Fix bug #11035 with cursor positioning on overlay strings with newlines.
[emacs.git] / src / lread.c
blob353f4a3064d58115d179d0106c224873273c3236
1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2012 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/>. */
21 #include <config.h>
22 #include <stdio.h>
23 #include <sys/types.h>
24 #include <sys/stat.h>
25 #include <sys/file.h>
26 #include <errno.h>
27 #include <limits.h> /* for CHAR_BIT */
28 #include <setjmp.h>
29 #include "lisp.h"
30 #include "intervals.h"
31 #include "buffer.h"
32 #include "character.h"
33 #include "charset.h"
34 #include "coding.h"
35 #include <epaths.h>
36 #include "commands.h"
37 #include "keyboard.h"
38 #include "frame.h"
39 #include "termhooks.h"
40 #include "coding.h"
41 #include "blockinput.h"
43 #ifdef MSDOS
44 #include "msdos.h"
45 #endif
47 #include <unistd.h>
48 #include <math.h>
50 #ifdef HAVE_SETLOCALE
51 #include <locale.h>
52 #endif /* HAVE_SETLOCALE */
54 #include <fcntl.h>
56 #ifdef HAVE_FSEEKO
57 #define file_offset off_t
58 #define file_tell ftello
59 #else
60 #define file_offset long
61 #define file_tell ftell
62 #endif
64 /* hash table read constants */
65 static Lisp_Object Qhash_table, Qdata;
66 static Lisp_Object Qtest, Qsize;
67 static Lisp_Object Qweakness;
68 static Lisp_Object Qrehash_size;
69 static Lisp_Object Qrehash_threshold;
71 static Lisp_Object Qread_char, Qget_file_char, Qcurrent_load_list;
72 Lisp_Object Qstandard_input;
73 Lisp_Object Qvariable_documentation;
74 static Lisp_Object Qascii_character, Qload, Qload_file_name;
75 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
76 static Lisp_Object Qinhibit_file_name_operation;
77 static Lisp_Object Qeval_buffer_list;
78 static Lisp_Object Qlexical_binding;
79 static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
81 /* Used instead of Qget_file_char while loading *.elc files compiled
82 by Emacs 21 or older. */
83 static Lisp_Object Qget_emacs_mule_file_char;
85 static Lisp_Object Qload_force_doc_strings;
87 extern Lisp_Object Qinternal_interpreter_environment;
89 static Lisp_Object Qload_in_progress;
91 /* The association list of objects read with the #n=object form.
92 Each member of the list has the form (n . object), and is used to
93 look up the object for the corresponding #n# construct.
94 It must be set to nil before all top-level calls to read0. */
95 static Lisp_Object read_objects;
97 /* Nonzero means READCHAR should read bytes one by one (not character)
98 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
99 This is set to 1 by read1 temporarily while handling #@NUMBER. */
100 static int load_each_byte;
102 /* List of descriptors now open for Fload. */
103 static Lisp_Object load_descriptor_list;
105 /* File for get_file_char to read from. Use by load. */
106 static FILE *instream;
108 /* When nonzero, read conses in pure space */
109 static int read_pure;
111 /* For use within read-from-string (this reader is non-reentrant!!) */
112 static EMACS_INT read_from_string_index;
113 static EMACS_INT read_from_string_index_byte;
114 static EMACS_INT read_from_string_limit;
116 /* Number of characters read in the current call to Fread or
117 Fread_from_string. */
118 static EMACS_INT readchar_count;
120 /* This contains the last string skipped with #@. */
121 static char *saved_doc_string;
122 /* Length of buffer allocated in saved_doc_string. */
123 static ptrdiff_t saved_doc_string_size;
124 /* Length of actual data in saved_doc_string. */
125 static ptrdiff_t saved_doc_string_length;
126 /* This is the file position that string came from. */
127 static file_offset saved_doc_string_position;
129 /* This contains the previous string skipped with #@.
130 We copy it from saved_doc_string when a new string
131 is put in saved_doc_string. */
132 static char *prev_saved_doc_string;
133 /* Length of buffer allocated in prev_saved_doc_string. */
134 static ptrdiff_t prev_saved_doc_string_size;
135 /* Length of actual data in prev_saved_doc_string. */
136 static ptrdiff_t prev_saved_doc_string_length;
137 /* This is the file position that string came from. */
138 static file_offset prev_saved_doc_string_position;
140 /* Nonzero means inside a new-style backquote
141 with no surrounding parentheses.
142 Fread initializes this to zero, so we need not specbind it
143 or worry about what happens to it when there is an error. */
144 static int new_backquote_flag;
145 static Lisp_Object Qold_style_backquotes;
147 /* A list of file names for files being loaded in Fload. Used to
148 check for recursive loads. */
150 static Lisp_Object Vloads_in_progress;
152 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
153 Lisp_Object);
155 static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int,
156 Lisp_Object, Lisp_Object,
157 Lisp_Object, Lisp_Object);
158 static Lisp_Object load_unwind (Lisp_Object);
159 static Lisp_Object load_descriptor_unwind (Lisp_Object);
161 static void invalid_syntax (const char *) NO_RETURN;
162 static void end_of_file_error (void) NO_RETURN;
165 /* Functions that read one byte from the current source READCHARFUN
166 or unreads one byte. If the integer argument C is -1, it returns
167 one read byte, or -1 when there's no more byte in the source. If C
168 is 0 or positive, it unreads C, and the return value is not
169 interesting. */
171 static int readbyte_for_lambda (int, Lisp_Object);
172 static int readbyte_from_file (int, Lisp_Object);
173 static int readbyte_from_string (int, Lisp_Object);
175 /* Handle unreading and rereading of characters.
176 Write READCHAR to read a character,
177 UNREAD(c) to unread c to be read again.
179 These macros correctly read/unread multibyte characters. */
181 #define READCHAR readchar (readcharfun, NULL)
182 #define UNREAD(c) unreadchar (readcharfun, c)
184 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
185 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
187 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
188 Qlambda, or a cons, we use this to keep an unread character because
189 a file stream can't handle multibyte-char unreading. The value -1
190 means that there's no unread character. */
191 static int unread_char;
193 static int
194 readchar (Lisp_Object readcharfun, int *multibyte)
196 Lisp_Object tem;
197 register int c;
198 int (*readbyte) (int, Lisp_Object);
199 unsigned char buf[MAX_MULTIBYTE_LENGTH];
200 int i, len;
201 int emacs_mule_encoding = 0;
203 if (multibyte)
204 *multibyte = 0;
206 readchar_count++;
208 if (BUFFERP (readcharfun))
210 register struct buffer *inbuffer = XBUFFER (readcharfun);
212 EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer);
214 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
215 return -1;
217 if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
219 /* Fetch the character code from the buffer. */
220 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
221 BUF_INC_POS (inbuffer, pt_byte);
222 c = STRING_CHAR (p);
223 if (multibyte)
224 *multibyte = 1;
226 else
228 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
229 if (! ASCII_BYTE_P (c))
230 c = BYTE8_TO_CHAR (c);
231 pt_byte++;
233 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
235 return c;
237 if (MARKERP (readcharfun))
239 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
241 EMACS_INT bytepos = marker_byte_position (readcharfun);
243 if (bytepos >= BUF_ZV_BYTE (inbuffer))
244 return -1;
246 if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
248 /* Fetch the character code from the buffer. */
249 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
250 BUF_INC_POS (inbuffer, bytepos);
251 c = STRING_CHAR (p);
252 if (multibyte)
253 *multibyte = 1;
255 else
257 c = BUF_FETCH_BYTE (inbuffer, bytepos);
258 if (! ASCII_BYTE_P (c))
259 c = BYTE8_TO_CHAR (c);
260 bytepos++;
263 XMARKER (readcharfun)->bytepos = bytepos;
264 XMARKER (readcharfun)->charpos++;
266 return c;
269 if (EQ (readcharfun, Qlambda))
271 readbyte = readbyte_for_lambda;
272 goto read_multibyte;
275 if (EQ (readcharfun, Qget_file_char))
277 readbyte = readbyte_from_file;
278 goto read_multibyte;
281 if (STRINGP (readcharfun))
283 if (read_from_string_index >= read_from_string_limit)
284 c = -1;
285 else if (STRING_MULTIBYTE (readcharfun))
287 if (multibyte)
288 *multibyte = 1;
289 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
290 read_from_string_index,
291 read_from_string_index_byte);
293 else
295 c = SREF (readcharfun, read_from_string_index_byte);
296 read_from_string_index++;
297 read_from_string_index_byte++;
299 return c;
302 if (CONSP (readcharfun))
304 /* This is the case that read_vector is reading from a unibyte
305 string that contains a byte sequence previously skipped
306 because of #@NUMBER. The car part of readcharfun is that
307 string, and the cdr part is a value of readcharfun given to
308 read_vector. */
309 readbyte = readbyte_from_string;
310 if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
311 emacs_mule_encoding = 1;
312 goto read_multibyte;
315 if (EQ (readcharfun, Qget_emacs_mule_file_char))
317 readbyte = readbyte_from_file;
318 emacs_mule_encoding = 1;
319 goto read_multibyte;
322 tem = call0 (readcharfun);
324 if (NILP (tem))
325 return -1;
326 return XINT (tem);
328 read_multibyte:
329 if (unread_char >= 0)
331 c = unread_char;
332 unread_char = -1;
333 return c;
335 c = (*readbyte) (-1, readcharfun);
336 if (c < 0 || load_each_byte)
337 return c;
338 if (multibyte)
339 *multibyte = 1;
340 if (ASCII_BYTE_P (c))
341 return c;
342 if (emacs_mule_encoding)
343 return read_emacs_mule_char (c, readbyte, readcharfun);
344 i = 0;
345 buf[i++] = c;
346 len = BYTES_BY_CHAR_HEAD (c);
347 while (i < len)
349 c = (*readbyte) (-1, readcharfun);
350 if (c < 0 || ! TRAILING_CODE_P (c))
352 while (--i > 1)
353 (*readbyte) (buf[i], readcharfun);
354 return BYTE8_TO_CHAR (buf[0]);
356 buf[i++] = c;
358 return STRING_CHAR (buf);
361 /* Unread the character C in the way appropriate for the stream READCHARFUN.
362 If the stream is a user function, call it with the char as argument. */
364 static void
365 unreadchar (Lisp_Object readcharfun, int c)
367 readchar_count--;
368 if (c == -1)
369 /* Don't back up the pointer if we're unreading the end-of-input mark,
370 since readchar didn't advance it when we read it. */
372 else if (BUFFERP (readcharfun))
374 struct buffer *b = XBUFFER (readcharfun);
375 EMACS_INT charpos = BUF_PT (b);
376 EMACS_INT bytepos = BUF_PT_BYTE (b);
378 if (! NILP (BVAR (b, enable_multibyte_characters)))
379 BUF_DEC_POS (b, bytepos);
380 else
381 bytepos--;
383 SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
385 else if (MARKERP (readcharfun))
387 struct buffer *b = XMARKER (readcharfun)->buffer;
388 EMACS_INT bytepos = XMARKER (readcharfun)->bytepos;
390 XMARKER (readcharfun)->charpos--;
391 if (! NILP (BVAR (b, enable_multibyte_characters)))
392 BUF_DEC_POS (b, bytepos);
393 else
394 bytepos--;
396 XMARKER (readcharfun)->bytepos = bytepos;
398 else if (STRINGP (readcharfun))
400 read_from_string_index--;
401 read_from_string_index_byte
402 = string_char_to_byte (readcharfun, read_from_string_index);
404 else if (CONSP (readcharfun))
406 unread_char = c;
408 else if (EQ (readcharfun, Qlambda))
410 unread_char = c;
412 else if (EQ (readcharfun, Qget_file_char)
413 || EQ (readcharfun, Qget_emacs_mule_file_char))
415 if (load_each_byte)
417 BLOCK_INPUT;
418 ungetc (c, instream);
419 UNBLOCK_INPUT;
421 else
422 unread_char = c;
424 else
425 call1 (readcharfun, make_number (c));
428 static int
429 readbyte_for_lambda (int c, Lisp_Object readcharfun)
431 return read_bytecode_char (c >= 0);
435 static int
436 readbyte_from_file (int c, Lisp_Object readcharfun)
438 if (c >= 0)
440 BLOCK_INPUT;
441 ungetc (c, instream);
442 UNBLOCK_INPUT;
443 return 0;
446 BLOCK_INPUT;
447 c = getc (instream);
449 #ifdef EINTR
450 /* Interrupted reads have been observed while reading over the network */
451 while (c == EOF && ferror (instream) && errno == EINTR)
453 UNBLOCK_INPUT;
454 QUIT;
455 BLOCK_INPUT;
456 clearerr (instream);
457 c = getc (instream);
459 #endif
461 UNBLOCK_INPUT;
463 return (c == EOF ? -1 : c);
466 static int
467 readbyte_from_string (int c, Lisp_Object readcharfun)
469 Lisp_Object string = XCAR (readcharfun);
471 if (c >= 0)
473 read_from_string_index--;
474 read_from_string_index_byte
475 = string_char_to_byte (string, read_from_string_index);
478 if (read_from_string_index >= read_from_string_limit)
479 c = -1;
480 else
481 FETCH_STRING_CHAR_ADVANCE (c, string,
482 read_from_string_index,
483 read_from_string_index_byte);
484 return c;
488 /* Read one non-ASCII character from INSTREAM. The character is
489 encoded in `emacs-mule' and the first byte is already read in
490 C. */
492 static int
493 read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
495 /* Emacs-mule coding uses at most 4-byte for one character. */
496 unsigned char buf[4];
497 int len = emacs_mule_bytes[c];
498 struct charset *charset;
499 int i;
500 unsigned code;
502 if (len == 1)
503 /* C is not a valid leading-code of `emacs-mule'. */
504 return BYTE8_TO_CHAR (c);
506 i = 0;
507 buf[i++] = c;
508 while (i < len)
510 c = (*readbyte) (-1, readcharfun);
511 if (c < 0xA0)
513 while (--i > 1)
514 (*readbyte) (buf[i], readcharfun);
515 return BYTE8_TO_CHAR (buf[0]);
517 buf[i++] = c;
520 if (len == 2)
522 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
523 code = buf[1] & 0x7F;
525 else if (len == 3)
527 if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
528 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
530 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
531 code = buf[2] & 0x7F;
533 else
535 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
536 code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
539 else
541 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
542 code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
544 c = DECODE_CHAR (charset, code);
545 if (c < 0)
546 Fsignal (Qinvalid_read_syntax,
547 Fcons (build_string ("invalid multibyte form"), Qnil));
548 return c;
552 static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
553 Lisp_Object);
554 static Lisp_Object read0 (Lisp_Object);
555 static Lisp_Object read1 (Lisp_Object, int *, int);
557 static Lisp_Object read_list (int, Lisp_Object);
558 static Lisp_Object read_vector (Lisp_Object, int);
560 static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
561 Lisp_Object);
562 static void substitute_object_in_subtree (Lisp_Object,
563 Lisp_Object);
564 static void substitute_in_interval (INTERVAL, Lisp_Object);
567 /* Get a character from the tty. */
569 /* Read input events until we get one that's acceptable for our purposes.
571 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
572 until we get a character we like, and then stuffed into
573 unread_switch_frame.
575 If ASCII_REQUIRED is non-zero, we check function key events to see
576 if the unmodified version of the symbol has a Qascii_character
577 property, and use that character, if present.
579 If ERROR_NONASCII is non-zero, we signal an error if the input we
580 get isn't an ASCII character with modifiers. If it's zero but
581 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
582 character.
584 If INPUT_METHOD is nonzero, we invoke the current input method
585 if the character warrants that.
587 If SECONDS is a number, we wait that many seconds for input, and
588 return Qnil if no input arrives within that time. */
590 static Lisp_Object
591 read_filtered_event (int no_switch_frame, int ascii_required,
592 int error_nonascii, int input_method, Lisp_Object seconds)
594 Lisp_Object val, delayed_switch_frame;
595 EMACS_TIME end_time;
597 #ifdef HAVE_WINDOW_SYSTEM
598 if (display_hourglass_p)
599 cancel_hourglass ();
600 #endif
602 delayed_switch_frame = Qnil;
604 /* Compute timeout. */
605 if (NUMBERP (seconds))
607 EMACS_TIME wait_time;
608 int sec, usec;
609 double duration = extract_float (seconds);
611 sec = (int) duration;
612 usec = (duration - sec) * 1000000;
613 EMACS_GET_TIME (end_time);
614 EMACS_SET_SECS_USECS (wait_time, sec, usec);
615 EMACS_ADD_TIME (end_time, end_time, wait_time);
618 /* Read until we get an acceptable event. */
619 retry:
621 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
622 NUMBERP (seconds) ? &end_time : NULL);
623 while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
625 if (BUFFERP (val))
626 goto retry;
628 /* switch-frame events are put off until after the next ASCII
629 character. This is better than signaling an error just because
630 the last characters were typed to a separate minibuffer frame,
631 for example. Eventually, some code which can deal with
632 switch-frame events will read it and process it. */
633 if (no_switch_frame
634 && EVENT_HAS_PARAMETERS (val)
635 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
637 delayed_switch_frame = val;
638 goto retry;
641 if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
643 /* Convert certain symbols to their ASCII equivalents. */
644 if (SYMBOLP (val))
646 Lisp_Object tem, tem1;
647 tem = Fget (val, Qevent_symbol_element_mask);
648 if (!NILP (tem))
650 tem1 = Fget (Fcar (tem), Qascii_character);
651 /* Merge this symbol's modifier bits
652 with the ASCII equivalent of its basic code. */
653 if (!NILP (tem1))
654 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
658 /* If we don't have a character now, deal with it appropriately. */
659 if (!INTEGERP (val))
661 if (error_nonascii)
663 Vunread_command_events = Fcons (val, Qnil);
664 error ("Non-character input-event");
666 else
667 goto retry;
671 if (! NILP (delayed_switch_frame))
672 unread_switch_frame = delayed_switch_frame;
674 #if 0
676 #ifdef HAVE_WINDOW_SYSTEM
677 if (display_hourglass_p)
678 start_hourglass ();
679 #endif
681 #endif
683 return val;
686 DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
687 doc: /* Read a character from the command input (keyboard or macro).
688 It is returned as a number.
689 If the character has modifiers, they are resolved and reflected to the
690 character code if possible (e.g. C-SPC -> 0).
692 If the user generates an event which is not a character (i.e. a mouse
693 click or function key event), `read-char' signals an error. As an
694 exception, switch-frame events are put off until non-character events
695 can be read.
696 If you want to read non-character events, or ignore them, call
697 `read-event' or `read-char-exclusive' instead.
699 If the optional argument PROMPT is non-nil, display that as a prompt.
700 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
701 input method is turned on in the current buffer, that input method
702 is used for reading a character.
703 If the optional argument SECONDS is non-nil, it should be a number
704 specifying the maximum number of seconds to wait for input. If no
705 input arrives in that time, return nil. SECONDS may be a
706 floating-point value. */)
707 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
709 Lisp_Object val;
711 if (! NILP (prompt))
712 message_with_string ("%s", prompt, 0);
713 val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
715 return (NILP (val) ? Qnil
716 : make_number (char_resolve_modifier_mask (XINT (val))));
719 DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
720 doc: /* Read an event object from the input stream.
721 If the optional argument PROMPT is non-nil, display that as a prompt.
722 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
723 input method is turned on in the current buffer, that input method
724 is used for reading a character.
725 If the optional argument SECONDS is non-nil, it should be a number
726 specifying the maximum number of seconds to wait for input. If no
727 input arrives in that time, return nil. SECONDS may be a
728 floating-point value. */)
729 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
731 if (! NILP (prompt))
732 message_with_string ("%s", prompt, 0);
733 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
736 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
737 doc: /* Read a character from the command input (keyboard or macro).
738 It is returned as a number. Non-character events are ignored.
739 If the character has modifiers, they are resolved and reflected to the
740 character code if possible (e.g. C-SPC -> 0).
742 If the optional argument PROMPT is non-nil, display that as a prompt.
743 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
744 input method is turned on in the current buffer, that input method
745 is used for reading a character.
746 If the optional argument SECONDS is non-nil, it should be a number
747 specifying the maximum number of seconds to wait for input. If no
748 input arrives in that time, return nil. SECONDS may be a
749 floating-point value. */)
750 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
752 Lisp_Object val;
754 if (! NILP (prompt))
755 message_with_string ("%s", prompt, 0);
757 val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
759 return (NILP (val) ? Qnil
760 : make_number (char_resolve_modifier_mask (XINT (val))));
763 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
764 doc: /* Don't use this yourself. */)
765 (void)
767 register Lisp_Object val;
768 BLOCK_INPUT;
769 XSETINT (val, getc (instream));
770 UNBLOCK_INPUT;
771 return val;
777 /* Return true if the lisp code read using READCHARFUN defines a non-nil
778 `lexical-binding' file variable. After returning, the stream is
779 positioned following the first line, if it is a comment, otherwise
780 nothing is read. */
782 static int
783 lisp_file_lexically_bound_p (Lisp_Object readcharfun)
785 int ch = READCHAR;
786 if (ch != ';')
787 /* The first line isn't a comment, just give up. */
789 UNREAD (ch);
790 return 0;
792 else
793 /* Look for an appropriate file-variable in the first line. */
795 int rv = 0;
796 enum {
797 NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
798 } beg_end_state = NOMINAL;
799 int in_file_vars = 0;
801 #define UPDATE_BEG_END_STATE(ch) \
802 if (beg_end_state == NOMINAL) \
803 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
804 else if (beg_end_state == AFTER_FIRST_DASH) \
805 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
806 else if (beg_end_state == AFTER_ASTERIX) \
808 if (ch == '-') \
809 in_file_vars = !in_file_vars; \
810 beg_end_state = NOMINAL; \
813 /* Skip until we get to the file vars, if any. */
816 ch = READCHAR;
817 UPDATE_BEG_END_STATE (ch);
819 while (!in_file_vars && ch != '\n' && ch != EOF);
821 while (in_file_vars)
823 char var[100], val[100];
824 unsigned i;
826 ch = READCHAR;
828 /* Read a variable name. */
829 while (ch == ' ' || ch == '\t')
830 ch = READCHAR;
832 i = 0;
833 while (ch != ':' && ch != '\n' && ch != EOF && in_file_vars)
835 if (i < sizeof var - 1)
836 var[i++] = ch;
837 UPDATE_BEG_END_STATE (ch);
838 ch = READCHAR;
841 /* Stop scanning if no colon was found before end marker. */
842 if (!in_file_vars)
843 break;
845 while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
846 i--;
847 var[i] = '\0';
849 if (ch == ':')
851 /* Read a variable value. */
852 ch = READCHAR;
854 while (ch == ' ' || ch == '\t')
855 ch = READCHAR;
857 i = 0;
858 while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
860 if (i < sizeof val - 1)
861 val[i++] = ch;
862 UPDATE_BEG_END_STATE (ch);
863 ch = READCHAR;
865 if (! in_file_vars)
866 /* The value was terminated by an end-marker, which
867 remove. */
868 i -= 3;
869 while (i > 0 && (val[i - 1] == ' ' || val[i - 1] == '\t'))
870 i--;
871 val[i] = '\0';
873 if (strcmp (var, "lexical-binding") == 0)
874 /* This is it... */
876 rv = (strcmp (val, "nil") != 0);
877 break;
882 while (ch != '\n' && ch != EOF)
883 ch = READCHAR;
885 return rv;
889 /* Value is a version number of byte compiled code if the file
890 associated with file descriptor FD is a compiled Lisp file that's
891 safe to load. Only files compiled with Emacs are safe to load.
892 Files compiled with XEmacs can lead to a crash in Fbyte_code
893 because of an incompatible change in the byte compiler. */
895 static int
896 safe_to_load_p (int fd)
898 char buf[512];
899 int nbytes, i;
900 int safe_p = 1;
901 int version = 1;
903 /* Read the first few bytes from the file, and look for a line
904 specifying the byte compiler version used. */
905 nbytes = emacs_read (fd, buf, sizeof buf - 1);
906 if (nbytes > 0)
908 buf[nbytes] = '\0';
910 /* Skip to the next newline, skipping over the initial `ELC'
911 with NUL bytes following it, but note the version. */
912 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
913 if (i == 4)
914 version = buf[i];
916 if (i >= nbytes
917 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
918 buf + i) < 0)
919 safe_p = 0;
921 if (safe_p)
922 safe_p = version;
924 lseek (fd, 0, SEEK_SET);
925 return safe_p;
929 /* Callback for record_unwind_protect. Restore the old load list OLD,
930 after loading a file successfully. */
932 static Lisp_Object
933 record_load_unwind (Lisp_Object old)
935 return Vloads_in_progress = old;
938 /* This handler function is used via internal_condition_case_1. */
940 static Lisp_Object
941 load_error_handler (Lisp_Object data)
943 return Qnil;
946 static Lisp_Object
947 load_warn_old_style_backquotes (Lisp_Object file)
949 if (!NILP (Vold_style_backquotes))
951 Lisp_Object args[2];
952 args[0] = build_string ("Loading `%s': old-style backquotes detected!");
953 args[1] = file;
954 Fmessage (2, args);
956 return Qnil;
959 DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
960 doc: /* Return the suffixes that `load' should try if a suffix is \
961 required.
962 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
963 (void)
965 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
966 while (CONSP (suffixes))
968 Lisp_Object exts = Vload_file_rep_suffixes;
969 suffix = XCAR (suffixes);
970 suffixes = XCDR (suffixes);
971 while (CONSP (exts))
973 ext = XCAR (exts);
974 exts = XCDR (exts);
975 lst = Fcons (concat2 (suffix, ext), lst);
978 return Fnreverse (lst);
981 DEFUN ("load", Fload, Sload, 1, 5, 0,
982 doc: /* Execute a file of Lisp code named FILE.
983 First try FILE with `.elc' appended, then try with `.el',
984 then try FILE unmodified (the exact suffixes in the exact order are
985 determined by `load-suffixes'). Environment variable references in
986 FILE are replaced with their values by calling `substitute-in-file-name'.
987 This function searches the directories in `load-path'.
989 If optional second arg NOERROR is non-nil,
990 report no error if FILE doesn't exist.
991 Print messages at start and end of loading unless
992 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
993 overrides that).
994 If optional fourth arg NOSUFFIX is non-nil, don't try adding
995 suffixes `.elc' or `.el' to the specified name FILE.
996 If optional fifth arg MUST-SUFFIX is non-nil, insist on
997 the suffix `.elc' or `.el'; don't accept just FILE unless
998 it ends in one of those suffixes or includes a directory name.
1000 If this function fails to find a file, it may look for different
1001 representations of that file before trying another file.
1002 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1003 to the file name. Emacs uses this feature mainly to find compressed
1004 versions of files when Auto Compression mode is enabled.
1006 The exact suffixes that this function tries out, in the exact order,
1007 are given by the value of the variable `load-file-rep-suffixes' if
1008 NOSUFFIX is non-nil and by the return value of the function
1009 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1010 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1011 and then the former.
1013 Loading a file records its definitions, and its `provide' and
1014 `require' calls, in an element of `load-history' whose
1015 car is the file name loaded. See `load-history'.
1017 While the file is in the process of being loaded, the variable
1018 `load-in-progress' is non-nil and the variable `load-file-name'
1019 is bound to the file's name.
1021 Return t if the file exists and loads successfully. */)
1022 (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix)
1024 register FILE *stream;
1025 register int fd = -1;
1026 int count = SPECPDL_INDEX ();
1027 struct gcpro gcpro1, gcpro2, gcpro3;
1028 Lisp_Object found, efound, hist_file_name;
1029 /* 1 means we printed the ".el is newer" message. */
1030 int newer = 0;
1031 /* 1 means we are loading a compiled file. */
1032 int compiled = 0;
1033 Lisp_Object handler;
1034 int safe_p = 1;
1035 const char *fmode = "r";
1036 Lisp_Object tmp[2];
1037 int version;
1039 #ifdef DOS_NT
1040 fmode = "rt";
1041 #endif /* DOS_NT */
1043 CHECK_STRING (file);
1045 /* If file name is magic, call the handler. */
1046 /* This shouldn't be necessary any more now that `openp' handles it right.
1047 handler = Ffind_file_name_handler (file, Qload);
1048 if (!NILP (handler))
1049 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1051 /* Do this after the handler to avoid
1052 the need to gcpro noerror, nomessage and nosuffix.
1053 (Below here, we care only whether they are nil or not.)
1054 The presence of this call is the result of a historical accident:
1055 it used to be in every file-operation and when it got removed
1056 everywhere, it accidentally stayed here. Since then, enough people
1057 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1058 that it seemed risky to remove. */
1059 if (! NILP (noerror))
1061 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
1062 Qt, load_error_handler);
1063 if (NILP (file))
1064 return Qnil;
1066 else
1067 file = Fsubstitute_in_file_name (file);
1070 /* Avoid weird lossage with null string as arg,
1071 since it would try to load a directory as a Lisp file */
1072 if (SBYTES (file) > 0)
1074 ptrdiff_t size = SBYTES (file);
1076 found = Qnil;
1077 GCPRO2 (file, found);
1079 if (! NILP (must_suffix))
1081 /* Don't insist on adding a suffix if FILE already ends with one. */
1082 if (size > 3
1083 && !strcmp (SSDATA (file) + size - 3, ".el"))
1084 must_suffix = Qnil;
1085 else if (size > 4
1086 && !strcmp (SSDATA (file) + size - 4, ".elc"))
1087 must_suffix = Qnil;
1088 /* Don't insist on adding a suffix
1089 if the argument includes a directory name. */
1090 else if (! NILP (Ffile_name_directory (file)))
1091 must_suffix = Qnil;
1094 fd = openp (Vload_path, file,
1095 (!NILP (nosuffix) ? Qnil
1096 : !NILP (must_suffix) ? Fget_load_suffixes ()
1097 : Fappend (2, (tmp[0] = Fget_load_suffixes (),
1098 tmp[1] = Vload_file_rep_suffixes,
1099 tmp))),
1100 &found, Qnil);
1101 UNGCPRO;
1104 if (fd == -1)
1106 if (NILP (noerror))
1107 xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
1108 return Qnil;
1111 /* Tell startup.el whether or not we found the user's init file. */
1112 if (EQ (Qt, Vuser_init_file))
1113 Vuser_init_file = found;
1115 /* If FD is -2, that means openp found a magic file. */
1116 if (fd == -2)
1118 if (NILP (Fequal (found, file)))
1119 /* If FOUND is a different file name from FILE,
1120 find its handler even if we have already inhibited
1121 the `load' operation on FILE. */
1122 handler = Ffind_file_name_handler (found, Qt);
1123 else
1124 handler = Ffind_file_name_handler (found, Qload);
1125 if (! NILP (handler))
1126 return call5 (handler, Qload, found, noerror, nomessage, Qt);
1127 #ifdef DOS_NT
1128 /* Tramp has to deal with semi-broken packages that prepend
1129 drive letters to remote files. For that reason, Tramp
1130 catches file operations that test for file existence, which
1131 makes openp think X:/foo.elc files are remote. However,
1132 Tramp does not catch `load' operations for such files, so we
1133 end up with a nil as the `load' handler above. If we would
1134 continue with fd = -2, we will behave wrongly, and in
1135 particular try reading a .elc file in the "rt" mode instead
1136 of "rb". See bug #9311 for the results. To work around
1137 this, we try to open the file locally, and go with that if it
1138 succeeds. */
1139 fd = emacs_open (SSDATA (ENCODE_FILE (found)), O_RDONLY, 0);
1140 if (fd == -1)
1141 fd = -2;
1142 #endif
1145 /* Check if we're stuck in a recursive load cycle.
1147 2000-09-21: It's not possible to just check for the file loaded
1148 being a member of Vloads_in_progress. This fails because of the
1149 way the byte compiler currently works; `provide's are not
1150 evaluated, see font-lock.el/jit-lock.el as an example. This
1151 leads to a certain amount of ``normal'' recursion.
1153 Also, just loading a file recursively is not always an error in
1154 the general case; the second load may do something different. */
1156 int load_count = 0;
1157 Lisp_Object tem;
1158 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
1159 if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
1161 if (fd >= 0)
1162 emacs_close (fd);
1163 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
1165 record_unwind_protect (record_load_unwind, Vloads_in_progress);
1166 Vloads_in_progress = Fcons (found, Vloads_in_progress);
1169 /* All loads are by default dynamic, unless the file itself specifies
1170 otherwise using a file-variable in the first line. This is bound here
1171 so that it takes effect whether or not we use
1172 Vload_source_file_function. */
1173 specbind (Qlexical_binding, Qnil);
1175 /* Get the name for load-history. */
1176 hist_file_name = (! NILP (Vpurify_flag)
1177 ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
1178 tmp[1] = Ffile_name_nondirectory (found),
1179 tmp))
1180 : found) ;
1182 version = -1;
1184 /* Check for the presence of old-style quotes and warn about them. */
1185 specbind (Qold_style_backquotes, Qnil);
1186 record_unwind_protect (load_warn_old_style_backquotes, file);
1188 if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
1189 || (fd >= 0 && (version = safe_to_load_p (fd)) > 0))
1190 /* Load .elc files directly, but not when they are
1191 remote and have no handler! */
1193 if (fd != -2)
1195 struct stat s1, s2;
1196 int result;
1198 GCPRO3 (file, found, hist_file_name);
1200 if (version < 0
1201 && ! (version = safe_to_load_p (fd)))
1203 safe_p = 0;
1204 if (!load_dangerous_libraries)
1206 if (fd >= 0)
1207 emacs_close (fd);
1208 error ("File `%s' was not compiled in Emacs",
1209 SDATA (found));
1211 else if (!NILP (nomessage) && !force_load_messages)
1212 message_with_string ("File `%s' not compiled in Emacs", found, 1);
1215 compiled = 1;
1217 efound = ENCODE_FILE (found);
1219 #ifdef DOS_NT
1220 fmode = "rb";
1221 #endif /* DOS_NT */
1222 result = stat (SSDATA (efound), &s1);
1223 if (result == 0)
1225 SSET (efound, SBYTES (efound) - 1, 0);
1226 result = stat (SSDATA (efound), &s2);
1227 SSET (efound, SBYTES (efound) - 1, 'c');
1230 if (result == 0 && s1.st_mtime < s2.st_mtime)
1232 /* Make the progress messages mention that source is newer. */
1233 newer = 1;
1235 /* If we won't print another message, mention this anyway. */
1236 if (!NILP (nomessage) && !force_load_messages)
1238 Lisp_Object msg_file;
1239 msg_file = Fsubstring (found, make_number (0), make_number (-1));
1240 message_with_string ("Source file `%s' newer than byte-compiled file",
1241 msg_file, 1);
1244 UNGCPRO;
1247 else
1249 /* We are loading a source file (*.el). */
1250 if (!NILP (Vload_source_file_function))
1252 Lisp_Object val;
1254 if (fd >= 0)
1255 emacs_close (fd);
1256 val = call4 (Vload_source_file_function, found, hist_file_name,
1257 NILP (noerror) ? Qnil : Qt,
1258 (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
1259 return unbind_to (count, val);
1263 GCPRO3 (file, found, hist_file_name);
1265 #ifdef WINDOWSNT
1266 efound = ENCODE_FILE (found);
1267 /* If we somehow got here with fd == -2, meaning the file is deemed
1268 to be remote, don't even try to reopen the file locally; just
1269 force a failure instead. */
1270 if (fd >= 0)
1272 emacs_close (fd);
1273 stream = fopen (SSDATA (efound), fmode);
1275 else
1276 stream = NULL;
1277 #else /* not WINDOWSNT */
1278 stream = fdopen (fd, fmode);
1279 #endif /* not WINDOWSNT */
1280 if (stream == 0)
1282 emacs_close (fd);
1283 error ("Failure to create stdio stream for %s", SDATA (file));
1286 if (! NILP (Vpurify_flag))
1287 Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
1289 if (NILP (nomessage) || force_load_messages)
1291 if (!safe_p)
1292 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1293 file, 1);
1294 else if (!compiled)
1295 message_with_string ("Loading %s (source)...", file, 1);
1296 else if (newer)
1297 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1298 file, 1);
1299 else /* The typical case; compiled file newer than source file. */
1300 message_with_string ("Loading %s...", file, 1);
1303 record_unwind_protect (load_unwind, make_save_value (stream, 0));
1304 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
1305 specbind (Qload_file_name, found);
1306 specbind (Qinhibit_file_name_operation, Qnil);
1307 load_descriptor_list
1308 = Fcons (make_number (fileno (stream)), load_descriptor_list);
1309 specbind (Qload_in_progress, Qt);
1311 instream = stream;
1312 if (lisp_file_lexically_bound_p (Qget_file_char))
1313 Fset (Qlexical_binding, Qt);
1315 if (! version || version >= 22)
1316 readevalloop (Qget_file_char, stream, hist_file_name,
1317 0, Qnil, Qnil, Qnil, Qnil);
1318 else
1320 /* We can't handle a file which was compiled with
1321 byte-compile-dynamic by older version of Emacs. */
1322 specbind (Qload_force_doc_strings, Qt);
1323 readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name,
1324 0, Qnil, Qnil, Qnil, Qnil);
1326 unbind_to (count, Qnil);
1328 /* Run any eval-after-load forms for this file */
1329 if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
1330 call1 (Qdo_after_load_evaluation, hist_file_name) ;
1332 UNGCPRO;
1334 xfree (saved_doc_string);
1335 saved_doc_string = 0;
1336 saved_doc_string_size = 0;
1338 xfree (prev_saved_doc_string);
1339 prev_saved_doc_string = 0;
1340 prev_saved_doc_string_size = 0;
1342 if (!noninteractive && (NILP (nomessage) || force_load_messages))
1344 if (!safe_p)
1345 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1346 file, 1);
1347 else if (!compiled)
1348 message_with_string ("Loading %s (source)...done", file, 1);
1349 else if (newer)
1350 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1351 file, 1);
1352 else /* The typical case; compiled file newer than source file. */
1353 message_with_string ("Loading %s...done", file, 1);
1356 return Qt;
1359 static Lisp_Object
1360 load_unwind (Lisp_Object arg) /* used as unwind-protect function in load */
1362 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
1363 if (stream != NULL)
1365 BLOCK_INPUT;
1366 fclose (stream);
1367 UNBLOCK_INPUT;
1369 return Qnil;
1372 static Lisp_Object
1373 load_descriptor_unwind (Lisp_Object oldlist)
1375 load_descriptor_list = oldlist;
1376 return Qnil;
1379 /* Close all descriptors in use for Floads.
1380 This is used when starting a subprocess. */
1382 void
1383 close_load_descs (void)
1385 #ifndef WINDOWSNT
1386 Lisp_Object tail;
1387 for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
1388 emacs_close (XFASTINT (XCAR (tail)));
1389 #endif
1392 static int
1393 complete_filename_p (Lisp_Object pathname)
1395 register const unsigned char *s = SDATA (pathname);
1396 return (IS_DIRECTORY_SEP (s[0])
1397 || (SCHARS (pathname) > 2
1398 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
1401 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1402 doc: /* Search for FILENAME through PATH.
1403 Returns the file's name in absolute form, or nil if not found.
1404 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1405 file name when searching.
1406 If non-nil, PREDICATE is used instead of `file-readable-p'.
1407 PREDICATE can also be an integer to pass to the access(2) function,
1408 in which case file-name-handlers are ignored.
1409 This function will normally skip directories, so if you want it to find
1410 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1411 (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
1413 Lisp_Object file;
1414 int fd = openp (path, filename, suffixes, &file, predicate);
1415 if (NILP (predicate) && fd > 0)
1416 close (fd);
1417 return file;
1420 static Lisp_Object Qdir_ok;
1422 /* Search for a file whose name is STR, looking in directories
1423 in the Lisp list PATH, and trying suffixes from SUFFIX.
1424 On success, returns a file descriptor. On failure, returns -1.
1426 SUFFIXES is a list of strings containing possible suffixes.
1427 The empty suffix is automatically added if the list is empty.
1429 PREDICATE non-nil means don't open the files,
1430 just look for one that satisfies the predicate. In this case,
1431 returns 1 on success. The predicate can be a lisp function or
1432 an integer to pass to `access' (in which case file-name-handlers
1433 are ignored).
1435 If STOREPTR is nonzero, it points to a slot where the name of
1436 the file actually found should be stored as a Lisp string.
1437 nil is stored there on failure.
1439 If the file we find is remote, return -2
1440 but store the found remote file name in *STOREPTR. */
1443 openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
1445 register int fd;
1446 EMACS_INT fn_size = 100;
1447 char buf[100];
1448 register char *fn = buf;
1449 int absolute = 0;
1450 EMACS_INT want_length;
1451 Lisp_Object filename;
1452 struct stat st;
1453 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1454 Lisp_Object string, tail, encoded_fn;
1455 EMACS_INT max_suffix_len = 0;
1457 CHECK_STRING (str);
1459 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1461 CHECK_STRING_CAR (tail);
1462 max_suffix_len = max (max_suffix_len,
1463 SBYTES (XCAR (tail)));
1466 string = filename = encoded_fn = Qnil;
1467 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1469 if (storeptr)
1470 *storeptr = Qnil;
1472 if (complete_filename_p (str))
1473 absolute = 1;
1475 for (; CONSP (path); path = XCDR (path))
1477 filename = Fexpand_file_name (str, XCAR (path));
1478 if (!complete_filename_p (filename))
1479 /* If there are non-absolute elts in PATH (eg ".") */
1480 /* Of course, this could conceivably lose if luser sets
1481 default-directory to be something non-absolute... */
1483 filename = Fexpand_file_name (filename, BVAR (current_buffer, directory));
1484 if (!complete_filename_p (filename))
1485 /* Give up on this path element! */
1486 continue;
1489 /* Calculate maximum length of any filename made from
1490 this path element/specified file name and any possible suffix. */
1491 want_length = max_suffix_len + SBYTES (filename);
1492 if (fn_size <= want_length)
1493 fn = (char *) alloca (fn_size = 100 + want_length);
1495 /* Loop over suffixes. */
1496 for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
1497 CONSP (tail); tail = XCDR (tail))
1499 ptrdiff_t lsuffix = SBYTES (XCAR (tail));
1500 Lisp_Object handler;
1501 int exists;
1503 /* Concatenate path element/specified name with the suffix.
1504 If the directory starts with /:, remove that. */
1505 if (SCHARS (filename) > 2
1506 && SREF (filename, 0) == '/'
1507 && SREF (filename, 1) == ':')
1509 strncpy (fn, SSDATA (filename) + 2,
1510 SBYTES (filename) - 2);
1511 fn[SBYTES (filename) - 2] = 0;
1513 else
1515 strncpy (fn, SSDATA (filename),
1516 SBYTES (filename));
1517 fn[SBYTES (filename)] = 0;
1520 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
1521 strncat (fn, SSDATA (XCAR (tail)), lsuffix);
1523 /* Check that the file exists and is not a directory. */
1524 /* We used to only check for handlers on non-absolute file names:
1525 if (absolute)
1526 handler = Qnil;
1527 else
1528 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1529 It's not clear why that was the case and it breaks things like
1530 (load "/bar.el") where the file is actually "/bar.el.gz". */
1531 string = build_string (fn);
1532 handler = Ffind_file_name_handler (string, Qfile_exists_p);
1533 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1535 if (NILP (predicate))
1536 exists = !NILP (Ffile_readable_p (string));
1537 else
1539 Lisp_Object tmp = call1 (predicate, string);
1540 exists = !NILP (tmp)
1541 && (EQ (tmp, Qdir_ok)
1542 || NILP (Ffile_directory_p (string)));
1545 if (exists)
1547 /* We succeeded; return this descriptor and filename. */
1548 if (storeptr)
1549 *storeptr = string;
1550 UNGCPRO;
1551 return -2;
1554 else
1556 const char *pfn;
1558 encoded_fn = ENCODE_FILE (string);
1559 pfn = SSDATA (encoded_fn);
1560 exists = (stat (pfn, &st) == 0 && ! S_ISDIR (st.st_mode));
1561 if (exists)
1563 /* Check that we can access or open it. */
1564 if (NATNUMP (predicate))
1565 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
1566 else
1567 fd = emacs_open (pfn, O_RDONLY, 0);
1569 if (fd >= 0)
1571 /* We succeeded; return this descriptor and filename. */
1572 if (storeptr)
1573 *storeptr = string;
1574 UNGCPRO;
1575 return fd;
1580 if (absolute)
1581 break;
1584 UNGCPRO;
1585 return -1;
1589 /* Merge the list we've accumulated of globals from the current input source
1590 into the load_history variable. The details depend on whether
1591 the source has an associated file name or not.
1593 FILENAME is the file name that we are loading from.
1594 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1596 static void
1597 build_load_history (Lisp_Object filename, int entire)
1599 register Lisp_Object tail, prev, newelt;
1600 register Lisp_Object tem, tem2;
1601 register int foundit = 0;
1603 tail = Vload_history;
1604 prev = Qnil;
1606 while (CONSP (tail))
1608 tem = XCAR (tail);
1610 /* Find the feature's previous assoc list... */
1611 if (!NILP (Fequal (filename, Fcar (tem))))
1613 foundit = 1;
1615 /* If we're loading the entire file, remove old data. */
1616 if (entire)
1618 if (NILP (prev))
1619 Vload_history = XCDR (tail);
1620 else
1621 Fsetcdr (prev, XCDR (tail));
1624 /* Otherwise, cons on new symbols that are not already members. */
1625 else
1627 tem2 = Vcurrent_load_list;
1629 while (CONSP (tem2))
1631 newelt = XCAR (tem2);
1633 if (NILP (Fmember (newelt, tem)))
1634 Fsetcar (tail, Fcons (XCAR (tem),
1635 Fcons (newelt, XCDR (tem))));
1637 tem2 = XCDR (tem2);
1638 QUIT;
1642 else
1643 prev = tail;
1644 tail = XCDR (tail);
1645 QUIT;
1648 /* If we're loading an entire file, cons the new assoc onto the
1649 front of load-history, the most-recently-loaded position. Also
1650 do this if we didn't find an existing member for the file. */
1651 if (entire || !foundit)
1652 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1653 Vload_history);
1656 static Lisp_Object
1657 unreadpure (Lisp_Object junk) /* Used as unwind-protect function in readevalloop */
1659 read_pure = 0;
1660 return Qnil;
1663 static Lisp_Object
1664 readevalloop_1 (Lisp_Object old)
1666 load_convert_to_unibyte = ! NILP (old);
1667 return Qnil;
1670 /* Signal an `end-of-file' error, if possible with file name
1671 information. */
1673 static void
1674 end_of_file_error (void)
1676 if (STRINGP (Vload_file_name))
1677 xsignal1 (Qend_of_file, Vload_file_name);
1679 xsignal0 (Qend_of_file);
1682 /* UNIBYTE specifies how to set load_convert_to_unibyte
1683 for this invocation.
1684 READFUN, if non-nil, is used instead of `read'.
1686 START, END specify region to read in current buffer (from eval-region).
1687 If the input is not from a buffer, they must be nil. */
1689 static void
1690 readevalloop (Lisp_Object readcharfun,
1691 FILE *stream,
1692 Lisp_Object sourcename,
1693 int printflag,
1694 Lisp_Object unibyte, Lisp_Object readfun,
1695 Lisp_Object start, Lisp_Object end)
1697 register int c;
1698 register Lisp_Object val;
1699 int count = SPECPDL_INDEX ();
1700 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1701 struct buffer *b = 0;
1702 int continue_reading_p;
1703 Lisp_Object lex_bound;
1704 /* Nonzero if reading an entire buffer. */
1705 int whole_buffer = 0;
1706 /* 1 on the first time around. */
1707 int first_sexp = 1;
1709 if (MARKERP (readcharfun))
1711 if (NILP (start))
1712 start = readcharfun;
1715 if (BUFFERP (readcharfun))
1716 b = XBUFFER (readcharfun);
1717 else if (MARKERP (readcharfun))
1718 b = XMARKER (readcharfun)->buffer;
1720 /* We assume START is nil when input is not from a buffer. */
1721 if (! NILP (start) && !b)
1722 abort ();
1724 specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
1725 specbind (Qcurrent_load_list, Qnil);
1726 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1727 load_convert_to_unibyte = !NILP (unibyte);
1729 /* If lexical binding is active (either because it was specified in
1730 the file's header, or via a buffer-local variable), create an empty
1731 lexical environment, otherwise, turn off lexical binding. */
1732 lex_bound = find_symbol_value (Qlexical_binding);
1733 specbind (Qinternal_interpreter_environment,
1734 NILP (lex_bound) || EQ (lex_bound, Qunbound)
1735 ? Qnil : Fcons (Qt, Qnil));
1737 GCPRO4 (sourcename, readfun, start, end);
1739 /* Try to ensure sourcename is a truename, except whilst preloading. */
1740 if (NILP (Vpurify_flag)
1741 && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
1742 && !NILP (Ffboundp (Qfile_truename)))
1743 sourcename = call1 (Qfile_truename, sourcename) ;
1745 LOADHIST_ATTACH (sourcename);
1747 continue_reading_p = 1;
1748 while (continue_reading_p)
1750 int count1 = SPECPDL_INDEX ();
1752 if (b != 0 && NILP (BVAR (b, name)))
1753 error ("Reading from killed buffer");
1755 if (!NILP (start))
1757 /* Switch to the buffer we are reading from. */
1758 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1759 set_buffer_internal (b);
1761 /* Save point in it. */
1762 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1763 /* Save ZV in it. */
1764 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1765 /* Those get unbound after we read one expression. */
1767 /* Set point and ZV around stuff to be read. */
1768 Fgoto_char (start);
1769 if (!NILP (end))
1770 Fnarrow_to_region (make_number (BEGV), end);
1772 /* Just for cleanliness, convert END to a marker
1773 if it is an integer. */
1774 if (INTEGERP (end))
1775 end = Fpoint_max_marker ();
1778 /* On the first cycle, we can easily test here
1779 whether we are reading the whole buffer. */
1780 if (b && first_sexp)
1781 whole_buffer = (PT == BEG && ZV == Z);
1783 instream = stream;
1784 read_next:
1785 c = READCHAR;
1786 if (c == ';')
1788 while ((c = READCHAR) != '\n' && c != -1);
1789 goto read_next;
1791 if (c < 0)
1793 unbind_to (count1, Qnil);
1794 break;
1797 /* Ignore whitespace here, so we can detect eof. */
1798 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
1799 || c == 0xa0) /* NBSP */
1800 goto read_next;
1802 if (!NILP (Vpurify_flag) && c == '(')
1804 record_unwind_protect (unreadpure, Qnil);
1805 val = read_list (-1, readcharfun);
1807 else
1809 UNREAD (c);
1810 read_objects = Qnil;
1811 if (!NILP (readfun))
1813 val = call1 (readfun, readcharfun);
1815 /* If READCHARFUN has set point to ZV, we should
1816 stop reading, even if the form read sets point
1817 to a different value when evaluated. */
1818 if (BUFFERP (readcharfun))
1820 struct buffer *buf = XBUFFER (readcharfun);
1821 if (BUF_PT (buf) == BUF_ZV (buf))
1822 continue_reading_p = 0;
1825 else if (! NILP (Vload_read_function))
1826 val = call1 (Vload_read_function, readcharfun);
1827 else
1828 val = read_internal_start (readcharfun, Qnil, Qnil);
1831 if (!NILP (start) && continue_reading_p)
1832 start = Fpoint_marker ();
1834 /* Restore saved point and BEGV. */
1835 unbind_to (count1, Qnil);
1837 /* Now eval what we just read. */
1838 val = eval_sub (val);
1840 if (printflag)
1842 Vvalues = Fcons (val, Vvalues);
1843 if (EQ (Vstandard_output, Qt))
1844 Fprin1 (val, Qnil);
1845 else
1846 Fprint (val, Qnil);
1849 first_sexp = 0;
1852 build_load_history (sourcename,
1853 stream || whole_buffer);
1855 UNGCPRO;
1857 unbind_to (count, Qnil);
1860 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
1861 doc: /* Execute the current buffer as Lisp code.
1862 When called from a Lisp program (i.e., not interactively), this
1863 function accepts up to five optional arguments:
1864 BUFFER is the buffer to evaluate (nil means use current buffer).
1865 PRINTFLAG controls printing of output:
1866 A value of nil means discard it; anything else is stream for print.
1867 FILENAME specifies the file name to use for `load-history'.
1868 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1869 invocation.
1870 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1871 functions should work normally even if PRINTFLAG is nil.
1873 This function preserves the position of point. */)
1874 (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
1876 int count = SPECPDL_INDEX ();
1877 Lisp_Object tem, buf;
1879 if (NILP (buffer))
1880 buf = Fcurrent_buffer ();
1881 else
1882 buf = Fget_buffer (buffer);
1883 if (NILP (buf))
1884 error ("No such buffer");
1886 if (NILP (printflag) && NILP (do_allow_print))
1887 tem = Qsymbolp;
1888 else
1889 tem = printflag;
1891 if (NILP (filename))
1892 filename = BVAR (XBUFFER (buf), filename);
1894 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
1895 specbind (Qstandard_output, tem);
1896 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1897 BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1898 specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil);
1899 readevalloop (buf, 0, filename,
1900 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
1901 unbind_to (count, Qnil);
1903 return Qnil;
1906 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
1907 doc: /* Execute the region as Lisp code.
1908 When called from programs, expects two arguments,
1909 giving starting and ending indices in the current buffer
1910 of the text to be executed.
1911 Programs can pass third argument PRINTFLAG which controls output:
1912 A value of nil means discard it; anything else is stream for printing it.
1913 Also the fourth argument READ-FUNCTION, if non-nil, is used
1914 instead of `read' to read each expression. It gets one argument
1915 which is the input stream for reading characters.
1917 This function does not move point. */)
1918 (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
1920 /* FIXME: Do the eval-sexp-add-defvars dance! */
1921 int count = SPECPDL_INDEX ();
1922 Lisp_Object tem, cbuf;
1924 cbuf = Fcurrent_buffer ();
1926 if (NILP (printflag))
1927 tem = Qsymbolp;
1928 else
1929 tem = printflag;
1930 specbind (Qstandard_output, tem);
1931 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
1933 /* readevalloop calls functions which check the type of start and end. */
1934 readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
1935 !NILP (printflag), Qnil, read_function,
1936 start, end);
1938 return unbind_to (count, Qnil);
1942 DEFUN ("read", Fread, Sread, 0, 1, 0,
1943 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1944 If STREAM is nil, use the value of `standard-input' (which see).
1945 STREAM or the value of `standard-input' may be:
1946 a buffer (read from point and advance it)
1947 a marker (read from where it points and advance it)
1948 a function (call it with no arguments for each character,
1949 call it with a char as argument to push a char back)
1950 a string (takes text from string, starting at the beginning)
1951 t (read text line using minibuffer and use it, or read from
1952 standard input in batch mode). */)
1953 (Lisp_Object stream)
1955 if (NILP (stream))
1956 stream = Vstandard_input;
1957 if (EQ (stream, Qt))
1958 stream = Qread_char;
1959 if (EQ (stream, Qread_char))
1960 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
1962 return read_internal_start (stream, Qnil, Qnil);
1965 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
1966 doc: /* Read one Lisp expression which is represented as text by STRING.
1967 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1968 FINAL-STRING-INDEX is an integer giving the position of the next
1969 remaining character in STRING.
1970 START and END optionally delimit a substring of STRING from which to read;
1971 they default to 0 and (length STRING) respectively. */)
1972 (Lisp_Object string, Lisp_Object start, Lisp_Object end)
1974 Lisp_Object ret;
1975 CHECK_STRING (string);
1976 /* read_internal_start sets read_from_string_index. */
1977 ret = read_internal_start (string, start, end);
1978 return Fcons (ret, make_number (read_from_string_index));
1981 /* Function to set up the global context we need in toplevel read
1982 calls. */
1983 static Lisp_Object
1984 read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
1985 /* start, end only used when stream is a string. */
1987 Lisp_Object retval;
1989 readchar_count = 0;
1990 new_backquote_flag = 0;
1991 read_objects = Qnil;
1992 if (EQ (Vread_with_symbol_positions, Qt)
1993 || EQ (Vread_with_symbol_positions, stream))
1994 Vread_symbol_positions_list = Qnil;
1996 if (STRINGP (stream)
1997 || ((CONSP (stream) && STRINGP (XCAR (stream)))))
1999 EMACS_INT startval, endval;
2000 Lisp_Object string;
2002 if (STRINGP (stream))
2003 string = stream;
2004 else
2005 string = XCAR (stream);
2007 if (NILP (end))
2008 endval = SCHARS (string);
2009 else
2011 CHECK_NUMBER (end);
2012 endval = XINT (end);
2013 if (endval < 0 || endval > SCHARS (string))
2014 args_out_of_range (string, end);
2017 if (NILP (start))
2018 startval = 0;
2019 else
2021 CHECK_NUMBER (start);
2022 startval = XINT (start);
2023 if (startval < 0 || startval > endval)
2024 args_out_of_range (string, start);
2026 read_from_string_index = startval;
2027 read_from_string_index_byte = string_char_to_byte (string, startval);
2028 read_from_string_limit = endval;
2031 retval = read0 (stream);
2032 if (EQ (Vread_with_symbol_positions, Qt)
2033 || EQ (Vread_with_symbol_positions, stream))
2034 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
2035 return retval;
2039 /* Signal Qinvalid_read_syntax error.
2040 S is error string of length N (if > 0) */
2042 static void
2043 invalid_syntax (const char *s)
2045 xsignal1 (Qinvalid_read_syntax, build_string (s));
2049 /* Use this for recursive reads, in contexts where internal tokens
2050 are not allowed. */
2052 static Lisp_Object
2053 read0 (Lisp_Object readcharfun)
2055 register Lisp_Object val;
2056 int c;
2058 val = read1 (readcharfun, &c, 0);
2059 if (!c)
2060 return val;
2062 xsignal1 (Qinvalid_read_syntax,
2063 Fmake_string (make_number (1), make_number (c)));
2066 static ptrdiff_t read_buffer_size;
2067 static char *read_buffer;
2069 /* Read a \-escape sequence, assuming we already read the `\'.
2070 If the escape sequence forces unibyte, return eight-bit char. */
2072 static int
2073 read_escape (Lisp_Object readcharfun, int stringp)
2075 register int c = READCHAR;
2076 /* \u allows up to four hex digits, \U up to eight. Default to the
2077 behavior for \u, and change this value in the case that \U is seen. */
2078 int unicode_hex_count = 4;
2080 switch (c)
2082 case -1:
2083 end_of_file_error ();
2085 case 'a':
2086 return '\007';
2087 case 'b':
2088 return '\b';
2089 case 'd':
2090 return 0177;
2091 case 'e':
2092 return 033;
2093 case 'f':
2094 return '\f';
2095 case 'n':
2096 return '\n';
2097 case 'r':
2098 return '\r';
2099 case 't':
2100 return '\t';
2101 case 'v':
2102 return '\v';
2103 case '\n':
2104 return -1;
2105 case ' ':
2106 if (stringp)
2107 return -1;
2108 return ' ';
2110 case 'M':
2111 c = READCHAR;
2112 if (c != '-')
2113 error ("Invalid escape character syntax");
2114 c = READCHAR;
2115 if (c == '\\')
2116 c = read_escape (readcharfun, 0);
2117 return c | meta_modifier;
2119 case 'S':
2120 c = READCHAR;
2121 if (c != '-')
2122 error ("Invalid escape character syntax");
2123 c = READCHAR;
2124 if (c == '\\')
2125 c = read_escape (readcharfun, 0);
2126 return c | shift_modifier;
2128 case 'H':
2129 c = READCHAR;
2130 if (c != '-')
2131 error ("Invalid escape character syntax");
2132 c = READCHAR;
2133 if (c == '\\')
2134 c = read_escape (readcharfun, 0);
2135 return c | hyper_modifier;
2137 case 'A':
2138 c = READCHAR;
2139 if (c != '-')
2140 error ("Invalid escape character syntax");
2141 c = READCHAR;
2142 if (c == '\\')
2143 c = read_escape (readcharfun, 0);
2144 return c | alt_modifier;
2146 case 's':
2147 c = READCHAR;
2148 if (stringp || c != '-')
2150 UNREAD (c);
2151 return ' ';
2153 c = READCHAR;
2154 if (c == '\\')
2155 c = read_escape (readcharfun, 0);
2156 return c | super_modifier;
2158 case 'C':
2159 c = READCHAR;
2160 if (c != '-')
2161 error ("Invalid escape character syntax");
2162 case '^':
2163 c = READCHAR;
2164 if (c == '\\')
2165 c = read_escape (readcharfun, 0);
2166 if ((c & ~CHAR_MODIFIER_MASK) == '?')
2167 return 0177 | (c & CHAR_MODIFIER_MASK);
2168 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
2169 return c | ctrl_modifier;
2170 /* ASCII control chars are made from letters (both cases),
2171 as well as the non-letters within 0100...0137. */
2172 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
2173 return (c & (037 | ~0177));
2174 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
2175 return (c & (037 | ~0177));
2176 else
2177 return c | ctrl_modifier;
2179 case '0':
2180 case '1':
2181 case '2':
2182 case '3':
2183 case '4':
2184 case '5':
2185 case '6':
2186 case '7':
2187 /* An octal escape, as in ANSI C. */
2189 register int i = c - '0';
2190 register int count = 0;
2191 while (++count < 3)
2193 if ((c = READCHAR) >= '0' && c <= '7')
2195 i *= 8;
2196 i += c - '0';
2198 else
2200 UNREAD (c);
2201 break;
2205 if (i >= 0x80 && i < 0x100)
2206 i = BYTE8_TO_CHAR (i);
2207 return i;
2210 case 'x':
2211 /* A hex escape, as in ANSI C. */
2213 unsigned int i = 0;
2214 int count = 0;
2215 while (1)
2217 c = READCHAR;
2218 if (c >= '0' && c <= '9')
2220 i *= 16;
2221 i += c - '0';
2223 else if ((c >= 'a' && c <= 'f')
2224 || (c >= 'A' && c <= 'F'))
2226 i *= 16;
2227 if (c >= 'a' && c <= 'f')
2228 i += c - 'a' + 10;
2229 else
2230 i += c - 'A' + 10;
2232 else
2234 UNREAD (c);
2235 break;
2237 /* Allow hex escapes as large as ?\xfffffff, because some
2238 packages use them to denote characters with modifiers. */
2239 if ((CHAR_META | (CHAR_META - 1)) < i)
2240 error ("Hex character out of range: \\x%x...", i);
2241 count += count < 3;
2244 if (count < 3 && i >= 0x80)
2245 return BYTE8_TO_CHAR (i);
2246 return i;
2249 case 'U':
2250 /* Post-Unicode-2.0: Up to eight hex chars. */
2251 unicode_hex_count = 8;
2252 case 'u':
2254 /* A Unicode escape. We only permit them in strings and characters,
2255 not arbitrarily in the source code, as in some other languages. */
2257 unsigned int i = 0;
2258 int count = 0;
2260 while (++count <= unicode_hex_count)
2262 c = READCHAR;
2263 /* isdigit and isalpha may be locale-specific, which we don't
2264 want. */
2265 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
2266 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
2267 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
2268 else
2269 error ("Non-hex digit used for Unicode escape");
2271 if (i > 0x10FFFF)
2272 error ("Non-Unicode character: 0x%x", i);
2273 return i;
2276 default:
2277 return c;
2281 /* Return the digit that CHARACTER stands for in the given BASE.
2282 Return -1 if CHARACTER is out of range for BASE,
2283 and -2 if CHARACTER is not valid for any supported BASE. */
2284 static inline int
2285 digit_to_number (int character, int base)
2287 int digit;
2289 if ('0' <= character && character <= '9')
2290 digit = character - '0';
2291 else if ('a' <= character && character <= 'z')
2292 digit = character - 'a' + 10;
2293 else if ('A' <= character && character <= 'Z')
2294 digit = character - 'A' + 10;
2295 else
2296 return -2;
2298 return digit < base ? digit : -1;
2301 /* Read an integer in radix RADIX using READCHARFUN to read
2302 characters. RADIX must be in the interval [2..36]; if it isn't, a
2303 read error is signaled . Value is the integer read. Signals an
2304 error if encountering invalid read syntax or if RADIX is out of
2305 range. */
2307 static Lisp_Object
2308 read_integer (Lisp_Object readcharfun, EMACS_INT radix)
2310 /* Room for sign, leading 0, other digits, trailing null byte.
2311 Also, room for invalid syntax diagnostic. */
2312 char buf[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT + 1,
2313 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT))];
2315 int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2317 if (radix < 2 || radix > 36)
2318 valid = 0;
2319 else
2321 char *p = buf;
2322 int c, digit;
2324 c = READCHAR;
2325 if (c == '-' || c == '+')
2327 *p++ = c;
2328 c = READCHAR;
2331 if (c == '0')
2333 *p++ = c;
2334 valid = 1;
2336 /* Ignore redundant leading zeros, so the buffer doesn't
2337 fill up with them. */
2339 c = READCHAR;
2340 while (c == '0');
2343 while (-1 <= (digit = digit_to_number (c, radix)))
2345 if (digit == -1)
2346 valid = 0;
2347 if (valid < 0)
2348 valid = 1;
2350 if (p < buf + sizeof buf - 1)
2351 *p++ = c;
2352 else
2353 valid = 0;
2355 c = READCHAR;
2358 UNREAD (c);
2359 *p = '\0';
2362 if (! valid)
2364 sprintf (buf, "integer, radix %"pI"d", radix);
2365 invalid_syntax (buf);
2368 return string_to_number (buf, radix, 0);
2372 /* If the next token is ')' or ']' or '.', we store that character
2373 in *PCH and the return value is not interesting. Else, we store
2374 zero in *PCH and we read and return one lisp object.
2376 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2378 static Lisp_Object
2379 read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
2381 register int c;
2382 unsigned uninterned_symbol = 0;
2383 int multibyte;
2385 *pch = 0;
2386 load_each_byte = 0;
2388 retry:
2390 c = READCHAR_REPORT_MULTIBYTE (&multibyte);
2391 if (c < 0)
2392 end_of_file_error ();
2394 switch (c)
2396 case '(':
2397 return read_list (0, readcharfun);
2399 case '[':
2400 return read_vector (readcharfun, 0);
2402 case ')':
2403 case ']':
2405 *pch = c;
2406 return Qnil;
2409 case '#':
2410 c = READCHAR;
2411 if (c == 's')
2413 c = READCHAR;
2414 if (c == '(')
2416 /* Accept extended format for hashtables (extensible to
2417 other types), e.g.
2418 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2419 Lisp_Object tmp = read_list (0, readcharfun);
2420 Lisp_Object head = CAR_SAFE (tmp);
2421 Lisp_Object data = Qnil;
2422 Lisp_Object val = Qnil;
2423 /* The size is 2 * number of allowed keywords to
2424 make-hash-table. */
2425 Lisp_Object params[10];
2426 Lisp_Object ht;
2427 Lisp_Object key = Qnil;
2428 int param_count = 0;
2430 if (!EQ (head, Qhash_table))
2431 error ("Invalid extended read marker at head of #s list "
2432 "(only hash-table allowed)");
2434 tmp = CDR_SAFE (tmp);
2436 /* This is repetitive but fast and simple. */
2437 params[param_count] = QCsize;
2438 params[param_count+1] = Fplist_get (tmp, Qsize);
2439 if (!NILP (params[param_count + 1]))
2440 param_count += 2;
2442 params[param_count] = QCtest;
2443 params[param_count+1] = Fplist_get (tmp, Qtest);
2444 if (!NILP (params[param_count + 1]))
2445 param_count += 2;
2447 params[param_count] = QCweakness;
2448 params[param_count+1] = Fplist_get (tmp, Qweakness);
2449 if (!NILP (params[param_count + 1]))
2450 param_count += 2;
2452 params[param_count] = QCrehash_size;
2453 params[param_count+1] = Fplist_get (tmp, Qrehash_size);
2454 if (!NILP (params[param_count + 1]))
2455 param_count += 2;
2457 params[param_count] = QCrehash_threshold;
2458 params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
2459 if (!NILP (params[param_count + 1]))
2460 param_count += 2;
2462 /* This is the hashtable data. */
2463 data = Fplist_get (tmp, Qdata);
2465 /* Now use params to make a new hashtable and fill it. */
2466 ht = Fmake_hash_table (param_count, params);
2468 while (CONSP (data))
2470 key = XCAR (data);
2471 data = XCDR (data);
2472 if (!CONSP (data))
2473 error ("Odd number of elements in hashtable data");
2474 val = XCAR (data);
2475 data = XCDR (data);
2476 Fputhash (key, val, ht);
2479 return ht;
2481 UNREAD (c);
2482 invalid_syntax ("#");
2484 if (c == '^')
2486 c = READCHAR;
2487 if (c == '[')
2489 Lisp_Object tmp;
2490 tmp = read_vector (readcharfun, 0);
2491 if (ASIZE (tmp) < CHAR_TABLE_STANDARD_SLOTS)
2492 error ("Invalid size char-table");
2493 XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
2494 return tmp;
2496 else if (c == '^')
2498 c = READCHAR;
2499 if (c == '[')
2501 Lisp_Object tmp;
2502 EMACS_INT depth, size;
2504 tmp = read_vector (readcharfun, 0);
2505 if (!INTEGERP (AREF (tmp, 0)))
2506 error ("Invalid depth in char-table");
2507 depth = XINT (AREF (tmp, 0));
2508 if (depth < 1 || depth > 3)
2509 error ("Invalid depth in char-table");
2510 size = ASIZE (tmp) - 2;
2511 if (chartab_size [depth] != size)
2512 error ("Invalid size char-table");
2513 XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
2514 return tmp;
2516 invalid_syntax ("#^^");
2518 invalid_syntax ("#^");
2520 if (c == '&')
2522 Lisp_Object length;
2523 length = read1 (readcharfun, pch, first_in_list);
2524 c = READCHAR;
2525 if (c == '"')
2527 Lisp_Object tmp, val;
2528 EMACS_INT size_in_chars
2529 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
2530 / BOOL_VECTOR_BITS_PER_CHAR);
2532 UNREAD (c);
2533 tmp = read1 (readcharfun, pch, first_in_list);
2534 if (STRING_MULTIBYTE (tmp)
2535 || (size_in_chars != SCHARS (tmp)
2536 /* We used to print 1 char too many
2537 when the number of bits was a multiple of 8.
2538 Accept such input in case it came from an old
2539 version. */
2540 && ! (XFASTINT (length)
2541 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
2542 invalid_syntax ("#&...");
2544 val = Fmake_bool_vector (length, Qnil);
2545 memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars);
2546 /* Clear the extraneous bits in the last byte. */
2547 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
2548 XBOOL_VECTOR (val)->data[size_in_chars - 1]
2549 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2550 return val;
2552 invalid_syntax ("#&...");
2554 if (c == '[')
2556 /* Accept compiled functions at read-time so that we don't have to
2557 build them using function calls. */
2558 Lisp_Object tmp;
2559 tmp = read_vector (readcharfun, 1);
2560 return Fmake_byte_code (ASIZE (tmp),
2561 XVECTOR (tmp)->contents);
2563 if (c == '(')
2565 Lisp_Object tmp;
2566 struct gcpro gcpro1;
2567 int ch;
2569 /* Read the string itself. */
2570 tmp = read1 (readcharfun, &ch, 0);
2571 if (ch != 0 || !STRINGP (tmp))
2572 invalid_syntax ("#");
2573 GCPRO1 (tmp);
2574 /* Read the intervals and their properties. */
2575 while (1)
2577 Lisp_Object beg, end, plist;
2579 beg = read1 (readcharfun, &ch, 0);
2580 end = plist = Qnil;
2581 if (ch == ')')
2582 break;
2583 if (ch == 0)
2584 end = read1 (readcharfun, &ch, 0);
2585 if (ch == 0)
2586 plist = read1 (readcharfun, &ch, 0);
2587 if (ch)
2588 invalid_syntax ("Invalid string property list");
2589 Fset_text_properties (beg, end, plist, tmp);
2591 UNGCPRO;
2592 return tmp;
2595 /* #@NUMBER is used to skip NUMBER following characters.
2596 That's used in .elc files to skip over doc strings
2597 and function definitions. */
2598 if (c == '@')
2600 enum { extra = 100 };
2601 ptrdiff_t i, nskip = 0;
2603 load_each_byte = 1;
2604 /* Read a decimal integer. */
2605 while ((c = READCHAR) >= 0
2606 && c >= '0' && c <= '9')
2608 if ((STRING_BYTES_BOUND - extra) / 10 <= nskip)
2609 string_overflow ();
2610 nskip *= 10;
2611 nskip += c - '0';
2613 UNREAD (c);
2615 if (load_force_doc_strings
2616 && (EQ (readcharfun, Qget_file_char)
2617 || EQ (readcharfun, Qget_emacs_mule_file_char)))
2619 /* If we are supposed to force doc strings into core right now,
2620 record the last string that we skipped,
2621 and record where in the file it comes from. */
2623 /* But first exchange saved_doc_string
2624 with prev_saved_doc_string, so we save two strings. */
2626 char *temp = saved_doc_string;
2627 ptrdiff_t temp_size = saved_doc_string_size;
2628 file_offset temp_pos = saved_doc_string_position;
2629 ptrdiff_t temp_len = saved_doc_string_length;
2631 saved_doc_string = prev_saved_doc_string;
2632 saved_doc_string_size = prev_saved_doc_string_size;
2633 saved_doc_string_position = prev_saved_doc_string_position;
2634 saved_doc_string_length = prev_saved_doc_string_length;
2636 prev_saved_doc_string = temp;
2637 prev_saved_doc_string_size = temp_size;
2638 prev_saved_doc_string_position = temp_pos;
2639 prev_saved_doc_string_length = temp_len;
2642 if (saved_doc_string_size == 0)
2644 saved_doc_string = (char *) xmalloc (nskip + extra);
2645 saved_doc_string_size = nskip + extra;
2647 if (nskip > saved_doc_string_size)
2649 saved_doc_string = (char *) xrealloc (saved_doc_string,
2650 nskip + extra);
2651 saved_doc_string_size = nskip + extra;
2654 saved_doc_string_position = file_tell (instream);
2656 /* Copy that many characters into saved_doc_string. */
2657 for (i = 0; i < nskip && c >= 0; i++)
2658 saved_doc_string[i] = c = READCHAR;
2660 saved_doc_string_length = i;
2662 else
2664 /* Skip that many characters. */
2665 for (i = 0; i < nskip && c >= 0; i++)
2666 c = READCHAR;
2669 load_each_byte = 0;
2670 goto retry;
2672 if (c == '!')
2674 /* #! appears at the beginning of an executable file.
2675 Skip the first line. */
2676 while (c != '\n' && c >= 0)
2677 c = READCHAR;
2678 goto retry;
2680 if (c == '$')
2681 return Vload_file_name;
2682 if (c == '\'')
2683 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
2684 /* #:foo is the uninterned symbol named foo. */
2685 if (c == ':')
2687 uninterned_symbol = 1;
2688 c = READCHAR;
2689 if (!(c > 040
2690 && c != 0xa0 /* NBSP */
2691 && (c >= 0200
2692 || strchr ("\"';()[]#`,", c) == NULL)))
2694 /* No symbol character follows, this is the empty
2695 symbol. */
2696 UNREAD (c);
2697 return Fmake_symbol (build_string (""));
2699 goto read_symbol;
2701 /* ## is the empty symbol. */
2702 if (c == '#')
2703 return Fintern (build_string (""), Qnil);
2704 /* Reader forms that can reuse previously read objects. */
2705 if (c >= '0' && c <= '9')
2707 EMACS_INT n = 0;
2708 Lisp_Object tem;
2710 /* Read a non-negative integer. */
2711 while (c >= '0' && c <= '9')
2713 if (MOST_POSITIVE_FIXNUM / 10 < n
2714 || MOST_POSITIVE_FIXNUM < n * 10 + c - '0')
2715 n = MOST_POSITIVE_FIXNUM + 1;
2716 else
2717 n = n * 10 + c - '0';
2718 c = READCHAR;
2721 if (n <= MOST_POSITIVE_FIXNUM)
2723 if (c == 'r' || c == 'R')
2724 return read_integer (readcharfun, n);
2726 if (! NILP (Vread_circle))
2728 /* #n=object returns object, but associates it with
2729 n for #n#. */
2730 if (c == '=')
2732 /* Make a placeholder for #n# to use temporarily */
2733 Lisp_Object placeholder;
2734 Lisp_Object cell;
2736 placeholder = Fcons (Qnil, Qnil);
2737 cell = Fcons (make_number (n), placeholder);
2738 read_objects = Fcons (cell, read_objects);
2740 /* Read the object itself. */
2741 tem = read0 (readcharfun);
2743 /* Now put it everywhere the placeholder was... */
2744 substitute_object_in_subtree (tem, placeholder);
2746 /* ...and #n# will use the real value from now on. */
2747 Fsetcdr (cell, tem);
2749 return tem;
2752 /* #n# returns a previously read object. */
2753 if (c == '#')
2755 tem = Fassq (make_number (n), read_objects);
2756 if (CONSP (tem))
2757 return XCDR (tem);
2761 /* Fall through to error message. */
2763 else if (c == 'x' || c == 'X')
2764 return read_integer (readcharfun, 16);
2765 else if (c == 'o' || c == 'O')
2766 return read_integer (readcharfun, 8);
2767 else if (c == 'b' || c == 'B')
2768 return read_integer (readcharfun, 2);
2770 UNREAD (c);
2771 invalid_syntax ("#");
2773 case ';':
2774 while ((c = READCHAR) >= 0 && c != '\n');
2775 goto retry;
2777 case '\'':
2779 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2782 case '`':
2784 int next_char = READCHAR;
2785 UNREAD (next_char);
2786 /* Transition from old-style to new-style:
2787 If we see "(`" it used to mean old-style, which usually works
2788 fine because ` should almost never appear in such a position
2789 for new-style. But occasionally we need "(`" to mean new
2790 style, so we try to distinguish the two by the fact that we
2791 can either write "( `foo" or "(` foo", where the first
2792 intends to use new-style whereas the second intends to use
2793 old-style. For Emacs-25, we should completely remove this
2794 first_in_list exception (old-style can still be obtained via
2795 "(\`" anyway). */
2796 if (!new_backquote_flag && first_in_list && next_char == ' ')
2798 Vold_style_backquotes = Qt;
2799 goto default_label;
2801 else
2803 Lisp_Object value;
2805 new_backquote_flag++;
2806 value = read0 (readcharfun);
2807 new_backquote_flag--;
2809 return Fcons (Qbackquote, Fcons (value, Qnil));
2812 case ',':
2814 int next_char = READCHAR;
2815 UNREAD (next_char);
2816 /* Transition from old-style to new-style:
2817 It used to be impossible to have a new-style , other than within
2818 a new-style `. This is sufficient when ` and , are used in the
2819 normal way, but ` and , can also appear in args to macros that
2820 will not interpret them in the usual way, in which case , may be
2821 used without any ` anywhere near.
2822 So we now use the same heuristic as for backquote: old-style
2823 unquotes are only recognized when first on a list, and when
2824 followed by a space.
2825 Because it's more difficult to peek 2 chars ahead, a new-style
2826 ,@ can still not be used outside of a `, unless it's in the middle
2827 of a list. */
2828 if (new_backquote_flag
2829 || !first_in_list
2830 || (next_char != ' ' && next_char != '@'))
2832 Lisp_Object comma_type = Qnil;
2833 Lisp_Object value;
2834 int ch = READCHAR;
2836 if (ch == '@')
2837 comma_type = Qcomma_at;
2838 else if (ch == '.')
2839 comma_type = Qcomma_dot;
2840 else
2842 if (ch >= 0) UNREAD (ch);
2843 comma_type = Qcomma;
2846 value = read0 (readcharfun);
2847 return Fcons (comma_type, Fcons (value, Qnil));
2849 else
2851 Vold_style_backquotes = Qt;
2852 goto default_label;
2855 case '?':
2857 int modifiers;
2858 int next_char;
2859 int ok;
2861 c = READCHAR;
2862 if (c < 0)
2863 end_of_file_error ();
2865 /* Accept `single space' syntax like (list ? x) where the
2866 whitespace character is SPC or TAB.
2867 Other literal whitespace like NL, CR, and FF are not accepted,
2868 as there are well-established escape sequences for these. */
2869 if (c == ' ' || c == '\t')
2870 return make_number (c);
2872 if (c == '\\')
2873 c = read_escape (readcharfun, 0);
2874 modifiers = c & CHAR_MODIFIER_MASK;
2875 c &= ~CHAR_MODIFIER_MASK;
2876 if (CHAR_BYTE8_P (c))
2877 c = CHAR_TO_BYTE8 (c);
2878 c |= modifiers;
2880 next_char = READCHAR;
2881 ok = (next_char <= 040
2882 || (next_char < 0200
2883 && strchr ("\"';()[]#?`,.", next_char) != NULL));
2884 UNREAD (next_char);
2885 if (ok)
2886 return make_number (c);
2888 invalid_syntax ("?");
2891 case '"':
2893 char *p = read_buffer;
2894 char *end = read_buffer + read_buffer_size;
2895 register int ch;
2896 /* Nonzero if we saw an escape sequence specifying
2897 a multibyte character. */
2898 int force_multibyte = 0;
2899 /* Nonzero if we saw an escape sequence specifying
2900 a single-byte character. */
2901 int force_singlebyte = 0;
2902 int cancel = 0;
2903 ptrdiff_t nchars = 0;
2905 while ((ch = READCHAR) >= 0
2906 && ch != '\"')
2908 if (end - p < MAX_MULTIBYTE_LENGTH)
2910 ptrdiff_t offset = p - read_buffer;
2911 if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
2912 memory_full (SIZE_MAX);
2913 read_buffer = (char *) xrealloc (read_buffer,
2914 read_buffer_size * 2);
2915 read_buffer_size *= 2;
2916 p = read_buffer + offset;
2917 end = read_buffer + read_buffer_size;
2920 if (ch == '\\')
2922 int modifiers;
2924 ch = read_escape (readcharfun, 1);
2926 /* CH is -1 if \ newline has just been seen */
2927 if (ch == -1)
2929 if (p == read_buffer)
2930 cancel = 1;
2931 continue;
2934 modifiers = ch & CHAR_MODIFIER_MASK;
2935 ch = ch & ~CHAR_MODIFIER_MASK;
2937 if (CHAR_BYTE8_P (ch))
2938 force_singlebyte = 1;
2939 else if (! ASCII_CHAR_P (ch))
2940 force_multibyte = 1;
2941 else /* i.e. ASCII_CHAR_P (ch) */
2943 /* Allow `\C- ' and `\C-?'. */
2944 if (modifiers == CHAR_CTL)
2946 if (ch == ' ')
2947 ch = 0, modifiers = 0;
2948 else if (ch == '?')
2949 ch = 127, modifiers = 0;
2951 if (modifiers & CHAR_SHIFT)
2953 /* Shift modifier is valid only with [A-Za-z]. */
2954 if (ch >= 'A' && ch <= 'Z')
2955 modifiers &= ~CHAR_SHIFT;
2956 else if (ch >= 'a' && ch <= 'z')
2957 ch -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
2960 if (modifiers & CHAR_META)
2962 /* Move the meta bit to the right place for a
2963 string. */
2964 modifiers &= ~CHAR_META;
2965 ch = BYTE8_TO_CHAR (ch | 0x80);
2966 force_singlebyte = 1;
2970 /* Any modifiers remaining are invalid. */
2971 if (modifiers)
2972 error ("Invalid modifier in string");
2973 p += CHAR_STRING (ch, (unsigned char *) p);
2975 else
2977 p += CHAR_STRING (ch, (unsigned char *) p);
2978 if (CHAR_BYTE8_P (ch))
2979 force_singlebyte = 1;
2980 else if (! ASCII_CHAR_P (ch))
2981 force_multibyte = 1;
2983 nchars++;
2986 if (ch < 0)
2987 end_of_file_error ();
2989 /* If purifying, and string starts with \ newline,
2990 return zero instead. This is for doc strings
2991 that we are really going to find in etc/DOC.nn.nn */
2992 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
2993 return make_number (0);
2995 if (force_multibyte)
2996 /* READ_BUFFER already contains valid multibyte forms. */
2998 else if (force_singlebyte)
3000 nchars = str_as_unibyte ((unsigned char *) read_buffer,
3001 p - read_buffer);
3002 p = read_buffer + nchars;
3004 else
3006 /* Otherwise, READ_BUFFER contains only ASCII. */
3009 if (read_pure)
3010 return make_pure_string (read_buffer, nchars, p - read_buffer,
3011 (force_multibyte
3012 || (p - read_buffer != nchars)));
3013 return make_specified_string (read_buffer, nchars, p - read_buffer,
3014 (force_multibyte
3015 || (p - read_buffer != nchars)));
3018 case '.':
3020 int next_char = READCHAR;
3021 UNREAD (next_char);
3023 if (next_char <= 040
3024 || (next_char < 0200
3025 && strchr ("\"';([#?`,", next_char) != NULL))
3027 *pch = c;
3028 return Qnil;
3031 /* Otherwise, we fall through! Note that the atom-reading loop
3032 below will now loop at least once, assuring that we will not
3033 try to UNREAD two characters in a row. */
3035 default:
3036 default_label:
3037 if (c <= 040) goto retry;
3038 if (c == 0xa0) /* NBSP */
3039 goto retry;
3041 read_symbol:
3043 char *p = read_buffer;
3044 int quoted = 0;
3045 EMACS_INT start_position = readchar_count - 1;
3048 char *end = read_buffer + read_buffer_size;
3052 if (end - p < MAX_MULTIBYTE_LENGTH)
3054 ptrdiff_t offset = p - read_buffer;
3055 if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
3056 memory_full (SIZE_MAX);
3057 read_buffer = (char *) xrealloc (read_buffer,
3058 read_buffer_size * 2);
3059 read_buffer_size *= 2;
3060 p = read_buffer + offset;
3061 end = read_buffer + read_buffer_size;
3064 if (c == '\\')
3066 c = READCHAR;
3067 if (c == -1)
3068 end_of_file_error ();
3069 quoted = 1;
3072 if (multibyte)
3073 p += CHAR_STRING (c, (unsigned char *) p);
3074 else
3075 *p++ = c;
3076 c = READCHAR;
3078 while (c > 040
3079 && c != 0xa0 /* NBSP */
3080 && (c >= 0200
3081 || strchr ("\"';()[]#`,", c) == NULL));
3083 if (p == end)
3085 ptrdiff_t offset = p - read_buffer;
3086 if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
3087 memory_full (SIZE_MAX);
3088 read_buffer = (char *) xrealloc (read_buffer,
3089 read_buffer_size * 2);
3090 read_buffer_size *= 2;
3091 p = read_buffer + offset;
3092 end = read_buffer + read_buffer_size;
3094 *p = 0;
3095 UNREAD (c);
3098 if (!quoted && !uninterned_symbol)
3100 Lisp_Object result = string_to_number (read_buffer, 10, 0);
3101 if (! NILP (result))
3102 return result;
3105 Lisp_Object name, result;
3106 EMACS_INT nbytes = p - read_buffer;
3107 EMACS_INT nchars
3108 = (multibyte
3109 ? multibyte_chars_in_text ((unsigned char *) read_buffer,
3110 nbytes)
3111 : nbytes);
3113 if (uninterned_symbol && ! NILP (Vpurify_flag))
3114 name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
3115 else
3116 name = make_specified_string (read_buffer, nchars, nbytes, multibyte);
3117 result = (uninterned_symbol ? Fmake_symbol (name)
3118 : Fintern (name, Qnil));
3120 if (EQ (Vread_with_symbol_positions, Qt)
3121 || EQ (Vread_with_symbol_positions, readcharfun))
3122 Vread_symbol_positions_list =
3123 Fcons (Fcons (result, make_number (start_position)),
3124 Vread_symbol_positions_list);
3125 return result;
3132 /* List of nodes we've seen during substitute_object_in_subtree. */
3133 static Lisp_Object seen_list;
3135 static void
3136 substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
3138 Lisp_Object check_object;
3140 /* We haven't seen any objects when we start. */
3141 seen_list = Qnil;
3143 /* Make all the substitutions. */
3144 check_object
3145 = substitute_object_recurse (object, placeholder, object);
3147 /* Clear seen_list because we're done with it. */
3148 seen_list = Qnil;
3150 /* The returned object here is expected to always eq the
3151 original. */
3152 if (!EQ (check_object, object))
3153 error ("Unexpected mutation error in reader");
3156 /* Feval doesn't get called from here, so no gc protection is needed. */
3157 #define SUBSTITUTE(get_val, set_val) \
3158 do { \
3159 Lisp_Object old_value = get_val; \
3160 Lisp_Object true_value \
3161 = substitute_object_recurse (object, placeholder, \
3162 old_value); \
3164 if (!EQ (old_value, true_value)) \
3166 set_val; \
3168 } while (0)
3170 static Lisp_Object
3171 substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree)
3173 /* If we find the placeholder, return the target object. */
3174 if (EQ (placeholder, subtree))
3175 return object;
3177 /* If we've been to this node before, don't explore it again. */
3178 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
3179 return subtree;
3181 /* If this node can be the entry point to a cycle, remember that
3182 we've seen it. It can only be such an entry point if it was made
3183 by #n=, which means that we can find it as a value in
3184 read_objects. */
3185 if (!EQ (Qnil, Frassq (subtree, read_objects)))
3186 seen_list = Fcons (subtree, seen_list);
3188 /* Recurse according to subtree's type.
3189 Every branch must return a Lisp_Object. */
3190 switch (XTYPE (subtree))
3192 case Lisp_Vectorlike:
3194 ptrdiff_t i, length = 0;
3195 if (BOOL_VECTOR_P (subtree))
3196 return subtree; /* No sub-objects anyway. */
3197 else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
3198 || COMPILEDP (subtree))
3199 length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
3200 else if (VECTORP (subtree))
3201 length = ASIZE (subtree);
3202 else
3203 /* An unknown pseudovector may contain non-Lisp fields, so we
3204 can't just blindly traverse all its fields. We used to call
3205 `Flength' which signaled `sequencep', so I just preserved this
3206 behavior. */
3207 wrong_type_argument (Qsequencep, subtree);
3209 for (i = 0; i < length; i++)
3210 SUBSTITUTE (AREF (subtree, i),
3211 ASET (subtree, i, true_value));
3212 return subtree;
3215 case Lisp_Cons:
3217 SUBSTITUTE (XCAR (subtree),
3218 XSETCAR (subtree, true_value));
3219 SUBSTITUTE (XCDR (subtree),
3220 XSETCDR (subtree, true_value));
3221 return subtree;
3224 case Lisp_String:
3226 /* Check for text properties in each interval.
3227 substitute_in_interval contains part of the logic. */
3229 INTERVAL root_interval = STRING_INTERVALS (subtree);
3230 Lisp_Object arg = Fcons (object, placeholder);
3232 traverse_intervals_noorder (root_interval,
3233 &substitute_in_interval, arg);
3235 return subtree;
3238 /* Other types don't recurse any further. */
3239 default:
3240 return subtree;
3244 /* Helper function for substitute_object_recurse. */
3245 static void
3246 substitute_in_interval (INTERVAL interval, Lisp_Object arg)
3248 Lisp_Object object = Fcar (arg);
3249 Lisp_Object placeholder = Fcdr (arg);
3251 SUBSTITUTE (interval->plist, interval->plist = true_value);
3255 #define LEAD_INT 1
3256 #define DOT_CHAR 2
3257 #define TRAIL_INT 4
3258 #define E_EXP 16
3261 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3262 integer syntax and fits in a fixnum, else return the nearest float if CP has
3263 either floating point or integer syntax and BASE is 10, else return nil. If
3264 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3265 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3266 number has integer syntax but does not fit. */
3268 Lisp_Object
3269 string_to_number (char const *string, int base, int ignore_trailing)
3271 int state;
3272 char const *cp = string;
3273 int leading_digit;
3274 int float_syntax = 0;
3275 double value = 0;
3277 /* Compute NaN and infinities using a variable, to cope with compilers that
3278 think they are smarter than we are. */
3279 double zero = 0;
3281 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3282 IEEE floating point hosts, and works around a formerly-common bug where
3283 atof ("-0.0") drops the sign. */
3284 int negative = *cp == '-';
3286 int signedp = negative || *cp == '+';
3287 cp += signedp;
3289 state = 0;
3291 leading_digit = digit_to_number (*cp, base);
3292 if (0 <= leading_digit)
3294 state |= LEAD_INT;
3296 ++cp;
3297 while (0 <= digit_to_number (*cp, base));
3299 if (*cp == '.')
3301 state |= DOT_CHAR;
3302 cp++;
3305 if (base == 10)
3307 if ('0' <= *cp && *cp <= '9')
3309 state |= TRAIL_INT;
3311 cp++;
3312 while ('0' <= *cp && *cp <= '9');
3314 if (*cp == 'e' || *cp == 'E')
3316 char const *ecp = cp;
3317 cp++;
3318 if (*cp == '+' || *cp == '-')
3319 cp++;
3320 if ('0' <= *cp && *cp <= '9')
3322 state |= E_EXP;
3324 cp++;
3325 while ('0' <= *cp && *cp <= '9');
3327 else if (cp[-1] == '+'
3328 && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
3330 state |= E_EXP;
3331 cp += 3;
3332 value = 1.0 / zero;
3334 else if (cp[-1] == '+'
3335 && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
3337 state |= E_EXP;
3338 cp += 3;
3339 value = zero / zero;
3341 /* If that made a "negative" NaN, negate it. */
3343 int i;
3344 union { double d; char c[sizeof (double)]; }
3345 u_data, u_minus_zero;
3346 u_data.d = value;
3347 u_minus_zero.d = -0.0;
3348 for (i = 0; i < sizeof (double); i++)
3349 if (u_data.c[i] & u_minus_zero.c[i])
3351 value = -value;
3352 break;
3355 /* Now VALUE is a positive NaN. */
3357 else
3358 cp = ecp;
3361 float_syntax = ((state & (DOT_CHAR|TRAIL_INT)) == (DOT_CHAR|TRAIL_INT)
3362 || state == (LEAD_INT|E_EXP));
3365 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3366 any prefix that matches. Otherwise, the entire string must match. */
3367 if (! (ignore_trailing
3368 ? ((state & LEAD_INT) != 0 || float_syntax)
3369 : (!*cp && ((state & ~DOT_CHAR) == LEAD_INT || float_syntax))))
3370 return Qnil;
3372 /* If the number uses integer and not float syntax, and is in C-language
3373 range, use its value, preferably as a fixnum. */
3374 if (0 <= leading_digit && ! float_syntax)
3376 uintmax_t n;
3378 /* Fast special case for single-digit integers. This also avoids a
3379 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3380 case some versions of strtoumax accept numbers like "0x1" that Emacs
3381 does not allow. */
3382 if (digit_to_number (string[signedp + 1], base) < 0)
3383 return make_number (negative ? -leading_digit : leading_digit);
3385 errno = 0;
3386 n = strtoumax (string + signedp, NULL, base);
3387 if (errno == ERANGE)
3389 /* Unfortunately there's no simple and accurate way to convert
3390 non-base-10 numbers that are out of C-language range. */
3391 if (base != 10)
3392 xsignal1 (Qoverflow_error, build_string (string));
3394 else if (n <= (negative ? -MOST_NEGATIVE_FIXNUM : MOST_POSITIVE_FIXNUM))
3396 EMACS_INT signed_n = n;
3397 return make_number (negative ? -signed_n : signed_n);
3399 else
3400 value = n;
3403 /* Either the number uses float syntax, or it does not fit into a fixnum.
3404 Convert it from string to floating point, unless the value is already
3405 known because it is an infinity, a NAN, or its absolute value fits in
3406 uintmax_t. */
3407 if (! value)
3408 value = atof (string + signedp);
3410 return make_float (negative ? -value : value);
3414 static Lisp_Object
3415 read_vector (Lisp_Object readcharfun, int bytecodeflag)
3417 ptrdiff_t i, size;
3418 register Lisp_Object *ptr;
3419 register Lisp_Object tem, item, vector;
3420 register struct Lisp_Cons *otem;
3421 Lisp_Object len;
3423 tem = read_list (1, readcharfun);
3424 len = Flength (tem);
3425 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
3427 size = ASIZE (vector);
3428 ptr = XVECTOR (vector)->contents;
3429 for (i = 0; i < size; i++)
3431 item = Fcar (tem);
3432 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3433 bytecode object, the docstring containing the bytecode and
3434 constants values must be treated as unibyte and passed to
3435 Fread, to get the actual bytecode string and constants vector. */
3436 if (bytecodeflag && load_force_doc_strings)
3438 if (i == COMPILED_BYTECODE)
3440 if (!STRINGP (item))
3441 error ("Invalid byte code");
3443 /* Delay handling the bytecode slot until we know whether
3444 it is lazily-loaded (we can tell by whether the
3445 constants slot is nil). */
3446 ptr[COMPILED_CONSTANTS] = item;
3447 item = Qnil;
3449 else if (i == COMPILED_CONSTANTS)
3451 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
3453 if (NILP (item))
3455 /* Coerce string to unibyte (like string-as-unibyte,
3456 but without generating extra garbage and
3457 guaranteeing no change in the contents). */
3458 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
3459 STRING_SET_UNIBYTE (bytestr);
3461 item = Fread (Fcons (bytestr, readcharfun));
3462 if (!CONSP (item))
3463 error ("Invalid byte code");
3465 otem = XCONS (item);
3466 bytestr = XCAR (item);
3467 item = XCDR (item);
3468 free_cons (otem);
3471 /* Now handle the bytecode slot. */
3472 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
3474 else if (i == COMPILED_DOC_STRING
3475 && STRINGP (item)
3476 && ! STRING_MULTIBYTE (item))
3478 if (EQ (readcharfun, Qget_emacs_mule_file_char))
3479 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
3480 else
3481 item = Fstring_as_multibyte (item);
3484 ptr[i] = read_pure ? Fpurecopy (item) : item;
3485 otem = XCONS (tem);
3486 tem = Fcdr (tem);
3487 free_cons (otem);
3489 return vector;
3492 /* FLAG = 1 means check for ] to terminate rather than ) and .
3493 FLAG = -1 means check for starting with defun
3494 and make structure pure. */
3496 static Lisp_Object
3497 read_list (int flag, register Lisp_Object readcharfun)
3499 /* -1 means check next element for defun,
3500 0 means don't check,
3501 1 means already checked and found defun. */
3502 int defunflag = flag < 0 ? -1 : 0;
3503 Lisp_Object val, tail;
3504 register Lisp_Object elt, tem;
3505 struct gcpro gcpro1, gcpro2;
3506 /* 0 is the normal case.
3507 1 means this list is a doc reference; replace it with the number 0.
3508 2 means this list is a doc reference; replace it with the doc string. */
3509 int doc_reference = 0;
3511 /* Initialize this to 1 if we are reading a list. */
3512 int first_in_list = flag <= 0;
3514 val = Qnil;
3515 tail = Qnil;
3517 while (1)
3519 int ch;
3520 GCPRO2 (val, tail);
3521 elt = read1 (readcharfun, &ch, first_in_list);
3522 UNGCPRO;
3524 first_in_list = 0;
3526 /* While building, if the list starts with #$, treat it specially. */
3527 if (EQ (elt, Vload_file_name)
3528 && ! NILP (elt)
3529 && !NILP (Vpurify_flag))
3531 if (NILP (Vdoc_file_name))
3532 /* We have not yet called Snarf-documentation, so assume
3533 this file is described in the DOC-MM.NN file
3534 and Snarf-documentation will fill in the right value later.
3535 For now, replace the whole list with 0. */
3536 doc_reference = 1;
3537 else
3538 /* We have already called Snarf-documentation, so make a relative
3539 file name for this file, so it can be found properly
3540 in the installed Lisp directory.
3541 We don't use Fexpand_file_name because that would make
3542 the directory absolute now. */
3543 elt = concat2 (build_string ("../lisp/"),
3544 Ffile_name_nondirectory (elt));
3546 else if (EQ (elt, Vload_file_name)
3547 && ! NILP (elt)
3548 && load_force_doc_strings)
3549 doc_reference = 2;
3551 if (ch)
3553 if (flag > 0)
3555 if (ch == ']')
3556 return val;
3557 invalid_syntax (") or . in a vector");
3559 if (ch == ')')
3560 return val;
3561 if (ch == '.')
3563 GCPRO2 (val, tail);
3564 if (!NILP (tail))
3565 XSETCDR (tail, read0 (readcharfun));
3566 else
3567 val = read0 (readcharfun);
3568 read1 (readcharfun, &ch, 0);
3569 UNGCPRO;
3570 if (ch == ')')
3572 if (doc_reference == 1)
3573 return make_number (0);
3574 if (doc_reference == 2)
3576 /* Get a doc string from the file we are loading.
3577 If it's in saved_doc_string, get it from there.
3579 Here, we don't know if the string is a
3580 bytecode string or a doc string. As a
3581 bytecode string must be unibyte, we always
3582 return a unibyte string. If it is actually a
3583 doc string, caller must make it
3584 multibyte. */
3586 EMACS_INT pos = XINT (XCDR (val));
3587 /* Position is negative for user variables. */
3588 if (pos < 0) pos = -pos;
3589 if (pos >= saved_doc_string_position
3590 && pos < (saved_doc_string_position
3591 + saved_doc_string_length))
3593 ptrdiff_t start = pos - saved_doc_string_position;
3594 ptrdiff_t from, to;
3596 /* Process quoting with ^A,
3597 and find the end of the string,
3598 which is marked with ^_ (037). */
3599 for (from = start, to = start;
3600 saved_doc_string[from] != 037;)
3602 int c = saved_doc_string[from++];
3603 if (c == 1)
3605 c = saved_doc_string[from++];
3606 if (c == 1)
3607 saved_doc_string[to++] = c;
3608 else if (c == '0')
3609 saved_doc_string[to++] = 0;
3610 else if (c == '_')
3611 saved_doc_string[to++] = 037;
3613 else
3614 saved_doc_string[to++] = c;
3617 return make_unibyte_string (saved_doc_string + start,
3618 to - start);
3620 /* Look in prev_saved_doc_string the same way. */
3621 else if (pos >= prev_saved_doc_string_position
3622 && pos < (prev_saved_doc_string_position
3623 + prev_saved_doc_string_length))
3625 ptrdiff_t start =
3626 pos - prev_saved_doc_string_position;
3627 ptrdiff_t from, to;
3629 /* Process quoting with ^A,
3630 and find the end of the string,
3631 which is marked with ^_ (037). */
3632 for (from = start, to = start;
3633 prev_saved_doc_string[from] != 037;)
3635 int c = prev_saved_doc_string[from++];
3636 if (c == 1)
3638 c = prev_saved_doc_string[from++];
3639 if (c == 1)
3640 prev_saved_doc_string[to++] = c;
3641 else if (c == '0')
3642 prev_saved_doc_string[to++] = 0;
3643 else if (c == '_')
3644 prev_saved_doc_string[to++] = 037;
3646 else
3647 prev_saved_doc_string[to++] = c;
3650 return make_unibyte_string (prev_saved_doc_string
3651 + start,
3652 to - start);
3654 else
3655 return get_doc_string (val, 1, 0);
3658 return val;
3660 invalid_syntax (". in wrong context");
3662 invalid_syntax ("] in a list");
3664 tem = (read_pure && flag <= 0
3665 ? pure_cons (elt, Qnil)
3666 : Fcons (elt, Qnil));
3667 if (!NILP (tail))
3668 XSETCDR (tail, tem);
3669 else
3670 val = tem;
3671 tail = tem;
3672 if (defunflag < 0)
3673 defunflag = EQ (elt, Qdefun);
3674 else if (defunflag > 0)
3675 read_pure = 1;
3679 static Lisp_Object initial_obarray;
3681 /* oblookup stores the bucket number here, for the sake of Funintern. */
3683 static size_t oblookup_last_bucket_number;
3685 /* Get an error if OBARRAY is not an obarray.
3686 If it is one, return it. */
3688 Lisp_Object
3689 check_obarray (Lisp_Object obarray)
3691 if (!VECTORP (obarray) || ASIZE (obarray) == 0)
3693 /* If Vobarray is now invalid, force it to be valid. */
3694 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
3695 wrong_type_argument (Qvectorp, obarray);
3697 return obarray;
3700 /* Intern the C string STR: return a symbol with that name,
3701 interned in the current obarray. */
3703 Lisp_Object
3704 intern (const char *str)
3706 Lisp_Object tem;
3707 ptrdiff_t len = strlen (str);
3708 Lisp_Object obarray;
3710 obarray = Vobarray;
3711 if (!VECTORP (obarray) || ASIZE (obarray) == 0)
3712 obarray = check_obarray (obarray);
3713 tem = oblookup (obarray, str, len, len);
3714 if (SYMBOLP (tem))
3715 return tem;
3716 return Fintern (make_string (str, len), obarray);
3719 Lisp_Object
3720 intern_c_string (const char *str)
3722 Lisp_Object tem;
3723 ptrdiff_t len = strlen (str);
3724 Lisp_Object obarray;
3726 obarray = Vobarray;
3727 if (!VECTORP (obarray) || ASIZE (obarray) == 0)
3728 obarray = check_obarray (obarray);
3729 tem = oblookup (obarray, str, len, len);
3730 if (SYMBOLP (tem))
3731 return tem;
3733 if (NILP (Vpurify_flag))
3734 /* Creating a non-pure string from a string literal not
3735 implemented yet. We could just use make_string here and live
3736 with the extra copy. */
3737 abort ();
3739 return Fintern (make_pure_c_string (str), obarray);
3742 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
3743 doc: /* Return the canonical symbol whose name is STRING.
3744 If there is none, one is created by this function and returned.
3745 A second optional argument specifies the obarray to use;
3746 it defaults to the value of `obarray'. */)
3747 (Lisp_Object string, Lisp_Object obarray)
3749 register Lisp_Object tem, sym, *ptr;
3751 if (NILP (obarray)) obarray = Vobarray;
3752 obarray = check_obarray (obarray);
3754 CHECK_STRING (string);
3756 tem = oblookup (obarray, SSDATA (string),
3757 SCHARS (string),
3758 SBYTES (string));
3759 if (!INTEGERP (tem))
3760 return tem;
3762 if (!NILP (Vpurify_flag))
3763 string = Fpurecopy (string);
3764 sym = Fmake_symbol (string);
3766 if (EQ (obarray, initial_obarray))
3767 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3768 else
3769 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
3771 if ((SREF (string, 0) == ':')
3772 && EQ (obarray, initial_obarray))
3774 XSYMBOL (sym)->constant = 1;
3775 XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
3776 SET_SYMBOL_VAL (XSYMBOL (sym), sym);
3779 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
3780 if (SYMBOLP (*ptr))
3781 XSYMBOL (sym)->next = XSYMBOL (*ptr);
3782 else
3783 XSYMBOL (sym)->next = 0;
3784 *ptr = sym;
3785 return sym;
3788 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
3789 doc: /* Return the canonical symbol named NAME, or nil if none exists.
3790 NAME may be a string or a symbol. If it is a symbol, that exact
3791 symbol is searched for.
3792 A second optional argument specifies the obarray to use;
3793 it defaults to the value of `obarray'. */)
3794 (Lisp_Object name, Lisp_Object obarray)
3796 register Lisp_Object tem, string;
3798 if (NILP (obarray)) obarray = Vobarray;
3799 obarray = check_obarray (obarray);
3801 if (!SYMBOLP (name))
3803 CHECK_STRING (name);
3804 string = name;
3806 else
3807 string = SYMBOL_NAME (name);
3809 tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
3810 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3811 return Qnil;
3812 else
3813 return tem;
3816 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
3817 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
3818 The value is t if a symbol was found and deleted, nil otherwise.
3819 NAME may be a string or a symbol. If it is a symbol, that symbol
3820 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3821 OBARRAY defaults to the value of the variable `obarray'. */)
3822 (Lisp_Object name, Lisp_Object obarray)
3824 register Lisp_Object string, tem;
3825 size_t hash;
3827 if (NILP (obarray)) obarray = Vobarray;
3828 obarray = check_obarray (obarray);
3830 if (SYMBOLP (name))
3831 string = SYMBOL_NAME (name);
3832 else
3834 CHECK_STRING (name);
3835 string = name;
3838 tem = oblookup (obarray, SSDATA (string),
3839 SCHARS (string),
3840 SBYTES (string));
3841 if (INTEGERP (tem))
3842 return Qnil;
3843 /* If arg was a symbol, don't delete anything but that symbol itself. */
3844 if (SYMBOLP (name) && !EQ (name, tem))
3845 return Qnil;
3847 /* There are plenty of other symbols which will screw up the Emacs
3848 session if we unintern them, as well as even more ways to use
3849 `setq' or `fset' or whatnot to make the Emacs session
3850 unusable. Let's not go down this silly road. --Stef */
3851 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3852 error ("Attempt to unintern t or nil"); */
3854 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3856 hash = oblookup_last_bucket_number;
3858 if (EQ (XVECTOR (obarray)->contents[hash], tem))
3860 if (XSYMBOL (tem)->next)
3861 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3862 else
3863 XSETINT (XVECTOR (obarray)->contents[hash], 0);
3865 else
3867 Lisp_Object tail, following;
3869 for (tail = XVECTOR (obarray)->contents[hash];
3870 XSYMBOL (tail)->next;
3871 tail = following)
3873 XSETSYMBOL (following, XSYMBOL (tail)->next);
3874 if (EQ (following, tem))
3876 XSYMBOL (tail)->next = XSYMBOL (following)->next;
3877 break;
3882 return Qt;
3885 /* Return the symbol in OBARRAY whose names matches the string
3886 of SIZE characters (SIZE_BYTE bytes) at PTR.
3887 If there is no such symbol in OBARRAY, return nil.
3889 Also store the bucket number in oblookup_last_bucket_number. */
3891 Lisp_Object
3892 oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte)
3894 size_t hash;
3895 size_t obsize;
3896 register Lisp_Object tail;
3897 Lisp_Object bucket, tem;
3899 if (!VECTORP (obarray)
3900 || (obsize = ASIZE (obarray)) == 0)
3902 obarray = check_obarray (obarray);
3903 obsize = ASIZE (obarray);
3905 /* This is sometimes needed in the middle of GC. */
3906 obsize &= ~ARRAY_MARK_FLAG;
3907 hash = hash_string (ptr, size_byte) % obsize;
3908 bucket = XVECTOR (obarray)->contents[hash];
3909 oblookup_last_bucket_number = hash;
3910 if (EQ (bucket, make_number (0)))
3912 else if (!SYMBOLP (bucket))
3913 error ("Bad data in guts of obarray"); /* Like CADR error message */
3914 else
3915 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
3917 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3918 && SCHARS (SYMBOL_NAME (tail)) == size
3919 && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
3920 return tail;
3921 else if (XSYMBOL (tail)->next == 0)
3922 break;
3924 XSETINT (tem, hash);
3925 return tem;
3928 void
3929 map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
3931 ptrdiff_t i;
3932 register Lisp_Object tail;
3933 CHECK_VECTOR (obarray);
3934 for (i = ASIZE (obarray) - 1; i >= 0; i--)
3936 tail = XVECTOR (obarray)->contents[i];
3937 if (SYMBOLP (tail))
3938 while (1)
3940 (*fn) (tail, arg);
3941 if (XSYMBOL (tail)->next == 0)
3942 break;
3943 XSETSYMBOL (tail, XSYMBOL (tail)->next);
3948 static void
3949 mapatoms_1 (Lisp_Object sym, Lisp_Object function)
3951 call1 (function, sym);
3954 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
3955 doc: /* Call FUNCTION on every symbol in OBARRAY.
3956 OBARRAY defaults to the value of `obarray'. */)
3957 (Lisp_Object function, Lisp_Object obarray)
3959 if (NILP (obarray)) obarray = Vobarray;
3960 obarray = check_obarray (obarray);
3962 map_obarray (obarray, mapatoms_1, function);
3963 return Qnil;
3966 #define OBARRAY_SIZE 1511
3968 void
3969 init_obarray (void)
3971 Lisp_Object oblength;
3972 ptrdiff_t size = 100 + MAX_MULTIBYTE_LENGTH;
3974 XSETFASTINT (oblength, OBARRAY_SIZE);
3976 Vobarray = Fmake_vector (oblength, make_number (0));
3977 initial_obarray = Vobarray;
3978 staticpro (&initial_obarray);
3980 Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
3981 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3982 NILP (Vpurify_flag) check in intern_c_string. */
3983 Qnil = make_number (-1); Vpurify_flag = make_number (1);
3984 Qnil = intern_c_string ("nil");
3986 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3987 so those two need to be fixed manually. */
3988 SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
3989 XSYMBOL (Qunbound)->function = Qunbound;
3990 XSYMBOL (Qunbound)->plist = Qnil;
3991 /* XSYMBOL (Qnil)->function = Qunbound; */
3992 SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
3993 XSYMBOL (Qnil)->constant = 1;
3994 XSYMBOL (Qnil)->plist = Qnil;
3996 Qt = intern_c_string ("t");
3997 SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
3998 XSYMBOL (Qt)->constant = 1;
4000 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4001 Vpurify_flag = Qt;
4003 DEFSYM (Qvariable_documentation, "variable-documentation");
4005 read_buffer = (char *) xmalloc (size);
4006 read_buffer_size = size;
4009 void
4010 defsubr (struct Lisp_Subr *sname)
4012 Lisp_Object sym;
4013 sym = intern_c_string (sname->symbol_name);
4014 XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR);
4015 XSETSUBR (XSYMBOL (sym)->function, sname);
4018 #ifdef NOTDEF /* use fset in subr.el now */
4019 void
4020 defalias (struct Lisp_Subr *sname, char *string)
4022 Lisp_Object sym;
4023 sym = intern (string);
4024 XSETSUBR (XSYMBOL (sym)->function, sname);
4026 #endif /* NOTDEF */
4028 /* Define an "integer variable"; a symbol whose value is forwarded to a
4029 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4030 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4031 void
4032 defvar_int (struct Lisp_Intfwd *i_fwd,
4033 const char *namestring, EMACS_INT *address)
4035 Lisp_Object sym;
4036 sym = intern_c_string (namestring);
4037 i_fwd->type = Lisp_Fwd_Int;
4038 i_fwd->intvar = address;
4039 XSYMBOL (sym)->declared_special = 1;
4040 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4041 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
4044 /* Similar but define a variable whose value is t if address contains 1,
4045 nil if address contains 0. */
4046 void
4047 defvar_bool (struct Lisp_Boolfwd *b_fwd,
4048 const char *namestring, int *address)
4050 Lisp_Object sym;
4051 sym = intern_c_string (namestring);
4052 b_fwd->type = Lisp_Fwd_Bool;
4053 b_fwd->boolvar = address;
4054 XSYMBOL (sym)->declared_special = 1;
4055 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4056 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
4057 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
4060 /* Similar but define a variable whose value is the Lisp Object stored
4061 at address. Two versions: with and without gc-marking of the C
4062 variable. The nopro version is used when that variable will be
4063 gc-marked for some other reason, since marking the same slot twice
4064 can cause trouble with strings. */
4065 void
4066 defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
4067 const char *namestring, Lisp_Object *address)
4069 Lisp_Object sym;
4070 sym = intern_c_string (namestring);
4071 o_fwd->type = Lisp_Fwd_Obj;
4072 o_fwd->objvar = address;
4073 XSYMBOL (sym)->declared_special = 1;
4074 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4075 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
4078 void
4079 defvar_lisp (struct Lisp_Objfwd *o_fwd,
4080 const char *namestring, Lisp_Object *address)
4082 defvar_lisp_nopro (o_fwd, namestring, address);
4083 staticpro (address);
4086 /* Similar but define a variable whose value is the Lisp Object stored
4087 at a particular offset in the current kboard object. */
4089 void
4090 defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
4091 const char *namestring, int offset)
4093 Lisp_Object sym;
4094 sym = intern_c_string (namestring);
4095 ko_fwd->type = Lisp_Fwd_Kboard_Obj;
4096 ko_fwd->offset = offset;
4097 XSYMBOL (sym)->declared_special = 1;
4098 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4099 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
4102 /* Record the value of load-path used at the start of dumping
4103 so we can see if the site changed it later during dumping. */
4104 static Lisp_Object dump_path;
4106 void
4107 init_lread (void)
4109 const char *normal;
4110 int turn_off_warning = 0;
4112 /* Compute the default Vload-path, with the following logic:
4113 If CANNOT_DUMP just use PATH_LOADSEARCH.
4114 Else if purify-flag (ie dumping) start from PATH_DUMPLOADSEARCH;
4115 otherwise start from PATH_LOADSEARCH.
4116 If !initialized, then just set both Vload_path and dump_path.
4117 If initialized, then if Vload_path != dump_path, do nothing.
4118 (Presumably the load-path has already been changed by something.)
4119 Also do nothing if Vinstallation_directory is nil.
4120 Otherwise:
4121 Remove site-lisp directories from the front of load-path.
4122 Add installation-dir/lisp (if exists and not already a member),
4123 at the front, and turn off warnings about missing directories
4124 (because we are presumably running uninstalled).
4125 If it does not exist, add dump_path at the end instead.
4126 Add installation-dir/leim (if exists and not already a member)
4127 at the front.
4128 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4129 and not already a member) at the front.
4130 If installation-dir != source-dir (ie running an uninstalled,
4131 out-of-tree build) AND install-dir/src/Makefile exists BUT
4132 install-dir/src/Makefile.in does NOT exist (this is a sanity
4133 check), then repeat the above steps for source-dir/lisp,
4134 leim and site-lisp.
4135 Finally, add the previously removed site-lisp directories back
4136 at the front (if !no_site_lisp).
4138 We then warn about any of the load-path elements that do not
4139 exist. The only ones that might not exist are those from
4140 PATH_LOADSEARCH, and perhaps dump_path.
4142 Having done all this, we then throw it all away if purify-flag is
4143 nil (ie, not dumping) and EMACSLOADPATH is set, and just
4144 unconditionally use the latter value instead.
4145 So AFAICS the only net results of all the previous steps will be
4146 possibly to issue some irrelevant warnings.
4148 FIXME? There's a case for saying that if we are running
4149 uninstalled, the eventual installation directories should not yet
4150 be included in load-path.
4152 #ifdef CANNOT_DUMP
4153 normal = PATH_LOADSEARCH;
4154 Vload_path = decode_env_path (0, normal);
4155 #else
4156 if (NILP (Vpurify_flag))
4157 normal = PATH_LOADSEARCH;
4158 else
4159 normal = PATH_DUMPLOADSEARCH;
4161 /* In a dumped Emacs, we normally reset the value of Vload_path using
4162 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4163 the source directory, instead of the path of the installed elisp
4164 libraries. However, if it appears that Vload_path has already been
4165 changed from the default that was saved before dumping, don't
4166 change it further. */
4167 if (initialized)
4169 if (! NILP (Fequal (dump_path, Vload_path)))
4171 Vload_path = decode_env_path (0, normal);
4172 if (no_site_lisp || !NILP (Vinstallation_directory))
4174 Lisp_Object tem, tem1, sitelisp;
4176 /* Remove "site-lisp" dirs from front of path temporarily
4177 and store them in sitelisp, then conc them on at the
4178 end so they're always first in path.
4179 Note that this won't work if you used a
4180 --enable-locallisppath element that does not happen
4181 to contain "site-lisp" in its name.
4183 sitelisp = Qnil;
4184 while (1)
4186 tem = Fcar (Vload_path);
4187 tem1 = Fstring_match (build_string ("site-lisp"),
4188 tem, Qnil);
4189 if (!NILP (tem1))
4191 Vload_path = Fcdr (Vload_path);
4192 sitelisp = Fcons (tem, sitelisp);
4194 else
4195 break;
4198 if (!NILP (Vinstallation_directory))
4200 /* Add to the path the lisp subdir of the
4201 installation dir, if it exists. */
4202 tem = Fexpand_file_name (build_string ("lisp"),
4203 Vinstallation_directory);
4204 tem1 = Ffile_exists_p (tem);
4205 if (!NILP (tem1))
4207 if (NILP (Fmember (tem, Vload_path)))
4209 turn_off_warning = 1;
4210 Vload_path = Fcons (tem, Vload_path);
4213 else
4214 /* That dir doesn't exist, so add the build-time
4215 Lisp dirs instead. */
4216 Vload_path = nconc2 (Vload_path, dump_path);
4218 /* Add leim under the installation dir, if it exists. */
4219 tem = Fexpand_file_name (build_string ("leim"),
4220 Vinstallation_directory);
4221 tem1 = Ffile_exists_p (tem);
4222 if (!NILP (tem1))
4224 if (NILP (Fmember (tem, Vload_path)))
4225 Vload_path = Fcons (tem, Vload_path);
4228 /* Add site-lisp under the installation dir, if it exists. */
4229 if (!no_site_lisp)
4231 tem = Fexpand_file_name (build_string ("site-lisp"),
4232 Vinstallation_directory);
4233 tem1 = Ffile_exists_p (tem);
4234 if (!NILP (tem1))
4236 if (NILP (Fmember (tem, Vload_path)))
4237 Vload_path = Fcons (tem, Vload_path);
4241 /* If Emacs was not built in the source directory,
4242 and it is run from where it was built, add to load-path
4243 the lisp, leim and site-lisp dirs under that directory. */
4245 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
4247 Lisp_Object tem2;
4249 tem = Fexpand_file_name (build_string ("src/Makefile"),
4250 Vinstallation_directory);
4251 tem1 = Ffile_exists_p (tem);
4253 /* Don't be fooled if they moved the entire source tree
4254 AFTER dumping Emacs. If the build directory is indeed
4255 different from the source dir, src/Makefile.in and
4256 src/Makefile will not be found together. */
4257 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
4258 Vinstallation_directory);
4259 tem2 = Ffile_exists_p (tem);
4260 if (!NILP (tem1) && NILP (tem2))
4262 tem = Fexpand_file_name (build_string ("lisp"),
4263 Vsource_directory);
4265 if (NILP (Fmember (tem, Vload_path)))
4266 Vload_path = Fcons (tem, Vload_path);
4268 tem = Fexpand_file_name (build_string ("leim"),
4269 Vsource_directory);
4271 if (NILP (Fmember (tem, Vload_path)))
4272 Vload_path = Fcons (tem, Vload_path);
4274 if (!no_site_lisp)
4276 tem = Fexpand_file_name (build_string ("site-lisp"),
4277 Vsource_directory);
4279 if (NILP (Fmember (tem, Vload_path)))
4280 Vload_path = Fcons (tem, Vload_path);
4283 } /* Vinstallation_directory != Vsource_directory */
4284 } /* if Vinstallation_directory */
4285 if (!NILP (sitelisp) && !no_site_lisp)
4286 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
4287 } /* if Vinstallation_directory || no_site_lisp */
4288 } /* if dump_path == Vload_path */
4290 else /* !initialized */
4292 /* NORMAL refers to the lisp dir in the source directory. */
4293 /* We used to add ../lisp at the front here, but
4294 that caused trouble because it was copied from dump_path
4295 into Vload_path, above, when Vinstallation_directory was non-nil.
4296 It should be unnecessary. */
4297 Vload_path = decode_env_path (0, normal);
4298 dump_path = Vload_path;
4300 #endif /* CANNOT_DUMP */
4302 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4303 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4304 almost never correct, thereby causing a warning to be printed out that
4305 confuses users. Since PATH_LOADSEARCH is always overridden by the
4306 EMACSLOADPATH environment variable below, disable the warning on NT. */
4308 /* HAVE_NS also uses EMACSLOADPATH. */
4310 /* Warn if dirs in the *standard* path don't exist. */
4311 if (!turn_off_warning)
4313 Lisp_Object path_tail;
4315 for (path_tail = Vload_path;
4316 !NILP (path_tail);
4317 path_tail = XCDR (path_tail))
4319 Lisp_Object dirfile;
4320 dirfile = Fcar (path_tail);
4321 if (STRINGP (dirfile))
4323 dirfile = Fdirectory_file_name (dirfile);
4324 /* Do we really need to warn about missing site-lisp dirs?
4325 It's true that the installation should have created
4326 them and added subdirs.el, but it's harmless if they
4327 are not there. */
4328 if (access (SSDATA (dirfile), 0) < 0)
4329 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4330 XCAR (path_tail));
4334 #endif /* !(WINDOWSNT || HAVE_NS) */
4336 /* If the EMACSLOADPATH environment variable is set, use its value.
4337 This doesn't apply if we're dumping. */
4338 #ifndef CANNOT_DUMP
4339 if (NILP (Vpurify_flag)
4340 && egetenv ("EMACSLOADPATH"))
4341 #endif
4342 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
4344 Vvalues = Qnil;
4346 load_in_progress = 0;
4347 Vload_file_name = Qnil;
4349 load_descriptor_list = Qnil;
4351 Vstandard_input = Qt;
4352 Vloads_in_progress = Qnil;
4355 /* Print a warning, using format string FORMAT, that directory DIRNAME
4356 does not exist. Print it on stderr and put it in *Messages*. */
4358 void
4359 dir_warning (const char *format, Lisp_Object dirname)
4361 fprintf (stderr, format, SDATA (dirname));
4363 /* Don't log the warning before we've initialized!! */
4364 if (initialized)
4366 char *buffer;
4367 ptrdiff_t message_len;
4368 USE_SAFE_ALLOCA;
4369 SAFE_ALLOCA (buffer, char *,
4370 SBYTES (dirname) + strlen (format) - (sizeof "%s" - 1) + 1);
4371 message_len = esprintf (buffer, format, SDATA (dirname));
4372 message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
4373 SAFE_FREE ();
4377 void
4378 syms_of_lread (void)
4380 defsubr (&Sread);
4381 defsubr (&Sread_from_string);
4382 defsubr (&Sintern);
4383 defsubr (&Sintern_soft);
4384 defsubr (&Sunintern);
4385 defsubr (&Sget_load_suffixes);
4386 defsubr (&Sload);
4387 defsubr (&Seval_buffer);
4388 defsubr (&Seval_region);
4389 defsubr (&Sread_char);
4390 defsubr (&Sread_char_exclusive);
4391 defsubr (&Sread_event);
4392 defsubr (&Sget_file_char);
4393 defsubr (&Smapatoms);
4394 defsubr (&Slocate_file_internal);
4396 DEFVAR_LISP ("obarray", Vobarray,
4397 doc: /* Symbol table for use by `intern' and `read'.
4398 It is a vector whose length ought to be prime for best results.
4399 The vector's contents don't make sense if examined from Lisp programs;
4400 to find all the symbols in an obarray, use `mapatoms'. */);
4402 DEFVAR_LISP ("values", Vvalues,
4403 doc: /* List of values of all expressions which were read, evaluated and printed.
4404 Order is reverse chronological. */);
4406 DEFVAR_LISP ("standard-input", Vstandard_input,
4407 doc: /* Stream for read to get input from.
4408 See documentation of `read' for possible values. */);
4409 Vstandard_input = Qt;
4411 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions,
4412 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4414 If this variable is a buffer, then only forms read from that buffer
4415 will be added to `read-symbol-positions-list'.
4416 If this variable is t, then all read forms will be added.
4417 The effect of all other values other than nil are not currently
4418 defined, although they may be in the future.
4420 The positions are relative to the last call to `read' or
4421 `read-from-string'. It is probably a bad idea to set this variable at
4422 the toplevel; bind it instead. */);
4423 Vread_with_symbol_positions = Qnil;
4425 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list,
4426 doc: /* A list mapping read symbols to their positions.
4427 This variable is modified during calls to `read' or
4428 `read-from-string', but only when `read-with-symbol-positions' is
4429 non-nil.
4431 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4432 CHAR-POSITION is an integer giving the offset of that occurrence of the
4433 symbol from the position where `read' or `read-from-string' started.
4435 Note that a symbol will appear multiple times in this list, if it was
4436 read multiple times. The list is in the same order as the symbols
4437 were read in. */);
4438 Vread_symbol_positions_list = Qnil;
4440 DEFVAR_LISP ("read-circle", Vread_circle,
4441 doc: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4442 Vread_circle = Qt;
4444 DEFVAR_LISP ("load-path", Vload_path,
4445 doc: /* *List of directories to search for files to load.
4446 Each element is a string (directory name) or nil (try default directory).
4447 Initialized based on EMACSLOADPATH environment variable, if any,
4448 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4450 DEFVAR_LISP ("load-suffixes", Vload_suffixes,
4451 doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
4452 This list should not include the empty string.
4453 `load' and related functions try to append these suffixes, in order,
4454 to the specified file name if a Lisp suffix is allowed or required. */);
4455 Vload_suffixes = Fcons (make_pure_c_string (".elc"),
4456 Fcons (make_pure_c_string (".el"), Qnil));
4457 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
4458 doc: /* List of suffixes that indicate representations of \
4459 the same file.
4460 This list should normally start with the empty string.
4462 Enabling Auto Compression mode appends the suffixes in
4463 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4464 mode removes them again. `load' and related functions use this list to
4465 determine whether they should look for compressed versions of a file
4466 and, if so, which suffixes they should try to append to the file name
4467 in order to do so. However, if you want to customize which suffixes
4468 the loading functions recognize as compression suffixes, you should
4469 customize `jka-compr-load-suffixes' rather than the present variable. */);
4470 Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
4472 DEFVAR_BOOL ("load-in-progress", load_in_progress,
4473 doc: /* Non-nil if inside of `load'. */);
4474 DEFSYM (Qload_in_progress, "load-in-progress");
4476 DEFVAR_LISP ("after-load-alist", Vafter_load_alist,
4477 doc: /* An alist of expressions to be evalled when particular files are loaded.
4478 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4480 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4481 a symbol \(a feature name).
4483 When `load' is run and the file-name argument matches an element's
4484 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4485 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4487 An error in FORMS does not undo the load, but does prevent execution of
4488 the rest of the FORMS. */);
4489 Vafter_load_alist = Qnil;
4491 DEFVAR_LISP ("load-history", Vload_history,
4492 doc: /* Alist mapping loaded file names to symbols and features.
4493 Each alist element should be a list (FILE-NAME ENTRIES...), where
4494 FILE-NAME is the name of a file that has been loaded into Emacs.
4495 The file name is absolute and true (i.e. it doesn't contain symlinks).
4496 As an exception, one of the alist elements may have FILE-NAME nil,
4497 for symbols and features not associated with any file.
4499 The remaining ENTRIES in the alist element describe the functions and
4500 variables defined in that file, the features provided, and the
4501 features required. Each entry has the form `(provide . FEATURE)',
4502 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4503 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4504 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4505 autoload before this file redefined it as a function. In addition,
4506 entries may also be single symbols, which means that SYMBOL was
4507 defined by `defvar' or `defconst'.
4509 During preloading, the file name recorded is relative to the main Lisp
4510 directory. These file names are converted to absolute at startup. */);
4511 Vload_history = Qnil;
4513 DEFVAR_LISP ("load-file-name", Vload_file_name,
4514 doc: /* Full name of file being loaded by `load'. */);
4515 Vload_file_name = Qnil;
4517 DEFVAR_LISP ("user-init-file", Vuser_init_file,
4518 doc: /* File name, including directory, of user's initialization file.
4519 If the file loaded had extension `.elc', and the corresponding source file
4520 exists, this variable contains the name of source file, suitable for use
4521 by functions like `custom-save-all' which edit the init file.
4522 While Emacs loads and evaluates the init file, value is the real name
4523 of the file, regardless of whether or not it has the `.elc' extension. */);
4524 Vuser_init_file = Qnil;
4526 DEFVAR_LISP ("current-load-list", Vcurrent_load_list,
4527 doc: /* Used for internal purposes by `load'. */);
4528 Vcurrent_load_list = Qnil;
4530 DEFVAR_LISP ("load-read-function", Vload_read_function,
4531 doc: /* Function used by `load' and `eval-region' for reading expressions.
4532 The default is nil, which means use the function `read'. */);
4533 Vload_read_function = Qnil;
4535 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function,
4536 doc: /* Function called in `load' for loading an Emacs Lisp source file.
4537 This function is for doing code conversion before reading the source file.
4538 If nil, loading is done without any code conversion.
4539 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4540 FULLNAME is the full name of FILE.
4541 See `load' for the meaning of the remaining arguments. */);
4542 Vload_source_file_function = Qnil;
4544 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings,
4545 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
4546 This is useful when the file being loaded is a temporary copy. */);
4547 load_force_doc_strings = 0;
4549 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte,
4550 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
4551 This is normally bound by `load' and `eval-buffer' to control `read',
4552 and is not meant for users to change. */);
4553 load_convert_to_unibyte = 0;
4555 DEFVAR_LISP ("source-directory", Vsource_directory,
4556 doc: /* Directory in which Emacs sources were found when Emacs was built.
4557 You cannot count on them to still be there! */);
4558 Vsource_directory
4559 = Fexpand_file_name (build_string ("../"),
4560 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
4562 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list,
4563 doc: /* List of files that were preloaded (when dumping Emacs). */);
4564 Vpreloaded_file_list = Qnil;
4566 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars,
4567 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4568 Vbyte_boolean_vars = Qnil;
4570 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries,
4571 doc: /* Non-nil means load dangerous compiled Lisp files.
4572 Some versions of XEmacs use different byte codes than Emacs. These
4573 incompatible byte codes can make Emacs crash when it tries to execute
4574 them. */);
4575 load_dangerous_libraries = 0;
4577 DEFVAR_BOOL ("force-load-messages", force_load_messages,
4578 doc: /* Non-nil means force printing messages when loading Lisp files.
4579 This overrides the value of the NOMESSAGE argument to `load'. */);
4580 force_load_messages = 0;
4582 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp,
4583 doc: /* Regular expression matching safe to load compiled Lisp files.
4584 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4585 from the file, and matches them against this regular expression.
4586 When the regular expression matches, the file is considered to be safe
4587 to load. See also `load-dangerous-libraries'. */);
4588 Vbytecomp_version_regexp
4589 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4591 Qlexical_binding = intern ("lexical-binding");
4592 staticpro (&Qlexical_binding);
4593 DEFVAR_LISP ("lexical-binding", Vlexical_binding,
4594 doc: /* Whether to use lexical binding when evaluating code.
4595 Non-nil means that the code in the current buffer should be evaluated
4596 with lexical binding.
4597 This variable is automatically set from the file variables of an
4598 interpreted Lisp file read using `load'. Unlike other file local
4599 variables, this must be set in the first line of a file. */);
4600 Fmake_variable_buffer_local (Qlexical_binding);
4602 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list,
4603 doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4604 Veval_buffer_list = Qnil;
4606 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes,
4607 doc: /* Set to non-nil when `read' encounters an old-style backquote. */);
4608 Vold_style_backquotes = Qnil;
4609 DEFSYM (Qold_style_backquotes, "old-style-backquotes");
4611 /* Vsource_directory was initialized in init_lread. */
4613 load_descriptor_list = Qnil;
4614 staticpro (&load_descriptor_list);
4616 DEFSYM (Qcurrent_load_list, "current-load-list");
4617 DEFSYM (Qstandard_input, "standard-input");
4618 DEFSYM (Qread_char, "read-char");
4619 DEFSYM (Qget_file_char, "get-file-char");
4620 DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char");
4621 DEFSYM (Qload_force_doc_strings, "load-force-doc-strings");
4623 DEFSYM (Qbackquote, "`");
4624 DEFSYM (Qcomma, ",");
4625 DEFSYM (Qcomma_at, ",@");
4626 DEFSYM (Qcomma_dot, ",.");
4628 DEFSYM (Qinhibit_file_name_operation, "inhibit-file-name-operation");
4629 DEFSYM (Qascii_character, "ascii-character");
4630 DEFSYM (Qfunction, "function");
4631 DEFSYM (Qload, "load");
4632 DEFSYM (Qload_file_name, "load-file-name");
4633 DEFSYM (Qeval_buffer_list, "eval-buffer-list");
4634 DEFSYM (Qfile_truename, "file-truename");
4635 DEFSYM (Qdir_ok, "dir-ok");
4636 DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
4638 staticpro (&dump_path);
4640 staticpro (&read_objects);
4641 read_objects = Qnil;
4642 staticpro (&seen_list);
4643 seen_list = Qnil;
4645 Vloads_in_progress = Qnil;
4646 staticpro (&Vloads_in_progress);
4648 DEFSYM (Qhash_table, "hash-table");
4649 DEFSYM (Qdata, "data");
4650 DEFSYM (Qtest, "test");
4651 DEFSYM (Qsize, "size");
4652 DEFSYM (Qweakness, "weakness");
4653 DEFSYM (Qrehash_size, "rehash-size");
4654 DEFSYM (Qrehash_threshold, "rehash-threshold");