(url-retrieve-synchronously): Don't autoload.
[emacs.git] / src / lread.c
blob4d9ddfbd0092dac0efd2a7e4b4b57da2cae26392
1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
24 #include <config.h>
25 #include <stdio.h>
26 #include <sys/types.h>
27 #include <sys/stat.h>
28 #include <sys/file.h>
29 #include <errno.h>
30 #include "lisp.h"
31 #include "intervals.h"
32 #include "buffer.h"
33 #include "charset.h"
34 #include <epaths.h>
35 #include "commands.h"
36 #include "keyboard.h"
37 #include "termhooks.h"
38 #include "coding.h"
40 #ifdef lint
41 #include <sys/inode.h>
42 #endif /* lint */
44 #ifdef MSDOS
45 #if __DJGPP__ < 2
46 #include <unistd.h> /* to get X_OK */
47 #endif
48 #include "msdos.h"
49 #endif
51 #ifdef HAVE_UNISTD_H
52 #include <unistd.h>
53 #endif
55 #ifndef X_OK
56 #define X_OK 01
57 #endif
59 #include <math.h>
61 #ifdef HAVE_SETLOCALE
62 #include <locale.h>
63 #endif /* HAVE_SETLOCALE */
65 #ifdef HAVE_FCNTL_H
66 #include <fcntl.h>
67 #endif
68 #ifndef O_RDONLY
69 #define O_RDONLY 0
70 #endif
72 #ifdef HAVE_FSEEKO
73 #define file_offset off_t
74 #define file_tell ftello
75 #else
76 #define file_offset long
77 #define file_tell ftell
78 #endif
80 #ifndef USE_CRT_DLL
81 extern int errno;
82 #endif
84 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
85 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
86 Lisp_Object Qascii_character, Qload, Qload_file_name;
87 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
88 Lisp_Object Qinhibit_file_name_operation;
89 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
91 extern Lisp_Object Qevent_symbol_element_mask;
92 extern Lisp_Object Qfile_exists_p;
94 /* non-zero iff inside `load' */
95 int load_in_progress;
97 /* Directory in which the sources were found. */
98 Lisp_Object Vsource_directory;
100 /* Search path and suffixes for files to be loaded. */
101 Lisp_Object Vload_path, Vload_suffixes, default_suffixes;
103 /* File name of user's init file. */
104 Lisp_Object Vuser_init_file;
106 /* This is the user-visible association list that maps features to
107 lists of defs in their load files. */
108 Lisp_Object Vload_history;
110 /* This is used to build the load history. */
111 Lisp_Object Vcurrent_load_list;
113 /* List of files that were preloaded. */
114 Lisp_Object Vpreloaded_file_list;
116 /* Name of file actually being read by `load'. */
117 Lisp_Object Vload_file_name;
119 /* Function to use for reading, in `load' and friends. */
120 Lisp_Object Vload_read_function;
122 /* The association list of objects read with the #n=object form.
123 Each member of the list has the form (n . object), and is used to
124 look up the object for the corresponding #n# construct.
125 It must be set to nil before all top-level calls to read0. */
126 Lisp_Object read_objects;
128 /* Nonzero means load should forcibly load all dynamic doc strings. */
129 static int load_force_doc_strings;
131 /* Nonzero means read should convert strings to unibyte. */
132 static int load_convert_to_unibyte;
134 /* Function to use for loading an Emacs lisp source file (not
135 compiled) instead of readevalloop. */
136 Lisp_Object Vload_source_file_function;
138 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
139 Lisp_Object Vbyte_boolean_vars;
141 /* Whether or not to add a `read-positions' property to symbols
142 read. */
143 Lisp_Object Vread_with_symbol_positions;
145 /* List of (SYMBOL . POSITION) accumulated so far. */
146 Lisp_Object Vread_symbol_positions_list;
148 /* List of descriptors now open for Fload. */
149 static Lisp_Object load_descriptor_list;
151 /* File for get_file_char to read from. Use by load. */
152 static FILE *instream;
154 /* When nonzero, read conses in pure space */
155 static int read_pure;
157 /* For use within read-from-string (this reader is non-reentrant!!) */
158 static int read_from_string_index;
159 static int read_from_string_index_byte;
160 static int read_from_string_limit;
162 /* Number of bytes left to read in the buffer character
163 that `readchar' has already advanced over. */
164 static int readchar_backlog;
165 /* Number of characters read in the current call to Fread or
166 Fread_from_string. */
167 static int readchar_count;
169 /* This contains the last string skipped with #@. */
170 static char *saved_doc_string;
171 /* Length of buffer allocated in saved_doc_string. */
172 static int saved_doc_string_size;
173 /* Length of actual data in saved_doc_string. */
174 static int saved_doc_string_length;
175 /* This is the file position that string came from. */
176 static file_offset saved_doc_string_position;
178 /* This contains the previous string skipped with #@.
179 We copy it from saved_doc_string when a new string
180 is put in saved_doc_string. */
181 static char *prev_saved_doc_string;
182 /* Length of buffer allocated in prev_saved_doc_string. */
183 static int prev_saved_doc_string_size;
184 /* Length of actual data in prev_saved_doc_string. */
185 static int prev_saved_doc_string_length;
186 /* This is the file position that string came from. */
187 static file_offset prev_saved_doc_string_position;
189 /* Nonzero means inside a new-style backquote
190 with no surrounding parentheses.
191 Fread initializes this to zero, so we need not specbind it
192 or worry about what happens to it when there is an error. */
193 static int new_backquote_flag;
195 /* A list of file names for files being loaded in Fload. Used to
196 check for recursive loads. */
198 static Lisp_Object Vloads_in_progress;
200 /* Non-zero means load dangerous compiled Lisp files. */
202 int load_dangerous_libraries;
204 /* A regular expression used to detect files compiled with Emacs. */
206 static Lisp_Object Vbytecomp_version_regexp;
208 static void to_multibyte P_ ((char **, char **, int *));
209 static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
210 Lisp_Object (*) (), int,
211 Lisp_Object, Lisp_Object,
212 Lisp_Object, Lisp_Object));
213 static Lisp_Object load_unwind P_ ((Lisp_Object));
214 static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
217 /* Handle unreading and rereading of characters.
218 Write READCHAR to read a character,
219 UNREAD(c) to unread c to be read again.
221 The READCHAR and UNREAD macros are meant for reading/unreading a
222 byte code; they do not handle multibyte characters. The caller
223 should manage them if necessary.
225 [ Actually that seems to be a lie; READCHAR will definitely read
226 multibyte characters from buffer sources, at least. Is the
227 comment just out of date?
228 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
231 #define READCHAR readchar (readcharfun)
232 #define UNREAD(c) unreadchar (readcharfun, c)
234 static int
235 readchar (readcharfun)
236 Lisp_Object readcharfun;
238 Lisp_Object tem;
239 register int c;
241 readchar_count++;
243 if (BUFFERP (readcharfun))
245 register struct buffer *inbuffer = XBUFFER (readcharfun);
247 int pt_byte = BUF_PT_BYTE (inbuffer);
248 int orig_pt_byte = pt_byte;
250 if (readchar_backlog > 0)
251 /* We get the address of the byte just passed,
252 which is the last byte of the character.
253 The other bytes in this character are consecutive with it,
254 because the gap can't be in the middle of a character. */
255 return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1)
256 - --readchar_backlog);
258 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
259 return -1;
261 readchar_backlog = -1;
263 if (! NILP (inbuffer->enable_multibyte_characters))
265 /* Fetch the character code from the buffer. */
266 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
267 BUF_INC_POS (inbuffer, pt_byte);
268 c = STRING_CHAR (p, pt_byte - orig_pt_byte);
270 else
272 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
273 pt_byte++;
275 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
277 return c;
279 if (MARKERP (readcharfun))
281 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
283 int bytepos = marker_byte_position (readcharfun);
284 int orig_bytepos = bytepos;
286 if (readchar_backlog > 0)
287 /* We get the address of the byte just passed,
288 which is the last byte of the character.
289 The other bytes in this character are consecutive with it,
290 because the gap can't be in the middle of a character. */
291 return *(BUF_BYTE_ADDRESS (inbuffer, XMARKER (readcharfun)->bytepos - 1)
292 - --readchar_backlog);
294 if (bytepos >= BUF_ZV_BYTE (inbuffer))
295 return -1;
297 readchar_backlog = -1;
299 if (! NILP (inbuffer->enable_multibyte_characters))
301 /* Fetch the character code from the buffer. */
302 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
303 BUF_INC_POS (inbuffer, bytepos);
304 c = STRING_CHAR (p, bytepos - orig_bytepos);
306 else
308 c = BUF_FETCH_BYTE (inbuffer, bytepos);
309 bytepos++;
312 XMARKER (readcharfun)->bytepos = bytepos;
313 XMARKER (readcharfun)->charpos++;
315 return c;
318 if (EQ (readcharfun, Qlambda))
319 return read_bytecode_char (0);
321 if (EQ (readcharfun, Qget_file_char))
323 c = getc (instream);
324 #ifdef EINTR
325 /* Interrupted reads have been observed while reading over the network */
326 while (c == EOF && ferror (instream) && errno == EINTR)
328 QUIT;
329 clearerr (instream);
330 c = getc (instream);
332 #endif
333 return c;
336 if (STRINGP (readcharfun))
338 if (read_from_string_index >= read_from_string_limit)
339 c = -1;
340 else
341 FETCH_STRING_CHAR_ADVANCE (c, readcharfun,
342 read_from_string_index,
343 read_from_string_index_byte);
345 return c;
348 tem = call0 (readcharfun);
350 if (NILP (tem))
351 return -1;
352 return XINT (tem);
355 /* Unread the character C in the way appropriate for the stream READCHARFUN.
356 If the stream is a user function, call it with the char as argument. */
358 static void
359 unreadchar (readcharfun, c)
360 Lisp_Object readcharfun;
361 int c;
363 readchar_count--;
364 if (c == -1)
365 /* Don't back up the pointer if we're unreading the end-of-input mark,
366 since readchar didn't advance it when we read it. */
368 else if (BUFFERP (readcharfun))
370 struct buffer *b = XBUFFER (readcharfun);
371 int bytepos = BUF_PT_BYTE (b);
373 if (readchar_backlog >= 0)
374 readchar_backlog++;
375 else
377 BUF_PT (b)--;
378 if (! NILP (b->enable_multibyte_characters))
379 BUF_DEC_POS (b, bytepos);
380 else
381 bytepos--;
383 BUF_PT_BYTE (b) = bytepos;
386 else if (MARKERP (readcharfun))
388 struct buffer *b = XMARKER (readcharfun)->buffer;
389 int bytepos = XMARKER (readcharfun)->bytepos;
391 if (readchar_backlog >= 0)
392 readchar_backlog++;
393 else
395 XMARKER (readcharfun)->charpos--;
396 if (! NILP (b->enable_multibyte_characters))
397 BUF_DEC_POS (b, bytepos);
398 else
399 bytepos--;
401 XMARKER (readcharfun)->bytepos = bytepos;
404 else if (STRINGP (readcharfun))
406 read_from_string_index--;
407 read_from_string_index_byte
408 = string_char_to_byte (readcharfun, read_from_string_index);
410 else if (EQ (readcharfun, Qlambda))
411 read_bytecode_char (1);
412 else if (EQ (readcharfun, Qget_file_char))
413 ungetc (c, instream);
414 else
415 call1 (readcharfun, make_number (c));
418 static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
419 Lisp_Object));
420 static Lisp_Object read0 P_ ((Lisp_Object));
421 static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
423 static Lisp_Object read_list P_ ((int, Lisp_Object));
424 static Lisp_Object read_vector P_ ((Lisp_Object, int));
425 static int read_multibyte P_ ((int, Lisp_Object));
427 static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
428 Lisp_Object));
429 static void substitute_object_in_subtree P_ ((Lisp_Object,
430 Lisp_Object));
431 static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
434 /* Get a character from the tty. */
436 extern Lisp_Object read_char ();
438 /* Read input events until we get one that's acceptable for our purposes.
440 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
441 until we get a character we like, and then stuffed into
442 unread_switch_frame.
444 If ASCII_REQUIRED is non-zero, we check function key events to see
445 if the unmodified version of the symbol has a Qascii_character
446 property, and use that character, if present.
448 If ERROR_NONASCII is non-zero, we signal an error if the input we
449 get isn't an ASCII character with modifiers. If it's zero but
450 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
451 character.
453 If INPUT_METHOD is nonzero, we invoke the current input method
454 if the character warrants that. */
456 Lisp_Object
457 read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
458 input_method)
459 int no_switch_frame, ascii_required, error_nonascii, input_method;
461 register Lisp_Object val, delayed_switch_frame;
463 #ifdef HAVE_WINDOW_SYSTEM
464 if (display_hourglass_p)
465 cancel_hourglass ();
466 #endif
468 delayed_switch_frame = Qnil;
470 /* Read until we get an acceptable event. */
471 retry:
472 val = read_char (0, 0, 0,
473 (input_method ? Qnil : Qt),
476 if (BUFFERP (val))
477 goto retry;
479 /* switch-frame events are put off until after the next ASCII
480 character. This is better than signaling an error just because
481 the last characters were typed to a separate minibuffer frame,
482 for example. Eventually, some code which can deal with
483 switch-frame events will read it and process it. */
484 if (no_switch_frame
485 && EVENT_HAS_PARAMETERS (val)
486 && EQ (EVENT_HEAD (val), Qswitch_frame))
488 delayed_switch_frame = val;
489 goto retry;
492 if (ascii_required)
494 /* Convert certain symbols to their ASCII equivalents. */
495 if (SYMBOLP (val))
497 Lisp_Object tem, tem1;
498 tem = Fget (val, Qevent_symbol_element_mask);
499 if (!NILP (tem))
501 tem1 = Fget (Fcar (tem), Qascii_character);
502 /* Merge this symbol's modifier bits
503 with the ASCII equivalent of its basic code. */
504 if (!NILP (tem1))
505 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
509 /* If we don't have a character now, deal with it appropriately. */
510 if (!INTEGERP (val))
512 if (error_nonascii)
514 Vunread_command_events = Fcons (val, Qnil);
515 error ("Non-character input-event");
517 else
518 goto retry;
522 if (! NILP (delayed_switch_frame))
523 unread_switch_frame = delayed_switch_frame;
525 #if 0
527 #ifdef HAVE_WINDOW_SYSTEM
528 if (display_hourglass_p)
529 start_hourglass ();
530 #endif
532 #endif
534 return val;
537 DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0,
538 doc: /* Read a character from the command input (keyboard or macro).
539 It is returned as a number.
540 If the user generates an event which is not a character (i.e. a mouse
541 click or function key event), `read-char' signals an error. As an
542 exception, switch-frame events are put off until non-ASCII events can
543 be read.
544 If you want to read non-character events, or ignore them, call
545 `read-event' or `read-char-exclusive' instead.
547 If the optional argument PROMPT is non-nil, display that as a prompt.
548 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
549 input method is turned on in the current buffer, that input method
550 is used for reading a character. */)
551 (prompt, inherit_input_method)
552 Lisp_Object prompt, inherit_input_method;
554 if (! NILP (prompt))
555 message_with_string ("%s", prompt, 0);
556 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method));
559 DEFUN ("read-event", Fread_event, Sread_event, 0, 2, 0,
560 doc: /* Read an event object from the input stream.
561 If the optional argument PROMPT is non-nil, display that as a prompt.
562 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
563 input method is turned on in the current buffer, that input method
564 is used for reading a character. */)
565 (prompt, inherit_input_method)
566 Lisp_Object prompt, inherit_input_method;
568 if (! NILP (prompt))
569 message_with_string ("%s", prompt, 0);
570 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method));
573 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 2, 0,
574 doc: /* Read a character from the command input (keyboard or macro).
575 It is returned as a number. Non-character events are ignored.
577 If the optional argument PROMPT is non-nil, display that as a prompt.
578 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
579 input method is turned on in the current buffer, that input method
580 is used for reading a character. */)
581 (prompt, inherit_input_method)
582 Lisp_Object prompt, inherit_input_method;
584 if (! NILP (prompt))
585 message_with_string ("%s", prompt, 0);
586 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method));
589 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
590 doc: /* Don't use this yourself. */)
593 register Lisp_Object val;
594 XSETINT (val, getc (instream));
595 return val;
600 /* Value is non-zero if the file asswociated with file descriptor FD
601 is a compiled Lisp file that's safe to load. Only files compiled
602 with Emacs are safe to load. Files compiled with XEmacs can lead
603 to a crash in Fbyte_code because of an incompatible change in the
604 byte compiler. */
606 static int
607 safe_to_load_p (fd)
608 int fd;
610 char buf[512];
611 int nbytes, i;
612 int safe_p = 1;
614 /* Read the first few bytes from the file, and look for a line
615 specifying the byte compiler version used. */
616 nbytes = emacs_read (fd, buf, sizeof buf - 1);
617 if (nbytes > 0)
619 buf[nbytes] = '\0';
621 /* Skip to the next newline, skipping over the initial `ELC'
622 with NUL bytes following it. */
623 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
626 if (i < nbytes
627 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
628 buf + i) < 0)
629 safe_p = 0;
632 lseek (fd, 0, SEEK_SET);
633 return safe_p;
637 /* Callback for record_unwind_protect. Restore the old load list OLD,
638 after loading a file successfully. */
640 static Lisp_Object
641 record_load_unwind (old)
642 Lisp_Object old;
644 return Vloads_in_progress = old;
647 /* This handler function is used via internal_condition_case_1. */
649 static Lisp_Object
650 load_error_handler (data)
651 Lisp_Object data;
653 return Qnil;
656 DEFUN ("load", Fload, Sload, 1, 5, 0,
657 doc: /* Execute a file of Lisp code named FILE.
658 First try FILE with `.elc' appended, then try with `.el',
659 then try FILE unmodified (the exact suffixes are determined by
660 `load-suffixes'). Environment variable references in FILE
661 are replaced with their values by calling `substitute-in-file-name'.
662 This function searches the directories in `load-path'.
663 If optional second arg NOERROR is non-nil,
664 report no error if FILE doesn't exist.
665 Print messages at start and end of loading unless
666 optional third arg NOMESSAGE is non-nil.
667 If optional fourth arg NOSUFFIX is non-nil, don't try adding
668 suffixes `.elc' or `.el' to the specified name FILE.
669 If optional fifth arg MUST-SUFFIX is non-nil, insist on
670 the suffix `.elc' or `.el'; don't accept just FILE unless
671 it ends in one of those suffixes or includes a directory name.
673 Loading a file records its definitions, and its `provide' and
674 `require' calls, in an element of `load-history' whose
675 car is the file name loaded. See `load-history'.
677 Return t if file exists. */)
678 (file, noerror, nomessage, nosuffix, must_suffix)
679 Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
681 register FILE *stream;
682 register int fd = -1;
683 int count = SPECPDL_INDEX ();
684 Lisp_Object temp;
685 struct gcpro gcpro1, gcpro2;
686 Lisp_Object found, efound;
687 /* 1 means we printed the ".el is newer" message. */
688 int newer = 0;
689 /* 1 means we are loading a compiled file. */
690 int compiled = 0;
691 Lisp_Object handler;
692 int safe_p = 1;
693 char *fmode = "r";
694 #ifdef DOS_NT
695 fmode = "rt";
696 #endif /* DOS_NT */
698 CHECK_STRING (file);
700 /* If file name is magic, call the handler. */
701 /* This shouldn't be necessary any more now that `openp' handles it right.
702 handler = Ffind_file_name_handler (file, Qload);
703 if (!NILP (handler))
704 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
706 /* Do this after the handler to avoid
707 the need to gcpro noerror, nomessage and nosuffix.
708 (Below here, we care only whether they are nil or not.)
709 The presence of this call is the result of a historical accident:
710 it used to be in every file-operations and when it got removed
711 everywhere, it accidentally stayed here. Since then, enough people
712 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
713 that it seemed risky to remove. */
714 if (! NILP (noerror))
716 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
717 Qt, load_error_handler);
718 if (NILP (file))
719 return Qnil;
721 else
722 file = Fsubstitute_in_file_name (file);
725 /* Avoid weird lossage with null string as arg,
726 since it would try to load a directory as a Lisp file */
727 if (SCHARS (file) > 0)
729 int size = SBYTES (file);
730 Lisp_Object tmp[2];
732 found = Qnil;
733 GCPRO2 (file, found);
735 if (! NILP (must_suffix))
737 /* Don't insist on adding a suffix if FILE already ends with one. */
738 if (size > 3
739 && !strcmp (SDATA (file) + size - 3, ".el"))
740 must_suffix = Qnil;
741 else if (size > 4
742 && !strcmp (SDATA (file) + size - 4, ".elc"))
743 must_suffix = Qnil;
744 /* Don't insist on adding a suffix
745 if the argument includes a directory name. */
746 else if (! NILP (Ffile_name_directory (file)))
747 must_suffix = Qnil;
750 fd = openp (Vload_path, file,
751 (!NILP (nosuffix) ? Qnil
752 : !NILP (must_suffix) ? Vload_suffixes
753 : Fappend (2, (tmp[0] = Vload_suffixes,
754 tmp[1] = default_suffixes,
755 tmp))),
756 &found, Qnil);
757 UNGCPRO;
760 if (fd == -1)
762 if (NILP (noerror))
763 Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
764 Fcons (file, Qnil)));
765 else
766 return Qnil;
769 /* Tell startup.el whether or not we found the user's init file. */
770 if (EQ (Qt, Vuser_init_file))
771 Vuser_init_file = found;
773 /* If FD is -2, that means openp found a magic file. */
774 if (fd == -2)
776 if (NILP (Fequal (found, file)))
777 /* If FOUND is a different file name from FILE,
778 find its handler even if we have already inhibited
779 the `load' operation on FILE. */
780 handler = Ffind_file_name_handler (found, Qt);
781 else
782 handler = Ffind_file_name_handler (found, Qload);
783 if (! NILP (handler))
784 return call5 (handler, Qload, found, noerror, nomessage, Qt);
787 /* Check if we're stuck in a recursive load cycle.
789 2000-09-21: It's not possible to just check for the file loaded
790 being a member of Vloads_in_progress. This fails because of the
791 way the byte compiler currently works; `provide's are not
792 evaluted, see font-lock.el/jit-lock.el as an example. This
793 leads to a certain amount of ``normal'' recursion.
795 Also, just loading a file recursively is not always an error in
796 the general case; the second load may do something different. */
798 int count = 0;
799 Lisp_Object tem;
800 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
801 if (!NILP (Fequal (found, XCAR (tem))))
802 count++;
803 if (count > 3)
804 Fsignal (Qerror, Fcons (build_string ("Recursive load"),
805 Fcons (found, Vloads_in_progress)));
806 record_unwind_protect (record_load_unwind, Vloads_in_progress);
807 Vloads_in_progress = Fcons (found, Vloads_in_progress);
810 if (!bcmp (SDATA (found) + SBYTES (found) - 4,
811 ".elc", 4))
812 /* Load .elc files directly, but not when they are
813 remote and have no handler! */
815 if (fd != -2)
817 struct stat s1, s2;
818 int result;
820 GCPRO2 (file, found);
822 if (!safe_to_load_p (fd))
824 safe_p = 0;
825 if (!load_dangerous_libraries)
827 if (fd >= 0)
828 emacs_close (fd);
829 error ("File `%s' was not compiled in Emacs",
830 SDATA (found));
832 else if (!NILP (nomessage))
833 message_with_string ("File `%s' not compiled in Emacs", found, 1);
836 compiled = 1;
838 efound = ENCODE_FILE (found);
840 #ifdef DOS_NT
841 fmode = "rb";
842 #endif /* DOS_NT */
843 stat ((char *)SDATA (efound), &s1);
844 SSET (efound, SBYTES (efound) - 1, 0);
845 result = stat ((char *)SDATA (efound), &s2);
846 SSET (efound, SBYTES (efound) - 1, 'c');
848 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
850 /* Make the progress messages mention that source is newer. */
851 newer = 1;
853 /* If we won't print another message, mention this anyway. */
854 if (!NILP (nomessage))
856 Lisp_Object msg_file;
857 msg_file = Fsubstring (found, make_number (0), make_number (-1));
858 message_with_string ("Source file `%s' newer than byte-compiled file",
859 msg_file, 1);
862 UNGCPRO;
865 else
867 /* We are loading a source file (*.el). */
868 if (!NILP (Vload_source_file_function))
870 Lisp_Object val;
872 if (fd >= 0)
873 emacs_close (fd);
874 val = call4 (Vload_source_file_function, found, file,
875 NILP (noerror) ? Qnil : Qt,
876 NILP (nomessage) ? Qnil : Qt);
877 return unbind_to (count, val);
881 GCPRO2 (file, found);
883 #ifdef WINDOWSNT
884 emacs_close (fd);
885 efound = ENCODE_FILE (found);
886 stream = fopen ((char *) SDATA (efound), fmode);
887 #else /* not WINDOWSNT */
888 stream = fdopen (fd, fmode);
889 #endif /* not WINDOWSNT */
890 if (stream == 0)
892 emacs_close (fd);
893 error ("Failure to create stdio stream for %s", SDATA (file));
896 if (! NILP (Vpurify_flag))
897 Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
899 if (NILP (nomessage))
901 if (!safe_p)
902 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
903 file, 1);
904 else if (!compiled)
905 message_with_string ("Loading %s (source)...", file, 1);
906 else if (newer)
907 message_with_string ("Loading %s (compiled; note, source file is newer)...",
908 file, 1);
909 else /* The typical case; compiled file newer than source file. */
910 message_with_string ("Loading %s...", file, 1);
913 record_unwind_protect (load_unwind, make_save_value (stream, 0));
914 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
915 specbind (Qload_file_name, found);
916 specbind (Qinhibit_file_name_operation, Qnil);
917 load_descriptor_list
918 = Fcons (make_number (fileno (stream)), load_descriptor_list);
919 load_in_progress++;
920 readevalloop (Qget_file_char, stream, (! NILP (Vpurify_flag) ? file : found),
921 Feval, 0, Qnil, Qnil, Qnil, Qnil);
922 unbind_to (count, Qnil);
924 /* Run any load-hooks for this file. */
925 temp = Fassoc (file, Vafter_load_alist);
926 if (!NILP (temp))
927 Fprogn (Fcdr (temp));
928 UNGCPRO;
930 if (saved_doc_string)
931 free (saved_doc_string);
932 saved_doc_string = 0;
933 saved_doc_string_size = 0;
935 if (prev_saved_doc_string)
936 xfree (prev_saved_doc_string);
937 prev_saved_doc_string = 0;
938 prev_saved_doc_string_size = 0;
940 if (!noninteractive && NILP (nomessage))
942 if (!safe_p)
943 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
944 file, 1);
945 else if (!compiled)
946 message_with_string ("Loading %s (source)...done", file, 1);
947 else if (newer)
948 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
949 file, 1);
950 else /* The typical case; compiled file newer than source file. */
951 message_with_string ("Loading %s...done", file, 1);
954 if (!NILP (Fequal (build_string ("obsolete"),
955 Ffile_name_nondirectory
956 (Fdirectory_file_name (Ffile_name_directory (found))))))
957 message_with_string ("Package %s is obsolete", file, 1);
959 return Qt;
962 static Lisp_Object
963 load_unwind (arg) /* used as unwind-protect function in load */
964 Lisp_Object arg;
966 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
967 if (stream != NULL)
968 fclose (stream);
969 if (--load_in_progress < 0) load_in_progress = 0;
970 return Qnil;
973 static Lisp_Object
974 load_descriptor_unwind (oldlist)
975 Lisp_Object oldlist;
977 load_descriptor_list = oldlist;
978 return Qnil;
981 /* Close all descriptors in use for Floads.
982 This is used when starting a subprocess. */
984 void
985 close_load_descs ()
987 #ifndef WINDOWSNT
988 Lisp_Object tail;
989 for (tail = load_descriptor_list; !NILP (tail); tail = XCDR (tail))
990 emacs_close (XFASTINT (XCAR (tail)));
991 #endif
994 static int
995 complete_filename_p (pathname)
996 Lisp_Object pathname;
998 register const unsigned char *s = SDATA (pathname);
999 return (IS_DIRECTORY_SEP (s[0])
1000 || (SCHARS (pathname) > 2
1001 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
1002 #ifdef ALTOS
1003 || *s == '@'
1004 #endif
1005 #ifdef VMS
1006 || index (s, ':')
1007 #endif /* VMS */
1011 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1012 doc: /* Search for FILENAME through PATH.
1013 Returns the file's name in absolute form, or nil if not found.
1014 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1015 file name when searching.
1016 If non-nil, PREDICATE is used instead of `file-readable-p'.
1017 PREDICATE can also be an integer to pass to the access(2) function,
1018 in which case file-name-handlers are ignored. */)
1019 (filename, path, suffixes, predicate)
1020 Lisp_Object filename, path, suffixes, predicate;
1022 Lisp_Object file;
1023 int fd = openp (path, filename, suffixes, &file, predicate);
1024 if (NILP (predicate) && fd > 0)
1025 close (fd);
1026 return file;
1030 /* Search for a file whose name is STR, looking in directories
1031 in the Lisp list PATH, and trying suffixes from SUFFIX.
1032 On success, returns a file descriptor. On failure, returns -1.
1034 SUFFIXES is a list of strings containing possible suffixes.
1035 The empty suffix is automatically added iff the list is empty.
1037 PREDICATE non-nil means don't open the files,
1038 just look for one that satisfies the predicate. In this case,
1039 returns 1 on success. The predicate can be a lisp function or
1040 an integer to pass to `access' (in which case file-name-handlers
1041 are ignored).
1043 If STOREPTR is nonzero, it points to a slot where the name of
1044 the file actually found should be stored as a Lisp string.
1045 nil is stored there on failure.
1047 If the file we find is remote, return -2
1048 but store the found remote file name in *STOREPTR. */
1051 openp (path, str, suffixes, storeptr, predicate)
1052 Lisp_Object path, str;
1053 Lisp_Object suffixes;
1054 Lisp_Object *storeptr;
1055 Lisp_Object predicate;
1057 register int fd;
1058 int fn_size = 100;
1059 char buf[100];
1060 register char *fn = buf;
1061 int absolute = 0;
1062 int want_size;
1063 Lisp_Object filename;
1064 struct stat st;
1065 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1066 Lisp_Object string, tail, encoded_fn;
1067 int max_suffix_len = 0;
1069 CHECK_STRING (str);
1071 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1073 CHECK_STRING_CAR (tail);
1074 max_suffix_len = max (max_suffix_len,
1075 SBYTES (XCAR (tail)));
1078 string = filename = Qnil;
1079 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1081 if (storeptr)
1082 *storeptr = Qnil;
1084 if (complete_filename_p (str))
1085 absolute = 1;
1087 for (; CONSP (path); path = XCDR (path))
1089 filename = Fexpand_file_name (str, XCAR (path));
1090 if (!complete_filename_p (filename))
1091 /* If there are non-absolute elts in PATH (eg ".") */
1092 /* Of course, this could conceivably lose if luser sets
1093 default-directory to be something non-absolute... */
1095 filename = Fexpand_file_name (filename, current_buffer->directory);
1096 if (!complete_filename_p (filename))
1097 /* Give up on this path element! */
1098 continue;
1101 /* Calculate maximum size of any filename made from
1102 this path element/specified file name and any possible suffix. */
1103 want_size = max_suffix_len + SBYTES (filename) + 1;
1104 if (fn_size < want_size)
1105 fn = (char *) alloca (fn_size = 100 + want_size);
1107 /* Loop over suffixes. */
1108 for (tail = NILP (suffixes) ? default_suffixes : suffixes;
1109 CONSP (tail); tail = XCDR (tail))
1111 int lsuffix = SBYTES (XCAR (tail));
1112 Lisp_Object handler;
1113 int exists;
1115 /* Concatenate path element/specified name with the suffix.
1116 If the directory starts with /:, remove that. */
1117 if (SCHARS (filename) > 2
1118 && SREF (filename, 0) == '/'
1119 && SREF (filename, 1) == ':')
1121 strncpy (fn, SDATA (filename) + 2,
1122 SBYTES (filename) - 2);
1123 fn[SBYTES (filename) - 2] = 0;
1125 else
1127 strncpy (fn, SDATA (filename),
1128 SBYTES (filename));
1129 fn[SBYTES (filename)] = 0;
1132 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
1133 strncat (fn, SDATA (XCAR (tail)), lsuffix);
1135 /* Check that the file exists and is not a directory. */
1136 /* We used to only check for handlers on non-absolute file names:
1137 if (absolute)
1138 handler = Qnil;
1139 else
1140 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1141 It's not clear why that was the case and it breaks things like
1142 (load "/bar.el") where the file is actually "/bar.el.gz". */
1143 string = build_string (fn);
1144 handler = Ffind_file_name_handler (string, Qfile_exists_p);
1145 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1147 if (NILP (predicate))
1148 exists = !NILP (Ffile_readable_p (string));
1149 else
1150 exists = !NILP (call1 (predicate, string));
1151 if (exists && !NILP (Ffile_directory_p (string)))
1152 exists = 0;
1154 if (exists)
1156 /* We succeeded; return this descriptor and filename. */
1157 if (storeptr)
1158 *storeptr = string;
1159 UNGCPRO;
1160 return -2;
1163 else
1165 const char *pfn;
1167 encoded_fn = ENCODE_FILE (string);
1168 pfn = SDATA (encoded_fn);
1169 exists = (stat (pfn, &st) >= 0
1170 && (st.st_mode & S_IFMT) != S_IFDIR);
1171 if (exists)
1173 /* Check that we can access or open it. */
1174 if (NATNUMP (predicate))
1175 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
1176 else
1177 fd = emacs_open (pfn, O_RDONLY, 0);
1179 if (fd >= 0)
1181 /* We succeeded; return this descriptor and filename. */
1182 if (storeptr)
1183 *storeptr = string;
1184 UNGCPRO;
1185 return fd;
1190 if (absolute)
1191 break;
1194 UNGCPRO;
1195 return -1;
1199 /* Merge the list we've accumulated of globals from the current input source
1200 into the load_history variable. The details depend on whether
1201 the source has an associated file name or not.
1203 FILENAME is the file name that we are loading from.
1204 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1206 static void
1207 build_load_history (filename, entire)
1208 Lisp_Object filename;
1209 int entire;
1211 register Lisp_Object tail, prev, newelt;
1212 register Lisp_Object tem, tem2;
1213 register int foundit = 0;
1215 tail = Vload_history;
1216 prev = Qnil;
1218 while (CONSP (tail))
1220 tem = XCAR (tail);
1222 /* Find the feature's previous assoc list... */
1223 if (!NILP (Fequal (filename, Fcar (tem))))
1225 foundit = 1;
1227 /* If we're loading the entire file, remove old data. */
1228 if (entire)
1230 if (NILP (prev))
1231 Vload_history = XCDR (tail);
1232 else
1233 Fsetcdr (prev, XCDR (tail));
1236 /* Otherwise, cons on new symbols that are not already members. */
1237 else
1239 tem2 = Vcurrent_load_list;
1241 while (CONSP (tem2))
1243 newelt = XCAR (tem2);
1245 if (NILP (Fmember (newelt, tem)))
1246 Fsetcar (tail, Fcons (XCAR (tem),
1247 Fcons (newelt, XCDR (tem))));
1249 tem2 = XCDR (tem2);
1250 QUIT;
1254 else
1255 prev = tail;
1256 tail = XCDR (tail);
1257 QUIT;
1260 /* If we're loading an entire file, cons the new assoc onto the
1261 front of load-history, the most-recently-loaded position. Also
1262 do this if we didn't find an existing member for the file. */
1263 if (entire || !foundit)
1264 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1265 Vload_history);
1268 Lisp_Object
1269 unreadpure (junk) /* Used as unwind-protect function in readevalloop */
1270 Lisp_Object junk;
1272 read_pure = 0;
1273 return Qnil;
1276 static Lisp_Object
1277 readevalloop_1 (old)
1278 Lisp_Object old;
1280 load_convert_to_unibyte = ! NILP (old);
1281 return Qnil;
1284 /* Signal an `end-of-file' error, if possible with file name
1285 information. */
1287 static void
1288 end_of_file_error ()
1290 Lisp_Object data;
1292 if (STRINGP (Vload_file_name))
1293 data = Fcons (Vload_file_name, Qnil);
1294 else
1295 data = Qnil;
1297 Fsignal (Qend_of_file, data);
1300 /* UNIBYTE specifies how to set load_convert_to_unibyte
1301 for this invocation.
1302 READFUN, if non-nil, is used instead of `read'.
1303 START, END is region in current buffer (from eval-region). */
1305 static void
1306 readevalloop (readcharfun, stream, sourcename, evalfun,
1307 printflag, unibyte, readfun, start, end)
1308 Lisp_Object readcharfun;
1309 FILE *stream;
1310 Lisp_Object sourcename;
1311 Lisp_Object (*evalfun) ();
1312 int printflag;
1313 Lisp_Object unibyte, readfun;
1314 Lisp_Object start, end;
1316 register int c;
1317 register Lisp_Object val;
1318 int count = SPECPDL_INDEX ();
1319 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1320 struct buffer *b = 0;
1321 int bpos;
1322 int continue_reading_p;
1323 /* Nonzero if reading an entire buffer. */
1324 int whole_buffer = 0;
1325 /* 1 on the first time around. */
1326 int first_sexp = 1;
1328 if (MARKERP (readcharfun))
1330 if (NILP (start))
1331 start = readcharfun;
1334 if (BUFFERP (readcharfun))
1335 b = XBUFFER (readcharfun);
1336 else if (MARKERP (readcharfun))
1337 b = XMARKER (readcharfun)->buffer;
1339 specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
1340 specbind (Qcurrent_load_list, Qnil);
1341 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1342 load_convert_to_unibyte = !NILP (unibyte);
1344 readchar_backlog = -1;
1346 GCPRO4 (sourcename, readfun, start, end);
1348 LOADHIST_ATTACH (sourcename);
1350 continue_reading_p = 1;
1351 while (continue_reading_p)
1353 int count1 = SPECPDL_INDEX ();
1355 if (b != 0 && NILP (b->name))
1356 error ("Reading from killed buffer");
1358 if (!NILP (start))
1360 /* Switch to the buffer we are reading from. */
1361 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1362 set_buffer_internal (b);
1364 /* Save point in it. */
1365 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1366 /* Save ZV in it. */
1367 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1368 /* Those get unbound after we read one expression. */
1370 /* Set point and ZV around stuff to be read. */
1371 Fgoto_char (start);
1372 if (!NILP (end))
1373 Fnarrow_to_region (make_number (BEGV), end);
1375 /* Just for cleanliness, convert END to a marker
1376 if it is an integer. */
1377 if (INTEGERP (end))
1378 end = Fpoint_max_marker ();
1381 /* On the first cycle, we can easily test here
1382 whether we are reading the whole buffer. */
1383 if (b && first_sexp)
1384 whole_buffer = (PT == BEG && ZV == Z);
1386 instream = stream;
1387 read_next:
1388 c = READCHAR;
1389 if (c == ';')
1391 while ((c = READCHAR) != '\n' && c != -1);
1392 goto read_next;
1394 if (c < 0)
1396 unbind_to (count1, Qnil);
1397 break;
1400 /* Ignore whitespace here, so we can detect eof. */
1401 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1402 goto read_next;
1404 if (!NILP (Vpurify_flag) && c == '(')
1406 record_unwind_protect (unreadpure, Qnil);
1407 val = read_list (-1, readcharfun);
1409 else
1411 UNREAD (c);
1412 read_objects = Qnil;
1413 if (!NILP (readfun))
1415 val = call1 (readfun, readcharfun);
1417 /* If READCHARFUN has set point to ZV, we should
1418 stop reading, even if the form read sets point
1419 to a different value when evaluated. */
1420 if (BUFFERP (readcharfun))
1422 struct buffer *b = XBUFFER (readcharfun);
1423 if (BUF_PT (b) == BUF_ZV (b))
1424 continue_reading_p = 0;
1427 else if (! NILP (Vload_read_function))
1428 val = call1 (Vload_read_function, readcharfun);
1429 else
1430 val = read_internal_start (readcharfun, Qnil, Qnil);
1433 if (!NILP (start) && continue_reading_p)
1434 start = Fpoint_marker ();
1436 /* Restore saved point and BEGV. */
1437 unbind_to (count1, Qnil);
1439 /* Now eval what we just read. */
1440 val = (*evalfun) (val);
1442 if (printflag)
1444 Vvalues = Fcons (val, Vvalues);
1445 if (EQ (Vstandard_output, Qt))
1446 Fprin1 (val, Qnil);
1447 else
1448 Fprint (val, Qnil);
1451 first_sexp = 0;
1454 build_load_history (sourcename,
1455 stream || whole_buffer);
1457 UNGCPRO;
1459 unbind_to (count, Qnil);
1462 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
1463 doc: /* Execute the current buffer as Lisp code.
1464 Programs can pass two arguments, BUFFER and PRINTFLAG.
1465 BUFFER is the buffer to evaluate (nil means use current buffer).
1466 PRINTFLAG controls printing of output:
1467 nil means discard it; anything else is stream for print.
1469 If the optional third argument FILENAME is non-nil,
1470 it specifies the file name to use for `load-history'.
1471 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1472 for this invocation.
1474 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1475 `print' and related functions should work normally even if PRINTFLAG is nil.
1477 This function preserves the position of point. */)
1478 (buffer, printflag, filename, unibyte, do_allow_print)
1479 Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
1481 int count = SPECPDL_INDEX ();
1482 Lisp_Object tem, buf;
1484 if (NILP (buffer))
1485 buf = Fcurrent_buffer ();
1486 else
1487 buf = Fget_buffer (buffer);
1488 if (NILP (buf))
1489 error ("No such buffer");
1491 if (NILP (printflag) && NILP (do_allow_print))
1492 tem = Qsymbolp;
1493 else
1494 tem = printflag;
1496 if (NILP (filename))
1497 filename = XBUFFER (buf)->filename;
1499 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
1500 specbind (Qstandard_output, tem);
1501 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1502 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1503 readevalloop (buf, 0, filename, Feval,
1504 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
1505 unbind_to (count, Qnil);
1507 return Qnil;
1510 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
1511 doc: /* Execute the region as Lisp code.
1512 When called from programs, expects two arguments,
1513 giving starting and ending indices in the current buffer
1514 of the text to be executed.
1515 Programs can pass third argument PRINTFLAG which controls output:
1516 nil means discard it; anything else is stream for printing it.
1517 Also the fourth argument READ-FUNCTION, if non-nil, is used
1518 instead of `read' to read each expression. It gets one argument
1519 which is the input stream for reading characters.
1521 This function does not move point. */)
1522 (start, end, printflag, read_function)
1523 Lisp_Object start, end, printflag, read_function;
1525 int count = SPECPDL_INDEX ();
1526 Lisp_Object tem, cbuf;
1528 cbuf = Fcurrent_buffer ();
1530 if (NILP (printflag))
1531 tem = Qsymbolp;
1532 else
1533 tem = printflag;
1534 specbind (Qstandard_output, tem);
1535 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
1537 /* readevalloop calls functions which check the type of start and end. */
1538 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
1539 !NILP (printflag), Qnil, read_function,
1540 start, end);
1542 return unbind_to (count, Qnil);
1546 DEFUN ("read", Fread, Sread, 0, 1, 0,
1547 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1548 If STREAM is nil, use the value of `standard-input' (which see).
1549 STREAM or the value of `standard-input' may be:
1550 a buffer (read from point and advance it)
1551 a marker (read from where it points and advance it)
1552 a function (call it with no arguments for each character,
1553 call it with a char as argument to push a char back)
1554 a string (takes text from string, starting at the beginning)
1555 t (read text line using minibuffer and use it, or read from
1556 standard input in batch mode). */)
1557 (stream)
1558 Lisp_Object stream;
1560 if (NILP (stream))
1561 stream = Vstandard_input;
1562 if (EQ (stream, Qt))
1563 stream = Qread_char;
1564 if (EQ (stream, Qread_char))
1565 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
1567 return read_internal_start (stream, Qnil, Qnil);
1570 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
1571 doc: /* Read one Lisp expression which is represented as text by STRING.
1572 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1573 START and END optionally delimit a substring of STRING from which to read;
1574 they default to 0 and (length STRING) respectively. */)
1575 (string, start, end)
1576 Lisp_Object string, start, end;
1578 Lisp_Object ret;
1579 CHECK_STRING (string);
1580 /* read_internal_start sets read_from_string_index. */
1581 ret = read_internal_start (string, start, end);
1582 return Fcons (ret, make_number (read_from_string_index));
1585 /* Function to set up the global context we need in toplevel read
1586 calls. */
1587 static Lisp_Object
1588 read_internal_start (stream, start, end)
1589 Lisp_Object stream;
1590 Lisp_Object start; /* Only used when stream is a string. */
1591 Lisp_Object end; /* Only used when stream is a string. */
1593 Lisp_Object retval;
1595 readchar_backlog = -1;
1596 readchar_count = 0;
1597 new_backquote_flag = 0;
1598 read_objects = Qnil;
1599 if (EQ (Vread_with_symbol_positions, Qt)
1600 || EQ (Vread_with_symbol_positions, stream))
1601 Vread_symbol_positions_list = Qnil;
1603 if (STRINGP (stream))
1605 int startval, endval;
1606 if (NILP (end))
1607 endval = SCHARS (stream);
1608 else
1610 CHECK_NUMBER (end);
1611 endval = XINT (end);
1612 if (endval < 0 || endval > SCHARS (stream))
1613 args_out_of_range (stream, end);
1616 if (NILP (start))
1617 startval = 0;
1618 else
1620 CHECK_NUMBER (start);
1621 startval = XINT (start);
1622 if (startval < 0 || startval > endval)
1623 args_out_of_range (stream, start);
1625 read_from_string_index = startval;
1626 read_from_string_index_byte = string_char_to_byte (stream, startval);
1627 read_from_string_limit = endval;
1630 retval = read0 (stream);
1631 if (EQ (Vread_with_symbol_positions, Qt)
1632 || EQ (Vread_with_symbol_positions, stream))
1633 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
1634 return retval;
1637 /* Use this for recursive reads, in contexts where internal tokens
1638 are not allowed. */
1640 static Lisp_Object
1641 read0 (readcharfun)
1642 Lisp_Object readcharfun;
1644 register Lisp_Object val;
1645 int c;
1647 val = read1 (readcharfun, &c, 0);
1648 if (c)
1649 Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1),
1650 make_number (c)),
1651 Qnil));
1653 return val;
1656 static int read_buffer_size;
1657 static char *read_buffer;
1659 /* Read multibyte form and return it as a character. C is a first
1660 byte of multibyte form, and rest of them are read from
1661 READCHARFUN. */
1663 static int
1664 read_multibyte (c, readcharfun)
1665 register int c;
1666 Lisp_Object readcharfun;
1668 /* We need the actual character code of this multibyte
1669 characters. */
1670 unsigned char str[MAX_MULTIBYTE_LENGTH];
1671 int len = 0;
1672 int bytes;
1674 if (c < 0)
1675 return c;
1677 str[len++] = c;
1678 while ((c = READCHAR) >= 0xA0
1679 && len < MAX_MULTIBYTE_LENGTH)
1681 str[len++] = c;
1682 readchar_count--;
1684 UNREAD (c);
1685 if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))
1686 return STRING_CHAR (str, len);
1687 /* The byte sequence is not valid as multibyte. Unread all bytes
1688 but the first one, and return the first byte. */
1689 while (--len > 0)
1690 UNREAD (str[len]);
1691 return str[0];
1694 /* Read a \-escape sequence, assuming we already read the `\'.
1695 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1696 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1697 Otherwise store 0 into *BYTEREP. */
1699 static int
1700 read_escape (readcharfun, stringp, byterep)
1701 Lisp_Object readcharfun;
1702 int stringp;
1703 int *byterep;
1705 register int c = READCHAR;
1707 *byterep = 0;
1709 switch (c)
1711 case -1:
1712 end_of_file_error ();
1714 case 'a':
1715 return '\007';
1716 case 'b':
1717 return '\b';
1718 case 'd':
1719 return 0177;
1720 case 'e':
1721 return 033;
1722 case 'f':
1723 return '\f';
1724 case 'n':
1725 return '\n';
1726 case 'r':
1727 return '\r';
1728 case 't':
1729 return '\t';
1730 case 'v':
1731 return '\v';
1732 case '\n':
1733 return -1;
1734 case ' ':
1735 if (stringp)
1736 return -1;
1737 return ' ';
1739 case 'M':
1740 c = READCHAR;
1741 if (c != '-')
1742 error ("Invalid escape character syntax");
1743 c = READCHAR;
1744 if (c == '\\')
1745 c = read_escape (readcharfun, 0, byterep);
1746 return c | meta_modifier;
1748 case 'S':
1749 c = READCHAR;
1750 if (c != '-')
1751 error ("Invalid escape character syntax");
1752 c = READCHAR;
1753 if (c == '\\')
1754 c = read_escape (readcharfun, 0, byterep);
1755 return c | shift_modifier;
1757 case 'H':
1758 c = READCHAR;
1759 if (c != '-')
1760 error ("Invalid escape character syntax");
1761 c = READCHAR;
1762 if (c == '\\')
1763 c = read_escape (readcharfun, 0, byterep);
1764 return c | hyper_modifier;
1766 case 'A':
1767 c = READCHAR;
1768 if (c != '-')
1769 error ("Invalid escape character syntax");
1770 c = READCHAR;
1771 if (c == '\\')
1772 c = read_escape (readcharfun, 0, byterep);
1773 return c | alt_modifier;
1775 case 's':
1776 c = READCHAR;
1777 if (c != '-')
1779 UNREAD (c);
1780 return ' ';
1782 c = READCHAR;
1783 if (c == '\\')
1784 c = read_escape (readcharfun, 0, byterep);
1785 return c | super_modifier;
1787 case 'C':
1788 c = READCHAR;
1789 if (c != '-')
1790 error ("Invalid escape character syntax");
1791 case '^':
1792 c = READCHAR;
1793 if (c == '\\')
1794 c = read_escape (readcharfun, 0, byterep);
1795 if ((c & ~CHAR_MODIFIER_MASK) == '?')
1796 return 0177 | (c & CHAR_MODIFIER_MASK);
1797 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
1798 return c | ctrl_modifier;
1799 /* ASCII control chars are made from letters (both cases),
1800 as well as the non-letters within 0100...0137. */
1801 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
1802 return (c & (037 | ~0177));
1803 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
1804 return (c & (037 | ~0177));
1805 else
1806 return c | ctrl_modifier;
1808 case '0':
1809 case '1':
1810 case '2':
1811 case '3':
1812 case '4':
1813 case '5':
1814 case '6':
1815 case '7':
1816 /* An octal escape, as in ANSI C. */
1818 register int i = c - '0';
1819 register int count = 0;
1820 while (++count < 3)
1822 if ((c = READCHAR) >= '0' && c <= '7')
1824 i *= 8;
1825 i += c - '0';
1827 else
1829 UNREAD (c);
1830 break;
1834 *byterep = 1;
1835 return i;
1838 case 'x':
1839 /* A hex escape, as in ANSI C. */
1841 int i = 0;
1842 while (1)
1844 c = READCHAR;
1845 if (c >= '0' && c <= '9')
1847 i *= 16;
1848 i += c - '0';
1850 else if ((c >= 'a' && c <= 'f')
1851 || (c >= 'A' && c <= 'F'))
1853 i *= 16;
1854 if (c >= 'a' && c <= 'f')
1855 i += c - 'a' + 10;
1856 else
1857 i += c - 'A' + 10;
1859 else
1861 UNREAD (c);
1862 break;
1866 *byterep = 2;
1867 return i;
1870 default:
1871 if (BASE_LEADING_CODE_P (c))
1872 c = read_multibyte (c, readcharfun);
1873 return c;
1878 /* Read an integer in radix RADIX using READCHARFUN to read
1879 characters. RADIX must be in the interval [2..36]; if it isn't, a
1880 read error is signaled . Value is the integer read. Signals an
1881 error if encountering invalid read syntax or if RADIX is out of
1882 range. */
1884 static Lisp_Object
1885 read_integer (readcharfun, radix)
1886 Lisp_Object readcharfun;
1887 int radix;
1889 int ndigits = 0, invalid_p, c, sign = 0;
1890 EMACS_INT number = 0;
1892 if (radix < 2 || radix > 36)
1893 invalid_p = 1;
1894 else
1896 number = ndigits = invalid_p = 0;
1897 sign = 1;
1899 c = READCHAR;
1900 if (c == '-')
1902 c = READCHAR;
1903 sign = -1;
1905 else if (c == '+')
1906 c = READCHAR;
1908 while (c >= 0)
1910 int digit;
1912 if (c >= '0' && c <= '9')
1913 digit = c - '0';
1914 else if (c >= 'a' && c <= 'z')
1915 digit = c - 'a' + 10;
1916 else if (c >= 'A' && c <= 'Z')
1917 digit = c - 'A' + 10;
1918 else
1920 UNREAD (c);
1921 break;
1924 if (digit < 0 || digit >= radix)
1925 invalid_p = 1;
1927 number = radix * number + digit;
1928 ++ndigits;
1929 c = READCHAR;
1933 if (ndigits == 0 || invalid_p)
1935 char buf[50];
1936 sprintf (buf, "integer, radix %d", radix);
1937 Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil));
1940 return make_number (sign * number);
1944 /* Convert unibyte text in read_buffer to multibyte.
1946 Initially, *P is a pointer after the end of the unibyte text, and
1947 the pointer *END points after the end of read_buffer.
1949 If read_buffer doesn't have enough room to hold the result
1950 of the conversion, reallocate it and adjust *P and *END.
1952 At the end, make *P point after the result of the conversion, and
1953 return in *NCHARS the number of characters in the converted
1954 text. */
1956 static void
1957 to_multibyte (p, end, nchars)
1958 char **p, **end;
1959 int *nchars;
1961 int nbytes;
1963 parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars);
1964 if (read_buffer_size < 2 * nbytes)
1966 int offset = *p - read_buffer;
1967 read_buffer_size = 2 * max (read_buffer_size, nbytes);
1968 read_buffer = (char *) xrealloc (read_buffer, read_buffer_size);
1969 *p = read_buffer + offset;
1970 *end = read_buffer + read_buffer_size;
1973 if (nbytes != *nchars)
1974 nbytes = str_as_multibyte (read_buffer, read_buffer_size,
1975 *p - read_buffer, nchars);
1977 *p = read_buffer + nbytes;
1981 /* If the next token is ')' or ']' or '.', we store that character
1982 in *PCH and the return value is not interesting. Else, we store
1983 zero in *PCH and we read and return one lisp object.
1985 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1987 static Lisp_Object
1988 read1 (readcharfun, pch, first_in_list)
1989 register Lisp_Object readcharfun;
1990 int *pch;
1991 int first_in_list;
1993 register int c;
1994 int uninterned_symbol = 0;
1996 *pch = 0;
1998 retry:
2000 c = READCHAR;
2001 if (c < 0)
2002 end_of_file_error ();
2004 switch (c)
2006 case '(':
2007 return read_list (0, readcharfun);
2009 case '[':
2010 return read_vector (readcharfun, 0);
2012 case ')':
2013 case ']':
2015 *pch = c;
2016 return Qnil;
2019 case '#':
2020 c = READCHAR;
2021 if (c == '^')
2023 c = READCHAR;
2024 if (c == '[')
2026 Lisp_Object tmp;
2027 tmp = read_vector (readcharfun, 0);
2028 if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS
2029 || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10)
2030 error ("Invalid size char-table");
2031 XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
2032 XCHAR_TABLE (tmp)->top = Qt;
2033 return tmp;
2035 else if (c == '^')
2037 c = READCHAR;
2038 if (c == '[')
2040 Lisp_Object tmp;
2041 tmp = read_vector (readcharfun, 0);
2042 if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS)
2043 error ("Invalid size char-table");
2044 XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
2045 XCHAR_TABLE (tmp)->top = Qnil;
2046 return tmp;
2048 Fsignal (Qinvalid_read_syntax,
2049 Fcons (make_string ("#^^", 3), Qnil));
2051 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil));
2053 if (c == '&')
2055 Lisp_Object length;
2056 length = read1 (readcharfun, pch, first_in_list);
2057 c = READCHAR;
2058 if (c == '"')
2060 Lisp_Object tmp, val;
2061 int size_in_chars
2062 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
2063 / BOOL_VECTOR_BITS_PER_CHAR);
2065 UNREAD (c);
2066 tmp = read1 (readcharfun, pch, first_in_list);
2067 if (size_in_chars != SCHARS (tmp)
2068 /* We used to print 1 char too many
2069 when the number of bits was a multiple of 8.
2070 Accept such input in case it came from an old version. */
2071 && ! (XFASTINT (length)
2072 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
2073 Fsignal (Qinvalid_read_syntax,
2074 Fcons (make_string ("#&...", 5), Qnil));
2076 val = Fmake_bool_vector (length, Qnil);
2077 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
2078 size_in_chars);
2079 /* Clear the extraneous bits in the last byte. */
2080 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
2081 XBOOL_VECTOR (val)->data[size_in_chars - 1]
2082 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2083 return val;
2085 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5),
2086 Qnil));
2088 if (c == '[')
2090 /* Accept compiled functions at read-time so that we don't have to
2091 build them using function calls. */
2092 Lisp_Object tmp;
2093 tmp = read_vector (readcharfun, 1);
2094 return Fmake_byte_code (XVECTOR (tmp)->size,
2095 XVECTOR (tmp)->contents);
2097 if (c == '(')
2099 Lisp_Object tmp;
2100 struct gcpro gcpro1;
2101 int ch;
2103 /* Read the string itself. */
2104 tmp = read1 (readcharfun, &ch, 0);
2105 if (ch != 0 || !STRINGP (tmp))
2106 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
2107 GCPRO1 (tmp);
2108 /* Read the intervals and their properties. */
2109 while (1)
2111 Lisp_Object beg, end, plist;
2113 beg = read1 (readcharfun, &ch, 0);
2114 end = plist = Qnil;
2115 if (ch == ')')
2116 break;
2117 if (ch == 0)
2118 end = read1 (readcharfun, &ch, 0);
2119 if (ch == 0)
2120 plist = read1 (readcharfun, &ch, 0);
2121 if (ch)
2122 Fsignal (Qinvalid_read_syntax,
2123 Fcons (build_string ("invalid string property list"),
2124 Qnil));
2125 Fset_text_properties (beg, end, plist, tmp);
2127 UNGCPRO;
2128 return tmp;
2131 /* #@NUMBER is used to skip NUMBER following characters.
2132 That's used in .elc files to skip over doc strings
2133 and function definitions. */
2134 if (c == '@')
2136 int i, nskip = 0;
2138 /* Read a decimal integer. */
2139 while ((c = READCHAR) >= 0
2140 && c >= '0' && c <= '9')
2142 nskip *= 10;
2143 nskip += c - '0';
2145 if (c >= 0)
2146 UNREAD (c);
2148 if (load_force_doc_strings && EQ (readcharfun, Qget_file_char))
2150 /* If we are supposed to force doc strings into core right now,
2151 record the last string that we skipped,
2152 and record where in the file it comes from. */
2154 /* But first exchange saved_doc_string
2155 with prev_saved_doc_string, so we save two strings. */
2157 char *temp = saved_doc_string;
2158 int temp_size = saved_doc_string_size;
2159 file_offset temp_pos = saved_doc_string_position;
2160 int temp_len = saved_doc_string_length;
2162 saved_doc_string = prev_saved_doc_string;
2163 saved_doc_string_size = prev_saved_doc_string_size;
2164 saved_doc_string_position = prev_saved_doc_string_position;
2165 saved_doc_string_length = prev_saved_doc_string_length;
2167 prev_saved_doc_string = temp;
2168 prev_saved_doc_string_size = temp_size;
2169 prev_saved_doc_string_position = temp_pos;
2170 prev_saved_doc_string_length = temp_len;
2173 if (saved_doc_string_size == 0)
2175 saved_doc_string_size = nskip + 100;
2176 saved_doc_string = (char *) xmalloc (saved_doc_string_size);
2178 if (nskip > saved_doc_string_size)
2180 saved_doc_string_size = nskip + 100;
2181 saved_doc_string = (char *) xrealloc (saved_doc_string,
2182 saved_doc_string_size);
2185 saved_doc_string_position = file_tell (instream);
2187 /* Copy that many characters into saved_doc_string. */
2188 for (i = 0; i < nskip && c >= 0; i++)
2189 saved_doc_string[i] = c = READCHAR;
2191 saved_doc_string_length = i;
2193 else
2195 /* Skip that many characters. */
2196 for (i = 0; i < nskip && c >= 0; i++)
2197 c = READCHAR;
2200 goto retry;
2202 if (c == '!')
2204 /* #! appears at the beginning of an executable file.
2205 Skip the first line. */
2206 while (c != '\n' && c >= 0)
2207 c = READCHAR;
2208 goto retry;
2210 if (c == '$')
2211 return Vload_file_name;
2212 if (c == '\'')
2213 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
2214 /* #:foo is the uninterned symbol named foo. */
2215 if (c == ':')
2217 uninterned_symbol = 1;
2218 c = READCHAR;
2219 goto default_label;
2221 /* Reader forms that can reuse previously read objects. */
2222 if (c >= '0' && c <= '9')
2224 int n = 0;
2225 Lisp_Object tem;
2227 /* Read a non-negative integer. */
2228 while (c >= '0' && c <= '9')
2230 n *= 10;
2231 n += c - '0';
2232 c = READCHAR;
2234 /* #n=object returns object, but associates it with n for #n#. */
2235 if (c == '=')
2237 /* Make a placeholder for #n# to use temporarily */
2238 Lisp_Object placeholder;
2239 Lisp_Object cell;
2241 placeholder = Fcons(Qnil, Qnil);
2242 cell = Fcons (make_number (n), placeholder);
2243 read_objects = Fcons (cell, read_objects);
2245 /* Read the object itself. */
2246 tem = read0 (readcharfun);
2248 /* Now put it everywhere the placeholder was... */
2249 substitute_object_in_subtree (tem, placeholder);
2251 /* ...and #n# will use the real value from now on. */
2252 Fsetcdr (cell, tem);
2254 return tem;
2256 /* #n# returns a previously read object. */
2257 if (c == '#')
2259 tem = Fassq (make_number (n), read_objects);
2260 if (CONSP (tem))
2261 return XCDR (tem);
2262 /* Fall through to error message. */
2264 else if (c == 'r' || c == 'R')
2265 return read_integer (readcharfun, n);
2267 /* Fall through to error message. */
2269 else if (c == 'x' || c == 'X')
2270 return read_integer (readcharfun, 16);
2271 else if (c == 'o' || c == 'O')
2272 return read_integer (readcharfun, 8);
2273 else if (c == 'b' || c == 'B')
2274 return read_integer (readcharfun, 2);
2276 UNREAD (c);
2277 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
2279 case ';':
2280 while ((c = READCHAR) >= 0 && c != '\n');
2281 goto retry;
2283 case '\'':
2285 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2288 case '`':
2289 if (first_in_list)
2290 goto default_label;
2291 else
2293 Lisp_Object value;
2295 new_backquote_flag++;
2296 value = read0 (readcharfun);
2297 new_backquote_flag--;
2299 return Fcons (Qbackquote, Fcons (value, Qnil));
2302 case ',':
2303 if (new_backquote_flag)
2305 Lisp_Object comma_type = Qnil;
2306 Lisp_Object value;
2307 int ch = READCHAR;
2309 if (ch == '@')
2310 comma_type = Qcomma_at;
2311 else if (ch == '.')
2312 comma_type = Qcomma_dot;
2313 else
2315 if (ch >= 0) UNREAD (ch);
2316 comma_type = Qcomma;
2319 new_backquote_flag--;
2320 value = read0 (readcharfun);
2321 new_backquote_flag++;
2322 return Fcons (comma_type, Fcons (value, Qnil));
2324 else
2325 goto default_label;
2327 case '?':
2329 int discard;
2330 int next_char;
2331 int ok;
2333 c = READCHAR;
2334 if (c < 0)
2335 end_of_file_error ();
2337 /* Accept `single space' syntax like (list ? x) where the
2338 whitespace character is SPC or TAB.
2339 Other literal whitespace like NL, CR, and FF are not accepted,
2340 as there are well-established escape sequences for these. */
2341 if (c == ' ' || c == '\t')
2342 return make_number (c);
2344 if (c == '\\')
2345 c = read_escape (readcharfun, 0, &discard);
2346 else if (BASE_LEADING_CODE_P (c))
2347 c = read_multibyte (c, readcharfun);
2349 next_char = READCHAR;
2350 if (next_char == '.')
2352 /* Only a dotted-pair dot is valid after a char constant. */
2353 int next_next_char = READCHAR;
2354 UNREAD (next_next_char);
2356 ok = (next_next_char <= 040
2357 || (next_next_char < 0200
2358 && (index ("\"';([#?", next_next_char)
2359 || (!first_in_list && next_next_char == '`')
2360 || (new_backquote_flag && next_next_char == ','))));
2362 else
2364 ok = (next_char <= 040
2365 || (next_char < 0200
2366 && (index ("\"';()[]#?", next_char)
2367 || (!first_in_list && next_char == '`')
2368 || (new_backquote_flag && next_char == ','))));
2370 UNREAD (next_char);
2371 if (!ok)
2372 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil));
2374 return make_number (c);
2377 case '"':
2379 char *p = read_buffer;
2380 char *end = read_buffer + read_buffer_size;
2381 register int c;
2382 /* 1 if we saw an escape sequence specifying
2383 a multibyte character, or a multibyte character. */
2384 int force_multibyte = 0;
2385 /* 1 if we saw an escape sequence specifying
2386 a single-byte character. */
2387 int force_singlebyte = 0;
2388 /* 1 if read_buffer contains multibyte text now. */
2389 int is_multibyte = 0;
2390 int cancel = 0;
2391 int nchars = 0;
2393 while ((c = READCHAR) >= 0
2394 && c != '\"')
2396 if (end - p < MAX_MULTIBYTE_LENGTH)
2398 int offset = p - read_buffer;
2399 read_buffer = (char *) xrealloc (read_buffer,
2400 read_buffer_size *= 2);
2401 p = read_buffer + offset;
2402 end = read_buffer + read_buffer_size;
2405 if (c == '\\')
2407 int byterep;
2409 c = read_escape (readcharfun, 1, &byterep);
2411 /* C is -1 if \ newline has just been seen */
2412 if (c == -1)
2414 if (p == read_buffer)
2415 cancel = 1;
2416 continue;
2419 if (byterep == 1)
2420 force_singlebyte = 1;
2421 else if (byterep == 2)
2422 force_multibyte = 1;
2425 /* A character that must be multibyte forces multibyte. */
2426 if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK))
2427 force_multibyte = 1;
2429 /* If we just discovered the need to be multibyte,
2430 convert the text accumulated thus far. */
2431 if (force_multibyte && ! is_multibyte)
2433 is_multibyte = 1;
2434 to_multibyte (&p, &end, &nchars);
2437 /* Allow `\C- ' and `\C-?'. */
2438 if (c == (CHAR_CTL | ' '))
2439 c = 0;
2440 else if (c == (CHAR_CTL | '?'))
2441 c = 127;
2443 if (c & CHAR_SHIFT)
2445 /* Shift modifier is valid only with [A-Za-z]. */
2446 if ((c & 0377) >= 'A' && (c & 0377) <= 'Z')
2447 c &= ~CHAR_SHIFT;
2448 else if ((c & 0377) >= 'a' && (c & 0377) <= 'z')
2449 c = (c & ~CHAR_SHIFT) - ('a' - 'A');
2452 if (c & CHAR_META)
2453 /* Move the meta bit to the right place for a string. */
2454 c = (c & ~CHAR_META) | 0x80;
2455 if (c & CHAR_MODIFIER_MASK)
2456 error ("Invalid modifier in string");
2458 if (is_multibyte)
2459 p += CHAR_STRING (c, p);
2460 else
2461 *p++ = c;
2463 nchars++;
2466 if (c < 0)
2467 end_of_file_error ();
2469 /* If purifying, and string starts with \ newline,
2470 return zero instead. This is for doc strings
2471 that we are really going to find in etc/DOC.nn.nn */
2472 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
2473 return make_number (0);
2475 if (is_multibyte || force_singlebyte)
2477 else if (load_convert_to_unibyte)
2479 Lisp_Object string;
2480 to_multibyte (&p, &end, &nchars);
2481 if (p - read_buffer != nchars)
2483 string = make_multibyte_string (read_buffer, nchars,
2484 p - read_buffer);
2485 return Fstring_make_unibyte (string);
2487 /* We can make a unibyte string directly. */
2488 is_multibyte = 0;
2490 else if (EQ (readcharfun, Qget_file_char)
2491 || EQ (readcharfun, Qlambda))
2493 /* Nowadays, reading directly from a file is used only for
2494 compiled Emacs Lisp files, and those always use the
2495 Emacs internal encoding. Meanwhile, Qlambda is used
2496 for reading dynamic byte code (compiled with
2497 byte-compile-dynamic = t). So make the string multibyte
2498 if the string contains any multibyte sequences.
2499 (to_multibyte is a no-op if not.) */
2500 to_multibyte (&p, &end, &nchars);
2501 is_multibyte = (p - read_buffer) != nchars;
2503 else
2504 /* In all other cases, if we read these bytes as
2505 separate characters, treat them as separate characters now. */
2508 /* We want readchar_count to be the number of characters, not
2509 bytes. Hence we adjust for multibyte characters in the
2510 string. ... But it doesn't seem to be necessary, because
2511 READCHAR *does* read multibyte characters from buffers. */
2512 /* readchar_count -= (p - read_buffer) - nchars; */
2513 if (read_pure)
2514 return make_pure_string (read_buffer, nchars, p - read_buffer,
2515 is_multibyte);
2516 return make_specified_string (read_buffer, nchars, p - read_buffer,
2517 is_multibyte);
2520 case '.':
2522 int next_char = READCHAR;
2523 UNREAD (next_char);
2525 if (next_char <= 040
2526 || (next_char < 0200
2527 && (index ("\"';([#?", next_char)
2528 || (!first_in_list && next_char == '`')
2529 || (new_backquote_flag && next_char == ','))))
2531 *pch = c;
2532 return Qnil;
2535 /* Otherwise, we fall through! Note that the atom-reading loop
2536 below will now loop at least once, assuring that we will not
2537 try to UNREAD two characters in a row. */
2539 default:
2540 default_label:
2541 if (c <= 040) goto retry;
2543 char *p = read_buffer;
2544 int quoted = 0;
2547 char *end = read_buffer + read_buffer_size;
2549 while (c > 040
2550 && (c >= 0200
2551 || (!index ("\"';()[]#", c)
2552 && !(!first_in_list && c == '`')
2553 && !(new_backquote_flag && c == ','))))
2555 if (end - p < MAX_MULTIBYTE_LENGTH)
2557 int offset = p - read_buffer;
2558 read_buffer = (char *) xrealloc (read_buffer,
2559 read_buffer_size *= 2);
2560 p = read_buffer + offset;
2561 end = read_buffer + read_buffer_size;
2564 if (c == '\\')
2566 c = READCHAR;
2567 if (c == -1)
2568 end_of_file_error ();
2569 quoted = 1;
2572 if (! SINGLE_BYTE_CHAR_P (c))
2573 p += CHAR_STRING (c, p);
2574 else
2575 *p++ = c;
2577 c = READCHAR;
2580 if (p == end)
2582 int offset = p - read_buffer;
2583 read_buffer = (char *) xrealloc (read_buffer,
2584 read_buffer_size *= 2);
2585 p = read_buffer + offset;
2586 end = read_buffer + read_buffer_size;
2588 *p = 0;
2589 if (c >= 0)
2590 UNREAD (c);
2593 if (!quoted && !uninterned_symbol)
2595 register char *p1;
2596 register Lisp_Object val;
2597 p1 = read_buffer;
2598 if (*p1 == '+' || *p1 == '-') p1++;
2599 /* Is it an integer? */
2600 if (p1 != p)
2602 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
2603 /* Integers can have trailing decimal points. */
2604 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
2605 if (p1 == p)
2606 /* It is an integer. */
2608 if (p1[-1] == '.')
2609 p1[-1] = '\0';
2610 if (sizeof (int) == sizeof (EMACS_INT))
2611 XSETINT (val, atoi (read_buffer));
2612 else if (sizeof (long) == sizeof (EMACS_INT))
2613 XSETINT (val, atol (read_buffer));
2614 else
2615 abort ();
2616 return val;
2619 if (isfloat_string (read_buffer))
2621 /* Compute NaN and infinities using 0.0 in a variable,
2622 to cope with compilers that think they are smarter
2623 than we are. */
2624 double zero = 0.0;
2626 double value;
2628 /* Negate the value ourselves. This treats 0, NaNs,
2629 and infinity properly on IEEE floating point hosts,
2630 and works around a common bug where atof ("-0.0")
2631 drops the sign. */
2632 int negative = read_buffer[0] == '-';
2634 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2635 returns 1, is if the input ends in e+INF or e+NaN. */
2636 switch (p[-1])
2638 case 'F':
2639 value = 1.0 / zero;
2640 break;
2641 case 'N':
2642 value = zero / zero;
2644 /* If that made a "negative" NaN, negate it. */
2647 int i;
2648 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
2650 u_data.d = value;
2651 u_minus_zero.d = - 0.0;
2652 for (i = 0; i < sizeof (double); i++)
2653 if (u_data.c[i] & u_minus_zero.c[i])
2655 value = - value;
2656 break;
2659 /* Now VALUE is a positive NaN. */
2660 break;
2661 default:
2662 value = atof (read_buffer + negative);
2663 break;
2666 return make_float (negative ? - value : value);
2670 Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
2671 : intern (read_buffer);
2672 if (EQ (Vread_with_symbol_positions, Qt)
2673 || EQ (Vread_with_symbol_positions, readcharfun))
2674 Vread_symbol_positions_list =
2675 /* Kind of a hack; this will probably fail if characters
2676 in the symbol name were escaped. Not really a big
2677 deal, though. */
2678 Fcons (Fcons (result,
2679 make_number (readchar_count
2680 - XFASTINT (Flength (Fsymbol_name (result))))),
2681 Vread_symbol_positions_list);
2682 return result;
2689 /* List of nodes we've seen during substitute_object_in_subtree. */
2690 static Lisp_Object seen_list;
2692 static void
2693 substitute_object_in_subtree (object, placeholder)
2694 Lisp_Object object;
2695 Lisp_Object placeholder;
2697 Lisp_Object check_object;
2699 /* We haven't seen any objects when we start. */
2700 seen_list = Qnil;
2702 /* Make all the substitutions. */
2703 check_object
2704 = substitute_object_recurse (object, placeholder, object);
2706 /* Clear seen_list because we're done with it. */
2707 seen_list = Qnil;
2709 /* The returned object here is expected to always eq the
2710 original. */
2711 if (!EQ (check_object, object))
2712 error ("Unexpected mutation error in reader");
2715 /* Feval doesn't get called from here, so no gc protection is needed. */
2716 #define SUBSTITUTE(get_val, set_val) \
2718 Lisp_Object old_value = get_val; \
2719 Lisp_Object true_value \
2720 = substitute_object_recurse (object, placeholder,\
2721 old_value); \
2723 if (!EQ (old_value, true_value)) \
2725 set_val; \
2729 static Lisp_Object
2730 substitute_object_recurse (object, placeholder, subtree)
2731 Lisp_Object object;
2732 Lisp_Object placeholder;
2733 Lisp_Object subtree;
2735 /* If we find the placeholder, return the target object. */
2736 if (EQ (placeholder, subtree))
2737 return object;
2739 /* If we've been to this node before, don't explore it again. */
2740 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
2741 return subtree;
2743 /* If this node can be the entry point to a cycle, remember that
2744 we've seen it. It can only be such an entry point if it was made
2745 by #n=, which means that we can find it as a value in
2746 read_objects. */
2747 if (!EQ (Qnil, Frassq (subtree, read_objects)))
2748 seen_list = Fcons (subtree, seen_list);
2750 /* Recurse according to subtree's type.
2751 Every branch must return a Lisp_Object. */
2752 switch (XTYPE (subtree))
2754 case Lisp_Vectorlike:
2756 int i;
2757 int length = XINT (Flength(subtree));
2758 for (i = 0; i < length; i++)
2760 Lisp_Object idx = make_number (i);
2761 SUBSTITUTE (Faref (subtree, idx),
2762 Faset (subtree, idx, true_value));
2764 return subtree;
2767 case Lisp_Cons:
2769 SUBSTITUTE (Fcar_safe (subtree),
2770 Fsetcar (subtree, true_value));
2771 SUBSTITUTE (Fcdr_safe (subtree),
2772 Fsetcdr (subtree, true_value));
2773 return subtree;
2776 case Lisp_String:
2778 /* Check for text properties in each interval.
2779 substitute_in_interval contains part of the logic. */
2781 INTERVAL root_interval = STRING_INTERVALS (subtree);
2782 Lisp_Object arg = Fcons (object, placeholder);
2784 traverse_intervals_noorder (root_interval,
2785 &substitute_in_interval, arg);
2787 return subtree;
2790 /* Other types don't recurse any further. */
2791 default:
2792 return subtree;
2796 /* Helper function for substitute_object_recurse. */
2797 static void
2798 substitute_in_interval (interval, arg)
2799 INTERVAL interval;
2800 Lisp_Object arg;
2802 Lisp_Object object = Fcar (arg);
2803 Lisp_Object placeholder = Fcdr (arg);
2805 SUBSTITUTE(interval->plist, interval->plist = true_value);
2809 #define LEAD_INT 1
2810 #define DOT_CHAR 2
2811 #define TRAIL_INT 4
2812 #define E_CHAR 8
2813 #define EXP_INT 16
2816 isfloat_string (cp)
2817 register char *cp;
2819 register int state;
2821 char *start = cp;
2823 state = 0;
2824 if (*cp == '+' || *cp == '-')
2825 cp++;
2827 if (*cp >= '0' && *cp <= '9')
2829 state |= LEAD_INT;
2830 while (*cp >= '0' && *cp <= '9')
2831 cp++;
2833 if (*cp == '.')
2835 state |= DOT_CHAR;
2836 cp++;
2838 if (*cp >= '0' && *cp <= '9')
2840 state |= TRAIL_INT;
2841 while (*cp >= '0' && *cp <= '9')
2842 cp++;
2844 if (*cp == 'e' || *cp == 'E')
2846 state |= E_CHAR;
2847 cp++;
2848 if (*cp == '+' || *cp == '-')
2849 cp++;
2852 if (*cp >= '0' && *cp <= '9')
2854 state |= EXP_INT;
2855 while (*cp >= '0' && *cp <= '9')
2856 cp++;
2858 else if (cp == start)
2860 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
2862 state |= EXP_INT;
2863 cp += 3;
2865 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
2867 state |= EXP_INT;
2868 cp += 3;
2871 return (((*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
2872 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
2873 || state == (DOT_CHAR|TRAIL_INT)
2874 || state == (LEAD_INT|E_CHAR|EXP_INT)
2875 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2876 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
2880 static Lisp_Object
2881 read_vector (readcharfun, bytecodeflag)
2882 Lisp_Object readcharfun;
2883 int bytecodeflag;
2885 register int i;
2886 register int size;
2887 register Lisp_Object *ptr;
2888 register Lisp_Object tem, item, vector;
2889 register struct Lisp_Cons *otem;
2890 Lisp_Object len;
2892 tem = read_list (1, readcharfun);
2893 len = Flength (tem);
2894 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
2896 size = XVECTOR (vector)->size;
2897 ptr = XVECTOR (vector)->contents;
2898 for (i = 0; i < size; i++)
2900 item = Fcar (tem);
2901 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2902 bytecode object, the docstring containing the bytecode and
2903 constants values must be treated as unibyte and passed to
2904 Fread, to get the actual bytecode string and constants vector. */
2905 if (bytecodeflag && load_force_doc_strings)
2907 if (i == COMPILED_BYTECODE)
2909 if (!STRINGP (item))
2910 error ("Invalid byte code");
2912 /* Delay handling the bytecode slot until we know whether
2913 it is lazily-loaded (we can tell by whether the
2914 constants slot is nil). */
2915 ptr[COMPILED_CONSTANTS] = item;
2916 item = Qnil;
2918 else if (i == COMPILED_CONSTANTS)
2920 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
2922 if (NILP (item))
2924 /* Coerce string to unibyte (like string-as-unibyte,
2925 but without generating extra garbage and
2926 guaranteeing no change in the contents). */
2927 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
2928 STRING_SET_UNIBYTE (bytestr);
2930 item = Fread (bytestr);
2931 if (!CONSP (item))
2932 error ("Invalid byte code");
2934 otem = XCONS (item);
2935 bytestr = XCAR (item);
2936 item = XCDR (item);
2937 free_cons (otem);
2940 /* Now handle the bytecode slot. */
2941 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
2944 ptr[i] = read_pure ? Fpurecopy (item) : item;
2945 otem = XCONS (tem);
2946 tem = Fcdr (tem);
2947 free_cons (otem);
2949 return vector;
2952 /* FLAG = 1 means check for ] to terminate rather than ) and .
2953 FLAG = -1 means check for starting with defun
2954 and make structure pure. */
2956 static Lisp_Object
2957 read_list (flag, readcharfun)
2958 int flag;
2959 register Lisp_Object readcharfun;
2961 /* -1 means check next element for defun,
2962 0 means don't check,
2963 1 means already checked and found defun. */
2964 int defunflag = flag < 0 ? -1 : 0;
2965 Lisp_Object val, tail;
2966 register Lisp_Object elt, tem;
2967 struct gcpro gcpro1, gcpro2;
2968 /* 0 is the normal case.
2969 1 means this list is a doc reference; replace it with the number 0.
2970 2 means this list is a doc reference; replace it with the doc string. */
2971 int doc_reference = 0;
2973 /* Initialize this to 1 if we are reading a list. */
2974 int first_in_list = flag <= 0;
2976 val = Qnil;
2977 tail = Qnil;
2979 while (1)
2981 int ch;
2982 GCPRO2 (val, tail);
2983 elt = read1 (readcharfun, &ch, first_in_list);
2984 UNGCPRO;
2986 first_in_list = 0;
2988 /* While building, if the list starts with #$, treat it specially. */
2989 if (EQ (elt, Vload_file_name)
2990 && ! NILP (elt)
2991 && !NILP (Vpurify_flag))
2993 if (NILP (Vdoc_file_name))
2994 /* We have not yet called Snarf-documentation, so assume
2995 this file is described in the DOC-MM.NN file
2996 and Snarf-documentation will fill in the right value later.
2997 For now, replace the whole list with 0. */
2998 doc_reference = 1;
2999 else
3000 /* We have already called Snarf-documentation, so make a relative
3001 file name for this file, so it can be found properly
3002 in the installed Lisp directory.
3003 We don't use Fexpand_file_name because that would make
3004 the directory absolute now. */
3005 elt = concat2 (build_string ("../lisp/"),
3006 Ffile_name_nondirectory (elt));
3008 else if (EQ (elt, Vload_file_name)
3009 && ! NILP (elt)
3010 && load_force_doc_strings)
3011 doc_reference = 2;
3013 if (ch)
3015 if (flag > 0)
3017 if (ch == ']')
3018 return val;
3019 Fsignal (Qinvalid_read_syntax,
3020 Fcons (make_string (") or . in a vector", 18), Qnil));
3022 if (ch == ')')
3023 return val;
3024 if (ch == '.')
3026 GCPRO2 (val, tail);
3027 if (!NILP (tail))
3028 XSETCDR (tail, read0 (readcharfun));
3029 else
3030 val = read0 (readcharfun);
3031 read1 (readcharfun, &ch, 0);
3032 UNGCPRO;
3033 if (ch == ')')
3035 if (doc_reference == 1)
3036 return make_number (0);
3037 if (doc_reference == 2)
3039 /* Get a doc string from the file we are loading.
3040 If it's in saved_doc_string, get it from there. */
3041 int pos = XINT (XCDR (val));
3042 /* Position is negative for user variables. */
3043 if (pos < 0) pos = -pos;
3044 if (pos >= saved_doc_string_position
3045 && pos < (saved_doc_string_position
3046 + saved_doc_string_length))
3048 int start = pos - saved_doc_string_position;
3049 int from, to;
3051 /* Process quoting with ^A,
3052 and find the end of the string,
3053 which is marked with ^_ (037). */
3054 for (from = start, to = start;
3055 saved_doc_string[from] != 037;)
3057 int c = saved_doc_string[from++];
3058 if (c == 1)
3060 c = saved_doc_string[from++];
3061 if (c == 1)
3062 saved_doc_string[to++] = c;
3063 else if (c == '0')
3064 saved_doc_string[to++] = 0;
3065 else if (c == '_')
3066 saved_doc_string[to++] = 037;
3068 else
3069 saved_doc_string[to++] = c;
3072 return make_string (saved_doc_string + start,
3073 to - start);
3075 /* Look in prev_saved_doc_string the same way. */
3076 else if (pos >= prev_saved_doc_string_position
3077 && pos < (prev_saved_doc_string_position
3078 + prev_saved_doc_string_length))
3080 int start = pos - prev_saved_doc_string_position;
3081 int from, to;
3083 /* Process quoting with ^A,
3084 and find the end of the string,
3085 which is marked with ^_ (037). */
3086 for (from = start, to = start;
3087 prev_saved_doc_string[from] != 037;)
3089 int c = prev_saved_doc_string[from++];
3090 if (c == 1)
3092 c = prev_saved_doc_string[from++];
3093 if (c == 1)
3094 prev_saved_doc_string[to++] = c;
3095 else if (c == '0')
3096 prev_saved_doc_string[to++] = 0;
3097 else if (c == '_')
3098 prev_saved_doc_string[to++] = 037;
3100 else
3101 prev_saved_doc_string[to++] = c;
3104 return make_string (prev_saved_doc_string + start,
3105 to - start);
3107 else
3108 return get_doc_string (val, 0, 0);
3111 return val;
3113 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
3115 return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
3117 tem = (read_pure && flag <= 0
3118 ? pure_cons (elt, Qnil)
3119 : Fcons (elt, Qnil));
3120 if (!NILP (tail))
3121 XSETCDR (tail, tem);
3122 else
3123 val = tem;
3124 tail = tem;
3125 if (defunflag < 0)
3126 defunflag = EQ (elt, Qdefun);
3127 else if (defunflag > 0)
3128 read_pure = 1;
3132 Lisp_Object Vobarray;
3133 Lisp_Object initial_obarray;
3135 /* oblookup stores the bucket number here, for the sake of Funintern. */
3137 int oblookup_last_bucket_number;
3139 static int hash_string ();
3141 /* Get an error if OBARRAY is not an obarray.
3142 If it is one, return it. */
3144 Lisp_Object
3145 check_obarray (obarray)
3146 Lisp_Object obarray;
3148 while (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3150 /* If Vobarray is now invalid, force it to be valid. */
3151 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
3153 obarray = wrong_type_argument (Qvectorp, obarray);
3155 return obarray;
3158 /* Intern the C string STR: return a symbol with that name,
3159 interned in the current obarray. */
3161 Lisp_Object
3162 intern (str)
3163 const char *str;
3165 Lisp_Object tem;
3166 int len = strlen (str);
3167 Lisp_Object obarray;
3169 obarray = Vobarray;
3170 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3171 obarray = check_obarray (obarray);
3172 tem = oblookup (obarray, str, len, len);
3173 if (SYMBOLP (tem))
3174 return tem;
3175 return Fintern (make_string (str, len), obarray);
3178 /* Create an uninterned symbol with name STR. */
3180 Lisp_Object
3181 make_symbol (str)
3182 char *str;
3184 int len = strlen (str);
3186 return Fmake_symbol ((!NILP (Vpurify_flag)
3187 ? make_pure_string (str, len, len, 0)
3188 : make_string (str, len)));
3191 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
3192 doc: /* Return the canonical symbol whose name is STRING.
3193 If there is none, one is created by this function and returned.
3194 A second optional argument specifies the obarray to use;
3195 it defaults to the value of `obarray'. */)
3196 (string, obarray)
3197 Lisp_Object string, obarray;
3199 register Lisp_Object tem, sym, *ptr;
3201 if (NILP (obarray)) obarray = Vobarray;
3202 obarray = check_obarray (obarray);
3204 CHECK_STRING (string);
3206 tem = oblookup (obarray, SDATA (string),
3207 SCHARS (string),
3208 SBYTES (string));
3209 if (!INTEGERP (tem))
3210 return tem;
3212 if (!NILP (Vpurify_flag))
3213 string = Fpurecopy (string);
3214 sym = Fmake_symbol (string);
3216 if (EQ (obarray, initial_obarray))
3217 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3218 else
3219 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
3221 if ((SREF (string, 0) == ':')
3222 && EQ (obarray, initial_obarray))
3224 XSYMBOL (sym)->constant = 1;
3225 XSYMBOL (sym)->value = sym;
3228 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
3229 if (SYMBOLP (*ptr))
3230 XSYMBOL (sym)->next = XSYMBOL (*ptr);
3231 else
3232 XSYMBOL (sym)->next = 0;
3233 *ptr = sym;
3234 return sym;
3237 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
3238 doc: /* Return the canonical symbol named NAME, or nil if none exists.
3239 NAME may be a string or a symbol. If it is a symbol, that exact
3240 symbol is searched for.
3241 A second optional argument specifies the obarray to use;
3242 it defaults to the value of `obarray'. */)
3243 (name, obarray)
3244 Lisp_Object name, obarray;
3246 register Lisp_Object tem, string;
3248 if (NILP (obarray)) obarray = Vobarray;
3249 obarray = check_obarray (obarray);
3251 if (!SYMBOLP (name))
3253 CHECK_STRING (name);
3254 string = name;
3256 else
3257 string = SYMBOL_NAME (name);
3259 tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
3260 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3261 return Qnil;
3262 else
3263 return tem;
3266 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
3267 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
3268 The value is t if a symbol was found and deleted, nil otherwise.
3269 NAME may be a string or a symbol. If it is a symbol, that symbol
3270 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3271 OBARRAY defaults to the value of the variable `obarray'. */)
3272 (name, obarray)
3273 Lisp_Object name, obarray;
3275 register Lisp_Object string, tem;
3276 int hash;
3278 if (NILP (obarray)) obarray = Vobarray;
3279 obarray = check_obarray (obarray);
3281 if (SYMBOLP (name))
3282 string = SYMBOL_NAME (name);
3283 else
3285 CHECK_STRING (name);
3286 string = name;
3289 tem = oblookup (obarray, SDATA (string),
3290 SCHARS (string),
3291 SBYTES (string));
3292 if (INTEGERP (tem))
3293 return Qnil;
3294 /* If arg was a symbol, don't delete anything but that symbol itself. */
3295 if (SYMBOLP (name) && !EQ (name, tem))
3296 return Qnil;
3298 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3299 XSYMBOL (tem)->constant = 0;
3300 XSYMBOL (tem)->indirect_variable = 0;
3302 hash = oblookup_last_bucket_number;
3304 if (EQ (XVECTOR (obarray)->contents[hash], tem))
3306 if (XSYMBOL (tem)->next)
3307 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3308 else
3309 XSETINT (XVECTOR (obarray)->contents[hash], 0);
3311 else
3313 Lisp_Object tail, following;
3315 for (tail = XVECTOR (obarray)->contents[hash];
3316 XSYMBOL (tail)->next;
3317 tail = following)
3319 XSETSYMBOL (following, XSYMBOL (tail)->next);
3320 if (EQ (following, tem))
3322 XSYMBOL (tail)->next = XSYMBOL (following)->next;
3323 break;
3328 return Qt;
3331 /* Return the symbol in OBARRAY whose names matches the string
3332 of SIZE characters (SIZE_BYTE bytes) at PTR.
3333 If there is no such symbol in OBARRAY, return nil.
3335 Also store the bucket number in oblookup_last_bucket_number. */
3337 Lisp_Object
3338 oblookup (obarray, ptr, size, size_byte)
3339 Lisp_Object obarray;
3340 register const char *ptr;
3341 int size, size_byte;
3343 int hash;
3344 int obsize;
3345 register Lisp_Object tail;
3346 Lisp_Object bucket, tem;
3348 if (!VECTORP (obarray)
3349 || (obsize = XVECTOR (obarray)->size) == 0)
3351 obarray = check_obarray (obarray);
3352 obsize = XVECTOR (obarray)->size;
3354 /* This is sometimes needed in the middle of GC. */
3355 obsize &= ~ARRAY_MARK_FLAG;
3356 /* Combining next two lines breaks VMS C 2.3. */
3357 hash = hash_string (ptr, size_byte);
3358 hash %= obsize;
3359 bucket = XVECTOR (obarray)->contents[hash];
3360 oblookup_last_bucket_number = hash;
3361 if (EQ (bucket, make_number (0)))
3363 else if (!SYMBOLP (bucket))
3364 error ("Bad data in guts of obarray"); /* Like CADR error message */
3365 else
3366 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
3368 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3369 && SCHARS (SYMBOL_NAME (tail)) == size
3370 && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
3371 return tail;
3372 else if (XSYMBOL (tail)->next == 0)
3373 break;
3375 XSETINT (tem, hash);
3376 return tem;
3379 static int
3380 hash_string (ptr, len)
3381 const unsigned char *ptr;
3382 int len;
3384 register const unsigned char *p = ptr;
3385 register const unsigned char *end = p + len;
3386 register unsigned char c;
3387 register int hash = 0;
3389 while (p != end)
3391 c = *p++;
3392 if (c >= 0140) c -= 40;
3393 hash = ((hash<<3) + (hash>>28) + c);
3395 return hash & 07777777777;
3398 void
3399 map_obarray (obarray, fn, arg)
3400 Lisp_Object obarray;
3401 void (*fn) P_ ((Lisp_Object, Lisp_Object));
3402 Lisp_Object arg;
3404 register int i;
3405 register Lisp_Object tail;
3406 CHECK_VECTOR (obarray);
3407 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
3409 tail = XVECTOR (obarray)->contents[i];
3410 if (SYMBOLP (tail))
3411 while (1)
3413 (*fn) (tail, arg);
3414 if (XSYMBOL (tail)->next == 0)
3415 break;
3416 XSETSYMBOL (tail, XSYMBOL (tail)->next);
3421 void
3422 mapatoms_1 (sym, function)
3423 Lisp_Object sym, function;
3425 call1 (function, sym);
3428 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
3429 doc: /* Call FUNCTION on every symbol in OBARRAY.
3430 OBARRAY defaults to the value of `obarray'. */)
3431 (function, obarray)
3432 Lisp_Object function, obarray;
3434 if (NILP (obarray)) obarray = Vobarray;
3435 obarray = check_obarray (obarray);
3437 map_obarray (obarray, mapatoms_1, function);
3438 return Qnil;
3441 #define OBARRAY_SIZE 1511
3443 void
3444 init_obarray ()
3446 Lisp_Object oblength;
3447 int hash;
3448 Lisp_Object *tem;
3450 XSETFASTINT (oblength, OBARRAY_SIZE);
3452 Qnil = Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3453 Vobarray = Fmake_vector (oblength, make_number (0));
3454 initial_obarray = Vobarray;
3455 staticpro (&initial_obarray);
3456 /* Intern nil in the obarray */
3457 XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3458 XSYMBOL (Qnil)->constant = 1;
3460 /* These locals are to kludge around a pyramid compiler bug. */
3461 hash = hash_string ("nil", 3);
3462 /* Separate statement here to avoid VAXC bug. */
3463 hash %= OBARRAY_SIZE;
3464 tem = &XVECTOR (Vobarray)->contents[hash];
3465 *tem = Qnil;
3467 Qunbound = Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3468 XSYMBOL (Qnil)->function = Qunbound;
3469 XSYMBOL (Qunbound)->value = Qunbound;
3470 XSYMBOL (Qunbound)->function = Qunbound;
3472 Qt = intern ("t");
3473 XSYMBOL (Qnil)->value = Qnil;
3474 XSYMBOL (Qnil)->plist = Qnil;
3475 XSYMBOL (Qt)->value = Qt;
3476 XSYMBOL (Qt)->constant = 1;
3478 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3479 Vpurify_flag = Qt;
3481 Qvariable_documentation = intern ("variable-documentation");
3482 staticpro (&Qvariable_documentation);
3484 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
3485 read_buffer = (char *) xmalloc (read_buffer_size);
3488 void
3489 defsubr (sname)
3490 struct Lisp_Subr *sname;
3492 Lisp_Object sym;
3493 sym = intern (sname->symbol_name);
3494 XSETSUBR (XSYMBOL (sym)->function, sname);
3497 #ifdef NOTDEF /* use fset in subr.el now */
3498 void
3499 defalias (sname, string)
3500 struct Lisp_Subr *sname;
3501 char *string;
3503 Lisp_Object sym;
3504 sym = intern (string);
3505 XSETSUBR (XSYMBOL (sym)->function, sname);
3507 #endif /* NOTDEF */
3509 /* Define an "integer variable"; a symbol whose value is forwarded
3510 to a C variable of type int. Sample call: */
3511 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3512 void
3513 defvar_int (namestring, address)
3514 char *namestring;
3515 EMACS_INT *address;
3517 Lisp_Object sym, val;
3518 sym = intern (namestring);
3519 val = allocate_misc ();
3520 XMISCTYPE (val) = Lisp_Misc_Intfwd;
3521 XINTFWD (val)->intvar = address;
3522 SET_SYMBOL_VALUE (sym, val);
3525 /* Similar but define a variable whose value is t if address contains 1,
3526 nil if address contains 0 */
3527 void
3528 defvar_bool (namestring, address)
3529 char *namestring;
3530 int *address;
3532 Lisp_Object sym, val;
3533 sym = intern (namestring);
3534 val = allocate_misc ();
3535 XMISCTYPE (val) = Lisp_Misc_Boolfwd;
3536 XBOOLFWD (val)->boolvar = address;
3537 SET_SYMBOL_VALUE (sym, val);
3538 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
3541 /* Similar but define a variable whose value is the Lisp Object stored
3542 at address. Two versions: with and without gc-marking of the C
3543 variable. The nopro version is used when that variable will be
3544 gc-marked for some other reason, since marking the same slot twice
3545 can cause trouble with strings. */
3546 void
3547 defvar_lisp_nopro (namestring, address)
3548 char *namestring;
3549 Lisp_Object *address;
3551 Lisp_Object sym, val;
3552 sym = intern (namestring);
3553 val = allocate_misc ();
3554 XMISCTYPE (val) = Lisp_Misc_Objfwd;
3555 XOBJFWD (val)->objvar = address;
3556 SET_SYMBOL_VALUE (sym, val);
3559 void
3560 defvar_lisp (namestring, address)
3561 char *namestring;
3562 Lisp_Object *address;
3564 defvar_lisp_nopro (namestring, address);
3565 staticpro (address);
3568 /* Similar but define a variable whose value is the Lisp Object stored in
3569 the current buffer. address is the address of the slot in the buffer
3570 that is current now. */
3572 void
3573 defvar_per_buffer (namestring, address, type, doc)
3574 char *namestring;
3575 Lisp_Object *address;
3576 Lisp_Object type;
3577 char *doc;
3579 Lisp_Object sym, val;
3580 int offset;
3582 sym = intern (namestring);
3583 val = allocate_misc ();
3584 offset = (char *)address - (char *)current_buffer;
3586 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
3587 XBUFFER_OBJFWD (val)->offset = offset;
3588 SET_SYMBOL_VALUE (sym, val);
3589 PER_BUFFER_SYMBOL (offset) = sym;
3590 PER_BUFFER_TYPE (offset) = type;
3592 if (PER_BUFFER_IDX (offset) == 0)
3593 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3594 slot of buffer_local_flags */
3595 abort ();
3599 /* Similar but define a variable whose value is the Lisp Object stored
3600 at a particular offset in the current kboard object. */
3602 void
3603 defvar_kboard (namestring, offset)
3604 char *namestring;
3605 int offset;
3607 Lisp_Object sym, val;
3608 sym = intern (namestring);
3609 val = allocate_misc ();
3610 XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd;
3611 XKBOARD_OBJFWD (val)->offset = offset;
3612 SET_SYMBOL_VALUE (sym, val);
3615 /* Record the value of load-path used at the start of dumping
3616 so we can see if the site changed it later during dumping. */
3617 static Lisp_Object dump_path;
3619 void
3620 init_lread ()
3622 char *normal;
3623 int turn_off_warning = 0;
3625 /* Compute the default load-path. */
3626 #ifdef CANNOT_DUMP
3627 normal = PATH_LOADSEARCH;
3628 Vload_path = decode_env_path (0, normal);
3629 #else
3630 if (NILP (Vpurify_flag))
3631 normal = PATH_LOADSEARCH;
3632 else
3633 normal = PATH_DUMPLOADSEARCH;
3635 /* In a dumped Emacs, we normally have to reset the value of
3636 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3637 uses ../lisp, instead of the path of the installed elisp
3638 libraries. However, if it appears that Vload_path was changed
3639 from the default before dumping, don't override that value. */
3640 if (initialized)
3642 if (! NILP (Fequal (dump_path, Vload_path)))
3644 Vload_path = decode_env_path (0, normal);
3645 if (!NILP (Vinstallation_directory))
3647 Lisp_Object tem, tem1, sitelisp;
3649 /* Remove site-lisp dirs from path temporarily and store
3650 them in sitelisp, then conc them on at the end so
3651 they're always first in path. */
3652 sitelisp = Qnil;
3653 while (1)
3655 tem = Fcar (Vload_path);
3656 tem1 = Fstring_match (build_string ("site-lisp"),
3657 tem, Qnil);
3658 if (!NILP (tem1))
3660 Vload_path = Fcdr (Vload_path);
3661 sitelisp = Fcons (tem, sitelisp);
3663 else
3664 break;
3667 /* Add to the path the lisp subdir of the
3668 installation dir, if it exists. */
3669 tem = Fexpand_file_name (build_string ("lisp"),
3670 Vinstallation_directory);
3671 tem1 = Ffile_exists_p (tem);
3672 if (!NILP (tem1))
3674 if (NILP (Fmember (tem, Vload_path)))
3676 turn_off_warning = 1;
3677 Vload_path = Fcons (tem, Vload_path);
3680 else
3681 /* That dir doesn't exist, so add the build-time
3682 Lisp dirs instead. */
3683 Vload_path = nconc2 (Vload_path, dump_path);
3685 /* Add leim under the installation dir, if it exists. */
3686 tem = Fexpand_file_name (build_string ("leim"),
3687 Vinstallation_directory);
3688 tem1 = Ffile_exists_p (tem);
3689 if (!NILP (tem1))
3691 if (NILP (Fmember (tem, Vload_path)))
3692 Vload_path = Fcons (tem, Vload_path);
3695 /* Add site-list under the installation dir, if it exists. */
3696 tem = Fexpand_file_name (build_string ("site-lisp"),
3697 Vinstallation_directory);
3698 tem1 = Ffile_exists_p (tem);
3699 if (!NILP (tem1))
3701 if (NILP (Fmember (tem, Vload_path)))
3702 Vload_path = Fcons (tem, Vload_path);
3705 /* If Emacs was not built in the source directory,
3706 and it is run from where it was built, add to load-path
3707 the lisp, leim and site-lisp dirs under that directory. */
3709 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
3711 Lisp_Object tem2;
3713 tem = Fexpand_file_name (build_string ("src/Makefile"),
3714 Vinstallation_directory);
3715 tem1 = Ffile_exists_p (tem);
3717 /* Don't be fooled if they moved the entire source tree
3718 AFTER dumping Emacs. If the build directory is indeed
3719 different from the source dir, src/Makefile.in and
3720 src/Makefile will not be found together. */
3721 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
3722 Vinstallation_directory);
3723 tem2 = Ffile_exists_p (tem);
3724 if (!NILP (tem1) && NILP (tem2))
3726 tem = Fexpand_file_name (build_string ("lisp"),
3727 Vsource_directory);
3729 if (NILP (Fmember (tem, Vload_path)))
3730 Vload_path = Fcons (tem, Vload_path);
3732 tem = Fexpand_file_name (build_string ("leim"),
3733 Vsource_directory);
3735 if (NILP (Fmember (tem, Vload_path)))
3736 Vload_path = Fcons (tem, Vload_path);
3738 tem = Fexpand_file_name (build_string ("site-lisp"),
3739 Vsource_directory);
3741 if (NILP (Fmember (tem, Vload_path)))
3742 Vload_path = Fcons (tem, Vload_path);
3745 if (!NILP (sitelisp))
3746 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
3750 else
3752 /* NORMAL refers to the lisp dir in the source directory. */
3753 /* We used to add ../lisp at the front here, but
3754 that caused trouble because it was copied from dump_path
3755 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3756 It should be unnecessary. */
3757 Vload_path = decode_env_path (0, normal);
3758 dump_path = Vload_path;
3760 #endif
3762 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3763 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3764 almost never correct, thereby causing a warning to be printed out that
3765 confuses users. Since PATH_LOADSEARCH is always overridden by the
3766 EMACSLOADPATH environment variable below, disable the warning on NT.
3767 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3768 the "standard" paths may not exist and would be overridden by
3769 EMACSLOADPATH as on NT. Since this depends on how the executable
3770 was build and packaged, turn off the warnings in general */
3772 /* Warn if dirs in the *standard* path don't exist. */
3773 if (!turn_off_warning)
3775 Lisp_Object path_tail;
3777 for (path_tail = Vload_path;
3778 !NILP (path_tail);
3779 path_tail = XCDR (path_tail))
3781 Lisp_Object dirfile;
3782 dirfile = Fcar (path_tail);
3783 if (STRINGP (dirfile))
3785 dirfile = Fdirectory_file_name (dirfile);
3786 if (access (SDATA (dirfile), 0) < 0)
3787 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3788 XCAR (path_tail));
3792 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3794 /* If the EMACSLOADPATH environment variable is set, use its value.
3795 This doesn't apply if we're dumping. */
3796 #ifndef CANNOT_DUMP
3797 if (NILP (Vpurify_flag)
3798 && egetenv ("EMACSLOADPATH"))
3799 #endif
3800 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
3802 Vvalues = Qnil;
3804 load_in_progress = 0;
3805 Vload_file_name = Qnil;
3807 load_descriptor_list = Qnil;
3809 Vstandard_input = Qt;
3810 Vloads_in_progress = Qnil;
3813 /* Print a warning, using format string FORMAT, that directory DIRNAME
3814 does not exist. Print it on stderr and put it in *Message*. */
3816 void
3817 dir_warning (format, dirname)
3818 char *format;
3819 Lisp_Object dirname;
3821 char *buffer
3822 = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
3824 fprintf (stderr, format, SDATA (dirname));
3825 sprintf (buffer, format, SDATA (dirname));
3826 /* Don't log the warning before we've initialized!! */
3827 if (initialized)
3828 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
3831 void
3832 syms_of_lread ()
3834 defsubr (&Sread);
3835 defsubr (&Sread_from_string);
3836 defsubr (&Sintern);
3837 defsubr (&Sintern_soft);
3838 defsubr (&Sunintern);
3839 defsubr (&Sload);
3840 defsubr (&Seval_buffer);
3841 defsubr (&Seval_region);
3842 defsubr (&Sread_char);
3843 defsubr (&Sread_char_exclusive);
3844 defsubr (&Sread_event);
3845 defsubr (&Sget_file_char);
3846 defsubr (&Smapatoms);
3847 defsubr (&Slocate_file_internal);
3849 DEFVAR_LISP ("obarray", &Vobarray,
3850 doc: /* Symbol table for use by `intern' and `read'.
3851 It is a vector whose length ought to be prime for best results.
3852 The vector's contents don't make sense if examined from Lisp programs;
3853 to find all the symbols in an obarray, use `mapatoms'. */);
3855 DEFVAR_LISP ("values", &Vvalues,
3856 doc: /* List of values of all expressions which were read, evaluated and printed.
3857 Order is reverse chronological. */);
3859 DEFVAR_LISP ("standard-input", &Vstandard_input,
3860 doc: /* Stream for read to get input from.
3861 See documentation of `read' for possible values. */);
3862 Vstandard_input = Qt;
3864 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
3865 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3867 If this variable is a buffer, then only forms read from that buffer
3868 will be added to `read-symbol-positions-list'.
3869 If this variable is t, then all read forms will be added.
3870 The effect of all other values other than nil are not currently
3871 defined, although they may be in the future.
3873 The positions are relative to the last call to `read' or
3874 `read-from-string'. It is probably a bad idea to set this variable at
3875 the toplevel; bind it instead. */);
3876 Vread_with_symbol_positions = Qnil;
3878 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
3879 doc: /* A list mapping read symbols to their positions.
3880 This variable is modified during calls to `read' or
3881 `read-from-string', but only when `read-with-symbol-positions' is
3882 non-nil.
3884 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3885 CHAR-POSITION is an integer giving the offset of that occurrence of the
3886 symbol from the position where `read' or `read-from-string' started.
3888 Note that a symbol will appear multiple times in this list, if it was
3889 read multiple times. The list is in the same order as the symbols
3890 were read in. */);
3891 Vread_symbol_positions_list = Qnil;
3893 DEFVAR_LISP ("load-path", &Vload_path,
3894 doc: /* *List of directories to search for files to load.
3895 Each element is a string (directory name) or nil (try default directory).
3896 Initialized based on EMACSLOADPATH environment variable, if any,
3897 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3899 DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
3900 doc: /* *List of suffixes to try for files to load.
3901 This list should not include the empty string. */);
3902 Vload_suffixes = Fcons (build_string (".elc"),
3903 Fcons (build_string (".el"), Qnil));
3904 /* We don't use empty_string because it's not initialized yet. */
3905 default_suffixes = Fcons (build_string (""), Qnil);
3906 staticpro (&default_suffixes);
3908 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
3909 doc: /* Non-nil iff inside of `load'. */);
3911 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
3912 doc: /* An alist of expressions to be evalled when particular files are loaded.
3913 Each element looks like (FILENAME FORMS...).
3914 When `load' is run and the file-name argument is FILENAME,
3915 the FORMS in the corresponding element are executed at the end of loading.
3917 FILENAME must match exactly! Normally FILENAME is the name of a library,
3918 with no directory specified, since that is how `load' is normally called.
3919 An error in FORMS does not undo the load,
3920 but does prevent execution of the rest of the FORMS.
3921 FILENAME can also be a symbol (a feature) and FORMS are then executed
3922 when the corresponding call to `provide' is made. */);
3923 Vafter_load_alist = Qnil;
3925 DEFVAR_LISP ("load-history", &Vload_history,
3926 doc: /* Alist mapping file names to symbols and features.
3927 Each alist element is a list that starts with a file name,
3928 except for one element (optional) that starts with nil and describes
3929 definitions evaluated from buffers not visiting files.
3930 The remaining elements of each list are symbols defined as variables
3931 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3932 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3933 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3934 and means that SYMBOL was an autoload before this file redefined it
3935 as a function.
3937 During preloading, the file name recorded is relative to the main Lisp
3938 directory. These file names are converted to absolute at startup. */);
3939 Vload_history = Qnil;
3941 DEFVAR_LISP ("load-file-name", &Vload_file_name,
3942 doc: /* Full name of file being loaded by `load'. */);
3943 Vload_file_name = Qnil;
3945 DEFVAR_LISP ("user-init-file", &Vuser_init_file,
3946 doc: /* File name, including directory, of user's initialization file.
3947 If the file loaded had extension `.elc', and the corresponding source file
3948 exists, this variable contains the name of source file, suitable for use
3949 by functions like `custom-save-all' which edit the init file. */);
3950 Vuser_init_file = Qnil;
3952 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
3953 doc: /* Used for internal purposes by `load'. */);
3954 Vcurrent_load_list = Qnil;
3956 DEFVAR_LISP ("load-read-function", &Vload_read_function,
3957 doc: /* Function used by `load' and `eval-region' for reading expressions.
3958 The default is nil, which means use the function `read'. */);
3959 Vload_read_function = Qnil;
3961 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
3962 doc: /* Function called in `load' for loading an Emacs lisp source file.
3963 This function is for doing code conversion before reading the source file.
3964 If nil, loading is done without any code conversion.
3965 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3966 FULLNAME is the full name of FILE.
3967 See `load' for the meaning of the remaining arguments. */);
3968 Vload_source_file_function = Qnil;
3970 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
3971 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
3972 This is useful when the file being loaded is a temporary copy. */);
3973 load_force_doc_strings = 0;
3975 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
3976 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
3977 This is normally bound by `load' and `eval-buffer' to control `read',
3978 and is not meant for users to change. */);
3979 load_convert_to_unibyte = 0;
3981 DEFVAR_LISP ("source-directory", &Vsource_directory,
3982 doc: /* Directory in which Emacs sources were found when Emacs was built.
3983 You cannot count on them to still be there! */);
3984 Vsource_directory
3985 = Fexpand_file_name (build_string ("../"),
3986 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
3988 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
3989 doc: /* List of files that were preloaded (when dumping Emacs). */);
3990 Vpreloaded_file_list = Qnil;
3992 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
3993 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3994 Vbyte_boolean_vars = Qnil;
3996 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
3997 doc: /* Non-nil means load dangerous compiled Lisp files.
3998 Some versions of XEmacs use different byte codes than Emacs. These
3999 incompatible byte codes can make Emacs crash when it tries to execute
4000 them. */);
4001 load_dangerous_libraries = 0;
4003 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
4004 doc: /* Regular expression matching safe to load compiled Lisp files.
4005 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4006 from the file, and matches them against this regular expression.
4007 When the regular expression matches, the file is considered to be safe
4008 to load. See also `load-dangerous-libraries'. */);
4009 Vbytecomp_version_regexp
4010 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4012 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
4013 doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4014 Veval_buffer_list = Qnil;
4016 /* Vsource_directory was initialized in init_lread. */
4018 load_descriptor_list = Qnil;
4019 staticpro (&load_descriptor_list);
4021 Qcurrent_load_list = intern ("current-load-list");
4022 staticpro (&Qcurrent_load_list);
4024 Qstandard_input = intern ("standard-input");
4025 staticpro (&Qstandard_input);
4027 Qread_char = intern ("read-char");
4028 staticpro (&Qread_char);
4030 Qget_file_char = intern ("get-file-char");
4031 staticpro (&Qget_file_char);
4033 Qbackquote = intern ("`");
4034 staticpro (&Qbackquote);
4035 Qcomma = intern (",");
4036 staticpro (&Qcomma);
4037 Qcomma_at = intern (",@");
4038 staticpro (&Qcomma_at);
4039 Qcomma_dot = intern (",.");
4040 staticpro (&Qcomma_dot);
4042 Qinhibit_file_name_operation = intern ("inhibit-file-name-operation");
4043 staticpro (&Qinhibit_file_name_operation);
4045 Qascii_character = intern ("ascii-character");
4046 staticpro (&Qascii_character);
4048 Qfunction = intern ("function");
4049 staticpro (&Qfunction);
4051 Qload = intern ("load");
4052 staticpro (&Qload);
4054 Qload_file_name = intern ("load-file-name");
4055 staticpro (&Qload_file_name);
4057 Qeval_buffer_list = intern ("eval-buffer-list");
4058 staticpro (&Qeval_buffer_list);
4060 staticpro (&dump_path);
4062 staticpro (&read_objects);
4063 read_objects = Qnil;
4064 staticpro (&seen_list);
4065 seen_list = Qnil;
4067 Vloads_in_progress = Qnil;
4068 staticpro (&Vloads_in_progress);
4071 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4072 (do not change this comment) */