* lisp/progmodes/which-func.el (which-func-ff-hook): Log the error message.
[emacs.git] / src / lread.c
blobbfe3755cc51bf4e0b7e91b1218005b6fff5b2e29
1 /* Lisp parsing and input streams.
3 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997,
4 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 2009, 2010 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <config.h>
24 #include <stdio.h>
25 #include <sys/types.h>
26 #include <sys/stat.h>
27 #include <sys/file.h>
28 #include <errno.h>
29 #include <setjmp.h>
30 #include "lisp.h"
31 #include "intervals.h"
32 #include "buffer.h"
33 #include "character.h"
34 #include "charset.h"
35 #include "coding.h"
36 #include <epaths.h>
37 #include "commands.h"
38 #include "keyboard.h"
39 #include "frame.h"
40 #include "termhooks.h"
41 #include "coding.h"
42 #include "blockinput.h"
44 #ifdef MSDOS
45 #include "msdos.h"
46 #endif
48 #ifdef HAVE_UNISTD_H
49 #include <unistd.h>
50 #endif
52 #include <math.h>
54 #ifdef HAVE_SETLOCALE
55 #include <locale.h>
56 #endif /* HAVE_SETLOCALE */
58 #include <fcntl.h>
60 #ifdef HAVE_FSEEKO
61 #define file_offset off_t
62 #define file_tell ftello
63 #else
64 #define file_offset long
65 #define file_tell ftell
66 #endif
68 /* hash table read constants */
69 Lisp_Object Qhash_table, Qdata;
70 Lisp_Object Qtest, Qsize;
71 Lisp_Object Qweakness;
72 Lisp_Object Qrehash_size;
73 Lisp_Object Qrehash_threshold;
75 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
76 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
77 Lisp_Object Qascii_character, Qload, Qload_file_name;
78 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
79 Lisp_Object Qinhibit_file_name_operation;
80 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
81 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
83 /* Used instead of Qget_file_char while loading *.elc files compiled
84 by Emacs 21 or older. */
85 static Lisp_Object Qget_emacs_mule_file_char;
87 static Lisp_Object Qload_force_doc_strings;
89 /* non-zero if inside `load' */
90 int load_in_progress;
91 static Lisp_Object Qload_in_progress;
93 /* Directory in which the sources were found. */
94 Lisp_Object Vsource_directory;
96 /* Search path and suffixes for files to be loaded. */
97 Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes;
99 /* File name of user's init file. */
100 Lisp_Object Vuser_init_file;
102 /* This is the user-visible association list that maps features to
103 lists of defs in their load files. */
104 Lisp_Object Vload_history;
106 /* This is used to build the load history. */
107 Lisp_Object Vcurrent_load_list;
109 /* List of files that were preloaded. */
110 Lisp_Object Vpreloaded_file_list;
112 /* Name of file actually being read by `load'. */
113 Lisp_Object Vload_file_name;
115 /* Function to use for reading, in `load' and friends. */
116 Lisp_Object Vload_read_function;
118 /* Non-nil means read recursive structures using #n= and #n# syntax. */
119 Lisp_Object Vread_circle;
121 /* The association list of objects read with the #n=object form.
122 Each member of the list has the form (n . object), and is used to
123 look up the object for the corresponding #n# construct.
124 It must be set to nil before all top-level calls to read0. */
125 Lisp_Object read_objects;
127 /* Nonzero means load should forcibly load all dynamic doc strings. */
128 static int load_force_doc_strings;
130 /* Nonzero means read should convert strings to unibyte. */
131 static int load_convert_to_unibyte;
133 /* Nonzero means READCHAR should read bytes one by one (not character)
134 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
135 This is set to 1 by read1 temporarily while handling #@NUMBER. */
136 static int load_each_byte;
138 /* Function to use for loading an Emacs Lisp source file (not
139 compiled) instead of readevalloop. */
140 Lisp_Object Vload_source_file_function;
142 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
143 Lisp_Object Vbyte_boolean_vars;
145 /* Whether or not to add a `read-positions' property to symbols
146 read. */
147 Lisp_Object Vread_with_symbol_positions;
149 /* List of (SYMBOL . POSITION) accumulated so far. */
150 Lisp_Object Vread_symbol_positions_list;
152 /* List of descriptors now open for Fload. */
153 static Lisp_Object load_descriptor_list;
155 /* File for get_file_char to read from. Use by load. */
156 static FILE *instream;
158 /* When nonzero, read conses in pure space */
159 static int read_pure;
161 /* For use within read-from-string (this reader is non-reentrant!!) */
162 static EMACS_INT read_from_string_index;
163 static EMACS_INT read_from_string_index_byte;
164 static EMACS_INT read_from_string_limit;
166 /* Number of characters read in the current call to Fread or
167 Fread_from_string. */
168 static EMACS_INT readchar_count;
170 /* This contains the last string skipped with #@. */
171 static char *saved_doc_string;
172 /* Length of buffer allocated in saved_doc_string. */
173 static int saved_doc_string_size;
174 /* Length of actual data in saved_doc_string. */
175 static int saved_doc_string_length;
176 /* This is the file position that string came from. */
177 static file_offset saved_doc_string_position;
179 /* This contains the previous string skipped with #@.
180 We copy it from saved_doc_string when a new string
181 is put in saved_doc_string. */
182 static char *prev_saved_doc_string;
183 /* Length of buffer allocated in prev_saved_doc_string. */
184 static int prev_saved_doc_string_size;
185 /* Length of actual data in prev_saved_doc_string. */
186 static int prev_saved_doc_string_length;
187 /* This is the file position that string came from. */
188 static file_offset prev_saved_doc_string_position;
190 /* Nonzero means inside a new-style backquote
191 with no surrounding parentheses.
192 Fread initializes this to zero, so we need not specbind it
193 or worry about what happens to it when there is an error. */
194 static int new_backquote_flag;
195 static Lisp_Object Vold_style_backquotes, Qold_style_backquotes;
197 /* A list of file names for files being loaded in Fload. Used to
198 check for recursive loads. */
200 static Lisp_Object Vloads_in_progress;
202 /* Non-zero means load dangerous compiled Lisp files. */
204 int load_dangerous_libraries;
206 /* Non-zero means force printing messages when loading Lisp files. */
208 int force_load_messages;
210 /* A regular expression used to detect files compiled with Emacs. */
212 static Lisp_Object Vbytecomp_version_regexp;
214 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
215 Lisp_Object);
217 static void readevalloop (Lisp_Object, FILE*, Lisp_Object,
218 Lisp_Object (*) (Lisp_Object), int,
219 Lisp_Object, Lisp_Object,
220 Lisp_Object, Lisp_Object);
221 static Lisp_Object load_unwind (Lisp_Object);
222 static Lisp_Object load_descriptor_unwind (Lisp_Object);
224 static void invalid_syntax (const char *, int) NO_RETURN;
225 static void end_of_file_error (void) NO_RETURN;
228 /* Functions that read one byte from the current source READCHARFUN
229 or unreads one byte. If the integer argument C is -1, it returns
230 one read byte, or -1 when there's no more byte in the source. If C
231 is 0 or positive, it unreads C, and the return value is not
232 interesting. */
234 static int readbyte_for_lambda (int, Lisp_Object);
235 static int readbyte_from_file (int, Lisp_Object);
236 static int readbyte_from_string (int, Lisp_Object);
238 /* Handle unreading and rereading of characters.
239 Write READCHAR to read a character,
240 UNREAD(c) to unread c to be read again.
242 These macros correctly read/unread multibyte characters. */
244 #define READCHAR readchar (readcharfun, NULL)
245 #define UNREAD(c) unreadchar (readcharfun, c)
247 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
248 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
250 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
251 Qlambda, or a cons, we use this to keep an unread character because
252 a file stream can't handle multibyte-char unreading. The value -1
253 means that there's no unread character. */
254 static int unread_char;
256 static int
257 readchar (Lisp_Object readcharfun, int *multibyte)
259 Lisp_Object tem;
260 register int c;
261 int (*readbyte) (int, Lisp_Object);
262 unsigned char buf[MAX_MULTIBYTE_LENGTH];
263 int i, len;
264 int emacs_mule_encoding = 0;
266 if (multibyte)
267 *multibyte = 0;
269 readchar_count++;
271 if (BUFFERP (readcharfun))
273 register struct buffer *inbuffer = XBUFFER (readcharfun);
275 EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer);
277 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
278 return -1;
280 if (! NILP (inbuffer->enable_multibyte_characters))
282 /* Fetch the character code from the buffer. */
283 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
284 BUF_INC_POS (inbuffer, pt_byte);
285 c = STRING_CHAR (p);
286 if (multibyte)
287 *multibyte = 1;
289 else
291 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
292 if (! ASCII_BYTE_P (c))
293 c = BYTE8_TO_CHAR (c);
294 pt_byte++;
296 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
298 return c;
300 if (MARKERP (readcharfun))
302 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
304 EMACS_INT bytepos = marker_byte_position (readcharfun);
306 if (bytepos >= BUF_ZV_BYTE (inbuffer))
307 return -1;
309 if (! NILP (inbuffer->enable_multibyte_characters))
311 /* Fetch the character code from the buffer. */
312 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
313 BUF_INC_POS (inbuffer, bytepos);
314 c = STRING_CHAR (p);
315 if (multibyte)
316 *multibyte = 1;
318 else
320 c = BUF_FETCH_BYTE (inbuffer, bytepos);
321 if (! ASCII_BYTE_P (c))
322 c = BYTE8_TO_CHAR (c);
323 bytepos++;
326 XMARKER (readcharfun)->bytepos = bytepos;
327 XMARKER (readcharfun)->charpos++;
329 return c;
332 if (EQ (readcharfun, Qlambda))
334 readbyte = readbyte_for_lambda;
335 goto read_multibyte;
338 if (EQ (readcharfun, Qget_file_char))
340 readbyte = readbyte_from_file;
341 goto read_multibyte;
344 if (STRINGP (readcharfun))
346 if (read_from_string_index >= read_from_string_limit)
347 c = -1;
348 else if (STRING_MULTIBYTE (readcharfun))
350 if (multibyte)
351 *multibyte = 1;
352 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
353 read_from_string_index,
354 read_from_string_index_byte);
356 else
358 c = SREF (readcharfun, read_from_string_index_byte);
359 read_from_string_index++;
360 read_from_string_index_byte++;
362 return c;
365 if (CONSP (readcharfun))
367 /* This is the case that read_vector is reading from a unibyte
368 string that contains a byte sequence previously skipped
369 because of #@NUMBER. The car part of readcharfun is that
370 string, and the cdr part is a value of readcharfun given to
371 read_vector. */
372 readbyte = readbyte_from_string;
373 if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
374 emacs_mule_encoding = 1;
375 goto read_multibyte;
378 if (EQ (readcharfun, Qget_emacs_mule_file_char))
380 readbyte = readbyte_from_file;
381 emacs_mule_encoding = 1;
382 goto read_multibyte;
385 tem = call0 (readcharfun);
387 if (NILP (tem))
388 return -1;
389 return XINT (tem);
391 read_multibyte:
392 if (unread_char >= 0)
394 c = unread_char;
395 unread_char = -1;
396 return c;
398 c = (*readbyte) (-1, readcharfun);
399 if (c < 0 || load_each_byte)
400 return c;
401 if (multibyte)
402 *multibyte = 1;
403 if (ASCII_BYTE_P (c))
404 return c;
405 if (emacs_mule_encoding)
406 return read_emacs_mule_char (c, readbyte, readcharfun);
407 i = 0;
408 buf[i++] = c;
409 len = BYTES_BY_CHAR_HEAD (c);
410 while (i < len)
412 c = (*readbyte) (-1, readcharfun);
413 if (c < 0 || ! TRAILING_CODE_P (c))
415 while (--i > 1)
416 (*readbyte) (buf[i], readcharfun);
417 return BYTE8_TO_CHAR (buf[0]);
419 buf[i++] = c;
421 return STRING_CHAR (buf);
424 /* Unread the character C in the way appropriate for the stream READCHARFUN.
425 If the stream is a user function, call it with the char as argument. */
427 static void
428 unreadchar (Lisp_Object readcharfun, int c)
430 readchar_count--;
431 if (c == -1)
432 /* Don't back up the pointer if we're unreading the end-of-input mark,
433 since readchar didn't advance it when we read it. */
435 else if (BUFFERP (readcharfun))
437 struct buffer *b = XBUFFER (readcharfun);
438 EMACS_INT bytepos = BUF_PT_BYTE (b);
440 BUF_PT (b)--;
441 if (! NILP (b->enable_multibyte_characters))
442 BUF_DEC_POS (b, bytepos);
443 else
444 bytepos--;
446 BUF_PT_BYTE (b) = bytepos;
448 else if (MARKERP (readcharfun))
450 struct buffer *b = XMARKER (readcharfun)->buffer;
451 EMACS_INT bytepos = XMARKER (readcharfun)->bytepos;
453 XMARKER (readcharfun)->charpos--;
454 if (! NILP (b->enable_multibyte_characters))
455 BUF_DEC_POS (b, bytepos);
456 else
457 bytepos--;
459 XMARKER (readcharfun)->bytepos = bytepos;
461 else if (STRINGP (readcharfun))
463 read_from_string_index--;
464 read_from_string_index_byte
465 = string_char_to_byte (readcharfun, read_from_string_index);
467 else if (CONSP (readcharfun))
469 unread_char = c;
471 else if (EQ (readcharfun, Qlambda))
473 unread_char = c;
475 else if (EQ (readcharfun, Qget_file_char)
476 || EQ (readcharfun, Qget_emacs_mule_file_char))
478 if (load_each_byte)
480 BLOCK_INPUT;
481 ungetc (c, instream);
482 UNBLOCK_INPUT;
484 else
485 unread_char = c;
487 else
488 call1 (readcharfun, make_number (c));
491 static int
492 readbyte_for_lambda (int c, Lisp_Object readcharfun)
494 return read_bytecode_char (c >= 0);
498 static int
499 readbyte_from_file (int c, Lisp_Object readcharfun)
501 if (c >= 0)
503 BLOCK_INPUT;
504 ungetc (c, instream);
505 UNBLOCK_INPUT;
506 return 0;
509 BLOCK_INPUT;
510 c = getc (instream);
512 #ifdef EINTR
513 /* Interrupted reads have been observed while reading over the network */
514 while (c == EOF && ferror (instream) && errno == EINTR)
516 UNBLOCK_INPUT;
517 QUIT;
518 BLOCK_INPUT;
519 clearerr (instream);
520 c = getc (instream);
522 #endif
524 UNBLOCK_INPUT;
526 return (c == EOF ? -1 : c);
529 static int
530 readbyte_from_string (int c, Lisp_Object readcharfun)
532 Lisp_Object string = XCAR (readcharfun);
534 if (c >= 0)
536 read_from_string_index--;
537 read_from_string_index_byte
538 = string_char_to_byte (string, read_from_string_index);
541 if (read_from_string_index >= read_from_string_limit)
542 c = -1;
543 else
544 FETCH_STRING_CHAR_ADVANCE (c, string,
545 read_from_string_index,
546 read_from_string_index_byte);
547 return c;
551 /* Read one non-ASCII character from INSTREAM. The character is
552 encoded in `emacs-mule' and the first byte is already read in
553 C. */
555 static int
556 read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
558 /* Emacs-mule coding uses at most 4-byte for one character. */
559 unsigned char buf[4];
560 int len = emacs_mule_bytes[c];
561 struct charset *charset;
562 int i;
563 unsigned code;
565 if (len == 1)
566 /* C is not a valid leading-code of `emacs-mule'. */
567 return BYTE8_TO_CHAR (c);
569 i = 0;
570 buf[i++] = c;
571 while (i < len)
573 c = (*readbyte) (-1, readcharfun);
574 if (c < 0xA0)
576 while (--i > 1)
577 (*readbyte) (buf[i], readcharfun);
578 return BYTE8_TO_CHAR (buf[0]);
580 buf[i++] = c;
583 if (len == 2)
585 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
586 code = buf[1] & 0x7F;
588 else if (len == 3)
590 if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
591 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
593 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
594 code = buf[2] & 0x7F;
596 else
598 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
599 code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
602 else
604 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
605 code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
607 c = DECODE_CHAR (charset, code);
608 if (c < 0)
609 Fsignal (Qinvalid_read_syntax,
610 Fcons (build_string ("invalid multibyte form"), Qnil));
611 return c;
615 static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
616 Lisp_Object);
617 static Lisp_Object read0 (Lisp_Object);
618 static Lisp_Object read1 (Lisp_Object, int *, int);
620 static Lisp_Object read_list (int, Lisp_Object);
621 static Lisp_Object read_vector (Lisp_Object, int);
623 static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
624 Lisp_Object);
625 static void substitute_object_in_subtree (Lisp_Object,
626 Lisp_Object);
627 static void substitute_in_interval (INTERVAL, Lisp_Object);
630 /* Get a character from the tty. */
632 /* Read input events until we get one that's acceptable for our purposes.
634 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
635 until we get a character we like, and then stuffed into
636 unread_switch_frame.
638 If ASCII_REQUIRED is non-zero, we check function key events to see
639 if the unmodified version of the symbol has a Qascii_character
640 property, and use that character, if present.
642 If ERROR_NONASCII is non-zero, we signal an error if the input we
643 get isn't an ASCII character with modifiers. If it's zero but
644 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
645 character.
647 If INPUT_METHOD is nonzero, we invoke the current input method
648 if the character warrants that.
650 If SECONDS is a number, we wait that many seconds for input, and
651 return Qnil if no input arrives within that time. */
653 Lisp_Object
654 read_filtered_event (int no_switch_frame, int ascii_required,
655 int error_nonascii, int input_method, Lisp_Object seconds)
657 Lisp_Object val, delayed_switch_frame;
658 EMACS_TIME end_time;
660 #ifdef HAVE_WINDOW_SYSTEM
661 if (display_hourglass_p)
662 cancel_hourglass ();
663 #endif
665 delayed_switch_frame = Qnil;
667 /* Compute timeout. */
668 if (NUMBERP (seconds))
670 EMACS_TIME wait_time;
671 int sec, usec;
672 double duration = extract_float (seconds);
674 sec = (int) duration;
675 usec = (duration - sec) * 1000000;
676 EMACS_GET_TIME (end_time);
677 EMACS_SET_SECS_USECS (wait_time, sec, usec);
678 EMACS_ADD_TIME (end_time, end_time, wait_time);
681 /* Read until we get an acceptable event. */
682 retry:
684 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
685 NUMBERP (seconds) ? &end_time : NULL);
686 while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
688 if (BUFFERP (val))
689 goto retry;
691 /* switch-frame events are put off until after the next ASCII
692 character. This is better than signaling an error just because
693 the last characters were typed to a separate minibuffer frame,
694 for example. Eventually, some code which can deal with
695 switch-frame events will read it and process it. */
696 if (no_switch_frame
697 && EVENT_HAS_PARAMETERS (val)
698 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
700 delayed_switch_frame = val;
701 goto retry;
704 if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
706 /* Convert certain symbols to their ASCII equivalents. */
707 if (SYMBOLP (val))
709 Lisp_Object tem, tem1;
710 tem = Fget (val, Qevent_symbol_element_mask);
711 if (!NILP (tem))
713 tem1 = Fget (Fcar (tem), Qascii_character);
714 /* Merge this symbol's modifier bits
715 with the ASCII equivalent of its basic code. */
716 if (!NILP (tem1))
717 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
721 /* If we don't have a character now, deal with it appropriately. */
722 if (!INTEGERP (val))
724 if (error_nonascii)
726 Vunread_command_events = Fcons (val, Qnil);
727 error ("Non-character input-event");
729 else
730 goto retry;
734 if (! NILP (delayed_switch_frame))
735 unread_switch_frame = delayed_switch_frame;
737 #if 0
739 #ifdef HAVE_WINDOW_SYSTEM
740 if (display_hourglass_p)
741 start_hourglass ();
742 #endif
744 #endif
746 return val;
749 DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
750 doc: /* Read a character from the command input (keyboard or macro).
751 It is returned as a number.
752 If the character has modifiers, they are resolved and reflected to the
753 character code if possible (e.g. C-SPC -> 0).
755 If the user generates an event which is not a character (i.e. a mouse
756 click or function key event), `read-char' signals an error. As an
757 exception, switch-frame events are put off until non-character events
758 can be read.
759 If you want to read non-character events, or ignore them, call
760 `read-event' or `read-char-exclusive' instead.
762 If the optional argument PROMPT is non-nil, display that as a prompt.
763 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
764 input method is turned on in the current buffer, that input method
765 is used for reading a character.
766 If the optional argument SECONDS is non-nil, it should be a number
767 specifying the maximum number of seconds to wait for input. If no
768 input arrives in that time, return nil. SECONDS may be a
769 floating-point value. */)
770 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
772 Lisp_Object val;
774 if (! NILP (prompt))
775 message_with_string ("%s", prompt, 0);
776 val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
778 return (NILP (val) ? Qnil
779 : make_number (char_resolve_modifier_mask (XINT (val))));
782 DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
783 doc: /* Read an event object from the input stream.
784 If the optional argument PROMPT is non-nil, display that as a prompt.
785 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
786 input method is turned on in the current buffer, that input method
787 is used for reading a character.
788 If the optional argument SECONDS is non-nil, it should be a number
789 specifying the maximum number of seconds to wait for input. If no
790 input arrives in that time, return nil. SECONDS may be a
791 floating-point value. */)
792 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
794 if (! NILP (prompt))
795 message_with_string ("%s", prompt, 0);
796 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
799 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
800 doc: /* Read a character from the command input (keyboard or macro).
801 It is returned as a number. Non-character events are ignored.
802 If the character has modifiers, they are resolved and reflected to the
803 character code if possible (e.g. C-SPC -> 0).
805 If the optional argument PROMPT is non-nil, display that as a prompt.
806 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
807 input method is turned on in the current buffer, that input method
808 is used for reading a character.
809 If the optional argument SECONDS is non-nil, it should be a number
810 specifying the maximum number of seconds to wait for input. If no
811 input arrives in that time, return nil. SECONDS may be a
812 floating-point value. */)
813 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
815 Lisp_Object val;
817 if (! NILP (prompt))
818 message_with_string ("%s", prompt, 0);
820 val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
822 return (NILP (val) ? Qnil
823 : make_number (char_resolve_modifier_mask (XINT (val))));
826 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
827 doc: /* Don't use this yourself. */)
828 (void)
830 register Lisp_Object val;
831 BLOCK_INPUT;
832 XSETINT (val, getc (instream));
833 UNBLOCK_INPUT;
834 return val;
839 /* Value is a version number of byte compiled code if the file
840 associated with file descriptor FD is a compiled Lisp file that's
841 safe to load. Only files compiled with Emacs are safe to load.
842 Files compiled with XEmacs can lead to a crash in Fbyte_code
843 because of an incompatible change in the byte compiler. */
845 static int
846 safe_to_load_p (int fd)
848 char buf[512];
849 int nbytes, i;
850 int safe_p = 1;
851 int version = 1;
853 /* Read the first few bytes from the file, and look for a line
854 specifying the byte compiler version used. */
855 nbytes = emacs_read (fd, buf, sizeof buf - 1);
856 if (nbytes > 0)
858 buf[nbytes] = '\0';
860 /* Skip to the next newline, skipping over the initial `ELC'
861 with NUL bytes following it, but note the version. */
862 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
863 if (i == 4)
864 version = buf[i];
866 if (i == nbytes
867 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
868 buf + i) < 0)
869 safe_p = 0;
871 if (safe_p)
872 safe_p = version;
874 lseek (fd, 0, SEEK_SET);
875 return safe_p;
879 /* Callback for record_unwind_protect. Restore the old load list OLD,
880 after loading a file successfully. */
882 static Lisp_Object
883 record_load_unwind (Lisp_Object old)
885 return Vloads_in_progress = old;
888 /* This handler function is used via internal_condition_case_1. */
890 static Lisp_Object
891 load_error_handler (Lisp_Object data)
893 return Qnil;
896 static Lisp_Object
897 load_warn_old_style_backquotes (Lisp_Object file)
899 if (!NILP (Vold_style_backquotes))
901 Lisp_Object args[2];
902 args[0] = build_string ("Loading `%s': old-style backquotes detected!");
903 args[1] = file;
904 Fmessage (2, args);
906 return Qnil;
909 DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
910 doc: /* Return the suffixes that `load' should try if a suffix is \
911 required.
912 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
913 (void)
915 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
916 while (CONSP (suffixes))
918 Lisp_Object exts = Vload_file_rep_suffixes;
919 suffix = XCAR (suffixes);
920 suffixes = XCDR (suffixes);
921 while (CONSP (exts))
923 ext = XCAR (exts);
924 exts = XCDR (exts);
925 lst = Fcons (concat2 (suffix, ext), lst);
928 return Fnreverse (lst);
931 DEFUN ("load", Fload, Sload, 1, 5, 0,
932 doc: /* Execute a file of Lisp code named FILE.
933 First try FILE with `.elc' appended, then try with `.el',
934 then try FILE unmodified (the exact suffixes in the exact order are
935 determined by `load-suffixes'). Environment variable references in
936 FILE are replaced with their values by calling `substitute-in-file-name'.
937 This function searches the directories in `load-path'.
939 If optional second arg NOERROR is non-nil,
940 report no error if FILE doesn't exist.
941 Print messages at start and end of loading unless
942 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
943 overrides that).
944 If optional fourth arg NOSUFFIX is non-nil, don't try adding
945 suffixes `.elc' or `.el' to the specified name FILE.
946 If optional fifth arg MUST-SUFFIX is non-nil, insist on
947 the suffix `.elc' or `.el'; don't accept just FILE unless
948 it ends in one of those suffixes or includes a directory name.
950 If this function fails to find a file, it may look for different
951 representations of that file before trying another file.
952 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
953 to the file name. Emacs uses this feature mainly to find compressed
954 versions of files when Auto Compression mode is enabled.
956 The exact suffixes that this function tries out, in the exact order,
957 are given by the value of the variable `load-file-rep-suffixes' if
958 NOSUFFIX is non-nil and by the return value of the function
959 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
960 MUST-SUFFIX are nil, this function first tries out the latter suffixes
961 and then the former.
963 Loading a file records its definitions, and its `provide' and
964 `require' calls, in an element of `load-history' whose
965 car is the file name loaded. See `load-history'.
967 While the file is in the process of being loaded, the variable
968 `load-in-progress' is non-nil and the variable `load-file-name'
969 is bound to the file's name.
971 Return t if the file exists and loads successfully. */)
972 (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix)
974 register FILE *stream;
975 register int fd = -1;
976 int count = SPECPDL_INDEX ();
977 struct gcpro gcpro1, gcpro2, gcpro3;
978 Lisp_Object found, efound, hist_file_name;
979 /* 1 means we printed the ".el is newer" message. */
980 int newer = 0;
981 /* 1 means we are loading a compiled file. */
982 int compiled = 0;
983 Lisp_Object handler;
984 int safe_p = 1;
985 const char *fmode = "r";
986 Lisp_Object tmp[2];
987 int version;
989 #ifdef DOS_NT
990 fmode = "rt";
991 #endif /* DOS_NT */
993 CHECK_STRING (file);
995 /* If file name is magic, call the handler. */
996 /* This shouldn't be necessary any more now that `openp' handles it right.
997 handler = Ffind_file_name_handler (file, Qload);
998 if (!NILP (handler))
999 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1001 /* Do this after the handler to avoid
1002 the need to gcpro noerror, nomessage and nosuffix.
1003 (Below here, we care only whether they are nil or not.)
1004 The presence of this call is the result of a historical accident:
1005 it used to be in every file-operation and when it got removed
1006 everywhere, it accidentally stayed here. Since then, enough people
1007 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1008 that it seemed risky to remove. */
1009 if (! NILP (noerror))
1011 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
1012 Qt, load_error_handler);
1013 if (NILP (file))
1014 return Qnil;
1016 else
1017 file = Fsubstitute_in_file_name (file);
1020 /* Avoid weird lossage with null string as arg,
1021 since it would try to load a directory as a Lisp file */
1022 if (SCHARS (file) > 0)
1024 int size = SBYTES (file);
1026 found = Qnil;
1027 GCPRO2 (file, found);
1029 if (! NILP (must_suffix))
1031 /* Don't insist on adding a suffix if FILE already ends with one. */
1032 if (size > 3
1033 && !strcmp (SDATA (file) + size - 3, ".el"))
1034 must_suffix = Qnil;
1035 else if (size > 4
1036 && !strcmp (SDATA (file) + size - 4, ".elc"))
1037 must_suffix = Qnil;
1038 /* Don't insist on adding a suffix
1039 if the argument includes a directory name. */
1040 else if (! NILP (Ffile_name_directory (file)))
1041 must_suffix = Qnil;
1044 fd = openp (Vload_path, file,
1045 (!NILP (nosuffix) ? Qnil
1046 : !NILP (must_suffix) ? Fget_load_suffixes ()
1047 : Fappend (2, (tmp[0] = Fget_load_suffixes (),
1048 tmp[1] = Vload_file_rep_suffixes,
1049 tmp))),
1050 &found, Qnil);
1051 UNGCPRO;
1054 if (fd == -1)
1056 if (NILP (noerror))
1057 xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
1058 return Qnil;
1061 /* Tell startup.el whether or not we found the user's init file. */
1062 if (EQ (Qt, Vuser_init_file))
1063 Vuser_init_file = found;
1065 /* If FD is -2, that means openp found a magic file. */
1066 if (fd == -2)
1068 if (NILP (Fequal (found, file)))
1069 /* If FOUND is a different file name from FILE,
1070 find its handler even if we have already inhibited
1071 the `load' operation on FILE. */
1072 handler = Ffind_file_name_handler (found, Qt);
1073 else
1074 handler = Ffind_file_name_handler (found, Qload);
1075 if (! NILP (handler))
1076 return call5 (handler, Qload, found, noerror, nomessage, Qt);
1079 /* Check if we're stuck in a recursive load cycle.
1081 2000-09-21: It's not possible to just check for the file loaded
1082 being a member of Vloads_in_progress. This fails because of the
1083 way the byte compiler currently works; `provide's are not
1084 evaluated, see font-lock.el/jit-lock.el as an example. This
1085 leads to a certain amount of ``normal'' recursion.
1087 Also, just loading a file recursively is not always an error in
1088 the general case; the second load may do something different. */
1090 int count = 0;
1091 Lisp_Object tem;
1092 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
1093 if (!NILP (Fequal (found, XCAR (tem))) && (++count > 3))
1095 if (fd >= 0)
1096 emacs_close (fd);
1097 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
1099 record_unwind_protect (record_load_unwind, Vloads_in_progress);
1100 Vloads_in_progress = Fcons (found, Vloads_in_progress);
1103 /* Get the name for load-history. */
1104 hist_file_name = (! NILP (Vpurify_flag)
1105 ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
1106 tmp[1] = Ffile_name_nondirectory (found),
1107 tmp))
1108 : found) ;
1110 version = -1;
1112 /* Check for the presence of old-style quotes and warn about them. */
1113 specbind (Qold_style_backquotes, Qnil);
1114 record_unwind_protect (load_warn_old_style_backquotes, file);
1116 if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
1117 || (fd >= 0 && (version = safe_to_load_p (fd)) > 0))
1118 /* Load .elc files directly, but not when they are
1119 remote and have no handler! */
1121 if (fd != -2)
1123 struct stat s1, s2;
1124 int result;
1126 GCPRO3 (file, found, hist_file_name);
1128 if (version < 0
1129 && ! (version = safe_to_load_p (fd)))
1131 safe_p = 0;
1132 if (!load_dangerous_libraries)
1134 if (fd >= 0)
1135 emacs_close (fd);
1136 error ("File `%s' was not compiled in Emacs",
1137 SDATA (found));
1139 else if (!NILP (nomessage) && !force_load_messages)
1140 message_with_string ("File `%s' not compiled in Emacs", found, 1);
1143 compiled = 1;
1145 efound = ENCODE_FILE (found);
1147 #ifdef DOS_NT
1148 fmode = "rb";
1149 #endif /* DOS_NT */
1150 stat ((char *)SDATA (efound), &s1);
1151 SSET (efound, SBYTES (efound) - 1, 0);
1152 result = stat ((char *)SDATA (efound), &s2);
1153 SSET (efound, SBYTES (efound) - 1, 'c');
1155 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1157 /* Make the progress messages mention that source is newer. */
1158 newer = 1;
1160 /* If we won't print another message, mention this anyway. */
1161 if (!NILP (nomessage) && !force_load_messages)
1163 Lisp_Object msg_file;
1164 msg_file = Fsubstring (found, make_number (0), make_number (-1));
1165 message_with_string ("Source file `%s' newer than byte-compiled file",
1166 msg_file, 1);
1169 UNGCPRO;
1172 else
1174 /* We are loading a source file (*.el). */
1175 if (!NILP (Vload_source_file_function))
1177 Lisp_Object val;
1179 if (fd >= 0)
1180 emacs_close (fd);
1181 val = call4 (Vload_source_file_function, found, hist_file_name,
1182 NILP (noerror) ? Qnil : Qt,
1183 (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
1184 return unbind_to (count, val);
1188 GCPRO3 (file, found, hist_file_name);
1190 #ifdef WINDOWSNT
1191 emacs_close (fd);
1192 efound = ENCODE_FILE (found);
1193 stream = fopen ((char *) SDATA (efound), fmode);
1194 #else /* not WINDOWSNT */
1195 stream = fdopen (fd, fmode);
1196 #endif /* not WINDOWSNT */
1197 if (stream == 0)
1199 emacs_close (fd);
1200 error ("Failure to create stdio stream for %s", SDATA (file));
1203 if (! NILP (Vpurify_flag))
1204 Vpreloaded_file_list = Fcons (Fpurecopy(file), Vpreloaded_file_list);
1206 if (NILP (nomessage) || force_load_messages)
1208 if (!safe_p)
1209 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1210 file, 1);
1211 else if (!compiled)
1212 message_with_string ("Loading %s (source)...", file, 1);
1213 else if (newer)
1214 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1215 file, 1);
1216 else /* The typical case; compiled file newer than source file. */
1217 message_with_string ("Loading %s...", file, 1);
1220 record_unwind_protect (load_unwind, make_save_value (stream, 0));
1221 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
1222 specbind (Qload_file_name, found);
1223 specbind (Qinhibit_file_name_operation, Qnil);
1224 load_descriptor_list
1225 = Fcons (make_number (fileno (stream)), load_descriptor_list);
1226 specbind (Qload_in_progress, Qt);
1227 if (! version || version >= 22)
1228 readevalloop (Qget_file_char, stream, hist_file_name,
1229 Feval, 0, Qnil, Qnil, Qnil, Qnil);
1230 else
1232 /* We can't handle a file which was compiled with
1233 byte-compile-dynamic by older version of Emacs. */
1234 specbind (Qload_force_doc_strings, Qt);
1235 readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
1236 0, Qnil, Qnil, Qnil, Qnil);
1238 unbind_to (count, Qnil);
1240 /* Run any eval-after-load forms for this file */
1241 if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
1242 call1 (Qdo_after_load_evaluation, hist_file_name) ;
1244 UNGCPRO;
1246 xfree (saved_doc_string);
1247 saved_doc_string = 0;
1248 saved_doc_string_size = 0;
1250 xfree (prev_saved_doc_string);
1251 prev_saved_doc_string = 0;
1252 prev_saved_doc_string_size = 0;
1254 if (!noninteractive && (NILP (nomessage) || force_load_messages))
1256 if (!safe_p)
1257 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1258 file, 1);
1259 else if (!compiled)
1260 message_with_string ("Loading %s (source)...done", file, 1);
1261 else if (newer)
1262 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1263 file, 1);
1264 else /* The typical case; compiled file newer than source file. */
1265 message_with_string ("Loading %s...done", file, 1);
1268 return Qt;
1271 static Lisp_Object
1272 load_unwind (Lisp_Object arg) /* used as unwind-protect function in load */
1274 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
1275 if (stream != NULL)
1277 BLOCK_INPUT;
1278 fclose (stream);
1279 UNBLOCK_INPUT;
1281 return Qnil;
1284 static Lisp_Object
1285 load_descriptor_unwind (Lisp_Object oldlist)
1287 load_descriptor_list = oldlist;
1288 return Qnil;
1291 /* Close all descriptors in use for Floads.
1292 This is used when starting a subprocess. */
1294 void
1295 close_load_descs (void)
1297 #ifndef WINDOWSNT
1298 Lisp_Object tail;
1299 for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
1300 emacs_close (XFASTINT (XCAR (tail)));
1301 #endif
1304 static int
1305 complete_filename_p (Lisp_Object pathname)
1307 register const unsigned char *s = SDATA (pathname);
1308 return (IS_DIRECTORY_SEP (s[0])
1309 || (SCHARS (pathname) > 2
1310 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
1313 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1314 doc: /* Search for FILENAME through PATH.
1315 Returns the file's name in absolute form, or nil if not found.
1316 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1317 file name when searching.
1318 If non-nil, PREDICATE is used instead of `file-readable-p'.
1319 PREDICATE can also be an integer to pass to the access(2) function,
1320 in which case file-name-handlers are ignored. */)
1321 (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
1323 Lisp_Object file;
1324 int fd = openp (path, filename, suffixes, &file, predicate);
1325 if (NILP (predicate) && fd > 0)
1326 close (fd);
1327 return file;
1331 /* Search for a file whose name is STR, looking in directories
1332 in the Lisp list PATH, and trying suffixes from SUFFIX.
1333 On success, returns a file descriptor. On failure, returns -1.
1335 SUFFIXES is a list of strings containing possible suffixes.
1336 The empty suffix is automatically added if the list is empty.
1338 PREDICATE non-nil means don't open the files,
1339 just look for one that satisfies the predicate. In this case,
1340 returns 1 on success. The predicate can be a lisp function or
1341 an integer to pass to `access' (in which case file-name-handlers
1342 are ignored).
1344 If STOREPTR is nonzero, it points to a slot where the name of
1345 the file actually found should be stored as a Lisp string.
1346 nil is stored there on failure.
1348 If the file we find is remote, return -2
1349 but store the found remote file name in *STOREPTR. */
1352 openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
1354 register int fd;
1355 int fn_size = 100;
1356 char buf[100];
1357 register char *fn = buf;
1358 int absolute = 0;
1359 int want_size;
1360 Lisp_Object filename;
1361 struct stat st;
1362 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1363 Lisp_Object string, tail, encoded_fn;
1364 int max_suffix_len = 0;
1366 CHECK_STRING (str);
1368 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1370 CHECK_STRING_CAR (tail);
1371 max_suffix_len = max (max_suffix_len,
1372 SBYTES (XCAR (tail)));
1375 string = filename = encoded_fn = Qnil;
1376 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1378 if (storeptr)
1379 *storeptr = Qnil;
1381 if (complete_filename_p (str))
1382 absolute = 1;
1384 for (; CONSP (path); path = XCDR (path))
1386 filename = Fexpand_file_name (str, XCAR (path));
1387 if (!complete_filename_p (filename))
1388 /* If there are non-absolute elts in PATH (eg ".") */
1389 /* Of course, this could conceivably lose if luser sets
1390 default-directory to be something non-absolute... */
1392 filename = Fexpand_file_name (filename, current_buffer->directory);
1393 if (!complete_filename_p (filename))
1394 /* Give up on this path element! */
1395 continue;
1398 /* Calculate maximum size of any filename made from
1399 this path element/specified file name and any possible suffix. */
1400 want_size = max_suffix_len + SBYTES (filename) + 1;
1401 if (fn_size < want_size)
1402 fn = (char *) alloca (fn_size = 100 + want_size);
1404 /* Loop over suffixes. */
1405 for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
1406 CONSP (tail); tail = XCDR (tail))
1408 int lsuffix = SBYTES (XCAR (tail));
1409 Lisp_Object handler;
1410 int exists;
1412 /* Concatenate path element/specified name with the suffix.
1413 If the directory starts with /:, remove that. */
1414 if (SCHARS (filename) > 2
1415 && SREF (filename, 0) == '/'
1416 && SREF (filename, 1) == ':')
1418 strncpy (fn, SDATA (filename) + 2,
1419 SBYTES (filename) - 2);
1420 fn[SBYTES (filename) - 2] = 0;
1422 else
1424 strncpy (fn, SDATA (filename),
1425 SBYTES (filename));
1426 fn[SBYTES (filename)] = 0;
1429 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
1430 strncat (fn, SDATA (XCAR (tail)), lsuffix);
1432 /* Check that the file exists and is not a directory. */
1433 /* We used to only check for handlers on non-absolute file names:
1434 if (absolute)
1435 handler = Qnil;
1436 else
1437 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1438 It's not clear why that was the case and it breaks things like
1439 (load "/bar.el") where the file is actually "/bar.el.gz". */
1440 string = build_string (fn);
1441 handler = Ffind_file_name_handler (string, Qfile_exists_p);
1442 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1444 if (NILP (predicate))
1445 exists = !NILP (Ffile_readable_p (string));
1446 else
1447 exists = !NILP (call1 (predicate, string));
1448 if (exists && !NILP (Ffile_directory_p (string)))
1449 exists = 0;
1451 if (exists)
1453 /* We succeeded; return this descriptor and filename. */
1454 if (storeptr)
1455 *storeptr = string;
1456 UNGCPRO;
1457 return -2;
1460 else
1462 const char *pfn;
1464 encoded_fn = ENCODE_FILE (string);
1465 pfn = SDATA (encoded_fn);
1466 exists = (stat (pfn, &st) >= 0
1467 && (st.st_mode & S_IFMT) != S_IFDIR);
1468 if (exists)
1470 /* Check that we can access or open it. */
1471 if (NATNUMP (predicate))
1472 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
1473 else
1474 fd = emacs_open (pfn, O_RDONLY, 0);
1476 if (fd >= 0)
1478 /* We succeeded; return this descriptor and filename. */
1479 if (storeptr)
1480 *storeptr = string;
1481 UNGCPRO;
1482 return fd;
1487 if (absolute)
1488 break;
1491 UNGCPRO;
1492 return -1;
1496 /* Merge the list we've accumulated of globals from the current input source
1497 into the load_history variable. The details depend on whether
1498 the source has an associated file name or not.
1500 FILENAME is the file name that we are loading from.
1501 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1503 static void
1504 build_load_history (Lisp_Object filename, int entire)
1506 register Lisp_Object tail, prev, newelt;
1507 register Lisp_Object tem, tem2;
1508 register int foundit = 0;
1510 tail = Vload_history;
1511 prev = Qnil;
1513 while (CONSP (tail))
1515 tem = XCAR (tail);
1517 /* Find the feature's previous assoc list... */
1518 if (!NILP (Fequal (filename, Fcar (tem))))
1520 foundit = 1;
1522 /* If we're loading the entire file, remove old data. */
1523 if (entire)
1525 if (NILP (prev))
1526 Vload_history = XCDR (tail);
1527 else
1528 Fsetcdr (prev, XCDR (tail));
1531 /* Otherwise, cons on new symbols that are not already members. */
1532 else
1534 tem2 = Vcurrent_load_list;
1536 while (CONSP (tem2))
1538 newelt = XCAR (tem2);
1540 if (NILP (Fmember (newelt, tem)))
1541 Fsetcar (tail, Fcons (XCAR (tem),
1542 Fcons (newelt, XCDR (tem))));
1544 tem2 = XCDR (tem2);
1545 QUIT;
1549 else
1550 prev = tail;
1551 tail = XCDR (tail);
1552 QUIT;
1555 /* If we're loading an entire file, cons the new assoc onto the
1556 front of load-history, the most-recently-loaded position. Also
1557 do this if we didn't find an existing member for the file. */
1558 if (entire || !foundit)
1559 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1560 Vload_history);
1563 static Lisp_Object
1564 unreadpure (Lisp_Object junk) /* Used as unwind-protect function in readevalloop */
1566 read_pure = 0;
1567 return Qnil;
1570 static Lisp_Object
1571 readevalloop_1 (Lisp_Object old)
1573 load_convert_to_unibyte = ! NILP (old);
1574 return Qnil;
1577 /* Signal an `end-of-file' error, if possible with file name
1578 information. */
1580 static void
1581 end_of_file_error (void)
1583 if (STRINGP (Vload_file_name))
1584 xsignal1 (Qend_of_file, Vload_file_name);
1586 xsignal0 (Qend_of_file);
1589 /* UNIBYTE specifies how to set load_convert_to_unibyte
1590 for this invocation.
1591 READFUN, if non-nil, is used instead of `read'.
1593 START, END specify region to read in current buffer (from eval-region).
1594 If the input is not from a buffer, they must be nil. */
1596 static void
1597 readevalloop (Lisp_Object readcharfun,
1598 FILE *stream,
1599 Lisp_Object sourcename,
1600 Lisp_Object (*evalfun) (Lisp_Object),
1601 int printflag,
1602 Lisp_Object unibyte, Lisp_Object readfun,
1603 Lisp_Object start, Lisp_Object end)
1605 register int c;
1606 register Lisp_Object val;
1607 int count = SPECPDL_INDEX ();
1608 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1609 struct buffer *b = 0;
1610 int continue_reading_p;
1611 /* Nonzero if reading an entire buffer. */
1612 int whole_buffer = 0;
1613 /* 1 on the first time around. */
1614 int first_sexp = 1;
1616 if (MARKERP (readcharfun))
1618 if (NILP (start))
1619 start = readcharfun;
1622 if (BUFFERP (readcharfun))
1623 b = XBUFFER (readcharfun);
1624 else if (MARKERP (readcharfun))
1625 b = XMARKER (readcharfun)->buffer;
1627 /* We assume START is nil when input is not from a buffer. */
1628 if (! NILP (start) && !b)
1629 abort ();
1631 specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
1632 specbind (Qcurrent_load_list, Qnil);
1633 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1634 load_convert_to_unibyte = !NILP (unibyte);
1636 GCPRO4 (sourcename, readfun, start, end);
1638 /* Try to ensure sourcename is a truename, except whilst preloading. */
1639 if (NILP (Vpurify_flag)
1640 && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
1641 && !NILP (Ffboundp (Qfile_truename)))
1642 sourcename = call1 (Qfile_truename, sourcename) ;
1644 LOADHIST_ATTACH (sourcename);
1646 continue_reading_p = 1;
1647 while (continue_reading_p)
1649 int count1 = SPECPDL_INDEX ();
1651 if (b != 0 && NILP (b->name))
1652 error ("Reading from killed buffer");
1654 if (!NILP (start))
1656 /* Switch to the buffer we are reading from. */
1657 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1658 set_buffer_internal (b);
1660 /* Save point in it. */
1661 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1662 /* Save ZV in it. */
1663 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1664 /* Those get unbound after we read one expression. */
1666 /* Set point and ZV around stuff to be read. */
1667 Fgoto_char (start);
1668 if (!NILP (end))
1669 Fnarrow_to_region (make_number (BEGV), end);
1671 /* Just for cleanliness, convert END to a marker
1672 if it is an integer. */
1673 if (INTEGERP (end))
1674 end = Fpoint_max_marker ();
1677 /* On the first cycle, we can easily test here
1678 whether we are reading the whole buffer. */
1679 if (b && first_sexp)
1680 whole_buffer = (PT == BEG && ZV == Z);
1682 instream = stream;
1683 read_next:
1684 c = READCHAR;
1685 if (c == ';')
1687 while ((c = READCHAR) != '\n' && c != -1);
1688 goto read_next;
1690 if (c < 0)
1692 unbind_to (count1, Qnil);
1693 break;
1696 /* Ignore whitespace here, so we can detect eof. */
1697 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
1698 || c == 0x8a0) /* NBSP */
1699 goto read_next;
1701 if (!NILP (Vpurify_flag) && c == '(')
1703 record_unwind_protect (unreadpure, Qnil);
1704 val = read_list (-1, readcharfun);
1706 else
1708 UNREAD (c);
1709 read_objects = Qnil;
1710 if (!NILP (readfun))
1712 val = call1 (readfun, readcharfun);
1714 /* If READCHARFUN has set point to ZV, we should
1715 stop reading, even if the form read sets point
1716 to a different value when evaluated. */
1717 if (BUFFERP (readcharfun))
1719 struct buffer *b = XBUFFER (readcharfun);
1720 if (BUF_PT (b) == BUF_ZV (b))
1721 continue_reading_p = 0;
1724 else if (! NILP (Vload_read_function))
1725 val = call1 (Vload_read_function, readcharfun);
1726 else
1727 val = read_internal_start (readcharfun, Qnil, Qnil);
1730 if (!NILP (start) && continue_reading_p)
1731 start = Fpoint_marker ();
1733 /* Restore saved point and BEGV. */
1734 unbind_to (count1, Qnil);
1736 /* Now eval what we just read. */
1737 val = (*evalfun) (val);
1739 if (printflag)
1741 Vvalues = Fcons (val, Vvalues);
1742 if (EQ (Vstandard_output, Qt))
1743 Fprin1 (val, Qnil);
1744 else
1745 Fprint (val, Qnil);
1748 first_sexp = 0;
1751 build_load_history (sourcename,
1752 stream || whole_buffer);
1754 UNGCPRO;
1756 unbind_to (count, Qnil);
1759 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
1760 doc: /* Execute the current buffer as Lisp code.
1761 When called from a Lisp program (i.e., not interactively), this
1762 function accepts up to five optional arguments:
1763 BUFFER is the buffer to evaluate (nil means use current buffer).
1764 PRINTFLAG controls printing of output:
1765 A value of nil means discard it; anything else is stream for print.
1766 FILENAME specifies the file name to use for `load-history'.
1767 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1768 invocation.
1769 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1770 functions should work normally even if PRINTFLAG is nil.
1772 This function preserves the position of point. */)
1773 (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
1775 int count = SPECPDL_INDEX ();
1776 Lisp_Object tem, buf;
1778 if (NILP (buffer))
1779 buf = Fcurrent_buffer ();
1780 else
1781 buf = Fget_buffer (buffer);
1782 if (NILP (buf))
1783 error ("No such buffer");
1785 if (NILP (printflag) && NILP (do_allow_print))
1786 tem = Qsymbolp;
1787 else
1788 tem = printflag;
1790 if (NILP (filename))
1791 filename = XBUFFER (buf)->filename;
1793 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
1794 specbind (Qstandard_output, tem);
1795 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1796 BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1797 readevalloop (buf, 0, filename, Feval,
1798 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
1799 unbind_to (count, Qnil);
1801 return Qnil;
1804 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
1805 doc: /* Execute the region as Lisp code.
1806 When called from programs, expects two arguments,
1807 giving starting and ending indices in the current buffer
1808 of the text to be executed.
1809 Programs can pass third argument PRINTFLAG which controls output:
1810 A value of nil means discard it; anything else is stream for printing it.
1811 Also the fourth argument READ-FUNCTION, if non-nil, is used
1812 instead of `read' to read each expression. It gets one argument
1813 which is the input stream for reading characters.
1815 This function does not move point. */)
1816 (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
1818 int count = SPECPDL_INDEX ();
1819 Lisp_Object tem, cbuf;
1821 cbuf = Fcurrent_buffer ();
1823 if (NILP (printflag))
1824 tem = Qsymbolp;
1825 else
1826 tem = printflag;
1827 specbind (Qstandard_output, tem);
1828 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
1830 /* readevalloop calls functions which check the type of start and end. */
1831 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
1832 !NILP (printflag), Qnil, read_function,
1833 start, end);
1835 return unbind_to (count, Qnil);
1839 DEFUN ("read", Fread, Sread, 0, 1, 0,
1840 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1841 If STREAM is nil, use the value of `standard-input' (which see).
1842 STREAM or the value of `standard-input' may be:
1843 a buffer (read from point and advance it)
1844 a marker (read from where it points and advance it)
1845 a function (call it with no arguments for each character,
1846 call it with a char as argument to push a char back)
1847 a string (takes text from string, starting at the beginning)
1848 t (read text line using minibuffer and use it, or read from
1849 standard input in batch mode). */)
1850 (Lisp_Object stream)
1852 if (NILP (stream))
1853 stream = Vstandard_input;
1854 if (EQ (stream, Qt))
1855 stream = Qread_char;
1856 if (EQ (stream, Qread_char))
1857 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
1859 return read_internal_start (stream, Qnil, Qnil);
1862 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
1863 doc: /* Read one Lisp expression which is represented as text by STRING.
1864 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1865 START and END optionally delimit a substring of STRING from which to read;
1866 they default to 0 and (length STRING) respectively. */)
1867 (Lisp_Object string, Lisp_Object start, Lisp_Object end)
1869 Lisp_Object ret;
1870 CHECK_STRING (string);
1871 /* read_internal_start sets read_from_string_index. */
1872 ret = read_internal_start (string, start, end);
1873 return Fcons (ret, make_number (read_from_string_index));
1876 /* Function to set up the global context we need in toplevel read
1877 calls. */
1878 static Lisp_Object
1879 read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
1880 /* start, end only used when stream is a string. */
1882 Lisp_Object retval;
1884 readchar_count = 0;
1885 new_backquote_flag = 0;
1886 read_objects = Qnil;
1887 if (EQ (Vread_with_symbol_positions, Qt)
1888 || EQ (Vread_with_symbol_positions, stream))
1889 Vread_symbol_positions_list = Qnil;
1891 if (STRINGP (stream)
1892 || ((CONSP (stream) && STRINGP (XCAR (stream)))))
1894 EMACS_INT startval, endval;
1895 Lisp_Object string;
1897 if (STRINGP (stream))
1898 string = stream;
1899 else
1900 string = XCAR (stream);
1902 if (NILP (end))
1903 endval = SCHARS (string);
1904 else
1906 CHECK_NUMBER (end);
1907 endval = XINT (end);
1908 if (endval < 0 || endval > SCHARS (string))
1909 args_out_of_range (string, end);
1912 if (NILP (start))
1913 startval = 0;
1914 else
1916 CHECK_NUMBER (start);
1917 startval = XINT (start);
1918 if (startval < 0 || startval > endval)
1919 args_out_of_range (string, start);
1921 read_from_string_index = startval;
1922 read_from_string_index_byte = string_char_to_byte (string, startval);
1923 read_from_string_limit = endval;
1926 retval = read0 (stream);
1927 if (EQ (Vread_with_symbol_positions, Qt)
1928 || EQ (Vread_with_symbol_positions, stream))
1929 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
1930 return retval;
1934 /* Signal Qinvalid_read_syntax error.
1935 S is error string of length N (if > 0) */
1937 static void
1938 invalid_syntax (const char *s, int n)
1940 if (!n)
1941 n = strlen (s);
1942 xsignal1 (Qinvalid_read_syntax, make_string (s, n));
1946 /* Use this for recursive reads, in contexts where internal tokens
1947 are not allowed. */
1949 static Lisp_Object
1950 read0 (Lisp_Object readcharfun)
1952 register Lisp_Object val;
1953 int c;
1955 val = read1 (readcharfun, &c, 0);
1956 if (!c)
1957 return val;
1959 xsignal1 (Qinvalid_read_syntax,
1960 Fmake_string (make_number (1), make_number (c)));
1963 static int read_buffer_size;
1964 static char *read_buffer;
1966 /* Read a \-escape sequence, assuming we already read the `\'.
1967 If the escape sequence forces unibyte, return eight-bit char. */
1969 static int
1970 read_escape (Lisp_Object readcharfun, int stringp)
1972 register int c = READCHAR;
1973 /* \u allows up to four hex digits, \U up to eight. Default to the
1974 behavior for \u, and change this value in the case that \U is seen. */
1975 int unicode_hex_count = 4;
1977 switch (c)
1979 case -1:
1980 end_of_file_error ();
1982 case 'a':
1983 return '\007';
1984 case 'b':
1985 return '\b';
1986 case 'd':
1987 return 0177;
1988 case 'e':
1989 return 033;
1990 case 'f':
1991 return '\f';
1992 case 'n':
1993 return '\n';
1994 case 'r':
1995 return '\r';
1996 case 't':
1997 return '\t';
1998 case 'v':
1999 return '\v';
2000 case '\n':
2001 return -1;
2002 case ' ':
2003 if (stringp)
2004 return -1;
2005 return ' ';
2007 case 'M':
2008 c = READCHAR;
2009 if (c != '-')
2010 error ("Invalid escape character syntax");
2011 c = READCHAR;
2012 if (c == '\\')
2013 c = read_escape (readcharfun, 0);
2014 return c | meta_modifier;
2016 case 'S':
2017 c = READCHAR;
2018 if (c != '-')
2019 error ("Invalid escape character syntax");
2020 c = READCHAR;
2021 if (c == '\\')
2022 c = read_escape (readcharfun, 0);
2023 return c | shift_modifier;
2025 case 'H':
2026 c = READCHAR;
2027 if (c != '-')
2028 error ("Invalid escape character syntax");
2029 c = READCHAR;
2030 if (c == '\\')
2031 c = read_escape (readcharfun, 0);
2032 return c | hyper_modifier;
2034 case 'A':
2035 c = READCHAR;
2036 if (c != '-')
2037 error ("Invalid escape character syntax");
2038 c = READCHAR;
2039 if (c == '\\')
2040 c = read_escape (readcharfun, 0);
2041 return c | alt_modifier;
2043 case 's':
2044 c = READCHAR;
2045 if (stringp || c != '-')
2047 UNREAD (c);
2048 return ' ';
2050 c = READCHAR;
2051 if (c == '\\')
2052 c = read_escape (readcharfun, 0);
2053 return c | super_modifier;
2055 case 'C':
2056 c = READCHAR;
2057 if (c != '-')
2058 error ("Invalid escape character syntax");
2059 case '^':
2060 c = READCHAR;
2061 if (c == '\\')
2062 c = read_escape (readcharfun, 0);
2063 if ((c & ~CHAR_MODIFIER_MASK) == '?')
2064 return 0177 | (c & CHAR_MODIFIER_MASK);
2065 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
2066 return c | ctrl_modifier;
2067 /* ASCII control chars are made from letters (both cases),
2068 as well as the non-letters within 0100...0137. */
2069 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
2070 return (c & (037 | ~0177));
2071 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
2072 return (c & (037 | ~0177));
2073 else
2074 return c | ctrl_modifier;
2076 case '0':
2077 case '1':
2078 case '2':
2079 case '3':
2080 case '4':
2081 case '5':
2082 case '6':
2083 case '7':
2084 /* An octal escape, as in ANSI C. */
2086 register int i = c - '0';
2087 register int count = 0;
2088 while (++count < 3)
2090 if ((c = READCHAR) >= '0' && c <= '7')
2092 i *= 8;
2093 i += c - '0';
2095 else
2097 UNREAD (c);
2098 break;
2102 if (i >= 0x80 && i < 0x100)
2103 i = BYTE8_TO_CHAR (i);
2104 return i;
2107 case 'x':
2108 /* A hex escape, as in ANSI C. */
2110 int i = 0;
2111 int count = 0;
2112 while (1)
2114 c = READCHAR;
2115 if (c >= '0' && c <= '9')
2117 i *= 16;
2118 i += c - '0';
2120 else if ((c >= 'a' && c <= 'f')
2121 || (c >= 'A' && c <= 'F'))
2123 i *= 16;
2124 if (c >= 'a' && c <= 'f')
2125 i += c - 'a' + 10;
2126 else
2127 i += c - 'A' + 10;
2129 else
2131 UNREAD (c);
2132 break;
2134 count++;
2137 if (count < 3 && i >= 0x80)
2138 return BYTE8_TO_CHAR (i);
2139 return i;
2142 case 'U':
2143 /* Post-Unicode-2.0: Up to eight hex chars. */
2144 unicode_hex_count = 8;
2145 case 'u':
2147 /* A Unicode escape. We only permit them in strings and characters,
2148 not arbitrarily in the source code, as in some other languages. */
2150 unsigned int i = 0;
2151 int count = 0;
2153 while (++count <= unicode_hex_count)
2155 c = READCHAR;
2156 /* isdigit and isalpha may be locale-specific, which we don't
2157 want. */
2158 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
2159 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
2160 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
2161 else
2163 error ("Non-hex digit used for Unicode escape");
2164 break;
2167 if (i > 0x10FFFF)
2168 error ("Non-Unicode character: 0x%x", i);
2169 return i;
2172 default:
2173 return c;
2177 /* Read an integer in radix RADIX using READCHARFUN to read
2178 characters. RADIX must be in the interval [2..36]; if it isn't, a
2179 read error is signaled . Value is the integer read. Signals an
2180 error if encountering invalid read syntax or if RADIX is out of
2181 range. */
2183 static Lisp_Object
2184 read_integer (Lisp_Object readcharfun, int radix)
2186 int ndigits = 0, invalid_p, c, sign = 0;
2187 /* We use a floating point number because */
2188 double number = 0;
2190 if (radix < 2 || radix > 36)
2191 invalid_p = 1;
2192 else
2194 number = ndigits = invalid_p = 0;
2195 sign = 1;
2197 c = READCHAR;
2198 if (c == '-')
2200 c = READCHAR;
2201 sign = -1;
2203 else if (c == '+')
2204 c = READCHAR;
2206 while (c >= 0)
2208 int digit;
2210 if (c >= '0' && c <= '9')
2211 digit = c - '0';
2212 else if (c >= 'a' && c <= 'z')
2213 digit = c - 'a' + 10;
2214 else if (c >= 'A' && c <= 'Z')
2215 digit = c - 'A' + 10;
2216 else
2218 UNREAD (c);
2219 break;
2222 if (digit < 0 || digit >= radix)
2223 invalid_p = 1;
2225 number = radix * number + digit;
2226 ++ndigits;
2227 c = READCHAR;
2231 if (ndigits == 0 || invalid_p)
2233 char buf[50];
2234 sprintf (buf, "integer, radix %d", radix);
2235 invalid_syntax (buf, 0);
2238 return make_fixnum_or_float (sign * number);
2242 /* If the next token is ')' or ']' or '.', we store that character
2243 in *PCH and the return value is not interesting. Else, we store
2244 zero in *PCH and we read and return one lisp object.
2246 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2248 static Lisp_Object
2249 read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
2251 register int c;
2252 int uninterned_symbol = 0;
2253 int multibyte;
2255 *pch = 0;
2256 load_each_byte = 0;
2258 retry:
2260 c = READCHAR_REPORT_MULTIBYTE (&multibyte);
2261 if (c < 0)
2262 end_of_file_error ();
2264 switch (c)
2266 case '(':
2267 return read_list (0, readcharfun);
2269 case '[':
2270 return read_vector (readcharfun, 0);
2272 case ')':
2273 case ']':
2275 *pch = c;
2276 return Qnil;
2279 case '#':
2280 c = READCHAR;
2281 if (c == 's')
2283 c = READCHAR;
2284 if (c == '(')
2286 /* Accept extended format for hashtables (extensible to
2287 other types), e.g.
2288 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2289 Lisp_Object tmp = read_list (0, readcharfun);
2290 Lisp_Object head = CAR_SAFE (tmp);
2291 Lisp_Object data = Qnil;
2292 Lisp_Object val = Qnil;
2293 /* The size is 2 * number of allowed keywords to
2294 make-hash-table. */
2295 Lisp_Object params[10];
2296 Lisp_Object ht;
2297 Lisp_Object key = Qnil;
2298 int param_count = 0;
2300 if (!EQ (head, Qhash_table))
2301 error ("Invalid extended read marker at head of #s list "
2302 "(only hash-table allowed)");
2304 tmp = CDR_SAFE (tmp);
2306 /* This is repetitive but fast and simple. */
2307 params[param_count] = QCsize;
2308 params[param_count+1] = Fplist_get (tmp, Qsize);
2309 if (!NILP (params[param_count + 1]))
2310 param_count += 2;
2312 params[param_count] = QCtest;
2313 params[param_count+1] = Fplist_get (tmp, Qtest);
2314 if (!NILP (params[param_count + 1]))
2315 param_count += 2;
2317 params[param_count] = QCweakness;
2318 params[param_count+1] = Fplist_get (tmp, Qweakness);
2319 if (!NILP (params[param_count + 1]))
2320 param_count += 2;
2322 params[param_count] = QCrehash_size;
2323 params[param_count+1] = Fplist_get (tmp, Qrehash_size);
2324 if (!NILP (params[param_count + 1]))
2325 param_count += 2;
2327 params[param_count] = QCrehash_threshold;
2328 params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
2329 if (!NILP (params[param_count + 1]))
2330 param_count += 2;
2332 /* This is the hashtable data. */
2333 data = Fplist_get (tmp, Qdata);
2335 /* Now use params to make a new hashtable and fill it. */
2336 ht = Fmake_hash_table (param_count, params);
2338 while (CONSP (data))
2340 key = XCAR (data);
2341 data = XCDR (data);
2342 if (!CONSP (data))
2343 error ("Odd number of elements in hashtable data");
2344 val = XCAR (data);
2345 data = XCDR (data);
2346 Fputhash (key, val, ht);
2349 return ht;
2351 UNREAD (c);
2352 invalid_syntax ("#", 1);
2354 if (c == '^')
2356 c = READCHAR;
2357 if (c == '[')
2359 Lisp_Object tmp;
2360 tmp = read_vector (readcharfun, 0);
2361 if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
2362 error ("Invalid size char-table");
2363 XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
2364 return tmp;
2366 else if (c == '^')
2368 c = READCHAR;
2369 if (c == '[')
2371 Lisp_Object tmp;
2372 int depth, size;
2374 tmp = read_vector (readcharfun, 0);
2375 if (!INTEGERP (AREF (tmp, 0)))
2376 error ("Invalid depth in char-table");
2377 depth = XINT (AREF (tmp, 0));
2378 if (depth < 1 || depth > 3)
2379 error ("Invalid depth in char-table");
2380 size = XVECTOR (tmp)->size - 2;
2381 if (chartab_size [depth] != size)
2382 error ("Invalid size char-table");
2383 XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
2384 return tmp;
2386 invalid_syntax ("#^^", 3);
2388 invalid_syntax ("#^", 2);
2390 if (c == '&')
2392 Lisp_Object length;
2393 length = read1 (readcharfun, pch, first_in_list);
2394 c = READCHAR;
2395 if (c == '"')
2397 Lisp_Object tmp, val;
2398 int size_in_chars
2399 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
2400 / BOOL_VECTOR_BITS_PER_CHAR);
2402 UNREAD (c);
2403 tmp = read1 (readcharfun, pch, first_in_list);
2404 if (STRING_MULTIBYTE (tmp)
2405 || (size_in_chars != SCHARS (tmp)
2406 /* We used to print 1 char too many
2407 when the number of bits was a multiple of 8.
2408 Accept such input in case it came from an old
2409 version. */
2410 && ! (XFASTINT (length)
2411 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
2412 invalid_syntax ("#&...", 5);
2414 val = Fmake_bool_vector (length, Qnil);
2415 memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars);
2416 /* Clear the extraneous bits in the last byte. */
2417 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
2418 XBOOL_VECTOR (val)->data[size_in_chars - 1]
2419 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2420 return val;
2422 invalid_syntax ("#&...", 5);
2424 if (c == '[')
2426 /* Accept compiled functions at read-time so that we don't have to
2427 build them using function calls. */
2428 Lisp_Object tmp;
2429 tmp = read_vector (readcharfun, 1);
2430 return Fmake_byte_code (XVECTOR (tmp)->size,
2431 XVECTOR (tmp)->contents);
2433 if (c == '(')
2435 Lisp_Object tmp;
2436 struct gcpro gcpro1;
2437 int ch;
2439 /* Read the string itself. */
2440 tmp = read1 (readcharfun, &ch, 0);
2441 if (ch != 0 || !STRINGP (tmp))
2442 invalid_syntax ("#", 1);
2443 GCPRO1 (tmp);
2444 /* Read the intervals and their properties. */
2445 while (1)
2447 Lisp_Object beg, end, plist;
2449 beg = read1 (readcharfun, &ch, 0);
2450 end = plist = Qnil;
2451 if (ch == ')')
2452 break;
2453 if (ch == 0)
2454 end = read1 (readcharfun, &ch, 0);
2455 if (ch == 0)
2456 plist = read1 (readcharfun, &ch, 0);
2457 if (ch)
2458 invalid_syntax ("Invalid string property list", 0);
2459 Fset_text_properties (beg, end, plist, tmp);
2461 UNGCPRO;
2462 return tmp;
2465 /* #@NUMBER is used to skip NUMBER following characters.
2466 That's used in .elc files to skip over doc strings
2467 and function definitions. */
2468 if (c == '@')
2470 int i, nskip = 0;
2472 load_each_byte = 1;
2473 /* Read a decimal integer. */
2474 while ((c = READCHAR) >= 0
2475 && c >= '0' && c <= '9')
2477 nskip *= 10;
2478 nskip += c - '0';
2480 if (c >= 0)
2481 UNREAD (c);
2483 if (load_force_doc_strings
2484 && (EQ (readcharfun, Qget_file_char)
2485 || EQ (readcharfun, Qget_emacs_mule_file_char)))
2487 /* If we are supposed to force doc strings into core right now,
2488 record the last string that we skipped,
2489 and record where in the file it comes from. */
2491 /* But first exchange saved_doc_string
2492 with prev_saved_doc_string, so we save two strings. */
2494 char *temp = saved_doc_string;
2495 int temp_size = saved_doc_string_size;
2496 file_offset temp_pos = saved_doc_string_position;
2497 int temp_len = saved_doc_string_length;
2499 saved_doc_string = prev_saved_doc_string;
2500 saved_doc_string_size = prev_saved_doc_string_size;
2501 saved_doc_string_position = prev_saved_doc_string_position;
2502 saved_doc_string_length = prev_saved_doc_string_length;
2504 prev_saved_doc_string = temp;
2505 prev_saved_doc_string_size = temp_size;
2506 prev_saved_doc_string_position = temp_pos;
2507 prev_saved_doc_string_length = temp_len;
2510 if (saved_doc_string_size == 0)
2512 saved_doc_string_size = nskip + 100;
2513 saved_doc_string = (char *) xmalloc (saved_doc_string_size);
2515 if (nskip > saved_doc_string_size)
2517 saved_doc_string_size = nskip + 100;
2518 saved_doc_string = (char *) xrealloc (saved_doc_string,
2519 saved_doc_string_size);
2522 saved_doc_string_position = file_tell (instream);
2524 /* Copy that many characters into saved_doc_string. */
2525 for (i = 0; i < nskip && c >= 0; i++)
2526 saved_doc_string[i] = c = READCHAR;
2528 saved_doc_string_length = i;
2530 else
2532 /* Skip that many characters. */
2533 for (i = 0; i < nskip && c >= 0; i++)
2534 c = READCHAR;
2537 load_each_byte = 0;
2538 goto retry;
2540 if (c == '!')
2542 /* #! appears at the beginning of an executable file.
2543 Skip the first line. */
2544 while (c != '\n' && c >= 0)
2545 c = READCHAR;
2546 goto retry;
2548 if (c == '$')
2549 return Vload_file_name;
2550 if (c == '\'')
2551 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
2552 /* #:foo is the uninterned symbol named foo. */
2553 if (c == ':')
2555 uninterned_symbol = 1;
2556 c = READCHAR;
2557 goto default_label;
2559 /* Reader forms that can reuse previously read objects. */
2560 if (c >= '0' && c <= '9')
2562 int n = 0;
2563 Lisp_Object tem;
2565 /* Read a non-negative integer. */
2566 while (c >= '0' && c <= '9')
2568 n *= 10;
2569 n += c - '0';
2570 c = READCHAR;
2572 /* #n=object returns object, but associates it with n for #n#. */
2573 if (c == '=' && !NILP (Vread_circle))
2575 /* Make a placeholder for #n# to use temporarily */
2576 Lisp_Object placeholder;
2577 Lisp_Object cell;
2579 placeholder = Fcons (Qnil, Qnil);
2580 cell = Fcons (make_number (n), placeholder);
2581 read_objects = Fcons (cell, read_objects);
2583 /* Read the object itself. */
2584 tem = read0 (readcharfun);
2586 /* Now put it everywhere the placeholder was... */
2587 substitute_object_in_subtree (tem, placeholder);
2589 /* ...and #n# will use the real value from now on. */
2590 Fsetcdr (cell, tem);
2592 return tem;
2594 /* #n# returns a previously read object. */
2595 if (c == '#' && !NILP (Vread_circle))
2597 tem = Fassq (make_number (n), read_objects);
2598 if (CONSP (tem))
2599 return XCDR (tem);
2600 /* Fall through to error message. */
2602 else if (c == 'r' || c == 'R')
2603 return read_integer (readcharfun, n);
2605 /* Fall through to error message. */
2607 else if (c == 'x' || c == 'X')
2608 return read_integer (readcharfun, 16);
2609 else if (c == 'o' || c == 'O')
2610 return read_integer (readcharfun, 8);
2611 else if (c == 'b' || c == 'B')
2612 return read_integer (readcharfun, 2);
2614 UNREAD (c);
2615 invalid_syntax ("#", 1);
2617 case ';':
2618 while ((c = READCHAR) >= 0 && c != '\n');
2619 goto retry;
2621 case '\'':
2623 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2626 case '`':
2628 int next_char = READCHAR;
2629 UNREAD (next_char);
2630 /* Transition from old-style to new-style:
2631 If we see "(`" it used to mean old-style, which usually works
2632 fine because ` should almost never appear in such a position
2633 for new-style. But occasionally we need "(`" to mean new
2634 style, so we try to distinguish the two by the fact that we
2635 can either write "( `foo" or "(` foo", where the first
2636 intends to use new-style whereas the second intends to use
2637 old-style. For Emacs-25, we should completely remove this
2638 first_in_list exception (old-style can still be obtained via
2639 "(\`" anyway). */
2640 if (first_in_list && next_char == ' ')
2642 Vold_style_backquotes = Qt;
2643 goto default_label;
2645 else
2647 Lisp_Object value;
2649 new_backquote_flag++;
2650 value = read0 (readcharfun);
2651 new_backquote_flag--;
2653 return Fcons (Qbackquote, Fcons (value, Qnil));
2656 case ',':
2657 if (new_backquote_flag)
2659 Lisp_Object comma_type = Qnil;
2660 Lisp_Object value;
2661 int ch = READCHAR;
2663 if (ch == '@')
2664 comma_type = Qcomma_at;
2665 else if (ch == '.')
2666 comma_type = Qcomma_dot;
2667 else
2669 if (ch >= 0) UNREAD (ch);
2670 comma_type = Qcomma;
2673 new_backquote_flag--;
2674 value = read0 (readcharfun);
2675 new_backquote_flag++;
2676 return Fcons (comma_type, Fcons (value, Qnil));
2678 else
2680 Vold_style_backquotes = Qt;
2681 goto default_label;
2684 case '?':
2686 int modifiers;
2687 int next_char;
2688 int ok;
2690 c = READCHAR;
2691 if (c < 0)
2692 end_of_file_error ();
2694 /* Accept `single space' syntax like (list ? x) where the
2695 whitespace character is SPC or TAB.
2696 Other literal whitespace like NL, CR, and FF are not accepted,
2697 as there are well-established escape sequences for these. */
2698 if (c == ' ' || c == '\t')
2699 return make_number (c);
2701 if (c == '\\')
2702 c = read_escape (readcharfun, 0);
2703 modifiers = c & CHAR_MODIFIER_MASK;
2704 c &= ~CHAR_MODIFIER_MASK;
2705 if (CHAR_BYTE8_P (c))
2706 c = CHAR_TO_BYTE8 (c);
2707 c |= modifiers;
2709 next_char = READCHAR;
2710 if (next_char == '.')
2712 /* Only a dotted-pair dot is valid after a char constant. */
2713 int next_next_char = READCHAR;
2714 UNREAD (next_next_char);
2716 ok = (next_next_char <= 040
2717 || (next_next_char < 0200
2718 && (strchr ("\"';([#?", next_next_char)
2719 || (!first_in_list && next_next_char == '`')
2720 || (new_backquote_flag && next_next_char == ','))));
2722 else
2724 ok = (next_char <= 040
2725 || (next_char < 0200
2726 && (strchr ("\"';()[]#?", next_char)
2727 || (!first_in_list && next_char == '`')
2728 || (new_backquote_flag && next_char == ','))));
2730 UNREAD (next_char);
2731 if (ok)
2732 return make_number (c);
2734 invalid_syntax ("?", 1);
2737 case '"':
2739 char *p = read_buffer;
2740 char *end = read_buffer + read_buffer_size;
2741 register int c;
2742 /* Nonzero if we saw an escape sequence specifying
2743 a multibyte character. */
2744 int force_multibyte = 0;
2745 /* Nonzero if we saw an escape sequence specifying
2746 a single-byte character. */
2747 int force_singlebyte = 0;
2748 int cancel = 0;
2749 int nchars = 0;
2751 while ((c = READCHAR) >= 0
2752 && c != '\"')
2754 if (end - p < MAX_MULTIBYTE_LENGTH)
2756 int offset = p - read_buffer;
2757 read_buffer = (char *) xrealloc (read_buffer,
2758 read_buffer_size *= 2);
2759 p = read_buffer + offset;
2760 end = read_buffer + read_buffer_size;
2763 if (c == '\\')
2765 int modifiers;
2767 c = read_escape (readcharfun, 1);
2769 /* C is -1 if \ newline has just been seen */
2770 if (c == -1)
2772 if (p == read_buffer)
2773 cancel = 1;
2774 continue;
2777 modifiers = c & CHAR_MODIFIER_MASK;
2778 c = c & ~CHAR_MODIFIER_MASK;
2780 if (CHAR_BYTE8_P (c))
2781 force_singlebyte = 1;
2782 else if (! ASCII_CHAR_P (c))
2783 force_multibyte = 1;
2784 else /* i.e. ASCII_CHAR_P (c) */
2786 /* Allow `\C- ' and `\C-?'. */
2787 if (modifiers == CHAR_CTL)
2789 if (c == ' ')
2790 c = 0, modifiers = 0;
2791 else if (c == '?')
2792 c = 127, modifiers = 0;
2794 if (modifiers & CHAR_SHIFT)
2796 /* Shift modifier is valid only with [A-Za-z]. */
2797 if (c >= 'A' && c <= 'Z')
2798 modifiers &= ~CHAR_SHIFT;
2799 else if (c >= 'a' && c <= 'z')
2800 c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
2803 if (modifiers & CHAR_META)
2805 /* Move the meta bit to the right place for a
2806 string. */
2807 modifiers &= ~CHAR_META;
2808 c = BYTE8_TO_CHAR (c | 0x80);
2809 force_singlebyte = 1;
2813 /* Any modifiers remaining are invalid. */
2814 if (modifiers)
2815 error ("Invalid modifier in string");
2816 p += CHAR_STRING (c, (unsigned char *) p);
2818 else
2820 p += CHAR_STRING (c, (unsigned char *) p);
2821 if (CHAR_BYTE8_P (c))
2822 force_singlebyte = 1;
2823 else if (! ASCII_CHAR_P (c))
2824 force_multibyte = 1;
2826 nchars++;
2829 if (c < 0)
2830 end_of_file_error ();
2832 /* If purifying, and string starts with \ newline,
2833 return zero instead. This is for doc strings
2834 that we are really going to find in etc/DOC.nn.nn */
2835 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
2836 return make_number (0);
2838 if (force_multibyte)
2839 /* READ_BUFFER already contains valid multibyte forms. */
2841 else if (force_singlebyte)
2843 nchars = str_as_unibyte (read_buffer, p - read_buffer);
2844 p = read_buffer + nchars;
2846 else
2847 /* Otherwise, READ_BUFFER contains only ASCII. */
2850 /* We want readchar_count to be the number of characters, not
2851 bytes. Hence we adjust for multibyte characters in the
2852 string. ... But it doesn't seem to be necessary, because
2853 READCHAR *does* read multibyte characters from buffers. */
2854 /* readchar_count -= (p - read_buffer) - nchars; */
2855 if (read_pure)
2856 return make_pure_string (read_buffer, nchars, p - read_buffer,
2857 (force_multibyte
2858 || (p - read_buffer != nchars)));
2859 return make_specified_string (read_buffer, nchars, p - read_buffer,
2860 (force_multibyte
2861 || (p - read_buffer != nchars)));
2864 case '.':
2866 int next_char = READCHAR;
2867 UNREAD (next_char);
2869 if (next_char <= 040
2870 || (next_char < 0200
2871 && (strchr ("\"';([#?", next_char)
2872 || (!first_in_list && next_char == '`')
2873 || (new_backquote_flag && next_char == ','))))
2875 *pch = c;
2876 return Qnil;
2879 /* Otherwise, we fall through! Note that the atom-reading loop
2880 below will now loop at least once, assuring that we will not
2881 try to UNREAD two characters in a row. */
2883 default:
2884 default_label:
2885 if (c <= 040) goto retry;
2886 if (c == 0x8a0) /* NBSP */
2887 goto retry;
2889 char *p = read_buffer;
2890 int quoted = 0;
2893 char *end = read_buffer + read_buffer_size;
2895 while (c > 040
2896 && c != 0x8a0 /* NBSP */
2897 && (c >= 0200
2898 || (!strchr ("\"';()[]#", c)
2899 && !(!first_in_list && c == '`')
2900 && !(new_backquote_flag && c == ','))))
2902 if (end - p < MAX_MULTIBYTE_LENGTH)
2904 int offset = p - read_buffer;
2905 read_buffer = (char *) xrealloc (read_buffer,
2906 read_buffer_size *= 2);
2907 p = read_buffer + offset;
2908 end = read_buffer + read_buffer_size;
2911 if (c == '\\')
2913 c = READCHAR;
2914 if (c == -1)
2915 end_of_file_error ();
2916 quoted = 1;
2919 if (multibyte)
2920 p += CHAR_STRING (c, p);
2921 else
2922 *p++ = c;
2923 c = READCHAR;
2926 if (p == end)
2928 int offset = p - read_buffer;
2929 read_buffer = (char *) xrealloc (read_buffer,
2930 read_buffer_size *= 2);
2931 p = read_buffer + offset;
2932 end = read_buffer + read_buffer_size;
2934 *p = 0;
2935 if (c >= 0)
2936 UNREAD (c);
2939 if (!quoted && !uninterned_symbol)
2941 register char *p1;
2942 p1 = read_buffer;
2943 if (*p1 == '+' || *p1 == '-') p1++;
2944 /* Is it an integer? */
2945 if (p1 != p)
2947 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
2948 /* Integers can have trailing decimal points. */
2949 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
2950 if (p1 == p)
2951 /* It is an integer. */
2953 if (p1[-1] == '.')
2954 p1[-1] = '\0';
2956 /* EMACS_INT n = atol (read_buffer); */
2957 char *endptr = NULL;
2958 EMACS_INT n = (errno = 0,
2959 strtol (read_buffer, &endptr, 10));
2960 if (errno == ERANGE && endptr)
2962 Lisp_Object args
2963 = Fcons (make_string (read_buffer,
2964 endptr - read_buffer),
2965 Qnil);
2966 xsignal (Qoverflow_error, args);
2968 return make_fixnum_or_float (n);
2972 if (isfloat_string (read_buffer, 0))
2974 /* Compute NaN and infinities using 0.0 in a variable,
2975 to cope with compilers that think they are smarter
2976 than we are. */
2977 double zero = 0.0;
2979 double value;
2981 /* Negate the value ourselves. This treats 0, NaNs,
2982 and infinity properly on IEEE floating point hosts,
2983 and works around a common bug where atof ("-0.0")
2984 drops the sign. */
2985 int negative = read_buffer[0] == '-';
2987 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2988 returns 1, is if the input ends in e+INF or e+NaN. */
2989 switch (p[-1])
2991 case 'F':
2992 value = 1.0 / zero;
2993 break;
2994 case 'N':
2995 value = zero / zero;
2997 /* If that made a "negative" NaN, negate it. */
3000 int i;
3001 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
3003 u_data.d = value;
3004 u_minus_zero.d = - 0.0;
3005 for (i = 0; i < sizeof (double); i++)
3006 if (u_data.c[i] & u_minus_zero.c[i])
3008 value = - value;
3009 break;
3012 /* Now VALUE is a positive NaN. */
3013 break;
3014 default:
3015 value = atof (read_buffer + negative);
3016 break;
3019 return make_float (negative ? - value : value);
3023 Lisp_Object name, result;
3024 EMACS_INT nbytes = p - read_buffer;
3025 EMACS_INT nchars
3026 = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
3027 : nbytes);
3029 if (uninterned_symbol && ! NILP (Vpurify_flag))
3030 name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
3031 else
3032 name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
3033 result = (uninterned_symbol ? Fmake_symbol (name)
3034 : Fintern (name, Qnil));
3036 if (EQ (Vread_with_symbol_positions, Qt)
3037 || EQ (Vread_with_symbol_positions, readcharfun))
3038 Vread_symbol_positions_list =
3039 /* Kind of a hack; this will probably fail if characters
3040 in the symbol name were escaped. Not really a big
3041 deal, though. */
3042 Fcons (Fcons (result,
3043 make_number (readchar_count
3044 - XFASTINT (Flength (Fsymbol_name (result))))),
3045 Vread_symbol_positions_list);
3046 return result;
3053 /* List of nodes we've seen during substitute_object_in_subtree. */
3054 static Lisp_Object seen_list;
3056 static void
3057 substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
3059 Lisp_Object check_object;
3061 /* We haven't seen any objects when we start. */
3062 seen_list = Qnil;
3064 /* Make all the substitutions. */
3065 check_object
3066 = substitute_object_recurse (object, placeholder, object);
3068 /* Clear seen_list because we're done with it. */
3069 seen_list = Qnil;
3071 /* The returned object here is expected to always eq the
3072 original. */
3073 if (!EQ (check_object, object))
3074 error ("Unexpected mutation error in reader");
3077 /* Feval doesn't get called from here, so no gc protection is needed. */
3078 #define SUBSTITUTE(get_val, set_val) \
3079 do { \
3080 Lisp_Object old_value = get_val; \
3081 Lisp_Object true_value \
3082 = substitute_object_recurse (object, placeholder, \
3083 old_value); \
3085 if (!EQ (old_value, true_value)) \
3087 set_val; \
3089 } while (0)
3091 static Lisp_Object
3092 substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree)
3094 /* If we find the placeholder, return the target object. */
3095 if (EQ (placeholder, subtree))
3096 return object;
3098 /* If we've been to this node before, don't explore it again. */
3099 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
3100 return subtree;
3102 /* If this node can be the entry point to a cycle, remember that
3103 we've seen it. It can only be such an entry point if it was made
3104 by #n=, which means that we can find it as a value in
3105 read_objects. */
3106 if (!EQ (Qnil, Frassq (subtree, read_objects)))
3107 seen_list = Fcons (subtree, seen_list);
3109 /* Recurse according to subtree's type.
3110 Every branch must return a Lisp_Object. */
3111 switch (XTYPE (subtree))
3113 case Lisp_Vectorlike:
3115 int i, length = 0;
3116 if (BOOL_VECTOR_P (subtree))
3117 return subtree; /* No sub-objects anyway. */
3118 else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
3119 || COMPILEDP (subtree))
3120 length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
3121 else if (VECTORP (subtree))
3122 length = ASIZE (subtree);
3123 else
3124 /* An unknown pseudovector may contain non-Lisp fields, so we
3125 can't just blindly traverse all its fields. We used to call
3126 `Flength' which signaled `sequencep', so I just preserved this
3127 behavior. */
3128 wrong_type_argument (Qsequencep, subtree);
3130 for (i = 0; i < length; i++)
3131 SUBSTITUTE (AREF (subtree, i),
3132 ASET (subtree, i, true_value));
3133 return subtree;
3136 case Lisp_Cons:
3138 SUBSTITUTE (XCAR (subtree),
3139 XSETCAR (subtree, true_value));
3140 SUBSTITUTE (XCDR (subtree),
3141 XSETCDR (subtree, true_value));
3142 return subtree;
3145 case Lisp_String:
3147 /* Check for text properties in each interval.
3148 substitute_in_interval contains part of the logic. */
3150 INTERVAL root_interval = STRING_INTERVALS (subtree);
3151 Lisp_Object arg = Fcons (object, placeholder);
3153 traverse_intervals_noorder (root_interval,
3154 &substitute_in_interval, arg);
3156 return subtree;
3159 /* Other types don't recurse any further. */
3160 default:
3161 return subtree;
3165 /* Helper function for substitute_object_recurse. */
3166 static void
3167 substitute_in_interval (INTERVAL interval, Lisp_Object arg)
3169 Lisp_Object object = Fcar (arg);
3170 Lisp_Object placeholder = Fcdr (arg);
3172 SUBSTITUTE (interval->plist, interval->plist = true_value);
3176 #define LEAD_INT 1
3177 #define DOT_CHAR 2
3178 #define TRAIL_INT 4
3179 #define E_CHAR 8
3180 #define EXP_INT 16
3183 isfloat_string (const char *cp, int ignore_trailing)
3185 int state;
3186 const char *start = cp;
3188 state = 0;
3189 if (*cp == '+' || *cp == '-')
3190 cp++;
3192 if (*cp >= '0' && *cp <= '9')
3194 state |= LEAD_INT;
3195 while (*cp >= '0' && *cp <= '9')
3196 cp++;
3198 if (*cp == '.')
3200 state |= DOT_CHAR;
3201 cp++;
3203 if (*cp >= '0' && *cp <= '9')
3205 state |= TRAIL_INT;
3206 while (*cp >= '0' && *cp <= '9')
3207 cp++;
3209 if (*cp == 'e' || *cp == 'E')
3211 state |= E_CHAR;
3212 cp++;
3213 if (*cp == '+' || *cp == '-')
3214 cp++;
3217 if (*cp >= '0' && *cp <= '9')
3219 state |= EXP_INT;
3220 while (*cp >= '0' && *cp <= '9')
3221 cp++;
3223 else if (cp == start)
3225 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
3227 state |= EXP_INT;
3228 cp += 3;
3230 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
3232 state |= EXP_INT;
3233 cp += 3;
3236 return ((ignore_trailing
3237 || *cp == 0 || *cp == ' ' || *cp == '\t' || *cp == '\n'
3238 || *cp == '\r' || *cp == '\f')
3239 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
3240 || state == (DOT_CHAR|TRAIL_INT)
3241 || state == (LEAD_INT|E_CHAR|EXP_INT)
3242 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
3243 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
3247 static Lisp_Object
3248 read_vector (Lisp_Object readcharfun, int bytecodeflag)
3250 register int i;
3251 register int size;
3252 register Lisp_Object *ptr;
3253 register Lisp_Object tem, item, vector;
3254 register struct Lisp_Cons *otem;
3255 Lisp_Object len;
3257 tem = read_list (1, readcharfun);
3258 len = Flength (tem);
3259 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
3261 size = XVECTOR (vector)->size;
3262 ptr = XVECTOR (vector)->contents;
3263 for (i = 0; i < size; i++)
3265 item = Fcar (tem);
3266 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3267 bytecode object, the docstring containing the bytecode and
3268 constants values must be treated as unibyte and passed to
3269 Fread, to get the actual bytecode string and constants vector. */
3270 if (bytecodeflag && load_force_doc_strings)
3272 if (i == COMPILED_BYTECODE)
3274 if (!STRINGP (item))
3275 error ("Invalid byte code");
3277 /* Delay handling the bytecode slot until we know whether
3278 it is lazily-loaded (we can tell by whether the
3279 constants slot is nil). */
3280 ptr[COMPILED_CONSTANTS] = item;
3281 item = Qnil;
3283 else if (i == COMPILED_CONSTANTS)
3285 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
3287 if (NILP (item))
3289 /* Coerce string to unibyte (like string-as-unibyte,
3290 but without generating extra garbage and
3291 guaranteeing no change in the contents). */
3292 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
3293 STRING_SET_UNIBYTE (bytestr);
3295 item = Fread (Fcons (bytestr, readcharfun));
3296 if (!CONSP (item))
3297 error ("Invalid byte code");
3299 otem = XCONS (item);
3300 bytestr = XCAR (item);
3301 item = XCDR (item);
3302 free_cons (otem);
3305 /* Now handle the bytecode slot. */
3306 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
3308 else if (i == COMPILED_DOC_STRING
3309 && STRINGP (item)
3310 && ! STRING_MULTIBYTE (item))
3312 if (EQ (readcharfun, Qget_emacs_mule_file_char))
3313 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
3314 else
3315 item = Fstring_as_multibyte (item);
3318 ptr[i] = read_pure ? Fpurecopy (item) : item;
3319 otem = XCONS (tem);
3320 tem = Fcdr (tem);
3321 free_cons (otem);
3323 return vector;
3326 /* FLAG = 1 means check for ] to terminate rather than ) and .
3327 FLAG = -1 means check for starting with defun
3328 and make structure pure. */
3330 static Lisp_Object
3331 read_list (int flag, register Lisp_Object readcharfun)
3333 /* -1 means check next element for defun,
3334 0 means don't check,
3335 1 means already checked and found defun. */
3336 int defunflag = flag < 0 ? -1 : 0;
3337 Lisp_Object val, tail;
3338 register Lisp_Object elt, tem;
3339 struct gcpro gcpro1, gcpro2;
3340 /* 0 is the normal case.
3341 1 means this list is a doc reference; replace it with the number 0.
3342 2 means this list is a doc reference; replace it with the doc string. */
3343 int doc_reference = 0;
3345 /* Initialize this to 1 if we are reading a list. */
3346 int first_in_list = flag <= 0;
3348 val = Qnil;
3349 tail = Qnil;
3351 while (1)
3353 int ch;
3354 GCPRO2 (val, tail);
3355 elt = read1 (readcharfun, &ch, first_in_list);
3356 UNGCPRO;
3358 first_in_list = 0;
3360 /* While building, if the list starts with #$, treat it specially. */
3361 if (EQ (elt, Vload_file_name)
3362 && ! NILP (elt)
3363 && !NILP (Vpurify_flag))
3365 if (NILP (Vdoc_file_name))
3366 /* We have not yet called Snarf-documentation, so assume
3367 this file is described in the DOC-MM.NN file
3368 and Snarf-documentation will fill in the right value later.
3369 For now, replace the whole list with 0. */
3370 doc_reference = 1;
3371 else
3372 /* We have already called Snarf-documentation, so make a relative
3373 file name for this file, so it can be found properly
3374 in the installed Lisp directory.
3375 We don't use Fexpand_file_name because that would make
3376 the directory absolute now. */
3377 elt = concat2 (build_string ("../lisp/"),
3378 Ffile_name_nondirectory (elt));
3380 else if (EQ (elt, Vload_file_name)
3381 && ! NILP (elt)
3382 && load_force_doc_strings)
3383 doc_reference = 2;
3385 if (ch)
3387 if (flag > 0)
3389 if (ch == ']')
3390 return val;
3391 invalid_syntax (") or . in a vector", 18);
3393 if (ch == ')')
3394 return val;
3395 if (ch == '.')
3397 GCPRO2 (val, tail);
3398 if (!NILP (tail))
3399 XSETCDR (tail, read0 (readcharfun));
3400 else
3401 val = read0 (readcharfun);
3402 read1 (readcharfun, &ch, 0);
3403 UNGCPRO;
3404 if (ch == ')')
3406 if (doc_reference == 1)
3407 return make_number (0);
3408 if (doc_reference == 2)
3410 /* Get a doc string from the file we are loading.
3411 If it's in saved_doc_string, get it from there.
3413 Here, we don't know if the string is a
3414 bytecode string or a doc string. As a
3415 bytecode string must be unibyte, we always
3416 return a unibyte string. If it is actually a
3417 doc string, caller must make it
3418 multibyte. */
3420 int pos = XINT (XCDR (val));
3421 /* Position is negative for user variables. */
3422 if (pos < 0) pos = -pos;
3423 if (pos >= saved_doc_string_position
3424 && pos < (saved_doc_string_position
3425 + saved_doc_string_length))
3427 int start = pos - saved_doc_string_position;
3428 int from, to;
3430 /* Process quoting with ^A,
3431 and find the end of the string,
3432 which is marked with ^_ (037). */
3433 for (from = start, to = start;
3434 saved_doc_string[from] != 037;)
3436 int c = saved_doc_string[from++];
3437 if (c == 1)
3439 c = saved_doc_string[from++];
3440 if (c == 1)
3441 saved_doc_string[to++] = c;
3442 else if (c == '0')
3443 saved_doc_string[to++] = 0;
3444 else if (c == '_')
3445 saved_doc_string[to++] = 037;
3447 else
3448 saved_doc_string[to++] = c;
3451 return make_unibyte_string (saved_doc_string + start,
3452 to - start);
3454 /* Look in prev_saved_doc_string the same way. */
3455 else if (pos >= prev_saved_doc_string_position
3456 && pos < (prev_saved_doc_string_position
3457 + prev_saved_doc_string_length))
3459 int start = pos - prev_saved_doc_string_position;
3460 int from, to;
3462 /* Process quoting with ^A,
3463 and find the end of the string,
3464 which is marked with ^_ (037). */
3465 for (from = start, to = start;
3466 prev_saved_doc_string[from] != 037;)
3468 int c = prev_saved_doc_string[from++];
3469 if (c == 1)
3471 c = prev_saved_doc_string[from++];
3472 if (c == 1)
3473 prev_saved_doc_string[to++] = c;
3474 else if (c == '0')
3475 prev_saved_doc_string[to++] = 0;
3476 else if (c == '_')
3477 prev_saved_doc_string[to++] = 037;
3479 else
3480 prev_saved_doc_string[to++] = c;
3483 return make_unibyte_string (prev_saved_doc_string
3484 + start,
3485 to - start);
3487 else
3488 return get_doc_string (val, 1, 0);
3491 return val;
3493 invalid_syntax (". in wrong context", 18);
3495 invalid_syntax ("] in a list", 11);
3497 tem = (read_pure && flag <= 0
3498 ? pure_cons (elt, Qnil)
3499 : Fcons (elt, Qnil));
3500 if (!NILP (tail))
3501 XSETCDR (tail, tem);
3502 else
3503 val = tem;
3504 tail = tem;
3505 if (defunflag < 0)
3506 defunflag = EQ (elt, Qdefun);
3507 else if (defunflag > 0)
3508 read_pure = 1;
3512 Lisp_Object Vobarray;
3513 Lisp_Object initial_obarray;
3515 /* oblookup stores the bucket number here, for the sake of Funintern. */
3517 int oblookup_last_bucket_number;
3519 static int hash_string (const unsigned char *ptr, int len);
3521 /* Get an error if OBARRAY is not an obarray.
3522 If it is one, return it. */
3524 Lisp_Object
3525 check_obarray (Lisp_Object obarray)
3527 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3529 /* If Vobarray is now invalid, force it to be valid. */
3530 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
3531 wrong_type_argument (Qvectorp, obarray);
3533 return obarray;
3536 /* Intern the C string STR: return a symbol with that name,
3537 interned in the current obarray. */
3539 Lisp_Object
3540 intern (const char *str)
3542 Lisp_Object tem;
3543 int len = strlen (str);
3544 Lisp_Object obarray;
3546 obarray = Vobarray;
3547 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3548 obarray = check_obarray (obarray);
3549 tem = oblookup (obarray, str, len, len);
3550 if (SYMBOLP (tem))
3551 return tem;
3552 return Fintern (make_string (str, len), obarray);
3555 Lisp_Object
3556 intern_c_string (const char *str)
3558 Lisp_Object tem;
3559 int len = strlen (str);
3560 Lisp_Object obarray;
3562 obarray = Vobarray;
3563 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3564 obarray = check_obarray (obarray);
3565 tem = oblookup (obarray, str, len, len);
3566 if (SYMBOLP (tem))
3567 return tem;
3569 if (NILP (Vpurify_flag))
3570 /* Creating a non-pure string from a string literal not
3571 implemented yet. We could just use make_string here and live
3572 with the extra copy. */
3573 abort ();
3575 return Fintern (make_pure_c_string (str), obarray);
3578 /* Create an uninterned symbol with name STR. */
3580 Lisp_Object
3581 make_symbol (const char *str)
3583 int len = strlen (str);
3585 return Fmake_symbol (!NILP (Vpurify_flag)
3586 ? make_pure_string (str, len, len, 0)
3587 : make_string (str, len));
3590 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
3591 doc: /* Return the canonical symbol whose name is STRING.
3592 If there is none, one is created by this function and returned.
3593 A second optional argument specifies the obarray to use;
3594 it defaults to the value of `obarray'. */)
3595 (Lisp_Object string, Lisp_Object obarray)
3597 register Lisp_Object tem, sym, *ptr;
3599 if (NILP (obarray)) obarray = Vobarray;
3600 obarray = check_obarray (obarray);
3602 CHECK_STRING (string);
3604 tem = oblookup (obarray, SDATA (string),
3605 SCHARS (string),
3606 SBYTES (string));
3607 if (!INTEGERP (tem))
3608 return tem;
3610 if (!NILP (Vpurify_flag))
3611 string = Fpurecopy (string);
3612 sym = Fmake_symbol (string);
3614 if (EQ (obarray, initial_obarray))
3615 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3616 else
3617 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
3619 if ((SREF (string, 0) == ':')
3620 && EQ (obarray, initial_obarray))
3622 XSYMBOL (sym)->constant = 1;
3623 XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
3624 SET_SYMBOL_VAL (XSYMBOL (sym), sym);
3627 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
3628 if (SYMBOLP (*ptr))
3629 XSYMBOL (sym)->next = XSYMBOL (*ptr);
3630 else
3631 XSYMBOL (sym)->next = 0;
3632 *ptr = sym;
3633 return sym;
3636 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
3637 doc: /* Return the canonical symbol named NAME, or nil if none exists.
3638 NAME may be a string or a symbol. If it is a symbol, that exact
3639 symbol is searched for.
3640 A second optional argument specifies the obarray to use;
3641 it defaults to the value of `obarray'. */)
3642 (Lisp_Object name, Lisp_Object obarray)
3644 register Lisp_Object tem, string;
3646 if (NILP (obarray)) obarray = Vobarray;
3647 obarray = check_obarray (obarray);
3649 if (!SYMBOLP (name))
3651 CHECK_STRING (name);
3652 string = name;
3654 else
3655 string = SYMBOL_NAME (name);
3657 tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
3658 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3659 return Qnil;
3660 else
3661 return tem;
3664 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
3665 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
3666 The value is t if a symbol was found and deleted, nil otherwise.
3667 NAME may be a string or a symbol. If it is a symbol, that symbol
3668 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3669 OBARRAY defaults to the value of the variable `obarray'. */)
3670 (Lisp_Object name, Lisp_Object obarray)
3672 register Lisp_Object string, tem;
3673 int hash;
3675 if (NILP (obarray)) obarray = Vobarray;
3676 obarray = check_obarray (obarray);
3678 if (SYMBOLP (name))
3679 string = SYMBOL_NAME (name);
3680 else
3682 CHECK_STRING (name);
3683 string = name;
3686 tem = oblookup (obarray, SDATA (string),
3687 SCHARS (string),
3688 SBYTES (string));
3689 if (INTEGERP (tem))
3690 return Qnil;
3691 /* If arg was a symbol, don't delete anything but that symbol itself. */
3692 if (SYMBOLP (name) && !EQ (name, tem))
3693 return Qnil;
3695 /* There are plenty of other symbols which will screw up the Emacs
3696 session if we unintern them, as well as even more ways to use
3697 `setq' or `fset' or whatnot to make the Emacs session
3698 unusable. Let's not go down this silly road. --Stef */
3699 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3700 error ("Attempt to unintern t or nil"); */
3702 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3704 hash = oblookup_last_bucket_number;
3706 if (EQ (XVECTOR (obarray)->contents[hash], tem))
3708 if (XSYMBOL (tem)->next)
3709 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3710 else
3711 XSETINT (XVECTOR (obarray)->contents[hash], 0);
3713 else
3715 Lisp_Object tail, following;
3717 for (tail = XVECTOR (obarray)->contents[hash];
3718 XSYMBOL (tail)->next;
3719 tail = following)
3721 XSETSYMBOL (following, XSYMBOL (tail)->next);
3722 if (EQ (following, tem))
3724 XSYMBOL (tail)->next = XSYMBOL (following)->next;
3725 break;
3730 return Qt;
3733 /* Return the symbol in OBARRAY whose names matches the string
3734 of SIZE characters (SIZE_BYTE bytes) at PTR.
3735 If there is no such symbol in OBARRAY, return nil.
3737 Also store the bucket number in oblookup_last_bucket_number. */
3739 Lisp_Object
3740 oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte)
3742 int hash;
3743 int obsize;
3744 register Lisp_Object tail;
3745 Lisp_Object bucket, tem;
3747 if (!VECTORP (obarray)
3748 || (obsize = XVECTOR (obarray)->size) == 0)
3750 obarray = check_obarray (obarray);
3751 obsize = XVECTOR (obarray)->size;
3753 /* This is sometimes needed in the middle of GC. */
3754 obsize &= ~ARRAY_MARK_FLAG;
3755 hash = hash_string (ptr, size_byte) % obsize;
3756 bucket = XVECTOR (obarray)->contents[hash];
3757 oblookup_last_bucket_number = hash;
3758 if (EQ (bucket, make_number (0)))
3760 else if (!SYMBOLP (bucket))
3761 error ("Bad data in guts of obarray"); /* Like CADR error message */
3762 else
3763 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
3765 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3766 && SCHARS (SYMBOL_NAME (tail)) == size
3767 && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
3768 return tail;
3769 else if (XSYMBOL (tail)->next == 0)
3770 break;
3772 XSETINT (tem, hash);
3773 return tem;
3776 static int
3777 hash_string (const unsigned char *ptr, int len)
3779 register const unsigned char *p = ptr;
3780 register const unsigned char *end = p + len;
3781 register unsigned char c;
3782 register int hash = 0;
3784 while (p != end)
3786 c = *p++;
3787 if (c >= 0140) c -= 40;
3788 hash = ((hash<<3) + (hash>>28) + c);
3790 return hash & 07777777777;
3793 void
3794 map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
3796 register int i;
3797 register Lisp_Object tail;
3798 CHECK_VECTOR (obarray);
3799 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
3801 tail = XVECTOR (obarray)->contents[i];
3802 if (SYMBOLP (tail))
3803 while (1)
3805 (*fn) (tail, arg);
3806 if (XSYMBOL (tail)->next == 0)
3807 break;
3808 XSETSYMBOL (tail, XSYMBOL (tail)->next);
3813 static void
3814 mapatoms_1 (Lisp_Object sym, Lisp_Object function)
3816 call1 (function, sym);
3819 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
3820 doc: /* Call FUNCTION on every symbol in OBARRAY.
3821 OBARRAY defaults to the value of `obarray'. */)
3822 (Lisp_Object function, Lisp_Object obarray)
3824 if (NILP (obarray)) obarray = Vobarray;
3825 obarray = check_obarray (obarray);
3827 map_obarray (obarray, mapatoms_1, function);
3828 return Qnil;
3831 #define OBARRAY_SIZE 1511
3833 void
3834 init_obarray (void)
3836 Lisp_Object oblength;
3838 XSETFASTINT (oblength, OBARRAY_SIZE);
3840 Vobarray = Fmake_vector (oblength, make_number (0));
3841 initial_obarray = Vobarray;
3842 staticpro (&initial_obarray);
3844 Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
3845 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3846 NILP (Vpurify_flag) check in intern_c_string. */
3847 Qnil = make_number (-1); Vpurify_flag = make_number (1);
3848 Qnil = intern_c_string ("nil");
3850 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3851 so those two need to be fixed manally. */
3852 SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
3853 XSYMBOL (Qunbound)->function = Qunbound;
3854 XSYMBOL (Qunbound)->plist = Qnil;
3855 /* XSYMBOL (Qnil)->function = Qunbound; */
3856 SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
3857 XSYMBOL (Qnil)->constant = 1;
3858 XSYMBOL (Qnil)->plist = Qnil;
3860 Qt = intern_c_string ("t");
3861 SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
3862 XSYMBOL (Qt)->constant = 1;
3864 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3865 Vpurify_flag = Qt;
3867 Qvariable_documentation = intern_c_string ("variable-documentation");
3868 staticpro (&Qvariable_documentation);
3870 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
3871 read_buffer = (char *) xmalloc (read_buffer_size);
3874 void
3875 defsubr (struct Lisp_Subr *sname)
3877 Lisp_Object sym;
3878 sym = intern_c_string (sname->symbol_name);
3879 XSETPVECTYPE (sname, PVEC_SUBR);
3880 XSETSUBR (XSYMBOL (sym)->function, sname);
3883 #ifdef NOTDEF /* use fset in subr.el now */
3884 void
3885 defalias (sname, string)
3886 struct Lisp_Subr *sname;
3887 char *string;
3889 Lisp_Object sym;
3890 sym = intern (string);
3891 XSETSUBR (XSYMBOL (sym)->function, sname);
3893 #endif /* NOTDEF */
3895 /* Define an "integer variable"; a symbol whose value is forwarded to a
3896 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3897 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3898 void
3899 defvar_int (struct Lisp_Intfwd *i_fwd,
3900 const char *namestring, EMACS_INT *address)
3902 Lisp_Object sym;
3903 sym = intern_c_string (namestring);
3904 i_fwd->type = Lisp_Fwd_Int;
3905 i_fwd->intvar = address;
3906 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
3907 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
3910 /* Similar but define a variable whose value is t if address contains 1,
3911 nil if address contains 0. */
3912 void
3913 defvar_bool (struct Lisp_Boolfwd *b_fwd,
3914 const char *namestring, int *address)
3916 Lisp_Object sym;
3917 sym = intern_c_string (namestring);
3918 b_fwd->type = Lisp_Fwd_Bool;
3919 b_fwd->boolvar = address;
3920 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
3921 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
3922 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
3925 /* Similar but define a variable whose value is the Lisp Object stored
3926 at address. Two versions: with and without gc-marking of the C
3927 variable. The nopro version is used when that variable will be
3928 gc-marked for some other reason, since marking the same slot twice
3929 can cause trouble with strings. */
3930 void
3931 defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
3932 const char *namestring, Lisp_Object *address)
3934 Lisp_Object sym;
3935 sym = intern_c_string (namestring);
3936 o_fwd->type = Lisp_Fwd_Obj;
3937 o_fwd->objvar = address;
3938 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
3939 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
3942 void
3943 defvar_lisp (struct Lisp_Objfwd *o_fwd,
3944 const char *namestring, Lisp_Object *address)
3946 defvar_lisp_nopro (o_fwd, namestring, address);
3947 staticpro (address);
3950 /* Similar but define a variable whose value is the Lisp Object stored
3951 at a particular offset in the current kboard object. */
3953 void
3954 defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
3955 const char *namestring, int offset)
3957 Lisp_Object sym;
3958 sym = intern_c_string (namestring);
3959 ko_fwd->type = Lisp_Fwd_Kboard_Obj;
3960 ko_fwd->offset = offset;
3961 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
3962 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
3965 /* Record the value of load-path used at the start of dumping
3966 so we can see if the site changed it later during dumping. */
3967 static Lisp_Object dump_path;
3969 void
3970 init_lread (void)
3972 const char *normal;
3973 int turn_off_warning = 0;
3975 /* Compute the default load-path. */
3976 #ifdef CANNOT_DUMP
3977 normal = PATH_LOADSEARCH;
3978 Vload_path = decode_env_path (0, normal);
3979 #else
3980 if (NILP (Vpurify_flag))
3981 normal = PATH_LOADSEARCH;
3982 else
3983 normal = PATH_DUMPLOADSEARCH;
3985 /* In a dumped Emacs, we normally have to reset the value of
3986 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3987 uses ../lisp, instead of the path of the installed elisp
3988 libraries. However, if it appears that Vload_path was changed
3989 from the default before dumping, don't override that value. */
3990 if (initialized)
3992 if (! NILP (Fequal (dump_path, Vload_path)))
3994 Vload_path = decode_env_path (0, normal);
3995 if (!NILP (Vinstallation_directory))
3997 Lisp_Object tem, tem1, sitelisp;
3999 /* Remove site-lisp dirs from path temporarily and store
4000 them in sitelisp, then conc them on at the end so
4001 they're always first in path. */
4002 sitelisp = Qnil;
4003 while (1)
4005 tem = Fcar (Vload_path);
4006 tem1 = Fstring_match (build_string ("site-lisp"),
4007 tem, Qnil);
4008 if (!NILP (tem1))
4010 Vload_path = Fcdr (Vload_path);
4011 sitelisp = Fcons (tem, sitelisp);
4013 else
4014 break;
4017 /* Add to the path the lisp subdir of the
4018 installation dir, if it exists. */
4019 tem = Fexpand_file_name (build_string ("lisp"),
4020 Vinstallation_directory);
4021 tem1 = Ffile_exists_p (tem);
4022 if (!NILP (tem1))
4024 if (NILP (Fmember (tem, Vload_path)))
4026 turn_off_warning = 1;
4027 Vload_path = Fcons (tem, Vload_path);
4030 else
4031 /* That dir doesn't exist, so add the build-time
4032 Lisp dirs instead. */
4033 Vload_path = nconc2 (Vload_path, dump_path);
4035 /* Add leim under the installation dir, if it exists. */
4036 tem = Fexpand_file_name (build_string ("leim"),
4037 Vinstallation_directory);
4038 tem1 = Ffile_exists_p (tem);
4039 if (!NILP (tem1))
4041 if (NILP (Fmember (tem, Vload_path)))
4042 Vload_path = Fcons (tem, Vload_path);
4045 /* Add site-lisp under the installation dir, if it exists. */
4046 tem = Fexpand_file_name (build_string ("site-lisp"),
4047 Vinstallation_directory);
4048 tem1 = Ffile_exists_p (tem);
4049 if (!NILP (tem1))
4051 if (NILP (Fmember (tem, Vload_path)))
4052 Vload_path = Fcons (tem, Vload_path);
4055 /* If Emacs was not built in the source directory,
4056 and it is run from where it was built, add to load-path
4057 the lisp, leim and site-lisp dirs under that directory. */
4059 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
4061 Lisp_Object tem2;
4063 tem = Fexpand_file_name (build_string ("src/Makefile"),
4064 Vinstallation_directory);
4065 tem1 = Ffile_exists_p (tem);
4067 /* Don't be fooled if they moved the entire source tree
4068 AFTER dumping Emacs. If the build directory is indeed
4069 different from the source dir, src/Makefile.in and
4070 src/Makefile will not be found together. */
4071 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
4072 Vinstallation_directory);
4073 tem2 = Ffile_exists_p (tem);
4074 if (!NILP (tem1) && NILP (tem2))
4076 tem = Fexpand_file_name (build_string ("lisp"),
4077 Vsource_directory);
4079 if (NILP (Fmember (tem, Vload_path)))
4080 Vload_path = Fcons (tem, Vload_path);
4082 tem = Fexpand_file_name (build_string ("leim"),
4083 Vsource_directory);
4085 if (NILP (Fmember (tem, Vload_path)))
4086 Vload_path = Fcons (tem, Vload_path);
4088 tem = Fexpand_file_name (build_string ("site-lisp"),
4089 Vsource_directory);
4091 if (NILP (Fmember (tem, Vload_path)))
4092 Vload_path = Fcons (tem, Vload_path);
4095 if (!NILP (sitelisp))
4096 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
4100 else
4102 /* NORMAL refers to the lisp dir in the source directory. */
4103 /* We used to add ../lisp at the front here, but
4104 that caused trouble because it was copied from dump_path
4105 into Vload_path, above, when Vinstallation_directory was non-nil.
4106 It should be unnecessary. */
4107 Vload_path = decode_env_path (0, normal);
4108 dump_path = Vload_path;
4110 #endif
4112 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4113 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4114 almost never correct, thereby causing a warning to be printed out that
4115 confuses users. Since PATH_LOADSEARCH is always overridden by the
4116 EMACSLOADPATH environment variable below, disable the warning on NT. */
4118 /* Warn if dirs in the *standard* path don't exist. */
4119 if (!turn_off_warning)
4121 Lisp_Object path_tail;
4123 for (path_tail = Vload_path;
4124 !NILP (path_tail);
4125 path_tail = XCDR (path_tail))
4127 Lisp_Object dirfile;
4128 dirfile = Fcar (path_tail);
4129 if (STRINGP (dirfile))
4131 dirfile = Fdirectory_file_name (dirfile);
4132 if (access (SDATA (dirfile), 0) < 0)
4133 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4134 XCAR (path_tail));
4138 #endif /* !(WINDOWSNT || HAVE_NS) */
4140 /* If the EMACSLOADPATH environment variable is set, use its value.
4141 This doesn't apply if we're dumping. */
4142 #ifndef CANNOT_DUMP
4143 if (NILP (Vpurify_flag)
4144 && egetenv ("EMACSLOADPATH"))
4145 #endif
4146 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
4148 Vvalues = Qnil;
4150 load_in_progress = 0;
4151 Vload_file_name = Qnil;
4153 load_descriptor_list = Qnil;
4155 Vstandard_input = Qt;
4156 Vloads_in_progress = Qnil;
4159 /* Print a warning, using format string FORMAT, that directory DIRNAME
4160 does not exist. Print it on stderr and put it in *Messages*. */
4162 void
4163 dir_warning (const char *format, Lisp_Object dirname)
4165 char *buffer
4166 = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
4168 fprintf (stderr, format, SDATA (dirname));
4169 sprintf (buffer, format, SDATA (dirname));
4170 /* Don't log the warning before we've initialized!! */
4171 if (initialized)
4172 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
4175 void
4176 syms_of_lread (void)
4178 defsubr (&Sread);
4179 defsubr (&Sread_from_string);
4180 defsubr (&Sintern);
4181 defsubr (&Sintern_soft);
4182 defsubr (&Sunintern);
4183 defsubr (&Sget_load_suffixes);
4184 defsubr (&Sload);
4185 defsubr (&Seval_buffer);
4186 defsubr (&Seval_region);
4187 defsubr (&Sread_char);
4188 defsubr (&Sread_char_exclusive);
4189 defsubr (&Sread_event);
4190 defsubr (&Sget_file_char);
4191 defsubr (&Smapatoms);
4192 defsubr (&Slocate_file_internal);
4194 DEFVAR_LISP ("obarray", &Vobarray,
4195 doc: /* Symbol table for use by `intern' and `read'.
4196 It is a vector whose length ought to be prime for best results.
4197 The vector's contents don't make sense if examined from Lisp programs;
4198 to find all the symbols in an obarray, use `mapatoms'. */);
4200 DEFVAR_LISP ("values", &Vvalues,
4201 doc: /* List of values of all expressions which were read, evaluated and printed.
4202 Order is reverse chronological. */);
4204 DEFVAR_LISP ("standard-input", &Vstandard_input,
4205 doc: /* Stream for read to get input from.
4206 See documentation of `read' for possible values. */);
4207 Vstandard_input = Qt;
4209 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
4210 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4212 If this variable is a buffer, then only forms read from that buffer
4213 will be added to `read-symbol-positions-list'.
4214 If this variable is t, then all read forms will be added.
4215 The effect of all other values other than nil are not currently
4216 defined, although they may be in the future.
4218 The positions are relative to the last call to `read' or
4219 `read-from-string'. It is probably a bad idea to set this variable at
4220 the toplevel; bind it instead. */);
4221 Vread_with_symbol_positions = Qnil;
4223 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
4224 doc: /* A list mapping read symbols to their positions.
4225 This variable is modified during calls to `read' or
4226 `read-from-string', but only when `read-with-symbol-positions' is
4227 non-nil.
4229 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4230 CHAR-POSITION is an integer giving the offset of that occurrence of the
4231 symbol from the position where `read' or `read-from-string' started.
4233 Note that a symbol will appear multiple times in this list, if it was
4234 read multiple times. The list is in the same order as the symbols
4235 were read in. */);
4236 Vread_symbol_positions_list = Qnil;
4238 DEFVAR_LISP ("read-circle", &Vread_circle,
4239 doc: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4240 Vread_circle = Qt;
4242 DEFVAR_LISP ("load-path", &Vload_path,
4243 doc: /* *List of directories to search for files to load.
4244 Each element is a string (directory name) or nil (try default directory).
4245 Initialized based on EMACSLOADPATH environment variable, if any,
4246 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4248 DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
4249 doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
4250 This list should not include the empty string.
4251 `load' and related functions try to append these suffixes, in order,
4252 to the specified file name if a Lisp suffix is allowed or required. */);
4253 Vload_suffixes = Fcons (make_pure_c_string (".elc"),
4254 Fcons (make_pure_c_string (".el"), Qnil));
4255 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes,
4256 doc: /* List of suffixes that indicate representations of \
4257 the same file.
4258 This list should normally start with the empty string.
4260 Enabling Auto Compression mode appends the suffixes in
4261 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4262 mode removes them again. `load' and related functions use this list to
4263 determine whether they should look for compressed versions of a file
4264 and, if so, which suffixes they should try to append to the file name
4265 in order to do so. However, if you want to customize which suffixes
4266 the loading functions recognize as compression suffixes, you should
4267 customize `jka-compr-load-suffixes' rather than the present variable. */);
4268 Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
4270 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
4271 doc: /* Non-nil if inside of `load'. */);
4272 Qload_in_progress = intern_c_string ("load-in-progress");
4273 staticpro (&Qload_in_progress);
4275 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
4276 doc: /* An alist of expressions to be evalled when particular files are loaded.
4277 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4279 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4280 a symbol \(a feature name).
4282 When `load' is run and the file-name argument matches an element's
4283 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4284 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4286 An error in FORMS does not undo the load, but does prevent execution of
4287 the rest of the FORMS. */);
4288 Vafter_load_alist = Qnil;
4290 DEFVAR_LISP ("load-history", &Vload_history,
4291 doc: /* Alist mapping loaded file names to symbols and features.
4292 Each alist element should be a list (FILE-NAME ENTRIES...), where
4293 FILE-NAME is the name of a file that has been loaded into Emacs.
4294 The file name is absolute and true (i.e. it doesn't contain symlinks).
4295 As an exception, one of the alist elements may have FILE-NAME nil,
4296 for symbols and features not associated with any file.
4298 The remaining ENTRIES in the alist element describe the functions and
4299 variables defined in that file, the features provided, and the
4300 features required. Each entry has the form `(provide . FEATURE)',
4301 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4302 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4303 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4304 SYMBOL was an autoload before this file redefined it as a function.
4306 During preloading, the file name recorded is relative to the main Lisp
4307 directory. These file names are converted to absolute at startup. */);
4308 Vload_history = Qnil;
4310 DEFVAR_LISP ("load-file-name", &Vload_file_name,
4311 doc: /* Full name of file being loaded by `load'. */);
4312 Vload_file_name = Qnil;
4314 DEFVAR_LISP ("user-init-file", &Vuser_init_file,
4315 doc: /* File name, including directory, of user's initialization file.
4316 If the file loaded had extension `.elc', and the corresponding source file
4317 exists, this variable contains the name of source file, suitable for use
4318 by functions like `custom-save-all' which edit the init file.
4319 While Emacs loads and evaluates the init file, value is the real name
4320 of the file, regardless of whether or not it has the `.elc' extension. */);
4321 Vuser_init_file = Qnil;
4323 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
4324 doc: /* Used for internal purposes by `load'. */);
4325 Vcurrent_load_list = Qnil;
4327 DEFVAR_LISP ("load-read-function", &Vload_read_function,
4328 doc: /* Function used by `load' and `eval-region' for reading expressions.
4329 The default is nil, which means use the function `read'. */);
4330 Vload_read_function = Qnil;
4332 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
4333 doc: /* Function called in `load' for loading an Emacs Lisp source file.
4334 This function is for doing code conversion before reading the source file.
4335 If nil, loading is done without any code conversion.
4336 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4337 FULLNAME is the full name of FILE.
4338 See `load' for the meaning of the remaining arguments. */);
4339 Vload_source_file_function = Qnil;
4341 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
4342 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
4343 This is useful when the file being loaded is a temporary copy. */);
4344 load_force_doc_strings = 0;
4346 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
4347 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
4348 This is normally bound by `load' and `eval-buffer' to control `read',
4349 and is not meant for users to change. */);
4350 load_convert_to_unibyte = 0;
4352 DEFVAR_LISP ("source-directory", &Vsource_directory,
4353 doc: /* Directory in which Emacs sources were found when Emacs was built.
4354 You cannot count on them to still be there! */);
4355 Vsource_directory
4356 = Fexpand_file_name (build_string ("../"),
4357 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
4359 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
4360 doc: /* List of files that were preloaded (when dumping Emacs). */);
4361 Vpreloaded_file_list = Qnil;
4363 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
4364 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4365 Vbyte_boolean_vars = Qnil;
4367 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
4368 doc: /* Non-nil means load dangerous compiled Lisp files.
4369 Some versions of XEmacs use different byte codes than Emacs. These
4370 incompatible byte codes can make Emacs crash when it tries to execute
4371 them. */);
4372 load_dangerous_libraries = 0;
4374 DEFVAR_BOOL ("force-load-messages", &force_load_messages,
4375 doc: /* Non-nil means force printing messages when loading Lisp files.
4376 This overrides the value of the NOMESSAGE argument to `load'. */);
4377 force_load_messages = 0;
4379 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
4380 doc: /* Regular expression matching safe to load compiled Lisp files.
4381 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4382 from the file, and matches them against this regular expression.
4383 When the regular expression matches, the file is considered to be safe
4384 to load. See also `load-dangerous-libraries'. */);
4385 Vbytecomp_version_regexp
4386 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4388 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
4389 doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4390 Veval_buffer_list = Qnil;
4392 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes,
4393 doc: /* Set to non-nil when `read' encounters an old-style backquote. */);
4394 Vold_style_backquotes = Qnil;
4395 Qold_style_backquotes = intern_c_string ("old-style-backquotes");
4396 staticpro (&Qold_style_backquotes);
4398 /* Vsource_directory was initialized in init_lread. */
4400 load_descriptor_list = Qnil;
4401 staticpro (&load_descriptor_list);
4403 Qcurrent_load_list = intern_c_string ("current-load-list");
4404 staticpro (&Qcurrent_load_list);
4406 Qstandard_input = intern_c_string ("standard-input");
4407 staticpro (&Qstandard_input);
4409 Qread_char = intern_c_string ("read-char");
4410 staticpro (&Qread_char);
4412 Qget_file_char = intern_c_string ("get-file-char");
4413 staticpro (&Qget_file_char);
4415 Qget_emacs_mule_file_char = intern_c_string ("get-emacs-mule-file-char");
4416 staticpro (&Qget_emacs_mule_file_char);
4418 Qload_force_doc_strings = intern_c_string ("load-force-doc-strings");
4419 staticpro (&Qload_force_doc_strings);
4421 Qbackquote = intern_c_string ("`");
4422 staticpro (&Qbackquote);
4423 Qcomma = intern_c_string (",");
4424 staticpro (&Qcomma);
4425 Qcomma_at = intern_c_string (",@");
4426 staticpro (&Qcomma_at);
4427 Qcomma_dot = intern_c_string (",.");
4428 staticpro (&Qcomma_dot);
4430 Qinhibit_file_name_operation = intern_c_string ("inhibit-file-name-operation");
4431 staticpro (&Qinhibit_file_name_operation);
4433 Qascii_character = intern_c_string ("ascii-character");
4434 staticpro (&Qascii_character);
4436 Qfunction = intern_c_string ("function");
4437 staticpro (&Qfunction);
4439 Qload = intern_c_string ("load");
4440 staticpro (&Qload);
4442 Qload_file_name = intern_c_string ("load-file-name");
4443 staticpro (&Qload_file_name);
4445 Qeval_buffer_list = intern_c_string ("eval-buffer-list");
4446 staticpro (&Qeval_buffer_list);
4448 Qfile_truename = intern_c_string ("file-truename");
4449 staticpro (&Qfile_truename) ;
4451 Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation");
4452 staticpro (&Qdo_after_load_evaluation) ;
4454 staticpro (&dump_path);
4456 staticpro (&read_objects);
4457 read_objects = Qnil;
4458 staticpro (&seen_list);
4459 seen_list = Qnil;
4461 Vloads_in_progress = Qnil;
4462 staticpro (&Vloads_in_progress);
4464 Qhash_table = intern_c_string ("hash-table");
4465 staticpro (&Qhash_table);
4466 Qdata = intern_c_string ("data");
4467 staticpro (&Qdata);
4468 Qtest = intern_c_string ("test");
4469 staticpro (&Qtest);
4470 Qsize = intern_c_string ("size");
4471 staticpro (&Qsize);
4472 Qweakness = intern_c_string ("weakness");
4473 staticpro (&Qweakness);
4474 Qrehash_size = intern_c_string ("rehash-size");
4475 staticpro (&Qrehash_size);
4476 Qrehash_threshold = intern_c_string ("rehash-threshold");
4477 staticpro (&Qrehash_threshold);