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 bytepos
= BUF_PT_BYTE (b
);
376 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
377 BUF_DEC_POS (b
, bytepos
);
381 BUF_PT_BYTE (b
) = 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], *var_end
, val
[100], *val_end
;
825 /* Read a variable name. */
826 while (ch
== ' ' || ch
== '\t')
830 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
832 if (var_end
< var
+ sizeof var
- 1)
834 UPDATE_BEG_END_STATE (ch
);
839 && (var_end
[-1] == ' ' || var_end
[-1] == '\t'))
845 /* Read a variable value. */
848 while (ch
== ' ' || ch
== '\t')
852 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
854 if (val_end
< val
+ sizeof val
- 1)
856 UPDATE_BEG_END_STATE (ch
);
860 /* The value was terminated by an end-marker, which
864 && (val_end
[-1] == ' ' || val_end
[-1] == '\t'))
868 if (strcmp (var
, "lexical-binding") == 0)
871 rv
= (strcmp (val
, "nil") != 0);
877 while (ch
!= '\n' && ch
!= EOF
)
885 /* Value is a version number of byte compiled code if the file
886 associated with file descriptor FD is a compiled Lisp file that's
887 safe to load. Only files compiled with Emacs are safe to load.
888 Files compiled with XEmacs can lead to a crash in Fbyte_code
889 because of an incompatible change in the byte compiler. */
892 safe_to_load_p (int fd
)
899 /* Read the first few bytes from the file, and look for a line
900 specifying the byte compiler version used. */
901 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
906 /* Skip to the next newline, skipping over the initial `ELC'
907 with NUL bytes following it, but note the version. */
908 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
913 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
920 lseek (fd
, 0, SEEK_SET
);
925 /* Callback for record_unwind_protect. Restore the old load list OLD,
926 after loading a file successfully. */
929 record_load_unwind (Lisp_Object old
)
931 return Vloads_in_progress
= old
;
934 /* This handler function is used via internal_condition_case_1. */
937 load_error_handler (Lisp_Object data
)
943 load_warn_old_style_backquotes (Lisp_Object file
)
945 if (!NILP (Vold_style_backquotes
))
948 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
955 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
956 doc
: /* Return the suffixes that `load' should try if a suffix is \
958 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
961 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
962 while (CONSP (suffixes
))
964 Lisp_Object exts
= Vload_file_rep_suffixes
;
965 suffix
= XCAR (suffixes
);
966 suffixes
= XCDR (suffixes
);
971 lst
= Fcons (concat2 (suffix
, ext
), lst
);
974 return Fnreverse (lst
);
977 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
978 doc
: /* Execute a file of Lisp code named FILE.
979 First try FILE with `.elc' appended, then try with `.el',
980 then try FILE unmodified (the exact suffixes in the exact order are
981 determined by `load-suffixes'). Environment variable references in
982 FILE are replaced with their values by calling `substitute-in-file-name'.
983 This function searches the directories in `load-path'.
985 If optional second arg NOERROR is non-nil,
986 report no error if FILE doesn't exist.
987 Print messages at start and end of loading unless
988 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
990 If optional fourth arg NOSUFFIX is non-nil, don't try adding
991 suffixes `.elc' or `.el' to the specified name FILE.
992 If optional fifth arg MUST-SUFFIX is non-nil, insist on
993 the suffix `.elc' or `.el'; don't accept just FILE unless
994 it ends in one of those suffixes or includes a directory name.
996 If this function fails to find a file, it may look for different
997 representations of that file before trying another file.
998 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
999 to the file name. Emacs uses this feature mainly to find compressed
1000 versions of files when Auto Compression mode is enabled.
1002 The exact suffixes that this function tries out, in the exact order,
1003 are given by the value of the variable `load-file-rep-suffixes' if
1004 NOSUFFIX is non-nil and by the return value of the function
1005 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1006 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1007 and then the former.
1009 Loading a file records its definitions, and its `provide' and
1010 `require' calls, in an element of `load-history' whose
1011 car is the file name loaded. See `load-history'.
1013 While the file is in the process of being loaded, the variable
1014 `load-in-progress' is non-nil and the variable `load-file-name'
1015 is bound to the file's name.
1017 Return t if the file exists and loads successfully. */)
1018 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1020 register FILE *stream
;
1021 register int fd
= -1;
1022 int count
= SPECPDL_INDEX ();
1023 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1024 Lisp_Object found
, efound
, hist_file_name
;
1025 /* 1 means we printed the ".el is newer" message. */
1027 /* 1 means we are loading a compiled file. */
1029 Lisp_Object handler
;
1031 const char *fmode
= "r";
1039 CHECK_STRING (file
);
1041 /* If file name is magic, call the handler. */
1042 /* This shouldn't be necessary any more now that `openp' handles it right.
1043 handler = Ffind_file_name_handler (file, Qload);
1044 if (!NILP (handler))
1045 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1047 /* Do this after the handler to avoid
1048 the need to gcpro noerror, nomessage and nosuffix.
1049 (Below here, we care only whether they are nil or not.)
1050 The presence of this call is the result of a historical accident:
1051 it used to be in every file-operation and when it got removed
1052 everywhere, it accidentally stayed here. Since then, enough people
1053 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1054 that it seemed risky to remove. */
1055 if (! NILP (noerror
))
1057 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1058 Qt
, load_error_handler
);
1063 file
= Fsubstitute_in_file_name (file
);
1066 /* Avoid weird lossage with null string as arg,
1067 since it would try to load a directory as a Lisp file */
1068 if (SCHARS (file
) > 0)
1070 int size
= SBYTES (file
);
1073 GCPRO2 (file
, found
);
1075 if (! NILP (must_suffix
))
1077 /* Don't insist on adding a suffix if FILE already ends with one. */
1079 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1082 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1084 /* Don't insist on adding a suffix
1085 if the argument includes a directory name. */
1086 else if (! NILP (Ffile_name_directory (file
)))
1090 fd
= openp (Vload_path
, file
,
1091 (!NILP (nosuffix
) ? Qnil
1092 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1093 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1094 tmp
[1] = Vload_file_rep_suffixes
,
1103 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1107 /* Tell startup.el whether or not we found the user's init file. */
1108 if (EQ (Qt
, Vuser_init_file
))
1109 Vuser_init_file
= found
;
1111 /* If FD is -2, that means openp found a magic file. */
1114 if (NILP (Fequal (found
, file
)))
1115 /* If FOUND is a different file name from FILE,
1116 find its handler even if we have already inhibited
1117 the `load' operation on FILE. */
1118 handler
= Ffind_file_name_handler (found
, Qt
);
1120 handler
= Ffind_file_name_handler (found
, Qload
);
1121 if (! NILP (handler
))
1122 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1125 /* Check if we're stuck in a recursive load cycle.
1127 2000-09-21: It's not possible to just check for the file loaded
1128 being a member of Vloads_in_progress. This fails because of the
1129 way the byte compiler currently works; `provide's are not
1130 evaluated, see font-lock.el/jit-lock.el as an example. This
1131 leads to a certain amount of ``normal'' recursion.
1133 Also, just loading a file recursively is not always an error in
1134 the general case; the second load may do something different. */
1138 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1139 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1143 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1145 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1146 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1149 /* All loads are by default dynamic, unless the file itself specifies
1150 otherwise using a file-variable in the first line. This is bound here
1151 so that it takes effect whether or not we use
1152 Vload_source_file_function. */
1153 specbind (Qlexical_binding
, Qnil
);
1155 /* Get the name for load-history. */
1156 hist_file_name
= (! NILP (Vpurify_flag
)
1157 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1158 tmp
[1] = Ffile_name_nondirectory (found
),
1164 /* Check for the presence of old-style quotes and warn about them. */
1165 specbind (Qold_style_backquotes
, Qnil
);
1166 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1168 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1169 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1170 /* Load .elc files directly, but not when they are
1171 remote and have no handler! */
1178 GCPRO3 (file
, found
, hist_file_name
);
1181 && ! (version
= safe_to_load_p (fd
)))
1184 if (!load_dangerous_libraries
)
1188 error ("File `%s' was not compiled in Emacs",
1191 else if (!NILP (nomessage
) && !force_load_messages
)
1192 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1197 efound
= ENCODE_FILE (found
);
1202 stat (SSDATA (efound
), &s1
);
1203 SSET (efound
, SBYTES (efound
) - 1, 0);
1204 result
= stat (SSDATA (efound
), &s2
);
1205 SSET (efound
, SBYTES (efound
) - 1, 'c');
1207 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1209 /* Make the progress messages mention that source is newer. */
1212 /* If we won't print another message, mention this anyway. */
1213 if (!NILP (nomessage
) && !force_load_messages
)
1215 Lisp_Object msg_file
;
1216 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1217 message_with_string ("Source file `%s' newer than byte-compiled file",
1226 /* We are loading a source file (*.el). */
1227 if (!NILP (Vload_source_file_function
))
1233 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1234 NILP (noerror
) ? Qnil
: Qt
,
1235 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1236 return unbind_to (count
, val
);
1240 GCPRO3 (file
, found
, hist_file_name
);
1244 efound
= ENCODE_FILE (found
);
1245 stream
= fopen (SSDATA (efound
), fmode
);
1246 #else /* not WINDOWSNT */
1247 stream
= fdopen (fd
, fmode
);
1248 #endif /* not WINDOWSNT */
1252 error ("Failure to create stdio stream for %s", SDATA (file
));
1255 if (! NILP (Vpurify_flag
))
1256 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1258 if (NILP (nomessage
) || force_load_messages
)
1261 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1264 message_with_string ("Loading %s (source)...", file
, 1);
1266 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1268 else /* The typical case; compiled file newer than source file. */
1269 message_with_string ("Loading %s...", file
, 1);
1272 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1273 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1274 specbind (Qload_file_name
, found
);
1275 specbind (Qinhibit_file_name_operation
, Qnil
);
1276 load_descriptor_list
1277 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1279 specbind (Qload_in_progress
, Qt
);
1282 if (lisp_file_lexically_bound_p (Qget_file_char
))
1283 Fset (Qlexical_binding
, Qt
);
1285 if (! version
|| version
>= 22)
1286 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1287 0, Qnil
, Qnil
, Qnil
, Qnil
);
1290 /* We can't handle a file which was compiled with
1291 byte-compile-dynamic by older version of Emacs. */
1292 specbind (Qload_force_doc_strings
, Qt
);
1293 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1294 0, Qnil
, Qnil
, Qnil
, Qnil
);
1296 unbind_to (count
, Qnil
);
1298 /* Run any eval-after-load forms for this file */
1299 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1300 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1304 xfree (saved_doc_string
);
1305 saved_doc_string
= 0;
1306 saved_doc_string_size
= 0;
1308 xfree (prev_saved_doc_string
);
1309 prev_saved_doc_string
= 0;
1310 prev_saved_doc_string_size
= 0;
1312 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1315 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1318 message_with_string ("Loading %s (source)...done", file
, 1);
1320 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1322 else /* The typical case; compiled file newer than source file. */
1323 message_with_string ("Loading %s...done", file
, 1);
1330 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1332 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1343 load_descriptor_unwind (Lisp_Object oldlist
)
1345 load_descriptor_list
= oldlist
;
1349 /* Close all descriptors in use for Floads.
1350 This is used when starting a subprocess. */
1353 close_load_descs (void)
1357 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1358 emacs_close (XFASTINT (XCAR (tail
)));
1363 complete_filename_p (Lisp_Object pathname
)
1365 register const unsigned char *s
= SDATA (pathname
);
1366 return (IS_DIRECTORY_SEP (s
[0])
1367 || (SCHARS (pathname
) > 2
1368 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1371 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1372 doc
: /* Search for FILENAME through PATH.
1373 Returns the file's name in absolute form, or nil if not found.
1374 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1375 file name when searching.
1376 If non-nil, PREDICATE is used instead of `file-readable-p'.
1377 PREDICATE can also be an integer to pass to the access(2) function,
1378 in which case file-name-handlers are ignored.
1379 This function will normally skip directories, so if you want it to find
1380 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1381 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1384 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1385 if (NILP (predicate
) && fd
> 0)
1390 static Lisp_Object Qdir_ok
;
1392 /* Search for a file whose name is STR, looking in directories
1393 in the Lisp list PATH, and trying suffixes from SUFFIX.
1394 On success, returns a file descriptor. On failure, returns -1.
1396 SUFFIXES is a list of strings containing possible suffixes.
1397 The empty suffix is automatically added if the list is empty.
1399 PREDICATE non-nil means don't open the files,
1400 just look for one that satisfies the predicate. In this case,
1401 returns 1 on success. The predicate can be a lisp function or
1402 an integer to pass to `access' (in which case file-name-handlers
1405 If STOREPTR is nonzero, it points to a slot where the name of
1406 the file actually found should be stored as a Lisp string.
1407 nil is stored there on failure.
1409 If the file we find is remote, return -2
1410 but store the found remote file name in *STOREPTR. */
1413 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1418 register char *fn
= buf
;
1421 Lisp_Object filename
;
1423 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1424 Lisp_Object string
, tail
, encoded_fn
;
1425 int max_suffix_len
= 0;
1429 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1431 CHECK_STRING_CAR (tail
);
1432 max_suffix_len
= max (max_suffix_len
,
1433 SBYTES (XCAR (tail
)));
1436 string
= filename
= encoded_fn
= Qnil
;
1437 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1442 if (complete_filename_p (str
))
1445 for (; CONSP (path
); path
= XCDR (path
))
1447 filename
= Fexpand_file_name (str
, XCAR (path
));
1448 if (!complete_filename_p (filename
))
1449 /* If there are non-absolute elts in PATH (eg ".") */
1450 /* Of course, this could conceivably lose if luser sets
1451 default-directory to be something non-absolute... */
1453 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1454 if (!complete_filename_p (filename
))
1455 /* Give up on this path element! */
1459 /* Calculate maximum size of any filename made from
1460 this path element/specified file name and any possible suffix. */
1461 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1462 if (fn_size
< want_size
)
1463 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1465 /* Loop over suffixes. */
1466 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1467 CONSP (tail
); tail
= XCDR (tail
))
1469 int lsuffix
= SBYTES (XCAR (tail
));
1470 Lisp_Object handler
;
1473 /* Concatenate path element/specified name with the suffix.
1474 If the directory starts with /:, remove that. */
1475 if (SCHARS (filename
) > 2
1476 && SREF (filename
, 0) == '/'
1477 && SREF (filename
, 1) == ':')
1479 strncpy (fn
, SSDATA (filename
) + 2,
1480 SBYTES (filename
) - 2);
1481 fn
[SBYTES (filename
) - 2] = 0;
1485 strncpy (fn
, SSDATA (filename
),
1487 fn
[SBYTES (filename
)] = 0;
1490 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1491 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1493 /* Check that the file exists and is not a directory. */
1494 /* We used to only check for handlers on non-absolute file names:
1498 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1499 It's not clear why that was the case and it breaks things like
1500 (load "/bar.el") where the file is actually "/bar.el.gz". */
1501 string
= build_string (fn
);
1502 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1503 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1505 if (NILP (predicate
))
1506 exists
= !NILP (Ffile_readable_p (string
));
1509 Lisp_Object tmp
= call1 (predicate
, string
);
1510 exists
= !NILP (tmp
)
1511 && (EQ (tmp
, Qdir_ok
)
1512 || !NILP (Ffile_directory_p (string
)));
1517 /* We succeeded; return this descriptor and filename. */
1528 encoded_fn
= ENCODE_FILE (string
);
1529 pfn
= SSDATA (encoded_fn
);
1530 exists
= (stat (pfn
, &st
) >= 0
1531 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1534 /* Check that we can access or open it. */
1535 if (NATNUMP (predicate
))
1536 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1538 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1542 /* We succeeded; return this descriptor and filename. */
1560 /* Merge the list we've accumulated of globals from the current input source
1561 into the load_history variable. The details depend on whether
1562 the source has an associated file name or not.
1564 FILENAME is the file name that we are loading from.
1565 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1568 build_load_history (Lisp_Object filename
, int entire
)
1570 register Lisp_Object tail
, prev
, newelt
;
1571 register Lisp_Object tem
, tem2
;
1572 register int foundit
= 0;
1574 tail
= Vload_history
;
1577 while (CONSP (tail
))
1581 /* Find the feature's previous assoc list... */
1582 if (!NILP (Fequal (filename
, Fcar (tem
))))
1586 /* If we're loading the entire file, remove old data. */
1590 Vload_history
= XCDR (tail
);
1592 Fsetcdr (prev
, XCDR (tail
));
1595 /* Otherwise, cons on new symbols that are not already members. */
1598 tem2
= Vcurrent_load_list
;
1600 while (CONSP (tem2
))
1602 newelt
= XCAR (tem2
);
1604 if (NILP (Fmember (newelt
, tem
)))
1605 Fsetcar (tail
, Fcons (XCAR (tem
),
1606 Fcons (newelt
, XCDR (tem
))));
1619 /* If we're loading an entire file, cons the new assoc onto the
1620 front of load-history, the most-recently-loaded position. Also
1621 do this if we didn't find an existing member for the file. */
1622 if (entire
|| !foundit
)
1623 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1628 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1635 readevalloop_1 (Lisp_Object old
)
1637 load_convert_to_unibyte
= ! NILP (old
);
1641 /* Signal an `end-of-file' error, if possible with file name
1645 end_of_file_error (void)
1647 if (STRINGP (Vload_file_name
))
1648 xsignal1 (Qend_of_file
, Vload_file_name
);
1650 xsignal0 (Qend_of_file
);
1653 /* UNIBYTE specifies how to set load_convert_to_unibyte
1654 for this invocation.
1655 READFUN, if non-nil, is used instead of `read'.
1657 START, END specify region to read in current buffer (from eval-region).
1658 If the input is not from a buffer, they must be nil. */
1661 readevalloop (Lisp_Object readcharfun
,
1663 Lisp_Object sourcename
,
1665 Lisp_Object unibyte
, Lisp_Object readfun
,
1666 Lisp_Object start
, Lisp_Object end
)
1669 register Lisp_Object val
;
1670 int count
= SPECPDL_INDEX ();
1671 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1672 struct buffer
*b
= 0;
1673 int continue_reading_p
;
1674 Lisp_Object lex_bound
;
1675 /* Nonzero if reading an entire buffer. */
1676 int whole_buffer
= 0;
1677 /* 1 on the first time around. */
1680 if (MARKERP (readcharfun
))
1683 start
= readcharfun
;
1686 if (BUFFERP (readcharfun
))
1687 b
= XBUFFER (readcharfun
);
1688 else if (MARKERP (readcharfun
))
1689 b
= XMARKER (readcharfun
)->buffer
;
1691 /* We assume START is nil when input is not from a buffer. */
1692 if (! NILP (start
) && !b
)
1695 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1696 specbind (Qcurrent_load_list
, Qnil
);
1697 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1698 load_convert_to_unibyte
= !NILP (unibyte
);
1700 /* If lexical binding is active (either because it was specified in
1701 the file's header, or via a buffer-local variable), create an empty
1702 lexical environment, otherwise, turn off lexical binding. */
1703 lex_bound
= find_symbol_value (Qlexical_binding
);
1704 specbind (Qinternal_interpreter_environment
,
1705 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1706 ? Qnil
: Fcons (Qt
, Qnil
));
1708 GCPRO4 (sourcename
, readfun
, start
, end
);
1710 /* Try to ensure sourcename is a truename, except whilst preloading. */
1711 if (NILP (Vpurify_flag
)
1712 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1713 && !NILP (Ffboundp (Qfile_truename
)))
1714 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1716 LOADHIST_ATTACH (sourcename
);
1718 continue_reading_p
= 1;
1719 while (continue_reading_p
)
1721 int count1
= SPECPDL_INDEX ();
1723 if (b
!= 0 && NILP (BVAR (b
, name
)))
1724 error ("Reading from killed buffer");
1728 /* Switch to the buffer we are reading from. */
1729 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1730 set_buffer_internal (b
);
1732 /* Save point in it. */
1733 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1734 /* Save ZV in it. */
1735 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1736 /* Those get unbound after we read one expression. */
1738 /* Set point and ZV around stuff to be read. */
1741 Fnarrow_to_region (make_number (BEGV
), end
);
1743 /* Just for cleanliness, convert END to a marker
1744 if it is an integer. */
1746 end
= Fpoint_max_marker ();
1749 /* On the first cycle, we can easily test here
1750 whether we are reading the whole buffer. */
1751 if (b
&& first_sexp
)
1752 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1759 while ((c
= READCHAR
) != '\n' && c
!= -1);
1764 unbind_to (count1
, Qnil
);
1768 /* Ignore whitespace here, so we can detect eof. */
1769 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1770 || c
== 0x8a0) /* NBSP */
1773 if (!NILP (Vpurify_flag
) && c
== '(')
1775 record_unwind_protect (unreadpure
, Qnil
);
1776 val
= read_list (-1, readcharfun
);
1781 read_objects
= Qnil
;
1782 if (!NILP (readfun
))
1784 val
= call1 (readfun
, readcharfun
);
1786 /* If READCHARFUN has set point to ZV, we should
1787 stop reading, even if the form read sets point
1788 to a different value when evaluated. */
1789 if (BUFFERP (readcharfun
))
1791 struct buffer
*b
= XBUFFER (readcharfun
);
1792 if (BUF_PT (b
) == BUF_ZV (b
))
1793 continue_reading_p
= 0;
1796 else if (! NILP (Vload_read_function
))
1797 val
= call1 (Vload_read_function
, readcharfun
);
1799 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1802 if (!NILP (start
) && continue_reading_p
)
1803 start
= Fpoint_marker ();
1805 /* Restore saved point and BEGV. */
1806 unbind_to (count1
, Qnil
);
1808 /* Now eval what we just read. */
1809 val
= eval_sub (val
);
1813 Vvalues
= Fcons (val
, Vvalues
);
1814 if (EQ (Vstandard_output
, Qt
))
1823 build_load_history (sourcename
,
1824 stream
|| whole_buffer
);
1828 unbind_to (count
, Qnil
);
1831 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1832 doc
: /* Execute the current buffer as Lisp code.
1833 When called from a Lisp program (i.e., not interactively), this
1834 function accepts up to five optional arguments:
1835 BUFFER is the buffer to evaluate (nil means use current buffer).
1836 PRINTFLAG controls printing of output:
1837 A value of nil means discard it; anything else is stream for print.
1838 FILENAME specifies the file name to use for `load-history'.
1839 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1841 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1842 functions should work normally even if PRINTFLAG is nil.
1844 This function preserves the position of point. */)
1845 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1847 int count
= SPECPDL_INDEX ();
1848 Lisp_Object tem
, buf
;
1851 buf
= Fcurrent_buffer ();
1853 buf
= Fget_buffer (buffer
);
1855 error ("No such buffer");
1857 if (NILP (printflag
) && NILP (do_allow_print
))
1862 if (NILP (filename
))
1863 filename
= BVAR (XBUFFER (buf
), filename
);
1865 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1866 specbind (Qstandard_output
, tem
);
1867 specbind (Qlexical_binding
, Qnil
);
1868 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1869 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1870 if (lisp_file_lexically_bound_p (buf
))
1871 Fset (Qlexical_binding
, Qt
);
1872 readevalloop (buf
, 0, filename
,
1873 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1874 unbind_to (count
, Qnil
);
1879 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1880 doc
: /* Execute the region as Lisp code.
1881 When called from programs, expects two arguments,
1882 giving starting and ending indices in the current buffer
1883 of the text to be executed.
1884 Programs can pass third argument PRINTFLAG which controls output:
1885 A value of nil means discard it; anything else is stream for printing it.
1886 Also the fourth argument READ-FUNCTION, if non-nil, is used
1887 instead of `read' to read each expression. It gets one argument
1888 which is the input stream for reading characters.
1890 This function does not move point. */)
1891 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1893 int count
= SPECPDL_INDEX ();
1894 Lisp_Object tem
, cbuf
;
1896 cbuf
= Fcurrent_buffer ();
1898 if (NILP (printflag
))
1902 specbind (Qstandard_output
, tem
);
1903 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1905 /* readevalloop calls functions which check the type of start and end. */
1906 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1907 !NILP (printflag
), Qnil
, read_function
,
1910 return unbind_to (count
, Qnil
);
1914 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1915 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1916 If STREAM is nil, use the value of `standard-input' (which see).
1917 STREAM or the value of `standard-input' may be:
1918 a buffer (read from point and advance it)
1919 a marker (read from where it points and advance it)
1920 a function (call it with no arguments for each character,
1921 call it with a char as argument to push a char back)
1922 a string (takes text from string, starting at the beginning)
1923 t (read text line using minibuffer and use it, or read from
1924 standard input in batch mode). */)
1925 (Lisp_Object stream
)
1928 stream
= Vstandard_input
;
1929 if (EQ (stream
, Qt
))
1930 stream
= Qread_char
;
1931 if (EQ (stream
, Qread_char
))
1932 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1934 return read_internal_start (stream
, Qnil
, Qnil
);
1937 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1938 doc
: /* Read one Lisp expression which is represented as text by STRING.
1939 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1940 START and END optionally delimit a substring of STRING from which to read;
1941 they default to 0 and (length STRING) respectively. */)
1942 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1945 CHECK_STRING (string
);
1946 /* read_internal_start sets read_from_string_index. */
1947 ret
= read_internal_start (string
, start
, end
);
1948 return Fcons (ret
, make_number (read_from_string_index
));
1951 /* Function to set up the global context we need in toplevel read
1954 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1955 /* start, end only used when stream is a string. */
1960 new_backquote_flag
= 0;
1961 read_objects
= Qnil
;
1962 if (EQ (Vread_with_symbol_positions
, Qt
)
1963 || EQ (Vread_with_symbol_positions
, stream
))
1964 Vread_symbol_positions_list
= Qnil
;
1966 if (STRINGP (stream
)
1967 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1969 EMACS_INT startval
, endval
;
1972 if (STRINGP (stream
))
1975 string
= XCAR (stream
);
1978 endval
= SCHARS (string
);
1982 endval
= XINT (end
);
1983 if (endval
< 0 || endval
> SCHARS (string
))
1984 args_out_of_range (string
, end
);
1991 CHECK_NUMBER (start
);
1992 startval
= XINT (start
);
1993 if (startval
< 0 || startval
> endval
)
1994 args_out_of_range (string
, start
);
1996 read_from_string_index
= startval
;
1997 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1998 read_from_string_limit
= endval
;
2001 retval
= read0 (stream
);
2002 if (EQ (Vread_with_symbol_positions
, Qt
)
2003 || EQ (Vread_with_symbol_positions
, stream
))
2004 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2009 /* Signal Qinvalid_read_syntax error.
2010 S is error string of length N (if > 0) */
2013 invalid_syntax (const char *s
, int n
)
2017 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2021 /* Use this for recursive reads, in contexts where internal tokens
2025 read0 (Lisp_Object readcharfun
)
2027 register Lisp_Object val
;
2030 val
= read1 (readcharfun
, &c
, 0);
2034 xsignal1 (Qinvalid_read_syntax
,
2035 Fmake_string (make_number (1), make_number (c
)));
2038 static int read_buffer_size
;
2039 static char *read_buffer
;
2041 /* Read a \-escape sequence, assuming we already read the `\'.
2042 If the escape sequence forces unibyte, return eight-bit char. */
2045 read_escape (Lisp_Object readcharfun
, int stringp
)
2047 register int c
= READCHAR
;
2048 /* \u allows up to four hex digits, \U up to eight. Default to the
2049 behavior for \u, and change this value in the case that \U is seen. */
2050 int unicode_hex_count
= 4;
2055 end_of_file_error ();
2085 error ("Invalid escape character syntax");
2088 c
= read_escape (readcharfun
, 0);
2089 return c
| meta_modifier
;
2094 error ("Invalid escape character syntax");
2097 c
= read_escape (readcharfun
, 0);
2098 return c
| shift_modifier
;
2103 error ("Invalid escape character syntax");
2106 c
= read_escape (readcharfun
, 0);
2107 return c
| hyper_modifier
;
2112 error ("Invalid escape character syntax");
2115 c
= read_escape (readcharfun
, 0);
2116 return c
| alt_modifier
;
2120 if (stringp
|| c
!= '-')
2127 c
= read_escape (readcharfun
, 0);
2128 return c
| super_modifier
;
2133 error ("Invalid escape character syntax");
2137 c
= read_escape (readcharfun
, 0);
2138 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2139 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2140 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2141 return c
| ctrl_modifier
;
2142 /* ASCII control chars are made from letters (both cases),
2143 as well as the non-letters within 0100...0137. */
2144 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2145 return (c
& (037 | ~0177));
2146 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2147 return (c
& (037 | ~0177));
2149 return c
| ctrl_modifier
;
2159 /* An octal escape, as in ANSI C. */
2161 register int i
= c
- '0';
2162 register int count
= 0;
2165 if ((c
= READCHAR
) >= '0' && c
<= '7')
2177 if (i
>= 0x80 && i
< 0x100)
2178 i
= BYTE8_TO_CHAR (i
);
2183 /* A hex escape, as in ANSI C. */
2190 if (c
>= '0' && c
<= '9')
2195 else if ((c
>= 'a' && c
<= 'f')
2196 || (c
>= 'A' && c
<= 'F'))
2199 if (c
>= 'a' && c
<= 'f')
2212 if (count
< 3 && i
>= 0x80)
2213 return BYTE8_TO_CHAR (i
);
2218 /* Post-Unicode-2.0: Up to eight hex chars. */
2219 unicode_hex_count
= 8;
2222 /* A Unicode escape. We only permit them in strings and characters,
2223 not arbitrarily in the source code, as in some other languages. */
2228 while (++count
<= unicode_hex_count
)
2231 /* isdigit and isalpha may be locale-specific, which we don't
2233 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2234 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2235 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2238 error ("Non-hex digit used for Unicode escape");
2243 error ("Non-Unicode character: 0x%x", i
);
2252 /* Read an integer in radix RADIX using READCHARFUN to read
2253 characters. RADIX must be in the interval [2..36]; if it isn't, a
2254 read error is signaled . Value is the integer read. Signals an
2255 error if encountering invalid read syntax or if RADIX is out of
2259 read_integer (Lisp_Object readcharfun
, int radix
)
2261 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2262 /* We use a floating point number because */
2265 if (radix
< 2 || radix
> 36)
2269 number
= ndigits
= invalid_p
= 0;
2285 if (c
>= '0' && c
<= '9')
2287 else if (c
>= 'a' && c
<= 'z')
2288 digit
= c
- 'a' + 10;
2289 else if (c
>= 'A' && c
<= 'Z')
2290 digit
= c
- 'A' + 10;
2297 if (digit
< 0 || digit
>= radix
)
2300 number
= radix
* number
+ digit
;
2306 if (ndigits
== 0 || invalid_p
)
2309 sprintf (buf
, "integer, radix %d", radix
);
2310 invalid_syntax (buf
, 0);
2313 return make_fixnum_or_float (sign
* number
);
2317 /* If the next token is ')' or ']' or '.', we store that character
2318 in *PCH and the return value is not interesting. Else, we store
2319 zero in *PCH and we read and return one lisp object.
2321 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2324 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2327 int uninterned_symbol
= 0;
2335 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2337 end_of_file_error ();
2342 return read_list (0, readcharfun
);
2345 return read_vector (readcharfun
, 0);
2361 /* Accept extended format for hashtables (extensible to
2363 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2364 Lisp_Object tmp
= read_list (0, readcharfun
);
2365 Lisp_Object head
= CAR_SAFE (tmp
);
2366 Lisp_Object data
= Qnil
;
2367 Lisp_Object val
= Qnil
;
2368 /* The size is 2 * number of allowed keywords to
2370 Lisp_Object params
[10];
2372 Lisp_Object key
= Qnil
;
2373 int param_count
= 0;
2375 if (!EQ (head
, Qhash_table
))
2376 error ("Invalid extended read marker at head of #s list "
2377 "(only hash-table allowed)");
2379 tmp
= CDR_SAFE (tmp
);
2381 /* This is repetitive but fast and simple. */
2382 params
[param_count
] = QCsize
;
2383 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2384 if (!NILP (params
[param_count
+ 1]))
2387 params
[param_count
] = QCtest
;
2388 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2389 if (!NILP (params
[param_count
+ 1]))
2392 params
[param_count
] = QCweakness
;
2393 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2394 if (!NILP (params
[param_count
+ 1]))
2397 params
[param_count
] = QCrehash_size
;
2398 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2399 if (!NILP (params
[param_count
+ 1]))
2402 params
[param_count
] = QCrehash_threshold
;
2403 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2404 if (!NILP (params
[param_count
+ 1]))
2407 /* This is the hashtable data. */
2408 data
= Fplist_get (tmp
, Qdata
);
2410 /* Now use params to make a new hashtable and fill it. */
2411 ht
= Fmake_hash_table (param_count
, params
);
2413 while (CONSP (data
))
2418 error ("Odd number of elements in hashtable data");
2421 Fputhash (key
, val
, ht
);
2427 invalid_syntax ("#", 1);
2435 tmp
= read_vector (readcharfun
, 0);
2436 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2437 error ("Invalid size char-table");
2438 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2449 tmp
= read_vector (readcharfun
, 0);
2450 if (!INTEGERP (AREF (tmp
, 0)))
2451 error ("Invalid depth in char-table");
2452 depth
= XINT (AREF (tmp
, 0));
2453 if (depth
< 1 || depth
> 3)
2454 error ("Invalid depth in char-table");
2455 size
= XVECTOR (tmp
)->size
- 2;
2456 if (chartab_size
[depth
] != size
)
2457 error ("Invalid size char-table");
2458 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2461 invalid_syntax ("#^^", 3);
2463 invalid_syntax ("#^", 2);
2468 length
= read1 (readcharfun
, pch
, first_in_list
);
2472 Lisp_Object tmp
, val
;
2474 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2475 / BOOL_VECTOR_BITS_PER_CHAR
);
2478 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2479 if (STRING_MULTIBYTE (tmp
)
2480 || (size_in_chars
!= SCHARS (tmp
)
2481 /* We used to print 1 char too many
2482 when the number of bits was a multiple of 8.
2483 Accept such input in case it came from an old
2485 && ! (XFASTINT (length
)
2486 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2487 invalid_syntax ("#&...", 5);
2489 val
= Fmake_bool_vector (length
, Qnil
);
2490 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2491 /* Clear the extraneous bits in the last byte. */
2492 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2493 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2494 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2497 invalid_syntax ("#&...", 5);
2500 /* `function vector' objects, including byte-compiled functions. */
2501 return read_vector (readcharfun
, 1);
2505 struct gcpro gcpro1
;
2508 /* Read the string itself. */
2509 tmp
= read1 (readcharfun
, &ch
, 0);
2510 if (ch
!= 0 || !STRINGP (tmp
))
2511 invalid_syntax ("#", 1);
2513 /* Read the intervals and their properties. */
2516 Lisp_Object beg
, end
, plist
;
2518 beg
= read1 (readcharfun
, &ch
, 0);
2523 end
= read1 (readcharfun
, &ch
, 0);
2525 plist
= read1 (readcharfun
, &ch
, 0);
2527 invalid_syntax ("Invalid string property list", 0);
2528 Fset_text_properties (beg
, end
, plist
, tmp
);
2534 /* #@NUMBER is used to skip NUMBER following characters.
2535 That's used in .elc files to skip over doc strings
2536 and function definitions. */
2542 /* Read a decimal integer. */
2543 while ((c
= READCHAR
) >= 0
2544 && c
>= '0' && c
<= '9')
2552 if (load_force_doc_strings
2553 && (EQ (readcharfun
, Qget_file_char
)
2554 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2556 /* If we are supposed to force doc strings into core right now,
2557 record the last string that we skipped,
2558 and record where in the file it comes from. */
2560 /* But first exchange saved_doc_string
2561 with prev_saved_doc_string, so we save two strings. */
2563 char *temp
= saved_doc_string
;
2564 int temp_size
= saved_doc_string_size
;
2565 file_offset temp_pos
= saved_doc_string_position
;
2566 int temp_len
= saved_doc_string_length
;
2568 saved_doc_string
= prev_saved_doc_string
;
2569 saved_doc_string_size
= prev_saved_doc_string_size
;
2570 saved_doc_string_position
= prev_saved_doc_string_position
;
2571 saved_doc_string_length
= prev_saved_doc_string_length
;
2573 prev_saved_doc_string
= temp
;
2574 prev_saved_doc_string_size
= temp_size
;
2575 prev_saved_doc_string_position
= temp_pos
;
2576 prev_saved_doc_string_length
= temp_len
;
2579 if (saved_doc_string_size
== 0)
2581 saved_doc_string_size
= nskip
+ 100;
2582 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2584 if (nskip
> saved_doc_string_size
)
2586 saved_doc_string_size
= nskip
+ 100;
2587 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2588 saved_doc_string_size
);
2591 saved_doc_string_position
= file_tell (instream
);
2593 /* Copy that many characters into saved_doc_string. */
2594 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2595 saved_doc_string
[i
] = c
= READCHAR
;
2597 saved_doc_string_length
= i
;
2601 /* Skip that many characters. */
2602 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2611 /* #! appears at the beginning of an executable file.
2612 Skip the first line. */
2613 while (c
!= '\n' && c
>= 0)
2618 return Vload_file_name
;
2620 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2621 /* #:foo is the uninterned symbol named foo. */
2624 uninterned_symbol
= 1;
2628 /* Reader forms that can reuse previously read objects. */
2629 if (c
>= '0' && c
<= '9')
2634 /* Read a non-negative integer. */
2635 while (c
>= '0' && c
<= '9')
2641 /* #n=object returns object, but associates it with n for #n#. */
2642 if (c
== '=' && !NILP (Vread_circle
))
2644 /* Make a placeholder for #n# to use temporarily */
2645 Lisp_Object placeholder
;
2648 placeholder
= Fcons (Qnil
, Qnil
);
2649 cell
= Fcons (make_number (n
), placeholder
);
2650 read_objects
= Fcons (cell
, read_objects
);
2652 /* Read the object itself. */
2653 tem
= read0 (readcharfun
);
2655 /* Now put it everywhere the placeholder was... */
2656 substitute_object_in_subtree (tem
, placeholder
);
2658 /* ...and #n# will use the real value from now on. */
2659 Fsetcdr (cell
, tem
);
2663 /* #n# returns a previously read object. */
2664 if (c
== '#' && !NILP (Vread_circle
))
2666 tem
= Fassq (make_number (n
), read_objects
);
2669 /* Fall through to error message. */
2671 else if (c
== 'r' || c
== 'R')
2672 return read_integer (readcharfun
, n
);
2674 /* Fall through to error message. */
2676 else if (c
== 'x' || c
== 'X')
2677 return read_integer (readcharfun
, 16);
2678 else if (c
== 'o' || c
== 'O')
2679 return read_integer (readcharfun
, 8);
2680 else if (c
== 'b' || c
== 'B')
2681 return read_integer (readcharfun
, 2);
2684 invalid_syntax ("#", 1);
2687 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2692 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2697 int next_char
= READCHAR
;
2699 /* Transition from old-style to new-style:
2700 If we see "(`" it used to mean old-style, which usually works
2701 fine because ` should almost never appear in such a position
2702 for new-style. But occasionally we need "(`" to mean new
2703 style, so we try to distinguish the two by the fact that we
2704 can either write "( `foo" or "(` foo", where the first
2705 intends to use new-style whereas the second intends to use
2706 old-style. For Emacs-25, we should completely remove this
2707 first_in_list exception (old-style can still be obtained via
2709 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2711 Vold_style_backquotes
= Qt
;
2718 new_backquote_flag
++;
2719 value
= read0 (readcharfun
);
2720 new_backquote_flag
--;
2722 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2727 int next_char
= READCHAR
;
2729 /* Transition from old-style to new-style:
2730 It used to be impossible to have a new-style , other than within
2731 a new-style `. This is sufficient when ` and , are used in the
2732 normal way, but ` and , can also appear in args to macros that
2733 will not interpret them in the usual way, in which case , may be
2734 used without any ` anywhere near.
2735 So we now use the same heuristic as for backquote: old-style
2736 unquotes are only recognized when first on a list, and when
2737 followed by a space.
2738 Because it's more difficult to peak 2 chars ahead, a new-style
2739 ,@ can still not be used outside of a `, unless it's in the middle
2741 if (new_backquote_flag
2743 || (next_char
!= ' ' && next_char
!= '@'))
2745 Lisp_Object comma_type
= Qnil
;
2750 comma_type
= Qcomma_at
;
2752 comma_type
= Qcomma_dot
;
2755 if (ch
>= 0) UNREAD (ch
);
2756 comma_type
= Qcomma
;
2759 value
= read0 (readcharfun
);
2760 return Fcons (comma_type
, Fcons (value
, Qnil
));
2764 Vold_style_backquotes
= Qt
;
2776 end_of_file_error ();
2778 /* Accept `single space' syntax like (list ? x) where the
2779 whitespace character is SPC or TAB.
2780 Other literal whitespace like NL, CR, and FF are not accepted,
2781 as there are well-established escape sequences for these. */
2782 if (c
== ' ' || c
== '\t')
2783 return make_number (c
);
2786 c
= read_escape (readcharfun
, 0);
2787 modifiers
= c
& CHAR_MODIFIER_MASK
;
2788 c
&= ~CHAR_MODIFIER_MASK
;
2789 if (CHAR_BYTE8_P (c
))
2790 c
= CHAR_TO_BYTE8 (c
);
2793 next_char
= READCHAR
;
2794 ok
= (next_char
<= 040
2795 || (next_char
< 0200
2796 && (strchr ("\"';()[]#?`,.", next_char
))));
2799 return make_number (c
);
2801 invalid_syntax ("?", 1);
2806 char *p
= read_buffer
;
2807 char *end
= read_buffer
+ read_buffer_size
;
2809 /* Nonzero if we saw an escape sequence specifying
2810 a multibyte character. */
2811 int force_multibyte
= 0;
2812 /* Nonzero if we saw an escape sequence specifying
2813 a single-byte character. */
2814 int force_singlebyte
= 0;
2818 while ((c
= READCHAR
) >= 0
2821 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2823 int offset
= p
- read_buffer
;
2824 read_buffer
= (char *) xrealloc (read_buffer
,
2825 read_buffer_size
*= 2);
2826 p
= read_buffer
+ offset
;
2827 end
= read_buffer
+ read_buffer_size
;
2834 c
= read_escape (readcharfun
, 1);
2836 /* C is -1 if \ newline has just been seen */
2839 if (p
== read_buffer
)
2844 modifiers
= c
& CHAR_MODIFIER_MASK
;
2845 c
= c
& ~CHAR_MODIFIER_MASK
;
2847 if (CHAR_BYTE8_P (c
))
2848 force_singlebyte
= 1;
2849 else if (! ASCII_CHAR_P (c
))
2850 force_multibyte
= 1;
2851 else /* i.e. ASCII_CHAR_P (c) */
2853 /* Allow `\C- ' and `\C-?'. */
2854 if (modifiers
== CHAR_CTL
)
2857 c
= 0, modifiers
= 0;
2859 c
= 127, modifiers
= 0;
2861 if (modifiers
& CHAR_SHIFT
)
2863 /* Shift modifier is valid only with [A-Za-z]. */
2864 if (c
>= 'A' && c
<= 'Z')
2865 modifiers
&= ~CHAR_SHIFT
;
2866 else if (c
>= 'a' && c
<= 'z')
2867 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2870 if (modifiers
& CHAR_META
)
2872 /* Move the meta bit to the right place for a
2874 modifiers
&= ~CHAR_META
;
2875 c
= BYTE8_TO_CHAR (c
| 0x80);
2876 force_singlebyte
= 1;
2880 /* Any modifiers remaining are invalid. */
2882 error ("Invalid modifier in string");
2883 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2887 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2888 if (CHAR_BYTE8_P (c
))
2889 force_singlebyte
= 1;
2890 else if (! ASCII_CHAR_P (c
))
2891 force_multibyte
= 1;
2897 end_of_file_error ();
2899 /* If purifying, and string starts with \ newline,
2900 return zero instead. This is for doc strings
2901 that we are really going to find in etc/DOC.nn.nn */
2902 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2903 return make_number (0);
2905 if (force_multibyte
)
2906 /* READ_BUFFER already contains valid multibyte forms. */
2908 else if (force_singlebyte
)
2910 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2912 p
= read_buffer
+ nchars
;
2915 /* Otherwise, READ_BUFFER contains only ASCII. */
2918 /* We want readchar_count to be the number of characters, not
2919 bytes. Hence we adjust for multibyte characters in the
2920 string. ... But it doesn't seem to be necessary, because
2921 READCHAR *does* read multibyte characters from buffers. */
2922 /* readchar_count -= (p - read_buffer) - nchars; */
2924 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2926 || (p
- read_buffer
!= nchars
)));
2927 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2929 || (p
- read_buffer
!= nchars
)));
2934 int next_char
= READCHAR
;
2937 if (next_char
<= 040
2938 || (next_char
< 0200
2939 && (strchr ("\"';([#?`,", next_char
))))
2945 /* Otherwise, we fall through! Note that the atom-reading loop
2946 below will now loop at least once, assuring that we will not
2947 try to UNREAD two characters in a row. */
2951 if (c
<= 040) goto retry
;
2952 if (c
== 0x8a0) /* NBSP */
2955 char *p
= read_buffer
;
2959 char *end
= read_buffer
+ read_buffer_size
;
2963 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2965 int offset
= p
- read_buffer
;
2966 read_buffer
= (char *) xrealloc (read_buffer
,
2967 read_buffer_size
*= 2);
2968 p
= read_buffer
+ offset
;
2969 end
= read_buffer
+ read_buffer_size
;
2976 end_of_file_error ();
2981 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2986 && c
!= 0x8a0 /* NBSP */
2988 || !(strchr ("\"';()[]#`,", c
))));
2992 int offset
= p
- read_buffer
;
2993 read_buffer
= (char *) xrealloc (read_buffer
,
2994 read_buffer_size
*= 2);
2995 p
= read_buffer
+ offset
;
2996 end
= read_buffer
+ read_buffer_size
;
3003 if (!quoted
&& !uninterned_symbol
)
3007 if (*p1
== '+' || *p1
== '-') p1
++;
3008 /* Is it an integer? */
3011 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3012 /* Integers can have trailing decimal points. */
3013 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3015 /* It is an integer. */
3020 /* EMACS_INT n = atol (read_buffer); */
3021 char *endptr
= NULL
;
3022 EMACS_INT n
= (errno
= 0,
3023 strtol (read_buffer
, &endptr
, 10));
3024 if (errno
== ERANGE
&& endptr
)
3027 = Fcons (make_string (read_buffer
,
3028 endptr
- read_buffer
),
3030 xsignal (Qoverflow_error
, args
);
3032 return make_fixnum_or_float (n
);
3036 if (isfloat_string (read_buffer
, 0))
3038 /* Compute NaN and infinities using 0.0 in a variable,
3039 to cope with compilers that think they are smarter
3045 /* Negate the value ourselves. This treats 0, NaNs,
3046 and infinity properly on IEEE floating point hosts,
3047 and works around a common bug where atof ("-0.0")
3049 int negative
= read_buffer
[0] == '-';
3051 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3052 returns 1, is if the input ends in e+INF or e+NaN. */
3059 value
= zero
/ zero
;
3061 /* If that made a "negative" NaN, negate it. */
3065 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3068 u_minus_zero
.d
= - 0.0;
3069 for (i
= 0; i
< sizeof (double); i
++)
3070 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3076 /* Now VALUE is a positive NaN. */
3079 value
= atof (read_buffer
+ negative
);
3083 return make_float (negative
? - value
: value
);
3087 Lisp_Object name
, result
;
3088 EMACS_INT nbytes
= p
- read_buffer
;
3091 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3095 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3096 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3098 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3099 result
= (uninterned_symbol
? Fmake_symbol (name
)
3100 : Fintern (name
, Qnil
));
3102 if (EQ (Vread_with_symbol_positions
, Qt
)
3103 || EQ (Vread_with_symbol_positions
, readcharfun
))
3104 Vread_symbol_positions_list
=
3105 /* Kind of a hack; this will probably fail if characters
3106 in the symbol name were escaped. Not really a big
3108 Fcons (Fcons (result
,
3109 make_number (readchar_count
3110 - XFASTINT (Flength (Fsymbol_name (result
))))),
3111 Vread_symbol_positions_list
);
3119 /* List of nodes we've seen during substitute_object_in_subtree. */
3120 static Lisp_Object seen_list
;
3123 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3125 Lisp_Object check_object
;
3127 /* We haven't seen any objects when we start. */
3130 /* Make all the substitutions. */
3132 = substitute_object_recurse (object
, placeholder
, object
);
3134 /* Clear seen_list because we're done with it. */
3137 /* The returned object here is expected to always eq the
3139 if (!EQ (check_object
, object
))
3140 error ("Unexpected mutation error in reader");
3143 /* Feval doesn't get called from here, so no gc protection is needed. */
3144 #define SUBSTITUTE(get_val, set_val) \
3146 Lisp_Object old_value = get_val; \
3147 Lisp_Object true_value \
3148 = substitute_object_recurse (object, placeholder, \
3151 if (!EQ (old_value, true_value)) \
3158 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3160 /* If we find the placeholder, return the target object. */
3161 if (EQ (placeholder
, subtree
))
3164 /* If we've been to this node before, don't explore it again. */
3165 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3168 /* If this node can be the entry point to a cycle, remember that
3169 we've seen it. It can only be such an entry point if it was made
3170 by #n=, which means that we can find it as a value in
3172 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3173 seen_list
= Fcons (subtree
, seen_list
);
3175 /* Recurse according to subtree's type.
3176 Every branch must return a Lisp_Object. */
3177 switch (XTYPE (subtree
))
3179 case Lisp_Vectorlike
:
3182 if (BOOL_VECTOR_P (subtree
))
3183 return subtree
; /* No sub-objects anyway. */
3184 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3185 || COMPILEDP (subtree
))
3186 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3187 else if (VECTORP (subtree
))
3188 length
= ASIZE (subtree
);
3190 /* An unknown pseudovector may contain non-Lisp fields, so we
3191 can't just blindly traverse all its fields. We used to call
3192 `Flength' which signaled `sequencep', so I just preserved this
3194 wrong_type_argument (Qsequencep
, subtree
);
3196 for (i
= 0; i
< length
; i
++)
3197 SUBSTITUTE (AREF (subtree
, i
),
3198 ASET (subtree
, i
, true_value
));
3204 SUBSTITUTE (XCAR (subtree
),
3205 XSETCAR (subtree
, true_value
));
3206 SUBSTITUTE (XCDR (subtree
),
3207 XSETCDR (subtree
, true_value
));
3213 /* Check for text properties in each interval.
3214 substitute_in_interval contains part of the logic. */
3216 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3217 Lisp_Object arg
= Fcons (object
, placeholder
);
3219 traverse_intervals_noorder (root_interval
,
3220 &substitute_in_interval
, arg
);
3225 /* Other types don't recurse any further. */
3231 /* Helper function for substitute_object_recurse. */
3233 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3235 Lisp_Object object
= Fcar (arg
);
3236 Lisp_Object placeholder
= Fcdr (arg
);
3238 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3249 isfloat_string (const char *cp
, int ignore_trailing
)
3252 const char *start
= cp
;
3255 if (*cp
== '+' || *cp
== '-')
3258 if (*cp
>= '0' && *cp
<= '9')
3261 while (*cp
>= '0' && *cp
<= '9')
3269 if (*cp
>= '0' && *cp
<= '9')
3272 while (*cp
>= '0' && *cp
<= '9')
3275 if (*cp
== 'e' || *cp
== 'E')
3279 if (*cp
== '+' || *cp
== '-')
3283 if (*cp
>= '0' && *cp
<= '9')
3286 while (*cp
>= '0' && *cp
<= '9')
3289 else if (cp
== start
)
3291 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3296 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3302 return ((ignore_trailing
3303 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3304 || *cp
== '\r' || *cp
== '\f')
3305 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3306 || state
== (DOT_CHAR
|TRAIL_INT
)
3307 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3308 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3309 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3314 read_vector (Lisp_Object readcharfun
, int read_funvec
)
3318 register Lisp_Object
*ptr
;
3319 register Lisp_Object tem
, item
, vector
;
3320 register struct Lisp_Cons
*otem
;
3322 /* If we're reading a funvec object we start out assuming it's also a
3323 byte-code object (a subset of funvecs), so we can do any special
3324 processing needed. If it's just an ordinary funvec object, we'll
3325 realize that as soon as we've read the first element. */
3326 int read_bytecode
= read_funvec
;
3328 tem
= read_list (1, readcharfun
);
3329 len
= Flength (tem
);
3330 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3332 size
= XVECTOR (vector
)->size
;
3333 ptr
= XVECTOR (vector
)->contents
;
3334 for (i
= 0; i
< size
; i
++)
3338 /* If READ_BYTECODE is set, check whether this is really a byte-code
3339 object, or just an ordinary `funvec' object -- non-byte-code
3340 funvec objects use the same reader syntax. We can tell from the
3341 first element which one it is. */
3342 if (read_bytecode
&& i
== 0 && ! FUNVEC_COMPILED_TAG_P (item
))
3343 read_bytecode
= 0; /* Nope. */
3345 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3346 bytecode object, the docstring containing the bytecode and
3347 constants values must be treated as unibyte and passed to
3348 Fread, to get the actual bytecode string and constants vector. */
3349 if (read_bytecode
&& load_force_doc_strings
)
3351 if (i
== COMPILED_BYTECODE
)
3353 if (!STRINGP (item
))
3354 error ("Invalid byte code");
3356 /* Delay handling the bytecode slot until we know whether
3357 it is lazily-loaded (we can tell by whether the
3358 constants slot is nil). */
3359 ptr
[COMPILED_CONSTANTS
] = item
;
3362 else if (i
== COMPILED_CONSTANTS
)
3364 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3368 /* Coerce string to unibyte (like string-as-unibyte,
3369 but without generating extra garbage and
3370 guaranteeing no change in the contents). */
3371 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3372 STRING_SET_UNIBYTE (bytestr
);
3374 item
= Fread (Fcons (bytestr
, readcharfun
));
3376 error ("Invalid byte code");
3378 otem
= XCONS (item
);
3379 bytestr
= XCAR (item
);
3384 /* Now handle the bytecode slot. */
3385 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3387 else if (i
== COMPILED_DOC_STRING
3389 && ! STRING_MULTIBYTE (item
))
3391 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3392 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3394 item
= Fstring_as_multibyte (item
);
3397 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3403 if (read_bytecode
&& size
>= 4)
3404 /* Convert this vector to a bytecode object. */
3405 vector
= Fmake_byte_code (size
, XVECTOR (vector
)->contents
);
3406 else if (read_funvec
&& size
>= 1)
3407 /* Convert this vector to an ordinary funvec object. */
3408 XSETFUNVEC (vector
, XVECTOR (vector
));
3413 /* FLAG = 1 means check for ] to terminate rather than ) and .
3414 FLAG = -1 means check for starting with defun
3415 and make structure pure. */
3418 read_list (int flag
, register Lisp_Object readcharfun
)
3420 /* -1 means check next element for defun,
3421 0 means don't check,
3422 1 means already checked and found defun. */
3423 int defunflag
= flag
< 0 ? -1 : 0;
3424 Lisp_Object val
, tail
;
3425 register Lisp_Object elt
, tem
;
3426 struct gcpro gcpro1
, gcpro2
;
3427 /* 0 is the normal case.
3428 1 means this list is a doc reference; replace it with the number 0.
3429 2 means this list is a doc reference; replace it with the doc string. */
3430 int doc_reference
= 0;
3432 /* Initialize this to 1 if we are reading a list. */
3433 int first_in_list
= flag
<= 0;
3442 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3447 /* While building, if the list starts with #$, treat it specially. */
3448 if (EQ (elt
, Vload_file_name
)
3450 && !NILP (Vpurify_flag
))
3452 if (NILP (Vdoc_file_name
))
3453 /* We have not yet called Snarf-documentation, so assume
3454 this file is described in the DOC-MM.NN file
3455 and Snarf-documentation will fill in the right value later.
3456 For now, replace the whole list with 0. */
3459 /* We have already called Snarf-documentation, so make a relative
3460 file name for this file, so it can be found properly
3461 in the installed Lisp directory.
3462 We don't use Fexpand_file_name because that would make
3463 the directory absolute now. */
3464 elt
= concat2 (build_string ("../lisp/"),
3465 Ffile_name_nondirectory (elt
));
3467 else if (EQ (elt
, Vload_file_name
)
3469 && load_force_doc_strings
)
3478 invalid_syntax (") or . in a vector", 18);
3486 XSETCDR (tail
, read0 (readcharfun
));
3488 val
= read0 (readcharfun
);
3489 read1 (readcharfun
, &ch
, 0);
3493 if (doc_reference
== 1)
3494 return make_number (0);
3495 if (doc_reference
== 2)
3497 /* Get a doc string from the file we are loading.
3498 If it's in saved_doc_string, get it from there.
3500 Here, we don't know if the string is a
3501 bytecode string or a doc string. As a
3502 bytecode string must be unibyte, we always
3503 return a unibyte string. If it is actually a
3504 doc string, caller must make it
3507 int pos
= XINT (XCDR (val
));
3508 /* Position is negative for user variables. */
3509 if (pos
< 0) pos
= -pos
;
3510 if (pos
>= saved_doc_string_position
3511 && pos
< (saved_doc_string_position
3512 + saved_doc_string_length
))
3514 int start
= pos
- saved_doc_string_position
;
3517 /* Process quoting with ^A,
3518 and find the end of the string,
3519 which is marked with ^_ (037). */
3520 for (from
= start
, to
= start
;
3521 saved_doc_string
[from
] != 037;)
3523 int c
= saved_doc_string
[from
++];
3526 c
= saved_doc_string
[from
++];
3528 saved_doc_string
[to
++] = c
;
3530 saved_doc_string
[to
++] = 0;
3532 saved_doc_string
[to
++] = 037;
3535 saved_doc_string
[to
++] = c
;
3538 return make_unibyte_string (saved_doc_string
+ start
,
3541 /* Look in prev_saved_doc_string the same way. */
3542 else if (pos
>= prev_saved_doc_string_position
3543 && pos
< (prev_saved_doc_string_position
3544 + prev_saved_doc_string_length
))
3546 int start
= pos
- prev_saved_doc_string_position
;
3549 /* Process quoting with ^A,
3550 and find the end of the string,
3551 which is marked with ^_ (037). */
3552 for (from
= start
, to
= start
;
3553 prev_saved_doc_string
[from
] != 037;)
3555 int c
= prev_saved_doc_string
[from
++];
3558 c
= prev_saved_doc_string
[from
++];
3560 prev_saved_doc_string
[to
++] = c
;
3562 prev_saved_doc_string
[to
++] = 0;
3564 prev_saved_doc_string
[to
++] = 037;
3567 prev_saved_doc_string
[to
++] = c
;
3570 return make_unibyte_string (prev_saved_doc_string
3575 return get_doc_string (val
, 1, 0);
3580 invalid_syntax (". in wrong context", 18);
3582 invalid_syntax ("] in a list", 11);
3584 tem
= (read_pure
&& flag
<= 0
3585 ? pure_cons (elt
, Qnil
)
3586 : Fcons (elt
, Qnil
));
3588 XSETCDR (tail
, tem
);
3593 defunflag
= EQ (elt
, Qdefun
);
3594 else if (defunflag
> 0)
3599 Lisp_Object initial_obarray
;
3601 /* oblookup stores the bucket number here, for the sake of Funintern. */
3603 int oblookup_last_bucket_number
;
3605 static int hash_string (const char *ptr
, int len
);
3607 /* Get an error if OBARRAY is not an obarray.
3608 If it is one, return it. */
3611 check_obarray (Lisp_Object obarray
)
3613 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3615 /* If Vobarray is now invalid, force it to be valid. */
3616 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3617 wrong_type_argument (Qvectorp
, obarray
);
3622 /* Intern the C string STR: return a symbol with that name,
3623 interned in the current obarray. */
3626 intern (const char *str
)
3629 int len
= strlen (str
);
3630 Lisp_Object obarray
;
3633 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3634 obarray
= check_obarray (obarray
);
3635 tem
= oblookup (obarray
, str
, len
, len
);
3638 return Fintern (make_string (str
, len
), obarray
);
3642 intern_c_string (const char *str
)
3645 int len
= strlen (str
);
3646 Lisp_Object obarray
;
3649 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3650 obarray
= check_obarray (obarray
);
3651 tem
= oblookup (obarray
, str
, len
, len
);
3655 if (NILP (Vpurify_flag
))
3656 /* Creating a non-pure string from a string literal not
3657 implemented yet. We could just use make_string here and live
3658 with the extra copy. */
3661 return Fintern (make_pure_c_string (str
), obarray
);
3664 /* Create an uninterned symbol with name STR. */
3667 make_symbol (const char *str
)
3669 int len
= strlen (str
);
3671 return Fmake_symbol (!NILP (Vpurify_flag
)
3672 ? make_pure_string (str
, len
, len
, 0)
3673 : make_string (str
, len
));
3676 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3677 doc
: /* Return the canonical symbol whose name is STRING.
3678 If there is none, one is created by this function and returned.
3679 A second optional argument specifies the obarray to use;
3680 it defaults to the value of `obarray'. */)
3681 (Lisp_Object string
, Lisp_Object obarray
)
3683 register Lisp_Object tem
, sym
, *ptr
;
3685 if (NILP (obarray
)) obarray
= Vobarray
;
3686 obarray
= check_obarray (obarray
);
3688 CHECK_STRING (string
);
3690 tem
= oblookup (obarray
, SSDATA (string
),
3693 if (!INTEGERP (tem
))
3696 if (!NILP (Vpurify_flag
))
3697 string
= Fpurecopy (string
);
3698 sym
= Fmake_symbol (string
);
3700 if (EQ (obarray
, initial_obarray
))
3701 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3703 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3705 if ((SREF (string
, 0) == ':')
3706 && EQ (obarray
, initial_obarray
))
3708 XSYMBOL (sym
)->constant
= 1;
3709 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3710 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3713 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3715 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3717 XSYMBOL (sym
)->next
= 0;
3722 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3723 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3724 NAME may be a string or a symbol. If it is a symbol, that exact
3725 symbol is searched for.
3726 A second optional argument specifies the obarray to use;
3727 it defaults to the value of `obarray'. */)
3728 (Lisp_Object name
, Lisp_Object obarray
)
3730 register Lisp_Object tem
, string
;
3732 if (NILP (obarray
)) obarray
= Vobarray
;
3733 obarray
= check_obarray (obarray
);
3735 if (!SYMBOLP (name
))
3737 CHECK_STRING (name
);
3741 string
= SYMBOL_NAME (name
);
3743 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3744 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3750 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3751 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3752 The value is t if a symbol was found and deleted, nil otherwise.
3753 NAME may be a string or a symbol. If it is a symbol, that symbol
3754 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3755 OBARRAY defaults to the value of the variable `obarray'. */)
3756 (Lisp_Object name
, Lisp_Object obarray
)
3758 register Lisp_Object string
, tem
;
3761 if (NILP (obarray
)) obarray
= Vobarray
;
3762 obarray
= check_obarray (obarray
);
3765 string
= SYMBOL_NAME (name
);
3768 CHECK_STRING (name
);
3772 tem
= oblookup (obarray
, SSDATA (string
),
3777 /* If arg was a symbol, don't delete anything but that symbol itself. */
3778 if (SYMBOLP (name
) && !EQ (name
, tem
))
3781 /* There are plenty of other symbols which will screw up the Emacs
3782 session if we unintern them, as well as even more ways to use
3783 `setq' or `fset' or whatnot to make the Emacs session
3784 unusable. Let's not go down this silly road. --Stef */
3785 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3786 error ("Attempt to unintern t or nil"); */
3788 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3790 hash
= oblookup_last_bucket_number
;
3792 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3794 if (XSYMBOL (tem
)->next
)
3795 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3797 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3801 Lisp_Object tail
, following
;
3803 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3804 XSYMBOL (tail
)->next
;
3807 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3808 if (EQ (following
, tem
))
3810 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3819 /* Return the symbol in OBARRAY whose names matches the string
3820 of SIZE characters (SIZE_BYTE bytes) at PTR.
3821 If there is no such symbol in OBARRAY, return nil.
3823 Also store the bucket number in oblookup_last_bucket_number. */
3826 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3830 register Lisp_Object tail
;
3831 Lisp_Object bucket
, tem
;
3833 if (!VECTORP (obarray
)
3834 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3836 obarray
= check_obarray (obarray
);
3837 obsize
= XVECTOR (obarray
)->size
;
3839 /* This is sometimes needed in the middle of GC. */
3840 obsize
&= ~ARRAY_MARK_FLAG
;
3841 hash
= hash_string (ptr
, size_byte
) % obsize
;
3842 bucket
= XVECTOR (obarray
)->contents
[hash
];
3843 oblookup_last_bucket_number
= hash
;
3844 if (EQ (bucket
, make_number (0)))
3846 else if (!SYMBOLP (bucket
))
3847 error ("Bad data in guts of obarray"); /* Like CADR error message */
3849 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3851 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3852 && SCHARS (SYMBOL_NAME (tail
)) == size
3853 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3855 else if (XSYMBOL (tail
)->next
== 0)
3858 XSETINT (tem
, hash
);
3863 hash_string (const char *ptr
, int len
)
3865 register const char *p
= ptr
;
3866 register const char *end
= p
+ len
;
3867 register unsigned char c
;
3868 register int hash
= 0;
3873 if (c
>= 0140) c
-= 40;
3874 hash
= ((hash
<<3) + (hash
>>28) + c
);
3876 return hash
& 07777777777;
3880 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3883 register Lisp_Object tail
;
3884 CHECK_VECTOR (obarray
);
3885 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3887 tail
= XVECTOR (obarray
)->contents
[i
];
3892 if (XSYMBOL (tail
)->next
== 0)
3894 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3900 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3902 call1 (function
, sym
);
3905 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3906 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3907 OBARRAY defaults to the value of `obarray'. */)
3908 (Lisp_Object function
, Lisp_Object obarray
)
3910 if (NILP (obarray
)) obarray
= Vobarray
;
3911 obarray
= check_obarray (obarray
);
3913 map_obarray (obarray
, mapatoms_1
, function
);
3917 #define OBARRAY_SIZE 1511
3922 Lisp_Object oblength
;
3924 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3926 Vobarray
= Fmake_vector (oblength
, make_number (0));
3927 initial_obarray
= Vobarray
;
3928 staticpro (&initial_obarray
);
3930 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3931 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3932 NILP (Vpurify_flag) check in intern_c_string. */
3933 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3934 Qnil
= intern_c_string ("nil");
3936 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3937 so those two need to be fixed manally. */
3938 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3939 XSYMBOL (Qunbound
)->function
= Qunbound
;
3940 XSYMBOL (Qunbound
)->plist
= Qnil
;
3941 /* XSYMBOL (Qnil)->function = Qunbound; */
3942 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3943 XSYMBOL (Qnil
)->constant
= 1;
3944 XSYMBOL (Qnil
)->plist
= Qnil
;
3946 Qt
= intern_c_string ("t");
3947 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3948 XSYMBOL (Qt
)->constant
= 1;
3950 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3953 Qvariable_documentation
= intern_c_string ("variable-documentation");
3954 staticpro (&Qvariable_documentation
);
3956 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3957 read_buffer
= (char *) xmalloc (read_buffer_size
);
3961 defsubr (struct Lisp_Subr
*sname
)
3964 sym
= intern_c_string (sname
->symbol_name
);
3965 XSETPVECTYPE (sname
, PVEC_SUBR
);
3966 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3969 #ifdef NOTDEF /* use fset in subr.el now */
3971 defalias (sname
, string
)
3972 struct Lisp_Subr
*sname
;
3976 sym
= intern (string
);
3977 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3981 /* Define an "integer variable"; a symbol whose value is forwarded to a
3982 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3983 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3985 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3986 const char *namestring
, EMACS_INT
*address
)
3989 sym
= intern_c_string (namestring
);
3990 i_fwd
->type
= Lisp_Fwd_Int
;
3991 i_fwd
->intvar
= address
;
3992 XSYMBOL (sym
)->declared_special
= 1;
3993 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3994 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3997 /* Similar but define a variable whose value is t if address contains 1,
3998 nil if address contains 0. */
4000 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4001 const char *namestring
, int *address
)
4004 sym
= intern_c_string (namestring
);
4005 b_fwd
->type
= Lisp_Fwd_Bool
;
4006 b_fwd
->boolvar
= address
;
4007 XSYMBOL (sym
)->declared_special
= 1;
4008 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4009 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4010 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4013 /* Similar but define a variable whose value is the Lisp Object stored
4014 at address. Two versions: with and without gc-marking of the C
4015 variable. The nopro version is used when that variable will be
4016 gc-marked for some other reason, since marking the same slot twice
4017 can cause trouble with strings. */
4019 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4020 const char *namestring
, Lisp_Object
*address
)
4023 sym
= intern_c_string (namestring
);
4024 o_fwd
->type
= Lisp_Fwd_Obj
;
4025 o_fwd
->objvar
= address
;
4026 XSYMBOL (sym
)->declared_special
= 1;
4027 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4028 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4032 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4033 const char *namestring
, Lisp_Object
*address
)
4035 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4036 staticpro (address
);
4040 /* Similar but define a variable whose value is the Lisp Object stored
4041 at a particular offset in the current kboard object. */
4044 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4045 const char *namestring
, int offset
)
4048 sym
= intern_c_string (namestring
);
4049 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4050 ko_fwd
->offset
= offset
;
4051 XSYMBOL (sym
)->declared_special
= 1;
4052 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4053 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4056 /* Record the value of load-path used at the start of dumping
4057 so we can see if the site changed it later during dumping. */
4058 static Lisp_Object dump_path
;
4064 int turn_off_warning
= 0;
4066 /* Compute the default load-path. */
4068 normal
= PATH_LOADSEARCH
;
4069 Vload_path
= decode_env_path (0, normal
);
4071 if (NILP (Vpurify_flag
))
4072 normal
= PATH_LOADSEARCH
;
4074 normal
= PATH_DUMPLOADSEARCH
;
4076 /* In a dumped Emacs, we normally have to reset the value of
4077 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4078 uses ../lisp, instead of the path of the installed elisp
4079 libraries. However, if it appears that Vload_path was changed
4080 from the default before dumping, don't override that value. */
4083 if (! NILP (Fequal (dump_path
, Vload_path
)))
4085 Vload_path
= decode_env_path (0, normal
);
4086 if (!NILP (Vinstallation_directory
))
4088 Lisp_Object tem
, tem1
, sitelisp
;
4090 /* Remove site-lisp dirs from path temporarily and store
4091 them in sitelisp, then conc them on at the end so
4092 they're always first in path. */
4096 tem
= Fcar (Vload_path
);
4097 tem1
= Fstring_match (build_string ("site-lisp"),
4101 Vload_path
= Fcdr (Vload_path
);
4102 sitelisp
= Fcons (tem
, sitelisp
);
4108 /* Add to the path the lisp subdir of the
4109 installation dir, if it exists. */
4110 tem
= Fexpand_file_name (build_string ("lisp"),
4111 Vinstallation_directory
);
4112 tem1
= Ffile_exists_p (tem
);
4115 if (NILP (Fmember (tem
, Vload_path
)))
4117 turn_off_warning
= 1;
4118 Vload_path
= Fcons (tem
, Vload_path
);
4122 /* That dir doesn't exist, so add the build-time
4123 Lisp dirs instead. */
4124 Vload_path
= nconc2 (Vload_path
, dump_path
);
4126 /* Add leim under the installation dir, if it exists. */
4127 tem
= Fexpand_file_name (build_string ("leim"),
4128 Vinstallation_directory
);
4129 tem1
= Ffile_exists_p (tem
);
4132 if (NILP (Fmember (tem
, Vload_path
)))
4133 Vload_path
= Fcons (tem
, Vload_path
);
4136 /* Add site-lisp under the installation dir, if it exists. */
4137 tem
= Fexpand_file_name (build_string ("site-lisp"),
4138 Vinstallation_directory
);
4139 tem1
= Ffile_exists_p (tem
);
4142 if (NILP (Fmember (tem
, Vload_path
)))
4143 Vload_path
= Fcons (tem
, Vload_path
);
4146 /* If Emacs was not built in the source directory,
4147 and it is run from where it was built, add to load-path
4148 the lisp, leim and site-lisp dirs under that directory. */
4150 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4154 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4155 Vinstallation_directory
);
4156 tem1
= Ffile_exists_p (tem
);
4158 /* Don't be fooled if they moved the entire source tree
4159 AFTER dumping Emacs. If the build directory is indeed
4160 different from the source dir, src/Makefile.in and
4161 src/Makefile will not be found together. */
4162 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4163 Vinstallation_directory
);
4164 tem2
= Ffile_exists_p (tem
);
4165 if (!NILP (tem1
) && NILP (tem2
))
4167 tem
= Fexpand_file_name (build_string ("lisp"),
4170 if (NILP (Fmember (tem
, Vload_path
)))
4171 Vload_path
= Fcons (tem
, Vload_path
);
4173 tem
= Fexpand_file_name (build_string ("leim"),
4176 if (NILP (Fmember (tem
, Vload_path
)))
4177 Vload_path
= Fcons (tem
, Vload_path
);
4179 tem
= Fexpand_file_name (build_string ("site-lisp"),
4182 if (NILP (Fmember (tem
, Vload_path
)))
4183 Vload_path
= Fcons (tem
, Vload_path
);
4186 if (!NILP (sitelisp
) && !no_site_lisp
)
4187 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4193 /* NORMAL refers to the lisp dir in the source directory. */
4194 /* We used to add ../lisp at the front here, but
4195 that caused trouble because it was copied from dump_path
4196 into Vload_path, above, when Vinstallation_directory was non-nil.
4197 It should be unnecessary. */
4198 Vload_path
= decode_env_path (0, normal
);
4199 dump_path
= Vload_path
;
4203 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4204 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4205 almost never correct, thereby causing a warning to be printed out that
4206 confuses users. Since PATH_LOADSEARCH is always overridden by the
4207 EMACSLOADPATH environment variable below, disable the warning on NT. */
4209 /* Warn if dirs in the *standard* path don't exist. */
4210 if (!turn_off_warning
)
4212 Lisp_Object path_tail
;
4214 for (path_tail
= Vload_path
;
4216 path_tail
= XCDR (path_tail
))
4218 Lisp_Object dirfile
;
4219 dirfile
= Fcar (path_tail
);
4220 if (STRINGP (dirfile
))
4222 dirfile
= Fdirectory_file_name (dirfile
);
4223 if (access (SSDATA (dirfile
), 0) < 0)
4224 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4229 #endif /* !(WINDOWSNT || HAVE_NS) */
4231 /* If the EMACSLOADPATH environment variable is set, use its value.
4232 This doesn't apply if we're dumping. */
4234 if (NILP (Vpurify_flag
)
4235 && egetenv ("EMACSLOADPATH"))
4237 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4241 load_in_progress
= 0;
4242 Vload_file_name
= Qnil
;
4244 load_descriptor_list
= Qnil
;
4246 Vstandard_input
= Qt
;
4247 Vloads_in_progress
= Qnil
;
4250 /* Print a warning, using format string FORMAT, that directory DIRNAME
4251 does not exist. Print it on stderr and put it in *Messages*. */
4254 dir_warning (const char *format
, Lisp_Object dirname
)
4257 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4259 fprintf (stderr
, format
, SDATA (dirname
));
4260 sprintf (buffer
, format
, SDATA (dirname
));
4261 /* Don't log the warning before we've initialized!! */
4263 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4267 syms_of_lread (void)
4270 defsubr (&Sread_from_string
);
4272 defsubr (&Sintern_soft
);
4273 defsubr (&Sunintern
);
4274 defsubr (&Sget_load_suffixes
);
4276 defsubr (&Seval_buffer
);
4277 defsubr (&Seval_region
);
4278 defsubr (&Sread_char
);
4279 defsubr (&Sread_char_exclusive
);
4280 defsubr (&Sread_event
);
4281 defsubr (&Sget_file_char
);
4282 defsubr (&Smapatoms
);
4283 defsubr (&Slocate_file_internal
);
4285 DEFVAR_LISP ("obarray", Vobarray
,
4286 doc
: /* Symbol table for use by `intern' and `read'.
4287 It is a vector whose length ought to be prime for best results.
4288 The vector's contents don't make sense if examined from Lisp programs;
4289 to find all the symbols in an obarray, use `mapatoms'. */);
4291 DEFVAR_LISP ("values", Vvalues
,
4292 doc
: /* List of values of all expressions which were read, evaluated and printed.
4293 Order is reverse chronological. */);
4295 DEFVAR_LISP ("standard-input", Vstandard_input
,
4296 doc
: /* Stream for read to get input from.
4297 See documentation of `read' for possible values. */);
4298 Vstandard_input
= Qt
;
4300 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4301 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4303 If this variable is a buffer, then only forms read from that buffer
4304 will be added to `read-symbol-positions-list'.
4305 If this variable is t, then all read forms will be added.
4306 The effect of all other values other than nil are not currently
4307 defined, although they may be in the future.
4309 The positions are relative to the last call to `read' or
4310 `read-from-string'. It is probably a bad idea to set this variable at
4311 the toplevel; bind it instead. */);
4312 Vread_with_symbol_positions
= Qnil
;
4314 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4315 doc
: /* A list mapping read symbols to their positions.
4316 This variable is modified during calls to `read' or
4317 `read-from-string', but only when `read-with-symbol-positions' is
4320 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4321 CHAR-POSITION is an integer giving the offset of that occurrence of the
4322 symbol from the position where `read' or `read-from-string' started.
4324 Note that a symbol will appear multiple times in this list, if it was
4325 read multiple times. The list is in the same order as the symbols
4327 Vread_symbol_positions_list
= Qnil
;
4329 DEFVAR_LISP ("read-circle", Vread_circle
,
4330 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4333 DEFVAR_LISP ("load-path", Vload_path
,
4334 doc
: /* *List of directories to search for files to load.
4335 Each element is a string (directory name) or nil (try default directory).
4336 Initialized based on EMACSLOADPATH environment variable, if any,
4337 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4339 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4340 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4341 This list should not include the empty string.
4342 `load' and related functions try to append these suffixes, in order,
4343 to the specified file name if a Lisp suffix is allowed or required. */);
4344 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4345 Fcons (make_pure_c_string (".el"), Qnil
));
4346 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4347 doc
: /* List of suffixes that indicate representations of \
4349 This list should normally start with the empty string.
4351 Enabling Auto Compression mode appends the suffixes in
4352 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4353 mode removes them again. `load' and related functions use this list to
4354 determine whether they should look for compressed versions of a file
4355 and, if so, which suffixes they should try to append to the file name
4356 in order to do so. However, if you want to customize which suffixes
4357 the loading functions recognize as compression suffixes, you should
4358 customize `jka-compr-load-suffixes' rather than the present variable. */);
4359 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4361 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4362 doc
: /* Non-nil if inside of `load'. */);
4363 Qload_in_progress
= intern_c_string ("load-in-progress");
4364 staticpro (&Qload_in_progress
);
4366 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4367 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4368 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4370 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4371 a symbol \(a feature name).
4373 When `load' is run and the file-name argument matches an element's
4374 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4375 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4377 An error in FORMS does not undo the load, but does prevent execution of
4378 the rest of the FORMS. */);
4379 Vafter_load_alist
= Qnil
;
4381 DEFVAR_LISP ("load-history", Vload_history
,
4382 doc
: /* Alist mapping loaded file names to symbols and features.
4383 Each alist element should be a list (FILE-NAME ENTRIES...), where
4384 FILE-NAME is the name of a file that has been loaded into Emacs.
4385 The file name is absolute and true (i.e. it doesn't contain symlinks).
4386 As an exception, one of the alist elements may have FILE-NAME nil,
4387 for symbols and features not associated with any file.
4389 The remaining ENTRIES in the alist element describe the functions and
4390 variables defined in that file, the features provided, and the
4391 features required. Each entry has the form `(provide . FEATURE)',
4392 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4393 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4394 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4395 SYMBOL was an autoload before this file redefined it as a function.
4397 During preloading, the file name recorded is relative to the main Lisp
4398 directory. These file names are converted to absolute at startup. */);
4399 Vload_history
= Qnil
;
4401 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4402 doc
: /* Full name of file being loaded by `load'. */);
4403 Vload_file_name
= Qnil
;
4405 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4406 doc
: /* File name, including directory, of user's initialization file.
4407 If the file loaded had extension `.elc', and the corresponding source file
4408 exists, this variable contains the name of source file, suitable for use
4409 by functions like `custom-save-all' which edit the init file.
4410 While Emacs loads and evaluates the init file, value is the real name
4411 of the file, regardless of whether or not it has the `.elc' extension. */);
4412 Vuser_init_file
= Qnil
;
4414 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4415 doc
: /* Used for internal purposes by `load'. */);
4416 Vcurrent_load_list
= Qnil
;
4418 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4419 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4420 The default is nil, which means use the function `read'. */);
4421 Vload_read_function
= Qnil
;
4423 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4424 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4425 This function is for doing code conversion before reading the source file.
4426 If nil, loading is done without any code conversion.
4427 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4428 FULLNAME is the full name of FILE.
4429 See `load' for the meaning of the remaining arguments. */);
4430 Vload_source_file_function
= Qnil
;
4432 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4433 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4434 This is useful when the file being loaded is a temporary copy. */);
4435 load_force_doc_strings
= 0;
4437 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4438 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4439 This is normally bound by `load' and `eval-buffer' to control `read',
4440 and is not meant for users to change. */);
4441 load_convert_to_unibyte
= 0;
4443 DEFVAR_LISP ("source-directory", Vsource_directory
,
4444 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4445 You cannot count on them to still be there! */);
4447 = Fexpand_file_name (build_string ("../"),
4448 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4450 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4451 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4452 Vpreloaded_file_list
= Qnil
;
4454 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4455 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4456 Vbyte_boolean_vars
= Qnil
;
4458 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4459 doc
: /* Non-nil means load dangerous compiled Lisp files.
4460 Some versions of XEmacs use different byte codes than Emacs. These
4461 incompatible byte codes can make Emacs crash when it tries to execute
4463 load_dangerous_libraries
= 0;
4465 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4466 doc
: /* Non-nil means force printing messages when loading Lisp files.
4467 This overrides the value of the NOMESSAGE argument to `load'. */);
4468 force_load_messages
= 0;
4470 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4471 doc
: /* Regular expression matching safe to load compiled Lisp files.
4472 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4473 from the file, and matches them against this regular expression.
4474 When the regular expression matches, the file is considered to be safe
4475 to load. See also `load-dangerous-libraries'. */);
4476 Vbytecomp_version_regexp
4477 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4479 Qlexical_binding
= intern ("lexical-binding");
4480 staticpro (&Qlexical_binding
);
4481 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4482 doc
: /* If non-nil, use lexical binding when evaluating code.
4483 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4484 This variable is automatically set from the file variables of an interpreted
4485 lisp file read using `load'. */);
4486 Fmake_variable_buffer_local (Qlexical_binding
);
4488 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4489 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4490 Veval_buffer_list
= Qnil
;
4492 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4493 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4494 Vold_style_backquotes
= Qnil
;
4495 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4496 staticpro (&Qold_style_backquotes
);
4498 /* Vsource_directory was initialized in init_lread. */
4500 load_descriptor_list
= Qnil
;
4501 staticpro (&load_descriptor_list
);
4503 Qcurrent_load_list
= intern_c_string ("current-load-list");
4504 staticpro (&Qcurrent_load_list
);
4506 Qstandard_input
= intern_c_string ("standard-input");
4507 staticpro (&Qstandard_input
);
4509 Qread_char
= intern_c_string ("read-char");
4510 staticpro (&Qread_char
);
4512 Qget_file_char
= intern_c_string ("get-file-char");
4513 staticpro (&Qget_file_char
);
4515 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4516 staticpro (&Qget_emacs_mule_file_char
);
4518 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4519 staticpro (&Qload_force_doc_strings
);
4521 Qbackquote
= intern_c_string ("`");
4522 staticpro (&Qbackquote
);
4523 Qcomma
= intern_c_string (",");
4524 staticpro (&Qcomma
);
4525 Qcomma_at
= intern_c_string (",@");
4526 staticpro (&Qcomma_at
);
4527 Qcomma_dot
= intern_c_string (",.");
4528 staticpro (&Qcomma_dot
);
4530 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4531 staticpro (&Qinhibit_file_name_operation
);
4533 Qascii_character
= intern_c_string ("ascii-character");
4534 staticpro (&Qascii_character
);
4536 Qfunction
= intern_c_string ("function");
4537 staticpro (&Qfunction
);
4539 Qload
= intern_c_string ("load");
4542 Qload_file_name
= intern_c_string ("load-file-name");
4543 staticpro (&Qload_file_name
);
4545 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4546 staticpro (&Qeval_buffer_list
);
4548 Qfile_truename
= intern_c_string ("file-truename");
4549 staticpro (&Qfile_truename
) ;
4551 Qdir_ok
= intern_c_string ("dir-ok");
4552 staticpro (&Qdir_ok
);
4554 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4555 staticpro (&Qdo_after_load_evaluation
) ;
4557 staticpro (&dump_path
);
4559 staticpro (&read_objects
);
4560 read_objects
= Qnil
;
4561 staticpro (&seen_list
);
4564 Vloads_in_progress
= Qnil
;
4565 staticpro (&Vloads_in_progress
);
4567 Qhash_table
= intern_c_string ("hash-table");
4568 staticpro (&Qhash_table
);
4569 Qdata
= intern_c_string ("data");
4571 Qtest
= intern_c_string ("test");
4573 Qsize
= intern_c_string ("size");
4575 Qweakness
= intern_c_string ("weakness");
4576 staticpro (&Qweakness
);
4577 Qrehash_size
= intern_c_string ("rehash-size");
4578 staticpro (&Qrehash_size
);
4579 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4580 staticpro (&Qrehash_threshold
);