1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
29 #include "intervals.h"
31 #include "character.h"
38 #include "termhooks.h"
40 #include "blockinput.h"
51 #endif /* HAVE_SETLOCALE */
56 #define file_offset off_t
57 #define file_tell ftello
59 #define file_offset long
60 #define file_tell ftell
63 /* hash table read constants */
64 Lisp_Object Qhash_table
, Qdata
;
65 Lisp_Object Qtest
, Qsize
;
66 Lisp_Object Qweakness
;
67 Lisp_Object Qrehash_size
;
68 Lisp_Object Qrehash_threshold
;
70 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
71 Lisp_Object Qvariable_documentation
;
72 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
73 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
74 Lisp_Object Qinhibit_file_name_operation
;
75 Lisp_Object Qeval_buffer_list
;
76 Lisp_Object Qlexical_binding
;
77 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
79 /* Used instead of Qget_file_char while loading *.elc files compiled
80 by Emacs 21 or older. */
81 static Lisp_Object Qget_emacs_mule_file_char
;
83 static Lisp_Object Qload_force_doc_strings
;
85 extern Lisp_Object Qinternal_interpreter_environment
;
87 static Lisp_Object Qload_in_progress
;
89 /* The association list of objects read with the #n=object form.
90 Each member of the list has the form (n . object), and is used to
91 look up the object for the corresponding #n# construct.
92 It must be set to nil before all top-level calls to read0. */
93 Lisp_Object read_objects
;
95 /* Nonzero means READCHAR should read bytes one by one (not character)
96 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
97 This is set to 1 by read1 temporarily while handling #@NUMBER. */
98 static int load_each_byte
;
100 /* List of descriptors now open for Fload. */
101 static Lisp_Object load_descriptor_list
;
103 /* File for get_file_char to read from. Use by load. */
104 static FILE *instream
;
106 /* When nonzero, read conses in pure space */
107 static int read_pure
;
109 /* For use within read-from-string (this reader is non-reentrant!!) */
110 static EMACS_INT read_from_string_index
;
111 static EMACS_INT read_from_string_index_byte
;
112 static EMACS_INT read_from_string_limit
;
114 /* Number of characters read in the current call to Fread or
115 Fread_from_string. */
116 static EMACS_INT readchar_count
;
118 /* This contains the last string skipped with #@. */
119 static char *saved_doc_string
;
120 /* Length of buffer allocated in saved_doc_string. */
121 static int saved_doc_string_size
;
122 /* Length of actual data in saved_doc_string. */
123 static int saved_doc_string_length
;
124 /* This is the file position that string came from. */
125 static file_offset saved_doc_string_position
;
127 /* This contains the previous string skipped with #@.
128 We copy it from saved_doc_string when a new string
129 is put in saved_doc_string. */
130 static char *prev_saved_doc_string
;
131 /* Length of buffer allocated in prev_saved_doc_string. */
132 static int prev_saved_doc_string_size
;
133 /* Length of actual data in prev_saved_doc_string. */
134 static int prev_saved_doc_string_length
;
135 /* This is the file position that string came from. */
136 static file_offset prev_saved_doc_string_position
;
138 /* Nonzero means inside a new-style backquote
139 with no surrounding parentheses.
140 Fread initializes this to zero, so we need not specbind it
141 or worry about what happens to it when there is an error. */
142 static int new_backquote_flag
;
143 static Lisp_Object Qold_style_backquotes
;
145 /* A list of file names for files being loaded in Fload. Used to
146 check for recursive loads. */
148 static Lisp_Object Vloads_in_progress
;
150 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
153 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
154 Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
);
156 static Lisp_Object
load_unwind (Lisp_Object
);
157 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
159 static void invalid_syntax (const char *, int) NO_RETURN
;
160 static void end_of_file_error (void) NO_RETURN
;
163 /* Functions that read one byte from the current source READCHARFUN
164 or unreads one byte. If the integer argument C is -1, it returns
165 one read byte, or -1 when there's no more byte in the source. If C
166 is 0 or positive, it unreads C, and the return value is not
169 static int readbyte_for_lambda (int, Lisp_Object
);
170 static int readbyte_from_file (int, Lisp_Object
);
171 static int readbyte_from_string (int, Lisp_Object
);
173 /* Handle unreading and rereading of characters.
174 Write READCHAR to read a character,
175 UNREAD(c) to unread c to be read again.
177 These macros correctly read/unread multibyte characters. */
179 #define READCHAR readchar (readcharfun, NULL)
180 #define UNREAD(c) unreadchar (readcharfun, c)
182 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
183 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
185 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
186 Qlambda, or a cons, we use this to keep an unread character because
187 a file stream can't handle multibyte-char unreading. The value -1
188 means that there's no unread character. */
189 static int unread_char
;
192 readchar (Lisp_Object readcharfun
, int *multibyte
)
196 int (*readbyte
) (int, Lisp_Object
);
197 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
199 int emacs_mule_encoding
= 0;
206 if (BUFFERP (readcharfun
))
208 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
210 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
212 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
215 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
217 /* Fetch the character code from the buffer. */
218 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
219 BUF_INC_POS (inbuffer
, pt_byte
);
226 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
227 if (! ASCII_BYTE_P (c
))
228 c
= BYTE8_TO_CHAR (c
);
231 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
235 if (MARKERP (readcharfun
))
237 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
239 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
241 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
244 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
246 /* Fetch the character code from the buffer. */
247 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
248 BUF_INC_POS (inbuffer
, bytepos
);
255 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
256 if (! ASCII_BYTE_P (c
))
257 c
= BYTE8_TO_CHAR (c
);
261 XMARKER (readcharfun
)->bytepos
= bytepos
;
262 XMARKER (readcharfun
)->charpos
++;
267 if (EQ (readcharfun
, Qlambda
))
269 readbyte
= readbyte_for_lambda
;
273 if (EQ (readcharfun
, Qget_file_char
))
275 readbyte
= readbyte_from_file
;
279 if (STRINGP (readcharfun
))
281 if (read_from_string_index
>= read_from_string_limit
)
283 else if (STRING_MULTIBYTE (readcharfun
))
287 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
288 read_from_string_index
,
289 read_from_string_index_byte
);
293 c
= SREF (readcharfun
, read_from_string_index_byte
);
294 read_from_string_index
++;
295 read_from_string_index_byte
++;
300 if (CONSP (readcharfun
))
302 /* This is the case that read_vector is reading from a unibyte
303 string that contains a byte sequence previously skipped
304 because of #@NUMBER. The car part of readcharfun is that
305 string, and the cdr part is a value of readcharfun given to
307 readbyte
= readbyte_from_string
;
308 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
309 emacs_mule_encoding
= 1;
313 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
315 readbyte
= readbyte_from_file
;
316 emacs_mule_encoding
= 1;
320 tem
= call0 (readcharfun
);
327 if (unread_char
>= 0)
333 c
= (*readbyte
) (-1, readcharfun
);
334 if (c
< 0 || load_each_byte
)
338 if (ASCII_BYTE_P (c
))
340 if (emacs_mule_encoding
)
341 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
344 len
= BYTES_BY_CHAR_HEAD (c
);
347 c
= (*readbyte
) (-1, readcharfun
);
348 if (c
< 0 || ! TRAILING_CODE_P (c
))
351 (*readbyte
) (buf
[i
], readcharfun
);
352 return BYTE8_TO_CHAR (buf
[0]);
356 return STRING_CHAR (buf
);
359 /* Unread the character C in the way appropriate for the stream READCHARFUN.
360 If the stream is a user function, call it with the char as argument. */
363 unreadchar (Lisp_Object readcharfun
, int c
)
367 /* Don't back up the pointer if we're unreading the end-of-input mark,
368 since readchar didn't advance it when we read it. */
370 else if (BUFFERP (readcharfun
))
372 struct buffer
*b
= XBUFFER (readcharfun
);
373 EMACS_INT charpos
= BUF_PT (b
);
374 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
376 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
377 BUF_DEC_POS (b
, bytepos
);
381 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
383 else if (MARKERP (readcharfun
))
385 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
386 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
388 XMARKER (readcharfun
)->charpos
--;
389 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
390 BUF_DEC_POS (b
, bytepos
);
394 XMARKER (readcharfun
)->bytepos
= bytepos
;
396 else if (STRINGP (readcharfun
))
398 read_from_string_index
--;
399 read_from_string_index_byte
400 = string_char_to_byte (readcharfun
, read_from_string_index
);
402 else if (CONSP (readcharfun
))
406 else if (EQ (readcharfun
, Qlambda
))
410 else if (EQ (readcharfun
, Qget_file_char
)
411 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
416 ungetc (c
, instream
);
423 call1 (readcharfun
, make_number (c
));
427 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
429 return read_bytecode_char (c
>= 0);
434 readbyte_from_file (int c
, Lisp_Object readcharfun
)
439 ungetc (c
, instream
);
448 /* Interrupted reads have been observed while reading over the network */
449 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
461 return (c
== EOF
? -1 : c
);
465 readbyte_from_string (int c
, Lisp_Object readcharfun
)
467 Lisp_Object string
= XCAR (readcharfun
);
471 read_from_string_index
--;
472 read_from_string_index_byte
473 = string_char_to_byte (string
, read_from_string_index
);
476 if (read_from_string_index
>= read_from_string_limit
)
479 FETCH_STRING_CHAR_ADVANCE (c
, string
,
480 read_from_string_index
,
481 read_from_string_index_byte
);
486 /* Read one non-ASCII character from INSTREAM. The character is
487 encoded in `emacs-mule' and the first byte is already read in
491 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
493 /* Emacs-mule coding uses at most 4-byte for one character. */
494 unsigned char buf
[4];
495 int len
= emacs_mule_bytes
[c
];
496 struct charset
*charset
;
501 /* C is not a valid leading-code of `emacs-mule'. */
502 return BYTE8_TO_CHAR (c
);
508 c
= (*readbyte
) (-1, readcharfun
);
512 (*readbyte
) (buf
[i
], readcharfun
);
513 return BYTE8_TO_CHAR (buf
[0]);
520 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
521 code
= buf
[1] & 0x7F;
525 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
526 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
528 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
529 code
= buf
[2] & 0x7F;
533 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
534 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
540 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
542 c
= DECODE_CHAR (charset
, code
);
544 Fsignal (Qinvalid_read_syntax
,
545 Fcons (build_string ("invalid multibyte form"), Qnil
));
550 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
552 static Lisp_Object
read0 (Lisp_Object
);
553 static Lisp_Object
read1 (Lisp_Object
, int *, int);
555 static Lisp_Object
read_list (int, Lisp_Object
);
556 static Lisp_Object
read_vector (Lisp_Object
, int);
558 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
560 static void substitute_object_in_subtree (Lisp_Object
,
562 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
565 /* Get a character from the tty. */
567 /* Read input events until we get one that's acceptable for our purposes.
569 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
570 until we get a character we like, and then stuffed into
573 If ASCII_REQUIRED is non-zero, we check function key events to see
574 if the unmodified version of the symbol has a Qascii_character
575 property, and use that character, if present.
577 If ERROR_NONASCII is non-zero, we signal an error if the input we
578 get isn't an ASCII character with modifiers. If it's zero but
579 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
582 If INPUT_METHOD is nonzero, we invoke the current input method
583 if the character warrants that.
585 If SECONDS is a number, we wait that many seconds for input, and
586 return Qnil if no input arrives within that time. */
589 read_filtered_event (int no_switch_frame
, int ascii_required
,
590 int error_nonascii
, int input_method
, Lisp_Object seconds
)
592 Lisp_Object val
, delayed_switch_frame
;
595 #ifdef HAVE_WINDOW_SYSTEM
596 if (display_hourglass_p
)
600 delayed_switch_frame
= Qnil
;
602 /* Compute timeout. */
603 if (NUMBERP (seconds
))
605 EMACS_TIME wait_time
;
607 double duration
= extract_float (seconds
);
609 sec
= (int) duration
;
610 usec
= (duration
- sec
) * 1000000;
611 EMACS_GET_TIME (end_time
);
612 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
613 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
616 /* Read until we get an acceptable event. */
619 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
620 NUMBERP (seconds
) ? &end_time
: NULL
);
621 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
626 /* switch-frame events are put off until after the next ASCII
627 character. This is better than signaling an error just because
628 the last characters were typed to a separate minibuffer frame,
629 for example. Eventually, some code which can deal with
630 switch-frame events will read it and process it. */
632 && EVENT_HAS_PARAMETERS (val
)
633 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
635 delayed_switch_frame
= val
;
639 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
641 /* Convert certain symbols to their ASCII equivalents. */
644 Lisp_Object tem
, tem1
;
645 tem
= Fget (val
, Qevent_symbol_element_mask
);
648 tem1
= Fget (Fcar (tem
), Qascii_character
);
649 /* Merge this symbol's modifier bits
650 with the ASCII equivalent of its basic code. */
652 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
656 /* If we don't have a character now, deal with it appropriately. */
661 Vunread_command_events
= Fcons (val
, Qnil
);
662 error ("Non-character input-event");
669 if (! NILP (delayed_switch_frame
))
670 unread_switch_frame
= delayed_switch_frame
;
674 #ifdef HAVE_WINDOW_SYSTEM
675 if (display_hourglass_p
)
684 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
685 doc
: /* Read a character from the command input (keyboard or macro).
686 It is returned as a number.
687 If the character has modifiers, they are resolved and reflected to the
688 character code if possible (e.g. C-SPC -> 0).
690 If the user generates an event which is not a character (i.e. a mouse
691 click or function key event), `read-char' signals an error. As an
692 exception, switch-frame events are put off until non-character events
694 If you want to read non-character events, or ignore them, call
695 `read-event' or `read-char-exclusive' instead.
697 If the optional argument PROMPT is non-nil, display that as a prompt.
698 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
699 input method is turned on in the current buffer, that input method
700 is used for reading a character.
701 If the optional argument SECONDS is non-nil, it should be a number
702 specifying the maximum number of seconds to wait for input. If no
703 input arrives in that time, return nil. SECONDS may be a
704 floating-point value. */)
705 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
710 message_with_string ("%s", prompt
, 0);
711 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
713 return (NILP (val
) ? Qnil
714 : make_number (char_resolve_modifier_mask (XINT (val
))));
717 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
718 doc
: /* Read an event object from the input stream.
719 If the optional argument PROMPT is non-nil, display that as a prompt.
720 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
721 input method is turned on in the current buffer, that input method
722 is used for reading a character.
723 If the optional argument SECONDS is non-nil, it should be a number
724 specifying the maximum number of seconds to wait for input. If no
725 input arrives in that time, return nil. SECONDS may be a
726 floating-point value. */)
727 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
730 message_with_string ("%s", prompt
, 0);
731 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
734 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
735 doc
: /* Read a character from the command input (keyboard or macro).
736 It is returned as a number. Non-character events are ignored.
737 If the character has modifiers, they are resolved and reflected to the
738 character code if possible (e.g. C-SPC -> 0).
740 If the optional argument PROMPT is non-nil, display that as a prompt.
741 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
742 input method is turned on in the current buffer, that input method
743 is used for reading a character.
744 If the optional argument SECONDS is non-nil, it should be a number
745 specifying the maximum number of seconds to wait for input. If no
746 input arrives in that time, return nil. SECONDS may be a
747 floating-point value. */)
748 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
753 message_with_string ("%s", prompt
, 0);
755 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
757 return (NILP (val
) ? Qnil
758 : make_number (char_resolve_modifier_mask (XINT (val
))));
761 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
762 doc
: /* Don't use this yourself. */)
765 register Lisp_Object val
;
767 XSETINT (val
, getc (instream
));
775 /* Return true if the lisp code read using READCHARFUN defines a non-nil
776 `lexical-binding' file variable. After returning, the stream is
777 positioned following the first line, if it is a comment, otherwise
781 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
785 /* The first line isn't a comment, just give up. */
791 /* Look for an appropriate file-variable in the first line. */
795 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
796 } beg_end_state
= NOMINAL
;
797 int in_file_vars
= 0;
799 #define UPDATE_BEG_END_STATE(ch) \
800 if (beg_end_state == NOMINAL) \
801 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
802 else if (beg_end_state == AFTER_FIRST_DASH) \
803 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
804 else if (beg_end_state == AFTER_ASTERIX) \
807 in_file_vars = !in_file_vars; \
808 beg_end_state = NOMINAL; \
811 /* Skip until we get to the file vars, if any. */
815 UPDATE_BEG_END_STATE (ch
);
817 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
821 char var
[100], val
[100];
826 /* Read a variable name. */
827 while (ch
== ' ' || ch
== '\t')
831 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
833 if (i
< sizeof var
- 1)
835 UPDATE_BEG_END_STATE (ch
);
839 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
845 /* Read a variable value. */
848 while (ch
== ' ' || ch
== '\t')
852 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
854 if (i
< sizeof val
- 1)
856 UPDATE_BEG_END_STATE (ch
);
860 /* The value was terminated by an end-marker, which
863 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
867 if (strcmp (var
, "lexical-binding") == 0)
870 rv
= (strcmp (val
, "nil") != 0);
876 while (ch
!= '\n' && ch
!= EOF
)
883 /* Value is a version number of byte compiled code if the file
884 associated with file descriptor FD is a compiled Lisp file that's
885 safe to load. Only files compiled with Emacs are safe to load.
886 Files compiled with XEmacs can lead to a crash in Fbyte_code
887 because of an incompatible change in the byte compiler. */
890 safe_to_load_p (int fd
)
897 /* Read the first few bytes from the file, and look for a line
898 specifying the byte compiler version used. */
899 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
904 /* Skip to the next newline, skipping over the initial `ELC'
905 with NUL bytes following it, but note the version. */
906 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
911 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
918 lseek (fd
, 0, SEEK_SET
);
923 /* Callback for record_unwind_protect. Restore the old load list OLD,
924 after loading a file successfully. */
927 record_load_unwind (Lisp_Object old
)
929 return Vloads_in_progress
= old
;
932 /* This handler function is used via internal_condition_case_1. */
935 load_error_handler (Lisp_Object data
)
941 load_warn_old_style_backquotes (Lisp_Object file
)
943 if (!NILP (Vold_style_backquotes
))
946 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
953 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
954 doc
: /* Return the suffixes that `load' should try if a suffix is \
956 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
959 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
960 while (CONSP (suffixes
))
962 Lisp_Object exts
= Vload_file_rep_suffixes
;
963 suffix
= XCAR (suffixes
);
964 suffixes
= XCDR (suffixes
);
969 lst
= Fcons (concat2 (suffix
, ext
), lst
);
972 return Fnreverse (lst
);
975 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
976 doc
: /* Execute a file of Lisp code named FILE.
977 First try FILE with `.elc' appended, then try with `.el',
978 then try FILE unmodified (the exact suffixes in the exact order are
979 determined by `load-suffixes'). Environment variable references in
980 FILE are replaced with their values by calling `substitute-in-file-name'.
981 This function searches the directories in `load-path'.
983 If optional second arg NOERROR is non-nil,
984 report no error if FILE doesn't exist.
985 Print messages at start and end of loading unless
986 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
988 If optional fourth arg NOSUFFIX is non-nil, don't try adding
989 suffixes `.elc' or `.el' to the specified name FILE.
990 If optional fifth arg MUST-SUFFIX is non-nil, insist on
991 the suffix `.elc' or `.el'; don't accept just FILE unless
992 it ends in one of those suffixes or includes a directory name.
994 If this function fails to find a file, it may look for different
995 representations of that file before trying another file.
996 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
997 to the file name. Emacs uses this feature mainly to find compressed
998 versions of files when Auto Compression mode is enabled.
1000 The exact suffixes that this function tries out, in the exact order,
1001 are given by the value of the variable `load-file-rep-suffixes' if
1002 NOSUFFIX is non-nil and by the return value of the function
1003 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1004 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1005 and then the former.
1007 Loading a file records its definitions, and its `provide' and
1008 `require' calls, in an element of `load-history' whose
1009 car is the file name loaded. See `load-history'.
1011 While the file is in the process of being loaded, the variable
1012 `load-in-progress' is non-nil and the variable `load-file-name'
1013 is bound to the file's name.
1015 Return t if the file exists and loads successfully. */)
1016 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1018 register FILE *stream
;
1019 register int fd
= -1;
1020 int count
= SPECPDL_INDEX ();
1021 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1022 Lisp_Object found
, efound
, hist_file_name
;
1023 /* 1 means we printed the ".el is newer" message. */
1025 /* 1 means we are loading a compiled file. */
1027 Lisp_Object handler
;
1029 const char *fmode
= "r";
1037 CHECK_STRING (file
);
1039 /* If file name is magic, call the handler. */
1040 /* This shouldn't be necessary any more now that `openp' handles it right.
1041 handler = Ffind_file_name_handler (file, Qload);
1042 if (!NILP (handler))
1043 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1045 /* Do this after the handler to avoid
1046 the need to gcpro noerror, nomessage and nosuffix.
1047 (Below here, we care only whether they are nil or not.)
1048 The presence of this call is the result of a historical accident:
1049 it used to be in every file-operation and when it got removed
1050 everywhere, it accidentally stayed here. Since then, enough people
1051 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1052 that it seemed risky to remove. */
1053 if (! NILP (noerror
))
1055 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1056 Qt
, load_error_handler
);
1061 file
= Fsubstitute_in_file_name (file
);
1064 /* Avoid weird lossage with null string as arg,
1065 since it would try to load a directory as a Lisp file */
1066 if (SCHARS (file
) > 0)
1068 int size
= SBYTES (file
);
1071 GCPRO2 (file
, found
);
1073 if (! NILP (must_suffix
))
1075 /* Don't insist on adding a suffix if FILE already ends with one. */
1077 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1080 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1082 /* Don't insist on adding a suffix
1083 if the argument includes a directory name. */
1084 else if (! NILP (Ffile_name_directory (file
)))
1088 fd
= openp (Vload_path
, file
,
1089 (!NILP (nosuffix
) ? Qnil
1090 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1091 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1092 tmp
[1] = Vload_file_rep_suffixes
,
1101 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1105 /* Tell startup.el whether or not we found the user's init file. */
1106 if (EQ (Qt
, Vuser_init_file
))
1107 Vuser_init_file
= found
;
1109 /* If FD is -2, that means openp found a magic file. */
1112 if (NILP (Fequal (found
, file
)))
1113 /* If FOUND is a different file name from FILE,
1114 find its handler even if we have already inhibited
1115 the `load' operation on FILE. */
1116 handler
= Ffind_file_name_handler (found
, Qt
);
1118 handler
= Ffind_file_name_handler (found
, Qload
);
1119 if (! NILP (handler
))
1120 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1123 /* Check if we're stuck in a recursive load cycle.
1125 2000-09-21: It's not possible to just check for the file loaded
1126 being a member of Vloads_in_progress. This fails because of the
1127 way the byte compiler currently works; `provide's are not
1128 evaluated, see font-lock.el/jit-lock.el as an example. This
1129 leads to a certain amount of ``normal'' recursion.
1131 Also, just loading a file recursively is not always an error in
1132 the general case; the second load may do something different. */
1136 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1137 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1141 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1143 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1144 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1147 /* All loads are by default dynamic, unless the file itself specifies
1148 otherwise using a file-variable in the first line. This is bound here
1149 so that it takes effect whether or not we use
1150 Vload_source_file_function. */
1151 specbind (Qlexical_binding
, Qnil
);
1153 /* Get the name for load-history. */
1154 hist_file_name
= (! NILP (Vpurify_flag
)
1155 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1156 tmp
[1] = Ffile_name_nondirectory (found
),
1162 /* Check for the presence of old-style quotes and warn about them. */
1163 specbind (Qold_style_backquotes
, Qnil
);
1164 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1166 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1167 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1168 /* Load .elc files directly, but not when they are
1169 remote and have no handler! */
1176 GCPRO3 (file
, found
, hist_file_name
);
1179 && ! (version
= safe_to_load_p (fd
)))
1182 if (!load_dangerous_libraries
)
1186 error ("File `%s' was not compiled in Emacs",
1189 else if (!NILP (nomessage
) && !force_load_messages
)
1190 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1195 efound
= ENCODE_FILE (found
);
1200 stat (SSDATA (efound
), &s1
);
1201 SSET (efound
, SBYTES (efound
) - 1, 0);
1202 result
= stat (SSDATA (efound
), &s2
);
1203 SSET (efound
, SBYTES (efound
) - 1, 'c');
1205 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1207 /* Make the progress messages mention that source is newer. */
1210 /* If we won't print another message, mention this anyway. */
1211 if (!NILP (nomessage
) && !force_load_messages
)
1213 Lisp_Object msg_file
;
1214 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1215 message_with_string ("Source file `%s' newer than byte-compiled file",
1224 /* We are loading a source file (*.el). */
1225 if (!NILP (Vload_source_file_function
))
1231 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1232 NILP (noerror
) ? Qnil
: Qt
,
1233 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1234 return unbind_to (count
, val
);
1238 GCPRO3 (file
, found
, hist_file_name
);
1242 efound
= ENCODE_FILE (found
);
1243 stream
= fopen (SSDATA (efound
), fmode
);
1244 #else /* not WINDOWSNT */
1245 stream
= fdopen (fd
, fmode
);
1246 #endif /* not WINDOWSNT */
1250 error ("Failure to create stdio stream for %s", SDATA (file
));
1253 if (! NILP (Vpurify_flag
))
1254 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1256 if (NILP (nomessage
) || force_load_messages
)
1259 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1262 message_with_string ("Loading %s (source)...", file
, 1);
1264 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1266 else /* The typical case; compiled file newer than source file. */
1267 message_with_string ("Loading %s...", file
, 1);
1270 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1271 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1272 specbind (Qload_file_name
, found
);
1273 specbind (Qinhibit_file_name_operation
, Qnil
);
1274 load_descriptor_list
1275 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1276 specbind (Qload_in_progress
, Qt
);
1279 if (lisp_file_lexically_bound_p (Qget_file_char
))
1280 Fset (Qlexical_binding
, Qt
);
1282 if (! version
|| version
>= 22)
1283 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1284 0, Qnil
, Qnil
, Qnil
, Qnil
);
1287 /* We can't handle a file which was compiled with
1288 byte-compile-dynamic by older version of Emacs. */
1289 specbind (Qload_force_doc_strings
, Qt
);
1290 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1291 0, Qnil
, Qnil
, Qnil
, Qnil
);
1293 unbind_to (count
, Qnil
);
1295 /* Run any eval-after-load forms for this file */
1296 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1297 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1301 xfree (saved_doc_string
);
1302 saved_doc_string
= 0;
1303 saved_doc_string_size
= 0;
1305 xfree (prev_saved_doc_string
);
1306 prev_saved_doc_string
= 0;
1307 prev_saved_doc_string_size
= 0;
1309 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1312 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1315 message_with_string ("Loading %s (source)...done", file
, 1);
1317 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1319 else /* The typical case; compiled file newer than source file. */
1320 message_with_string ("Loading %s...done", file
, 1);
1327 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1329 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1340 load_descriptor_unwind (Lisp_Object oldlist
)
1342 load_descriptor_list
= oldlist
;
1346 /* Close all descriptors in use for Floads.
1347 This is used when starting a subprocess. */
1350 close_load_descs (void)
1354 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1355 emacs_close (XFASTINT (XCAR (tail
)));
1360 complete_filename_p (Lisp_Object pathname
)
1362 register const unsigned char *s
= SDATA (pathname
);
1363 return (IS_DIRECTORY_SEP (s
[0])
1364 || (SCHARS (pathname
) > 2
1365 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1368 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1369 doc
: /* Search for FILENAME through PATH.
1370 Returns the file's name in absolute form, or nil if not found.
1371 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1372 file name when searching.
1373 If non-nil, PREDICATE is used instead of `file-readable-p'.
1374 PREDICATE can also be an integer to pass to the access(2) function,
1375 in which case file-name-handlers are ignored.
1376 This function will normally skip directories, so if you want it to find
1377 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1378 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1381 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1382 if (NILP (predicate
) && fd
> 0)
1387 static Lisp_Object Qdir_ok
;
1389 /* Search for a file whose name is STR, looking in directories
1390 in the Lisp list PATH, and trying suffixes from SUFFIX.
1391 On success, returns a file descriptor. On failure, returns -1.
1393 SUFFIXES is a list of strings containing possible suffixes.
1394 The empty suffix is automatically added if the list is empty.
1396 PREDICATE non-nil means don't open the files,
1397 just look for one that satisfies the predicate. In this case,
1398 returns 1 on success. The predicate can be a lisp function or
1399 an integer to pass to `access' (in which case file-name-handlers
1402 If STOREPTR is nonzero, it points to a slot where the name of
1403 the file actually found should be stored as a Lisp string.
1404 nil is stored there on failure.
1406 If the file we find is remote, return -2
1407 but store the found remote file name in *STOREPTR. */
1410 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1415 register char *fn
= buf
;
1418 Lisp_Object filename
;
1420 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1421 Lisp_Object string
, tail
, encoded_fn
;
1422 int max_suffix_len
= 0;
1426 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1428 CHECK_STRING_CAR (tail
);
1429 max_suffix_len
= max (max_suffix_len
,
1430 SBYTES (XCAR (tail
)));
1433 string
= filename
= encoded_fn
= Qnil
;
1434 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1439 if (complete_filename_p (str
))
1442 for (; CONSP (path
); path
= XCDR (path
))
1444 filename
= Fexpand_file_name (str
, XCAR (path
));
1445 if (!complete_filename_p (filename
))
1446 /* If there are non-absolute elts in PATH (eg ".") */
1447 /* Of course, this could conceivably lose if luser sets
1448 default-directory to be something non-absolute... */
1450 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1451 if (!complete_filename_p (filename
))
1452 /* Give up on this path element! */
1456 /* Calculate maximum size of any filename made from
1457 this path element/specified file name and any possible suffix. */
1458 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1459 if (fn_size
< want_size
)
1460 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1462 /* Loop over suffixes. */
1463 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1464 CONSP (tail
); tail
= XCDR (tail
))
1466 int lsuffix
= SBYTES (XCAR (tail
));
1467 Lisp_Object handler
;
1470 /* Concatenate path element/specified name with the suffix.
1471 If the directory starts with /:, remove that. */
1472 if (SCHARS (filename
) > 2
1473 && SREF (filename
, 0) == '/'
1474 && SREF (filename
, 1) == ':')
1476 strncpy (fn
, SSDATA (filename
) + 2,
1477 SBYTES (filename
) - 2);
1478 fn
[SBYTES (filename
) - 2] = 0;
1482 strncpy (fn
, SSDATA (filename
),
1484 fn
[SBYTES (filename
)] = 0;
1487 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1488 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1490 /* Check that the file exists and is not a directory. */
1491 /* We used to only check for handlers on non-absolute file names:
1495 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1496 It's not clear why that was the case and it breaks things like
1497 (load "/bar.el") where the file is actually "/bar.el.gz". */
1498 string
= build_string (fn
);
1499 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1500 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1502 if (NILP (predicate
))
1503 exists
= !NILP (Ffile_readable_p (string
));
1506 Lisp_Object tmp
= call1 (predicate
, string
);
1507 exists
= !NILP (tmp
)
1508 && (EQ (tmp
, Qdir_ok
)
1509 || NILP (Ffile_directory_p (string
)));
1514 /* We succeeded; return this descriptor and filename. */
1525 encoded_fn
= ENCODE_FILE (string
);
1526 pfn
= SSDATA (encoded_fn
);
1527 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1530 /* Check that we can access or open it. */
1531 if (NATNUMP (predicate
))
1532 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1534 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1538 /* We succeeded; return this descriptor and filename. */
1556 /* Merge the list we've accumulated of globals from the current input source
1557 into the load_history variable. The details depend on whether
1558 the source has an associated file name or not.
1560 FILENAME is the file name that we are loading from.
1561 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1564 build_load_history (Lisp_Object filename
, int entire
)
1566 register Lisp_Object tail
, prev
, newelt
;
1567 register Lisp_Object tem
, tem2
;
1568 register int foundit
= 0;
1570 tail
= Vload_history
;
1573 while (CONSP (tail
))
1577 /* Find the feature's previous assoc list... */
1578 if (!NILP (Fequal (filename
, Fcar (tem
))))
1582 /* If we're loading the entire file, remove old data. */
1586 Vload_history
= XCDR (tail
);
1588 Fsetcdr (prev
, XCDR (tail
));
1591 /* Otherwise, cons on new symbols that are not already members. */
1594 tem2
= Vcurrent_load_list
;
1596 while (CONSP (tem2
))
1598 newelt
= XCAR (tem2
);
1600 if (NILP (Fmember (newelt
, tem
)))
1601 Fsetcar (tail
, Fcons (XCAR (tem
),
1602 Fcons (newelt
, XCDR (tem
))));
1615 /* If we're loading an entire file, cons the new assoc onto the
1616 front of load-history, the most-recently-loaded position. Also
1617 do this if we didn't find an existing member for the file. */
1618 if (entire
|| !foundit
)
1619 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1624 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1631 readevalloop_1 (Lisp_Object old
)
1633 load_convert_to_unibyte
= ! NILP (old
);
1637 /* Signal an `end-of-file' error, if possible with file name
1641 end_of_file_error (void)
1643 if (STRINGP (Vload_file_name
))
1644 xsignal1 (Qend_of_file
, Vload_file_name
);
1646 xsignal0 (Qend_of_file
);
1649 /* UNIBYTE specifies how to set load_convert_to_unibyte
1650 for this invocation.
1651 READFUN, if non-nil, is used instead of `read'.
1653 START, END specify region to read in current buffer (from eval-region).
1654 If the input is not from a buffer, they must be nil. */
1657 readevalloop (Lisp_Object readcharfun
,
1659 Lisp_Object sourcename
,
1661 Lisp_Object unibyte
, Lisp_Object readfun
,
1662 Lisp_Object start
, Lisp_Object end
)
1665 register Lisp_Object val
;
1666 int count
= SPECPDL_INDEX ();
1667 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1668 struct buffer
*b
= 0;
1669 int continue_reading_p
;
1670 Lisp_Object lex_bound
;
1671 /* Nonzero if reading an entire buffer. */
1672 int whole_buffer
= 0;
1673 /* 1 on the first time around. */
1676 if (MARKERP (readcharfun
))
1679 start
= readcharfun
;
1682 if (BUFFERP (readcharfun
))
1683 b
= XBUFFER (readcharfun
);
1684 else if (MARKERP (readcharfun
))
1685 b
= XMARKER (readcharfun
)->buffer
;
1687 /* We assume START is nil when input is not from a buffer. */
1688 if (! NILP (start
) && !b
)
1691 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1692 specbind (Qcurrent_load_list
, Qnil
);
1693 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1694 load_convert_to_unibyte
= !NILP (unibyte
);
1696 /* If lexical binding is active (either because it was specified in
1697 the file's header, or via a buffer-local variable), create an empty
1698 lexical environment, otherwise, turn off lexical binding. */
1699 lex_bound
= find_symbol_value (Qlexical_binding
);
1700 specbind (Qinternal_interpreter_environment
,
1701 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1702 ? Qnil
: Fcons (Qt
, Qnil
));
1704 GCPRO4 (sourcename
, readfun
, start
, end
);
1706 /* Try to ensure sourcename is a truename, except whilst preloading. */
1707 if (NILP (Vpurify_flag
)
1708 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1709 && !NILP (Ffboundp (Qfile_truename
)))
1710 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1712 LOADHIST_ATTACH (sourcename
);
1714 continue_reading_p
= 1;
1715 while (continue_reading_p
)
1717 int count1
= SPECPDL_INDEX ();
1719 if (b
!= 0 && NILP (BVAR (b
, name
)))
1720 error ("Reading from killed buffer");
1724 /* Switch to the buffer we are reading from. */
1725 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1726 set_buffer_internal (b
);
1728 /* Save point in it. */
1729 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1730 /* Save ZV in it. */
1731 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1732 /* Those get unbound after we read one expression. */
1734 /* Set point and ZV around stuff to be read. */
1737 Fnarrow_to_region (make_number (BEGV
), end
);
1739 /* Just for cleanliness, convert END to a marker
1740 if it is an integer. */
1742 end
= Fpoint_max_marker ();
1745 /* On the first cycle, we can easily test here
1746 whether we are reading the whole buffer. */
1747 if (b
&& first_sexp
)
1748 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1755 while ((c
= READCHAR
) != '\n' && c
!= -1);
1760 unbind_to (count1
, Qnil
);
1764 /* Ignore whitespace here, so we can detect eof. */
1765 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1766 || c
== 0x8a0) /* NBSP */
1769 if (!NILP (Vpurify_flag
) && c
== '(')
1771 record_unwind_protect (unreadpure
, Qnil
);
1772 val
= read_list (-1, readcharfun
);
1777 read_objects
= Qnil
;
1778 if (!NILP (readfun
))
1780 val
= call1 (readfun
, readcharfun
);
1782 /* If READCHARFUN has set point to ZV, we should
1783 stop reading, even if the form read sets point
1784 to a different value when evaluated. */
1785 if (BUFFERP (readcharfun
))
1787 struct buffer
*buf
= XBUFFER (readcharfun
);
1788 if (BUF_PT (buf
) == BUF_ZV (buf
))
1789 continue_reading_p
= 0;
1792 else if (! NILP (Vload_read_function
))
1793 val
= call1 (Vload_read_function
, readcharfun
);
1795 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1798 if (!NILP (start
) && continue_reading_p
)
1799 start
= Fpoint_marker ();
1801 /* Restore saved point and BEGV. */
1802 unbind_to (count1
, Qnil
);
1804 /* Now eval what we just read. */
1805 val
= eval_sub (val
);
1809 Vvalues
= Fcons (val
, Vvalues
);
1810 if (EQ (Vstandard_output
, Qt
))
1819 build_load_history (sourcename
,
1820 stream
|| whole_buffer
);
1824 unbind_to (count
, Qnil
);
1827 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1828 doc
: /* Execute the current buffer as Lisp code.
1829 When called from a Lisp program (i.e., not interactively), this
1830 function accepts up to five optional arguments:
1831 BUFFER is the buffer to evaluate (nil means use current buffer).
1832 PRINTFLAG controls printing of output:
1833 A value of nil means discard it; anything else is stream for print.
1834 FILENAME specifies the file name to use for `load-history'.
1835 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1837 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1838 functions should work normally even if PRINTFLAG is nil.
1840 This function preserves the position of point. */)
1841 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1843 int count
= SPECPDL_INDEX ();
1844 Lisp_Object tem
, buf
;
1847 buf
= Fcurrent_buffer ();
1849 buf
= Fget_buffer (buffer
);
1851 error ("No such buffer");
1853 if (NILP (printflag
) && NILP (do_allow_print
))
1858 if (NILP (filename
))
1859 filename
= BVAR (XBUFFER (buf
), filename
);
1861 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1862 specbind (Qstandard_output
, tem
);
1863 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1864 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1865 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1866 readevalloop (buf
, 0, filename
,
1867 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1868 unbind_to (count
, Qnil
);
1873 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1874 doc
: /* Execute the region as Lisp code.
1875 When called from programs, expects two arguments,
1876 giving starting and ending indices in the current buffer
1877 of the text to be executed.
1878 Programs can pass third argument PRINTFLAG which controls output:
1879 A value of nil means discard it; anything else is stream for printing it.
1880 Also the fourth argument READ-FUNCTION, if non-nil, is used
1881 instead of `read' to read each expression. It gets one argument
1882 which is the input stream for reading characters.
1884 This function does not move point. */)
1885 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1887 /* FIXME: Do the eval-sexp-add-defvars danse! */
1888 int count
= SPECPDL_INDEX ();
1889 Lisp_Object tem
, cbuf
;
1891 cbuf
= Fcurrent_buffer ();
1893 if (NILP (printflag
))
1897 specbind (Qstandard_output
, tem
);
1898 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1900 /* readevalloop calls functions which check the type of start and end. */
1901 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1902 !NILP (printflag
), Qnil
, read_function
,
1905 return unbind_to (count
, Qnil
);
1909 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1910 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1911 If STREAM is nil, use the value of `standard-input' (which see).
1912 STREAM or the value of `standard-input' may be:
1913 a buffer (read from point and advance it)
1914 a marker (read from where it points and advance it)
1915 a function (call it with no arguments for each character,
1916 call it with a char as argument to push a char back)
1917 a string (takes text from string, starting at the beginning)
1918 t (read text line using minibuffer and use it, or read from
1919 standard input in batch mode). */)
1920 (Lisp_Object stream
)
1923 stream
= Vstandard_input
;
1924 if (EQ (stream
, Qt
))
1925 stream
= Qread_char
;
1926 if (EQ (stream
, Qread_char
))
1927 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1929 return read_internal_start (stream
, Qnil
, Qnil
);
1932 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1933 doc
: /* Read one Lisp expression which is represented as text by STRING.
1934 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1935 START and END optionally delimit a substring of STRING from which to read;
1936 they default to 0 and (length STRING) respectively. */)
1937 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1940 CHECK_STRING (string
);
1941 /* read_internal_start sets read_from_string_index. */
1942 ret
= read_internal_start (string
, start
, end
);
1943 return Fcons (ret
, make_number (read_from_string_index
));
1946 /* Function to set up the global context we need in toplevel read
1949 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1950 /* start, end only used when stream is a string. */
1955 new_backquote_flag
= 0;
1956 read_objects
= Qnil
;
1957 if (EQ (Vread_with_symbol_positions
, Qt
)
1958 || EQ (Vread_with_symbol_positions
, stream
))
1959 Vread_symbol_positions_list
= Qnil
;
1961 if (STRINGP (stream
)
1962 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1964 EMACS_INT startval
, endval
;
1967 if (STRINGP (stream
))
1970 string
= XCAR (stream
);
1973 endval
= SCHARS (string
);
1977 endval
= XINT (end
);
1978 if (endval
< 0 || endval
> SCHARS (string
))
1979 args_out_of_range (string
, end
);
1986 CHECK_NUMBER (start
);
1987 startval
= XINT (start
);
1988 if (startval
< 0 || startval
> endval
)
1989 args_out_of_range (string
, start
);
1991 read_from_string_index
= startval
;
1992 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1993 read_from_string_limit
= endval
;
1996 retval
= read0 (stream
);
1997 if (EQ (Vread_with_symbol_positions
, Qt
)
1998 || EQ (Vread_with_symbol_positions
, stream
))
1999 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2004 /* Signal Qinvalid_read_syntax error.
2005 S is error string of length N (if > 0) */
2008 invalid_syntax (const char *s
, int n
)
2012 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2016 /* Use this for recursive reads, in contexts where internal tokens
2020 read0 (Lisp_Object readcharfun
)
2022 register Lisp_Object val
;
2025 val
= read1 (readcharfun
, &c
, 0);
2029 xsignal1 (Qinvalid_read_syntax
,
2030 Fmake_string (make_number (1), make_number (c
)));
2033 static int read_buffer_size
;
2034 static char *read_buffer
;
2036 /* Read a \-escape sequence, assuming we already read the `\'.
2037 If the escape sequence forces unibyte, return eight-bit char. */
2040 read_escape (Lisp_Object readcharfun
, int stringp
)
2042 register int c
= READCHAR
;
2043 /* \u allows up to four hex digits, \U up to eight. Default to the
2044 behavior for \u, and change this value in the case that \U is seen. */
2045 int unicode_hex_count
= 4;
2050 end_of_file_error ();
2080 error ("Invalid escape character syntax");
2083 c
= read_escape (readcharfun
, 0);
2084 return c
| meta_modifier
;
2089 error ("Invalid escape character syntax");
2092 c
= read_escape (readcharfun
, 0);
2093 return c
| shift_modifier
;
2098 error ("Invalid escape character syntax");
2101 c
= read_escape (readcharfun
, 0);
2102 return c
| hyper_modifier
;
2107 error ("Invalid escape character syntax");
2110 c
= read_escape (readcharfun
, 0);
2111 return c
| alt_modifier
;
2115 if (stringp
|| c
!= '-')
2122 c
= read_escape (readcharfun
, 0);
2123 return c
| super_modifier
;
2128 error ("Invalid escape character syntax");
2132 c
= read_escape (readcharfun
, 0);
2133 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2134 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2135 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2136 return c
| ctrl_modifier
;
2137 /* ASCII control chars are made from letters (both cases),
2138 as well as the non-letters within 0100...0137. */
2139 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2140 return (c
& (037 | ~0177));
2141 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2142 return (c
& (037 | ~0177));
2144 return c
| ctrl_modifier
;
2154 /* An octal escape, as in ANSI C. */
2156 register int i
= c
- '0';
2157 register int count
= 0;
2160 if ((c
= READCHAR
) >= '0' && c
<= '7')
2172 if (i
>= 0x80 && i
< 0x100)
2173 i
= BYTE8_TO_CHAR (i
);
2178 /* A hex escape, as in ANSI C. */
2185 if (c
>= '0' && c
<= '9')
2190 else if ((c
>= 'a' && c
<= 'f')
2191 || (c
>= 'A' && c
<= 'F'))
2194 if (c
>= 'a' && c
<= 'f')
2207 if (count
< 3 && i
>= 0x80)
2208 return BYTE8_TO_CHAR (i
);
2213 /* Post-Unicode-2.0: Up to eight hex chars. */
2214 unicode_hex_count
= 8;
2217 /* A Unicode escape. We only permit them in strings and characters,
2218 not arbitrarily in the source code, as in some other languages. */
2223 while (++count
<= unicode_hex_count
)
2226 /* isdigit and isalpha may be locale-specific, which we don't
2228 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2229 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2230 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2233 error ("Non-hex digit used for Unicode escape");
2238 error ("Non-Unicode character: 0x%x", i
);
2247 /* Read an integer in radix RADIX using READCHARFUN to read
2248 characters. RADIX must be in the interval [2..36]; if it isn't, a
2249 read error is signaled . Value is the integer read. Signals an
2250 error if encountering invalid read syntax or if RADIX is out of
2254 read_integer (Lisp_Object readcharfun
, int radix
)
2256 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2257 /* We use a floating point number because */
2260 if (radix
< 2 || radix
> 36)
2264 number
= ndigits
= invalid_p
= 0;
2280 if (c
>= '0' && c
<= '9')
2282 else if (c
>= 'a' && c
<= 'z')
2283 digit
= c
- 'a' + 10;
2284 else if (c
>= 'A' && c
<= 'Z')
2285 digit
= c
- 'A' + 10;
2292 if (digit
< 0 || digit
>= radix
)
2295 number
= radix
* number
+ digit
;
2301 if (ndigits
== 0 || invalid_p
)
2304 sprintf (buf
, "integer, radix %d", radix
);
2305 invalid_syntax (buf
, 0);
2308 return make_fixnum_or_float (sign
* number
);
2312 /* If the next token is ')' or ']' or '.', we store that character
2313 in *PCH and the return value is not interesting. Else, we store
2314 zero in *PCH and we read and return one lisp object.
2316 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2319 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2322 unsigned uninterned_symbol
= 0;
2330 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2332 end_of_file_error ();
2337 return read_list (0, readcharfun
);
2340 return read_vector (readcharfun
, 0);
2356 /* Accept extended format for hashtables (extensible to
2358 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2359 Lisp_Object tmp
= read_list (0, readcharfun
);
2360 Lisp_Object head
= CAR_SAFE (tmp
);
2361 Lisp_Object data
= Qnil
;
2362 Lisp_Object val
= Qnil
;
2363 /* The size is 2 * number of allowed keywords to
2365 Lisp_Object params
[10];
2367 Lisp_Object key
= Qnil
;
2368 int param_count
= 0;
2370 if (!EQ (head
, Qhash_table
))
2371 error ("Invalid extended read marker at head of #s list "
2372 "(only hash-table allowed)");
2374 tmp
= CDR_SAFE (tmp
);
2376 /* This is repetitive but fast and simple. */
2377 params
[param_count
] = QCsize
;
2378 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2379 if (!NILP (params
[param_count
+ 1]))
2382 params
[param_count
] = QCtest
;
2383 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2384 if (!NILP (params
[param_count
+ 1]))
2387 params
[param_count
] = QCweakness
;
2388 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2389 if (!NILP (params
[param_count
+ 1]))
2392 params
[param_count
] = QCrehash_size
;
2393 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2394 if (!NILP (params
[param_count
+ 1]))
2397 params
[param_count
] = QCrehash_threshold
;
2398 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2399 if (!NILP (params
[param_count
+ 1]))
2402 /* This is the hashtable data. */
2403 data
= Fplist_get (tmp
, Qdata
);
2405 /* Now use params to make a new hashtable and fill it. */
2406 ht
= Fmake_hash_table (param_count
, params
);
2408 while (CONSP (data
))
2413 error ("Odd number of elements in hashtable data");
2416 Fputhash (key
, val
, ht
);
2422 invalid_syntax ("#", 1);
2430 tmp
= read_vector (readcharfun
, 0);
2431 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2432 error ("Invalid size char-table");
2433 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2444 tmp
= read_vector (readcharfun
, 0);
2445 if (!INTEGERP (AREF (tmp
, 0)))
2446 error ("Invalid depth in char-table");
2447 depth
= XINT (AREF (tmp
, 0));
2448 if (depth
< 1 || depth
> 3)
2449 error ("Invalid depth in char-table");
2450 size
= XVECTOR (tmp
)->size
- 2;
2451 if (chartab_size
[depth
] != size
)
2452 error ("Invalid size char-table");
2453 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2456 invalid_syntax ("#^^", 3);
2458 invalid_syntax ("#^", 2);
2463 length
= read1 (readcharfun
, pch
, first_in_list
);
2467 Lisp_Object tmp
, val
;
2469 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2470 / BOOL_VECTOR_BITS_PER_CHAR
);
2473 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2474 if (STRING_MULTIBYTE (tmp
)
2475 || (size_in_chars
!= SCHARS (tmp
)
2476 /* We used to print 1 char too many
2477 when the number of bits was a multiple of 8.
2478 Accept such input in case it came from an old
2480 && ! (XFASTINT (length
)
2481 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2482 invalid_syntax ("#&...", 5);
2484 val
= Fmake_bool_vector (length
, Qnil
);
2485 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2486 /* Clear the extraneous bits in the last byte. */
2487 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2488 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2489 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2492 invalid_syntax ("#&...", 5);
2496 /* Accept compiled functions at read-time so that we don't have to
2497 build them using function calls. */
2499 tmp
= read_vector (readcharfun
, 1);
2500 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2501 XVECTOR (tmp
)->contents
);
2506 struct gcpro gcpro1
;
2509 /* Read the string itself. */
2510 tmp
= read1 (readcharfun
, &ch
, 0);
2511 if (ch
!= 0 || !STRINGP (tmp
))
2512 invalid_syntax ("#", 1);
2514 /* Read the intervals and their properties. */
2517 Lisp_Object beg
, end
, plist
;
2519 beg
= read1 (readcharfun
, &ch
, 0);
2524 end
= read1 (readcharfun
, &ch
, 0);
2526 plist
= read1 (readcharfun
, &ch
, 0);
2528 invalid_syntax ("Invalid string property list", 0);
2529 Fset_text_properties (beg
, end
, plist
, tmp
);
2535 /* #@NUMBER is used to skip NUMBER following characters.
2536 That's used in .elc files to skip over doc strings
2537 and function definitions. */
2543 /* Read a decimal integer. */
2544 while ((c
= READCHAR
) >= 0
2545 && c
>= '0' && c
<= '9')
2553 if (load_force_doc_strings
2554 && (EQ (readcharfun
, Qget_file_char
)
2555 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2557 /* If we are supposed to force doc strings into core right now,
2558 record the last string that we skipped,
2559 and record where in the file it comes from. */
2561 /* But first exchange saved_doc_string
2562 with prev_saved_doc_string, so we save two strings. */
2564 char *temp
= saved_doc_string
;
2565 int temp_size
= saved_doc_string_size
;
2566 file_offset temp_pos
= saved_doc_string_position
;
2567 int temp_len
= saved_doc_string_length
;
2569 saved_doc_string
= prev_saved_doc_string
;
2570 saved_doc_string_size
= prev_saved_doc_string_size
;
2571 saved_doc_string_position
= prev_saved_doc_string_position
;
2572 saved_doc_string_length
= prev_saved_doc_string_length
;
2574 prev_saved_doc_string
= temp
;
2575 prev_saved_doc_string_size
= temp_size
;
2576 prev_saved_doc_string_position
= temp_pos
;
2577 prev_saved_doc_string_length
= temp_len
;
2580 if (saved_doc_string_size
== 0)
2582 saved_doc_string_size
= nskip
+ 100;
2583 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2585 if (nskip
> saved_doc_string_size
)
2587 saved_doc_string_size
= nskip
+ 100;
2588 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2589 saved_doc_string_size
);
2592 saved_doc_string_position
= file_tell (instream
);
2594 /* Copy that many characters into saved_doc_string. */
2595 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2596 saved_doc_string
[i
] = c
= READCHAR
;
2598 saved_doc_string_length
= i
;
2602 /* Skip that many characters. */
2603 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2612 /* #! appears at the beginning of an executable file.
2613 Skip the first line. */
2614 while (c
!= '\n' && c
>= 0)
2619 return Vload_file_name
;
2621 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2622 /* #:foo is the uninterned symbol named foo. */
2625 uninterned_symbol
= 1;
2629 /* Reader forms that can reuse previously read objects. */
2630 if (c
>= '0' && c
<= '9')
2635 /* Read a non-negative integer. */
2636 while (c
>= '0' && c
<= '9')
2642 /* #n=object returns object, but associates it with n for #n#. */
2643 if (c
== '=' && !NILP (Vread_circle
))
2645 /* Make a placeholder for #n# to use temporarily */
2646 Lisp_Object placeholder
;
2649 placeholder
= Fcons (Qnil
, Qnil
);
2650 cell
= Fcons (make_number (n
), placeholder
);
2651 read_objects
= Fcons (cell
, read_objects
);
2653 /* Read the object itself. */
2654 tem
= read0 (readcharfun
);
2656 /* Now put it everywhere the placeholder was... */
2657 substitute_object_in_subtree (tem
, placeholder
);
2659 /* ...and #n# will use the real value from now on. */
2660 Fsetcdr (cell
, tem
);
2664 /* #n# returns a previously read object. */
2665 if (c
== '#' && !NILP (Vread_circle
))
2667 tem
= Fassq (make_number (n
), read_objects
);
2670 /* Fall through to error message. */
2672 else if (c
== 'r' || c
== 'R')
2673 return read_integer (readcharfun
, n
);
2675 /* Fall through to error message. */
2677 else if (c
== 'x' || c
== 'X')
2678 return read_integer (readcharfun
, 16);
2679 else if (c
== 'o' || c
== 'O')
2680 return read_integer (readcharfun
, 8);
2681 else if (c
== 'b' || c
== 'B')
2682 return read_integer (readcharfun
, 2);
2685 invalid_syntax ("#", 1);
2688 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2693 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2698 int next_char
= READCHAR
;
2700 /* Transition from old-style to new-style:
2701 If we see "(`" it used to mean old-style, which usually works
2702 fine because ` should almost never appear in such a position
2703 for new-style. But occasionally we need "(`" to mean new
2704 style, so we try to distinguish the two by the fact that we
2705 can either write "( `foo" or "(` foo", where the first
2706 intends to use new-style whereas the second intends to use
2707 old-style. For Emacs-25, we should completely remove this
2708 first_in_list exception (old-style can still be obtained via
2710 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2712 Vold_style_backquotes
= Qt
;
2719 new_backquote_flag
++;
2720 value
= read0 (readcharfun
);
2721 new_backquote_flag
--;
2723 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2728 int next_char
= READCHAR
;
2730 /* Transition from old-style to new-style:
2731 It used to be impossible to have a new-style , other than within
2732 a new-style `. This is sufficient when ` and , are used in the
2733 normal way, but ` and , can also appear in args to macros that
2734 will not interpret them in the usual way, in which case , may be
2735 used without any ` anywhere near.
2736 So we now use the same heuristic as for backquote: old-style
2737 unquotes are only recognized when first on a list, and when
2738 followed by a space.
2739 Because it's more difficult to peak 2 chars ahead, a new-style
2740 ,@ can still not be used outside of a `, unless it's in the middle
2742 if (new_backquote_flag
2744 || (next_char
!= ' ' && next_char
!= '@'))
2746 Lisp_Object comma_type
= Qnil
;
2751 comma_type
= Qcomma_at
;
2753 comma_type
= Qcomma_dot
;
2756 if (ch
>= 0) UNREAD (ch
);
2757 comma_type
= Qcomma
;
2760 value
= read0 (readcharfun
);
2761 return Fcons (comma_type
, Fcons (value
, Qnil
));
2765 Vold_style_backquotes
= Qt
;
2777 end_of_file_error ();
2779 /* Accept `single space' syntax like (list ? x) where the
2780 whitespace character is SPC or TAB.
2781 Other literal whitespace like NL, CR, and FF are not accepted,
2782 as there are well-established escape sequences for these. */
2783 if (c
== ' ' || c
== '\t')
2784 return make_number (c
);
2787 c
= read_escape (readcharfun
, 0);
2788 modifiers
= c
& CHAR_MODIFIER_MASK
;
2789 c
&= ~CHAR_MODIFIER_MASK
;
2790 if (CHAR_BYTE8_P (c
))
2791 c
= CHAR_TO_BYTE8 (c
);
2794 next_char
= READCHAR
;
2795 ok
= (next_char
<= 040
2796 || (next_char
< 0200
2797 && (strchr ("\"';()[]#?`,.", next_char
))));
2800 return make_number (c
);
2802 invalid_syntax ("?", 1);
2807 char *p
= read_buffer
;
2808 char *end
= read_buffer
+ read_buffer_size
;
2810 /* Nonzero if we saw an escape sequence specifying
2811 a multibyte character. */
2812 int force_multibyte
= 0;
2813 /* Nonzero if we saw an escape sequence specifying
2814 a single-byte character. */
2815 int force_singlebyte
= 0;
2819 while ((ch
= READCHAR
) >= 0
2822 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2824 int offset
= p
- read_buffer
;
2825 read_buffer
= (char *) xrealloc (read_buffer
,
2826 read_buffer_size
*= 2);
2827 p
= read_buffer
+ offset
;
2828 end
= read_buffer
+ read_buffer_size
;
2835 ch
= read_escape (readcharfun
, 1);
2837 /* CH is -1 if \ newline has just been seen */
2840 if (p
== read_buffer
)
2845 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2846 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2848 if (CHAR_BYTE8_P (ch
))
2849 force_singlebyte
= 1;
2850 else if (! ASCII_CHAR_P (ch
))
2851 force_multibyte
= 1;
2852 else /* i.e. ASCII_CHAR_P (ch) */
2854 /* Allow `\C- ' and `\C-?'. */
2855 if (modifiers
== CHAR_CTL
)
2858 ch
= 0, modifiers
= 0;
2860 ch
= 127, modifiers
= 0;
2862 if (modifiers
& CHAR_SHIFT
)
2864 /* Shift modifier is valid only with [A-Za-z]. */
2865 if (ch
>= 'A' && ch
<= 'Z')
2866 modifiers
&= ~CHAR_SHIFT
;
2867 else if (ch
>= 'a' && ch
<= 'z')
2868 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2871 if (modifiers
& CHAR_META
)
2873 /* Move the meta bit to the right place for a
2875 modifiers
&= ~CHAR_META
;
2876 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2877 force_singlebyte
= 1;
2881 /* Any modifiers remaining are invalid. */
2883 error ("Invalid modifier in string");
2884 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2888 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2889 if (CHAR_BYTE8_P (ch
))
2890 force_singlebyte
= 1;
2891 else if (! ASCII_CHAR_P (ch
))
2892 force_multibyte
= 1;
2898 end_of_file_error ();
2900 /* If purifying, and string starts with \ newline,
2901 return zero instead. This is for doc strings
2902 that we are really going to find in etc/DOC.nn.nn */
2903 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2904 return make_number (0);
2906 if (force_multibyte
)
2907 /* READ_BUFFER already contains valid multibyte forms. */
2909 else if (force_singlebyte
)
2911 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2913 p
= read_buffer
+ nchars
;
2917 /* Otherwise, READ_BUFFER contains only ASCII. */
2920 /* We want readchar_count to be the number of characters, not
2921 bytes. Hence we adjust for multibyte characters in the
2922 string. ... But it doesn't seem to be necessary, because
2923 READCHAR *does* read multibyte characters from buffers. */
2924 /* readchar_count -= (p - read_buffer) - nchars; */
2926 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2928 || (p
- read_buffer
!= nchars
)));
2929 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2931 || (p
- read_buffer
!= nchars
)));
2936 int next_char
= READCHAR
;
2939 if (next_char
<= 040
2940 || (next_char
< 0200
2941 && (strchr ("\"';([#?`,", next_char
))))
2947 /* Otherwise, we fall through! Note that the atom-reading loop
2948 below will now loop at least once, assuring that we will not
2949 try to UNREAD two characters in a row. */
2953 if (c
<= 040) goto retry
;
2954 if (c
== 0x8a0) /* NBSP */
2957 char *p
= read_buffer
;
2961 char *end
= read_buffer
+ read_buffer_size
;
2965 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2967 int offset
= p
- read_buffer
;
2968 read_buffer
= (char *) xrealloc (read_buffer
,
2969 read_buffer_size
*= 2);
2970 p
= read_buffer
+ offset
;
2971 end
= read_buffer
+ read_buffer_size
;
2978 end_of_file_error ();
2983 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2988 && c
!= 0x8a0 /* NBSP */
2990 || !(strchr ("\"';()[]#`,", c
))));
2994 int offset
= p
- read_buffer
;
2995 read_buffer
= (char *) xrealloc (read_buffer
,
2996 read_buffer_size
*= 2);
2997 p
= read_buffer
+ offset
;
2998 end
= read_buffer
+ read_buffer_size
;
3005 if (!quoted
&& !uninterned_symbol
)
3009 if (*p1
== '+' || *p1
== '-') p1
++;
3010 /* Is it an integer? */
3013 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3014 /* Integers can have trailing decimal points. */
3015 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3017 /* It is an integer. */
3022 /* EMACS_INT n = atol (read_buffer); */
3023 char *endptr
= NULL
;
3024 EMACS_INT n
= (errno
= 0,
3025 strtol (read_buffer
, &endptr
, 10));
3026 if (errno
== ERANGE
&& endptr
)
3029 = Fcons (make_string (read_buffer
,
3030 endptr
- read_buffer
),
3032 xsignal (Qoverflow_error
, args
);
3034 return make_fixnum_or_float (n
);
3038 if (isfloat_string (read_buffer
, 0))
3040 /* Compute NaN and infinities using 0.0 in a variable,
3041 to cope with compilers that think they are smarter
3047 /* Negate the value ourselves. This treats 0, NaNs,
3048 and infinity properly on IEEE floating point hosts,
3049 and works around a common bug where atof ("-0.0")
3051 int negative
= read_buffer
[0] == '-';
3053 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3054 returns 1, is if the input ends in e+INF or e+NaN. */
3061 value
= zero
/ zero
;
3063 /* If that made a "negative" NaN, negate it. */
3067 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3070 u_minus_zero
.d
= - 0.0;
3071 for (i
= 0; i
< sizeof (double); i
++)
3072 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3078 /* Now VALUE is a positive NaN. */
3081 value
= atof (read_buffer
+ negative
);
3085 return make_float (negative
? - value
: value
);
3089 Lisp_Object name
, result
;
3090 EMACS_INT nbytes
= p
- read_buffer
;
3093 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3097 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3098 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3100 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3101 result
= (uninterned_symbol
? Fmake_symbol (name
)
3102 : Fintern (name
, Qnil
));
3104 if (EQ (Vread_with_symbol_positions
, Qt
)
3105 || EQ (Vread_with_symbol_positions
, readcharfun
))
3106 Vread_symbol_positions_list
=
3107 /* Kind of a hack; this will probably fail if characters
3108 in the symbol name were escaped. Not really a big
3110 Fcons (Fcons (result
,
3111 make_number (readchar_count
3112 - XFASTINT (Flength (Fsymbol_name (result
))))),
3113 Vread_symbol_positions_list
);
3121 /* List of nodes we've seen during substitute_object_in_subtree. */
3122 static Lisp_Object seen_list
;
3125 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3127 Lisp_Object check_object
;
3129 /* We haven't seen any objects when we start. */
3132 /* Make all the substitutions. */
3134 = substitute_object_recurse (object
, placeholder
, object
);
3136 /* Clear seen_list because we're done with it. */
3139 /* The returned object here is expected to always eq the
3141 if (!EQ (check_object
, object
))
3142 error ("Unexpected mutation error in reader");
3145 /* Feval doesn't get called from here, so no gc protection is needed. */
3146 #define SUBSTITUTE(get_val, set_val) \
3148 Lisp_Object old_value = get_val; \
3149 Lisp_Object true_value \
3150 = substitute_object_recurse (object, placeholder, \
3153 if (!EQ (old_value, true_value)) \
3160 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3162 /* If we find the placeholder, return the target object. */
3163 if (EQ (placeholder
, subtree
))
3166 /* If we've been to this node before, don't explore it again. */
3167 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3170 /* If this node can be the entry point to a cycle, remember that
3171 we've seen it. It can only be such an entry point if it was made
3172 by #n=, which means that we can find it as a value in
3174 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3175 seen_list
= Fcons (subtree
, seen_list
);
3177 /* Recurse according to subtree's type.
3178 Every branch must return a Lisp_Object. */
3179 switch (XTYPE (subtree
))
3181 case Lisp_Vectorlike
:
3184 if (BOOL_VECTOR_P (subtree
))
3185 return subtree
; /* No sub-objects anyway. */
3186 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3187 || COMPILEDP (subtree
))
3188 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3189 else if (VECTORP (subtree
))
3190 length
= ASIZE (subtree
);
3192 /* An unknown pseudovector may contain non-Lisp fields, so we
3193 can't just blindly traverse all its fields. We used to call
3194 `Flength' which signaled `sequencep', so I just preserved this
3196 wrong_type_argument (Qsequencep
, subtree
);
3198 for (i
= 0; i
< length
; i
++)
3199 SUBSTITUTE (AREF (subtree
, i
),
3200 ASET (subtree
, i
, true_value
));
3206 SUBSTITUTE (XCAR (subtree
),
3207 XSETCAR (subtree
, true_value
));
3208 SUBSTITUTE (XCDR (subtree
),
3209 XSETCDR (subtree
, true_value
));
3215 /* Check for text properties in each interval.
3216 substitute_in_interval contains part of the logic. */
3218 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3219 Lisp_Object arg
= Fcons (object
, placeholder
);
3221 traverse_intervals_noorder (root_interval
,
3222 &substitute_in_interval
, arg
);
3227 /* Other types don't recurse any further. */
3233 /* Helper function for substitute_object_recurse. */
3235 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3237 Lisp_Object object
= Fcar (arg
);
3238 Lisp_Object placeholder
= Fcdr (arg
);
3240 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3251 isfloat_string (const char *cp
, int ignore_trailing
)
3254 const char *start
= cp
;
3257 if (*cp
== '+' || *cp
== '-')
3260 if (*cp
>= '0' && *cp
<= '9')
3263 while (*cp
>= '0' && *cp
<= '9')
3271 if (*cp
>= '0' && *cp
<= '9')
3274 while (*cp
>= '0' && *cp
<= '9')
3277 if (*cp
== 'e' || *cp
== 'E')
3281 if (*cp
== '+' || *cp
== '-')
3285 if (*cp
>= '0' && *cp
<= '9')
3288 while (*cp
>= '0' && *cp
<= '9')
3291 else if (cp
== start
)
3293 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3298 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3304 return ((ignore_trailing
3305 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3306 || *cp
== '\r' || *cp
== '\f')
3307 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3308 || state
== (DOT_CHAR
|TRAIL_INT
)
3309 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3310 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3311 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3316 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3320 register Lisp_Object
*ptr
;
3321 register Lisp_Object tem
, item
, vector
;
3322 register struct Lisp_Cons
*otem
;
3325 tem
= read_list (1, readcharfun
);
3326 len
= Flength (tem
);
3327 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3329 size
= XVECTOR (vector
)->size
;
3330 ptr
= XVECTOR (vector
)->contents
;
3331 for (i
= 0; i
< size
; i
++)
3334 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3335 bytecode object, the docstring containing the bytecode and
3336 constants values must be treated as unibyte and passed to
3337 Fread, to get the actual bytecode string and constants vector. */
3338 if (bytecodeflag
&& load_force_doc_strings
)
3340 if (i
== COMPILED_BYTECODE
)
3342 if (!STRINGP (item
))
3343 error ("Invalid byte code");
3345 /* Delay handling the bytecode slot until we know whether
3346 it is lazily-loaded (we can tell by whether the
3347 constants slot is nil). */
3348 ptr
[COMPILED_CONSTANTS
] = item
;
3351 else if (i
== COMPILED_CONSTANTS
)
3353 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3357 /* Coerce string to unibyte (like string-as-unibyte,
3358 but without generating extra garbage and
3359 guaranteeing no change in the contents). */
3360 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3361 STRING_SET_UNIBYTE (bytestr
);
3363 item
= Fread (Fcons (bytestr
, readcharfun
));
3365 error ("Invalid byte code");
3367 otem
= XCONS (item
);
3368 bytestr
= XCAR (item
);
3373 /* Now handle the bytecode slot. */
3374 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3376 else if (i
== COMPILED_DOC_STRING
3378 && ! STRING_MULTIBYTE (item
))
3380 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3381 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3383 item
= Fstring_as_multibyte (item
);
3386 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3394 /* FLAG = 1 means check for ] to terminate rather than ) and .
3395 FLAG = -1 means check for starting with defun
3396 and make structure pure. */
3399 read_list (int flag
, register Lisp_Object readcharfun
)
3401 /* -1 means check next element for defun,
3402 0 means don't check,
3403 1 means already checked and found defun. */
3404 int defunflag
= flag
< 0 ? -1 : 0;
3405 Lisp_Object val
, tail
;
3406 register Lisp_Object elt
, tem
;
3407 struct gcpro gcpro1
, gcpro2
;
3408 /* 0 is the normal case.
3409 1 means this list is a doc reference; replace it with the number 0.
3410 2 means this list is a doc reference; replace it with the doc string. */
3411 int doc_reference
= 0;
3413 /* Initialize this to 1 if we are reading a list. */
3414 int first_in_list
= flag
<= 0;
3423 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3428 /* While building, if the list starts with #$, treat it specially. */
3429 if (EQ (elt
, Vload_file_name
)
3431 && !NILP (Vpurify_flag
))
3433 if (NILP (Vdoc_file_name
))
3434 /* We have not yet called Snarf-documentation, so assume
3435 this file is described in the DOC-MM.NN file
3436 and Snarf-documentation will fill in the right value later.
3437 For now, replace the whole list with 0. */
3440 /* We have already called Snarf-documentation, so make a relative
3441 file name for this file, so it can be found properly
3442 in the installed Lisp directory.
3443 We don't use Fexpand_file_name because that would make
3444 the directory absolute now. */
3445 elt
= concat2 (build_string ("../lisp/"),
3446 Ffile_name_nondirectory (elt
));
3448 else if (EQ (elt
, Vload_file_name
)
3450 && load_force_doc_strings
)
3459 invalid_syntax (") or . in a vector", 18);
3467 XSETCDR (tail
, read0 (readcharfun
));
3469 val
= read0 (readcharfun
);
3470 read1 (readcharfun
, &ch
, 0);
3474 if (doc_reference
== 1)
3475 return make_number (0);
3476 if (doc_reference
== 2)
3478 /* Get a doc string from the file we are loading.
3479 If it's in saved_doc_string, get it from there.
3481 Here, we don't know if the string is a
3482 bytecode string or a doc string. As a
3483 bytecode string must be unibyte, we always
3484 return a unibyte string. If it is actually a
3485 doc string, caller must make it
3488 int pos
= XINT (XCDR (val
));
3489 /* Position is negative for user variables. */
3490 if (pos
< 0) pos
= -pos
;
3491 if (pos
>= saved_doc_string_position
3492 && pos
< (saved_doc_string_position
3493 + saved_doc_string_length
))
3495 int start
= pos
- saved_doc_string_position
;
3498 /* Process quoting with ^A,
3499 and find the end of the string,
3500 which is marked with ^_ (037). */
3501 for (from
= start
, to
= start
;
3502 saved_doc_string
[from
] != 037;)
3504 int c
= saved_doc_string
[from
++];
3507 c
= saved_doc_string
[from
++];
3509 saved_doc_string
[to
++] = c
;
3511 saved_doc_string
[to
++] = 0;
3513 saved_doc_string
[to
++] = 037;
3516 saved_doc_string
[to
++] = c
;
3519 return make_unibyte_string (saved_doc_string
+ start
,
3522 /* Look in prev_saved_doc_string the same way. */
3523 else if (pos
>= prev_saved_doc_string_position
3524 && pos
< (prev_saved_doc_string_position
3525 + prev_saved_doc_string_length
))
3527 int start
= pos
- prev_saved_doc_string_position
;
3530 /* Process quoting with ^A,
3531 and find the end of the string,
3532 which is marked with ^_ (037). */
3533 for (from
= start
, to
= start
;
3534 prev_saved_doc_string
[from
] != 037;)
3536 int c
= prev_saved_doc_string
[from
++];
3539 c
= prev_saved_doc_string
[from
++];
3541 prev_saved_doc_string
[to
++] = c
;
3543 prev_saved_doc_string
[to
++] = 0;
3545 prev_saved_doc_string
[to
++] = 037;
3548 prev_saved_doc_string
[to
++] = c
;
3551 return make_unibyte_string (prev_saved_doc_string
3556 return get_doc_string (val
, 1, 0);
3561 invalid_syntax (". in wrong context", 18);
3563 invalid_syntax ("] in a list", 11);
3565 tem
= (read_pure
&& flag
<= 0
3566 ? pure_cons (elt
, Qnil
)
3567 : Fcons (elt
, Qnil
));
3569 XSETCDR (tail
, tem
);
3574 defunflag
= EQ (elt
, Qdefun
);
3575 else if (defunflag
> 0)
3580 Lisp_Object initial_obarray
;
3582 /* oblookup stores the bucket number here, for the sake of Funintern. */
3584 int oblookup_last_bucket_number
;
3586 static int hash_string (const char *ptr
, int len
);
3588 /* Get an error if OBARRAY is not an obarray.
3589 If it is one, return it. */
3592 check_obarray (Lisp_Object obarray
)
3594 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3596 /* If Vobarray is now invalid, force it to be valid. */
3597 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3598 wrong_type_argument (Qvectorp
, obarray
);
3603 /* Intern the C string STR: return a symbol with that name,
3604 interned in the current obarray. */
3607 intern (const char *str
)
3610 int len
= strlen (str
);
3611 Lisp_Object obarray
;
3614 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3615 obarray
= check_obarray (obarray
);
3616 tem
= oblookup (obarray
, str
, len
, len
);
3619 return Fintern (make_string (str
, len
), obarray
);
3623 intern_c_string (const char *str
)
3626 int len
= strlen (str
);
3627 Lisp_Object obarray
;
3630 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3631 obarray
= check_obarray (obarray
);
3632 tem
= oblookup (obarray
, str
, len
, len
);
3636 if (NILP (Vpurify_flag
))
3637 /* Creating a non-pure string from a string literal not
3638 implemented yet. We could just use make_string here and live
3639 with the extra copy. */
3642 return Fintern (make_pure_c_string (str
), obarray
);
3645 /* Create an uninterned symbol with name STR. */
3648 make_symbol (const char *str
)
3650 int len
= strlen (str
);
3652 return Fmake_symbol (!NILP (Vpurify_flag
)
3653 ? make_pure_string (str
, len
, len
, 0)
3654 : make_string (str
, len
));
3657 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3658 doc
: /* Return the canonical symbol whose name is STRING.
3659 If there is none, one is created by this function and returned.
3660 A second optional argument specifies the obarray to use;
3661 it defaults to the value of `obarray'. */)
3662 (Lisp_Object string
, Lisp_Object obarray
)
3664 register Lisp_Object tem
, sym
, *ptr
;
3666 if (NILP (obarray
)) obarray
= Vobarray
;
3667 obarray
= check_obarray (obarray
);
3669 CHECK_STRING (string
);
3671 tem
= oblookup (obarray
, SSDATA (string
),
3674 if (!INTEGERP (tem
))
3677 if (!NILP (Vpurify_flag
))
3678 string
= Fpurecopy (string
);
3679 sym
= Fmake_symbol (string
);
3681 if (EQ (obarray
, initial_obarray
))
3682 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3684 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3686 if ((SREF (string
, 0) == ':')
3687 && EQ (obarray
, initial_obarray
))
3689 XSYMBOL (sym
)->constant
= 1;
3690 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3691 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3694 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3696 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3698 XSYMBOL (sym
)->next
= 0;
3703 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3704 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3705 NAME may be a string or a symbol. If it is a symbol, that exact
3706 symbol is searched for.
3707 A second optional argument specifies the obarray to use;
3708 it defaults to the value of `obarray'. */)
3709 (Lisp_Object name
, Lisp_Object obarray
)
3711 register Lisp_Object tem
, string
;
3713 if (NILP (obarray
)) obarray
= Vobarray
;
3714 obarray
= check_obarray (obarray
);
3716 if (!SYMBOLP (name
))
3718 CHECK_STRING (name
);
3722 string
= SYMBOL_NAME (name
);
3724 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3725 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3731 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3732 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3733 The value is t if a symbol was found and deleted, nil otherwise.
3734 NAME may be a string or a symbol. If it is a symbol, that symbol
3735 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3736 OBARRAY defaults to the value of the variable `obarray'. */)
3737 (Lisp_Object name
, Lisp_Object obarray
)
3739 register Lisp_Object string
, tem
;
3742 if (NILP (obarray
)) obarray
= Vobarray
;
3743 obarray
= check_obarray (obarray
);
3746 string
= SYMBOL_NAME (name
);
3749 CHECK_STRING (name
);
3753 tem
= oblookup (obarray
, SSDATA (string
),
3758 /* If arg was a symbol, don't delete anything but that symbol itself. */
3759 if (SYMBOLP (name
) && !EQ (name
, tem
))
3762 /* There are plenty of other symbols which will screw up the Emacs
3763 session if we unintern them, as well as even more ways to use
3764 `setq' or `fset' or whatnot to make the Emacs session
3765 unusable. Let's not go down this silly road. --Stef */
3766 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3767 error ("Attempt to unintern t or nil"); */
3769 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3771 hash
= oblookup_last_bucket_number
;
3773 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3775 if (XSYMBOL (tem
)->next
)
3776 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3778 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3782 Lisp_Object tail
, following
;
3784 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3785 XSYMBOL (tail
)->next
;
3788 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3789 if (EQ (following
, tem
))
3791 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3800 /* Return the symbol in OBARRAY whose names matches the string
3801 of SIZE characters (SIZE_BYTE bytes) at PTR.
3802 If there is no such symbol in OBARRAY, return nil.
3804 Also store the bucket number in oblookup_last_bucket_number. */
3807 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3811 register Lisp_Object tail
;
3812 Lisp_Object bucket
, tem
;
3814 if (!VECTORP (obarray
)
3815 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3817 obarray
= check_obarray (obarray
);
3818 obsize
= XVECTOR (obarray
)->size
;
3820 /* This is sometimes needed in the middle of GC. */
3821 obsize
&= ~ARRAY_MARK_FLAG
;
3822 hash
= hash_string (ptr
, size_byte
) % obsize
;
3823 bucket
= XVECTOR (obarray
)->contents
[hash
];
3824 oblookup_last_bucket_number
= hash
;
3825 if (EQ (bucket
, make_number (0)))
3827 else if (!SYMBOLP (bucket
))
3828 error ("Bad data in guts of obarray"); /* Like CADR error message */
3830 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3832 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3833 && SCHARS (SYMBOL_NAME (tail
)) == size
3834 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3836 else if (XSYMBOL (tail
)->next
== 0)
3839 XSETINT (tem
, hash
);
3844 hash_string (const char *ptr
, int len
)
3846 register const char *p
= ptr
;
3847 register const char *end
= p
+ len
;
3848 register unsigned char c
;
3849 register int hash
= 0;
3854 if (c
>= 0140) c
-= 40;
3855 hash
= ((hash
<<3) + (hash
>>28) + c
);
3857 return hash
& 07777777777;
3861 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3864 register Lisp_Object tail
;
3865 CHECK_VECTOR (obarray
);
3866 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3868 tail
= XVECTOR (obarray
)->contents
[i
];
3873 if (XSYMBOL (tail
)->next
== 0)
3875 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3881 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3883 call1 (function
, sym
);
3886 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3887 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3888 OBARRAY defaults to the value of `obarray'. */)
3889 (Lisp_Object function
, Lisp_Object obarray
)
3891 if (NILP (obarray
)) obarray
= Vobarray
;
3892 obarray
= check_obarray (obarray
);
3894 map_obarray (obarray
, mapatoms_1
, function
);
3898 #define OBARRAY_SIZE 1511
3903 Lisp_Object oblength
;
3905 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3907 Vobarray
= Fmake_vector (oblength
, make_number (0));
3908 initial_obarray
= Vobarray
;
3909 staticpro (&initial_obarray
);
3911 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3912 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3913 NILP (Vpurify_flag) check in intern_c_string. */
3914 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3915 Qnil
= intern_c_string ("nil");
3917 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3918 so those two need to be fixed manally. */
3919 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3920 XSYMBOL (Qunbound
)->function
= Qunbound
;
3921 XSYMBOL (Qunbound
)->plist
= Qnil
;
3922 /* XSYMBOL (Qnil)->function = Qunbound; */
3923 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3924 XSYMBOL (Qnil
)->constant
= 1;
3925 XSYMBOL (Qnil
)->plist
= Qnil
;
3927 Qt
= intern_c_string ("t");
3928 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3929 XSYMBOL (Qt
)->constant
= 1;
3931 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3934 Qvariable_documentation
= intern_c_string ("variable-documentation");
3935 staticpro (&Qvariable_documentation
);
3937 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3938 read_buffer
= (char *) xmalloc (read_buffer_size
);
3942 defsubr (struct Lisp_Subr
*sname
)
3945 sym
= intern_c_string (sname
->symbol_name
);
3946 XSETPVECTYPE (sname
, PVEC_SUBR
);
3947 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3950 #ifdef NOTDEF /* use fset in subr.el now */
3952 defalias (sname
, string
)
3953 struct Lisp_Subr
*sname
;
3957 sym
= intern (string
);
3958 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3962 /* Define an "integer variable"; a symbol whose value is forwarded to a
3963 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3964 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3966 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3967 const char *namestring
, EMACS_INT
*address
)
3970 sym
= intern_c_string (namestring
);
3971 i_fwd
->type
= Lisp_Fwd_Int
;
3972 i_fwd
->intvar
= address
;
3973 XSYMBOL (sym
)->declared_special
= 1;
3974 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3975 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3978 /* Similar but define a variable whose value is t if address contains 1,
3979 nil if address contains 0. */
3981 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3982 const char *namestring
, int *address
)
3985 sym
= intern_c_string (namestring
);
3986 b_fwd
->type
= Lisp_Fwd_Bool
;
3987 b_fwd
->boolvar
= address
;
3988 XSYMBOL (sym
)->declared_special
= 1;
3989 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3990 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3991 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3994 /* Similar but define a variable whose value is the Lisp Object stored
3995 at address. Two versions: with and without gc-marking of the C
3996 variable. The nopro version is used when that variable will be
3997 gc-marked for some other reason, since marking the same slot twice
3998 can cause trouble with strings. */
4000 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4001 const char *namestring
, Lisp_Object
*address
)
4004 sym
= intern_c_string (namestring
);
4005 o_fwd
->type
= Lisp_Fwd_Obj
;
4006 o_fwd
->objvar
= address
;
4007 XSYMBOL (sym
)->declared_special
= 1;
4008 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4009 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4013 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4014 const char *namestring
, Lisp_Object
*address
)
4016 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4017 staticpro (address
);
4020 /* Similar but define a variable whose value is the Lisp Object stored
4021 at a particular offset in the current kboard object. */
4024 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4025 const char *namestring
, int offset
)
4028 sym
= intern_c_string (namestring
);
4029 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4030 ko_fwd
->offset
= offset
;
4031 XSYMBOL (sym
)->declared_special
= 1;
4032 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4033 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4036 /* Record the value of load-path used at the start of dumping
4037 so we can see if the site changed it later during dumping. */
4038 static Lisp_Object dump_path
;
4044 int turn_off_warning
= 0;
4046 /* Compute the default load-path. */
4048 normal
= PATH_LOADSEARCH
;
4049 Vload_path
= decode_env_path (0, normal
);
4051 if (NILP (Vpurify_flag
))
4052 normal
= PATH_LOADSEARCH
;
4054 normal
= PATH_DUMPLOADSEARCH
;
4056 /* In a dumped Emacs, we normally have to reset the value of
4057 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4058 uses ../lisp, instead of the path of the installed elisp
4059 libraries. However, if it appears that Vload_path was changed
4060 from the default before dumping, don't override that value. */
4063 if (! NILP (Fequal (dump_path
, Vload_path
)))
4065 Vload_path
= decode_env_path (0, normal
);
4066 if (!NILP (Vinstallation_directory
))
4068 Lisp_Object tem
, tem1
, sitelisp
;
4070 /* Remove site-lisp dirs from path temporarily and store
4071 them in sitelisp, then conc them on at the end so
4072 they're always first in path. */
4076 tem
= Fcar (Vload_path
);
4077 tem1
= Fstring_match (build_string ("site-lisp"),
4081 Vload_path
= Fcdr (Vload_path
);
4082 sitelisp
= Fcons (tem
, sitelisp
);
4088 /* Add to the path the lisp subdir of the
4089 installation dir, if it exists. */
4090 tem
= Fexpand_file_name (build_string ("lisp"),
4091 Vinstallation_directory
);
4092 tem1
= Ffile_exists_p (tem
);
4095 if (NILP (Fmember (tem
, Vload_path
)))
4097 turn_off_warning
= 1;
4098 Vload_path
= Fcons (tem
, Vload_path
);
4102 /* That dir doesn't exist, so add the build-time
4103 Lisp dirs instead. */
4104 Vload_path
= nconc2 (Vload_path
, dump_path
);
4106 /* Add leim under the installation dir, if it exists. */
4107 tem
= Fexpand_file_name (build_string ("leim"),
4108 Vinstallation_directory
);
4109 tem1
= Ffile_exists_p (tem
);
4112 if (NILP (Fmember (tem
, Vload_path
)))
4113 Vload_path
= Fcons (tem
, Vload_path
);
4116 /* Add site-lisp under the installation dir, if it exists. */
4117 tem
= Fexpand_file_name (build_string ("site-lisp"),
4118 Vinstallation_directory
);
4119 tem1
= Ffile_exists_p (tem
);
4122 if (NILP (Fmember (tem
, Vload_path
)))
4123 Vload_path
= Fcons (tem
, Vload_path
);
4126 /* If Emacs was not built in the source directory,
4127 and it is run from where it was built, add to load-path
4128 the lisp, leim and site-lisp dirs under that directory. */
4130 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4134 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4135 Vinstallation_directory
);
4136 tem1
= Ffile_exists_p (tem
);
4138 /* Don't be fooled if they moved the entire source tree
4139 AFTER dumping Emacs. If the build directory is indeed
4140 different from the source dir, src/Makefile.in and
4141 src/Makefile will not be found together. */
4142 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4143 Vinstallation_directory
);
4144 tem2
= Ffile_exists_p (tem
);
4145 if (!NILP (tem1
) && NILP (tem2
))
4147 tem
= Fexpand_file_name (build_string ("lisp"),
4150 if (NILP (Fmember (tem
, Vload_path
)))
4151 Vload_path
= Fcons (tem
, Vload_path
);
4153 tem
= Fexpand_file_name (build_string ("leim"),
4156 if (NILP (Fmember (tem
, Vload_path
)))
4157 Vload_path
= Fcons (tem
, Vload_path
);
4159 tem
= Fexpand_file_name (build_string ("site-lisp"),
4162 if (NILP (Fmember (tem
, Vload_path
)))
4163 Vload_path
= Fcons (tem
, Vload_path
);
4166 if (!NILP (sitelisp
) && !no_site_lisp
)
4167 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4173 /* NORMAL refers to the lisp dir in the source directory. */
4174 /* We used to add ../lisp at the front here, but
4175 that caused trouble because it was copied from dump_path
4176 into Vload_path, above, when Vinstallation_directory was non-nil.
4177 It should be unnecessary. */
4178 Vload_path
= decode_env_path (0, normal
);
4179 dump_path
= Vload_path
;
4183 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4184 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4185 almost never correct, thereby causing a warning to be printed out that
4186 confuses users. Since PATH_LOADSEARCH is always overridden by the
4187 EMACSLOADPATH environment variable below, disable the warning on NT. */
4189 /* Warn if dirs in the *standard* path don't exist. */
4190 if (!turn_off_warning
)
4192 Lisp_Object path_tail
;
4194 for (path_tail
= Vload_path
;
4196 path_tail
= XCDR (path_tail
))
4198 Lisp_Object dirfile
;
4199 dirfile
= Fcar (path_tail
);
4200 if (STRINGP (dirfile
))
4202 dirfile
= Fdirectory_file_name (dirfile
);
4203 if (access (SSDATA (dirfile
), 0) < 0)
4204 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4209 #endif /* !(WINDOWSNT || HAVE_NS) */
4211 /* If the EMACSLOADPATH environment variable is set, use its value.
4212 This doesn't apply if we're dumping. */
4214 if (NILP (Vpurify_flag
)
4215 && egetenv ("EMACSLOADPATH"))
4217 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4221 load_in_progress
= 0;
4222 Vload_file_name
= Qnil
;
4224 load_descriptor_list
= Qnil
;
4226 Vstandard_input
= Qt
;
4227 Vloads_in_progress
= Qnil
;
4230 /* Print a warning, using format string FORMAT, that directory DIRNAME
4231 does not exist. Print it on stderr and put it in *Messages*. */
4234 dir_warning (const char *format
, Lisp_Object dirname
)
4237 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4239 fprintf (stderr
, format
, SDATA (dirname
));
4240 sprintf (buffer
, format
, SDATA (dirname
));
4241 /* Don't log the warning before we've initialized!! */
4243 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4247 syms_of_lread (void)
4250 defsubr (&Sread_from_string
);
4252 defsubr (&Sintern_soft
);
4253 defsubr (&Sunintern
);
4254 defsubr (&Sget_load_suffixes
);
4256 defsubr (&Seval_buffer
);
4257 defsubr (&Seval_region
);
4258 defsubr (&Sread_char
);
4259 defsubr (&Sread_char_exclusive
);
4260 defsubr (&Sread_event
);
4261 defsubr (&Sget_file_char
);
4262 defsubr (&Smapatoms
);
4263 defsubr (&Slocate_file_internal
);
4265 DEFVAR_LISP ("obarray", Vobarray
,
4266 doc
: /* Symbol table for use by `intern' and `read'.
4267 It is a vector whose length ought to be prime for best results.
4268 The vector's contents don't make sense if examined from Lisp programs;
4269 to find all the symbols in an obarray, use `mapatoms'. */);
4271 DEFVAR_LISP ("values", Vvalues
,
4272 doc
: /* List of values of all expressions which were read, evaluated and printed.
4273 Order is reverse chronological. */);
4275 DEFVAR_LISP ("standard-input", Vstandard_input
,
4276 doc
: /* Stream for read to get input from.
4277 See documentation of `read' for possible values. */);
4278 Vstandard_input
= Qt
;
4280 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4281 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4283 If this variable is a buffer, then only forms read from that buffer
4284 will be added to `read-symbol-positions-list'.
4285 If this variable is t, then all read forms will be added.
4286 The effect of all other values other than nil are not currently
4287 defined, although they may be in the future.
4289 The positions are relative to the last call to `read' or
4290 `read-from-string'. It is probably a bad idea to set this variable at
4291 the toplevel; bind it instead. */);
4292 Vread_with_symbol_positions
= Qnil
;
4294 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4295 doc
: /* A list mapping read symbols to their positions.
4296 This variable is modified during calls to `read' or
4297 `read-from-string', but only when `read-with-symbol-positions' is
4300 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4301 CHAR-POSITION is an integer giving the offset of that occurrence of the
4302 symbol from the position where `read' or `read-from-string' started.
4304 Note that a symbol will appear multiple times in this list, if it was
4305 read multiple times. The list is in the same order as the symbols
4307 Vread_symbol_positions_list
= Qnil
;
4309 DEFVAR_LISP ("read-circle", Vread_circle
,
4310 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4313 DEFVAR_LISP ("load-path", Vload_path
,
4314 doc
: /* *List of directories to search for files to load.
4315 Each element is a string (directory name) or nil (try default directory).
4316 Initialized based on EMACSLOADPATH environment variable, if any,
4317 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4319 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4320 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4321 This list should not include the empty string.
4322 `load' and related functions try to append these suffixes, in order,
4323 to the specified file name if a Lisp suffix is allowed or required. */);
4324 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4325 Fcons (make_pure_c_string (".el"), Qnil
));
4326 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4327 doc
: /* List of suffixes that indicate representations of \
4329 This list should normally start with the empty string.
4331 Enabling Auto Compression mode appends the suffixes in
4332 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4333 mode removes them again. `load' and related functions use this list to
4334 determine whether they should look for compressed versions of a file
4335 and, if so, which suffixes they should try to append to the file name
4336 in order to do so. However, if you want to customize which suffixes
4337 the loading functions recognize as compression suffixes, you should
4338 customize `jka-compr-load-suffixes' rather than the present variable. */);
4339 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4341 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4342 doc
: /* Non-nil if inside of `load'. */);
4343 Qload_in_progress
= intern_c_string ("load-in-progress");
4344 staticpro (&Qload_in_progress
);
4346 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4347 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4348 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4350 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4351 a symbol \(a feature name).
4353 When `load' is run and the file-name argument matches an element's
4354 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4355 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4357 An error in FORMS does not undo the load, but does prevent execution of
4358 the rest of the FORMS. */);
4359 Vafter_load_alist
= Qnil
;
4361 DEFVAR_LISP ("load-history", Vload_history
,
4362 doc
: /* Alist mapping loaded file names to symbols and features.
4363 Each alist element should be a list (FILE-NAME ENTRIES...), where
4364 FILE-NAME is the name of a file that has been loaded into Emacs.
4365 The file name is absolute and true (i.e. it doesn't contain symlinks).
4366 As an exception, one of the alist elements may have FILE-NAME nil,
4367 for symbols and features not associated with any file.
4369 The remaining ENTRIES in the alist element describe the functions and
4370 variables defined in that file, the features provided, and the
4371 features required. Each entry has the form `(provide . FEATURE)',
4372 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4373 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4374 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4375 SYMBOL was an autoload before this file redefined it as a function.
4377 During preloading, the file name recorded is relative to the main Lisp
4378 directory. These file names are converted to absolute at startup. */);
4379 Vload_history
= Qnil
;
4381 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4382 doc
: /* Full name of file being loaded by `load'. */);
4383 Vload_file_name
= Qnil
;
4385 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4386 doc
: /* File name, including directory, of user's initialization file.
4387 If the file loaded had extension `.elc', and the corresponding source file
4388 exists, this variable contains the name of source file, suitable for use
4389 by functions like `custom-save-all' which edit the init file.
4390 While Emacs loads and evaluates the init file, value is the real name
4391 of the file, regardless of whether or not it has the `.elc' extension. */);
4392 Vuser_init_file
= Qnil
;
4394 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4395 doc
: /* Used for internal purposes by `load'. */);
4396 Vcurrent_load_list
= Qnil
;
4398 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4399 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4400 The default is nil, which means use the function `read'. */);
4401 Vload_read_function
= Qnil
;
4403 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4404 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4405 This function is for doing code conversion before reading the source file.
4406 If nil, loading is done without any code conversion.
4407 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4408 FULLNAME is the full name of FILE.
4409 See `load' for the meaning of the remaining arguments. */);
4410 Vload_source_file_function
= Qnil
;
4412 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4413 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4414 This is useful when the file being loaded is a temporary copy. */);
4415 load_force_doc_strings
= 0;
4417 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4418 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4419 This is normally bound by `load' and `eval-buffer' to control `read',
4420 and is not meant for users to change. */);
4421 load_convert_to_unibyte
= 0;
4423 DEFVAR_LISP ("source-directory", Vsource_directory
,
4424 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4425 You cannot count on them to still be there! */);
4427 = Fexpand_file_name (build_string ("../"),
4428 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4430 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4431 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4432 Vpreloaded_file_list
= Qnil
;
4434 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4435 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4436 Vbyte_boolean_vars
= Qnil
;
4438 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4439 doc
: /* Non-nil means load dangerous compiled Lisp files.
4440 Some versions of XEmacs use different byte codes than Emacs. These
4441 incompatible byte codes can make Emacs crash when it tries to execute
4443 load_dangerous_libraries
= 0;
4445 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4446 doc
: /* Non-nil means force printing messages when loading Lisp files.
4447 This overrides the value of the NOMESSAGE argument to `load'. */);
4448 force_load_messages
= 0;
4450 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4451 doc
: /* Regular expression matching safe to load compiled Lisp files.
4452 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4453 from the file, and matches them against this regular expression.
4454 When the regular expression matches, the file is considered to be safe
4455 to load. See also `load-dangerous-libraries'. */);
4456 Vbytecomp_version_regexp
4457 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4459 Qlexical_binding
= intern ("lexical-binding");
4460 staticpro (&Qlexical_binding
);
4461 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4462 doc
: /* If non-nil, use lexical binding when evaluating code.
4463 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4464 This variable is automatically set from the file variables of an interpreted
4465 Lisp file read using `load'. */);
4466 Fmake_variable_buffer_local (Qlexical_binding
);
4468 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4469 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4470 Veval_buffer_list
= Qnil
;
4472 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4473 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4474 Vold_style_backquotes
= Qnil
;
4475 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4476 staticpro (&Qold_style_backquotes
);
4478 /* Vsource_directory was initialized in init_lread. */
4480 load_descriptor_list
= Qnil
;
4481 staticpro (&load_descriptor_list
);
4483 Qcurrent_load_list
= intern_c_string ("current-load-list");
4484 staticpro (&Qcurrent_load_list
);
4486 Qstandard_input
= intern_c_string ("standard-input");
4487 staticpro (&Qstandard_input
);
4489 Qread_char
= intern_c_string ("read-char");
4490 staticpro (&Qread_char
);
4492 Qget_file_char
= intern_c_string ("get-file-char");
4493 staticpro (&Qget_file_char
);
4495 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4496 staticpro (&Qget_emacs_mule_file_char
);
4498 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4499 staticpro (&Qload_force_doc_strings
);
4501 Qbackquote
= intern_c_string ("`");
4502 staticpro (&Qbackquote
);
4503 Qcomma
= intern_c_string (",");
4504 staticpro (&Qcomma
);
4505 Qcomma_at
= intern_c_string (",@");
4506 staticpro (&Qcomma_at
);
4507 Qcomma_dot
= intern_c_string (",.");
4508 staticpro (&Qcomma_dot
);
4510 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4511 staticpro (&Qinhibit_file_name_operation
);
4513 Qascii_character
= intern_c_string ("ascii-character");
4514 staticpro (&Qascii_character
);
4516 Qfunction
= intern_c_string ("function");
4517 staticpro (&Qfunction
);
4519 Qload
= intern_c_string ("load");
4522 Qload_file_name
= intern_c_string ("load-file-name");
4523 staticpro (&Qload_file_name
);
4525 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4526 staticpro (&Qeval_buffer_list
);
4528 Qfile_truename
= intern_c_string ("file-truename");
4529 staticpro (&Qfile_truename
) ;
4531 Qdir_ok
= intern_c_string ("dir-ok");
4532 staticpro (&Qdir_ok
);
4534 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4535 staticpro (&Qdo_after_load_evaluation
) ;
4537 staticpro (&dump_path
);
4539 staticpro (&read_objects
);
4540 read_objects
= Qnil
;
4541 staticpro (&seen_list
);
4544 Vloads_in_progress
= Qnil
;
4545 staticpro (&Vloads_in_progress
);
4547 Qhash_table
= intern_c_string ("hash-table");
4548 staticpro (&Qhash_table
);
4549 Qdata
= intern_c_string ("data");
4551 Qtest
= intern_c_string ("test");
4553 Qsize
= intern_c_string ("size");
4555 Qweakness
= intern_c_string ("weakness");
4556 staticpro (&Qweakness
);
4557 Qrehash_size
= intern_c_string ("rehash-size");
4558 staticpro (&Qrehash_size
);
4559 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4560 staticpro (&Qrehash_threshold
);