1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
29 #include "intervals.h"
31 #include "character.h"
38 #include "termhooks.h"
40 #include "blockinput.h"
51 #endif /* HAVE_SETLOCALE */
56 #define file_offset off_t
57 #define file_tell ftello
59 #define file_offset long
60 #define file_tell ftell
63 /* hash table read constants */
64 Lisp_Object Qhash_table
, Qdata
;
65 Lisp_Object Qtest
, Qsize
;
66 Lisp_Object Qweakness
;
67 Lisp_Object Qrehash_size
;
68 Lisp_Object Qrehash_threshold
;
70 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
71 Lisp_Object Qvariable_documentation
;
72 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
73 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
74 Lisp_Object Qinhibit_file_name_operation
;
75 Lisp_Object Qeval_buffer_list
;
76 Lisp_Object Qlexical_binding
;
77 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
79 /* Used instead of Qget_file_char while loading *.elc files compiled
80 by Emacs 21 or older. */
81 static Lisp_Object Qget_emacs_mule_file_char
;
83 static Lisp_Object Qload_force_doc_strings
;
85 extern Lisp_Object Qinternal_interpreter_environment
;
87 static Lisp_Object Qload_in_progress
;
89 /* The association list of objects read with the #n=object form.
90 Each member of the list has the form (n . object), and is used to
91 look up the object for the corresponding #n# construct.
92 It must be set to nil before all top-level calls to read0. */
93 Lisp_Object read_objects
;
95 /* Nonzero means READCHAR should read bytes one by one (not character)
96 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
97 This is set to 1 by read1 temporarily while handling #@NUMBER. */
98 static int load_each_byte
;
100 /* List of descriptors now open for Fload. */
101 static Lisp_Object load_descriptor_list
;
103 /* File for get_file_char to read from. Use by load. */
104 static FILE *instream
;
106 /* When nonzero, read conses in pure space */
107 static int read_pure
;
109 /* For use within read-from-string (this reader is non-reentrant!!) */
110 static EMACS_INT read_from_string_index
;
111 static EMACS_INT read_from_string_index_byte
;
112 static EMACS_INT read_from_string_limit
;
114 /* Number of characters read in the current call to Fread or
115 Fread_from_string. */
116 static EMACS_INT readchar_count
;
118 /* This contains the last string skipped with #@. */
119 static char *saved_doc_string
;
120 /* Length of buffer allocated in saved_doc_string. */
121 static int saved_doc_string_size
;
122 /* Length of actual data in saved_doc_string. */
123 static int saved_doc_string_length
;
124 /* This is the file position that string came from. */
125 static file_offset saved_doc_string_position
;
127 /* This contains the previous string skipped with #@.
128 We copy it from saved_doc_string when a new string
129 is put in saved_doc_string. */
130 static char *prev_saved_doc_string
;
131 /* Length of buffer allocated in prev_saved_doc_string. */
132 static int prev_saved_doc_string_size
;
133 /* Length of actual data in prev_saved_doc_string. */
134 static int prev_saved_doc_string_length
;
135 /* This is the file position that string came from. */
136 static file_offset prev_saved_doc_string_position
;
138 /* Nonzero means inside a new-style backquote
139 with no surrounding parentheses.
140 Fread initializes this to zero, so we need not specbind it
141 or worry about what happens to it when there is an error. */
142 static int new_backquote_flag
;
143 static Lisp_Object Qold_style_backquotes
;
145 /* A list of file names for files being loaded in Fload. Used to
146 check for recursive loads. */
148 static Lisp_Object Vloads_in_progress
;
150 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
153 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
154 Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
);
156 static Lisp_Object
load_unwind (Lisp_Object
);
157 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
159 static void invalid_syntax (const char *, int) NO_RETURN
;
160 static void end_of_file_error (void) NO_RETURN
;
163 /* Functions that read one byte from the current source READCHARFUN
164 or unreads one byte. If the integer argument C is -1, it returns
165 one read byte, or -1 when there's no more byte in the source. If C
166 is 0 or positive, it unreads C, and the return value is not
169 static int readbyte_for_lambda (int, Lisp_Object
);
170 static int readbyte_from_file (int, Lisp_Object
);
171 static int readbyte_from_string (int, Lisp_Object
);
173 /* Handle unreading and rereading of characters.
174 Write READCHAR to read a character,
175 UNREAD(c) to unread c to be read again.
177 These macros correctly read/unread multibyte characters. */
179 #define READCHAR readchar (readcharfun, NULL)
180 #define UNREAD(c) unreadchar (readcharfun, c)
182 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
183 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
185 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
186 Qlambda, or a cons, we use this to keep an unread character because
187 a file stream can't handle multibyte-char unreading. The value -1
188 means that there's no unread character. */
189 static int unread_char
;
192 readchar (Lisp_Object readcharfun
, int *multibyte
)
196 int (*readbyte
) (int, Lisp_Object
);
197 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
199 int emacs_mule_encoding
= 0;
206 if (BUFFERP (readcharfun
))
208 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
210 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
212 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
215 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
217 /* Fetch the character code from the buffer. */
218 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
219 BUF_INC_POS (inbuffer
, pt_byte
);
226 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
227 if (! ASCII_BYTE_P (c
))
228 c
= BYTE8_TO_CHAR (c
);
231 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
235 if (MARKERP (readcharfun
))
237 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
239 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
241 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
244 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
246 /* Fetch the character code from the buffer. */
247 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
248 BUF_INC_POS (inbuffer
, bytepos
);
255 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
256 if (! ASCII_BYTE_P (c
))
257 c
= BYTE8_TO_CHAR (c
);
261 XMARKER (readcharfun
)->bytepos
= bytepos
;
262 XMARKER (readcharfun
)->charpos
++;
267 if (EQ (readcharfun
, Qlambda
))
269 readbyte
= readbyte_for_lambda
;
273 if (EQ (readcharfun
, Qget_file_char
))
275 readbyte
= readbyte_from_file
;
279 if (STRINGP (readcharfun
))
281 if (read_from_string_index
>= read_from_string_limit
)
283 else if (STRING_MULTIBYTE (readcharfun
))
287 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
288 read_from_string_index
,
289 read_from_string_index_byte
);
293 c
= SREF (readcharfun
, read_from_string_index_byte
);
294 read_from_string_index
++;
295 read_from_string_index_byte
++;
300 if (CONSP (readcharfun
))
302 /* This is the case that read_vector is reading from a unibyte
303 string that contains a byte sequence previously skipped
304 because of #@NUMBER. The car part of readcharfun is that
305 string, and the cdr part is a value of readcharfun given to
307 readbyte
= readbyte_from_string
;
308 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
309 emacs_mule_encoding
= 1;
313 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
315 readbyte
= readbyte_from_file
;
316 emacs_mule_encoding
= 1;
320 tem
= call0 (readcharfun
);
327 if (unread_char
>= 0)
333 c
= (*readbyte
) (-1, readcharfun
);
334 if (c
< 0 || load_each_byte
)
338 if (ASCII_BYTE_P (c
))
340 if (emacs_mule_encoding
)
341 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
344 len
= BYTES_BY_CHAR_HEAD (c
);
347 c
= (*readbyte
) (-1, readcharfun
);
348 if (c
< 0 || ! TRAILING_CODE_P (c
))
351 (*readbyte
) (buf
[i
], readcharfun
);
352 return BYTE8_TO_CHAR (buf
[0]);
356 return STRING_CHAR (buf
);
359 /* Unread the character C in the way appropriate for the stream READCHARFUN.
360 If the stream is a user function, call it with the char as argument. */
363 unreadchar (Lisp_Object readcharfun
, int c
)
367 /* Don't back up the pointer if we're unreading the end-of-input mark,
368 since readchar didn't advance it when we read it. */
370 else if (BUFFERP (readcharfun
))
372 struct buffer
*b
= XBUFFER (readcharfun
);
373 EMACS_INT charpos
= BUF_PT (b
);
374 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
376 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
377 BUF_DEC_POS (b
, bytepos
);
381 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
383 else if (MARKERP (readcharfun
))
385 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
386 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
388 XMARKER (readcharfun
)->charpos
--;
389 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
390 BUF_DEC_POS (b
, bytepos
);
394 XMARKER (readcharfun
)->bytepos
= bytepos
;
396 else if (STRINGP (readcharfun
))
398 read_from_string_index
--;
399 read_from_string_index_byte
400 = string_char_to_byte (readcharfun
, read_from_string_index
);
402 else if (CONSP (readcharfun
))
406 else if (EQ (readcharfun
, Qlambda
))
410 else if (EQ (readcharfun
, Qget_file_char
)
411 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
416 ungetc (c
, instream
);
423 call1 (readcharfun
, make_number (c
));
427 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
429 return read_bytecode_char (c
>= 0);
434 readbyte_from_file (int c
, Lisp_Object readcharfun
)
439 ungetc (c
, instream
);
448 /* Interrupted reads have been observed while reading over the network */
449 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
461 return (c
== EOF
? -1 : c
);
465 readbyte_from_string (int c
, Lisp_Object readcharfun
)
467 Lisp_Object string
= XCAR (readcharfun
);
471 read_from_string_index
--;
472 read_from_string_index_byte
473 = string_char_to_byte (string
, read_from_string_index
);
476 if (read_from_string_index
>= read_from_string_limit
)
479 FETCH_STRING_CHAR_ADVANCE (c
, string
,
480 read_from_string_index
,
481 read_from_string_index_byte
);
486 /* Read one non-ASCII character from INSTREAM. The character is
487 encoded in `emacs-mule' and the first byte is already read in
491 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
493 /* Emacs-mule coding uses at most 4-byte for one character. */
494 unsigned char buf
[4];
495 int len
= emacs_mule_bytes
[c
];
496 struct charset
*charset
;
501 /* C is not a valid leading-code of `emacs-mule'. */
502 return BYTE8_TO_CHAR (c
);
508 c
= (*readbyte
) (-1, readcharfun
);
512 (*readbyte
) (buf
[i
], readcharfun
);
513 return BYTE8_TO_CHAR (buf
[0]);
520 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
521 code
= buf
[1] & 0x7F;
525 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
526 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
528 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
529 code
= buf
[2] & 0x7F;
533 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
534 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
540 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
542 c
= DECODE_CHAR (charset
, code
);
544 Fsignal (Qinvalid_read_syntax
,
545 Fcons (build_string ("invalid multibyte form"), Qnil
));
550 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
552 static Lisp_Object
read0 (Lisp_Object
);
553 static Lisp_Object
read1 (Lisp_Object
, int *, int);
555 static Lisp_Object
read_list (int, Lisp_Object
);
556 static Lisp_Object
read_vector (Lisp_Object
, int);
558 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
560 static void substitute_object_in_subtree (Lisp_Object
,
562 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
565 /* Get a character from the tty. */
567 /* Read input events until we get one that's acceptable for our purposes.
569 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
570 until we get a character we like, and then stuffed into
573 If ASCII_REQUIRED is non-zero, we check function key events to see
574 if the unmodified version of the symbol has a Qascii_character
575 property, and use that character, if present.
577 If ERROR_NONASCII is non-zero, we signal an error if the input we
578 get isn't an ASCII character with modifiers. If it's zero but
579 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
582 If INPUT_METHOD is nonzero, we invoke the current input method
583 if the character warrants that.
585 If SECONDS is a number, we wait that many seconds for input, and
586 return Qnil if no input arrives within that time. */
589 read_filtered_event (int no_switch_frame
, int ascii_required
,
590 int error_nonascii
, int input_method
, Lisp_Object seconds
)
592 Lisp_Object val
, delayed_switch_frame
;
595 #ifdef HAVE_WINDOW_SYSTEM
596 if (display_hourglass_p
)
600 delayed_switch_frame
= Qnil
;
602 /* Compute timeout. */
603 if (NUMBERP (seconds
))
605 EMACS_TIME wait_time
;
607 double duration
= extract_float (seconds
);
609 sec
= (int) duration
;
610 usec
= (duration
- sec
) * 1000000;
611 EMACS_GET_TIME (end_time
);
612 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
613 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
616 /* Read until we get an acceptable event. */
619 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
620 NUMBERP (seconds
) ? &end_time
: NULL
);
621 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
626 /* switch-frame events are put off until after the next ASCII
627 character. This is better than signaling an error just because
628 the last characters were typed to a separate minibuffer frame,
629 for example. Eventually, some code which can deal with
630 switch-frame events will read it and process it. */
632 && EVENT_HAS_PARAMETERS (val
)
633 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
635 delayed_switch_frame
= val
;
639 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
641 /* Convert certain symbols to their ASCII equivalents. */
644 Lisp_Object tem
, tem1
;
645 tem
= Fget (val
, Qevent_symbol_element_mask
);
648 tem1
= Fget (Fcar (tem
), Qascii_character
);
649 /* Merge this symbol's modifier bits
650 with the ASCII equivalent of its basic code. */
652 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
656 /* If we don't have a character now, deal with it appropriately. */
661 Vunread_command_events
= Fcons (val
, Qnil
);
662 error ("Non-character input-event");
669 if (! NILP (delayed_switch_frame
))
670 unread_switch_frame
= delayed_switch_frame
;
674 #ifdef HAVE_WINDOW_SYSTEM
675 if (display_hourglass_p
)
684 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
685 doc
: /* Read a character from the command input (keyboard or macro).
686 It is returned as a number.
687 If the character has modifiers, they are resolved and reflected to the
688 character code if possible (e.g. C-SPC -> 0).
690 If the user generates an event which is not a character (i.e. a mouse
691 click or function key event), `read-char' signals an error. As an
692 exception, switch-frame events are put off until non-character events
694 If you want to read non-character events, or ignore them, call
695 `read-event' or `read-char-exclusive' instead.
697 If the optional argument PROMPT is non-nil, display that as a prompt.
698 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
699 input method is turned on in the current buffer, that input method
700 is used for reading a character.
701 If the optional argument SECONDS is non-nil, it should be a number
702 specifying the maximum number of seconds to wait for input. If no
703 input arrives in that time, return nil. SECONDS may be a
704 floating-point value. */)
705 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
710 message_with_string ("%s", prompt
, 0);
711 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
713 return (NILP (val
) ? Qnil
714 : make_number (char_resolve_modifier_mask (XINT (val
))));
717 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
718 doc
: /* Read an event object from the input stream.
719 If the optional argument PROMPT is non-nil, display that as a prompt.
720 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
721 input method is turned on in the current buffer, that input method
722 is used for reading a character.
723 If the optional argument SECONDS is non-nil, it should be a number
724 specifying the maximum number of seconds to wait for input. If no
725 input arrives in that time, return nil. SECONDS may be a
726 floating-point value. */)
727 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
730 message_with_string ("%s", prompt
, 0);
731 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
734 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
735 doc
: /* Read a character from the command input (keyboard or macro).
736 It is returned as a number. Non-character events are ignored.
737 If the character has modifiers, they are resolved and reflected to the
738 character code if possible (e.g. C-SPC -> 0).
740 If the optional argument PROMPT is non-nil, display that as a prompt.
741 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
742 input method is turned on in the current buffer, that input method
743 is used for reading a character.
744 If the optional argument SECONDS is non-nil, it should be a number
745 specifying the maximum number of seconds to wait for input. If no
746 input arrives in that time, return nil. SECONDS may be a
747 floating-point value. */)
748 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
753 message_with_string ("%s", prompt
, 0);
755 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
757 return (NILP (val
) ? Qnil
758 : make_number (char_resolve_modifier_mask (XINT (val
))));
761 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
762 doc
: /* Don't use this yourself. */)
765 register Lisp_Object val
;
767 XSETINT (val
, getc (instream
));
775 /* Return true if the lisp code read using READCHARFUN defines a non-nil
776 `lexical-binding' file variable. After returning, the stream is
777 positioned following the first line, if it is a comment, otherwise
781 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
785 /* The first line isn't a comment, just give up. */
791 /* Look for an appropriate file-variable in the first line. */
795 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
796 } beg_end_state
= NOMINAL
;
797 int in_file_vars
= 0;
799 #define UPDATE_BEG_END_STATE(ch) \
800 if (beg_end_state == NOMINAL) \
801 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
802 else if (beg_end_state == AFTER_FIRST_DASH) \
803 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
804 else if (beg_end_state == AFTER_ASTERIX) \
807 in_file_vars = !in_file_vars; \
808 beg_end_state = NOMINAL; \
811 /* Skip until we get to the file vars, if any. */
815 UPDATE_BEG_END_STATE (ch
);
817 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
821 char var
[100], *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
)
884 /* Value is a version number of byte compiled code if the file
885 associated with file descriptor FD is a compiled Lisp file that's
886 safe to load. Only files compiled with Emacs are safe to load.
887 Files compiled with XEmacs can lead to a crash in Fbyte_code
888 because of an incompatible change in the byte compiler. */
891 safe_to_load_p (int fd
)
898 /* Read the first few bytes from the file, and look for a line
899 specifying the byte compiler version used. */
900 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
905 /* Skip to the next newline, skipping over the initial `ELC'
906 with NUL bytes following it, but note the version. */
907 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
912 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
919 lseek (fd
, 0, SEEK_SET
);
924 /* Callback for record_unwind_protect. Restore the old load list OLD,
925 after loading a file successfully. */
928 record_load_unwind (Lisp_Object old
)
930 return Vloads_in_progress
= old
;
933 /* This handler function is used via internal_condition_case_1. */
936 load_error_handler (Lisp_Object data
)
942 load_warn_old_style_backquotes (Lisp_Object file
)
944 if (!NILP (Vold_style_backquotes
))
947 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
954 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
955 doc
: /* Return the suffixes that `load' should try if a suffix is \
957 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
960 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
961 while (CONSP (suffixes
))
963 Lisp_Object exts
= Vload_file_rep_suffixes
;
964 suffix
= XCAR (suffixes
);
965 suffixes
= XCDR (suffixes
);
970 lst
= Fcons (concat2 (suffix
, ext
), lst
);
973 return Fnreverse (lst
);
976 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
977 doc
: /* Execute a file of Lisp code named FILE.
978 First try FILE with `.elc' appended, then try with `.el',
979 then try FILE unmodified (the exact suffixes in the exact order are
980 determined by `load-suffixes'). Environment variable references in
981 FILE are replaced with their values by calling `substitute-in-file-name'.
982 This function searches the directories in `load-path'.
984 If optional second arg NOERROR is non-nil,
985 report no error if FILE doesn't exist.
986 Print messages at start and end of loading unless
987 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
989 If optional fourth arg NOSUFFIX is non-nil, don't try adding
990 suffixes `.elc' or `.el' to the specified name FILE.
991 If optional fifth arg MUST-SUFFIX is non-nil, insist on
992 the suffix `.elc' or `.el'; don't accept just FILE unless
993 it ends in one of those suffixes or includes a directory name.
995 If this function fails to find a file, it may look for different
996 representations of that file before trying another file.
997 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
998 to the file name. Emacs uses this feature mainly to find compressed
999 versions of files when Auto Compression mode is enabled.
1001 The exact suffixes that this function tries out, in the exact order,
1002 are given by the value of the variable `load-file-rep-suffixes' if
1003 NOSUFFIX is non-nil and by the return value of the function
1004 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1005 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1006 and then the former.
1008 Loading a file records its definitions, and its `provide' and
1009 `require' calls, in an element of `load-history' whose
1010 car is the file name loaded. See `load-history'.
1012 While the file is in the process of being loaded, the variable
1013 `load-in-progress' is non-nil and the variable `load-file-name'
1014 is bound to the file's name.
1016 Return t if the file exists and loads successfully. */)
1017 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1019 register FILE *stream
;
1020 register int fd
= -1;
1021 int count
= SPECPDL_INDEX ();
1022 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1023 Lisp_Object found
, efound
, hist_file_name
;
1024 /* 1 means we printed the ".el is newer" message. */
1026 /* 1 means we are loading a compiled file. */
1028 Lisp_Object handler
;
1030 const char *fmode
= "r";
1038 CHECK_STRING (file
);
1040 /* If file name is magic, call the handler. */
1041 /* This shouldn't be necessary any more now that `openp' handles it right.
1042 handler = Ffind_file_name_handler (file, Qload);
1043 if (!NILP (handler))
1044 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1046 /* Do this after the handler to avoid
1047 the need to gcpro noerror, nomessage and nosuffix.
1048 (Below here, we care only whether they are nil or not.)
1049 The presence of this call is the result of a historical accident:
1050 it used to be in every file-operation and when it got removed
1051 everywhere, it accidentally stayed here. Since then, enough people
1052 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1053 that it seemed risky to remove. */
1054 if (! NILP (noerror
))
1056 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1057 Qt
, load_error_handler
);
1062 file
= Fsubstitute_in_file_name (file
);
1065 /* Avoid weird lossage with null string as arg,
1066 since it would try to load a directory as a Lisp file */
1067 if (SCHARS (file
) > 0)
1069 int size
= SBYTES (file
);
1072 GCPRO2 (file
, found
);
1074 if (! NILP (must_suffix
))
1076 /* Don't insist on adding a suffix if FILE already ends with one. */
1078 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1081 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1083 /* Don't insist on adding a suffix
1084 if the argument includes a directory name. */
1085 else if (! NILP (Ffile_name_directory (file
)))
1089 fd
= openp (Vload_path
, file
,
1090 (!NILP (nosuffix
) ? Qnil
1091 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1092 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1093 tmp
[1] = Vload_file_rep_suffixes
,
1102 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1106 /* Tell startup.el whether or not we found the user's init file. */
1107 if (EQ (Qt
, Vuser_init_file
))
1108 Vuser_init_file
= found
;
1110 /* If FD is -2, that means openp found a magic file. */
1113 if (NILP (Fequal (found
, file
)))
1114 /* If FOUND is a different file name from FILE,
1115 find its handler even if we have already inhibited
1116 the `load' operation on FILE. */
1117 handler
= Ffind_file_name_handler (found
, Qt
);
1119 handler
= Ffind_file_name_handler (found
, Qload
);
1120 if (! NILP (handler
))
1121 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1124 /* Check if we're stuck in a recursive load cycle.
1126 2000-09-21: It's not possible to just check for the file loaded
1127 being a member of Vloads_in_progress. This fails because of the
1128 way the byte compiler currently works; `provide's are not
1129 evaluated, see font-lock.el/jit-lock.el as an example. This
1130 leads to a certain amount of ``normal'' recursion.
1132 Also, just loading a file recursively is not always an error in
1133 the general case; the second load may do something different. */
1137 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1138 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1142 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1144 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1145 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1148 /* All loads are by default dynamic, unless the file itself specifies
1149 otherwise using a file-variable in the first line. This is bound here
1150 so that it takes effect whether or not we use
1151 Vload_source_file_function. */
1152 specbind (Qlexical_binding
, Qnil
);
1154 /* Get the name for load-history. */
1155 hist_file_name
= (! NILP (Vpurify_flag
)
1156 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1157 tmp
[1] = Ffile_name_nondirectory (found
),
1163 /* Check for the presence of old-style quotes and warn about them. */
1164 specbind (Qold_style_backquotes
, Qnil
);
1165 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1167 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1168 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1169 /* Load .elc files directly, but not when they are
1170 remote and have no handler! */
1177 GCPRO3 (file
, found
, hist_file_name
);
1180 && ! (version
= safe_to_load_p (fd
)))
1183 if (!load_dangerous_libraries
)
1187 error ("File `%s' was not compiled in Emacs",
1190 else if (!NILP (nomessage
) && !force_load_messages
)
1191 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1196 efound
= ENCODE_FILE (found
);
1201 stat (SSDATA (efound
), &s1
);
1202 SSET (efound
, SBYTES (efound
) - 1, 0);
1203 result
= stat (SSDATA (efound
), &s2
);
1204 SSET (efound
, SBYTES (efound
) - 1, 'c');
1206 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1208 /* Make the progress messages mention that source is newer. */
1211 /* If we won't print another message, mention this anyway. */
1212 if (!NILP (nomessage
) && !force_load_messages
)
1214 Lisp_Object msg_file
;
1215 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1216 message_with_string ("Source file `%s' newer than byte-compiled file",
1225 /* We are loading a source file (*.el). */
1226 if (!NILP (Vload_source_file_function
))
1232 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1233 NILP (noerror
) ? Qnil
: Qt
,
1234 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1235 return unbind_to (count
, val
);
1239 GCPRO3 (file
, found
, hist_file_name
);
1243 efound
= ENCODE_FILE (found
);
1244 stream
= fopen (SSDATA (efound
), fmode
);
1245 #else /* not WINDOWSNT */
1246 stream
= fdopen (fd
, fmode
);
1247 #endif /* not WINDOWSNT */
1251 error ("Failure to create stdio stream for %s", SDATA (file
));
1254 if (! NILP (Vpurify_flag
))
1255 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1257 if (NILP (nomessage
) || force_load_messages
)
1260 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1263 message_with_string ("Loading %s (source)...", file
, 1);
1265 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1267 else /* The typical case; compiled file newer than source file. */
1268 message_with_string ("Loading %s...", file
, 1);
1271 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1272 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1273 specbind (Qload_file_name
, found
);
1274 specbind (Qinhibit_file_name_operation
, Qnil
);
1275 load_descriptor_list
1276 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1277 specbind (Qload_in_progress
, Qt
);
1280 if (lisp_file_lexically_bound_p (Qget_file_char
))
1281 Fset (Qlexical_binding
, Qt
);
1283 if (! version
|| version
>= 22)
1284 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1285 0, Qnil
, Qnil
, Qnil
, Qnil
);
1288 /* We can't handle a file which was compiled with
1289 byte-compile-dynamic by older version of Emacs. */
1290 specbind (Qload_force_doc_strings
, Qt
);
1291 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1292 0, Qnil
, Qnil
, Qnil
, Qnil
);
1294 unbind_to (count
, Qnil
);
1296 /* Run any eval-after-load forms for this file */
1297 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1298 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1302 xfree (saved_doc_string
);
1303 saved_doc_string
= 0;
1304 saved_doc_string_size
= 0;
1306 xfree (prev_saved_doc_string
);
1307 prev_saved_doc_string
= 0;
1308 prev_saved_doc_string_size
= 0;
1310 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1313 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1316 message_with_string ("Loading %s (source)...done", file
, 1);
1318 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1320 else /* The typical case; compiled file newer than source file. */
1321 message_with_string ("Loading %s...done", file
, 1);
1328 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1330 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1341 load_descriptor_unwind (Lisp_Object oldlist
)
1343 load_descriptor_list
= oldlist
;
1347 /* Close all descriptors in use for Floads.
1348 This is used when starting a subprocess. */
1351 close_load_descs (void)
1355 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1356 emacs_close (XFASTINT (XCAR (tail
)));
1361 complete_filename_p (Lisp_Object pathname
)
1363 register const unsigned char *s
= SDATA (pathname
);
1364 return (IS_DIRECTORY_SEP (s
[0])
1365 || (SCHARS (pathname
) > 2
1366 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1369 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1370 doc
: /* Search for FILENAME through PATH.
1371 Returns the file's name in absolute form, or nil if not found.
1372 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1373 file name when searching.
1374 If non-nil, PREDICATE is used instead of `file-readable-p'.
1375 PREDICATE can also be an integer to pass to the access(2) function,
1376 in which case file-name-handlers are ignored.
1377 This function will normally skip directories, so if you want it to find
1378 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1379 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1382 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1383 if (NILP (predicate
) && fd
> 0)
1388 static Lisp_Object Qdir_ok
;
1390 /* Search for a file whose name is STR, looking in directories
1391 in the Lisp list PATH, and trying suffixes from SUFFIX.
1392 On success, returns a file descriptor. On failure, returns -1.
1394 SUFFIXES is a list of strings containing possible suffixes.
1395 The empty suffix is automatically added if the list is empty.
1397 PREDICATE non-nil means don't open the files,
1398 just look for one that satisfies the predicate. In this case,
1399 returns 1 on success. The predicate can be a lisp function or
1400 an integer to pass to `access' (in which case file-name-handlers
1403 If STOREPTR is nonzero, it points to a slot where the name of
1404 the file actually found should be stored as a Lisp string.
1405 nil is stored there on failure.
1407 If the file we find is remote, return -2
1408 but store the found remote file name in *STOREPTR. */
1411 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1416 register char *fn
= buf
;
1419 Lisp_Object filename
;
1421 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1422 Lisp_Object string
, tail
, encoded_fn
;
1423 int max_suffix_len
= 0;
1427 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1429 CHECK_STRING_CAR (tail
);
1430 max_suffix_len
= max (max_suffix_len
,
1431 SBYTES (XCAR (tail
)));
1434 string
= filename
= encoded_fn
= Qnil
;
1435 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1440 if (complete_filename_p (str
))
1443 for (; CONSP (path
); path
= XCDR (path
))
1445 filename
= Fexpand_file_name (str
, XCAR (path
));
1446 if (!complete_filename_p (filename
))
1447 /* If there are non-absolute elts in PATH (eg ".") */
1448 /* Of course, this could conceivably lose if luser sets
1449 default-directory to be something non-absolute... */
1451 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1452 if (!complete_filename_p (filename
))
1453 /* Give up on this path element! */
1457 /* Calculate maximum size of any filename made from
1458 this path element/specified file name and any possible suffix. */
1459 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1460 if (fn_size
< want_size
)
1461 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1463 /* Loop over suffixes. */
1464 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1465 CONSP (tail
); tail
= XCDR (tail
))
1467 int lsuffix
= SBYTES (XCAR (tail
));
1468 Lisp_Object handler
;
1471 /* Concatenate path element/specified name with the suffix.
1472 If the directory starts with /:, remove that. */
1473 if (SCHARS (filename
) > 2
1474 && SREF (filename
, 0) == '/'
1475 && SREF (filename
, 1) == ':')
1477 strncpy (fn
, SSDATA (filename
) + 2,
1478 SBYTES (filename
) - 2);
1479 fn
[SBYTES (filename
) - 2] = 0;
1483 strncpy (fn
, SSDATA (filename
),
1485 fn
[SBYTES (filename
)] = 0;
1488 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1489 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1491 /* Check that the file exists and is not a directory. */
1492 /* We used to only check for handlers on non-absolute file names:
1496 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1497 It's not clear why that was the case and it breaks things like
1498 (load "/bar.el") where the file is actually "/bar.el.gz". */
1499 string
= build_string (fn
);
1500 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1501 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1503 if (NILP (predicate
))
1504 exists
= !NILP (Ffile_readable_p (string
));
1507 Lisp_Object tmp
= call1 (predicate
, string
);
1508 exists
= !NILP (tmp
)
1509 && (EQ (tmp
, Qdir_ok
)
1510 || NILP (Ffile_directory_p (string
)));
1515 /* We succeeded; return this descriptor and filename. */
1526 encoded_fn
= ENCODE_FILE (string
);
1527 pfn
= SSDATA (encoded_fn
);
1528 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1531 /* Check that we can access or open it. */
1532 if (NATNUMP (predicate
))
1533 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1535 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1539 /* We succeeded; return this descriptor and filename. */
1557 /* Merge the list we've accumulated of globals from the current input source
1558 into the load_history variable. The details depend on whether
1559 the source has an associated file name or not.
1561 FILENAME is the file name that we are loading from.
1562 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1565 build_load_history (Lisp_Object filename
, int entire
)
1567 register Lisp_Object tail
, prev
, newelt
;
1568 register Lisp_Object tem
, tem2
;
1569 register int foundit
= 0;
1571 tail
= Vload_history
;
1574 while (CONSP (tail
))
1578 /* Find the feature's previous assoc list... */
1579 if (!NILP (Fequal (filename
, Fcar (tem
))))
1583 /* If we're loading the entire file, remove old data. */
1587 Vload_history
= XCDR (tail
);
1589 Fsetcdr (prev
, XCDR (tail
));
1592 /* Otherwise, cons on new symbols that are not already members. */
1595 tem2
= Vcurrent_load_list
;
1597 while (CONSP (tem2
))
1599 newelt
= XCAR (tem2
);
1601 if (NILP (Fmember (newelt
, tem
)))
1602 Fsetcar (tail
, Fcons (XCAR (tem
),
1603 Fcons (newelt
, XCDR (tem
))));
1616 /* If we're loading an entire file, cons the new assoc onto the
1617 front of load-history, the most-recently-loaded position. Also
1618 do this if we didn't find an existing member for the file. */
1619 if (entire
|| !foundit
)
1620 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1625 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1632 readevalloop_1 (Lisp_Object old
)
1634 load_convert_to_unibyte
= ! NILP (old
);
1638 /* Signal an `end-of-file' error, if possible with file name
1642 end_of_file_error (void)
1644 if (STRINGP (Vload_file_name
))
1645 xsignal1 (Qend_of_file
, Vload_file_name
);
1647 xsignal0 (Qend_of_file
);
1650 /* UNIBYTE specifies how to set load_convert_to_unibyte
1651 for this invocation.
1652 READFUN, if non-nil, is used instead of `read'.
1654 START, END specify region to read in current buffer (from eval-region).
1655 If the input is not from a buffer, they must be nil. */
1658 readevalloop (Lisp_Object readcharfun
,
1660 Lisp_Object sourcename
,
1662 Lisp_Object unibyte
, Lisp_Object readfun
,
1663 Lisp_Object start
, Lisp_Object end
)
1666 register Lisp_Object val
;
1667 int count
= SPECPDL_INDEX ();
1668 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1669 struct buffer
*b
= 0;
1670 int continue_reading_p
;
1671 Lisp_Object lex_bound
;
1672 /* Nonzero if reading an entire buffer. */
1673 int whole_buffer
= 0;
1674 /* 1 on the first time around. */
1677 if (MARKERP (readcharfun
))
1680 start
= readcharfun
;
1683 if (BUFFERP (readcharfun
))
1684 b
= XBUFFER (readcharfun
);
1685 else if (MARKERP (readcharfun
))
1686 b
= XMARKER (readcharfun
)->buffer
;
1688 /* We assume START is nil when input is not from a buffer. */
1689 if (! NILP (start
) && !b
)
1692 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1693 specbind (Qcurrent_load_list
, Qnil
);
1694 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1695 load_convert_to_unibyte
= !NILP (unibyte
);
1697 /* If lexical binding is active (either because it was specified in
1698 the file's header, or via a buffer-local variable), create an empty
1699 lexical environment, otherwise, turn off lexical binding. */
1700 lex_bound
= find_symbol_value (Qlexical_binding
);
1701 specbind (Qinternal_interpreter_environment
,
1702 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1703 ? Qnil
: Fcons (Qt
, Qnil
));
1705 GCPRO4 (sourcename
, readfun
, start
, end
);
1707 /* Try to ensure sourcename is a truename, except whilst preloading. */
1708 if (NILP (Vpurify_flag
)
1709 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1710 && !NILP (Ffboundp (Qfile_truename
)))
1711 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1713 LOADHIST_ATTACH (sourcename
);
1715 continue_reading_p
= 1;
1716 while (continue_reading_p
)
1718 int count1
= SPECPDL_INDEX ();
1720 if (b
!= 0 && NILP (BVAR (b
, name
)))
1721 error ("Reading from killed buffer");
1725 /* Switch to the buffer we are reading from. */
1726 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1727 set_buffer_internal (b
);
1729 /* Save point in it. */
1730 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1731 /* Save ZV in it. */
1732 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1733 /* Those get unbound after we read one expression. */
1735 /* Set point and ZV around stuff to be read. */
1738 Fnarrow_to_region (make_number (BEGV
), end
);
1740 /* Just for cleanliness, convert END to a marker
1741 if it is an integer. */
1743 end
= Fpoint_max_marker ();
1746 /* On the first cycle, we can easily test here
1747 whether we are reading the whole buffer. */
1748 if (b
&& first_sexp
)
1749 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1756 while ((c
= READCHAR
) != '\n' && c
!= -1);
1761 unbind_to (count1
, Qnil
);
1765 /* Ignore whitespace here, so we can detect eof. */
1766 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1767 || c
== 0x8a0) /* NBSP */
1770 if (!NILP (Vpurify_flag
) && c
== '(')
1772 record_unwind_protect (unreadpure
, Qnil
);
1773 val
= read_list (-1, readcharfun
);
1778 read_objects
= Qnil
;
1779 if (!NILP (readfun
))
1781 val
= call1 (readfun
, readcharfun
);
1783 /* If READCHARFUN has set point to ZV, we should
1784 stop reading, even if the form read sets point
1785 to a different value when evaluated. */
1786 if (BUFFERP (readcharfun
))
1788 struct buffer
*buf
= XBUFFER (readcharfun
);
1789 if (BUF_PT (buf
) == BUF_ZV (buf
))
1790 continue_reading_p
= 0;
1793 else if (! NILP (Vload_read_function
))
1794 val
= call1 (Vload_read_function
, readcharfun
);
1796 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1799 if (!NILP (start
) && continue_reading_p
)
1800 start
= Fpoint_marker ();
1802 /* Restore saved point and BEGV. */
1803 unbind_to (count1
, Qnil
);
1805 /* Now eval what we just read. */
1806 val
= eval_sub (val
);
1810 Vvalues
= Fcons (val
, Vvalues
);
1811 if (EQ (Vstandard_output
, Qt
))
1820 build_load_history (sourcename
,
1821 stream
|| whole_buffer
);
1825 unbind_to (count
, Qnil
);
1828 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1829 doc
: /* Execute the current buffer as Lisp code.
1830 When called from a Lisp program (i.e., not interactively), this
1831 function accepts up to five optional arguments:
1832 BUFFER is the buffer to evaluate (nil means use current buffer).
1833 PRINTFLAG controls printing of output:
1834 A value of nil means discard it; anything else is stream for print.
1835 FILENAME specifies the file name to use for `load-history'.
1836 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1838 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1839 functions should work normally even if PRINTFLAG is nil.
1841 This function preserves the position of point. */)
1842 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1844 int count
= SPECPDL_INDEX ();
1845 Lisp_Object tem
, buf
;
1848 buf
= Fcurrent_buffer ();
1850 buf
= Fget_buffer (buffer
);
1852 error ("No such buffer");
1854 if (NILP (printflag
) && NILP (do_allow_print
))
1859 if (NILP (filename
))
1860 filename
= BVAR (XBUFFER (buf
), filename
);
1862 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1863 specbind (Qstandard_output
, tem
);
1864 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1865 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1866 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1867 readevalloop (buf
, 0, filename
,
1868 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1869 unbind_to (count
, Qnil
);
1874 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1875 doc
: /* Execute the region as Lisp code.
1876 When called from programs, expects two arguments,
1877 giving starting and ending indices in the current buffer
1878 of the text to be executed.
1879 Programs can pass third argument PRINTFLAG which controls output:
1880 A value of nil means discard it; anything else is stream for printing it.
1881 Also the fourth argument READ-FUNCTION, if non-nil, is used
1882 instead of `read' to read each expression. It gets one argument
1883 which is the input stream for reading characters.
1885 This function does not move point. */)
1886 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1888 /* FIXME: Do the eval-sexp-add-defvars danse! */
1889 int count
= SPECPDL_INDEX ();
1890 Lisp_Object tem
, cbuf
;
1892 cbuf
= Fcurrent_buffer ();
1894 if (NILP (printflag
))
1898 specbind (Qstandard_output
, tem
);
1899 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1901 /* readevalloop calls functions which check the type of start and end. */
1902 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1903 !NILP (printflag
), Qnil
, read_function
,
1906 return unbind_to (count
, Qnil
);
1910 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1911 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1912 If STREAM is nil, use the value of `standard-input' (which see).
1913 STREAM or the value of `standard-input' may be:
1914 a buffer (read from point and advance it)
1915 a marker (read from where it points and advance it)
1916 a function (call it with no arguments for each character,
1917 call it with a char as argument to push a char back)
1918 a string (takes text from string, starting at the beginning)
1919 t (read text line using minibuffer and use it, or read from
1920 standard input in batch mode). */)
1921 (Lisp_Object stream
)
1924 stream
= Vstandard_input
;
1925 if (EQ (stream
, Qt
))
1926 stream
= Qread_char
;
1927 if (EQ (stream
, Qread_char
))
1928 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1930 return read_internal_start (stream
, Qnil
, Qnil
);
1933 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1934 doc
: /* Read one Lisp expression which is represented as text by STRING.
1935 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1936 START and END optionally delimit a substring of STRING from which to read;
1937 they default to 0 and (length STRING) respectively. */)
1938 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1941 CHECK_STRING (string
);
1942 /* read_internal_start sets read_from_string_index. */
1943 ret
= read_internal_start (string
, start
, end
);
1944 return Fcons (ret
, make_number (read_from_string_index
));
1947 /* Function to set up the global context we need in toplevel read
1950 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1951 /* start, end only used when stream is a string. */
1956 new_backquote_flag
= 0;
1957 read_objects
= Qnil
;
1958 if (EQ (Vread_with_symbol_positions
, Qt
)
1959 || EQ (Vread_with_symbol_positions
, stream
))
1960 Vread_symbol_positions_list
= Qnil
;
1962 if (STRINGP (stream
)
1963 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1965 EMACS_INT startval
, endval
;
1968 if (STRINGP (stream
))
1971 string
= XCAR (stream
);
1974 endval
= SCHARS (string
);
1978 endval
= XINT (end
);
1979 if (endval
< 0 || endval
> SCHARS (string
))
1980 args_out_of_range (string
, end
);
1987 CHECK_NUMBER (start
);
1988 startval
= XINT (start
);
1989 if (startval
< 0 || startval
> endval
)
1990 args_out_of_range (string
, start
);
1992 read_from_string_index
= startval
;
1993 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1994 read_from_string_limit
= endval
;
1997 retval
= read0 (stream
);
1998 if (EQ (Vread_with_symbol_positions
, Qt
)
1999 || EQ (Vread_with_symbol_positions
, stream
))
2000 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2005 /* Signal Qinvalid_read_syntax error.
2006 S is error string of length N (if > 0) */
2009 invalid_syntax (const char *s
, int n
)
2013 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2017 /* Use this for recursive reads, in contexts where internal tokens
2021 read0 (Lisp_Object readcharfun
)
2023 register Lisp_Object val
;
2026 val
= read1 (readcharfun
, &c
, 0);
2030 xsignal1 (Qinvalid_read_syntax
,
2031 Fmake_string (make_number (1), make_number (c
)));
2034 static int read_buffer_size
;
2035 static char *read_buffer
;
2037 /* Read a \-escape sequence, assuming we already read the `\'.
2038 If the escape sequence forces unibyte, return eight-bit char. */
2041 read_escape (Lisp_Object readcharfun
, int stringp
)
2043 register int c
= READCHAR
;
2044 /* \u allows up to four hex digits, \U up to eight. Default to the
2045 behavior for \u, and change this value in the case that \U is seen. */
2046 int unicode_hex_count
= 4;
2051 end_of_file_error ();
2081 error ("Invalid escape character syntax");
2084 c
= read_escape (readcharfun
, 0);
2085 return c
| meta_modifier
;
2090 error ("Invalid escape character syntax");
2093 c
= read_escape (readcharfun
, 0);
2094 return c
| shift_modifier
;
2099 error ("Invalid escape character syntax");
2102 c
= read_escape (readcharfun
, 0);
2103 return c
| hyper_modifier
;
2108 error ("Invalid escape character syntax");
2111 c
= read_escape (readcharfun
, 0);
2112 return c
| alt_modifier
;
2116 if (stringp
|| c
!= '-')
2123 c
= read_escape (readcharfun
, 0);
2124 return c
| super_modifier
;
2129 error ("Invalid escape character syntax");
2133 c
= read_escape (readcharfun
, 0);
2134 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2135 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2136 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2137 return c
| ctrl_modifier
;
2138 /* ASCII control chars are made from letters (both cases),
2139 as well as the non-letters within 0100...0137. */
2140 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2141 return (c
& (037 | ~0177));
2142 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2143 return (c
& (037 | ~0177));
2145 return c
| ctrl_modifier
;
2155 /* An octal escape, as in ANSI C. */
2157 register int i
= c
- '0';
2158 register int count
= 0;
2161 if ((c
= READCHAR
) >= '0' && c
<= '7')
2173 if (i
>= 0x80 && i
< 0x100)
2174 i
= BYTE8_TO_CHAR (i
);
2179 /* A hex escape, as in ANSI C. */
2186 if (c
>= '0' && c
<= '9')
2191 else if ((c
>= 'a' && c
<= 'f')
2192 || (c
>= 'A' && c
<= 'F'))
2195 if (c
>= 'a' && c
<= 'f')
2208 if (count
< 3 && i
>= 0x80)
2209 return BYTE8_TO_CHAR (i
);
2214 /* Post-Unicode-2.0: Up to eight hex chars. */
2215 unicode_hex_count
= 8;
2218 /* A Unicode escape. We only permit them in strings and characters,
2219 not arbitrarily in the source code, as in some other languages. */
2224 while (++count
<= unicode_hex_count
)
2227 /* isdigit and isalpha may be locale-specific, which we don't
2229 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2230 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2231 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2234 error ("Non-hex digit used for Unicode escape");
2239 error ("Non-Unicode character: 0x%x", i
);
2248 /* Read an integer in radix RADIX using READCHARFUN to read
2249 characters. RADIX must be in the interval [2..36]; if it isn't, a
2250 read error is signaled . Value is the integer read. Signals an
2251 error if encountering invalid read syntax or if RADIX is out of
2255 read_integer (Lisp_Object readcharfun
, int radix
)
2257 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2258 /* We use a floating point number because */
2261 if (radix
< 2 || radix
> 36)
2265 number
= ndigits
= invalid_p
= 0;
2281 if (c
>= '0' && c
<= '9')
2283 else if (c
>= 'a' && c
<= 'z')
2284 digit
= c
- 'a' + 10;
2285 else if (c
>= 'A' && c
<= 'Z')
2286 digit
= c
- 'A' + 10;
2293 if (digit
< 0 || digit
>= radix
)
2296 number
= radix
* number
+ digit
;
2302 if (ndigits
== 0 || invalid_p
)
2305 sprintf (buf
, "integer, radix %d", radix
);
2306 invalid_syntax (buf
, 0);
2309 return make_fixnum_or_float (sign
* number
);
2313 /* If the next token is ')' or ']' or '.', we store that character
2314 in *PCH and the return value is not interesting. Else, we store
2315 zero in *PCH and we read and return one lisp object.
2317 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2320 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2323 int uninterned_symbol
= 0;
2331 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2333 end_of_file_error ();
2338 return read_list (0, readcharfun
);
2341 return read_vector (readcharfun
, 0);
2357 /* Accept extended format for hashtables (extensible to
2359 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2360 Lisp_Object tmp
= read_list (0, readcharfun
);
2361 Lisp_Object head
= CAR_SAFE (tmp
);
2362 Lisp_Object data
= Qnil
;
2363 Lisp_Object val
= Qnil
;
2364 /* The size is 2 * number of allowed keywords to
2366 Lisp_Object params
[10];
2368 Lisp_Object key
= Qnil
;
2369 int param_count
= 0;
2371 if (!EQ (head
, Qhash_table
))
2372 error ("Invalid extended read marker at head of #s list "
2373 "(only hash-table allowed)");
2375 tmp
= CDR_SAFE (tmp
);
2377 /* This is repetitive but fast and simple. */
2378 params
[param_count
] = QCsize
;
2379 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2380 if (!NILP (params
[param_count
+ 1]))
2383 params
[param_count
] = QCtest
;
2384 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2385 if (!NILP (params
[param_count
+ 1]))
2388 params
[param_count
] = QCweakness
;
2389 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2390 if (!NILP (params
[param_count
+ 1]))
2393 params
[param_count
] = QCrehash_size
;
2394 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2395 if (!NILP (params
[param_count
+ 1]))
2398 params
[param_count
] = QCrehash_threshold
;
2399 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2400 if (!NILP (params
[param_count
+ 1]))
2403 /* This is the hashtable data. */
2404 data
= Fplist_get (tmp
, Qdata
);
2406 /* Now use params to make a new hashtable and fill it. */
2407 ht
= Fmake_hash_table (param_count
, params
);
2409 while (CONSP (data
))
2414 error ("Odd number of elements in hashtable data");
2417 Fputhash (key
, val
, ht
);
2423 invalid_syntax ("#", 1);
2431 tmp
= read_vector (readcharfun
, 0);
2432 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2433 error ("Invalid size char-table");
2434 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2445 tmp
= read_vector (readcharfun
, 0);
2446 if (!INTEGERP (AREF (tmp
, 0)))
2447 error ("Invalid depth in char-table");
2448 depth
= XINT (AREF (tmp
, 0));
2449 if (depth
< 1 || depth
> 3)
2450 error ("Invalid depth in char-table");
2451 size
= XVECTOR (tmp
)->size
- 2;
2452 if (chartab_size
[depth
] != size
)
2453 error ("Invalid size char-table");
2454 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2457 invalid_syntax ("#^^", 3);
2459 invalid_syntax ("#^", 2);
2464 length
= read1 (readcharfun
, pch
, first_in_list
);
2468 Lisp_Object tmp
, val
;
2470 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2471 / BOOL_VECTOR_BITS_PER_CHAR
);
2474 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2475 if (STRING_MULTIBYTE (tmp
)
2476 || (size_in_chars
!= SCHARS (tmp
)
2477 /* We used to print 1 char too many
2478 when the number of bits was a multiple of 8.
2479 Accept such input in case it came from an old
2481 && ! (XFASTINT (length
)
2482 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2483 invalid_syntax ("#&...", 5);
2485 val
= Fmake_bool_vector (length
, Qnil
);
2486 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2487 /* Clear the extraneous bits in the last byte. */
2488 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2489 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2490 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2493 invalid_syntax ("#&...", 5);
2497 /* Accept compiled functions at read-time so that we don't have to
2498 build them using function calls. */
2500 tmp
= read_vector (readcharfun
, 1);
2501 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2502 XVECTOR (tmp
)->contents
);
2507 struct gcpro gcpro1
;
2510 /* Read the string itself. */
2511 tmp
= read1 (readcharfun
, &ch
, 0);
2512 if (ch
!= 0 || !STRINGP (tmp
))
2513 invalid_syntax ("#", 1);
2515 /* Read the intervals and their properties. */
2518 Lisp_Object beg
, end
, plist
;
2520 beg
= read1 (readcharfun
, &ch
, 0);
2525 end
= read1 (readcharfun
, &ch
, 0);
2527 plist
= read1 (readcharfun
, &ch
, 0);
2529 invalid_syntax ("Invalid string property list", 0);
2530 Fset_text_properties (beg
, end
, plist
, tmp
);
2536 /* #@NUMBER is used to skip NUMBER following characters.
2537 That's used in .elc files to skip over doc strings
2538 and function definitions. */
2544 /* Read a decimal integer. */
2545 while ((c
= READCHAR
) >= 0
2546 && c
>= '0' && c
<= '9')
2554 if (load_force_doc_strings
2555 && (EQ (readcharfun
, Qget_file_char
)
2556 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2558 /* If we are supposed to force doc strings into core right now,
2559 record the last string that we skipped,
2560 and record where in the file it comes from. */
2562 /* But first exchange saved_doc_string
2563 with prev_saved_doc_string, so we save two strings. */
2565 char *temp
= saved_doc_string
;
2566 int temp_size
= saved_doc_string_size
;
2567 file_offset temp_pos
= saved_doc_string_position
;
2568 int temp_len
= saved_doc_string_length
;
2570 saved_doc_string
= prev_saved_doc_string
;
2571 saved_doc_string_size
= prev_saved_doc_string_size
;
2572 saved_doc_string_position
= prev_saved_doc_string_position
;
2573 saved_doc_string_length
= prev_saved_doc_string_length
;
2575 prev_saved_doc_string
= temp
;
2576 prev_saved_doc_string_size
= temp_size
;
2577 prev_saved_doc_string_position
= temp_pos
;
2578 prev_saved_doc_string_length
= temp_len
;
2581 if (saved_doc_string_size
== 0)
2583 saved_doc_string_size
= nskip
+ 100;
2584 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2586 if (nskip
> saved_doc_string_size
)
2588 saved_doc_string_size
= nskip
+ 100;
2589 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2590 saved_doc_string_size
);
2593 saved_doc_string_position
= file_tell (instream
);
2595 /* Copy that many characters into saved_doc_string. */
2596 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2597 saved_doc_string
[i
] = c
= READCHAR
;
2599 saved_doc_string_length
= i
;
2603 /* Skip that many characters. */
2604 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2613 /* #! appears at the beginning of an executable file.
2614 Skip the first line. */
2615 while (c
!= '\n' && c
>= 0)
2620 return Vload_file_name
;
2622 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2623 /* #:foo is the uninterned symbol named foo. */
2626 uninterned_symbol
= 1;
2630 /* Reader forms that can reuse previously read objects. */
2631 if (c
>= '0' && c
<= '9')
2636 /* Read a non-negative integer. */
2637 while (c
>= '0' && c
<= '9')
2643 /* #n=object returns object, but associates it with n for #n#. */
2644 if (c
== '=' && !NILP (Vread_circle
))
2646 /* Make a placeholder for #n# to use temporarily */
2647 Lisp_Object placeholder
;
2650 placeholder
= Fcons (Qnil
, Qnil
);
2651 cell
= Fcons (make_number (n
), placeholder
);
2652 read_objects
= Fcons (cell
, read_objects
);
2654 /* Read the object itself. */
2655 tem
= read0 (readcharfun
);
2657 /* Now put it everywhere the placeholder was... */
2658 substitute_object_in_subtree (tem
, placeholder
);
2660 /* ...and #n# will use the real value from now on. */
2661 Fsetcdr (cell
, tem
);
2665 /* #n# returns a previously read object. */
2666 if (c
== '#' && !NILP (Vread_circle
))
2668 tem
= Fassq (make_number (n
), read_objects
);
2671 /* Fall through to error message. */
2673 else if (c
== 'r' || c
== 'R')
2674 return read_integer (readcharfun
, n
);
2676 /* Fall through to error message. */
2678 else if (c
== 'x' || c
== 'X')
2679 return read_integer (readcharfun
, 16);
2680 else if (c
== 'o' || c
== 'O')
2681 return read_integer (readcharfun
, 8);
2682 else if (c
== 'b' || c
== 'B')
2683 return read_integer (readcharfun
, 2);
2686 invalid_syntax ("#", 1);
2689 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2694 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2699 int next_char
= READCHAR
;
2701 /* Transition from old-style to new-style:
2702 If we see "(`" it used to mean old-style, which usually works
2703 fine because ` should almost never appear in such a position
2704 for new-style. But occasionally we need "(`" to mean new
2705 style, so we try to distinguish the two by the fact that we
2706 can either write "( `foo" or "(` foo", where the first
2707 intends to use new-style whereas the second intends to use
2708 old-style. For Emacs-25, we should completely remove this
2709 first_in_list exception (old-style can still be obtained via
2711 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2713 Vold_style_backquotes
= Qt
;
2720 new_backquote_flag
++;
2721 value
= read0 (readcharfun
);
2722 new_backquote_flag
--;
2724 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2729 int next_char
= READCHAR
;
2731 /* Transition from old-style to new-style:
2732 It used to be impossible to have a new-style , other than within
2733 a new-style `. This is sufficient when ` and , are used in the
2734 normal way, but ` and , can also appear in args to macros that
2735 will not interpret them in the usual way, in which case , may be
2736 used without any ` anywhere near.
2737 So we now use the same heuristic as for backquote: old-style
2738 unquotes are only recognized when first on a list, and when
2739 followed by a space.
2740 Because it's more difficult to peak 2 chars ahead, a new-style
2741 ,@ can still not be used outside of a `, unless it's in the middle
2743 if (new_backquote_flag
2745 || (next_char
!= ' ' && next_char
!= '@'))
2747 Lisp_Object comma_type
= Qnil
;
2752 comma_type
= Qcomma_at
;
2754 comma_type
= Qcomma_dot
;
2757 if (ch
>= 0) UNREAD (ch
);
2758 comma_type
= Qcomma
;
2761 value
= read0 (readcharfun
);
2762 return Fcons (comma_type
, Fcons (value
, Qnil
));
2766 Vold_style_backquotes
= Qt
;
2778 end_of_file_error ();
2780 /* Accept `single space' syntax like (list ? x) where the
2781 whitespace character is SPC or TAB.
2782 Other literal whitespace like NL, CR, and FF are not accepted,
2783 as there are well-established escape sequences for these. */
2784 if (c
== ' ' || c
== '\t')
2785 return make_number (c
);
2788 c
= read_escape (readcharfun
, 0);
2789 modifiers
= c
& CHAR_MODIFIER_MASK
;
2790 c
&= ~CHAR_MODIFIER_MASK
;
2791 if (CHAR_BYTE8_P (c
))
2792 c
= CHAR_TO_BYTE8 (c
);
2795 next_char
= READCHAR
;
2796 ok
= (next_char
<= 040
2797 || (next_char
< 0200
2798 && (strchr ("\"';()[]#?`,.", next_char
))));
2801 return make_number (c
);
2803 invalid_syntax ("?", 1);
2808 char *p
= read_buffer
;
2809 char *end
= read_buffer
+ read_buffer_size
;
2811 /* Nonzero if we saw an escape sequence specifying
2812 a multibyte character. */
2813 int force_multibyte
= 0;
2814 /* Nonzero if we saw an escape sequence specifying
2815 a single-byte character. */
2816 int force_singlebyte
= 0;
2820 while ((ch
= READCHAR
) >= 0
2823 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2825 int offset
= p
- read_buffer
;
2826 read_buffer
= (char *) xrealloc (read_buffer
,
2827 read_buffer_size
*= 2);
2828 p
= read_buffer
+ offset
;
2829 end
= read_buffer
+ read_buffer_size
;
2836 ch
= read_escape (readcharfun
, 1);
2838 /* CH is -1 if \ newline has just been seen */
2841 if (p
== read_buffer
)
2846 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2847 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2849 if (CHAR_BYTE8_P (ch
))
2850 force_singlebyte
= 1;
2851 else if (! ASCII_CHAR_P (ch
))
2852 force_multibyte
= 1;
2853 else /* i.e. ASCII_CHAR_P (ch) */
2855 /* Allow `\C- ' and `\C-?'. */
2856 if (modifiers
== CHAR_CTL
)
2859 ch
= 0, modifiers
= 0;
2861 ch
= 127, modifiers
= 0;
2863 if (modifiers
& CHAR_SHIFT
)
2865 /* Shift modifier is valid only with [A-Za-z]. */
2866 if (ch
>= 'A' && ch
<= 'Z')
2867 modifiers
&= ~CHAR_SHIFT
;
2868 else if (ch
>= 'a' && ch
<= 'z')
2869 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2872 if (modifiers
& CHAR_META
)
2874 /* Move the meta bit to the right place for a
2876 modifiers
&= ~CHAR_META
;
2877 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2878 force_singlebyte
= 1;
2882 /* Any modifiers remaining are invalid. */
2884 error ("Invalid modifier in string");
2885 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2889 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2890 if (CHAR_BYTE8_P (ch
))
2891 force_singlebyte
= 1;
2892 else if (! ASCII_CHAR_P (ch
))
2893 force_multibyte
= 1;
2899 end_of_file_error ();
2901 /* If purifying, and string starts with \ newline,
2902 return zero instead. This is for doc strings
2903 that we are really going to find in etc/DOC.nn.nn */
2904 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2905 return make_number (0);
2907 if (force_multibyte
)
2908 /* READ_BUFFER already contains valid multibyte forms. */
2910 else if (force_singlebyte
)
2912 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2914 p
= read_buffer
+ nchars
;
2918 /* Otherwise, READ_BUFFER contains only ASCII. */
2921 /* We want readchar_count to be the number of characters, not
2922 bytes. Hence we adjust for multibyte characters in the
2923 string. ... But it doesn't seem to be necessary, because
2924 READCHAR *does* read multibyte characters from buffers. */
2925 /* readchar_count -= (p - read_buffer) - nchars; */
2927 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2929 || (p
- read_buffer
!= nchars
)));
2930 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2932 || (p
- read_buffer
!= nchars
)));
2937 int next_char
= READCHAR
;
2940 if (next_char
<= 040
2941 || (next_char
< 0200
2942 && (strchr ("\"';([#?`,", next_char
))))
2948 /* Otherwise, we fall through! Note that the atom-reading loop
2949 below will now loop at least once, assuring that we will not
2950 try to UNREAD two characters in a row. */
2954 if (c
<= 040) goto retry
;
2955 if (c
== 0x8a0) /* NBSP */
2958 char *p
= read_buffer
;
2962 char *end
= read_buffer
+ read_buffer_size
;
2966 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2968 int offset
= p
- read_buffer
;
2969 read_buffer
= (char *) xrealloc (read_buffer
,
2970 read_buffer_size
*= 2);
2971 p
= read_buffer
+ offset
;
2972 end
= read_buffer
+ read_buffer_size
;
2979 end_of_file_error ();
2984 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2989 && c
!= 0x8a0 /* NBSP */
2991 || !(strchr ("\"';()[]#`,", c
))));
2995 int offset
= p
- read_buffer
;
2996 read_buffer
= (char *) xrealloc (read_buffer
,
2997 read_buffer_size
*= 2);
2998 p
= read_buffer
+ offset
;
2999 end
= read_buffer
+ read_buffer_size
;
3006 if (!quoted
&& !uninterned_symbol
)
3010 if (*p1
== '+' || *p1
== '-') p1
++;
3011 /* Is it an integer? */
3014 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3015 /* Integers can have trailing decimal points. */
3016 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3018 /* It is an integer. */
3023 /* EMACS_INT n = atol (read_buffer); */
3024 char *endptr
= NULL
;
3025 EMACS_INT n
= (errno
= 0,
3026 strtol (read_buffer
, &endptr
, 10));
3027 if (errno
== ERANGE
&& endptr
)
3030 = Fcons (make_string (read_buffer
,
3031 endptr
- read_buffer
),
3033 xsignal (Qoverflow_error
, args
);
3035 return make_fixnum_or_float (n
);
3039 if (isfloat_string (read_buffer
, 0))
3041 /* Compute NaN and infinities using 0.0 in a variable,
3042 to cope with compilers that think they are smarter
3048 /* Negate the value ourselves. This treats 0, NaNs,
3049 and infinity properly on IEEE floating point hosts,
3050 and works around a common bug where atof ("-0.0")
3052 int negative
= read_buffer
[0] == '-';
3054 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3055 returns 1, is if the input ends in e+INF or e+NaN. */
3062 value
= zero
/ zero
;
3064 /* If that made a "negative" NaN, negate it. */
3068 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3071 u_minus_zero
.d
= - 0.0;
3072 for (i
= 0; i
< sizeof (double); i
++)
3073 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3079 /* Now VALUE is a positive NaN. */
3082 value
= atof (read_buffer
+ negative
);
3086 return make_float (negative
? - value
: value
);
3090 Lisp_Object name
, result
;
3091 EMACS_INT nbytes
= p
- read_buffer
;
3094 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3098 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3099 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3101 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3102 result
= (uninterned_symbol
? Fmake_symbol (name
)
3103 : Fintern (name
, Qnil
));
3105 if (EQ (Vread_with_symbol_positions
, Qt
)
3106 || EQ (Vread_with_symbol_positions
, readcharfun
))
3107 Vread_symbol_positions_list
=
3108 /* Kind of a hack; this will probably fail if characters
3109 in the symbol name were escaped. Not really a big
3111 Fcons (Fcons (result
,
3112 make_number (readchar_count
3113 - XFASTINT (Flength (Fsymbol_name (result
))))),
3114 Vread_symbol_positions_list
);
3122 /* List of nodes we've seen during substitute_object_in_subtree. */
3123 static Lisp_Object seen_list
;
3126 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3128 Lisp_Object check_object
;
3130 /* We haven't seen any objects when we start. */
3133 /* Make all the substitutions. */
3135 = substitute_object_recurse (object
, placeholder
, object
);
3137 /* Clear seen_list because we're done with it. */
3140 /* The returned object here is expected to always eq the
3142 if (!EQ (check_object
, object
))
3143 error ("Unexpected mutation error in reader");
3146 /* Feval doesn't get called from here, so no gc protection is needed. */
3147 #define SUBSTITUTE(get_val, set_val) \
3149 Lisp_Object old_value = get_val; \
3150 Lisp_Object true_value \
3151 = substitute_object_recurse (object, placeholder, \
3154 if (!EQ (old_value, true_value)) \
3161 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3163 /* If we find the placeholder, return the target object. */
3164 if (EQ (placeholder
, subtree
))
3167 /* If we've been to this node before, don't explore it again. */
3168 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3171 /* If this node can be the entry point to a cycle, remember that
3172 we've seen it. It can only be such an entry point if it was made
3173 by #n=, which means that we can find it as a value in
3175 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3176 seen_list
= Fcons (subtree
, seen_list
);
3178 /* Recurse according to subtree's type.
3179 Every branch must return a Lisp_Object. */
3180 switch (XTYPE (subtree
))
3182 case Lisp_Vectorlike
:
3185 if (BOOL_VECTOR_P (subtree
))
3186 return subtree
; /* No sub-objects anyway. */
3187 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3188 || COMPILEDP (subtree
))
3189 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3190 else if (VECTORP (subtree
))
3191 length
= ASIZE (subtree
);
3193 /* An unknown pseudovector may contain non-Lisp fields, so we
3194 can't just blindly traverse all its fields. We used to call
3195 `Flength' which signaled `sequencep', so I just preserved this
3197 wrong_type_argument (Qsequencep
, subtree
);
3199 for (i
= 0; i
< length
; i
++)
3200 SUBSTITUTE (AREF (subtree
, i
),
3201 ASET (subtree
, i
, true_value
));
3207 SUBSTITUTE (XCAR (subtree
),
3208 XSETCAR (subtree
, true_value
));
3209 SUBSTITUTE (XCDR (subtree
),
3210 XSETCDR (subtree
, true_value
));
3216 /* Check for text properties in each interval.
3217 substitute_in_interval contains part of the logic. */
3219 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3220 Lisp_Object arg
= Fcons (object
, placeholder
);
3222 traverse_intervals_noorder (root_interval
,
3223 &substitute_in_interval
, arg
);
3228 /* Other types don't recurse any further. */
3234 /* Helper function for substitute_object_recurse. */
3236 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3238 Lisp_Object object
= Fcar (arg
);
3239 Lisp_Object placeholder
= Fcdr (arg
);
3241 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3252 isfloat_string (const char *cp
, int ignore_trailing
)
3255 const char *start
= cp
;
3258 if (*cp
== '+' || *cp
== '-')
3261 if (*cp
>= '0' && *cp
<= '9')
3264 while (*cp
>= '0' && *cp
<= '9')
3272 if (*cp
>= '0' && *cp
<= '9')
3275 while (*cp
>= '0' && *cp
<= '9')
3278 if (*cp
== 'e' || *cp
== 'E')
3282 if (*cp
== '+' || *cp
== '-')
3286 if (*cp
>= '0' && *cp
<= '9')
3289 while (*cp
>= '0' && *cp
<= '9')
3292 else if (cp
== start
)
3294 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3299 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3305 return ((ignore_trailing
3306 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3307 || *cp
== '\r' || *cp
== '\f')
3308 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3309 || state
== (DOT_CHAR
|TRAIL_INT
)
3310 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3311 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3312 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3317 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3321 register Lisp_Object
*ptr
;
3322 register Lisp_Object tem
, item
, vector
;
3323 register struct Lisp_Cons
*otem
;
3326 tem
= read_list (1, readcharfun
);
3327 len
= Flength (tem
);
3328 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3330 size
= XVECTOR (vector
)->size
;
3331 ptr
= XVECTOR (vector
)->contents
;
3332 for (i
= 0; i
< size
; i
++)
3335 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3336 bytecode object, the docstring containing the bytecode and
3337 constants values must be treated as unibyte and passed to
3338 Fread, to get the actual bytecode string and constants vector. */
3339 if (bytecodeflag
&& load_force_doc_strings
)
3341 if (i
== COMPILED_BYTECODE
)
3343 if (!STRINGP (item
))
3344 error ("Invalid byte code");
3346 /* Delay handling the bytecode slot until we know whether
3347 it is lazily-loaded (we can tell by whether the
3348 constants slot is nil). */
3349 ptr
[COMPILED_CONSTANTS
] = item
;
3352 else if (i
== COMPILED_CONSTANTS
)
3354 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3358 /* Coerce string to unibyte (like string-as-unibyte,
3359 but without generating extra garbage and
3360 guaranteeing no change in the contents). */
3361 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3362 STRING_SET_UNIBYTE (bytestr
);
3364 item
= Fread (Fcons (bytestr
, readcharfun
));
3366 error ("Invalid byte code");
3368 otem
= XCONS (item
);
3369 bytestr
= XCAR (item
);
3374 /* Now handle the bytecode slot. */
3375 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3377 else if (i
== COMPILED_DOC_STRING
3379 && ! STRING_MULTIBYTE (item
))
3381 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3382 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3384 item
= Fstring_as_multibyte (item
);
3387 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3395 /* FLAG = 1 means check for ] to terminate rather than ) and .
3396 FLAG = -1 means check for starting with defun
3397 and make structure pure. */
3400 read_list (int flag
, register Lisp_Object readcharfun
)
3402 /* -1 means check next element for defun,
3403 0 means don't check,
3404 1 means already checked and found defun. */
3405 int defunflag
= flag
< 0 ? -1 : 0;
3406 Lisp_Object val
, tail
;
3407 register Lisp_Object elt
, tem
;
3408 struct gcpro gcpro1
, gcpro2
;
3409 /* 0 is the normal case.
3410 1 means this list is a doc reference; replace it with the number 0.
3411 2 means this list is a doc reference; replace it with the doc string. */
3412 int doc_reference
= 0;
3414 /* Initialize this to 1 if we are reading a list. */
3415 int first_in_list
= flag
<= 0;
3424 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3429 /* While building, if the list starts with #$, treat it specially. */
3430 if (EQ (elt
, Vload_file_name
)
3432 && !NILP (Vpurify_flag
))
3434 if (NILP (Vdoc_file_name
))
3435 /* We have not yet called Snarf-documentation, so assume
3436 this file is described in the DOC-MM.NN file
3437 and Snarf-documentation will fill in the right value later.
3438 For now, replace the whole list with 0. */
3441 /* We have already called Snarf-documentation, so make a relative
3442 file name for this file, so it can be found properly
3443 in the installed Lisp directory.
3444 We don't use Fexpand_file_name because that would make
3445 the directory absolute now. */
3446 elt
= concat2 (build_string ("../lisp/"),
3447 Ffile_name_nondirectory (elt
));
3449 else if (EQ (elt
, Vload_file_name
)
3451 && load_force_doc_strings
)
3460 invalid_syntax (") or . in a vector", 18);
3468 XSETCDR (tail
, read0 (readcharfun
));
3470 val
= read0 (readcharfun
);
3471 read1 (readcharfun
, &ch
, 0);
3475 if (doc_reference
== 1)
3476 return make_number (0);
3477 if (doc_reference
== 2)
3479 /* Get a doc string from the file we are loading.
3480 If it's in saved_doc_string, get it from there.
3482 Here, we don't know if the string is a
3483 bytecode string or a doc string. As a
3484 bytecode string must be unibyte, we always
3485 return a unibyte string. If it is actually a
3486 doc string, caller must make it
3489 int pos
= XINT (XCDR (val
));
3490 /* Position is negative for user variables. */
3491 if (pos
< 0) pos
= -pos
;
3492 if (pos
>= saved_doc_string_position
3493 && pos
< (saved_doc_string_position
3494 + saved_doc_string_length
))
3496 int start
= pos
- saved_doc_string_position
;
3499 /* Process quoting with ^A,
3500 and find the end of the string,
3501 which is marked with ^_ (037). */
3502 for (from
= start
, to
= start
;
3503 saved_doc_string
[from
] != 037;)
3505 int c
= saved_doc_string
[from
++];
3508 c
= saved_doc_string
[from
++];
3510 saved_doc_string
[to
++] = c
;
3512 saved_doc_string
[to
++] = 0;
3514 saved_doc_string
[to
++] = 037;
3517 saved_doc_string
[to
++] = c
;
3520 return make_unibyte_string (saved_doc_string
+ start
,
3523 /* Look in prev_saved_doc_string the same way. */
3524 else if (pos
>= prev_saved_doc_string_position
3525 && pos
< (prev_saved_doc_string_position
3526 + prev_saved_doc_string_length
))
3528 int start
= pos
- prev_saved_doc_string_position
;
3531 /* Process quoting with ^A,
3532 and find the end of the string,
3533 which is marked with ^_ (037). */
3534 for (from
= start
, to
= start
;
3535 prev_saved_doc_string
[from
] != 037;)
3537 int c
= prev_saved_doc_string
[from
++];
3540 c
= prev_saved_doc_string
[from
++];
3542 prev_saved_doc_string
[to
++] = c
;
3544 prev_saved_doc_string
[to
++] = 0;
3546 prev_saved_doc_string
[to
++] = 037;
3549 prev_saved_doc_string
[to
++] = c
;
3552 return make_unibyte_string (prev_saved_doc_string
3557 return get_doc_string (val
, 1, 0);
3562 invalid_syntax (". in wrong context", 18);
3564 invalid_syntax ("] in a list", 11);
3566 tem
= (read_pure
&& flag
<= 0
3567 ? pure_cons (elt
, Qnil
)
3568 : Fcons (elt
, Qnil
));
3570 XSETCDR (tail
, tem
);
3575 defunflag
= EQ (elt
, Qdefun
);
3576 else if (defunflag
> 0)
3581 Lisp_Object initial_obarray
;
3583 /* oblookup stores the bucket number here, for the sake of Funintern. */
3585 int oblookup_last_bucket_number
;
3587 static int hash_string (const char *ptr
, int len
);
3589 /* Get an error if OBARRAY is not an obarray.
3590 If it is one, return it. */
3593 check_obarray (Lisp_Object obarray
)
3595 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3597 /* If Vobarray is now invalid, force it to be valid. */
3598 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3599 wrong_type_argument (Qvectorp
, obarray
);
3604 /* Intern the C string STR: return a symbol with that name,
3605 interned in the current obarray. */
3608 intern (const char *str
)
3611 int len
= strlen (str
);
3612 Lisp_Object obarray
;
3615 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3616 obarray
= check_obarray (obarray
);
3617 tem
= oblookup (obarray
, str
, len
, len
);
3620 return Fintern (make_string (str
, len
), obarray
);
3624 intern_c_string (const char *str
)
3627 int len
= strlen (str
);
3628 Lisp_Object obarray
;
3631 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3632 obarray
= check_obarray (obarray
);
3633 tem
= oblookup (obarray
, str
, len
, len
);
3637 if (NILP (Vpurify_flag
))
3638 /* Creating a non-pure string from a string literal not
3639 implemented yet. We could just use make_string here and live
3640 with the extra copy. */
3643 return Fintern (make_pure_c_string (str
), obarray
);
3646 /* Create an uninterned symbol with name STR. */
3649 make_symbol (const char *str
)
3651 int len
= strlen (str
);
3653 return Fmake_symbol (!NILP (Vpurify_flag
)
3654 ? make_pure_string (str
, len
, len
, 0)
3655 : make_string (str
, len
));
3658 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3659 doc
: /* Return the canonical symbol whose name is STRING.
3660 If there is none, one is created by this function and returned.
3661 A second optional argument specifies the obarray to use;
3662 it defaults to the value of `obarray'. */)
3663 (Lisp_Object string
, Lisp_Object obarray
)
3665 register Lisp_Object tem
, sym
, *ptr
;
3667 if (NILP (obarray
)) obarray
= Vobarray
;
3668 obarray
= check_obarray (obarray
);
3670 CHECK_STRING (string
);
3672 tem
= oblookup (obarray
, SSDATA (string
),
3675 if (!INTEGERP (tem
))
3678 if (!NILP (Vpurify_flag
))
3679 string
= Fpurecopy (string
);
3680 sym
= Fmake_symbol (string
);
3682 if (EQ (obarray
, initial_obarray
))
3683 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3685 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3687 if ((SREF (string
, 0) == ':')
3688 && EQ (obarray
, initial_obarray
))
3690 XSYMBOL (sym
)->constant
= 1;
3691 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3692 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3695 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3697 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3699 XSYMBOL (sym
)->next
= 0;
3704 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3705 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3706 NAME may be a string or a symbol. If it is a symbol, that exact
3707 symbol is searched for.
3708 A second optional argument specifies the obarray to use;
3709 it defaults to the value of `obarray'. */)
3710 (Lisp_Object name
, Lisp_Object obarray
)
3712 register Lisp_Object tem
, string
;
3714 if (NILP (obarray
)) obarray
= Vobarray
;
3715 obarray
= check_obarray (obarray
);
3717 if (!SYMBOLP (name
))
3719 CHECK_STRING (name
);
3723 string
= SYMBOL_NAME (name
);
3725 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3726 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3732 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3733 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3734 The value is t if a symbol was found and deleted, nil otherwise.
3735 NAME may be a string or a symbol. If it is a symbol, that symbol
3736 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3737 OBARRAY defaults to the value of the variable `obarray'. */)
3738 (Lisp_Object name
, Lisp_Object obarray
)
3740 register Lisp_Object string
, tem
;
3743 if (NILP (obarray
)) obarray
= Vobarray
;
3744 obarray
= check_obarray (obarray
);
3747 string
= SYMBOL_NAME (name
);
3750 CHECK_STRING (name
);
3754 tem
= oblookup (obarray
, SSDATA (string
),
3759 /* If arg was a symbol, don't delete anything but that symbol itself. */
3760 if (SYMBOLP (name
) && !EQ (name
, tem
))
3763 /* There are plenty of other symbols which will screw up the Emacs
3764 session if we unintern them, as well as even more ways to use
3765 `setq' or `fset' or whatnot to make the Emacs session
3766 unusable. Let's not go down this silly road. --Stef */
3767 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3768 error ("Attempt to unintern t or nil"); */
3770 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3772 hash
= oblookup_last_bucket_number
;
3774 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3776 if (XSYMBOL (tem
)->next
)
3777 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3779 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3783 Lisp_Object tail
, following
;
3785 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3786 XSYMBOL (tail
)->next
;
3789 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3790 if (EQ (following
, tem
))
3792 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3801 /* Return the symbol in OBARRAY whose names matches the string
3802 of SIZE characters (SIZE_BYTE bytes) at PTR.
3803 If there is no such symbol in OBARRAY, return nil.
3805 Also store the bucket number in oblookup_last_bucket_number. */
3808 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3812 register Lisp_Object tail
;
3813 Lisp_Object bucket
, tem
;
3815 if (!VECTORP (obarray
)
3816 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3818 obarray
= check_obarray (obarray
);
3819 obsize
= XVECTOR (obarray
)->size
;
3821 /* This is sometimes needed in the middle of GC. */
3822 obsize
&= ~ARRAY_MARK_FLAG
;
3823 hash
= hash_string (ptr
, size_byte
) % obsize
;
3824 bucket
= XVECTOR (obarray
)->contents
[hash
];
3825 oblookup_last_bucket_number
= hash
;
3826 if (EQ (bucket
, make_number (0)))
3828 else if (!SYMBOLP (bucket
))
3829 error ("Bad data in guts of obarray"); /* Like CADR error message */
3831 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3833 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3834 && SCHARS (SYMBOL_NAME (tail
)) == size
3835 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3837 else if (XSYMBOL (tail
)->next
== 0)
3840 XSETINT (tem
, hash
);
3845 hash_string (const char *ptr
, int len
)
3847 register const char *p
= ptr
;
3848 register const char *end
= p
+ len
;
3849 register unsigned char c
;
3850 register int hash
= 0;
3855 if (c
>= 0140) c
-= 40;
3856 hash
= ((hash
<<3) + (hash
>>28) + c
);
3858 return hash
& 07777777777;
3862 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3865 register Lisp_Object tail
;
3866 CHECK_VECTOR (obarray
);
3867 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3869 tail
= XVECTOR (obarray
)->contents
[i
];
3874 if (XSYMBOL (tail
)->next
== 0)
3876 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3882 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3884 call1 (function
, sym
);
3887 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3888 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3889 OBARRAY defaults to the value of `obarray'. */)
3890 (Lisp_Object function
, Lisp_Object obarray
)
3892 if (NILP (obarray
)) obarray
= Vobarray
;
3893 obarray
= check_obarray (obarray
);
3895 map_obarray (obarray
, mapatoms_1
, function
);
3899 #define OBARRAY_SIZE 1511
3904 Lisp_Object oblength
;
3906 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3908 Vobarray
= Fmake_vector (oblength
, make_number (0));
3909 initial_obarray
= Vobarray
;
3910 staticpro (&initial_obarray
);
3912 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3913 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3914 NILP (Vpurify_flag) check in intern_c_string. */
3915 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3916 Qnil
= intern_c_string ("nil");
3918 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3919 so those two need to be fixed manally. */
3920 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3921 XSYMBOL (Qunbound
)->function
= Qunbound
;
3922 XSYMBOL (Qunbound
)->plist
= Qnil
;
3923 /* XSYMBOL (Qnil)->function = Qunbound; */
3924 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3925 XSYMBOL (Qnil
)->constant
= 1;
3926 XSYMBOL (Qnil
)->plist
= Qnil
;
3928 Qt
= intern_c_string ("t");
3929 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3930 XSYMBOL (Qt
)->constant
= 1;
3932 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3935 Qvariable_documentation
= intern_c_string ("variable-documentation");
3936 staticpro (&Qvariable_documentation
);
3938 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3939 read_buffer
= (char *) xmalloc (read_buffer_size
);
3943 defsubr (struct Lisp_Subr
*sname
)
3946 sym
= intern_c_string (sname
->symbol_name
);
3947 XSETPVECTYPE (sname
, PVEC_SUBR
);
3948 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3951 #ifdef NOTDEF /* use fset in subr.el now */
3953 defalias (sname
, string
)
3954 struct Lisp_Subr
*sname
;
3958 sym
= intern (string
);
3959 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3963 /* Define an "integer variable"; a symbol whose value is forwarded to a
3964 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3965 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3967 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3968 const char *namestring
, EMACS_INT
*address
)
3971 sym
= intern_c_string (namestring
);
3972 i_fwd
->type
= Lisp_Fwd_Int
;
3973 i_fwd
->intvar
= address
;
3974 XSYMBOL (sym
)->declared_special
= 1;
3975 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3976 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3979 /* Similar but define a variable whose value is t if address contains 1,
3980 nil if address contains 0. */
3982 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3983 const char *namestring
, int *address
)
3986 sym
= intern_c_string (namestring
);
3987 b_fwd
->type
= Lisp_Fwd_Bool
;
3988 b_fwd
->boolvar
= address
;
3989 XSYMBOL (sym
)->declared_special
= 1;
3990 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3991 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3992 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3995 /* Similar but define a variable whose value is the Lisp Object stored
3996 at address. Two versions: with and without gc-marking of the C
3997 variable. The nopro version is used when that variable will be
3998 gc-marked for some other reason, since marking the same slot twice
3999 can cause trouble with strings. */
4001 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4002 const char *namestring
, Lisp_Object
*address
)
4005 sym
= intern_c_string (namestring
);
4006 o_fwd
->type
= Lisp_Fwd_Obj
;
4007 o_fwd
->objvar
= address
;
4008 XSYMBOL (sym
)->declared_special
= 1;
4009 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4010 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4014 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4015 const char *namestring
, Lisp_Object
*address
)
4017 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4018 staticpro (address
);
4021 /* Similar but define a variable whose value is the Lisp Object stored
4022 at a particular offset in the current kboard object. */
4025 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4026 const char *namestring
, int offset
)
4029 sym
= intern_c_string (namestring
);
4030 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4031 ko_fwd
->offset
= offset
;
4032 XSYMBOL (sym
)->declared_special
= 1;
4033 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4034 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4037 /* Record the value of load-path used at the start of dumping
4038 so we can see if the site changed it later during dumping. */
4039 static Lisp_Object dump_path
;
4045 int turn_off_warning
= 0;
4047 /* Compute the default load-path. */
4049 normal
= PATH_LOADSEARCH
;
4050 Vload_path
= decode_env_path (0, normal
);
4052 if (NILP (Vpurify_flag
))
4053 normal
= PATH_LOADSEARCH
;
4055 normal
= PATH_DUMPLOADSEARCH
;
4057 /* In a dumped Emacs, we normally have to reset the value of
4058 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4059 uses ../lisp, instead of the path of the installed elisp
4060 libraries. However, if it appears that Vload_path was changed
4061 from the default before dumping, don't override that value. */
4064 if (! NILP (Fequal (dump_path
, Vload_path
)))
4066 Vload_path
= decode_env_path (0, normal
);
4067 if (!NILP (Vinstallation_directory
))
4069 Lisp_Object tem
, tem1
, sitelisp
;
4071 /* Remove site-lisp dirs from path temporarily and store
4072 them in sitelisp, then conc them on at the end so
4073 they're always first in path. */
4077 tem
= Fcar (Vload_path
);
4078 tem1
= Fstring_match (build_string ("site-lisp"),
4082 Vload_path
= Fcdr (Vload_path
);
4083 sitelisp
= Fcons (tem
, sitelisp
);
4089 /* Add to the path the lisp subdir of the
4090 installation dir, if it exists. */
4091 tem
= Fexpand_file_name (build_string ("lisp"),
4092 Vinstallation_directory
);
4093 tem1
= Ffile_exists_p (tem
);
4096 if (NILP (Fmember (tem
, Vload_path
)))
4098 turn_off_warning
= 1;
4099 Vload_path
= Fcons (tem
, Vload_path
);
4103 /* That dir doesn't exist, so add the build-time
4104 Lisp dirs instead. */
4105 Vload_path
= nconc2 (Vload_path
, dump_path
);
4107 /* Add leim under the installation dir, if it exists. */
4108 tem
= Fexpand_file_name (build_string ("leim"),
4109 Vinstallation_directory
);
4110 tem1
= Ffile_exists_p (tem
);
4113 if (NILP (Fmember (tem
, Vload_path
)))
4114 Vload_path
= Fcons (tem
, Vload_path
);
4117 /* Add site-lisp under the installation dir, if it exists. */
4118 tem
= Fexpand_file_name (build_string ("site-lisp"),
4119 Vinstallation_directory
);
4120 tem1
= Ffile_exists_p (tem
);
4123 if (NILP (Fmember (tem
, Vload_path
)))
4124 Vload_path
= Fcons (tem
, Vload_path
);
4127 /* If Emacs was not built in the source directory,
4128 and it is run from where it was built, add to load-path
4129 the lisp, leim and site-lisp dirs under that directory. */
4131 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4135 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4136 Vinstallation_directory
);
4137 tem1
= Ffile_exists_p (tem
);
4139 /* Don't be fooled if they moved the entire source tree
4140 AFTER dumping Emacs. If the build directory is indeed
4141 different from the source dir, src/Makefile.in and
4142 src/Makefile will not be found together. */
4143 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4144 Vinstallation_directory
);
4145 tem2
= Ffile_exists_p (tem
);
4146 if (!NILP (tem1
) && NILP (tem2
))
4148 tem
= Fexpand_file_name (build_string ("lisp"),
4151 if (NILP (Fmember (tem
, Vload_path
)))
4152 Vload_path
= Fcons (tem
, Vload_path
);
4154 tem
= Fexpand_file_name (build_string ("leim"),
4157 if (NILP (Fmember (tem
, Vload_path
)))
4158 Vload_path
= Fcons (tem
, Vload_path
);
4160 tem
= Fexpand_file_name (build_string ("site-lisp"),
4163 if (NILP (Fmember (tem
, Vload_path
)))
4164 Vload_path
= Fcons (tem
, Vload_path
);
4167 if (!NILP (sitelisp
) && !no_site_lisp
)
4168 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4174 /* NORMAL refers to the lisp dir in the source directory. */
4175 /* We used to add ../lisp at the front here, but
4176 that caused trouble because it was copied from dump_path
4177 into Vload_path, above, when Vinstallation_directory was non-nil.
4178 It should be unnecessary. */
4179 Vload_path
= decode_env_path (0, normal
);
4180 dump_path
= Vload_path
;
4184 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4185 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4186 almost never correct, thereby causing a warning to be printed out that
4187 confuses users. Since PATH_LOADSEARCH is always overridden by the
4188 EMACSLOADPATH environment variable below, disable the warning on NT. */
4190 /* Warn if dirs in the *standard* path don't exist. */
4191 if (!turn_off_warning
)
4193 Lisp_Object path_tail
;
4195 for (path_tail
= Vload_path
;
4197 path_tail
= XCDR (path_tail
))
4199 Lisp_Object dirfile
;
4200 dirfile
= Fcar (path_tail
);
4201 if (STRINGP (dirfile
))
4203 dirfile
= Fdirectory_file_name (dirfile
);
4204 if (access (SSDATA (dirfile
), 0) < 0)
4205 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4210 #endif /* !(WINDOWSNT || HAVE_NS) */
4212 /* If the EMACSLOADPATH environment variable is set, use its value.
4213 This doesn't apply if we're dumping. */
4215 if (NILP (Vpurify_flag
)
4216 && egetenv ("EMACSLOADPATH"))
4218 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4222 load_in_progress
= 0;
4223 Vload_file_name
= Qnil
;
4225 load_descriptor_list
= Qnil
;
4227 Vstandard_input
= Qt
;
4228 Vloads_in_progress
= Qnil
;
4231 /* Print a warning, using format string FORMAT, that directory DIRNAME
4232 does not exist. Print it on stderr and put it in *Messages*. */
4235 dir_warning (const char *format
, Lisp_Object dirname
)
4238 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4240 fprintf (stderr
, format
, SDATA (dirname
));
4241 sprintf (buffer
, format
, SDATA (dirname
));
4242 /* Don't log the warning before we've initialized!! */
4244 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4248 syms_of_lread (void)
4251 defsubr (&Sread_from_string
);
4253 defsubr (&Sintern_soft
);
4254 defsubr (&Sunintern
);
4255 defsubr (&Sget_load_suffixes
);
4257 defsubr (&Seval_buffer
);
4258 defsubr (&Seval_region
);
4259 defsubr (&Sread_char
);
4260 defsubr (&Sread_char_exclusive
);
4261 defsubr (&Sread_event
);
4262 defsubr (&Sget_file_char
);
4263 defsubr (&Smapatoms
);
4264 defsubr (&Slocate_file_internal
);
4266 DEFVAR_LISP ("obarray", Vobarray
,
4267 doc
: /* Symbol table for use by `intern' and `read'.
4268 It is a vector whose length ought to be prime for best results.
4269 The vector's contents don't make sense if examined from Lisp programs;
4270 to find all the symbols in an obarray, use `mapatoms'. */);
4272 DEFVAR_LISP ("values", Vvalues
,
4273 doc
: /* List of values of all expressions which were read, evaluated and printed.
4274 Order is reverse chronological. */);
4276 DEFVAR_LISP ("standard-input", Vstandard_input
,
4277 doc
: /* Stream for read to get input from.
4278 See documentation of `read' for possible values. */);
4279 Vstandard_input
= Qt
;
4281 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4282 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4284 If this variable is a buffer, then only forms read from that buffer
4285 will be added to `read-symbol-positions-list'.
4286 If this variable is t, then all read forms will be added.
4287 The effect of all other values other than nil are not currently
4288 defined, although they may be in the future.
4290 The positions are relative to the last call to `read' or
4291 `read-from-string'. It is probably a bad idea to set this variable at
4292 the toplevel; bind it instead. */);
4293 Vread_with_symbol_positions
= Qnil
;
4295 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4296 doc
: /* A list mapping read symbols to their positions.
4297 This variable is modified during calls to `read' or
4298 `read-from-string', but only when `read-with-symbol-positions' is
4301 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4302 CHAR-POSITION is an integer giving the offset of that occurrence of the
4303 symbol from the position where `read' or `read-from-string' started.
4305 Note that a symbol will appear multiple times in this list, if it was
4306 read multiple times. The list is in the same order as the symbols
4308 Vread_symbol_positions_list
= Qnil
;
4310 DEFVAR_LISP ("read-circle", Vread_circle
,
4311 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4314 DEFVAR_LISP ("load-path", Vload_path
,
4315 doc
: /* *List of directories to search for files to load.
4316 Each element is a string (directory name) or nil (try default directory).
4317 Initialized based on EMACSLOADPATH environment variable, if any,
4318 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4320 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4321 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4322 This list should not include the empty string.
4323 `load' and related functions try to append these suffixes, in order,
4324 to the specified file name if a Lisp suffix is allowed or required. */);
4325 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4326 Fcons (make_pure_c_string (".el"), Qnil
));
4327 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4328 doc
: /* List of suffixes that indicate representations of \
4330 This list should normally start with the empty string.
4332 Enabling Auto Compression mode appends the suffixes in
4333 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4334 mode removes them again. `load' and related functions use this list to
4335 determine whether they should look for compressed versions of a file
4336 and, if so, which suffixes they should try to append to the file name
4337 in order to do so. However, if you want to customize which suffixes
4338 the loading functions recognize as compression suffixes, you should
4339 customize `jka-compr-load-suffixes' rather than the present variable. */);
4340 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4342 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4343 doc
: /* Non-nil if inside of `load'. */);
4344 Qload_in_progress
= intern_c_string ("load-in-progress");
4345 staticpro (&Qload_in_progress
);
4347 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4348 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4349 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4351 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4352 a symbol \(a feature name).
4354 When `load' is run and the file-name argument matches an element's
4355 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4356 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4358 An error in FORMS does not undo the load, but does prevent execution of
4359 the rest of the FORMS. */);
4360 Vafter_load_alist
= Qnil
;
4362 DEFVAR_LISP ("load-history", Vload_history
,
4363 doc
: /* Alist mapping loaded file names to symbols and features.
4364 Each alist element should be a list (FILE-NAME ENTRIES...), where
4365 FILE-NAME is the name of a file that has been loaded into Emacs.
4366 The file name is absolute and true (i.e. it doesn't contain symlinks).
4367 As an exception, one of the alist elements may have FILE-NAME nil,
4368 for symbols and features not associated with any file.
4370 The remaining ENTRIES in the alist element describe the functions and
4371 variables defined in that file, the features provided, and the
4372 features required. Each entry has the form `(provide . FEATURE)',
4373 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4374 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4375 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4376 SYMBOL was an autoload before this file redefined it as a function.
4378 During preloading, the file name recorded is relative to the main Lisp
4379 directory. These file names are converted to absolute at startup. */);
4380 Vload_history
= Qnil
;
4382 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4383 doc
: /* Full name of file being loaded by `load'. */);
4384 Vload_file_name
= Qnil
;
4386 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4387 doc
: /* File name, including directory, of user's initialization file.
4388 If the file loaded had extension `.elc', and the corresponding source file
4389 exists, this variable contains the name of source file, suitable for use
4390 by functions like `custom-save-all' which edit the init file.
4391 While Emacs loads and evaluates the init file, value is the real name
4392 of the file, regardless of whether or not it has the `.elc' extension. */);
4393 Vuser_init_file
= Qnil
;
4395 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4396 doc
: /* Used for internal purposes by `load'. */);
4397 Vcurrent_load_list
= Qnil
;
4399 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4400 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4401 The default is nil, which means use the function `read'. */);
4402 Vload_read_function
= Qnil
;
4404 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4405 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4406 This function is for doing code conversion before reading the source file.
4407 If nil, loading is done without any code conversion.
4408 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4409 FULLNAME is the full name of FILE.
4410 See `load' for the meaning of the remaining arguments. */);
4411 Vload_source_file_function
= Qnil
;
4413 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4414 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4415 This is useful when the file being loaded is a temporary copy. */);
4416 load_force_doc_strings
= 0;
4418 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4419 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4420 This is normally bound by `load' and `eval-buffer' to control `read',
4421 and is not meant for users to change. */);
4422 load_convert_to_unibyte
= 0;
4424 DEFVAR_LISP ("source-directory", Vsource_directory
,
4425 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4426 You cannot count on them to still be there! */);
4428 = Fexpand_file_name (build_string ("../"),
4429 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4431 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4432 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4433 Vpreloaded_file_list
= Qnil
;
4435 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4436 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4437 Vbyte_boolean_vars
= Qnil
;
4439 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4440 doc
: /* Non-nil means load dangerous compiled Lisp files.
4441 Some versions of XEmacs use different byte codes than Emacs. These
4442 incompatible byte codes can make Emacs crash when it tries to execute
4444 load_dangerous_libraries
= 0;
4446 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4447 doc
: /* Non-nil means force printing messages when loading Lisp files.
4448 This overrides the value of the NOMESSAGE argument to `load'. */);
4449 force_load_messages
= 0;
4451 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4452 doc
: /* Regular expression matching safe to load compiled Lisp files.
4453 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4454 from the file, and matches them against this regular expression.
4455 When the regular expression matches, the file is considered to be safe
4456 to load. See also `load-dangerous-libraries'. */);
4457 Vbytecomp_version_regexp
4458 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4460 Qlexical_binding
= intern ("lexical-binding");
4461 staticpro (&Qlexical_binding
);
4462 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4463 doc
: /* If non-nil, use lexical binding when evaluating code.
4464 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4465 This variable is automatically set from the file variables of an interpreted
4466 Lisp file read using `load'. */);
4467 Fmake_variable_buffer_local (Qlexical_binding
);
4469 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4470 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4471 Veval_buffer_list
= Qnil
;
4473 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4474 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4475 Vold_style_backquotes
= Qnil
;
4476 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4477 staticpro (&Qold_style_backquotes
);
4479 /* Vsource_directory was initialized in init_lread. */
4481 load_descriptor_list
= Qnil
;
4482 staticpro (&load_descriptor_list
);
4484 Qcurrent_load_list
= intern_c_string ("current-load-list");
4485 staticpro (&Qcurrent_load_list
);
4487 Qstandard_input
= intern_c_string ("standard-input");
4488 staticpro (&Qstandard_input
);
4490 Qread_char
= intern_c_string ("read-char");
4491 staticpro (&Qread_char
);
4493 Qget_file_char
= intern_c_string ("get-file-char");
4494 staticpro (&Qget_file_char
);
4496 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4497 staticpro (&Qget_emacs_mule_file_char
);
4499 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4500 staticpro (&Qload_force_doc_strings
);
4502 Qbackquote
= intern_c_string ("`");
4503 staticpro (&Qbackquote
);
4504 Qcomma
= intern_c_string (",");
4505 staticpro (&Qcomma
);
4506 Qcomma_at
= intern_c_string (",@");
4507 staticpro (&Qcomma_at
);
4508 Qcomma_dot
= intern_c_string (",.");
4509 staticpro (&Qcomma_dot
);
4511 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4512 staticpro (&Qinhibit_file_name_operation
);
4514 Qascii_character
= intern_c_string ("ascii-character");
4515 staticpro (&Qascii_character
);
4517 Qfunction
= intern_c_string ("function");
4518 staticpro (&Qfunction
);
4520 Qload
= intern_c_string ("load");
4523 Qload_file_name
= intern_c_string ("load-file-name");
4524 staticpro (&Qload_file_name
);
4526 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4527 staticpro (&Qeval_buffer_list
);
4529 Qfile_truename
= intern_c_string ("file-truename");
4530 staticpro (&Qfile_truename
) ;
4532 Qdir_ok
= intern_c_string ("dir-ok");
4533 staticpro (&Qdir_ok
);
4535 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4536 staticpro (&Qdo_after_load_evaluation
) ;
4538 staticpro (&dump_path
);
4540 staticpro (&read_objects
);
4541 read_objects
= Qnil
;
4542 staticpro (&seen_list
);
4545 Vloads_in_progress
= Qnil
;
4546 staticpro (&Vloads_in_progress
);
4548 Qhash_table
= intern_c_string ("hash-table");
4549 staticpro (&Qhash_table
);
4550 Qdata
= intern_c_string ("data");
4552 Qtest
= intern_c_string ("test");
4554 Qsize
= intern_c_string ("size");
4556 Qweakness
= intern_c_string ("weakness");
4557 staticpro (&Qweakness
);
4558 Qrehash_size
= intern_c_string ("rehash-size");
4559 staticpro (&Qrehash_size
);
4560 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4561 staticpro (&Qrehash_threshold
);