Avoid infloop when scrolling conservatively (Bug#7537).
[emacs.git] / src / lread.c
blob17861d3bb23dd23133634894525f9f135999c9af
1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <stdio.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <sys/file.h>
27 #include <errno.h>
28 #include <setjmp.h>
29 #include "lisp.h"
30 #include "intervals.h"
31 #include "buffer.h"
32 #include "character.h"
33 #include "charset.h"
34 #include "coding.h"
35 #include <epaths.h>
36 #include "commands.h"
37 #include "keyboard.h"
38 #include "frame.h"
39 #include "termhooks.h"
40 #include "coding.h"
41 #include "blockinput.h"
43 #ifdef MSDOS
44 #if __DJGPP__ < 2
45 #include <unistd.h> /* to get X_OK */
46 #endif
47 #include "msdos.h"
48 #endif
50 #ifdef HAVE_UNISTD_H
51 #include <unistd.h>
52 #endif
54 #ifndef X_OK
55 #define X_OK 01
56 #endif
58 #include <math.h>
60 #ifdef HAVE_SETLOCALE
61 #include <locale.h>
62 #endif /* HAVE_SETLOCALE */
64 #ifdef HAVE_FCNTL_H
65 #include <fcntl.h>
66 #endif
67 #ifndef O_RDONLY
68 #define O_RDONLY 0
69 #endif
71 #ifdef HAVE_FSEEKO
72 #define file_offset off_t
73 #define file_tell ftello
74 #else
75 #define file_offset long
76 #define file_tell ftell
77 #endif
79 #ifndef USE_CRT_DLL
80 extern int errno;
81 #endif
83 /* hash table read constants */
84 Lisp_Object Qhash_table, Qdata;
85 Lisp_Object Qtest, Qsize;
86 Lisp_Object Qweakness;
87 Lisp_Object Qrehash_size;
88 Lisp_Object Qrehash_threshold;
89 extern Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
91 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
92 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
93 Lisp_Object Qascii_character, Qload, Qload_file_name;
94 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
95 Lisp_Object Qinhibit_file_name_operation;
96 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
97 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
99 /* Used instead of Qget_file_char while loading *.elc files compiled
100 by Emacs 21 or older. */
101 static Lisp_Object Qget_emacs_mule_file_char;
103 static Lisp_Object Qload_force_doc_strings;
105 extern Lisp_Object Qevent_symbol_element_mask;
106 extern Lisp_Object Qfile_exists_p;
108 /* non-zero if inside `load' */
109 int load_in_progress;
110 static Lisp_Object Qload_in_progress;
112 /* Directory in which the sources were found. */
113 Lisp_Object Vsource_directory;
115 /* Search path and suffixes for files to be loaded. */
116 Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes;
118 /* File name of user's init file. */
119 Lisp_Object Vuser_init_file;
121 /* This is the user-visible association list that maps features to
122 lists of defs in their load files. */
123 Lisp_Object Vload_history;
125 /* This is used to build the load history. */
126 Lisp_Object Vcurrent_load_list;
128 /* List of files that were preloaded. */
129 Lisp_Object Vpreloaded_file_list;
131 /* Name of file actually being read by `load'. */
132 Lisp_Object Vload_file_name;
134 /* Function to use for reading, in `load' and friends. */
135 Lisp_Object Vload_read_function;
137 /* Non-nil means read recursive structures using #n= and #n# syntax. */
138 Lisp_Object Vread_circle;
140 /* The association list of objects read with the #n=object form.
141 Each member of the list has the form (n . object), and is used to
142 look up the object for the corresponding #n# construct.
143 It must be set to nil before all top-level calls to read0. */
144 Lisp_Object read_objects;
146 /* Nonzero means load should forcibly load all dynamic doc strings. */
147 static int load_force_doc_strings;
149 /* Nonzero means read should convert strings to unibyte. */
150 static int load_convert_to_unibyte;
152 /* Nonzero means READCHAR should read bytes one by one (not character)
153 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
154 This is set to 1 by read1 temporarily while handling #@NUMBER. */
155 static int load_each_byte;
157 /* Function to use for loading an Emacs Lisp source file (not
158 compiled) instead of readevalloop. */
159 Lisp_Object Vload_source_file_function;
161 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
162 Lisp_Object Vbyte_boolean_vars;
164 /* Whether or not to add a `read-positions' property to symbols
165 read. */
166 Lisp_Object Vread_with_symbol_positions;
168 /* List of (SYMBOL . POSITION) accumulated so far. */
169 Lisp_Object Vread_symbol_positions_list;
171 /* List of descriptors now open for Fload. */
172 static Lisp_Object load_descriptor_list;
174 /* File for get_file_char to read from. Use by load. */
175 static FILE *instream;
177 /* When nonzero, read conses in pure space */
178 static int read_pure;
180 /* For use within read-from-string (this reader is non-reentrant!!) */
181 static int read_from_string_index;
182 static int read_from_string_index_byte;
183 static int read_from_string_limit;
185 /* Number of characters read in the current call to Fread or
186 Fread_from_string. */
187 static int readchar_count;
189 /* This contains the last string skipped with #@. */
190 static char *saved_doc_string;
191 /* Length of buffer allocated in saved_doc_string. */
192 static int saved_doc_string_size;
193 /* Length of actual data in saved_doc_string. */
194 static int saved_doc_string_length;
195 /* This is the file position that string came from. */
196 static file_offset saved_doc_string_position;
198 /* This contains the previous string skipped with #@.
199 We copy it from saved_doc_string when a new string
200 is put in saved_doc_string. */
201 static char *prev_saved_doc_string;
202 /* Length of buffer allocated in prev_saved_doc_string. */
203 static int prev_saved_doc_string_size;
204 /* Length of actual data in prev_saved_doc_string. */
205 static int prev_saved_doc_string_length;
206 /* This is the file position that string came from. */
207 static file_offset prev_saved_doc_string_position;
209 /* Nonzero means inside a new-style backquote
210 with no surrounding parentheses.
211 Fread initializes this to zero, so we need not specbind it
212 or worry about what happens to it when there is an error. */
213 static int new_backquote_flag;
214 static Lisp_Object Vold_style_backquotes, Qold_style_backquotes;
216 /* A list of file names for files being loaded in Fload. Used to
217 check for recursive loads. */
219 static Lisp_Object Vloads_in_progress;
221 /* Non-zero means load dangerous compiled Lisp files. */
223 int load_dangerous_libraries;
225 /* Non-zero means force printing messages when loading Lisp files. */
227 int force_load_messages;
229 /* A regular expression used to detect files compiled with Emacs. */
231 static Lisp_Object Vbytecomp_version_regexp;
233 static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
234 Lisp_Object));
236 static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
237 Lisp_Object (*) (), int,
238 Lisp_Object, Lisp_Object,
239 Lisp_Object, Lisp_Object));
240 static Lisp_Object load_unwind P_ ((Lisp_Object));
241 static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
243 static void invalid_syntax P_ ((const char *, int)) NO_RETURN;
244 static void end_of_file_error P_ (()) NO_RETURN;
247 /* Functions that read one byte from the current source READCHARFUN
248 or unreads one byte. If the integer argument C is -1, it returns
249 one read byte, or -1 when there's no more byte in the source. If C
250 is 0 or positive, it unreads C, and the return value is not
251 interesting. */
253 static int readbyte_for_lambda P_ ((int, Lisp_Object));
254 static int readbyte_from_file P_ ((int, Lisp_Object));
255 static int readbyte_from_string P_ ((int, Lisp_Object));
257 /* Handle unreading and rereading of characters.
258 Write READCHAR to read a character,
259 UNREAD(c) to unread c to be read again.
261 These macros correctly read/unread multibyte characters. */
263 #define READCHAR readchar (readcharfun, NULL)
264 #define UNREAD(c) unreadchar (readcharfun, c)
266 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
267 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
269 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
270 Qlambda, or a cons, we use this to keep an unread character because
271 a file stream can't handle multibyte-char unreading. The value -1
272 means that there's no unread character. */
273 static int unread_char;
275 static int
276 readchar (readcharfun, multibyte)
277 Lisp_Object readcharfun;
278 int *multibyte;
280 Lisp_Object tem;
281 register int c;
282 int (*readbyte) P_ ((int, Lisp_Object));
283 unsigned char buf[MAX_MULTIBYTE_LENGTH];
284 int i, len;
285 int emacs_mule_encoding = 0;
287 if (multibyte)
288 *multibyte = 0;
290 readchar_count++;
292 if (BUFFERP (readcharfun))
294 register struct buffer *inbuffer = XBUFFER (readcharfun);
296 int pt_byte = BUF_PT_BYTE (inbuffer);
298 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
299 return -1;
301 if (! NILP (inbuffer->enable_multibyte_characters))
303 /* Fetch the character code from the buffer. */
304 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
305 BUF_INC_POS (inbuffer, pt_byte);
306 c = STRING_CHAR (p);
307 if (multibyte)
308 *multibyte = 1;
310 else
312 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
313 if (! ASCII_BYTE_P (c))
314 c = BYTE8_TO_CHAR (c);
315 pt_byte++;
317 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
319 return c;
321 if (MARKERP (readcharfun))
323 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
325 int bytepos = marker_byte_position (readcharfun);
327 if (bytepos >= BUF_ZV_BYTE (inbuffer))
328 return -1;
330 if (! NILP (inbuffer->enable_multibyte_characters))
332 /* Fetch the character code from the buffer. */
333 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
334 BUF_INC_POS (inbuffer, bytepos);
335 c = STRING_CHAR (p);
336 if (multibyte)
337 *multibyte = 1;
339 else
341 c = BUF_FETCH_BYTE (inbuffer, bytepos);
342 if (! ASCII_BYTE_P (c))
343 c = BYTE8_TO_CHAR (c);
344 bytepos++;
347 XMARKER (readcharfun)->bytepos = bytepos;
348 XMARKER (readcharfun)->charpos++;
350 return c;
353 if (EQ (readcharfun, Qlambda))
355 readbyte = readbyte_for_lambda;
356 goto read_multibyte;
359 if (EQ (readcharfun, Qget_file_char))
361 readbyte = readbyte_from_file;
362 goto read_multibyte;
365 if (STRINGP (readcharfun))
367 if (read_from_string_index >= read_from_string_limit)
368 c = -1;
369 else if (STRING_MULTIBYTE (readcharfun))
371 if (multibyte)
372 *multibyte = 1;
373 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
374 read_from_string_index,
375 read_from_string_index_byte);
377 else
379 c = SREF (readcharfun, read_from_string_index_byte);
380 read_from_string_index++;
381 read_from_string_index_byte++;
383 return c;
386 if (CONSP (readcharfun))
388 /* This is the case that read_vector is reading from a unibyte
389 string that contains a byte sequence previously skipped
390 because of #@NUMBER. The car part of readcharfun is that
391 string, and the cdr part is a value of readcharfun given to
392 read_vector. */
393 readbyte = readbyte_from_string;
394 if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
395 emacs_mule_encoding = 1;
396 goto read_multibyte;
399 if (EQ (readcharfun, Qget_emacs_mule_file_char))
401 readbyte = readbyte_from_file;
402 emacs_mule_encoding = 1;
403 goto read_multibyte;
406 tem = call0 (readcharfun);
408 if (NILP (tem))
409 return -1;
410 return XINT (tem);
412 read_multibyte:
413 if (unread_char >= 0)
415 c = unread_char;
416 unread_char = -1;
417 return c;
419 c = (*readbyte) (-1, readcharfun);
420 if (c < 0 || load_each_byte)
421 return c;
422 if (multibyte)
423 *multibyte = 1;
424 if (ASCII_BYTE_P (c))
425 return c;
426 if (emacs_mule_encoding)
427 return read_emacs_mule_char (c, readbyte, readcharfun);
428 i = 0;
429 buf[i++] = c;
430 len = BYTES_BY_CHAR_HEAD (c);
431 while (i < len)
433 c = (*readbyte) (-1, readcharfun);
434 if (c < 0 || ! TRAILING_CODE_P (c))
436 while (--i > 1)
437 (*readbyte) (buf[i], readcharfun);
438 return BYTE8_TO_CHAR (buf[0]);
440 buf[i++] = c;
442 return STRING_CHAR (buf);
445 /* Unread the character C in the way appropriate for the stream READCHARFUN.
446 If the stream is a user function, call it with the char as argument. */
448 static void
449 unreadchar (readcharfun, c)
450 Lisp_Object readcharfun;
451 int c;
453 readchar_count--;
454 if (c == -1)
455 /* Don't back up the pointer if we're unreading the end-of-input mark,
456 since readchar didn't advance it when we read it. */
458 else if (BUFFERP (readcharfun))
460 struct buffer *b = XBUFFER (readcharfun);
461 int bytepos = BUF_PT_BYTE (b);
463 BUF_PT (b)--;
464 if (! NILP (b->enable_multibyte_characters))
465 BUF_DEC_POS (b, bytepos);
466 else
467 bytepos--;
469 BUF_PT_BYTE (b) = bytepos;
471 else if (MARKERP (readcharfun))
473 struct buffer *b = XMARKER (readcharfun)->buffer;
474 int bytepos = XMARKER (readcharfun)->bytepos;
476 XMARKER (readcharfun)->charpos--;
477 if (! NILP (b->enable_multibyte_characters))
478 BUF_DEC_POS (b, bytepos);
479 else
480 bytepos--;
482 XMARKER (readcharfun)->bytepos = bytepos;
484 else if (STRINGP (readcharfun))
486 read_from_string_index--;
487 read_from_string_index_byte
488 = string_char_to_byte (readcharfun, read_from_string_index);
490 else if (CONSP (readcharfun))
492 unread_char = c;
494 else if (EQ (readcharfun, Qlambda))
496 unread_char = c;
498 else if (EQ (readcharfun, Qget_file_char)
499 || EQ (readcharfun, Qget_emacs_mule_file_char))
501 if (load_each_byte)
503 BLOCK_INPUT;
504 ungetc (c, instream);
505 UNBLOCK_INPUT;
507 else
508 unread_char = c;
510 else
511 call1 (readcharfun, make_number (c));
514 static int
515 readbyte_for_lambda (c, readcharfun)
516 int c;
517 Lisp_Object readcharfun;
519 return read_bytecode_char (c >= 0);
523 static int
524 readbyte_from_file (c, readcharfun)
525 int c;
526 Lisp_Object readcharfun;
528 if (c >= 0)
530 BLOCK_INPUT;
531 ungetc (c, instream);
532 UNBLOCK_INPUT;
533 return 0;
536 BLOCK_INPUT;
537 c = getc (instream);
539 #ifdef EINTR
540 /* Interrupted reads have been observed while reading over the network */
541 while (c == EOF && ferror (instream) && errno == EINTR)
543 UNBLOCK_INPUT;
544 QUIT;
545 BLOCK_INPUT;
546 clearerr (instream);
547 c = getc (instream);
549 #endif
551 UNBLOCK_INPUT;
553 return (c == EOF ? -1 : c);
556 static int
557 readbyte_from_string (c, readcharfun)
558 int c;
559 Lisp_Object readcharfun;
561 Lisp_Object string = XCAR (readcharfun);
563 if (c >= 0)
565 read_from_string_index--;
566 read_from_string_index_byte
567 = string_char_to_byte (string, read_from_string_index);
570 if (read_from_string_index >= read_from_string_limit)
571 c = -1;
572 else
573 FETCH_STRING_CHAR_ADVANCE (c, string,
574 read_from_string_index,
575 read_from_string_index_byte);
576 return c;
580 /* Read one non-ASCII character from INSTREAM. The character is
581 encoded in `emacs-mule' and the first byte is already read in
582 C. */
584 extern char emacs_mule_bytes[256];
586 static int
587 read_emacs_mule_char (c, readbyte, readcharfun)
588 int c;
589 int (*readbyte) P_ ((int, Lisp_Object));
590 Lisp_Object readcharfun;
592 /* Emacs-mule coding uses at most 4-byte for one character. */
593 unsigned char buf[4];
594 int len = emacs_mule_bytes[c];
595 struct charset *charset;
596 int i;
597 unsigned code;
599 if (len == 1)
600 /* C is not a valid leading-code of `emacs-mule'. */
601 return BYTE8_TO_CHAR (c);
603 i = 0;
604 buf[i++] = c;
605 while (i < len)
607 c = (*readbyte) (-1, readcharfun);
608 if (c < 0xA0)
610 while (--i > 1)
611 (*readbyte) (buf[i], readcharfun);
612 return BYTE8_TO_CHAR (buf[0]);
614 buf[i++] = c;
617 if (len == 2)
619 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
620 code = buf[1] & 0x7F;
622 else if (len == 3)
624 if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
625 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
627 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
628 code = buf[2] & 0x7F;
630 else
632 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
633 code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
636 else
638 charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
639 code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
641 c = DECODE_CHAR (charset, code);
642 if (c < 0)
643 Fsignal (Qinvalid_read_syntax,
644 Fcons (build_string ("invalid multibyte form"), Qnil));
645 return c;
649 static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
650 Lisp_Object));
651 static Lisp_Object read0 P_ ((Lisp_Object));
652 static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
654 static Lisp_Object read_list P_ ((int, Lisp_Object));
655 static Lisp_Object read_vector P_ ((Lisp_Object, int));
657 static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
658 Lisp_Object));
659 static void substitute_object_in_subtree P_ ((Lisp_Object,
660 Lisp_Object));
661 static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
664 /* Get a character from the tty. */
666 /* Read input events until we get one that's acceptable for our purposes.
668 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
669 until we get a character we like, and then stuffed into
670 unread_switch_frame.
672 If ASCII_REQUIRED is non-zero, we check function key events to see
673 if the unmodified version of the symbol has a Qascii_character
674 property, and use that character, if present.
676 If ERROR_NONASCII is non-zero, we signal an error if the input we
677 get isn't an ASCII character with modifiers. If it's zero but
678 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
679 character.
681 If INPUT_METHOD is nonzero, we invoke the current input method
682 if the character warrants that.
684 If SECONDS is a number, we wait that many seconds for input, and
685 return Qnil if no input arrives within that time. */
687 Lisp_Object
688 read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
689 input_method, seconds)
690 int no_switch_frame, ascii_required, error_nonascii, input_method;
691 Lisp_Object seconds;
693 Lisp_Object val, delayed_switch_frame;
694 EMACS_TIME end_time;
696 #ifdef HAVE_WINDOW_SYSTEM
697 if (display_hourglass_p)
698 cancel_hourglass ();
699 #endif
701 delayed_switch_frame = Qnil;
703 /* Compute timeout. */
704 if (NUMBERP (seconds))
706 EMACS_TIME wait_time;
707 int sec, usec;
708 double duration = extract_float (seconds);
710 sec = (int) duration;
711 usec = (duration - sec) * 1000000;
712 EMACS_GET_TIME (end_time);
713 EMACS_SET_SECS_USECS (wait_time, sec, usec);
714 EMACS_ADD_TIME (end_time, end_time, wait_time);
717 /* Read until we get an acceptable event. */
718 retry:
720 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
721 NUMBERP (seconds) ? &end_time : NULL);
722 while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
724 if (BUFFERP (val))
725 goto retry;
727 /* switch-frame events are put off until after the next ASCII
728 character. This is better than signaling an error just because
729 the last characters were typed to a separate minibuffer frame,
730 for example. Eventually, some code which can deal with
731 switch-frame events will read it and process it. */
732 if (no_switch_frame
733 && EVENT_HAS_PARAMETERS (val)
734 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
736 delayed_switch_frame = val;
737 goto retry;
740 if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
742 /* Convert certain symbols to their ASCII equivalents. */
743 if (SYMBOLP (val))
745 Lisp_Object tem, tem1;
746 tem = Fget (val, Qevent_symbol_element_mask);
747 if (!NILP (tem))
749 tem1 = Fget (Fcar (tem), Qascii_character);
750 /* Merge this symbol's modifier bits
751 with the ASCII equivalent of its basic code. */
752 if (!NILP (tem1))
753 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
757 /* If we don't have a character now, deal with it appropriately. */
758 if (!INTEGERP (val))
760 if (error_nonascii)
762 Vunread_command_events = Fcons (val, Qnil);
763 error ("Non-character input-event");
765 else
766 goto retry;
770 if (! NILP (delayed_switch_frame))
771 unread_switch_frame = delayed_switch_frame;
773 #if 0
775 #ifdef HAVE_WINDOW_SYSTEM
776 if (display_hourglass_p)
777 start_hourglass ();
778 #endif
780 #endif
782 return val;
785 DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
786 doc: /* Read a character from the command input (keyboard or macro).
787 It is returned as a number.
788 If the character has modifiers, they are resolved and reflected to the
789 character code if possible (e.g. C-SPC -> 0).
791 If the user generates an event which is not a character (i.e. a mouse
792 click or function key event), `read-char' signals an error. As an
793 exception, switch-frame events are put off until non-character events
794 can be read.
795 If you want to read non-character events, or ignore them, call
796 `read-event' or `read-char-exclusive' instead.
798 If the optional argument PROMPT is non-nil, display that as a prompt.
799 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
800 input method is turned on in the current buffer, that input method
801 is used for reading a character.
802 If the optional argument SECONDS is non-nil, it should be a number
803 specifying the maximum number of seconds to wait for input. If no
804 input arrives in that time, return nil. SECONDS may be a
805 floating-point value. */)
806 (prompt, inherit_input_method, seconds)
807 Lisp_Object prompt, inherit_input_method, seconds;
809 Lisp_Object val;
811 if (! NILP (prompt))
812 message_with_string ("%s", prompt, 0);
813 val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
815 return (NILP (val) ? Qnil
816 : make_number (char_resolve_modifier_mask (XINT (val))));
819 DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
820 doc: /* Read an event object from the input stream.
821 If the optional argument PROMPT is non-nil, display that as a prompt.
822 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
823 input method is turned on in the current buffer, that input method
824 is used for reading a character.
825 If the optional argument SECONDS is non-nil, it should be a number
826 specifying the maximum number of seconds to wait for input. If no
827 input arrives in that time, return nil. SECONDS may be a
828 floating-point value. */)
829 (prompt, inherit_input_method, seconds)
830 Lisp_Object prompt, inherit_input_method, seconds;
832 if (! NILP (prompt))
833 message_with_string ("%s", prompt, 0);
834 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
837 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
838 doc: /* Read a character from the command input (keyboard or macro).
839 It is returned as a number. Non-character events are ignored.
840 If the character has modifiers, they are resolved and reflected to the
841 character code if possible (e.g. C-SPC -> 0).
843 If the optional argument PROMPT is non-nil, display that as a prompt.
844 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
845 input method is turned on in the current buffer, that input method
846 is used for reading a character.
847 If the optional argument SECONDS is non-nil, it should be a number
848 specifying the maximum number of seconds to wait for input. If no
849 input arrives in that time, return nil. SECONDS may be a
850 floating-point value. */)
851 (prompt, inherit_input_method, seconds)
852 Lisp_Object prompt, inherit_input_method, seconds;
854 Lisp_Object val;
856 if (! NILP (prompt))
857 message_with_string ("%s", prompt, 0);
859 val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
861 return (NILP (val) ? Qnil
862 : make_number (char_resolve_modifier_mask (XINT (val))));
865 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
866 doc: /* Don't use this yourself. */)
869 register Lisp_Object val;
870 BLOCK_INPUT;
871 XSETINT (val, getc (instream));
872 UNBLOCK_INPUT;
873 return val;
878 /* Value is a version number of byte compiled code if the file
879 associated with file descriptor FD is a compiled Lisp file that's
880 safe to load. Only files compiled with Emacs are safe to load.
881 Files compiled with XEmacs can lead to a crash in Fbyte_code
882 because of an incompatible change in the byte compiler. */
884 static int
885 safe_to_load_p (fd)
886 int fd;
888 char buf[512];
889 int nbytes, i;
890 int safe_p = 1;
891 int version = 1;
893 /* Read the first few bytes from the file, and look for a line
894 specifying the byte compiler version used. */
895 nbytes = emacs_read (fd, buf, sizeof buf - 1);
896 if (nbytes > 0)
898 buf[nbytes] = '\0';
900 /* Skip to the next newline, skipping over the initial `ELC'
901 with NUL bytes following it, but note the version. */
902 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
903 if (i == 4)
904 version = buf[i];
906 if (i == nbytes
907 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
908 buf + i) < 0)
909 safe_p = 0;
911 if (safe_p)
912 safe_p = version;
914 lseek (fd, 0, SEEK_SET);
915 return safe_p;
919 /* Callback for record_unwind_protect. Restore the old load list OLD,
920 after loading a file successfully. */
922 static Lisp_Object
923 record_load_unwind (old)
924 Lisp_Object old;
926 return Vloads_in_progress = old;
929 /* This handler function is used via internal_condition_case_1. */
931 static Lisp_Object
932 load_error_handler (data)
933 Lisp_Object data;
935 return Qnil;
938 static Lisp_Object
939 load_warn_old_style_backquotes (file)
940 Lisp_Object file;
942 if (!NILP (Vold_style_backquotes))
944 Lisp_Object args[2];
945 args[0] = build_string ("Loading `%s': old-style backquotes detected!");
946 args[1] = file;
947 Fmessage (2, args);
949 return Qnil;
952 DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
953 doc: /* Return the suffixes that `load' should try if a suffix is \
954 required.
955 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
958 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
959 while (CONSP (suffixes))
961 Lisp_Object exts = Vload_file_rep_suffixes;
962 suffix = XCAR (suffixes);
963 suffixes = XCDR (suffixes);
964 while (CONSP (exts))
966 ext = XCAR (exts);
967 exts = XCDR (exts);
968 lst = Fcons (concat2 (suffix, ext), lst);
971 return Fnreverse (lst);
974 DEFUN ("load", Fload, Sload, 1, 5, 0,
975 doc: /* Execute a file of Lisp code named FILE.
976 First try FILE with `.elc' appended, then try with `.el',
977 then try FILE unmodified (the exact suffixes in the exact order are
978 determined by `load-suffixes'). Environment variable references in
979 FILE are replaced with their values by calling `substitute-in-file-name'.
980 This function searches the directories in `load-path'.
982 If optional second arg NOERROR is non-nil,
983 report no error if FILE doesn't exist.
984 Print messages at start and end of loading unless
985 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
986 overrides that).
987 If optional fourth arg NOSUFFIX is non-nil, don't try adding
988 suffixes `.elc' or `.el' to the specified name FILE.
989 If optional fifth arg MUST-SUFFIX is non-nil, insist on
990 the suffix `.elc' or `.el'; don't accept just FILE unless
991 it ends in one of those suffixes or includes a directory name.
993 If this function fails to find a file, it may look for different
994 representations of that file before trying another file.
995 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
996 to the file name. Emacs uses this feature mainly to find compressed
997 versions of files when Auto Compression mode is enabled.
999 The exact suffixes that this function tries out, in the exact order,
1000 are given by the value of the variable `load-file-rep-suffixes' if
1001 NOSUFFIX is non-nil and by the return value of the function
1002 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1003 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1004 and then the former.
1006 Loading a file records its definitions, and its `provide' and
1007 `require' calls, in an element of `load-history' whose
1008 car is the file name loaded. See `load-history'.
1010 While the file is in the process of being loaded, the variable
1011 `load-in-progress' is non-nil and the variable `load-file-name'
1012 is bound to the file's name.
1014 Return t if the file exists and loads successfully. */)
1015 (file, noerror, nomessage, nosuffix, must_suffix)
1016 Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
1018 register FILE *stream;
1019 register int fd = -1;
1020 int count = SPECPDL_INDEX ();
1021 struct gcpro gcpro1, gcpro2, gcpro3;
1022 Lisp_Object found, efound, hist_file_name;
1023 /* 1 means we printed the ".el is newer" message. */
1024 int newer = 0;
1025 /* 1 means we are loading a compiled file. */
1026 int compiled = 0;
1027 Lisp_Object handler;
1028 int safe_p = 1;
1029 char *fmode = "r";
1030 Lisp_Object tmp[2];
1031 int version;
1033 #ifdef DOS_NT
1034 fmode = "rt";
1035 #endif /* DOS_NT */
1037 CHECK_STRING (file);
1039 /* If file name is magic, call the handler. */
1040 /* This shouldn't be necessary any more now that `openp' handles it right.
1041 handler = Ffind_file_name_handler (file, Qload);
1042 if (!NILP (handler))
1043 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1045 /* Do this after the handler to avoid
1046 the need to gcpro noerror, nomessage and nosuffix.
1047 (Below here, we care only whether they are nil or not.)
1048 The presence of this call is the result of a historical accident:
1049 it used to be in every file-operation and when it got removed
1050 everywhere, it accidentally stayed here. Since then, enough people
1051 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1052 that it seemed risky to remove. */
1053 if (! NILP (noerror))
1055 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
1056 Qt, load_error_handler);
1057 if (NILP (file))
1058 return Qnil;
1060 else
1061 file = Fsubstitute_in_file_name (file);
1064 /* Avoid weird lossage with null string as arg,
1065 since it would try to load a directory as a Lisp file */
1066 if (SCHARS (file) > 0)
1068 int size = SBYTES (file);
1070 found = Qnil;
1071 GCPRO2 (file, found);
1073 if (! NILP (must_suffix))
1075 /* Don't insist on adding a suffix if FILE already ends with one. */
1076 if (size > 3
1077 && !strcmp (SDATA (file) + size - 3, ".el"))
1078 must_suffix = Qnil;
1079 else if (size > 4
1080 && !strcmp (SDATA (file) + size - 4, ".elc"))
1081 must_suffix = Qnil;
1082 /* Don't insist on adding a suffix
1083 if the argument includes a directory name. */
1084 else if (! NILP (Ffile_name_directory (file)))
1085 must_suffix = Qnil;
1088 fd = openp (Vload_path, file,
1089 (!NILP (nosuffix) ? Qnil
1090 : !NILP (must_suffix) ? Fget_load_suffixes ()
1091 : Fappend (2, (tmp[0] = Fget_load_suffixes (),
1092 tmp[1] = Vload_file_rep_suffixes,
1093 tmp))),
1094 &found, Qnil);
1095 UNGCPRO;
1098 if (fd == -1)
1100 if (NILP (noerror))
1101 xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
1102 return Qnil;
1105 /* Tell startup.el whether or not we found the user's init file. */
1106 if (EQ (Qt, Vuser_init_file))
1107 Vuser_init_file = found;
1109 /* If FD is -2, that means openp found a magic file. */
1110 if (fd == -2)
1112 if (NILP (Fequal (found, file)))
1113 /* If FOUND is a different file name from FILE,
1114 find its handler even if we have already inhibited
1115 the `load' operation on FILE. */
1116 handler = Ffind_file_name_handler (found, Qt);
1117 else
1118 handler = Ffind_file_name_handler (found, Qload);
1119 if (! NILP (handler))
1120 return call5 (handler, Qload, found, noerror, nomessage, Qt);
1123 /* Check if we're stuck in a recursive load cycle.
1125 2000-09-21: It's not possible to just check for the file loaded
1126 being a member of Vloads_in_progress. This fails because of the
1127 way the byte compiler currently works; `provide's are not
1128 evaluated, see font-lock.el/jit-lock.el as an example. This
1129 leads to a certain amount of ``normal'' recursion.
1131 Also, just loading a file recursively is not always an error in
1132 the general case; the second load may do something different. */
1134 int count = 0;
1135 Lisp_Object tem;
1136 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
1137 if (!NILP (Fequal (found, XCAR (tem))) && (++count > 3))
1139 if (fd >= 0)
1140 emacs_close (fd);
1141 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
1143 record_unwind_protect (record_load_unwind, Vloads_in_progress);
1144 Vloads_in_progress = Fcons (found, Vloads_in_progress);
1147 /* Get the name for load-history. */
1148 hist_file_name = (! NILP (Vpurify_flag)
1149 ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
1150 tmp[1] = Ffile_name_nondirectory (found),
1151 tmp))
1152 : found) ;
1154 version = -1;
1156 /* Check for the presence of old-style quotes and warn about them. */
1157 specbind (Qold_style_backquotes, Qnil);
1158 record_unwind_protect (load_warn_old_style_backquotes, file);
1160 if (!bcmp (SDATA (found) + SBYTES (found) - 4,
1161 ".elc", 4)
1162 || (fd >= 0 && (version = safe_to_load_p (fd)) > 0))
1163 /* Load .elc files directly, but not when they are
1164 remote and have no handler! */
1166 if (fd != -2)
1168 struct stat s1, s2;
1169 int result;
1171 GCPRO3 (file, found, hist_file_name);
1173 if (version < 0
1174 && ! (version = safe_to_load_p (fd)))
1176 safe_p = 0;
1177 if (!load_dangerous_libraries)
1179 if (fd >= 0)
1180 emacs_close (fd);
1181 error ("File `%s' was not compiled in Emacs",
1182 SDATA (found));
1184 else if (!NILP (nomessage) && !force_load_messages)
1185 message_with_string ("File `%s' not compiled in Emacs", found, 1);
1188 compiled = 1;
1190 efound = ENCODE_FILE (found);
1192 #ifdef DOS_NT
1193 fmode = "rb";
1194 #endif /* DOS_NT */
1195 stat ((char *)SDATA (efound), &s1);
1196 SSET (efound, SBYTES (efound) - 1, 0);
1197 result = stat ((char *)SDATA (efound), &s2);
1198 SSET (efound, SBYTES (efound) - 1, 'c');
1200 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1202 /* Make the progress messages mention that source is newer. */
1203 newer = 1;
1205 /* If we won't print another message, mention this anyway. */
1206 if (!NILP (nomessage) && !force_load_messages)
1208 Lisp_Object msg_file;
1209 msg_file = Fsubstring (found, make_number (0), make_number (-1));
1210 message_with_string ("Source file `%s' newer than byte-compiled file",
1211 msg_file, 1);
1214 UNGCPRO;
1217 else
1219 /* We are loading a source file (*.el). */
1220 if (!NILP (Vload_source_file_function))
1222 Lisp_Object val;
1224 if (fd >= 0)
1225 emacs_close (fd);
1226 val = call4 (Vload_source_file_function, found, hist_file_name,
1227 NILP (noerror) ? Qnil : Qt,
1228 (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
1229 return unbind_to (count, val);
1233 GCPRO3 (file, found, hist_file_name);
1235 #ifdef WINDOWSNT
1236 emacs_close (fd);
1237 efound = ENCODE_FILE (found);
1238 stream = fopen ((char *) SDATA (efound), fmode);
1239 #else /* not WINDOWSNT */
1240 stream = fdopen (fd, fmode);
1241 #endif /* not WINDOWSNT */
1242 if (stream == 0)
1244 emacs_close (fd);
1245 error ("Failure to create stdio stream for %s", SDATA (file));
1248 if (! NILP (Vpurify_flag))
1249 Vpreloaded_file_list = Fcons (Fpurecopy(file), Vpreloaded_file_list);
1251 if (NILP (nomessage) || force_load_messages)
1253 if (!safe_p)
1254 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1255 file, 1);
1256 else if (!compiled)
1257 message_with_string ("Loading %s (source)...", file, 1);
1258 else if (newer)
1259 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1260 file, 1);
1261 else /* The typical case; compiled file newer than source file. */
1262 message_with_string ("Loading %s...", file, 1);
1265 record_unwind_protect (load_unwind, make_save_value (stream, 0));
1266 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
1267 specbind (Qload_file_name, found);
1268 specbind (Qinhibit_file_name_operation, Qnil);
1269 load_descriptor_list
1270 = Fcons (make_number (fileno (stream)), load_descriptor_list);
1271 specbind (Qload_in_progress, Qt);
1272 if (! version || version >= 22)
1273 readevalloop (Qget_file_char, stream, hist_file_name,
1274 Feval, 0, Qnil, Qnil, Qnil, Qnil);
1275 else
1277 /* We can't handle a file which was compiled with
1278 byte-compile-dynamic by older version of Emacs. */
1279 specbind (Qload_force_doc_strings, Qt);
1280 readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
1281 0, Qnil, Qnil, Qnil, Qnil);
1283 unbind_to (count, Qnil);
1285 /* Run any eval-after-load forms for this file */
1286 if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
1287 call1 (Qdo_after_load_evaluation, hist_file_name) ;
1289 UNGCPRO;
1291 xfree (saved_doc_string);
1292 saved_doc_string = 0;
1293 saved_doc_string_size = 0;
1295 xfree (prev_saved_doc_string);
1296 prev_saved_doc_string = 0;
1297 prev_saved_doc_string_size = 0;
1299 if (!noninteractive && (NILP (nomessage) || force_load_messages))
1301 if (!safe_p)
1302 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1303 file, 1);
1304 else if (!compiled)
1305 message_with_string ("Loading %s (source)...done", file, 1);
1306 else if (newer)
1307 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1308 file, 1);
1309 else /* The typical case; compiled file newer than source file. */
1310 message_with_string ("Loading %s...done", file, 1);
1313 return Qt;
1316 static Lisp_Object
1317 load_unwind (arg) /* used as unwind-protect function in load */
1318 Lisp_Object arg;
1320 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
1321 if (stream != NULL)
1323 BLOCK_INPUT;
1324 fclose (stream);
1325 UNBLOCK_INPUT;
1327 return Qnil;
1330 static Lisp_Object
1331 load_descriptor_unwind (oldlist)
1332 Lisp_Object oldlist;
1334 load_descriptor_list = oldlist;
1335 return Qnil;
1338 /* Close all descriptors in use for Floads.
1339 This is used when starting a subprocess. */
1341 void
1342 close_load_descs ()
1344 #ifndef WINDOWSNT
1345 Lisp_Object tail;
1346 for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
1347 emacs_close (XFASTINT (XCAR (tail)));
1348 #endif
1351 static int
1352 complete_filename_p (pathname)
1353 Lisp_Object pathname;
1355 register const unsigned char *s = SDATA (pathname);
1356 return (IS_DIRECTORY_SEP (s[0])
1357 || (SCHARS (pathname) > 2
1358 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
1361 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1362 doc: /* Search for FILENAME through PATH.
1363 Returns the file's name in absolute form, or nil if not found.
1364 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1365 file name when searching.
1366 If non-nil, PREDICATE is used instead of `file-readable-p'.
1367 PREDICATE can also be an integer to pass to the access(2) function,
1368 in which case file-name-handlers are ignored. */)
1369 (filename, path, suffixes, predicate)
1370 Lisp_Object filename, path, suffixes, predicate;
1372 Lisp_Object file;
1373 int fd = openp (path, filename, suffixes, &file, predicate);
1374 if (NILP (predicate) && fd > 0)
1375 close (fd);
1376 return file;
1380 /* Search for a file whose name is STR, looking in directories
1381 in the Lisp list PATH, and trying suffixes from SUFFIX.
1382 On success, returns a file descriptor. On failure, returns -1.
1384 SUFFIXES is a list of strings containing possible suffixes.
1385 The empty suffix is automatically added if the list is empty.
1387 PREDICATE non-nil means don't open the files,
1388 just look for one that satisfies the predicate. In this case,
1389 returns 1 on success. The predicate can be a lisp function or
1390 an integer to pass to `access' (in which case file-name-handlers
1391 are ignored).
1393 If STOREPTR is nonzero, it points to a slot where the name of
1394 the file actually found should be stored as a Lisp string.
1395 nil is stored there on failure.
1397 If the file we find is remote, return -2
1398 but store the found remote file name in *STOREPTR. */
1401 openp (path, str, suffixes, storeptr, predicate)
1402 Lisp_Object path, str;
1403 Lisp_Object suffixes;
1404 Lisp_Object *storeptr;
1405 Lisp_Object predicate;
1407 register int fd;
1408 int fn_size = 100;
1409 char buf[100];
1410 register char *fn = buf;
1411 int absolute = 0;
1412 int want_size;
1413 Lisp_Object filename;
1414 struct stat st;
1415 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1416 Lisp_Object string, tail, encoded_fn;
1417 int max_suffix_len = 0;
1419 CHECK_STRING (str);
1421 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1423 CHECK_STRING_CAR (tail);
1424 max_suffix_len = max (max_suffix_len,
1425 SBYTES (XCAR (tail)));
1428 string = filename = encoded_fn = Qnil;
1429 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1431 if (storeptr)
1432 *storeptr = Qnil;
1434 if (complete_filename_p (str))
1435 absolute = 1;
1437 for (; CONSP (path); path = XCDR (path))
1439 filename = Fexpand_file_name (str, XCAR (path));
1440 if (!complete_filename_p (filename))
1441 /* If there are non-absolute elts in PATH (eg ".") */
1442 /* Of course, this could conceivably lose if luser sets
1443 default-directory to be something non-absolute... */
1445 filename = Fexpand_file_name (filename, current_buffer->directory);
1446 if (!complete_filename_p (filename))
1447 /* Give up on this path element! */
1448 continue;
1451 /* Calculate maximum size of any filename made from
1452 this path element/specified file name and any possible suffix. */
1453 want_size = max_suffix_len + SBYTES (filename) + 1;
1454 if (fn_size < want_size)
1455 fn = (char *) alloca (fn_size = 100 + want_size);
1457 /* Loop over suffixes. */
1458 for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
1459 CONSP (tail); tail = XCDR (tail))
1461 int lsuffix = SBYTES (XCAR (tail));
1462 Lisp_Object handler;
1463 int exists;
1465 /* Concatenate path element/specified name with the suffix.
1466 If the directory starts with /:, remove that. */
1467 if (SCHARS (filename) > 2
1468 && SREF (filename, 0) == '/'
1469 && SREF (filename, 1) == ':')
1471 strncpy (fn, SDATA (filename) + 2,
1472 SBYTES (filename) - 2);
1473 fn[SBYTES (filename) - 2] = 0;
1475 else
1477 strncpy (fn, SDATA (filename),
1478 SBYTES (filename));
1479 fn[SBYTES (filename)] = 0;
1482 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
1483 strncat (fn, SDATA (XCAR (tail)), lsuffix);
1485 /* Check that the file exists and is not a directory. */
1486 /* We used to only check for handlers on non-absolute file names:
1487 if (absolute)
1488 handler = Qnil;
1489 else
1490 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1491 It's not clear why that was the case and it breaks things like
1492 (load "/bar.el") where the file is actually "/bar.el.gz". */
1493 string = build_string (fn);
1494 handler = Ffind_file_name_handler (string, Qfile_exists_p);
1495 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1497 if (NILP (predicate))
1498 exists = !NILP (Ffile_readable_p (string));
1499 else
1500 exists = !NILP (call1 (predicate, string));
1501 if (exists && !NILP (Ffile_directory_p (string)))
1502 exists = 0;
1504 if (exists)
1506 /* We succeeded; return this descriptor and filename. */
1507 if (storeptr)
1508 *storeptr = string;
1509 UNGCPRO;
1510 return -2;
1513 else
1515 const char *pfn;
1517 encoded_fn = ENCODE_FILE (string);
1518 pfn = SDATA (encoded_fn);
1519 exists = (stat (pfn, &st) >= 0
1520 && (st.st_mode & S_IFMT) != S_IFDIR);
1521 if (exists)
1523 /* Check that we can access or open it. */
1524 if (NATNUMP (predicate))
1525 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
1526 else
1527 fd = emacs_open (pfn, O_RDONLY, 0);
1529 if (fd >= 0)
1531 /* We succeeded; return this descriptor and filename. */
1532 if (storeptr)
1533 *storeptr = string;
1534 UNGCPRO;
1535 return fd;
1540 if (absolute)
1541 break;
1544 UNGCPRO;
1545 return -1;
1549 /* Merge the list we've accumulated of globals from the current input source
1550 into the load_history variable. The details depend on whether
1551 the source has an associated file name or not.
1553 FILENAME is the file name that we are loading from.
1554 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1556 static void
1557 build_load_history (filename, entire)
1558 Lisp_Object filename;
1559 int entire;
1561 register Lisp_Object tail, prev, newelt;
1562 register Lisp_Object tem, tem2;
1563 register int foundit = 0;
1565 tail = Vload_history;
1566 prev = Qnil;
1568 while (CONSP (tail))
1570 tem = XCAR (tail);
1572 /* Find the feature's previous assoc list... */
1573 if (!NILP (Fequal (filename, Fcar (tem))))
1575 foundit = 1;
1577 /* If we're loading the entire file, remove old data. */
1578 if (entire)
1580 if (NILP (prev))
1581 Vload_history = XCDR (tail);
1582 else
1583 Fsetcdr (prev, XCDR (tail));
1586 /* Otherwise, cons on new symbols that are not already members. */
1587 else
1589 tem2 = Vcurrent_load_list;
1591 while (CONSP (tem2))
1593 newelt = XCAR (tem2);
1595 if (NILP (Fmember (newelt, tem)))
1596 Fsetcar (tail, Fcons (XCAR (tem),
1597 Fcons (newelt, XCDR (tem))));
1599 tem2 = XCDR (tem2);
1600 QUIT;
1604 else
1605 prev = tail;
1606 tail = XCDR (tail);
1607 QUIT;
1610 /* If we're loading an entire file, cons the new assoc onto the
1611 front of load-history, the most-recently-loaded position. Also
1612 do this if we didn't find an existing member for the file. */
1613 if (entire || !foundit)
1614 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1615 Vload_history);
1618 Lisp_Object
1619 unreadpure (junk) /* Used as unwind-protect function in readevalloop */
1620 Lisp_Object junk;
1622 read_pure = 0;
1623 return Qnil;
1626 static Lisp_Object
1627 readevalloop_1 (old)
1628 Lisp_Object old;
1630 load_convert_to_unibyte = ! NILP (old);
1631 return Qnil;
1634 /* Signal an `end-of-file' error, if possible with file name
1635 information. */
1637 static void
1638 end_of_file_error ()
1640 if (STRINGP (Vload_file_name))
1641 xsignal1 (Qend_of_file, Vload_file_name);
1643 xsignal0 (Qend_of_file);
1646 /* UNIBYTE specifies how to set load_convert_to_unibyte
1647 for this invocation.
1648 READFUN, if non-nil, is used instead of `read'.
1650 START, END specify region to read in current buffer (from eval-region).
1651 If the input is not from a buffer, they must be nil. */
1653 static void
1654 readevalloop (readcharfun, stream, sourcename, evalfun,
1655 printflag, unibyte, readfun, start, end)
1656 Lisp_Object readcharfun;
1657 FILE *stream;
1658 Lisp_Object sourcename;
1659 Lisp_Object (*evalfun) ();
1660 int printflag;
1661 Lisp_Object unibyte, readfun;
1662 Lisp_Object start, end;
1664 register int c;
1665 register Lisp_Object val;
1666 int count = SPECPDL_INDEX ();
1667 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1668 struct buffer *b = 0;
1669 int continue_reading_p;
1670 /* Nonzero if reading an entire buffer. */
1671 int whole_buffer = 0;
1672 /* 1 on the first time around. */
1673 int first_sexp = 1;
1675 if (MARKERP (readcharfun))
1677 if (NILP (start))
1678 start = readcharfun;
1681 if (BUFFERP (readcharfun))
1682 b = XBUFFER (readcharfun);
1683 else if (MARKERP (readcharfun))
1684 b = XMARKER (readcharfun)->buffer;
1686 /* We assume START is nil when input is not from a buffer. */
1687 if (! NILP (start) && !b)
1688 abort ();
1690 specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
1691 specbind (Qcurrent_load_list, Qnil);
1692 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1693 load_convert_to_unibyte = !NILP (unibyte);
1695 GCPRO4 (sourcename, readfun, start, end);
1697 /* Try to ensure sourcename is a truename, except whilst preloading. */
1698 if (NILP (Vpurify_flag)
1699 && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
1700 && !NILP (Ffboundp (Qfile_truename)))
1701 sourcename = call1 (Qfile_truename, sourcename) ;
1703 LOADHIST_ATTACH (sourcename);
1705 continue_reading_p = 1;
1706 while (continue_reading_p)
1708 int count1 = SPECPDL_INDEX ();
1710 if (b != 0 && NILP (b->name))
1711 error ("Reading from killed buffer");
1713 if (!NILP (start))
1715 /* Switch to the buffer we are reading from. */
1716 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1717 set_buffer_internal (b);
1719 /* Save point in it. */
1720 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1721 /* Save ZV in it. */
1722 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1723 /* Those get unbound after we read one expression. */
1725 /* Set point and ZV around stuff to be read. */
1726 Fgoto_char (start);
1727 if (!NILP (end))
1728 Fnarrow_to_region (make_number (BEGV), end);
1730 /* Just for cleanliness, convert END to a marker
1731 if it is an integer. */
1732 if (INTEGERP (end))
1733 end = Fpoint_max_marker ();
1736 /* On the first cycle, we can easily test here
1737 whether we are reading the whole buffer. */
1738 if (b && first_sexp)
1739 whole_buffer = (PT == BEG && ZV == Z);
1741 instream = stream;
1742 read_next:
1743 c = READCHAR;
1744 if (c == ';')
1746 while ((c = READCHAR) != '\n' && c != -1);
1747 goto read_next;
1749 if (c < 0)
1751 unbind_to (count1, Qnil);
1752 break;
1755 /* Ignore whitespace here, so we can detect eof. */
1756 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
1757 || c == 0x8a0) /* NBSP */
1758 goto read_next;
1760 if (!NILP (Vpurify_flag) && c == '(')
1762 record_unwind_protect (unreadpure, Qnil);
1763 val = read_list (-1, readcharfun);
1765 else
1767 UNREAD (c);
1768 read_objects = Qnil;
1769 if (!NILP (readfun))
1771 val = call1 (readfun, readcharfun);
1773 /* If READCHARFUN has set point to ZV, we should
1774 stop reading, even if the form read sets point
1775 to a different value when evaluated. */
1776 if (BUFFERP (readcharfun))
1778 struct buffer *b = XBUFFER (readcharfun);
1779 if (BUF_PT (b) == BUF_ZV (b))
1780 continue_reading_p = 0;
1783 else if (! NILP (Vload_read_function))
1784 val = call1 (Vload_read_function, readcharfun);
1785 else
1786 val = read_internal_start (readcharfun, Qnil, Qnil);
1789 if (!NILP (start) && continue_reading_p)
1790 start = Fpoint_marker ();
1792 /* Restore saved point and BEGV. */
1793 unbind_to (count1, Qnil);
1795 /* Now eval what we just read. */
1796 val = (*evalfun) (val);
1798 if (printflag)
1800 Vvalues = Fcons (val, Vvalues);
1801 if (EQ (Vstandard_output, Qt))
1802 Fprin1 (val, Qnil);
1803 else
1804 Fprint (val, Qnil);
1807 first_sexp = 0;
1810 build_load_history (sourcename,
1811 stream || whole_buffer);
1813 UNGCPRO;
1815 unbind_to (count, Qnil);
1818 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
1819 doc: /* Execute the current buffer as Lisp code.
1820 When called from a Lisp program (i.e., not interactively), this
1821 function accepts up to five optional arguments:
1822 BUFFER is the buffer to evaluate (nil means use current buffer).
1823 PRINTFLAG controls printing of output:
1824 A value of nil means discard it; anything else is stream for print.
1825 FILENAME specifies the file name to use for `load-history'.
1826 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1827 invocation.
1828 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1829 functions should work normally even if PRINTFLAG is nil.
1831 This function preserves the position of point. */)
1832 (buffer, printflag, filename, unibyte, do_allow_print)
1833 Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
1835 int count = SPECPDL_INDEX ();
1836 Lisp_Object tem, buf;
1838 if (NILP (buffer))
1839 buf = Fcurrent_buffer ();
1840 else
1841 buf = Fget_buffer (buffer);
1842 if (NILP (buf))
1843 error ("No such buffer");
1845 if (NILP (printflag) && NILP (do_allow_print))
1846 tem = Qsymbolp;
1847 else
1848 tem = printflag;
1850 if (NILP (filename))
1851 filename = XBUFFER (buf)->filename;
1853 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
1854 specbind (Qstandard_output, tem);
1855 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1856 BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1857 readevalloop (buf, 0, filename, Feval,
1858 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
1859 unbind_to (count, Qnil);
1861 return Qnil;
1864 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
1865 doc: /* Execute the region as Lisp code.
1866 When called from programs, expects two arguments,
1867 giving starting and ending indices in the current buffer
1868 of the text to be executed.
1869 Programs can pass third argument PRINTFLAG which controls output:
1870 A value of nil means discard it; anything else is stream for printing it.
1871 Also the fourth argument READ-FUNCTION, if non-nil, is used
1872 instead of `read' to read each expression. It gets one argument
1873 which is the input stream for reading characters.
1875 This function does not move point. */)
1876 (start, end, printflag, read_function)
1877 Lisp_Object start, end, printflag, read_function;
1879 int count = SPECPDL_INDEX ();
1880 Lisp_Object tem, cbuf;
1882 cbuf = Fcurrent_buffer ();
1884 if (NILP (printflag))
1885 tem = Qsymbolp;
1886 else
1887 tem = printflag;
1888 specbind (Qstandard_output, tem);
1889 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
1891 /* readevalloop calls functions which check the type of start and end. */
1892 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
1893 !NILP (printflag), Qnil, read_function,
1894 start, end);
1896 return unbind_to (count, Qnil);
1900 DEFUN ("read", Fread, Sread, 0, 1, 0,
1901 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1902 If STREAM is nil, use the value of `standard-input' (which see).
1903 STREAM or the value of `standard-input' may be:
1904 a buffer (read from point and advance it)
1905 a marker (read from where it points and advance it)
1906 a function (call it with no arguments for each character,
1907 call it with a char as argument to push a char back)
1908 a string (takes text from string, starting at the beginning)
1909 t (read text line using minibuffer and use it, or read from
1910 standard input in batch mode). */)
1911 (stream)
1912 Lisp_Object stream;
1914 if (NILP (stream))
1915 stream = Vstandard_input;
1916 if (EQ (stream, Qt))
1917 stream = Qread_char;
1918 if (EQ (stream, Qread_char))
1919 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
1921 return read_internal_start (stream, Qnil, Qnil);
1924 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
1925 doc: /* Read one Lisp expression which is represented as text by STRING.
1926 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1927 START and END optionally delimit a substring of STRING from which to read;
1928 they default to 0 and (length STRING) respectively. */)
1929 (string, start, end)
1930 Lisp_Object string, start, end;
1932 Lisp_Object ret;
1933 CHECK_STRING (string);
1934 /* read_internal_start sets read_from_string_index. */
1935 ret = read_internal_start (string, start, end);
1936 return Fcons (ret, make_number (read_from_string_index));
1939 /* Function to set up the global context we need in toplevel read
1940 calls. */
1941 static Lisp_Object
1942 read_internal_start (stream, start, end)
1943 Lisp_Object stream;
1944 Lisp_Object start; /* Only used when stream is a string. */
1945 Lisp_Object end; /* Only used when stream is a string. */
1947 Lisp_Object retval;
1949 readchar_count = 0;
1950 new_backquote_flag = 0;
1951 read_objects = Qnil;
1952 if (EQ (Vread_with_symbol_positions, Qt)
1953 || EQ (Vread_with_symbol_positions, stream))
1954 Vread_symbol_positions_list = Qnil;
1956 if (STRINGP (stream)
1957 || ((CONSP (stream) && STRINGP (XCAR (stream)))))
1959 int startval, endval;
1960 Lisp_Object string;
1962 if (STRINGP (stream))
1963 string = stream;
1964 else
1965 string = XCAR (stream);
1967 if (NILP (end))
1968 endval = SCHARS (string);
1969 else
1971 CHECK_NUMBER (end);
1972 endval = XINT (end);
1973 if (endval < 0 || endval > SCHARS (string))
1974 args_out_of_range (string, end);
1977 if (NILP (start))
1978 startval = 0;
1979 else
1981 CHECK_NUMBER (start);
1982 startval = XINT (start);
1983 if (startval < 0 || startval > endval)
1984 args_out_of_range (string, start);
1986 read_from_string_index = startval;
1987 read_from_string_index_byte = string_char_to_byte (string, startval);
1988 read_from_string_limit = endval;
1991 retval = read0 (stream);
1992 if (EQ (Vread_with_symbol_positions, Qt)
1993 || EQ (Vread_with_symbol_positions, stream))
1994 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
1995 return retval;
1999 /* Signal Qinvalid_read_syntax error.
2000 S is error string of length N (if > 0) */
2002 static void
2003 invalid_syntax (s, n)
2004 const char *s;
2005 int n;
2007 if (!n)
2008 n = strlen (s);
2009 xsignal1 (Qinvalid_read_syntax, make_string (s, n));
2013 /* Use this for recursive reads, in contexts where internal tokens
2014 are not allowed. */
2016 static Lisp_Object
2017 read0 (readcharfun)
2018 Lisp_Object readcharfun;
2020 register Lisp_Object val;
2021 int c;
2023 val = read1 (readcharfun, &c, 0);
2024 if (!c)
2025 return val;
2027 xsignal1 (Qinvalid_read_syntax,
2028 Fmake_string (make_number (1), make_number (c)));
2031 static int read_buffer_size;
2032 static char *read_buffer;
2034 /* Read a \-escape sequence, assuming we already read the `\'.
2035 If the escape sequence forces unibyte, return eight-bit char. */
2037 static int
2038 read_escape (readcharfun, stringp)
2039 Lisp_Object readcharfun;
2040 int stringp;
2042 register int c = READCHAR;
2043 /* \u allows up to four hex digits, \U up to eight. Default to the
2044 behavior for \u, and change this value in the case that \U is seen. */
2045 int unicode_hex_count = 4;
2047 switch (c)
2049 case -1:
2050 end_of_file_error ();
2052 case 'a':
2053 return '\007';
2054 case 'b':
2055 return '\b';
2056 case 'd':
2057 return 0177;
2058 case 'e':
2059 return 033;
2060 case 'f':
2061 return '\f';
2062 case 'n':
2063 return '\n';
2064 case 'r':
2065 return '\r';
2066 case 't':
2067 return '\t';
2068 case 'v':
2069 return '\v';
2070 case '\n':
2071 return -1;
2072 case ' ':
2073 if (stringp)
2074 return -1;
2075 return ' ';
2077 case 'M':
2078 c = READCHAR;
2079 if (c != '-')
2080 error ("Invalid escape character syntax");
2081 c = READCHAR;
2082 if (c == '\\')
2083 c = read_escape (readcharfun, 0);
2084 return c | meta_modifier;
2086 case 'S':
2087 c = READCHAR;
2088 if (c != '-')
2089 error ("Invalid escape character syntax");
2090 c = READCHAR;
2091 if (c == '\\')
2092 c = read_escape (readcharfun, 0);
2093 return c | shift_modifier;
2095 case 'H':
2096 c = READCHAR;
2097 if (c != '-')
2098 error ("Invalid escape character syntax");
2099 c = READCHAR;
2100 if (c == '\\')
2101 c = read_escape (readcharfun, 0);
2102 return c | hyper_modifier;
2104 case 'A':
2105 c = READCHAR;
2106 if (c != '-')
2107 error ("Invalid escape character syntax");
2108 c = READCHAR;
2109 if (c == '\\')
2110 c = read_escape (readcharfun, 0);
2111 return c | alt_modifier;
2113 case 's':
2114 c = READCHAR;
2115 if (stringp || c != '-')
2117 UNREAD (c);
2118 return ' ';
2120 c = READCHAR;
2121 if (c == '\\')
2122 c = read_escape (readcharfun, 0);
2123 return c | super_modifier;
2125 case 'C':
2126 c = READCHAR;
2127 if (c != '-')
2128 error ("Invalid escape character syntax");
2129 case '^':
2130 c = READCHAR;
2131 if (c == '\\')
2132 c = read_escape (readcharfun, 0);
2133 if ((c & ~CHAR_MODIFIER_MASK) == '?')
2134 return 0177 | (c & CHAR_MODIFIER_MASK);
2135 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
2136 return c | ctrl_modifier;
2137 /* ASCII control chars are made from letters (both cases),
2138 as well as the non-letters within 0100...0137. */
2139 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
2140 return (c & (037 | ~0177));
2141 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
2142 return (c & (037 | ~0177));
2143 else
2144 return c | ctrl_modifier;
2146 case '0':
2147 case '1':
2148 case '2':
2149 case '3':
2150 case '4':
2151 case '5':
2152 case '6':
2153 case '7':
2154 /* An octal escape, as in ANSI C. */
2156 register int i = c - '0';
2157 register int count = 0;
2158 while (++count < 3)
2160 if ((c = READCHAR) >= '0' && c <= '7')
2162 i *= 8;
2163 i += c - '0';
2165 else
2167 UNREAD (c);
2168 break;
2172 if (i >= 0x80 && i < 0x100)
2173 i = BYTE8_TO_CHAR (i);
2174 return i;
2177 case 'x':
2178 /* A hex escape, as in ANSI C. */
2180 int i = 0;
2181 int count = 0;
2182 while (1)
2184 c = READCHAR;
2185 if (c >= '0' && c <= '9')
2187 i *= 16;
2188 i += c - '0';
2190 else if ((c >= 'a' && c <= 'f')
2191 || (c >= 'A' && c <= 'F'))
2193 i *= 16;
2194 if (c >= 'a' && c <= 'f')
2195 i += c - 'a' + 10;
2196 else
2197 i += c - 'A' + 10;
2199 else
2201 UNREAD (c);
2202 break;
2204 count++;
2207 if (count < 3 && i >= 0x80)
2208 return BYTE8_TO_CHAR (i);
2209 return i;
2212 case 'U':
2213 /* Post-Unicode-2.0: Up to eight hex chars. */
2214 unicode_hex_count = 8;
2215 case 'u':
2217 /* A Unicode escape. We only permit them in strings and characters,
2218 not arbitrarily in the source code, as in some other languages. */
2220 unsigned int i = 0;
2221 int count = 0;
2223 while (++count <= unicode_hex_count)
2225 c = READCHAR;
2226 /* isdigit and isalpha may be locale-specific, which we don't
2227 want. */
2228 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
2229 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
2230 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
2231 else
2233 error ("Non-hex digit used for Unicode escape");
2234 break;
2237 if (i > 0x10FFFF)
2238 error ("Non-Unicode character: 0x%x", i);
2239 return i;
2242 default:
2243 return c;
2247 /* Read an integer in radix RADIX using READCHARFUN to read
2248 characters. RADIX must be in the interval [2..36]; if it isn't, a
2249 read error is signaled . Value is the integer read. Signals an
2250 error if encountering invalid read syntax or if RADIX is out of
2251 range. */
2253 static Lisp_Object
2254 read_integer (readcharfun, radix)
2255 Lisp_Object readcharfun;
2256 int radix;
2258 int ndigits = 0, invalid_p, c, sign = 0;
2259 /* We use a floating point number because */
2260 double number = 0;
2262 if (radix < 2 || radix > 36)
2263 invalid_p = 1;
2264 else
2266 number = ndigits = invalid_p = 0;
2267 sign = 1;
2269 c = READCHAR;
2270 if (c == '-')
2272 c = READCHAR;
2273 sign = -1;
2275 else if (c == '+')
2276 c = READCHAR;
2278 while (c >= 0)
2280 int digit;
2282 if (c >= '0' && c <= '9')
2283 digit = c - '0';
2284 else if (c >= 'a' && c <= 'z')
2285 digit = c - 'a' + 10;
2286 else if (c >= 'A' && c <= 'Z')
2287 digit = c - 'A' + 10;
2288 else
2290 UNREAD (c);
2291 break;
2294 if (digit < 0 || digit >= radix)
2295 invalid_p = 1;
2297 number = radix * number + digit;
2298 ++ndigits;
2299 c = READCHAR;
2303 if (ndigits == 0 || invalid_p)
2305 char buf[50];
2306 sprintf (buf, "integer, radix %d", radix);
2307 invalid_syntax (buf, 0);
2310 return make_fixnum_or_float (sign * number);
2314 /* If the next token is ')' or ']' or '.', we store that character
2315 in *PCH and the return value is not interesting. Else, we store
2316 zero in *PCH and we read and return one lisp object.
2318 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2320 static Lisp_Object
2321 read1 (readcharfun, pch, first_in_list)
2322 register Lisp_Object readcharfun;
2323 int *pch;
2324 int first_in_list;
2326 register int c;
2327 int uninterned_symbol = 0;
2328 int multibyte;
2330 *pch = 0;
2331 load_each_byte = 0;
2333 retry:
2335 c = READCHAR_REPORT_MULTIBYTE (&multibyte);
2336 if (c < 0)
2337 end_of_file_error ();
2339 switch (c)
2341 case '(':
2342 return read_list (0, readcharfun);
2344 case '[':
2345 return read_vector (readcharfun, 0);
2347 case ')':
2348 case ']':
2350 *pch = c;
2351 return Qnil;
2354 case '#':
2355 c = READCHAR;
2356 if (c == 's')
2358 c = READCHAR;
2359 if (c == '(')
2361 /* Accept extended format for hashtables (extensible to
2362 other types), e.g.
2363 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2364 Lisp_Object tmp = read_list (0, readcharfun);
2365 Lisp_Object head = CAR_SAFE (tmp);
2366 Lisp_Object data = Qnil;
2367 Lisp_Object val = Qnil;
2368 /* The size is 2 * number of allowed keywords to
2369 make-hash-table. */
2370 Lisp_Object params[10];
2371 Lisp_Object ht;
2372 Lisp_Object key = Qnil;
2373 int param_count = 0;
2375 if (!EQ (head, Qhash_table))
2376 error ("Invalid extended read marker at head of #s list "
2377 "(only hash-table allowed)");
2379 tmp = CDR_SAFE (tmp);
2381 /* This is repetitive but fast and simple. */
2382 params[param_count] = QCsize;
2383 params[param_count+1] = Fplist_get (tmp, Qsize);
2384 if (!NILP (params[param_count + 1]))
2385 param_count += 2;
2387 params[param_count] = QCtest;
2388 params[param_count+1] = Fplist_get (tmp, Qtest);
2389 if (!NILP (params[param_count + 1]))
2390 param_count += 2;
2392 params[param_count] = QCweakness;
2393 params[param_count+1] = Fplist_get (tmp, Qweakness);
2394 if (!NILP (params[param_count + 1]))
2395 param_count += 2;
2397 params[param_count] = QCrehash_size;
2398 params[param_count+1] = Fplist_get (tmp, Qrehash_size);
2399 if (!NILP (params[param_count + 1]))
2400 param_count += 2;
2402 params[param_count] = QCrehash_threshold;
2403 params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
2404 if (!NILP (params[param_count + 1]))
2405 param_count += 2;
2407 /* This is the hashtable data. */
2408 data = Fplist_get (tmp, Qdata);
2410 /* Now use params to make a new hashtable and fill it. */
2411 ht = Fmake_hash_table (param_count, params);
2413 while (CONSP (data))
2415 key = XCAR (data);
2416 data = XCDR (data);
2417 if (!CONSP (data))
2418 error ("Odd number of elements in hashtable data");
2419 val = XCAR (data);
2420 data = XCDR (data);
2421 Fputhash (key, val, ht);
2424 return ht;
2426 UNREAD (c);
2427 invalid_syntax ("#", 1);
2429 if (c == '^')
2431 c = READCHAR;
2432 if (c == '[')
2434 Lisp_Object tmp;
2435 tmp = read_vector (readcharfun, 0);
2436 if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
2437 error ("Invalid size char-table");
2438 XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
2439 return tmp;
2441 else if (c == '^')
2443 c = READCHAR;
2444 if (c == '[')
2446 Lisp_Object tmp;
2447 int depth, size;
2449 tmp = read_vector (readcharfun, 0);
2450 if (!INTEGERP (AREF (tmp, 0)))
2451 error ("Invalid depth in char-table");
2452 depth = XINT (AREF (tmp, 0));
2453 if (depth < 1 || depth > 3)
2454 error ("Invalid depth in char-table");
2455 size = XVECTOR (tmp)->size - 2;
2456 if (chartab_size [depth] != size)
2457 error ("Invalid size char-table");
2458 XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
2459 return tmp;
2461 invalid_syntax ("#^^", 3);
2463 invalid_syntax ("#^", 2);
2465 if (c == '&')
2467 Lisp_Object length;
2468 length = read1 (readcharfun, pch, first_in_list);
2469 c = READCHAR;
2470 if (c == '"')
2472 Lisp_Object tmp, val;
2473 int size_in_chars
2474 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
2475 / BOOL_VECTOR_BITS_PER_CHAR);
2477 UNREAD (c);
2478 tmp = read1 (readcharfun, pch, first_in_list);
2479 if (STRING_MULTIBYTE (tmp)
2480 || (size_in_chars != SCHARS (tmp)
2481 /* We used to print 1 char too many
2482 when the number of bits was a multiple of 8.
2483 Accept such input in case it came from an old
2484 version. */
2485 && ! (XFASTINT (length)
2486 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
2487 invalid_syntax ("#&...", 5);
2489 val = Fmake_bool_vector (length, Qnil);
2490 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
2491 size_in_chars);
2492 /* Clear the extraneous bits in the last byte. */
2493 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
2494 XBOOL_VECTOR (val)->data[size_in_chars - 1]
2495 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2496 return val;
2498 invalid_syntax ("#&...", 5);
2500 if (c == '[')
2502 /* Accept compiled functions at read-time so that we don't have to
2503 build them using function calls. */
2504 Lisp_Object tmp;
2505 tmp = read_vector (readcharfun, 1);
2506 return Fmake_byte_code (XVECTOR (tmp)->size,
2507 XVECTOR (tmp)->contents);
2509 if (c == '(')
2511 Lisp_Object tmp;
2512 struct gcpro gcpro1;
2513 int ch;
2515 /* Read the string itself. */
2516 tmp = read1 (readcharfun, &ch, 0);
2517 if (ch != 0 || !STRINGP (tmp))
2518 invalid_syntax ("#", 1);
2519 GCPRO1 (tmp);
2520 /* Read the intervals and their properties. */
2521 while (1)
2523 Lisp_Object beg, end, plist;
2525 beg = read1 (readcharfun, &ch, 0);
2526 end = plist = Qnil;
2527 if (ch == ')')
2528 break;
2529 if (ch == 0)
2530 end = read1 (readcharfun, &ch, 0);
2531 if (ch == 0)
2532 plist = read1 (readcharfun, &ch, 0);
2533 if (ch)
2534 invalid_syntax ("Invalid string property list", 0);
2535 Fset_text_properties (beg, end, plist, tmp);
2537 UNGCPRO;
2538 return tmp;
2541 /* #@NUMBER is used to skip NUMBER following characters.
2542 That's used in .elc files to skip over doc strings
2543 and function definitions. */
2544 if (c == '@')
2546 int i, nskip = 0;
2548 load_each_byte = 1;
2549 /* Read a decimal integer. */
2550 while ((c = READCHAR) >= 0
2551 && c >= '0' && c <= '9')
2553 nskip *= 10;
2554 nskip += c - '0';
2556 if (c >= 0)
2557 UNREAD (c);
2559 if (load_force_doc_strings
2560 && (EQ (readcharfun, Qget_file_char)
2561 || EQ (readcharfun, Qget_emacs_mule_file_char)))
2563 /* If we are supposed to force doc strings into core right now,
2564 record the last string that we skipped,
2565 and record where in the file it comes from. */
2567 /* But first exchange saved_doc_string
2568 with prev_saved_doc_string, so we save two strings. */
2570 char *temp = saved_doc_string;
2571 int temp_size = saved_doc_string_size;
2572 file_offset temp_pos = saved_doc_string_position;
2573 int temp_len = saved_doc_string_length;
2575 saved_doc_string = prev_saved_doc_string;
2576 saved_doc_string_size = prev_saved_doc_string_size;
2577 saved_doc_string_position = prev_saved_doc_string_position;
2578 saved_doc_string_length = prev_saved_doc_string_length;
2580 prev_saved_doc_string = temp;
2581 prev_saved_doc_string_size = temp_size;
2582 prev_saved_doc_string_position = temp_pos;
2583 prev_saved_doc_string_length = temp_len;
2586 if (saved_doc_string_size == 0)
2588 saved_doc_string_size = nskip + 100;
2589 saved_doc_string = (char *) xmalloc (saved_doc_string_size);
2591 if (nskip > saved_doc_string_size)
2593 saved_doc_string_size = nskip + 100;
2594 saved_doc_string = (char *) xrealloc (saved_doc_string,
2595 saved_doc_string_size);
2598 saved_doc_string_position = file_tell (instream);
2600 /* Copy that many characters into saved_doc_string. */
2601 for (i = 0; i < nskip && c >= 0; i++)
2602 saved_doc_string[i] = c = READCHAR;
2604 saved_doc_string_length = i;
2606 else
2608 /* Skip that many characters. */
2609 for (i = 0; i < nskip && c >= 0; i++)
2610 c = READCHAR;
2613 load_each_byte = 0;
2614 goto retry;
2616 if (c == '!')
2618 /* #! appears at the beginning of an executable file.
2619 Skip the first line. */
2620 while (c != '\n' && c >= 0)
2621 c = READCHAR;
2622 goto retry;
2624 if (c == '$')
2625 return Vload_file_name;
2626 if (c == '\'')
2627 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
2628 /* #:foo is the uninterned symbol named foo. */
2629 if (c == ':')
2631 uninterned_symbol = 1;
2632 c = READCHAR;
2633 goto default_label;
2635 /* Reader forms that can reuse previously read objects. */
2636 if (c >= '0' && c <= '9')
2638 int n = 0;
2639 Lisp_Object tem;
2641 /* Read a non-negative integer. */
2642 while (c >= '0' && c <= '9')
2644 n *= 10;
2645 n += c - '0';
2646 c = READCHAR;
2648 /* #n=object returns object, but associates it with n for #n#. */
2649 if (c == '=' && !NILP (Vread_circle))
2651 /* Make a placeholder for #n# to use temporarily */
2652 Lisp_Object placeholder;
2653 Lisp_Object cell;
2655 placeholder = Fcons (Qnil, Qnil);
2656 cell = Fcons (make_number (n), placeholder);
2657 read_objects = Fcons (cell, read_objects);
2659 /* Read the object itself. */
2660 tem = read0 (readcharfun);
2662 /* Now put it everywhere the placeholder was... */
2663 substitute_object_in_subtree (tem, placeholder);
2665 /* ...and #n# will use the real value from now on. */
2666 Fsetcdr (cell, tem);
2668 return tem;
2670 /* #n# returns a previously read object. */
2671 if (c == '#' && !NILP (Vread_circle))
2673 tem = Fassq (make_number (n), read_objects);
2674 if (CONSP (tem))
2675 return XCDR (tem);
2676 /* Fall through to error message. */
2678 else if (c == 'r' || c == 'R')
2679 return read_integer (readcharfun, n);
2681 /* Fall through to error message. */
2683 else if (c == 'x' || c == 'X')
2684 return read_integer (readcharfun, 16);
2685 else if (c == 'o' || c == 'O')
2686 return read_integer (readcharfun, 8);
2687 else if (c == 'b' || c == 'B')
2688 return read_integer (readcharfun, 2);
2690 UNREAD (c);
2691 invalid_syntax ("#", 1);
2693 case ';':
2694 while ((c = READCHAR) >= 0 && c != '\n');
2695 goto retry;
2697 case '\'':
2699 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2702 case '`':
2703 if (first_in_list)
2705 Vold_style_backquotes = Qt;
2706 goto default_label;
2708 else
2710 Lisp_Object value;
2712 new_backquote_flag++;
2713 value = read0 (readcharfun);
2714 new_backquote_flag--;
2716 return Fcons (Qbackquote, Fcons (value, Qnil));
2719 case ',':
2720 if (new_backquote_flag)
2722 Lisp_Object comma_type = Qnil;
2723 Lisp_Object value;
2724 int ch = READCHAR;
2726 if (ch == '@')
2727 comma_type = Qcomma_at;
2728 else if (ch == '.')
2729 comma_type = Qcomma_dot;
2730 else
2732 if (ch >= 0) UNREAD (ch);
2733 comma_type = Qcomma;
2736 new_backquote_flag--;
2737 value = read0 (readcharfun);
2738 new_backquote_flag++;
2739 return Fcons (comma_type, Fcons (value, Qnil));
2741 else
2743 Vold_style_backquotes = Qt;
2744 goto default_label;
2747 case '?':
2749 int modifiers;
2750 int next_char;
2751 int ok;
2753 c = READCHAR;
2754 if (c < 0)
2755 end_of_file_error ();
2757 /* Accept `single space' syntax like (list ? x) where the
2758 whitespace character is SPC or TAB.
2759 Other literal whitespace like NL, CR, and FF are not accepted,
2760 as there are well-established escape sequences for these. */
2761 if (c == ' ' || c == '\t')
2762 return make_number (c);
2764 if (c == '\\')
2765 c = read_escape (readcharfun, 0);
2766 modifiers = c & CHAR_MODIFIER_MASK;
2767 c &= ~CHAR_MODIFIER_MASK;
2768 if (CHAR_BYTE8_P (c))
2769 c = CHAR_TO_BYTE8 (c);
2770 c |= modifiers;
2772 next_char = READCHAR;
2773 if (next_char == '.')
2775 /* Only a dotted-pair dot is valid after a char constant. */
2776 int next_next_char = READCHAR;
2777 UNREAD (next_next_char);
2779 ok = (next_next_char <= 040
2780 || (next_next_char < 0200
2781 && (index ("\"';([#?", next_next_char)
2782 || (!first_in_list && next_next_char == '`')
2783 || (new_backquote_flag && next_next_char == ','))));
2785 else
2787 ok = (next_char <= 040
2788 || (next_char < 0200
2789 && (index ("\"';()[]#?", next_char)
2790 || (!first_in_list && next_char == '`')
2791 || (new_backquote_flag && next_char == ','))));
2793 UNREAD (next_char);
2794 if (ok)
2795 return make_number (c);
2797 invalid_syntax ("?", 1);
2800 case '"':
2802 char *p = read_buffer;
2803 char *end = read_buffer + read_buffer_size;
2804 register int c;
2805 /* Nonzero if we saw an escape sequence specifying
2806 a multibyte character. */
2807 int force_multibyte = 0;
2808 /* Nonzero if we saw an escape sequence specifying
2809 a single-byte character. */
2810 int force_singlebyte = 0;
2811 int cancel = 0;
2812 int nchars = 0;
2814 while ((c = READCHAR) >= 0
2815 && c != '\"')
2817 if (end - p < MAX_MULTIBYTE_LENGTH)
2819 int offset = p - read_buffer;
2820 read_buffer = (char *) xrealloc (read_buffer,
2821 read_buffer_size *= 2);
2822 p = read_buffer + offset;
2823 end = read_buffer + read_buffer_size;
2826 if (c == '\\')
2828 int modifiers;
2830 c = read_escape (readcharfun, 1);
2832 /* C is -1 if \ newline has just been seen */
2833 if (c == -1)
2835 if (p == read_buffer)
2836 cancel = 1;
2837 continue;
2840 modifiers = c & CHAR_MODIFIER_MASK;
2841 c = c & ~CHAR_MODIFIER_MASK;
2843 if (CHAR_BYTE8_P (c))
2844 force_singlebyte = 1;
2845 else if (! ASCII_CHAR_P (c))
2846 force_multibyte = 1;
2847 else /* i.e. ASCII_CHAR_P (c) */
2849 /* Allow `\C- ' and `\C-?'. */
2850 if (modifiers == CHAR_CTL)
2852 if (c == ' ')
2853 c = 0, modifiers = 0;
2854 else if (c == '?')
2855 c = 127, modifiers = 0;
2857 if (modifiers & CHAR_SHIFT)
2859 /* Shift modifier is valid only with [A-Za-z]. */
2860 if (c >= 'A' && c <= 'Z')
2861 modifiers &= ~CHAR_SHIFT;
2862 else if (c >= 'a' && c <= 'z')
2863 c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
2866 if (modifiers & CHAR_META)
2868 /* Move the meta bit to the right place for a
2869 string. */
2870 modifiers &= ~CHAR_META;
2871 c = BYTE8_TO_CHAR (c | 0x80);
2872 force_singlebyte = 1;
2876 /* Any modifiers remaining are invalid. */
2877 if (modifiers)
2878 error ("Invalid modifier in string");
2879 p += CHAR_STRING (c, (unsigned char *) p);
2881 else
2883 p += CHAR_STRING (c, (unsigned char *) p);
2884 if (CHAR_BYTE8_P (c))
2885 force_singlebyte = 1;
2886 else if (! ASCII_CHAR_P (c))
2887 force_multibyte = 1;
2889 nchars++;
2892 if (c < 0)
2893 end_of_file_error ();
2895 /* If purifying, and string starts with \ newline,
2896 return zero instead. This is for doc strings
2897 that we are really going to find in etc/DOC.nn.nn */
2898 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
2899 return make_number (0);
2901 if (force_multibyte)
2902 /* READ_BUFFER already contains valid multibyte forms. */
2904 else if (force_singlebyte)
2906 nchars = str_as_unibyte (read_buffer, p - read_buffer);
2907 p = read_buffer + nchars;
2909 else
2910 /* Otherwise, READ_BUFFER contains only ASCII. */
2913 /* We want readchar_count to be the number of characters, not
2914 bytes. Hence we adjust for multibyte characters in the
2915 string. ... But it doesn't seem to be necessary, because
2916 READCHAR *does* read multibyte characters from buffers. */
2917 /* readchar_count -= (p - read_buffer) - nchars; */
2918 if (read_pure)
2919 return make_pure_string (read_buffer, nchars, p - read_buffer,
2920 (force_multibyte
2921 || (p - read_buffer != nchars)));
2922 return make_specified_string (read_buffer, nchars, p - read_buffer,
2923 (force_multibyte
2924 || (p - read_buffer != nchars)));
2927 case '.':
2929 int next_char = READCHAR;
2930 UNREAD (next_char);
2932 if (next_char <= 040
2933 || (next_char < 0200
2934 && (index ("\"';([#?", next_char)
2935 || (!first_in_list && next_char == '`')
2936 || (new_backquote_flag && next_char == ','))))
2938 *pch = c;
2939 return Qnil;
2942 /* Otherwise, we fall through! Note that the atom-reading loop
2943 below will now loop at least once, assuring that we will not
2944 try to UNREAD two characters in a row. */
2946 default:
2947 default_label:
2948 if (c <= 040) goto retry;
2949 if (c == 0x8a0) /* NBSP */
2950 goto retry;
2952 char *p = read_buffer;
2953 int quoted = 0;
2956 char *end = read_buffer + read_buffer_size;
2958 while (c > 040
2959 && c != 0x8a0 /* NBSP */
2960 && (c >= 0200
2961 || (!index ("\"';()[]#", c)
2962 && !(!first_in_list && c == '`')
2963 && !(new_backquote_flag && c == ','))))
2965 if (end - p < MAX_MULTIBYTE_LENGTH)
2967 int offset = p - read_buffer;
2968 read_buffer = (char *) xrealloc (read_buffer,
2969 read_buffer_size *= 2);
2970 p = read_buffer + offset;
2971 end = read_buffer + read_buffer_size;
2974 if (c == '\\')
2976 c = READCHAR;
2977 if (c == -1)
2978 end_of_file_error ();
2979 quoted = 1;
2982 if (multibyte)
2983 p += CHAR_STRING (c, p);
2984 else
2985 *p++ = c;
2986 c = READCHAR;
2989 if (p == end)
2991 int offset = p - read_buffer;
2992 read_buffer = (char *) xrealloc (read_buffer,
2993 read_buffer_size *= 2);
2994 p = read_buffer + offset;
2995 end = read_buffer + read_buffer_size;
2997 *p = 0;
2998 if (c >= 0)
2999 UNREAD (c);
3002 if (!quoted && !uninterned_symbol)
3004 register char *p1;
3005 p1 = read_buffer;
3006 if (*p1 == '+' || *p1 == '-') p1++;
3007 /* Is it an integer? */
3008 if (p1 != p)
3010 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
3011 /* Integers can have trailing decimal points. */
3012 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
3013 if (p1 == p)
3014 /* It is an integer. */
3016 if (p1[-1] == '.')
3017 p1[-1] = '\0';
3019 /* EMACS_INT n = atol (read_buffer); */
3020 char *endptr = NULL;
3021 EMACS_INT n = (errno = 0,
3022 strtol (read_buffer, &endptr, 10));
3023 if (errno == ERANGE && endptr)
3025 Lisp_Object args
3026 = Fcons (make_string (read_buffer,
3027 endptr - read_buffer),
3028 Qnil);
3029 xsignal (Qoverflow_error, args);
3031 return make_fixnum_or_float (n);
3035 if (isfloat_string (read_buffer, 0))
3037 /* Compute NaN and infinities using 0.0 in a variable,
3038 to cope with compilers that think they are smarter
3039 than we are. */
3040 double zero = 0.0;
3042 double value;
3044 /* Negate the value ourselves. This treats 0, NaNs,
3045 and infinity properly on IEEE floating point hosts,
3046 and works around a common bug where atof ("-0.0")
3047 drops the sign. */
3048 int negative = read_buffer[0] == '-';
3050 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3051 returns 1, is if the input ends in e+INF or e+NaN. */
3052 switch (p[-1])
3054 case 'F':
3055 value = 1.0 / zero;
3056 break;
3057 case 'N':
3058 value = zero / zero;
3060 /* If that made a "negative" NaN, negate it. */
3063 int i;
3064 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
3066 u_data.d = value;
3067 u_minus_zero.d = - 0.0;
3068 for (i = 0; i < sizeof (double); i++)
3069 if (u_data.c[i] & u_minus_zero.c[i])
3071 value = - value;
3072 break;
3075 /* Now VALUE is a positive NaN. */
3076 break;
3077 default:
3078 value = atof (read_buffer + negative);
3079 break;
3082 return make_float (negative ? - value : value);
3086 Lisp_Object name, result;
3087 EMACS_INT nbytes = p - read_buffer;
3088 EMACS_INT nchars
3089 = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
3090 : nbytes);
3092 if (uninterned_symbol && ! NILP (Vpurify_flag))
3093 name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
3094 else
3095 name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
3096 result = (uninterned_symbol ? Fmake_symbol (name)
3097 : Fintern (name, Qnil));
3099 if (EQ (Vread_with_symbol_positions, Qt)
3100 || EQ (Vread_with_symbol_positions, readcharfun))
3101 Vread_symbol_positions_list =
3102 /* Kind of a hack; this will probably fail if characters
3103 in the symbol name were escaped. Not really a big
3104 deal, though. */
3105 Fcons (Fcons (result,
3106 make_number (readchar_count
3107 - XFASTINT (Flength (Fsymbol_name (result))))),
3108 Vread_symbol_positions_list);
3109 return result;
3116 /* List of nodes we've seen during substitute_object_in_subtree. */
3117 static Lisp_Object seen_list;
3119 static void
3120 substitute_object_in_subtree (object, placeholder)
3121 Lisp_Object object;
3122 Lisp_Object placeholder;
3124 Lisp_Object check_object;
3126 /* We haven't seen any objects when we start. */
3127 seen_list = Qnil;
3129 /* Make all the substitutions. */
3130 check_object
3131 = substitute_object_recurse (object, placeholder, object);
3133 /* Clear seen_list because we're done with it. */
3134 seen_list = Qnil;
3136 /* The returned object here is expected to always eq the
3137 original. */
3138 if (!EQ (check_object, object))
3139 error ("Unexpected mutation error in reader");
3142 /* Feval doesn't get called from here, so no gc protection is needed. */
3143 #define SUBSTITUTE(get_val, set_val) \
3144 do { \
3145 Lisp_Object old_value = get_val; \
3146 Lisp_Object true_value \
3147 = substitute_object_recurse (object, placeholder, \
3148 old_value); \
3150 if (!EQ (old_value, true_value)) \
3152 set_val; \
3154 } while (0)
3156 static Lisp_Object
3157 substitute_object_recurse (object, placeholder, subtree)
3158 Lisp_Object object;
3159 Lisp_Object placeholder;
3160 Lisp_Object subtree;
3162 /* If we find the placeholder, return the target object. */
3163 if (EQ (placeholder, subtree))
3164 return object;
3166 /* If we've been to this node before, don't explore it again. */
3167 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
3168 return subtree;
3170 /* If this node can be the entry point to a cycle, remember that
3171 we've seen it. It can only be such an entry point if it was made
3172 by #n=, which means that we can find it as a value in
3173 read_objects. */
3174 if (!EQ (Qnil, Frassq (subtree, read_objects)))
3175 seen_list = Fcons (subtree, seen_list);
3177 /* Recurse according to subtree's type.
3178 Every branch must return a Lisp_Object. */
3179 switch (XTYPE (subtree))
3181 case Lisp_Vectorlike:
3183 int i, length = 0;
3184 if (BOOL_VECTOR_P (subtree))
3185 return subtree; /* No sub-objects anyway. */
3186 else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
3187 || COMPILEDP (subtree))
3188 length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
3189 else if (VECTORP (subtree))
3190 length = ASIZE (subtree);
3191 else
3192 /* An unknown pseudovector may contain non-Lisp fields, so we
3193 can't just blindly traverse all its fields. We used to call
3194 `Flength' which signaled `sequencep', so I just preserved this
3195 behavior. */
3196 wrong_type_argument (Qsequencep, subtree);
3198 for (i = 0; i < length; i++)
3199 SUBSTITUTE (AREF (subtree, i),
3200 ASET (subtree, i, true_value));
3201 return subtree;
3204 case Lisp_Cons:
3206 SUBSTITUTE (XCAR (subtree),
3207 XSETCAR (subtree, true_value));
3208 SUBSTITUTE (XCDR (subtree),
3209 XSETCDR (subtree, true_value));
3210 return subtree;
3213 case Lisp_String:
3215 /* Check for text properties in each interval.
3216 substitute_in_interval contains part of the logic. */
3218 INTERVAL root_interval = STRING_INTERVALS (subtree);
3219 Lisp_Object arg = Fcons (object, placeholder);
3221 traverse_intervals_noorder (root_interval,
3222 &substitute_in_interval, arg);
3224 return subtree;
3227 /* Other types don't recurse any further. */
3228 default:
3229 return subtree;
3233 /* Helper function for substitute_object_recurse. */
3234 static void
3235 substitute_in_interval (interval, arg)
3236 INTERVAL interval;
3237 Lisp_Object arg;
3239 Lisp_Object object = Fcar (arg);
3240 Lisp_Object placeholder = Fcdr (arg);
3242 SUBSTITUTE (interval->plist, interval->plist = true_value);
3246 #define LEAD_INT 1
3247 #define DOT_CHAR 2
3248 #define TRAIL_INT 4
3249 #define E_CHAR 8
3250 #define EXP_INT 16
3253 isfloat_string (cp, ignore_trailing)
3254 register char *cp;
3255 int ignore_trailing;
3257 register int state;
3259 char *start = cp;
3261 state = 0;
3262 if (*cp == '+' || *cp == '-')
3263 cp++;
3265 if (*cp >= '0' && *cp <= '9')
3267 state |= LEAD_INT;
3268 while (*cp >= '0' && *cp <= '9')
3269 cp++;
3271 if (*cp == '.')
3273 state |= DOT_CHAR;
3274 cp++;
3276 if (*cp >= '0' && *cp <= '9')
3278 state |= TRAIL_INT;
3279 while (*cp >= '0' && *cp <= '9')
3280 cp++;
3282 if (*cp == 'e' || *cp == 'E')
3284 state |= E_CHAR;
3285 cp++;
3286 if (*cp == '+' || *cp == '-')
3287 cp++;
3290 if (*cp >= '0' && *cp <= '9')
3292 state |= EXP_INT;
3293 while (*cp >= '0' && *cp <= '9')
3294 cp++;
3296 else if (cp == start)
3298 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
3300 state |= EXP_INT;
3301 cp += 3;
3303 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
3305 state |= EXP_INT;
3306 cp += 3;
3309 return ((ignore_trailing
3310 || (*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
3311 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
3312 || state == (DOT_CHAR|TRAIL_INT)
3313 || state == (LEAD_INT|E_CHAR|EXP_INT)
3314 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
3315 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
3319 static Lisp_Object
3320 read_vector (readcharfun, bytecodeflag)
3321 Lisp_Object readcharfun;
3322 int bytecodeflag;
3324 register int i;
3325 register int size;
3326 register Lisp_Object *ptr;
3327 register Lisp_Object tem, item, vector;
3328 register struct Lisp_Cons *otem;
3329 Lisp_Object len;
3331 tem = read_list (1, readcharfun);
3332 len = Flength (tem);
3333 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
3335 size = XVECTOR (vector)->size;
3336 ptr = XVECTOR (vector)->contents;
3337 for (i = 0; i < size; i++)
3339 item = Fcar (tem);
3340 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3341 bytecode object, the docstring containing the bytecode and
3342 constants values must be treated as unibyte and passed to
3343 Fread, to get the actual bytecode string and constants vector. */
3344 if (bytecodeflag && load_force_doc_strings)
3346 if (i == COMPILED_BYTECODE)
3348 if (!STRINGP (item))
3349 error ("Invalid byte code");
3351 /* Delay handling the bytecode slot until we know whether
3352 it is lazily-loaded (we can tell by whether the
3353 constants slot is nil). */
3354 ptr[COMPILED_CONSTANTS] = item;
3355 item = Qnil;
3357 else if (i == COMPILED_CONSTANTS)
3359 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
3361 if (NILP (item))
3363 /* Coerce string to unibyte (like string-as-unibyte,
3364 but without generating extra garbage and
3365 guaranteeing no change in the contents). */
3366 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
3367 STRING_SET_UNIBYTE (bytestr);
3369 item = Fread (Fcons (bytestr, readcharfun));
3370 if (!CONSP (item))
3371 error ("Invalid byte code");
3373 otem = XCONS (item);
3374 bytestr = XCAR (item);
3375 item = XCDR (item);
3376 free_cons (otem);
3379 /* Now handle the bytecode slot. */
3380 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
3382 else if (i == COMPILED_DOC_STRING
3383 && STRINGP (item)
3384 && ! STRING_MULTIBYTE (item))
3386 if (EQ (readcharfun, Qget_emacs_mule_file_char))
3387 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
3388 else
3389 item = Fstring_as_multibyte (item);
3392 ptr[i] = read_pure ? Fpurecopy (item) : item;
3393 otem = XCONS (tem);
3394 tem = Fcdr (tem);
3395 free_cons (otem);
3397 return vector;
3400 /* FLAG = 1 means check for ] to terminate rather than ) and .
3401 FLAG = -1 means check for starting with defun
3402 and make structure pure. */
3404 static Lisp_Object
3405 read_list (flag, readcharfun)
3406 int flag;
3407 register Lisp_Object readcharfun;
3409 /* -1 means check next element for defun,
3410 0 means don't check,
3411 1 means already checked and found defun. */
3412 int defunflag = flag < 0 ? -1 : 0;
3413 Lisp_Object val, tail;
3414 register Lisp_Object elt, tem;
3415 struct gcpro gcpro1, gcpro2;
3416 /* 0 is the normal case.
3417 1 means this list is a doc reference; replace it with the number 0.
3418 2 means this list is a doc reference; replace it with the doc string. */
3419 int doc_reference = 0;
3421 /* Initialize this to 1 if we are reading a list. */
3422 int first_in_list = flag <= 0;
3424 val = Qnil;
3425 tail = Qnil;
3427 while (1)
3429 int ch;
3430 GCPRO2 (val, tail);
3431 elt = read1 (readcharfun, &ch, first_in_list);
3432 UNGCPRO;
3434 first_in_list = 0;
3436 /* While building, if the list starts with #$, treat it specially. */
3437 if (EQ (elt, Vload_file_name)
3438 && ! NILP (elt)
3439 && !NILP (Vpurify_flag))
3441 if (NILP (Vdoc_file_name))
3442 /* We have not yet called Snarf-documentation, so assume
3443 this file is described in the DOC-MM.NN file
3444 and Snarf-documentation will fill in the right value later.
3445 For now, replace the whole list with 0. */
3446 doc_reference = 1;
3447 else
3448 /* We have already called Snarf-documentation, so make a relative
3449 file name for this file, so it can be found properly
3450 in the installed Lisp directory.
3451 We don't use Fexpand_file_name because that would make
3452 the directory absolute now. */
3453 elt = concat2 (build_string ("../lisp/"),
3454 Ffile_name_nondirectory (elt));
3456 else if (EQ (elt, Vload_file_name)
3457 && ! NILP (elt)
3458 && load_force_doc_strings)
3459 doc_reference = 2;
3461 if (ch)
3463 if (flag > 0)
3465 if (ch == ']')
3466 return val;
3467 invalid_syntax (") or . in a vector", 18);
3469 if (ch == ')')
3470 return val;
3471 if (ch == '.')
3473 GCPRO2 (val, tail);
3474 if (!NILP (tail))
3475 XSETCDR (tail, read0 (readcharfun));
3476 else
3477 val = read0 (readcharfun);
3478 read1 (readcharfun, &ch, 0);
3479 UNGCPRO;
3480 if (ch == ')')
3482 if (doc_reference == 1)
3483 return make_number (0);
3484 if (doc_reference == 2)
3486 /* Get a doc string from the file we are loading.
3487 If it's in saved_doc_string, get it from there.
3489 Here, we don't know if the string is a
3490 bytecode string or a doc string. As a
3491 bytecode string must be unibyte, we always
3492 return a unibyte string. If it is actually a
3493 doc string, caller must make it
3494 multibyte. */
3496 int pos = XINT (XCDR (val));
3497 /* Position is negative for user variables. */
3498 if (pos < 0) pos = -pos;
3499 if (pos >= saved_doc_string_position
3500 && pos < (saved_doc_string_position
3501 + saved_doc_string_length))
3503 int start = pos - saved_doc_string_position;
3504 int from, to;
3506 /* Process quoting with ^A,
3507 and find the end of the string,
3508 which is marked with ^_ (037). */
3509 for (from = start, to = start;
3510 saved_doc_string[from] != 037;)
3512 int c = saved_doc_string[from++];
3513 if (c == 1)
3515 c = saved_doc_string[from++];
3516 if (c == 1)
3517 saved_doc_string[to++] = c;
3518 else if (c == '0')
3519 saved_doc_string[to++] = 0;
3520 else if (c == '_')
3521 saved_doc_string[to++] = 037;
3523 else
3524 saved_doc_string[to++] = c;
3527 return make_unibyte_string (saved_doc_string + start,
3528 to - start);
3530 /* Look in prev_saved_doc_string the same way. */
3531 else if (pos >= prev_saved_doc_string_position
3532 && pos < (prev_saved_doc_string_position
3533 + prev_saved_doc_string_length))
3535 int start = pos - prev_saved_doc_string_position;
3536 int from, to;
3538 /* Process quoting with ^A,
3539 and find the end of the string,
3540 which is marked with ^_ (037). */
3541 for (from = start, to = start;
3542 prev_saved_doc_string[from] != 037;)
3544 int c = prev_saved_doc_string[from++];
3545 if (c == 1)
3547 c = prev_saved_doc_string[from++];
3548 if (c == 1)
3549 prev_saved_doc_string[to++] = c;
3550 else if (c == '0')
3551 prev_saved_doc_string[to++] = 0;
3552 else if (c == '_')
3553 prev_saved_doc_string[to++] = 037;
3555 else
3556 prev_saved_doc_string[to++] = c;
3559 return make_unibyte_string (prev_saved_doc_string
3560 + start,
3561 to - start);
3563 else
3564 return get_doc_string (val, 1, 0);
3567 return val;
3569 invalid_syntax (". in wrong context", 18);
3571 invalid_syntax ("] in a list", 11);
3573 tem = (read_pure && flag <= 0
3574 ? pure_cons (elt, Qnil)
3575 : Fcons (elt, Qnil));
3576 if (!NILP (tail))
3577 XSETCDR (tail, tem);
3578 else
3579 val = tem;
3580 tail = tem;
3581 if (defunflag < 0)
3582 defunflag = EQ (elt, Qdefun);
3583 else if (defunflag > 0)
3584 read_pure = 1;
3588 Lisp_Object Vobarray;
3589 Lisp_Object initial_obarray;
3591 /* oblookup stores the bucket number here, for the sake of Funintern. */
3593 int oblookup_last_bucket_number;
3595 static int hash_string ();
3597 /* Get an error if OBARRAY is not an obarray.
3598 If it is one, return it. */
3600 Lisp_Object
3601 check_obarray (obarray)
3602 Lisp_Object obarray;
3604 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3606 /* If Vobarray is now invalid, force it to be valid. */
3607 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
3608 wrong_type_argument (Qvectorp, obarray);
3610 return obarray;
3613 /* Intern the C string STR: return a symbol with that name,
3614 interned in the current obarray. */
3616 Lisp_Object
3617 intern (str)
3618 const char *str;
3620 Lisp_Object tem;
3621 int len = strlen (str);
3622 Lisp_Object obarray;
3624 obarray = Vobarray;
3625 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3626 obarray = check_obarray (obarray);
3627 tem = oblookup (obarray, str, len, len);
3628 if (SYMBOLP (tem))
3629 return tem;
3630 return Fintern (make_string (str, len), obarray);
3633 Lisp_Object
3634 intern_c_string (const char *str)
3636 Lisp_Object tem;
3637 int len = strlen (str);
3638 Lisp_Object obarray;
3640 obarray = Vobarray;
3641 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3642 obarray = check_obarray (obarray);
3643 tem = oblookup (obarray, str, len, len);
3644 if (SYMBOLP (tem))
3645 return tem;
3647 if (NILP (Vpurify_flag))
3648 /* Creating a non-pure string from a string literal not
3649 implemented yet. We could just use make_string here and live
3650 with the extra copy. */
3651 abort ();
3653 return Fintern (make_pure_c_string (str), obarray);
3656 /* Create an uninterned symbol with name STR. */
3658 Lisp_Object
3659 make_symbol (str)
3660 char *str;
3662 int len = strlen (str);
3664 return Fmake_symbol ((!NILP (Vpurify_flag)
3665 ? make_pure_string (str, len, len, 0)
3666 : make_string (str, len)));
3669 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
3670 doc: /* Return the canonical symbol whose name is STRING.
3671 If there is none, one is created by this function and returned.
3672 A second optional argument specifies the obarray to use;
3673 it defaults to the value of `obarray'. */)
3674 (string, obarray)
3675 Lisp_Object string, obarray;
3677 register Lisp_Object tem, sym, *ptr;
3679 if (NILP (obarray)) obarray = Vobarray;
3680 obarray = check_obarray (obarray);
3682 CHECK_STRING (string);
3684 tem = oblookup (obarray, SDATA (string),
3685 SCHARS (string),
3686 SBYTES (string));
3687 if (!INTEGERP (tem))
3688 return tem;
3690 if (!NILP (Vpurify_flag))
3691 string = Fpurecopy (string);
3692 sym = Fmake_symbol (string);
3694 if (EQ (obarray, initial_obarray))
3695 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3696 else
3697 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
3699 if ((SREF (string, 0) == ':')
3700 && EQ (obarray, initial_obarray))
3702 XSYMBOL (sym)->constant = 1;
3703 XSYMBOL (sym)->value = sym;
3706 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
3707 if (SYMBOLP (*ptr))
3708 XSYMBOL (sym)->next = XSYMBOL (*ptr);
3709 else
3710 XSYMBOL (sym)->next = 0;
3711 *ptr = sym;
3712 return sym;
3715 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
3716 doc: /* Return the canonical symbol named NAME, or nil if none exists.
3717 NAME may be a string or a symbol. If it is a symbol, that exact
3718 symbol is searched for.
3719 A second optional argument specifies the obarray to use;
3720 it defaults to the value of `obarray'. */)
3721 (name, obarray)
3722 Lisp_Object name, obarray;
3724 register Lisp_Object tem, string;
3726 if (NILP (obarray)) obarray = Vobarray;
3727 obarray = check_obarray (obarray);
3729 if (!SYMBOLP (name))
3731 CHECK_STRING (name);
3732 string = name;
3734 else
3735 string = SYMBOL_NAME (name);
3737 tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
3738 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3739 return Qnil;
3740 else
3741 return tem;
3744 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
3745 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
3746 The value is t if a symbol was found and deleted, nil otherwise.
3747 NAME may be a string or a symbol. If it is a symbol, that symbol
3748 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3749 OBARRAY defaults to the value of the variable `obarray'. */)
3750 (name, obarray)
3751 Lisp_Object name, obarray;
3753 register Lisp_Object string, tem;
3754 int hash;
3756 if (NILP (obarray)) obarray = Vobarray;
3757 obarray = check_obarray (obarray);
3759 if (SYMBOLP (name))
3760 string = SYMBOL_NAME (name);
3761 else
3763 CHECK_STRING (name);
3764 string = name;
3767 tem = oblookup (obarray, SDATA (string),
3768 SCHARS (string),
3769 SBYTES (string));
3770 if (INTEGERP (tem))
3771 return Qnil;
3772 /* If arg was a symbol, don't delete anything but that symbol itself. */
3773 if (SYMBOLP (name) && !EQ (name, tem))
3774 return Qnil;
3776 /* There are plenty of other symbols which will screw up the Emacs
3777 session if we unintern them, as well as even more ways to use
3778 `setq' or `fset' or whatnot to make the Emacs session
3779 unusable. Let's not go down this silly road. --Stef */
3780 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3781 error ("Attempt to unintern t or nil"); */
3783 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3784 XSYMBOL (tem)->constant = 0;
3785 XSYMBOL (tem)->indirect_variable = 0;
3787 hash = oblookup_last_bucket_number;
3789 if (EQ (XVECTOR (obarray)->contents[hash], tem))
3791 if (XSYMBOL (tem)->next)
3792 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3793 else
3794 XSETINT (XVECTOR (obarray)->contents[hash], 0);
3796 else
3798 Lisp_Object tail, following;
3800 for (tail = XVECTOR (obarray)->contents[hash];
3801 XSYMBOL (tail)->next;
3802 tail = following)
3804 XSETSYMBOL (following, XSYMBOL (tail)->next);
3805 if (EQ (following, tem))
3807 XSYMBOL (tail)->next = XSYMBOL (following)->next;
3808 break;
3813 return Qt;
3816 /* Return the symbol in OBARRAY whose names matches the string
3817 of SIZE characters (SIZE_BYTE bytes) at PTR.
3818 If there is no such symbol in OBARRAY, return nil.
3820 Also store the bucket number in oblookup_last_bucket_number. */
3822 Lisp_Object
3823 oblookup (obarray, ptr, size, size_byte)
3824 Lisp_Object obarray;
3825 register const char *ptr;
3826 int size, size_byte;
3828 int hash;
3829 int obsize;
3830 register Lisp_Object tail;
3831 Lisp_Object bucket, tem;
3833 if (!VECTORP (obarray)
3834 || (obsize = XVECTOR (obarray)->size) == 0)
3836 obarray = check_obarray (obarray);
3837 obsize = XVECTOR (obarray)->size;
3839 /* This is sometimes needed in the middle of GC. */
3840 obsize &= ~ARRAY_MARK_FLAG;
3841 hash = hash_string (ptr, size_byte) % obsize;
3842 bucket = XVECTOR (obarray)->contents[hash];
3843 oblookup_last_bucket_number = hash;
3844 if (EQ (bucket, make_number (0)))
3846 else if (!SYMBOLP (bucket))
3847 error ("Bad data in guts of obarray"); /* Like CADR error message */
3848 else
3849 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
3851 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3852 && SCHARS (SYMBOL_NAME (tail)) == size
3853 && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
3854 return tail;
3855 else if (XSYMBOL (tail)->next == 0)
3856 break;
3858 XSETINT (tem, hash);
3859 return tem;
3862 static int
3863 hash_string (ptr, len)
3864 const unsigned char *ptr;
3865 int len;
3867 register const unsigned char *p = ptr;
3868 register const unsigned char *end = p + len;
3869 register unsigned char c;
3870 register int hash = 0;
3872 while (p != end)
3874 c = *p++;
3875 if (c >= 0140) c -= 40;
3876 hash = ((hash<<3) + (hash>>28) + c);
3878 return hash & 07777777777;
3881 void
3882 map_obarray (obarray, fn, arg)
3883 Lisp_Object obarray;
3884 void (*fn) P_ ((Lisp_Object, Lisp_Object));
3885 Lisp_Object arg;
3887 register int i;
3888 register Lisp_Object tail;
3889 CHECK_VECTOR (obarray);
3890 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
3892 tail = XVECTOR (obarray)->contents[i];
3893 if (SYMBOLP (tail))
3894 while (1)
3896 (*fn) (tail, arg);
3897 if (XSYMBOL (tail)->next == 0)
3898 break;
3899 XSETSYMBOL (tail, XSYMBOL (tail)->next);
3904 void
3905 mapatoms_1 (sym, function)
3906 Lisp_Object sym, function;
3908 call1 (function, sym);
3911 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
3912 doc: /* Call FUNCTION on every symbol in OBARRAY.
3913 OBARRAY defaults to the value of `obarray'. */)
3914 (function, obarray)
3915 Lisp_Object function, obarray;
3917 if (NILP (obarray)) obarray = Vobarray;
3918 obarray = check_obarray (obarray);
3920 map_obarray (obarray, mapatoms_1, function);
3921 return Qnil;
3924 #define OBARRAY_SIZE 1511
3926 void
3927 init_obarray ()
3929 Lisp_Object oblength;
3930 int hash;
3931 Lisp_Object *tem;
3933 XSETFASTINT (oblength, OBARRAY_SIZE);
3935 Qnil = Fmake_symbol (make_pure_c_string ("nil"));
3936 Vobarray = Fmake_vector (oblength, make_number (0));
3937 initial_obarray = Vobarray;
3938 staticpro (&initial_obarray);
3939 /* Intern nil in the obarray */
3940 XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3941 XSYMBOL (Qnil)->constant = 1;
3943 /* These locals are to kludge around a pyramid compiler bug. */
3944 hash = hash_string ("nil", 3);
3945 /* Separate statement here to avoid VAXC bug. */
3946 hash %= OBARRAY_SIZE;
3947 tem = &XVECTOR (Vobarray)->contents[hash];
3948 *tem = Qnil;
3950 Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
3951 XSYMBOL (Qnil)->function = Qunbound;
3952 XSYMBOL (Qunbound)->value = Qunbound;
3953 XSYMBOL (Qunbound)->function = Qunbound;
3955 Qt = intern_c_string ("t");
3956 XSYMBOL (Qnil)->value = Qnil;
3957 XSYMBOL (Qnil)->plist = Qnil;
3958 XSYMBOL (Qt)->value = Qt;
3959 XSYMBOL (Qt)->constant = 1;
3961 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3962 Vpurify_flag = Qt;
3964 Qvariable_documentation = intern_c_string ("variable-documentation");
3965 staticpro (&Qvariable_documentation);
3967 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
3968 read_buffer = (char *) xmalloc (read_buffer_size);
3971 void
3972 defsubr (sname)
3973 struct Lisp_Subr *sname;
3975 Lisp_Object sym;
3976 sym = intern_c_string (sname->symbol_name);
3977 XSETPVECTYPE (sname, PVEC_SUBR);
3978 XSETSUBR (XSYMBOL (sym)->function, sname);
3981 #ifdef NOTDEF /* use fset in subr.el now */
3982 void
3983 defalias (sname, string)
3984 struct Lisp_Subr *sname;
3985 char *string;
3987 Lisp_Object sym;
3988 sym = intern (string);
3989 XSETSUBR (XSYMBOL (sym)->function, sname);
3991 #endif /* NOTDEF */
3993 /* Define an "integer variable"; a symbol whose value is forwarded
3994 to a C variable of type int. Sample call:
3995 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3996 void
3997 defvar_int (const char *namestring, EMACS_INT *address)
3999 Lisp_Object sym, val;
4000 sym = intern_c_string (namestring);
4001 val = allocate_misc ();
4002 XMISCTYPE (val) = Lisp_Misc_Intfwd;
4003 XINTFWD (val)->intvar = address;
4004 SET_SYMBOL_VALUE (sym, val);
4007 /* Similar but define a variable whose value is t if address contains 1,
4008 nil if address contains 0. */
4009 void
4010 defvar_bool (const char *namestring, int *address)
4012 Lisp_Object sym, val;
4013 sym = intern_c_string (namestring);
4014 val = allocate_misc ();
4015 XMISCTYPE (val) = Lisp_Misc_Boolfwd;
4016 XBOOLFWD (val)->boolvar = address;
4017 SET_SYMBOL_VALUE (sym, val);
4018 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
4021 /* Similar but define a variable whose value is the Lisp Object stored
4022 at address. Two versions: with and without gc-marking of the C
4023 variable. The nopro version is used when that variable will be
4024 gc-marked for some other reason, since marking the same slot twice
4025 can cause trouble with strings. */
4026 void
4027 defvar_lisp_nopro (const char *namestring, Lisp_Object *address)
4029 Lisp_Object sym, val;
4030 sym = intern_c_string (namestring);
4031 val = allocate_misc ();
4032 XMISCTYPE (val) = Lisp_Misc_Objfwd;
4033 XOBJFWD (val)->objvar = address;
4034 SET_SYMBOL_VALUE (sym, val);
4037 void
4038 defvar_lisp (const char *namestring, Lisp_Object *address)
4040 defvar_lisp_nopro (namestring, address);
4041 staticpro (address);
4044 /* Similar but define a variable whose value is the Lisp Object stored
4045 at a particular offset in the current kboard object. */
4047 void
4048 defvar_kboard (const char *namestring, int offset)
4050 Lisp_Object sym, val;
4051 sym = intern_c_string (namestring);
4052 val = allocate_misc ();
4053 XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd;
4054 XKBOARD_OBJFWD (val)->offset = offset;
4055 SET_SYMBOL_VALUE (sym, val);
4058 /* Record the value of load-path used at the start of dumping
4059 so we can see if the site changed it later during dumping. */
4060 static Lisp_Object dump_path;
4062 void
4063 init_lread ()
4065 char *normal;
4066 int turn_off_warning = 0;
4068 /* Compute the default load-path. */
4069 #ifdef CANNOT_DUMP
4070 normal = PATH_LOADSEARCH;
4071 Vload_path = decode_env_path (0, normal);
4072 #else
4073 if (NILP (Vpurify_flag))
4074 normal = PATH_LOADSEARCH;
4075 else
4076 normal = PATH_DUMPLOADSEARCH;
4078 /* In a dumped Emacs, we normally have to reset the value of
4079 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4080 uses ../lisp, instead of the path of the installed elisp
4081 libraries. However, if it appears that Vload_path was changed
4082 from the default before dumping, don't override that value. */
4083 if (initialized)
4085 if (! NILP (Fequal (dump_path, Vload_path)))
4087 Vload_path = decode_env_path (0, normal);
4088 if (!NILP (Vinstallation_directory))
4090 Lisp_Object tem, tem1, sitelisp;
4092 /* Remove site-lisp dirs from path temporarily and store
4093 them in sitelisp, then conc them on at the end so
4094 they're always first in path. */
4095 sitelisp = Qnil;
4096 while (1)
4098 tem = Fcar (Vload_path);
4099 tem1 = Fstring_match (build_string ("site-lisp"),
4100 tem, Qnil);
4101 if (!NILP (tem1))
4103 Vload_path = Fcdr (Vload_path);
4104 sitelisp = Fcons (tem, sitelisp);
4106 else
4107 break;
4110 /* Add to the path the lisp subdir of the
4111 installation dir, if it exists. */
4112 tem = Fexpand_file_name (build_string ("lisp"),
4113 Vinstallation_directory);
4114 tem1 = Ffile_exists_p (tem);
4115 if (!NILP (tem1))
4117 if (NILP (Fmember (tem, Vload_path)))
4119 turn_off_warning = 1;
4120 Vload_path = Fcons (tem, Vload_path);
4123 else
4124 /* That dir doesn't exist, so add the build-time
4125 Lisp dirs instead. */
4126 Vload_path = nconc2 (Vload_path, dump_path);
4128 /* Add leim under the installation dir, if it exists. */
4129 tem = Fexpand_file_name (build_string ("leim"),
4130 Vinstallation_directory);
4131 tem1 = Ffile_exists_p (tem);
4132 if (!NILP (tem1))
4134 if (NILP (Fmember (tem, Vload_path)))
4135 Vload_path = Fcons (tem, Vload_path);
4138 /* Add site-lisp under the installation dir, if it exists. */
4139 tem = Fexpand_file_name (build_string ("site-lisp"),
4140 Vinstallation_directory);
4141 tem1 = Ffile_exists_p (tem);
4142 if (!NILP (tem1))
4144 if (NILP (Fmember (tem, Vload_path)))
4145 Vload_path = Fcons (tem, Vload_path);
4148 /* If Emacs was not built in the source directory,
4149 and it is run from where it was built, add to load-path
4150 the lisp, leim and site-lisp dirs under that directory. */
4152 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
4154 Lisp_Object tem2;
4156 tem = Fexpand_file_name (build_string ("src/Makefile"),
4157 Vinstallation_directory);
4158 tem1 = Ffile_exists_p (tem);
4160 /* Don't be fooled if they moved the entire source tree
4161 AFTER dumping Emacs. If the build directory is indeed
4162 different from the source dir, src/Makefile.in and
4163 src/Makefile will not be found together. */
4164 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
4165 Vinstallation_directory);
4166 tem2 = Ffile_exists_p (tem);
4167 if (!NILP (tem1) && NILP (tem2))
4169 tem = Fexpand_file_name (build_string ("lisp"),
4170 Vsource_directory);
4172 if (NILP (Fmember (tem, Vload_path)))
4173 Vload_path = Fcons (tem, Vload_path);
4175 tem = Fexpand_file_name (build_string ("leim"),
4176 Vsource_directory);
4178 if (NILP (Fmember (tem, Vload_path)))
4179 Vload_path = Fcons (tem, Vload_path);
4181 tem = Fexpand_file_name (build_string ("site-lisp"),
4182 Vsource_directory);
4184 if (NILP (Fmember (tem, Vload_path)))
4185 Vload_path = Fcons (tem, Vload_path);
4188 if (!NILP (sitelisp))
4189 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
4193 else
4195 /* NORMAL refers to the lisp dir in the source directory. */
4196 /* We used to add ../lisp at the front here, but
4197 that caused trouble because it was copied from dump_path
4198 into Vload_path, above, when Vinstallation_directory was non-nil.
4199 It should be unnecessary. */
4200 Vload_path = decode_env_path (0, normal);
4201 dump_path = Vload_path;
4203 #endif
4205 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4206 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4207 almost never correct, thereby causing a warning to be printed out that
4208 confuses users. Since PATH_LOADSEARCH is always overridden by the
4209 EMACSLOADPATH environment variable below, disable the warning on NT. */
4211 /* Warn if dirs in the *standard* path don't exist. */
4212 if (!turn_off_warning)
4214 Lisp_Object path_tail;
4216 for (path_tail = Vload_path;
4217 !NILP (path_tail);
4218 path_tail = XCDR (path_tail))
4220 Lisp_Object dirfile;
4221 dirfile = Fcar (path_tail);
4222 if (STRINGP (dirfile))
4224 dirfile = Fdirectory_file_name (dirfile);
4225 if (access (SDATA (dirfile), 0) < 0)
4226 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4227 XCAR (path_tail));
4231 #endif /* !(WINDOWSNT || HAVE_NS) */
4233 /* If the EMACSLOADPATH environment variable is set, use its value.
4234 This doesn't apply if we're dumping. */
4235 #ifndef CANNOT_DUMP
4236 if (NILP (Vpurify_flag)
4237 && egetenv ("EMACSLOADPATH"))
4238 #endif
4239 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
4241 Vvalues = Qnil;
4243 load_in_progress = 0;
4244 Vload_file_name = Qnil;
4246 load_descriptor_list = Qnil;
4248 Vstandard_input = Qt;
4249 Vloads_in_progress = Qnil;
4252 /* Print a warning, using format string FORMAT, that directory DIRNAME
4253 does not exist. Print it on stderr and put it in *Messages*. */
4255 void
4256 dir_warning (format, dirname)
4257 char *format;
4258 Lisp_Object dirname;
4260 char *buffer
4261 = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
4263 fprintf (stderr, format, SDATA (dirname));
4264 sprintf (buffer, format, SDATA (dirname));
4265 /* Don't log the warning before we've initialized!! */
4266 if (initialized)
4267 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
4270 void
4271 syms_of_lread ()
4273 defsubr (&Sread);
4274 defsubr (&Sread_from_string);
4275 defsubr (&Sintern);
4276 defsubr (&Sintern_soft);
4277 defsubr (&Sunintern);
4278 defsubr (&Sget_load_suffixes);
4279 defsubr (&Sload);
4280 defsubr (&Seval_buffer);
4281 defsubr (&Seval_region);
4282 defsubr (&Sread_char);
4283 defsubr (&Sread_char_exclusive);
4284 defsubr (&Sread_event);
4285 defsubr (&Sget_file_char);
4286 defsubr (&Smapatoms);
4287 defsubr (&Slocate_file_internal);
4289 DEFVAR_LISP ("obarray", &Vobarray,
4290 doc: /* Symbol table for use by `intern' and `read'.
4291 It is a vector whose length ought to be prime for best results.
4292 The vector's contents don't make sense if examined from Lisp programs;
4293 to find all the symbols in an obarray, use `mapatoms'. */);
4295 DEFVAR_LISP ("values", &Vvalues,
4296 doc: /* List of values of all expressions which were read, evaluated and printed.
4297 Order is reverse chronological. */);
4299 DEFVAR_LISP ("standard-input", &Vstandard_input,
4300 doc: /* Stream for read to get input from.
4301 See documentation of `read' for possible values. */);
4302 Vstandard_input = Qt;
4304 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
4305 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4307 If this variable is a buffer, then only forms read from that buffer
4308 will be added to `read-symbol-positions-list'.
4309 If this variable is t, then all read forms will be added.
4310 The effect of all other values other than nil are not currently
4311 defined, although they may be in the future.
4313 The positions are relative to the last call to `read' or
4314 `read-from-string'. It is probably a bad idea to set this variable at
4315 the toplevel; bind it instead. */);
4316 Vread_with_symbol_positions = Qnil;
4318 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
4319 doc: /* A list mapping read symbols to their positions.
4320 This variable is modified during calls to `read' or
4321 `read-from-string', but only when `read-with-symbol-positions' is
4322 non-nil.
4324 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4325 CHAR-POSITION is an integer giving the offset of that occurrence of the
4326 symbol from the position where `read' or `read-from-string' started.
4328 Note that a symbol will appear multiple times in this list, if it was
4329 read multiple times. The list is in the same order as the symbols
4330 were read in. */);
4331 Vread_symbol_positions_list = Qnil;
4333 DEFVAR_LISP ("read-circle", &Vread_circle,
4334 doc: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4335 Vread_circle = Qt;
4337 DEFVAR_LISP ("load-path", &Vload_path,
4338 doc: /* *List of directories to search for files to load.
4339 Each element is a string (directory name) or nil (try default directory).
4340 Initialized based on EMACSLOADPATH environment variable, if any,
4341 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4343 DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
4344 doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
4345 This list should not include the empty string.
4346 `load' and related functions try to append these suffixes, in order,
4347 to the specified file name if a Lisp suffix is allowed or required. */);
4348 Vload_suffixes = Fcons (make_pure_c_string (".elc"),
4349 Fcons (make_pure_c_string (".el"), Qnil));
4350 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes,
4351 doc: /* List of suffixes that indicate representations of \
4352 the same file.
4353 This list should normally start with the empty string.
4355 Enabling Auto Compression mode appends the suffixes in
4356 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4357 mode removes them again. `load' and related functions use this list to
4358 determine whether they should look for compressed versions of a file
4359 and, if so, which suffixes they should try to append to the file name
4360 in order to do so. However, if you want to customize which suffixes
4361 the loading functions recognize as compression suffixes, you should
4362 customize `jka-compr-load-suffixes' rather than the present variable. */);
4363 Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
4365 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
4366 doc: /* Non-nil if inside of `load'. */);
4367 Qload_in_progress = intern_c_string ("load-in-progress");
4368 staticpro (&Qload_in_progress);
4370 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
4371 doc: /* An alist of expressions to be evalled when particular files are loaded.
4372 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4374 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4375 a symbol \(a feature name).
4377 When `load' is run and the file-name argument matches an element's
4378 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4379 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4381 An error in FORMS does not undo the load, but does prevent execution of
4382 the rest of the FORMS. */);
4383 Vafter_load_alist = Qnil;
4385 DEFVAR_LISP ("load-history", &Vload_history,
4386 doc: /* Alist mapping loaded file names to symbols and features.
4387 Each alist element should be a list (FILE-NAME ENTRIES...), where
4388 FILE-NAME is the name of a file that has been loaded into Emacs.
4389 The file name is absolute and true (i.e. it doesn't contain symlinks).
4390 As an exception, one of the alist elements may have FILE-NAME nil,
4391 for symbols and features not associated with any file.
4393 The remaining ENTRIES in the alist element describe the functions and
4394 variables defined in that file, the features provided, and the
4395 features required. Each entry has the form `(provide . FEATURE)',
4396 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4397 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4398 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4399 SYMBOL was an autoload before this file redefined it as a function.
4401 During preloading, the file name recorded is relative to the main Lisp
4402 directory. These file names are converted to absolute at startup. */);
4403 Vload_history = Qnil;
4405 DEFVAR_LISP ("load-file-name", &Vload_file_name,
4406 doc: /* Full name of file being loaded by `load'. */);
4407 Vload_file_name = Qnil;
4409 DEFVAR_LISP ("user-init-file", &Vuser_init_file,
4410 doc: /* File name, including directory, of user's initialization file.
4411 If the file loaded had extension `.elc', and the corresponding source file
4412 exists, this variable contains the name of source file, suitable for use
4413 by functions like `custom-save-all' which edit the init file.
4414 While Emacs loads and evaluates the init file, value is the real name
4415 of the file, regardless of whether or not it has the `.elc' extension. */);
4416 Vuser_init_file = Qnil;
4418 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
4419 doc: /* Used for internal purposes by `load'. */);
4420 Vcurrent_load_list = Qnil;
4422 DEFVAR_LISP ("load-read-function", &Vload_read_function,
4423 doc: /* Function used by `load' and `eval-region' for reading expressions.
4424 The default is nil, which means use the function `read'. */);
4425 Vload_read_function = Qnil;
4427 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
4428 doc: /* Function called in `load' for loading an Emacs Lisp source file.
4429 This function is for doing code conversion before reading the source file.
4430 If nil, loading is done without any code conversion.
4431 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4432 FULLNAME is the full name of FILE.
4433 See `load' for the meaning of the remaining arguments. */);
4434 Vload_source_file_function = Qnil;
4436 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
4437 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
4438 This is useful when the file being loaded is a temporary copy. */);
4439 load_force_doc_strings = 0;
4441 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
4442 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
4443 This is normally bound by `load' and `eval-buffer' to control `read',
4444 and is not meant for users to change. */);
4445 load_convert_to_unibyte = 0;
4447 DEFVAR_LISP ("source-directory", &Vsource_directory,
4448 doc: /* Directory in which Emacs sources were found when Emacs was built.
4449 You cannot count on them to still be there! */);
4450 Vsource_directory
4451 = Fexpand_file_name (build_string ("../"),
4452 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
4454 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
4455 doc: /* List of files that were preloaded (when dumping Emacs). */);
4456 Vpreloaded_file_list = Qnil;
4458 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
4459 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4460 Vbyte_boolean_vars = Qnil;
4462 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
4463 doc: /* Non-nil means load dangerous compiled Lisp files.
4464 Some versions of XEmacs use different byte codes than Emacs. These
4465 incompatible byte codes can make Emacs crash when it tries to execute
4466 them. */);
4467 load_dangerous_libraries = 0;
4469 DEFVAR_BOOL ("force-load-messages", &force_load_messages,
4470 doc: /* Non-nil means force printing messages when loading Lisp files.
4471 This overrides the value of the NOMESSAGE argument to `load'. */);
4472 force_load_messages = 0;
4474 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
4475 doc: /* Regular expression matching safe to load compiled Lisp files.
4476 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4477 from the file, and matches them against this regular expression.
4478 When the regular expression matches, the file is considered to be safe
4479 to load. See also `load-dangerous-libraries'. */);
4480 Vbytecomp_version_regexp
4481 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4483 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
4484 doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4485 Veval_buffer_list = Qnil;
4487 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes,
4488 doc: /* Set to non-nil when `read' encounters an old-style backquote. */);
4489 Vold_style_backquotes = Qnil;
4490 Qold_style_backquotes = intern_c_string ("old-style-backquotes");
4491 staticpro (&Qold_style_backquotes);
4493 /* Vsource_directory was initialized in init_lread. */
4495 load_descriptor_list = Qnil;
4496 staticpro (&load_descriptor_list);
4498 Qcurrent_load_list = intern_c_string ("current-load-list");
4499 staticpro (&Qcurrent_load_list);
4501 Qstandard_input = intern_c_string ("standard-input");
4502 staticpro (&Qstandard_input);
4504 Qread_char = intern_c_string ("read-char");
4505 staticpro (&Qread_char);
4507 Qget_file_char = intern_c_string ("get-file-char");
4508 staticpro (&Qget_file_char);
4510 Qget_emacs_mule_file_char = intern_c_string ("get-emacs-mule-file-char");
4511 staticpro (&Qget_emacs_mule_file_char);
4513 Qload_force_doc_strings = intern_c_string ("load-force-doc-strings");
4514 staticpro (&Qload_force_doc_strings);
4516 Qbackquote = intern_c_string ("`");
4517 staticpro (&Qbackquote);
4518 Qcomma = intern_c_string (",");
4519 staticpro (&Qcomma);
4520 Qcomma_at = intern_c_string (",@");
4521 staticpro (&Qcomma_at);
4522 Qcomma_dot = intern_c_string (",.");
4523 staticpro (&Qcomma_dot);
4525 Qinhibit_file_name_operation = intern_c_string ("inhibit-file-name-operation");
4526 staticpro (&Qinhibit_file_name_operation);
4528 Qascii_character = intern_c_string ("ascii-character");
4529 staticpro (&Qascii_character);
4531 Qfunction = intern_c_string ("function");
4532 staticpro (&Qfunction);
4534 Qload = intern_c_string ("load");
4535 staticpro (&Qload);
4537 Qload_file_name = intern_c_string ("load-file-name");
4538 staticpro (&Qload_file_name);
4540 Qeval_buffer_list = intern_c_string ("eval-buffer-list");
4541 staticpro (&Qeval_buffer_list);
4543 Qfile_truename = intern_c_string ("file-truename");
4544 staticpro (&Qfile_truename) ;
4546 Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation");
4547 staticpro (&Qdo_after_load_evaluation) ;
4549 staticpro (&dump_path);
4551 staticpro (&read_objects);
4552 read_objects = Qnil;
4553 staticpro (&seen_list);
4554 seen_list = Qnil;
4556 Vloads_in_progress = Qnil;
4557 staticpro (&Vloads_in_progress);
4559 Qhash_table = intern_c_string ("hash-table");
4560 staticpro (&Qhash_table);
4561 Qdata = intern_c_string ("data");
4562 staticpro (&Qdata);
4563 Qtest = intern_c_string ("test");
4564 staticpro (&Qtest);
4565 Qsize = intern_c_string ("size");
4566 staticpro (&Qsize);
4567 Qweakness = intern_c_string ("weakness");
4568 staticpro (&Qweakness);
4569 Qrehash_size = intern_c_string ("rehash-size");
4570 staticpro (&Qrehash_size);
4571 Qrehash_threshold = intern_c_string ("rehash-threshold");
4572 staticpro (&Qrehash_threshold);
4575 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4576 (do not change this comment) */