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 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
31 #include "intervals.h"
33 #include "character.h"
39 #include "termhooks.h"
43 #include <sys/inode.h>
48 #include <unistd.h> /* to get X_OK */
65 #endif /* HAVE_SETLOCALE */
75 #define file_offset off_t
76 #define file_tell ftello
78 #define file_offset long
79 #define file_tell ftell
86 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
87 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
88 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
89 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
90 Lisp_Object Qinhibit_file_name_operation
;
91 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
92 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
94 /* Used instead of Qget_file_char while loading *.elc files compiled
95 by Emacs 21 or older. */
96 static Lisp_Object Qget_emacs_mule_file_char
;
98 static Lisp_Object Qload_force_doc_strings
;
100 extern Lisp_Object Qevent_symbol_element_mask
;
101 extern Lisp_Object Qfile_exists_p
;
103 /* non-zero iff inside `load' */
104 int load_in_progress
;
106 /* Directory in which the sources were found. */
107 Lisp_Object Vsource_directory
;
109 /* Search path and suffixes for files to be loaded. */
110 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
112 /* File name of user's init file. */
113 Lisp_Object Vuser_init_file
;
115 /* This is the user-visible association list that maps features to
116 lists of defs in their load files. */
117 Lisp_Object Vload_history
;
119 /* This is used to build the load history. */
120 Lisp_Object Vcurrent_load_list
;
122 /* List of files that were preloaded. */
123 Lisp_Object Vpreloaded_file_list
;
125 /* Name of file actually being read by `load'. */
126 Lisp_Object Vload_file_name
;
128 /* Function to use for reading, in `load' and friends. */
129 Lisp_Object Vload_read_function
;
131 /* The association list of objects read with the #n=object form.
132 Each member of the list has the form (n . object), and is used to
133 look up the object for the corresponding #n# construct.
134 It must be set to nil before all top-level calls to read0. */
135 Lisp_Object read_objects
;
137 /* Nonzero means load should forcibly load all dynamic doc strings. */
138 static int load_force_doc_strings
;
140 /* Nonzero means read should convert strings to unibyte. */
141 static int load_convert_to_unibyte
;
143 /* Nonzero means READCHAR should read bytes one by one (not character)
144 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
145 This is set to 1 by read1 temporarily while handling #@NUMBER. */
146 static int load_each_byte
;
148 /* Function to use for loading an Emacs Lisp source file (not
149 compiled) instead of readevalloop. */
150 Lisp_Object Vload_source_file_function
;
152 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
153 Lisp_Object Vbyte_boolean_vars
;
155 /* Whether or not to add a `read-positions' property to symbols
157 Lisp_Object Vread_with_symbol_positions
;
159 /* List of (SYMBOL . POSITION) accumulated so far. */
160 Lisp_Object Vread_symbol_positions_list
;
162 /* List of descriptors now open for Fload. */
163 static Lisp_Object load_descriptor_list
;
165 /* File for get_file_char to read from. Use by load. */
166 static FILE *instream
;
168 /* When nonzero, read conses in pure space */
169 static int read_pure
;
171 /* For use within read-from-string (this reader is non-reentrant!!) */
172 static int read_from_string_index
;
173 static int read_from_string_index_byte
;
174 static int read_from_string_limit
;
176 /* Number of characters read in the current call to Fread or
177 Fread_from_string. */
178 static int readchar_count
;
180 /* This contains the last string skipped with #@. */
181 static char *saved_doc_string
;
182 /* Length of buffer allocated in saved_doc_string. */
183 static int saved_doc_string_size
;
184 /* Length of actual data in saved_doc_string. */
185 static int saved_doc_string_length
;
186 /* This is the file position that string came from. */
187 static file_offset saved_doc_string_position
;
189 /* This contains the previous string skipped with #@.
190 We copy it from saved_doc_string when a new string
191 is put in saved_doc_string. */
192 static char *prev_saved_doc_string
;
193 /* Length of buffer allocated in prev_saved_doc_string. */
194 static int prev_saved_doc_string_size
;
195 /* Length of actual data in prev_saved_doc_string. */
196 static int prev_saved_doc_string_length
;
197 /* This is the file position that string came from. */
198 static file_offset prev_saved_doc_string_position
;
200 /* Nonzero means inside a new-style backquote
201 with no surrounding parentheses.
202 Fread initializes this to zero, so we need not specbind it
203 or worry about what happens to it when there is an error. */
204 static int new_backquote_flag
;
206 /* A list of file names for files being loaded in Fload. Used to
207 check for recursive loads. */
209 static Lisp_Object Vloads_in_progress
;
211 /* Non-zero means load dangerous compiled Lisp files. */
213 int load_dangerous_libraries
;
215 /* A regular expression used to detect files compiled with Emacs. */
217 static Lisp_Object Vbytecomp_version_regexp
;
219 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
222 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
223 Lisp_Object (*) (), int,
224 Lisp_Object
, Lisp_Object
,
225 Lisp_Object
, Lisp_Object
));
226 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
227 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
229 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
230 static void end_of_file_error
P_ (()) NO_RETURN
;
233 /* Functions that read one byte from the current source READCHARFUN
234 or unreads one byte. If the integer argument C is -1, it returns
235 one read byte, or -1 when there's no more byte in the source. If C
236 is 0 or positive, it unreads C, and the return value is not
239 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
240 static int readbyte_from_file
P_ ((int, Lisp_Object
));
241 static int readbyte_from_string
P_ ((int, Lisp_Object
));
243 /* Handle unreading and rereading of characters.
244 Write READCHAR to read a character,
245 UNREAD(c) to unread c to be read again.
247 These macros correctly read/unread multibyte characters. */
249 #define READCHAR readchar (readcharfun)
250 #define UNREAD(c) unreadchar (readcharfun, c)
252 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
253 Qlambda, or a cons, we use this to keep an unread character because
254 a file stream can't handle multibyte-char unreading. The value -1
255 means that there's no unread character. */
256 static int unread_char
;
259 readchar (readcharfun
)
260 Lisp_Object readcharfun
;
264 int (*readbyte
) P_ ((int, Lisp_Object
));
265 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
267 int emacs_mule_encoding
= 0;
271 if (BUFFERP (readcharfun
))
273 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
275 int pt_byte
= BUF_PT_BYTE (inbuffer
);
277 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
280 if (! NILP (inbuffer
->enable_multibyte_characters
))
282 /* Fetch the character code from the buffer. */
283 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
284 BUF_INC_POS (inbuffer
, pt_byte
);
285 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
289 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
290 if (! ASCII_BYTE_P (c
))
291 c
= BYTE8_TO_CHAR (c
);
294 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
298 if (MARKERP (readcharfun
))
300 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
302 int bytepos
= marker_byte_position (readcharfun
);
304 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
307 if (! NILP (inbuffer
->enable_multibyte_characters
))
309 /* Fetch the character code from the buffer. */
310 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
311 BUF_INC_POS (inbuffer
, bytepos
);
312 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
316 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
317 if (! ASCII_BYTE_P (c
))
318 c
= BYTE8_TO_CHAR (c
);
322 XMARKER (readcharfun
)->bytepos
= bytepos
;
323 XMARKER (readcharfun
)->charpos
++;
328 if (EQ (readcharfun
, Qlambda
))
330 readbyte
= readbyte_for_lambda
;
334 if (EQ (readcharfun
, Qget_file_char
))
336 readbyte
= readbyte_from_file
;
340 if (STRINGP (readcharfun
))
342 if (read_from_string_index
>= read_from_string_limit
)
345 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
346 read_from_string_index
,
347 read_from_string_index_byte
);
352 if (CONSP (readcharfun
))
354 /* This is the case that read_vector is reading from a unibyte
355 string that contains a byte sequence previously skipped
356 because of #@NUMBER. The car part of readcharfun is that
357 string, and the cdr part is a value of readcharfun given to
359 readbyte
= readbyte_from_string
;
360 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
361 emacs_mule_encoding
= 1;
365 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
367 readbyte
= readbyte_from_file
;
368 emacs_mule_encoding
= 1;
372 tem
= call0 (readcharfun
);
379 if (unread_char
>= 0)
385 c
= (*readbyte
) (-1, readcharfun
);
386 if (c
< 0 || ASCII_BYTE_P (c
) || load_each_byte
)
388 if (emacs_mule_encoding
)
389 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
392 len
= BYTES_BY_CHAR_HEAD (c
);
395 c
= (*readbyte
) (-1, readcharfun
);
396 if (c
< 0 || ! TRAILING_CODE_P (c
))
399 (*readbyte
) (buf
[i
], readcharfun
);
400 return BYTE8_TO_CHAR (buf
[0]);
404 return STRING_CHAR (buf
, i
);
407 /* Unread the character C in the way appropriate for the stream READCHARFUN.
408 If the stream is a user function, call it with the char as argument. */
411 unreadchar (readcharfun
, c
)
412 Lisp_Object readcharfun
;
417 /* Don't back up the pointer if we're unreading the end-of-input mark,
418 since readchar didn't advance it when we read it. */
420 else if (BUFFERP (readcharfun
))
422 struct buffer
*b
= XBUFFER (readcharfun
);
423 int bytepos
= BUF_PT_BYTE (b
);
426 if (! NILP (b
->enable_multibyte_characters
))
427 BUF_DEC_POS (b
, bytepos
);
431 BUF_PT_BYTE (b
) = bytepos
;
433 else if (MARKERP (readcharfun
))
435 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
436 int bytepos
= XMARKER (readcharfun
)->bytepos
;
438 XMARKER (readcharfun
)->charpos
--;
439 if (! NILP (b
->enable_multibyte_characters
))
440 BUF_DEC_POS (b
, bytepos
);
444 XMARKER (readcharfun
)->bytepos
= bytepos
;
446 else if (STRINGP (readcharfun
))
448 read_from_string_index
--;
449 read_from_string_index_byte
450 = string_char_to_byte (readcharfun
, read_from_string_index
);
452 else if (CONSP (readcharfun
))
456 else if (EQ (readcharfun
, Qlambda
))
460 else if (EQ (readcharfun
, Qget_file_char
)
461 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
464 ungetc (c
, instream
);
469 call1 (readcharfun
, make_number (c
));
473 readbyte_for_lambda (c
, readcharfun
)
475 Lisp_Object readcharfun
;
477 return read_bytecode_char (c
>= 0);
482 readbyte_from_file (c
, readcharfun
)
484 Lisp_Object readcharfun
;
488 ungetc (c
, instream
);
494 /* Interrupted reads have been observed while reading over the network */
495 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
502 return (c
== EOF
? -1 : c
);
506 readbyte_from_string (c
, readcharfun
)
508 Lisp_Object readcharfun
;
510 Lisp_Object string
= XCAR (readcharfun
);
514 read_from_string_index
--;
515 read_from_string_index_byte
516 = string_char_to_byte (string
, read_from_string_index
);
519 if (read_from_string_index
>= read_from_string_limit
)
522 FETCH_STRING_CHAR_ADVANCE (c
, string
,
523 read_from_string_index
,
524 read_from_string_index_byte
);
529 /* Read one non-ASCII character from INSTREAM. The character is
530 encoded in `emacs-mule' and the first byte is already read in
533 extern char emacs_mule_bytes
[256];
536 read_emacs_mule_char (c
, readbyte
, readcharfun
)
538 int (*readbyte
) P_ ((int, Lisp_Object
));
539 Lisp_Object readcharfun
;
541 /* Emacs-mule coding uses at most 4-byte for one character. */
542 unsigned char buf
[4];
543 int len
= emacs_mule_bytes
[c
];
544 struct charset
*charset
;
549 /* C is not a valid leading-code of `emacs-mule'. */
550 return BYTE8_TO_CHAR (c
);
556 c
= (*readbyte
) (-1, readcharfun
);
560 (*readbyte
) (buf
[i
], readcharfun
);
561 return BYTE8_TO_CHAR (buf
[0]);
568 charset
= emacs_mule_charset
[buf
[0]];
569 code
= buf
[1] & 0x7F;
573 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
574 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
576 charset
= emacs_mule_charset
[buf
[1]];
577 code
= buf
[2] & 0x7F;
581 charset
= emacs_mule_charset
[buf
[0]];
582 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
587 charset
= emacs_mule_charset
[buf
[1]];
588 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
590 c
= DECODE_CHAR (charset
, code
);
592 Fsignal (Qinvalid_read_syntax
,
593 Fcons (build_string ("invalid multibyte form"), Qnil
));
598 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
600 static Lisp_Object read0
P_ ((Lisp_Object
));
601 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
603 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
604 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
606 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
608 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
610 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
613 /* Get a character from the tty. */
615 extern Lisp_Object
read_char ();
617 /* Read input events until we get one that's acceptable for our purposes.
619 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
620 until we get a character we like, and then stuffed into
623 If ASCII_REQUIRED is non-zero, we check function key events to see
624 if the unmodified version of the symbol has a Qascii_character
625 property, and use that character, if present.
627 If ERROR_NONASCII is non-zero, we signal an error if the input we
628 get isn't an ASCII character with modifiers. If it's zero but
629 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
632 If INPUT_METHOD is nonzero, we invoke the current input method
633 if the character warrants that.
635 If SECONDS is a number, we wait that many seconds for input, and
636 return Qnil if no input arrives within that time. */
639 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
640 input_method
, seconds
)
641 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
644 Lisp_Object val
, delayed_switch_frame
;
647 #ifdef HAVE_WINDOW_SYSTEM
648 if (display_hourglass_p
)
652 delayed_switch_frame
= Qnil
;
654 /* Compute timeout. */
655 if (NUMBERP (seconds
))
657 EMACS_TIME wait_time
;
659 double duration
= extract_float (seconds
);
661 sec
= (int) duration
;
662 usec
= (duration
- sec
) * 1000000;
663 EMACS_GET_TIME (end_time
);
664 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
665 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
668 /* Read until we get an acceptable event. */
670 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
671 NUMBERP (seconds
) ? &end_time
: NULL
);
676 /* switch-frame events are put off until after the next ASCII
677 character. This is better than signaling an error just because
678 the last characters were typed to a separate minibuffer frame,
679 for example. Eventually, some code which can deal with
680 switch-frame events will read it and process it. */
682 && EVENT_HAS_PARAMETERS (val
)
683 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
685 delayed_switch_frame
= val
;
689 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
691 /* Convert certain symbols to their ASCII equivalents. */
694 Lisp_Object tem
, tem1
;
695 tem
= Fget (val
, Qevent_symbol_element_mask
);
698 tem1
= Fget (Fcar (tem
), Qascii_character
);
699 /* Merge this symbol's modifier bits
700 with the ASCII equivalent of its basic code. */
702 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
706 /* If we don't have a character now, deal with it appropriately. */
711 Vunread_command_events
= Fcons (val
, Qnil
);
712 error ("Non-character input-event");
719 if (! NILP (delayed_switch_frame
))
720 unread_switch_frame
= delayed_switch_frame
;
724 #ifdef HAVE_WINDOW_SYSTEM
725 if (display_hourglass_p
)
734 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
735 doc
: /* Read a character from the command input (keyboard or macro).
736 It is returned as a number.
737 If the user generates an event which is not a character (i.e. a mouse
738 click or function key event), `read-char' signals an error. As an
739 exception, switch-frame events are put off until non-ASCII events can
741 If you want to read non-character events, or ignore them, call
742 `read-event' or `read-char-exclusive' instead.
744 If the optional argument PROMPT is non-nil, display that as a prompt.
745 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
746 input method is turned on in the current buffer, that input method
747 is used for reading a character.
748 If the optional argument SECONDS is non-nil, it should be a number
749 specifying the maximum number of seconds to wait for input. If no
750 input arrives in that time, return nil. SECONDS may be a
751 floating-point value. */)
752 (prompt
, inherit_input_method
, seconds
)
753 Lisp_Object prompt
, inherit_input_method
, seconds
;
756 message_with_string ("%s", prompt
, 0);
757 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
760 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
761 doc
: /* Read an event object from the input stream.
762 If the optional argument PROMPT is non-nil, display that as a prompt.
763 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
764 input method is turned on in the current buffer, that input method
765 is used for reading a character.
766 If the optional argument SECONDS is non-nil, it should be a number
767 specifying the maximum number of seconds to wait for input. If no
768 input arrives in that time, return nil. SECONDS may be a
769 floating-point value. */)
770 (prompt
, inherit_input_method
, seconds
)
771 Lisp_Object prompt
, inherit_input_method
, seconds
;
774 message_with_string ("%s", prompt
, 0);
775 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
778 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
779 doc
: /* Read a character from the command input (keyboard or macro).
780 It is returned as a number. Non-character events are ignored.
782 If the optional argument PROMPT is non-nil, display that as a prompt.
783 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
784 input method is turned on in the current buffer, that input method
785 is used for reading a character.
786 If the optional argument SECONDS is non-nil, it should be a number
787 specifying the maximum number of seconds to wait for input. If no
788 input arrives in that time, return nil. SECONDS may be a
789 floating-point value. */)
790 (prompt
, inherit_input_method
, seconds
)
791 Lisp_Object prompt
, inherit_input_method
, seconds
;
794 message_with_string ("%s", prompt
, 0);
795 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
798 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
799 doc
: /* Don't use this yourself. */)
802 register Lisp_Object val
;
803 XSETINT (val
, getc (instream
));
809 /* Value is a version number of byte compiled code if the file
810 asswociated with file descriptor FD is a compiled Lisp file that's
811 safe to load. Only files compiled with Emacs are safe to load.
812 Files compiled with XEmacs can lead to a crash in Fbyte_code
813 because of an incompatible change in the byte compiler. */
824 /* Read the first few bytes from the file, and look for a line
825 specifying the byte compiler version used. */
826 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
831 /* Skip to the next newline, skipping over the initial `ELC'
832 with NUL bytes following it, but note the version. */
833 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
838 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
845 lseek (fd
, 0, SEEK_SET
);
850 /* Callback for record_unwind_protect. Restore the old load list OLD,
851 after loading a file successfully. */
854 record_load_unwind (old
)
857 return Vloads_in_progress
= old
;
860 /* This handler function is used via internal_condition_case_1. */
863 load_error_handler (data
)
869 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
870 doc
: /* Return the suffixes that `load' should try if a suffix is \
872 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
875 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
876 while (CONSP (suffixes
))
878 Lisp_Object exts
= Vload_file_rep_suffixes
;
879 suffix
= XCAR (suffixes
);
880 suffixes
= XCDR (suffixes
);
885 lst
= Fcons (concat2 (suffix
, ext
), lst
);
888 return Fnreverse (lst
);
891 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
892 doc
: /* Execute a file of Lisp code named FILE.
893 First try FILE with `.elc' appended, then try with `.el',
894 then try FILE unmodified (the exact suffixes in the exact order are
895 determined by `load-suffixes'). Environment variable references in
896 FILE are replaced with their values by calling `substitute-in-file-name'.
897 This function searches the directories in `load-path'.
899 If optional second arg NOERROR is non-nil,
900 report no error if FILE doesn't exist.
901 Print messages at start and end of loading unless
902 optional third arg NOMESSAGE is non-nil.
903 If optional fourth arg NOSUFFIX is non-nil, don't try adding
904 suffixes `.elc' or `.el' to the specified name FILE.
905 If optional fifth arg MUST-SUFFIX is non-nil, insist on
906 the suffix `.elc' or `.el'; don't accept just FILE unless
907 it ends in one of those suffixes or includes a directory name.
909 If this function fails to find a file, it may look for different
910 representations of that file before trying another file.
911 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
912 to the file name. Emacs uses this feature mainly to find compressed
913 versions of files when Auto Compression mode is enabled.
915 The exact suffixes that this function tries out, in the exact order,
916 are given by the value of the variable `load-file-rep-suffixes' if
917 NOSUFFIX is non-nil and by the return value of the function
918 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
919 MUST-SUFFIX are nil, this function first tries out the latter suffixes
922 Loading a file records its definitions, and its `provide' and
923 `require' calls, in an element of `load-history' whose
924 car is the file name loaded. See `load-history'.
926 Return t if the file exists and loads successfully. */)
927 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
928 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
930 register FILE *stream
;
931 register int fd
= -1;
932 int count
= SPECPDL_INDEX ();
934 struct gcpro gcpro1
, gcpro2
, gcpro3
;
935 Lisp_Object found
, efound
, hist_file_name
;
936 /* 1 means we printed the ".el is newer" message. */
938 /* 1 means we are loading a compiled file. */
952 /* If file name is magic, call the handler. */
953 /* This shouldn't be necessary any more now that `openp' handles it right.
954 handler = Ffind_file_name_handler (file, Qload);
956 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
958 /* Do this after the handler to avoid
959 the need to gcpro noerror, nomessage and nosuffix.
960 (Below here, we care only whether they are nil or not.)
961 The presence of this call is the result of a historical accident:
962 it used to be in every file-operation and when it got removed
963 everywhere, it accidentally stayed here. Since then, enough people
964 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
965 that it seemed risky to remove. */
966 if (! NILP (noerror
))
968 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
969 Qt
, load_error_handler
);
974 file
= Fsubstitute_in_file_name (file
);
977 /* Avoid weird lossage with null string as arg,
978 since it would try to load a directory as a Lisp file */
979 if (SCHARS (file
) > 0)
981 int size
= SBYTES (file
);
984 GCPRO2 (file
, found
);
986 if (! NILP (must_suffix
))
988 /* Don't insist on adding a suffix if FILE already ends with one. */
990 && !strcmp (SDATA (file
) + size
- 3, ".el"))
993 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
995 /* Don't insist on adding a suffix
996 if the argument includes a directory name. */
997 else if (! NILP (Ffile_name_directory (file
)))
1001 fd
= openp (Vload_path
, file
,
1002 (!NILP (nosuffix
) ? Qnil
1003 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1004 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1005 tmp
[1] = Vload_file_rep_suffixes
,
1014 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1018 /* Tell startup.el whether or not we found the user's init file. */
1019 if (EQ (Qt
, Vuser_init_file
))
1020 Vuser_init_file
= found
;
1022 /* If FD is -2, that means openp found a magic file. */
1025 if (NILP (Fequal (found
, file
)))
1026 /* If FOUND is a different file name from FILE,
1027 find its handler even if we have already inhibited
1028 the `load' operation on FILE. */
1029 handler
= Ffind_file_name_handler (found
, Qt
);
1031 handler
= Ffind_file_name_handler (found
, Qload
);
1032 if (! NILP (handler
))
1033 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1036 /* Check if we're stuck in a recursive load cycle.
1038 2000-09-21: It's not possible to just check for the file loaded
1039 being a member of Vloads_in_progress. This fails because of the
1040 way the byte compiler currently works; `provide's are not
1041 evaluted, see font-lock.el/jit-lock.el as an example. This
1042 leads to a certain amount of ``normal'' recursion.
1044 Also, just loading a file recursively is not always an error in
1045 the general case; the second load may do something different. */
1049 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1050 if (!NILP (Fequal (found
, XCAR (tem
))))
1056 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1058 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1059 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1062 /* Get the name for load-history. */
1063 hist_file_name
= (! NILP (Vpurify_flag
)
1064 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1065 tmp
[1] = Ffile_name_nondirectory (found
),
1070 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1072 || (version
= safe_to_load_p (fd
)) > 0)
1073 /* Load .elc files directly, but not when they are
1074 remote and have no handler! */
1081 GCPRO3 (file
, found
, hist_file_name
);
1084 && ! (version
= safe_to_load_p (fd
)))
1087 if (!load_dangerous_libraries
)
1091 error ("File `%s' was not compiled in Emacs",
1094 else if (!NILP (nomessage
))
1095 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1100 efound
= ENCODE_FILE (found
);
1105 stat ((char *)SDATA (efound
), &s1
);
1106 SSET (efound
, SBYTES (efound
) - 1, 0);
1107 result
= stat ((char *)SDATA (efound
), &s2
);
1108 SSET (efound
, SBYTES (efound
) - 1, 'c');
1110 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1112 /* Make the progress messages mention that source is newer. */
1115 /* If we won't print another message, mention this anyway. */
1116 if (!NILP (nomessage
))
1118 Lisp_Object msg_file
;
1119 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1120 message_with_string ("Source file `%s' newer than byte-compiled file",
1129 /* We are loading a source file (*.el). */
1130 if (!NILP (Vload_source_file_function
))
1136 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1137 NILP (noerror
) ? Qnil
: Qt
,
1138 NILP (nomessage
) ? Qnil
: Qt
);
1139 return unbind_to (count
, val
);
1143 GCPRO3 (file
, found
, hist_file_name
);
1147 efound
= ENCODE_FILE (found
);
1148 stream
= fopen ((char *) SDATA (efound
), fmode
);
1149 #else /* not WINDOWSNT */
1150 stream
= fdopen (fd
, fmode
);
1151 #endif /* not WINDOWSNT */
1155 error ("Failure to create stdio stream for %s", SDATA (file
));
1158 if (! NILP (Vpurify_flag
))
1159 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1161 if (NILP (nomessage
))
1164 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1167 message_with_string ("Loading %s (source)...", file
, 1);
1169 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1171 else /* The typical case; compiled file newer than source file. */
1172 message_with_string ("Loading %s...", file
, 1);
1175 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1176 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1177 specbind (Qload_file_name
, found
);
1178 specbind (Qinhibit_file_name_operation
, Qnil
);
1179 load_descriptor_list
1180 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1182 if (! version
|| version
>= 22)
1183 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1184 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1187 /* We can't handle a file which was compiled with
1188 byte-compile-dynamic by older version of Emacs. */
1189 specbind (Qload_force_doc_strings
, Qt
);
1190 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1191 0, Qnil
, Qnil
, Qnil
, Qnil
);
1193 unbind_to (count
, Qnil
);
1195 /* Run any eval-after-load forms for this file */
1196 if (NILP (Vpurify_flag
)
1197 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1198 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1202 if (saved_doc_string
)
1203 free (saved_doc_string
);
1204 saved_doc_string
= 0;
1205 saved_doc_string_size
= 0;
1207 if (prev_saved_doc_string
)
1208 xfree (prev_saved_doc_string
);
1209 prev_saved_doc_string
= 0;
1210 prev_saved_doc_string_size
= 0;
1212 if (!noninteractive
&& NILP (nomessage
))
1215 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1218 message_with_string ("Loading %s (source)...done", file
, 1);
1220 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1222 else /* The typical case; compiled file newer than source file. */
1223 message_with_string ("Loading %s...done", file
, 1);
1226 if (!NILP (Fequal (build_string ("obsolete"),
1227 Ffile_name_nondirectory
1228 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1229 message_with_string ("Package %s is obsolete", file
, 1);
1235 load_unwind (arg
) /* used as unwind-protect function in load */
1238 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1241 if (--load_in_progress
< 0) load_in_progress
= 0;
1246 load_descriptor_unwind (oldlist
)
1247 Lisp_Object oldlist
;
1249 load_descriptor_list
= oldlist
;
1253 /* Close all descriptors in use for Floads.
1254 This is used when starting a subprocess. */
1261 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1262 emacs_close (XFASTINT (XCAR (tail
)));
1267 complete_filename_p (pathname
)
1268 Lisp_Object pathname
;
1270 register const unsigned char *s
= SDATA (pathname
);
1271 return (IS_DIRECTORY_SEP (s
[0])
1272 || (SCHARS (pathname
) > 2
1273 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1283 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1284 doc
: /* Search for FILENAME through PATH.
1285 Returns the file's name in absolute form, or nil if not found.
1286 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1287 file name when searching.
1288 If non-nil, PREDICATE is used instead of `file-readable-p'.
1289 PREDICATE can also be an integer to pass to the access(2) function,
1290 in which case file-name-handlers are ignored. */)
1291 (filename
, path
, suffixes
, predicate
)
1292 Lisp_Object filename
, path
, suffixes
, predicate
;
1295 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1296 if (NILP (predicate
) && fd
> 0)
1302 /* Search for a file whose name is STR, looking in directories
1303 in the Lisp list PATH, and trying suffixes from SUFFIX.
1304 On success, returns a file descriptor. On failure, returns -1.
1306 SUFFIXES is a list of strings containing possible suffixes.
1307 The empty suffix is automatically added iff the list is empty.
1309 PREDICATE non-nil means don't open the files,
1310 just look for one that satisfies the predicate. In this case,
1311 returns 1 on success. The predicate can be a lisp function or
1312 an integer to pass to `access' (in which case file-name-handlers
1315 If STOREPTR is nonzero, it points to a slot where the name of
1316 the file actually found should be stored as a Lisp string.
1317 nil is stored there on failure.
1319 If the file we find is remote, return -2
1320 but store the found remote file name in *STOREPTR. */
1323 openp (path
, str
, suffixes
, storeptr
, predicate
)
1324 Lisp_Object path
, str
;
1325 Lisp_Object suffixes
;
1326 Lisp_Object
*storeptr
;
1327 Lisp_Object predicate
;
1332 register char *fn
= buf
;
1335 Lisp_Object filename
;
1337 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1338 Lisp_Object string
, tail
, encoded_fn
;
1339 int max_suffix_len
= 0;
1343 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1345 CHECK_STRING_CAR (tail
);
1346 max_suffix_len
= max (max_suffix_len
,
1347 SBYTES (XCAR (tail
)));
1350 string
= filename
= encoded_fn
= Qnil
;
1351 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1356 if (complete_filename_p (str
))
1359 for (; CONSP (path
); path
= XCDR (path
))
1361 filename
= Fexpand_file_name (str
, XCAR (path
));
1362 if (!complete_filename_p (filename
))
1363 /* If there are non-absolute elts in PATH (eg ".") */
1364 /* Of course, this could conceivably lose if luser sets
1365 default-directory to be something non-absolute... */
1367 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1368 if (!complete_filename_p (filename
))
1369 /* Give up on this path element! */
1373 /* Calculate maximum size of any filename made from
1374 this path element/specified file name and any possible suffix. */
1375 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1376 if (fn_size
< want_size
)
1377 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1379 /* Loop over suffixes. */
1380 for (tail
= NILP (suffixes
) ? Fcons (build_string (""), Qnil
) : suffixes
;
1381 CONSP (tail
); tail
= XCDR (tail
))
1383 int lsuffix
= SBYTES (XCAR (tail
));
1384 Lisp_Object handler
;
1387 /* Concatenate path element/specified name with the suffix.
1388 If the directory starts with /:, remove that. */
1389 if (SCHARS (filename
) > 2
1390 && SREF (filename
, 0) == '/'
1391 && SREF (filename
, 1) == ':')
1393 strncpy (fn
, SDATA (filename
) + 2,
1394 SBYTES (filename
) - 2);
1395 fn
[SBYTES (filename
) - 2] = 0;
1399 strncpy (fn
, SDATA (filename
),
1401 fn
[SBYTES (filename
)] = 0;
1404 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1405 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1407 /* Check that the file exists and is not a directory. */
1408 /* We used to only check for handlers on non-absolute file names:
1412 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1413 It's not clear why that was the case and it breaks things like
1414 (load "/bar.el") where the file is actually "/bar.el.gz". */
1415 string
= build_string (fn
);
1416 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1417 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1419 if (NILP (predicate
))
1420 exists
= !NILP (Ffile_readable_p (string
));
1422 exists
= !NILP (call1 (predicate
, string
));
1423 if (exists
&& !NILP (Ffile_directory_p (string
)))
1428 /* We succeeded; return this descriptor and filename. */
1439 encoded_fn
= ENCODE_FILE (string
);
1440 pfn
= SDATA (encoded_fn
);
1441 exists
= (stat (pfn
, &st
) >= 0
1442 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1445 /* Check that we can access or open it. */
1446 if (NATNUMP (predicate
))
1447 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1449 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1453 /* We succeeded; return this descriptor and filename. */
1471 /* Merge the list we've accumulated of globals from the current input source
1472 into the load_history variable. The details depend on whether
1473 the source has an associated file name or not.
1475 FILENAME is the file name that we are loading from.
1476 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1479 build_load_history (filename
, entire
)
1480 Lisp_Object filename
;
1483 register Lisp_Object tail
, prev
, newelt
;
1484 register Lisp_Object tem
, tem2
;
1485 register int foundit
= 0;
1487 tail
= Vload_history
;
1490 while (CONSP (tail
))
1494 /* Find the feature's previous assoc list... */
1495 if (!NILP (Fequal (filename
, Fcar (tem
))))
1499 /* If we're loading the entire file, remove old data. */
1503 Vload_history
= XCDR (tail
);
1505 Fsetcdr (prev
, XCDR (tail
));
1508 /* Otherwise, cons on new symbols that are not already members. */
1511 tem2
= Vcurrent_load_list
;
1513 while (CONSP (tem2
))
1515 newelt
= XCAR (tem2
);
1517 if (NILP (Fmember (newelt
, tem
)))
1518 Fsetcar (tail
, Fcons (XCAR (tem
),
1519 Fcons (newelt
, XCDR (tem
))));
1532 /* If we're loading an entire file, cons the new assoc onto the
1533 front of load-history, the most-recently-loaded position. Also
1534 do this if we didn't find an existing member for the file. */
1535 if (entire
|| !foundit
)
1536 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1541 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1549 readevalloop_1 (old
)
1552 load_convert_to_unibyte
= ! NILP (old
);
1556 /* Signal an `end-of-file' error, if possible with file name
1560 end_of_file_error ()
1564 if (STRINGP (Vload_file_name
))
1565 xsignal1 (Qend_of_file
, Vload_file_name
);
1567 xsignal0 (Qend_of_file
);
1570 /* UNIBYTE specifies how to set load_convert_to_unibyte
1571 for this invocation.
1572 READFUN, if non-nil, is used instead of `read'.
1574 START, END specify region to read in current buffer (from eval-region).
1575 If the input is not from a buffer, they must be nil. */
1578 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1579 printflag
, unibyte
, readfun
, start
, end
)
1580 Lisp_Object readcharfun
;
1582 Lisp_Object sourcename
;
1583 Lisp_Object (*evalfun
) ();
1585 Lisp_Object unibyte
, readfun
;
1586 Lisp_Object start
, end
;
1589 register Lisp_Object val
;
1590 int count
= SPECPDL_INDEX ();
1591 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1592 struct buffer
*b
= 0;
1593 int continue_reading_p
;
1594 /* Nonzero if reading an entire buffer. */
1595 int whole_buffer
= 0;
1596 /* 1 on the first time around. */
1599 if (MARKERP (readcharfun
))
1602 start
= readcharfun
;
1605 if (BUFFERP (readcharfun
))
1606 b
= XBUFFER (readcharfun
);
1607 else if (MARKERP (readcharfun
))
1608 b
= XMARKER (readcharfun
)->buffer
;
1610 /* We assume START is nil when input is not from a buffer. */
1611 if (! NILP (start
) && !b
)
1614 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1615 specbind (Qcurrent_load_list
, Qnil
);
1616 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1617 load_convert_to_unibyte
= !NILP (unibyte
);
1619 GCPRO4 (sourcename
, readfun
, start
, end
);
1621 /* Try to ensure sourcename is a truename, except whilst preloading. */
1622 if (NILP (Vpurify_flag
)
1623 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1624 && !NILP (Ffboundp (Qfile_truename
)))
1625 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1627 LOADHIST_ATTACH (sourcename
);
1629 continue_reading_p
= 1;
1630 while (continue_reading_p
)
1632 int count1
= SPECPDL_INDEX ();
1634 if (b
!= 0 && NILP (b
->name
))
1635 error ("Reading from killed buffer");
1639 /* Switch to the buffer we are reading from. */
1640 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1641 set_buffer_internal (b
);
1643 /* Save point in it. */
1644 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1645 /* Save ZV in it. */
1646 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1647 /* Those get unbound after we read one expression. */
1649 /* Set point and ZV around stuff to be read. */
1652 Fnarrow_to_region (make_number (BEGV
), end
);
1654 /* Just for cleanliness, convert END to a marker
1655 if it is an integer. */
1657 end
= Fpoint_max_marker ();
1660 /* On the first cycle, we can easily test here
1661 whether we are reading the whole buffer. */
1662 if (b
&& first_sexp
)
1663 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1670 while ((c
= READCHAR
) != '\n' && c
!= -1);
1675 unbind_to (count1
, Qnil
);
1679 /* Ignore whitespace here, so we can detect eof. */
1680 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1683 if (!NILP (Vpurify_flag
) && c
== '(')
1685 record_unwind_protect (unreadpure
, Qnil
);
1686 val
= read_list (-1, readcharfun
);
1691 read_objects
= Qnil
;
1692 if (!NILP (readfun
))
1694 val
= call1 (readfun
, readcharfun
);
1696 /* If READCHARFUN has set point to ZV, we should
1697 stop reading, even if the form read sets point
1698 to a different value when evaluated. */
1699 if (BUFFERP (readcharfun
))
1701 struct buffer
*b
= XBUFFER (readcharfun
);
1702 if (BUF_PT (b
) == BUF_ZV (b
))
1703 continue_reading_p
= 0;
1706 else if (! NILP (Vload_read_function
))
1707 val
= call1 (Vload_read_function
, readcharfun
);
1709 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1712 if (!NILP (start
) && continue_reading_p
)
1713 start
= Fpoint_marker ();
1715 /* Restore saved point and BEGV. */
1716 unbind_to (count1
, Qnil
);
1718 /* Now eval what we just read. */
1719 val
= (*evalfun
) (val
);
1723 Vvalues
= Fcons (val
, Vvalues
);
1724 if (EQ (Vstandard_output
, Qt
))
1733 build_load_history (sourcename
,
1734 stream
|| whole_buffer
);
1738 unbind_to (count
, Qnil
);
1741 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1742 doc
: /* Execute the current buffer as Lisp code.
1743 Programs can pass two arguments, BUFFER and PRINTFLAG.
1744 BUFFER is the buffer to evaluate (nil means use current buffer).
1745 PRINTFLAG controls printing of output:
1746 A value of nil means discard it; anything else is stream for print.
1748 If the optional third argument FILENAME is non-nil,
1749 it specifies the file name to use for `load-history'.
1750 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1751 for this invocation.
1753 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1754 `print' and related functions should work normally even if PRINTFLAG is nil.
1756 This function preserves the position of point. */)
1757 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1758 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1760 int count
= SPECPDL_INDEX ();
1761 Lisp_Object tem
, buf
;
1764 buf
= Fcurrent_buffer ();
1766 buf
= Fget_buffer (buffer
);
1768 error ("No such buffer");
1770 if (NILP (printflag
) && NILP (do_allow_print
))
1775 if (NILP (filename
))
1776 filename
= XBUFFER (buf
)->filename
;
1778 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1779 specbind (Qstandard_output
, tem
);
1780 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1781 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1782 readevalloop (buf
, 0, filename
, Feval
,
1783 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1784 unbind_to (count
, Qnil
);
1789 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1790 doc
: /* Execute the region as Lisp code.
1791 When called from programs, expects two arguments,
1792 giving starting and ending indices in the current buffer
1793 of the text to be executed.
1794 Programs can pass third argument PRINTFLAG which controls output:
1795 A value of nil means discard it; anything else is stream for printing it.
1796 Also the fourth argument READ-FUNCTION, if non-nil, is used
1797 instead of `read' to read each expression. It gets one argument
1798 which is the input stream for reading characters.
1800 This function does not move point. */)
1801 (start
, end
, printflag
, read_function
)
1802 Lisp_Object start
, end
, printflag
, read_function
;
1804 int count
= SPECPDL_INDEX ();
1805 Lisp_Object tem
, cbuf
;
1807 cbuf
= Fcurrent_buffer ();
1809 if (NILP (printflag
))
1813 specbind (Qstandard_output
, tem
);
1814 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1816 /* readevalloop calls functions which check the type of start and end. */
1817 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1818 !NILP (printflag
), Qnil
, read_function
,
1821 return unbind_to (count
, Qnil
);
1825 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1826 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1827 If STREAM is nil, use the value of `standard-input' (which see).
1828 STREAM or the value of `standard-input' may be:
1829 a buffer (read from point and advance it)
1830 a marker (read from where it points and advance it)
1831 a function (call it with no arguments for each character,
1832 call it with a char as argument to push a char back)
1833 a string (takes text from string, starting at the beginning)
1834 t (read text line using minibuffer and use it, or read from
1835 standard input in batch mode). */)
1840 stream
= Vstandard_input
;
1841 if (EQ (stream
, Qt
))
1842 stream
= Qread_char
;
1843 if (EQ (stream
, Qread_char
))
1844 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1846 return read_internal_start (stream
, Qnil
, Qnil
);
1849 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1850 doc
: /* Read one Lisp expression which is represented as text by STRING.
1851 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1852 START and END optionally delimit a substring of STRING from which to read;
1853 they default to 0 and (length STRING) respectively. */)
1854 (string
, start
, end
)
1855 Lisp_Object string
, start
, end
;
1858 CHECK_STRING (string
);
1859 /* read_internal_start sets read_from_string_index. */
1860 ret
= read_internal_start (string
, start
, end
);
1861 return Fcons (ret
, make_number (read_from_string_index
));
1864 /* Function to set up the global context we need in toplevel read
1867 read_internal_start (stream
, start
, end
)
1869 Lisp_Object start
; /* Only used when stream is a string. */
1870 Lisp_Object end
; /* Only used when stream is a string. */
1875 new_backquote_flag
= 0;
1876 read_objects
= Qnil
;
1877 if (EQ (Vread_with_symbol_positions
, Qt
)
1878 || EQ (Vread_with_symbol_positions
, stream
))
1879 Vread_symbol_positions_list
= Qnil
;
1881 if (STRINGP (stream
)
1882 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1884 int startval
, endval
;
1887 if (STRINGP (stream
))
1890 string
= XCAR (stream
);
1893 endval
= SCHARS (string
);
1897 endval
= XINT (end
);
1898 if (endval
< 0 || endval
> SCHARS (string
))
1899 args_out_of_range (string
, end
);
1906 CHECK_NUMBER (start
);
1907 startval
= XINT (start
);
1908 if (startval
< 0 || startval
> endval
)
1909 args_out_of_range (string
, start
);
1911 read_from_string_index
= startval
;
1912 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1913 read_from_string_limit
= endval
;
1916 retval
= read0 (stream
);
1917 if (EQ (Vread_with_symbol_positions
, Qt
)
1918 || EQ (Vread_with_symbol_positions
, stream
))
1919 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1924 /* Signal Qinvalid_read_syntax error.
1925 S is error string of length N (if > 0) */
1928 invalid_syntax (s
, n
)
1934 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1938 /* Use this for recursive reads, in contexts where internal tokens
1943 Lisp_Object readcharfun
;
1945 register Lisp_Object val
;
1948 val
= read1 (readcharfun
, &c
, 0);
1952 xsignal1 (Qinvalid_read_syntax
,
1953 Fmake_string (make_number (1), make_number (c
)));
1956 static int read_buffer_size
;
1957 static char *read_buffer
;
1959 /* Read a \-escape sequence, assuming we already read the `\'.
1960 If the escape sequence forces unibyte, return eight-bit char. */
1963 read_escape (readcharfun
, stringp
)
1964 Lisp_Object readcharfun
;
1967 register int c
= READCHAR
;
1968 /* \u allows up to four hex digits, \U up to eight. Default to the
1969 behaviour for \u, and change this value in the case that \U is seen. */
1970 int unicode_hex_count
= 4;
1975 end_of_file_error ();
2005 error ("Invalid escape character syntax");
2008 c
= read_escape (readcharfun
, 0);
2009 return c
| meta_modifier
;
2014 error ("Invalid escape character syntax");
2017 c
= read_escape (readcharfun
, 0);
2018 return c
| shift_modifier
;
2023 error ("Invalid escape character syntax");
2026 c
= read_escape (readcharfun
, 0);
2027 return c
| hyper_modifier
;
2032 error ("Invalid escape character syntax");
2035 c
= read_escape (readcharfun
, 0);
2036 return c
| alt_modifier
;
2047 c
= read_escape (readcharfun
, 0);
2048 return c
| super_modifier
;
2053 error ("Invalid escape character syntax");
2057 c
= read_escape (readcharfun
, 0);
2058 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2059 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2060 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2061 return c
| ctrl_modifier
;
2062 /* ASCII control chars are made from letters (both cases),
2063 as well as the non-letters within 0100...0137. */
2064 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2065 return (c
& (037 | ~0177));
2066 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2067 return (c
& (037 | ~0177));
2069 return c
| ctrl_modifier
;
2079 /* An octal escape, as in ANSI C. */
2081 register int i
= c
- '0';
2082 register int count
= 0;
2085 if ((c
= READCHAR
) >= '0' && c
<= '7')
2097 if (i
>= 0x80 && i
< 0x100)
2098 i
= BYTE8_TO_CHAR (i
);
2103 /* A hex escape, as in ANSI C. */
2110 if (c
>= '0' && c
<= '9')
2115 else if ((c
>= 'a' && c
<= 'f')
2116 || (c
>= 'A' && c
<= 'F'))
2119 if (c
>= 'a' && c
<= 'f')
2132 if (count
< 3 && i
>= 0x80)
2133 return BYTE8_TO_CHAR (i
);
2138 /* Post-Unicode-2.0: Up to eight hex chars. */
2139 unicode_hex_count
= 8;
2142 /* A Unicode escape. We only permit them in strings and characters,
2143 not arbitrarily in the source code, as in some other languages. */
2148 while (++count
<= unicode_hex_count
)
2151 /* isdigit and isalpha may be locale-specific, which we don't
2153 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2154 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2155 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2158 error ("Non-hex digit used for Unicode escape");
2171 /* Read an integer in radix RADIX using READCHARFUN to read
2172 characters. RADIX must be in the interval [2..36]; if it isn't, a
2173 read error is signaled . Value is the integer read. Signals an
2174 error if encountering invalid read syntax or if RADIX is out of
2178 read_integer (readcharfun
, radix
)
2179 Lisp_Object readcharfun
;
2182 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2183 EMACS_INT number
= 0;
2185 if (radix
< 2 || radix
> 36)
2189 number
= ndigits
= invalid_p
= 0;
2205 if (c
>= '0' && c
<= '9')
2207 else if (c
>= 'a' && c
<= 'z')
2208 digit
= c
- 'a' + 10;
2209 else if (c
>= 'A' && c
<= 'Z')
2210 digit
= c
- 'A' + 10;
2217 if (digit
< 0 || digit
>= radix
)
2220 number
= radix
* number
+ digit
;
2226 if (ndigits
== 0 || invalid_p
)
2229 sprintf (buf
, "integer, radix %d", radix
);
2230 invalid_syntax (buf
, 0);
2233 return make_number (sign
* number
);
2237 /* If the next token is ')' or ']' or '.', we store that character
2238 in *PCH and the return value is not interesting. Else, we store
2239 zero in *PCH and we read and return one lisp object.
2241 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2244 read1 (readcharfun
, pch
, first_in_list
)
2245 register Lisp_Object readcharfun
;
2250 int uninterned_symbol
= 0;
2259 end_of_file_error ();
2264 return read_list (0, readcharfun
);
2267 return read_vector (readcharfun
, 0);
2284 tmp
= read_vector (readcharfun
, 0);
2285 if (XVECTOR (tmp
)->size
< VECSIZE (struct Lisp_Char_Table
))
2286 error ("Invalid size char-table");
2287 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2298 tmp
= read_vector (readcharfun
, 0);
2299 if (!INTEGERP (AREF (tmp
, 0)))
2300 error ("Invalid depth in char-table");
2301 depth
= XINT (AREF (tmp
, 0));
2302 if (depth
< 1 || depth
> 3)
2303 error ("Invalid depth in char-table");
2304 size
= XVECTOR (tmp
)->size
- 2;
2305 if (chartab_size
[depth
] != size
)
2306 error ("Invalid size char-table");
2307 XSETSUB_CHAR_TABLE (tmp
, XSUB_CHAR_TABLE (tmp
));
2310 invalid_syntax ("#^^", 3);
2312 invalid_syntax ("#^", 2);
2317 length
= read1 (readcharfun
, pch
, first_in_list
);
2321 Lisp_Object tmp
, val
;
2323 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2324 / BOOL_VECTOR_BITS_PER_CHAR
);
2327 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2328 if (STRING_MULTIBYTE (tmp
)
2329 || (size_in_chars
!= SCHARS (tmp
)
2330 /* We used to print 1 char too many
2331 when the number of bits was a multiple of 8.
2332 Accept such input in case it came from an old
2334 && ! (XFASTINT (length
)
2335 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2336 invalid_syntax ("#&...", 5);
2338 val
= Fmake_bool_vector (length
, Qnil
);
2339 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2341 /* Clear the extraneous bits in the last byte. */
2342 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2343 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2344 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2347 invalid_syntax ("#&...", 5);
2351 /* Accept compiled functions at read-time so that we don't have to
2352 build them using function calls. */
2354 tmp
= read_vector (readcharfun
, 1);
2355 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2356 XVECTOR (tmp
)->contents
);
2361 struct gcpro gcpro1
;
2364 /* Read the string itself. */
2365 tmp
= read1 (readcharfun
, &ch
, 0);
2366 if (ch
!= 0 || !STRINGP (tmp
))
2367 invalid_syntax ("#", 1);
2369 /* Read the intervals and their properties. */
2372 Lisp_Object beg
, end
, plist
;
2374 beg
= read1 (readcharfun
, &ch
, 0);
2379 end
= read1 (readcharfun
, &ch
, 0);
2381 plist
= read1 (readcharfun
, &ch
, 0);
2383 invalid_syntax ("Invalid string property list", 0);
2384 Fset_text_properties (beg
, end
, plist
, tmp
);
2390 /* #@NUMBER is used to skip NUMBER following characters.
2391 That's used in .elc files to skip over doc strings
2392 and function definitions. */
2398 /* Read a decimal integer. */
2399 while ((c
= READCHAR
) >= 0
2400 && c
>= '0' && c
<= '9')
2408 if (load_force_doc_strings
2409 && (EQ (readcharfun
, Qget_file_char
)
2410 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2412 /* If we are supposed to force doc strings into core right now,
2413 record the last string that we skipped,
2414 and record where in the file it comes from. */
2416 /* But first exchange saved_doc_string
2417 with prev_saved_doc_string, so we save two strings. */
2419 char *temp
= saved_doc_string
;
2420 int temp_size
= saved_doc_string_size
;
2421 file_offset temp_pos
= saved_doc_string_position
;
2422 int temp_len
= saved_doc_string_length
;
2424 saved_doc_string
= prev_saved_doc_string
;
2425 saved_doc_string_size
= prev_saved_doc_string_size
;
2426 saved_doc_string_position
= prev_saved_doc_string_position
;
2427 saved_doc_string_length
= prev_saved_doc_string_length
;
2429 prev_saved_doc_string
= temp
;
2430 prev_saved_doc_string_size
= temp_size
;
2431 prev_saved_doc_string_position
= temp_pos
;
2432 prev_saved_doc_string_length
= temp_len
;
2435 if (saved_doc_string_size
== 0)
2437 saved_doc_string_size
= nskip
+ 100;
2438 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2440 if (nskip
> saved_doc_string_size
)
2442 saved_doc_string_size
= nskip
+ 100;
2443 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2444 saved_doc_string_size
);
2447 saved_doc_string_position
= file_tell (instream
);
2449 /* Copy that many characters into saved_doc_string. */
2450 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2451 saved_doc_string
[i
] = c
= READCHAR
;
2453 saved_doc_string_length
= i
;
2457 /* Skip that many characters. */
2458 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2467 /* #! appears at the beginning of an executable file.
2468 Skip the first line. */
2469 while (c
!= '\n' && c
>= 0)
2474 return Vload_file_name
;
2476 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2477 /* #:foo is the uninterned symbol named foo. */
2480 uninterned_symbol
= 1;
2484 /* Reader forms that can reuse previously read objects. */
2485 if (c
>= '0' && c
<= '9')
2490 /* Read a non-negative integer. */
2491 while (c
>= '0' && c
<= '9')
2497 /* #n=object returns object, but associates it with n for #n#. */
2500 /* Make a placeholder for #n# to use temporarily */
2501 Lisp_Object placeholder
;
2504 placeholder
= Fcons(Qnil
, Qnil
);
2505 cell
= Fcons (make_number (n
), placeholder
);
2506 read_objects
= Fcons (cell
, read_objects
);
2508 /* Read the object itself. */
2509 tem
= read0 (readcharfun
);
2511 /* Now put it everywhere the placeholder was... */
2512 substitute_object_in_subtree (tem
, placeholder
);
2514 /* ...and #n# will use the real value from now on. */
2515 Fsetcdr (cell
, tem
);
2519 /* #n# returns a previously read object. */
2522 tem
= Fassq (make_number (n
), read_objects
);
2525 /* Fall through to error message. */
2527 else if (c
== 'r' || c
== 'R')
2528 return read_integer (readcharfun
, n
);
2530 /* Fall through to error message. */
2532 else if (c
== 'x' || c
== 'X')
2533 return read_integer (readcharfun
, 16);
2534 else if (c
== 'o' || c
== 'O')
2535 return read_integer (readcharfun
, 8);
2536 else if (c
== 'b' || c
== 'B')
2537 return read_integer (readcharfun
, 2);
2540 invalid_syntax ("#", 1);
2543 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2548 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2558 new_backquote_flag
++;
2559 value
= read0 (readcharfun
);
2560 new_backquote_flag
--;
2562 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2566 if (new_backquote_flag
)
2568 Lisp_Object comma_type
= Qnil
;
2573 comma_type
= Qcomma_at
;
2575 comma_type
= Qcomma_dot
;
2578 if (ch
>= 0) UNREAD (ch
);
2579 comma_type
= Qcomma
;
2582 new_backquote_flag
--;
2583 value
= read0 (readcharfun
);
2584 new_backquote_flag
++;
2585 return Fcons (comma_type
, Fcons (value
, Qnil
));
2598 end_of_file_error ();
2600 /* Accept `single space' syntax like (list ? x) where the
2601 whitespace character is SPC or TAB.
2602 Other literal whitespace like NL, CR, and FF are not accepted,
2603 as there are well-established escape sequences for these. */
2604 if (c
== ' ' || c
== '\t')
2605 return make_number (c
);
2608 c
= read_escape (readcharfun
, 0);
2609 modifiers
= c
& CHAR_MODIFIER_MASK
;
2610 c
&= ~CHAR_MODIFIER_MASK
;
2611 if (CHAR_BYTE8_P (c
))
2612 c
= CHAR_TO_BYTE8 (c
);
2615 next_char
= READCHAR
;
2616 if (next_char
== '.')
2618 /* Only a dotted-pair dot is valid after a char constant. */
2619 int next_next_char
= READCHAR
;
2620 UNREAD (next_next_char
);
2622 ok
= (next_next_char
<= 040
2623 || (next_next_char
< 0200
2624 && (index ("\"';([#?", next_next_char
)
2625 || (!first_in_list
&& next_next_char
== '`')
2626 || (new_backquote_flag
&& next_next_char
== ','))));
2630 ok
= (next_char
<= 040
2631 || (next_char
< 0200
2632 && (index ("\"';()[]#?", next_char
)
2633 || (!first_in_list
&& next_char
== '`')
2634 || (new_backquote_flag
&& next_char
== ','))));
2638 return make_number (c
);
2640 invalid_syntax ("?", 1);
2645 char *p
= read_buffer
;
2646 char *end
= read_buffer
+ read_buffer_size
;
2648 /* Nonzero if we saw an escape sequence specifying
2649 a multibyte character. */
2650 int force_multibyte
= 0;
2651 /* Nonzero if we saw an escape sequence specifying
2652 a single-byte character. */
2653 int force_singlebyte
= 0;
2657 while ((c
= READCHAR
) >= 0
2660 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2662 int offset
= p
- read_buffer
;
2663 read_buffer
= (char *) xrealloc (read_buffer
,
2664 read_buffer_size
*= 2);
2665 p
= read_buffer
+ offset
;
2666 end
= read_buffer
+ read_buffer_size
;
2673 c
= read_escape (readcharfun
, 1);
2675 /* C is -1 if \ newline has just been seen */
2678 if (p
== read_buffer
)
2683 modifiers
= c
& CHAR_MODIFIER_MASK
;
2684 c
= c
& ~CHAR_MODIFIER_MASK
;
2686 if (CHAR_BYTE8_P (c
))
2687 force_singlebyte
= 1;
2688 else if (! ASCII_CHAR_P (c
))
2689 force_multibyte
= 1;
2690 else /* i.e. ASCII_CHAR_P (c) */
2692 /* Allow `\C- ' and `\C-?'. */
2693 if (modifiers
== CHAR_CTL
)
2696 c
= 0, modifiers
= 0;
2698 c
= 127, modifiers
= 0;
2700 if (modifiers
& CHAR_SHIFT
)
2702 /* Shift modifier is valid only with [A-Za-z]. */
2703 if (c
>= 'A' && c
<= 'Z')
2704 modifiers
&= ~CHAR_SHIFT
;
2705 else if (c
>= 'a' && c
<= 'z')
2706 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2709 if (modifiers
& CHAR_META
)
2711 /* Move the meta bit to the right place for a
2713 modifiers
&= ~CHAR_META
;
2714 c
= BYTE8_TO_CHAR (c
| 0x80);
2715 force_singlebyte
= 1;
2719 /* Any modifiers remaining are invalid. */
2721 error ("Invalid modifier in string");
2722 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2726 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2727 if (CHAR_BYTE8_P (c
))
2728 force_singlebyte
= 1;
2729 else if (! ASCII_CHAR_P (c
))
2730 force_multibyte
= 1;
2736 end_of_file_error ();
2738 /* If purifying, and string starts with \ newline,
2739 return zero instead. This is for doc strings
2740 that we are really going to find in etc/DOC.nn.nn */
2741 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2742 return make_number (0);
2744 if (force_multibyte
)
2745 /* READ_BUFFER already contains valid multibyte forms. */
2747 else if (force_singlebyte
)
2749 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2750 p
= read_buffer
+ nchars
;
2753 /* Otherwise, READ_BUFFER contains only ASCII. */
2756 /* We want readchar_count to be the number of characters, not
2757 bytes. Hence we adjust for multibyte characters in the
2758 string. ... But it doesn't seem to be necessary, because
2759 READCHAR *does* read multibyte characters from buffers. */
2760 /* readchar_count -= (p - read_buffer) - nchars; */
2762 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2764 || (p
- read_buffer
!= nchars
)));
2765 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2767 || (p
- read_buffer
!= nchars
)));
2772 int next_char
= READCHAR
;
2775 if (next_char
<= 040
2776 || (next_char
< 0200
2777 && (index ("\"';([#?", next_char
)
2778 || (!first_in_list
&& next_char
== '`')
2779 || (new_backquote_flag
&& next_char
== ','))))
2785 /* Otherwise, we fall through! Note that the atom-reading loop
2786 below will now loop at least once, assuring that we will not
2787 try to UNREAD two characters in a row. */
2791 if (c
<= 040) goto retry
;
2793 char *p
= read_buffer
;
2797 char *end
= read_buffer
+ read_buffer_size
;
2801 || (!index ("\"';()[]#", c
)
2802 && !(!first_in_list
&& c
== '`')
2803 && !(new_backquote_flag
&& c
== ','))))
2805 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2807 int offset
= p
- read_buffer
;
2808 read_buffer
= (char *) xrealloc (read_buffer
,
2809 read_buffer_size
*= 2);
2810 p
= read_buffer
+ offset
;
2811 end
= read_buffer
+ read_buffer_size
;
2818 end_of_file_error ();
2822 p
+= CHAR_STRING (c
, p
);
2828 int offset
= p
- read_buffer
;
2829 read_buffer
= (char *) xrealloc (read_buffer
,
2830 read_buffer_size
*= 2);
2831 p
= read_buffer
+ offset
;
2832 end
= read_buffer
+ read_buffer_size
;
2839 if (!quoted
&& !uninterned_symbol
)
2842 register Lisp_Object val
;
2844 if (*p1
== '+' || *p1
== '-') p1
++;
2845 /* Is it an integer? */
2848 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2849 /* Integers can have trailing decimal points. */
2850 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2852 /* It is an integer. */
2856 /* Fixme: if we have strtol, use that, and check
2858 if (sizeof (int) == sizeof (EMACS_INT
))
2859 XSETINT (val
, atoi (read_buffer
));
2860 else if (sizeof (long) == sizeof (EMACS_INT
))
2861 XSETINT (val
, atol (read_buffer
));
2867 if (isfloat_string (read_buffer
))
2869 /* Compute NaN and infinities using 0.0 in a variable,
2870 to cope with compilers that think they are smarter
2876 /* Negate the value ourselves. This treats 0, NaNs,
2877 and infinity properly on IEEE floating point hosts,
2878 and works around a common bug where atof ("-0.0")
2880 int negative
= read_buffer
[0] == '-';
2882 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2883 returns 1, is if the input ends in e+INF or e+NaN. */
2890 value
= zero
/ zero
;
2892 /* If that made a "negative" NaN, negate it. */
2896 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2899 u_minus_zero
.d
= - 0.0;
2900 for (i
= 0; i
< sizeof (double); i
++)
2901 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2907 /* Now VALUE is a positive NaN. */
2910 value
= atof (read_buffer
+ negative
);
2914 return make_float (negative
? - value
: value
);
2918 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2919 : intern (read_buffer
);
2920 if (EQ (Vread_with_symbol_positions
, Qt
)
2921 || EQ (Vread_with_symbol_positions
, readcharfun
))
2922 Vread_symbol_positions_list
=
2923 /* Kind of a hack; this will probably fail if characters
2924 in the symbol name were escaped. Not really a big
2926 Fcons (Fcons (result
,
2927 make_number (readchar_count
2928 - XFASTINT (Flength (Fsymbol_name (result
))))),
2929 Vread_symbol_positions_list
);
2937 /* List of nodes we've seen during substitute_object_in_subtree. */
2938 static Lisp_Object seen_list
;
2941 substitute_object_in_subtree (object
, placeholder
)
2943 Lisp_Object placeholder
;
2945 Lisp_Object check_object
;
2947 /* We haven't seen any objects when we start. */
2950 /* Make all the substitutions. */
2952 = substitute_object_recurse (object
, placeholder
, object
);
2954 /* Clear seen_list because we're done with it. */
2957 /* The returned object here is expected to always eq the
2959 if (!EQ (check_object
, object
))
2960 error ("Unexpected mutation error in reader");
2963 /* Feval doesn't get called from here, so no gc protection is needed. */
2964 #define SUBSTITUTE(get_val, set_val) \
2966 Lisp_Object old_value = get_val; \
2967 Lisp_Object true_value \
2968 = substitute_object_recurse (object, placeholder,\
2971 if (!EQ (old_value, true_value)) \
2978 substitute_object_recurse (object
, placeholder
, subtree
)
2980 Lisp_Object placeholder
;
2981 Lisp_Object subtree
;
2983 /* If we find the placeholder, return the target object. */
2984 if (EQ (placeholder
, subtree
))
2987 /* If we've been to this node before, don't explore it again. */
2988 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2991 /* If this node can be the entry point to a cycle, remember that
2992 we've seen it. It can only be such an entry point if it was made
2993 by #n=, which means that we can find it as a value in
2995 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2996 seen_list
= Fcons (subtree
, seen_list
);
2998 /* Recurse according to subtree's type.
2999 Every branch must return a Lisp_Object. */
3000 switch (XTYPE (subtree
))
3002 case Lisp_Vectorlike
:
3005 int length
= XINT (Flength(subtree
));
3006 for (i
= 0; i
< length
; i
++)
3008 Lisp_Object idx
= make_number (i
);
3009 SUBSTITUTE (Faref (subtree
, idx
),
3010 Faset (subtree
, idx
, true_value
));
3017 SUBSTITUTE (Fcar_safe (subtree
),
3018 Fsetcar (subtree
, true_value
));
3019 SUBSTITUTE (Fcdr_safe (subtree
),
3020 Fsetcdr (subtree
, true_value
));
3026 /* Check for text properties in each interval.
3027 substitute_in_interval contains part of the logic. */
3029 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3030 Lisp_Object arg
= Fcons (object
, placeholder
);
3032 traverse_intervals_noorder (root_interval
,
3033 &substitute_in_interval
, arg
);
3038 /* Other types don't recurse any further. */
3044 /* Helper function for substitute_object_recurse. */
3046 substitute_in_interval (interval
, arg
)
3050 Lisp_Object object
= Fcar (arg
);
3051 Lisp_Object placeholder
= Fcdr (arg
);
3053 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3072 if (*cp
== '+' || *cp
== '-')
3075 if (*cp
>= '0' && *cp
<= '9')
3078 while (*cp
>= '0' && *cp
<= '9')
3086 if (*cp
>= '0' && *cp
<= '9')
3089 while (*cp
>= '0' && *cp
<= '9')
3092 if (*cp
== 'e' || *cp
== 'E')
3096 if (*cp
== '+' || *cp
== '-')
3100 if (*cp
>= '0' && *cp
<= '9')
3103 while (*cp
>= '0' && *cp
<= '9')
3106 else if (cp
== start
)
3108 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3113 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3119 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3120 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3121 || state
== (DOT_CHAR
|TRAIL_INT
)
3122 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3123 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3124 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3129 read_vector (readcharfun
, bytecodeflag
)
3130 Lisp_Object readcharfun
;
3135 register Lisp_Object
*ptr
;
3136 register Lisp_Object tem
, item
, vector
;
3137 register struct Lisp_Cons
*otem
;
3140 tem
= read_list (1, readcharfun
);
3141 len
= Flength (tem
);
3142 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3144 size
= XVECTOR (vector
)->size
;
3145 ptr
= XVECTOR (vector
)->contents
;
3146 for (i
= 0; i
< size
; i
++)
3149 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3150 bytecode object, the docstring containing the bytecode and
3151 constants values must be treated as unibyte and passed to
3152 Fread, to get the actual bytecode string and constants vector. */
3153 if (bytecodeflag
&& load_force_doc_strings
)
3155 if (i
== COMPILED_BYTECODE
)
3157 if (!STRINGP (item
))
3158 error ("Invalid byte code");
3160 /* Delay handling the bytecode slot until we know whether
3161 it is lazily-loaded (we can tell by whether the
3162 constants slot is nil). */
3163 ptr
[COMPILED_CONSTANTS
] = item
;
3166 else if (i
== COMPILED_CONSTANTS
)
3168 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3172 /* Coerce string to unibyte (like string-as-unibyte,
3173 but without generating extra garbage and
3174 guaranteeing no change in the contents). */
3175 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3176 STRING_SET_UNIBYTE (bytestr
);
3178 item
= Fread (Fcons (bytestr
, readcharfun
));
3180 error ("Invalid byte code");
3182 otem
= XCONS (item
);
3183 bytestr
= XCAR (item
);
3188 /* Now handle the bytecode slot. */
3189 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3191 else if (i
== COMPILED_DOC_STRING
3193 && ! STRING_MULTIBYTE (item
))
3195 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3196 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3198 item
= Fstring_as_multibyte (item
);
3201 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3209 /* FLAG = 1 means check for ] to terminate rather than ) and .
3210 FLAG = -1 means check for starting with defun
3211 and make structure pure. */
3214 read_list (flag
, readcharfun
)
3216 register Lisp_Object readcharfun
;
3218 /* -1 means check next element for defun,
3219 0 means don't check,
3220 1 means already checked and found defun. */
3221 int defunflag
= flag
< 0 ? -1 : 0;
3222 Lisp_Object val
, tail
;
3223 register Lisp_Object elt
, tem
;
3224 struct gcpro gcpro1
, gcpro2
;
3225 /* 0 is the normal case.
3226 1 means this list is a doc reference; replace it with the number 0.
3227 2 means this list is a doc reference; replace it with the doc string. */
3228 int doc_reference
= 0;
3230 /* Initialize this to 1 if we are reading a list. */
3231 int first_in_list
= flag
<= 0;
3240 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3245 /* While building, if the list starts with #$, treat it specially. */
3246 if (EQ (elt
, Vload_file_name
)
3248 && !NILP (Vpurify_flag
))
3250 if (NILP (Vdoc_file_name
))
3251 /* We have not yet called Snarf-documentation, so assume
3252 this file is described in the DOC-MM.NN file
3253 and Snarf-documentation will fill in the right value later.
3254 For now, replace the whole list with 0. */
3257 /* We have already called Snarf-documentation, so make a relative
3258 file name for this file, so it can be found properly
3259 in the installed Lisp directory.
3260 We don't use Fexpand_file_name because that would make
3261 the directory absolute now. */
3262 elt
= concat2 (build_string ("../lisp/"),
3263 Ffile_name_nondirectory (elt
));
3265 else if (EQ (elt
, Vload_file_name
)
3267 && load_force_doc_strings
)
3276 invalid_syntax (") or . in a vector", 18);
3284 XSETCDR (tail
, read0 (readcharfun
));
3286 val
= read0 (readcharfun
);
3287 read1 (readcharfun
, &ch
, 0);
3291 if (doc_reference
== 1)
3292 return make_number (0);
3293 if (doc_reference
== 2)
3295 /* Get a doc string from the file we are loading.
3296 If it's in saved_doc_string, get it from there.
3298 Here, we don't know if the string is a
3299 bytecode string or a doc string. As a
3300 bytecode string must be unibyte, we always
3301 return a unibyte string. If it is actually a
3302 doc string, caller must make it
3305 int pos
= XINT (XCDR (val
));
3306 /* Position is negative for user variables. */
3307 if (pos
< 0) pos
= -pos
;
3308 if (pos
>= saved_doc_string_position
3309 && pos
< (saved_doc_string_position
3310 + saved_doc_string_length
))
3312 int start
= pos
- saved_doc_string_position
;
3315 /* Process quoting with ^A,
3316 and find the end of the string,
3317 which is marked with ^_ (037). */
3318 for (from
= start
, to
= start
;
3319 saved_doc_string
[from
] != 037;)
3321 int c
= saved_doc_string
[from
++];
3324 c
= saved_doc_string
[from
++];
3326 saved_doc_string
[to
++] = c
;
3328 saved_doc_string
[to
++] = 0;
3330 saved_doc_string
[to
++] = 037;
3333 saved_doc_string
[to
++] = c
;
3336 return make_unibyte_string (saved_doc_string
+ start
,
3339 /* Look in prev_saved_doc_string the same way. */
3340 else if (pos
>= prev_saved_doc_string_position
3341 && pos
< (prev_saved_doc_string_position
3342 + prev_saved_doc_string_length
))
3344 int start
= pos
- prev_saved_doc_string_position
;
3347 /* Process quoting with ^A,
3348 and find the end of the string,
3349 which is marked with ^_ (037). */
3350 for (from
= start
, to
= start
;
3351 prev_saved_doc_string
[from
] != 037;)
3353 int c
= prev_saved_doc_string
[from
++];
3356 c
= prev_saved_doc_string
[from
++];
3358 prev_saved_doc_string
[to
++] = c
;
3360 prev_saved_doc_string
[to
++] = 0;
3362 prev_saved_doc_string
[to
++] = 037;
3365 prev_saved_doc_string
[to
++] = c
;
3368 return make_unibyte_string (prev_saved_doc_string
3373 return get_doc_string (val
, 1, 0);
3378 invalid_syntax (". in wrong context", 18);
3380 invalid_syntax ("] in a list", 11);
3382 tem
= (read_pure
&& flag
<= 0
3383 ? pure_cons (elt
, Qnil
)
3384 : Fcons (elt
, Qnil
));
3386 XSETCDR (tail
, tem
);
3391 defunflag
= EQ (elt
, Qdefun
);
3392 else if (defunflag
> 0)
3397 Lisp_Object Vobarray
;
3398 Lisp_Object initial_obarray
;
3400 /* oblookup stores the bucket number here, for the sake of Funintern. */
3402 int oblookup_last_bucket_number
;
3404 static int hash_string ();
3406 /* Get an error if OBARRAY is not an obarray.
3407 If it is one, return it. */
3410 check_obarray (obarray
)
3411 Lisp_Object obarray
;
3413 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3415 /* If Vobarray is now invalid, force it to be valid. */
3416 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3417 wrong_type_argument (Qvectorp
, obarray
);
3422 /* Intern the C string STR: return a symbol with that name,
3423 interned in the current obarray. */
3430 int len
= strlen (str
);
3431 Lisp_Object obarray
;
3434 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3435 obarray
= check_obarray (obarray
);
3436 tem
= oblookup (obarray
, str
, len
, len
);
3439 return Fintern (make_string (str
, len
), obarray
);
3442 /* Create an uninterned symbol with name STR. */
3448 int len
= strlen (str
);
3450 return Fmake_symbol ((!NILP (Vpurify_flag
)
3451 ? make_pure_string (str
, len
, len
, 0)
3452 : make_string (str
, len
)));
3455 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3456 doc
: /* Return the canonical symbol whose name is STRING.
3457 If there is none, one is created by this function and returned.
3458 A second optional argument specifies the obarray to use;
3459 it defaults to the value of `obarray'. */)
3461 Lisp_Object string
, obarray
;
3463 register Lisp_Object tem
, sym
, *ptr
;
3465 if (NILP (obarray
)) obarray
= Vobarray
;
3466 obarray
= check_obarray (obarray
);
3468 CHECK_STRING (string
);
3470 tem
= oblookup (obarray
, SDATA (string
),
3473 if (!INTEGERP (tem
))
3476 if (!NILP (Vpurify_flag
))
3477 string
= Fpurecopy (string
);
3478 sym
= Fmake_symbol (string
);
3480 if (EQ (obarray
, initial_obarray
))
3481 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3483 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3485 if ((SREF (string
, 0) == ':')
3486 && EQ (obarray
, initial_obarray
))
3488 XSYMBOL (sym
)->constant
= 1;
3489 XSYMBOL (sym
)->value
= sym
;
3492 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3494 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3496 XSYMBOL (sym
)->next
= 0;
3501 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3502 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3503 NAME may be a string or a symbol. If it is a symbol, that exact
3504 symbol is searched for.
3505 A second optional argument specifies the obarray to use;
3506 it defaults to the value of `obarray'. */)
3508 Lisp_Object name
, obarray
;
3510 register Lisp_Object tem
, string
;
3512 if (NILP (obarray
)) obarray
= Vobarray
;
3513 obarray
= check_obarray (obarray
);
3515 if (!SYMBOLP (name
))
3517 CHECK_STRING (name
);
3521 string
= SYMBOL_NAME (name
);
3523 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3524 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3530 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3531 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3532 The value is t if a symbol was found and deleted, nil otherwise.
3533 NAME may be a string or a symbol. If it is a symbol, that symbol
3534 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3535 OBARRAY defaults to the value of the variable `obarray'. */)
3537 Lisp_Object name
, obarray
;
3539 register Lisp_Object string
, tem
;
3542 if (NILP (obarray
)) obarray
= Vobarray
;
3543 obarray
= check_obarray (obarray
);
3546 string
= SYMBOL_NAME (name
);
3549 CHECK_STRING (name
);
3553 tem
= oblookup (obarray
, SDATA (string
),
3558 /* If arg was a symbol, don't delete anything but that symbol itself. */
3559 if (SYMBOLP (name
) && !EQ (name
, tem
))
3562 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3563 XSYMBOL (tem
)->constant
= 0;
3564 XSYMBOL (tem
)->indirect_variable
= 0;
3566 hash
= oblookup_last_bucket_number
;
3568 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3570 if (XSYMBOL (tem
)->next
)
3571 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3573 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3577 Lisp_Object tail
, following
;
3579 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3580 XSYMBOL (tail
)->next
;
3583 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3584 if (EQ (following
, tem
))
3586 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3595 /* Return the symbol in OBARRAY whose names matches the string
3596 of SIZE characters (SIZE_BYTE bytes) at PTR.
3597 If there is no such symbol in OBARRAY, return nil.
3599 Also store the bucket number in oblookup_last_bucket_number. */
3602 oblookup (obarray
, ptr
, size
, size_byte
)
3603 Lisp_Object obarray
;
3604 register const char *ptr
;
3605 int size
, size_byte
;
3609 register Lisp_Object tail
;
3610 Lisp_Object bucket
, tem
;
3612 if (!VECTORP (obarray
)
3613 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3615 obarray
= check_obarray (obarray
);
3616 obsize
= XVECTOR (obarray
)->size
;
3618 /* This is sometimes needed in the middle of GC. */
3619 obsize
&= ~ARRAY_MARK_FLAG
;
3620 /* Combining next two lines breaks VMS C 2.3. */
3621 hash
= hash_string (ptr
, size_byte
);
3623 bucket
= XVECTOR (obarray
)->contents
[hash
];
3624 oblookup_last_bucket_number
= hash
;
3625 if (EQ (bucket
, make_number (0)))
3627 else if (!SYMBOLP (bucket
))
3628 error ("Bad data in guts of obarray"); /* Like CADR error message */
3630 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3632 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3633 && SCHARS (SYMBOL_NAME (tail
)) == size
3634 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3636 else if (XSYMBOL (tail
)->next
== 0)
3639 XSETINT (tem
, hash
);
3644 hash_string (ptr
, len
)
3645 const unsigned char *ptr
;
3648 register const unsigned char *p
= ptr
;
3649 register const unsigned char *end
= p
+ len
;
3650 register unsigned char c
;
3651 register int hash
= 0;
3656 if (c
>= 0140) c
-= 40;
3657 hash
= ((hash
<<3) + (hash
>>28) + c
);
3659 return hash
& 07777777777;
3663 map_obarray (obarray
, fn
, arg
)
3664 Lisp_Object obarray
;
3665 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3669 register Lisp_Object tail
;
3670 CHECK_VECTOR (obarray
);
3671 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3673 tail
= XVECTOR (obarray
)->contents
[i
];
3678 if (XSYMBOL (tail
)->next
== 0)
3680 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3686 mapatoms_1 (sym
, function
)
3687 Lisp_Object sym
, function
;
3689 call1 (function
, sym
);
3692 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3693 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3694 OBARRAY defaults to the value of `obarray'. */)
3696 Lisp_Object function
, obarray
;
3698 if (NILP (obarray
)) obarray
= Vobarray
;
3699 obarray
= check_obarray (obarray
);
3701 map_obarray (obarray
, mapatoms_1
, function
);
3705 #define OBARRAY_SIZE 1511
3710 Lisp_Object oblength
;
3714 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3716 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3717 Vobarray
= Fmake_vector (oblength
, make_number (0));
3718 initial_obarray
= Vobarray
;
3719 staticpro (&initial_obarray
);
3720 /* Intern nil in the obarray */
3721 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3722 XSYMBOL (Qnil
)->constant
= 1;
3724 /* These locals are to kludge around a pyramid compiler bug. */
3725 hash
= hash_string ("nil", 3);
3726 /* Separate statement here to avoid VAXC bug. */
3727 hash
%= OBARRAY_SIZE
;
3728 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3731 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3732 XSYMBOL (Qnil
)->function
= Qunbound
;
3733 XSYMBOL (Qunbound
)->value
= Qunbound
;
3734 XSYMBOL (Qunbound
)->function
= Qunbound
;
3737 XSYMBOL (Qnil
)->value
= Qnil
;
3738 XSYMBOL (Qnil
)->plist
= Qnil
;
3739 XSYMBOL (Qt
)->value
= Qt
;
3740 XSYMBOL (Qt
)->constant
= 1;
3742 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3745 Qvariable_documentation
= intern ("variable-documentation");
3746 staticpro (&Qvariable_documentation
);
3748 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3749 read_buffer
= (char *) xmalloc (read_buffer_size
);
3754 struct Lisp_Subr
*sname
;
3757 sym
= intern (sname
->symbol_name
);
3758 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3761 #ifdef NOTDEF /* use fset in subr.el now */
3763 defalias (sname
, string
)
3764 struct Lisp_Subr
*sname
;
3768 sym
= intern (string
);
3769 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3773 /* Define an "integer variable"; a symbol whose value is forwarded
3774 to a C variable of type int. Sample call: */
3775 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3777 defvar_int (namestring
, address
)
3781 Lisp_Object sym
, val
;
3782 sym
= intern (namestring
);
3783 val
= allocate_misc ();
3784 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3785 XINTFWD (val
)->intvar
= address
;
3786 SET_SYMBOL_VALUE (sym
, val
);
3789 /* Similar but define a variable whose value is t if address contains 1,
3790 nil if address contains 0 */
3792 defvar_bool (namestring
, address
)
3796 Lisp_Object sym
, val
;
3797 sym
= intern (namestring
);
3798 val
= allocate_misc ();
3799 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3800 XBOOLFWD (val
)->boolvar
= address
;
3801 SET_SYMBOL_VALUE (sym
, val
);
3802 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3805 /* Similar but define a variable whose value is the Lisp Object stored
3806 at address. Two versions: with and without gc-marking of the C
3807 variable. The nopro version is used when that variable will be
3808 gc-marked for some other reason, since marking the same slot twice
3809 can cause trouble with strings. */
3811 defvar_lisp_nopro (namestring
, address
)
3813 Lisp_Object
*address
;
3815 Lisp_Object sym
, val
;
3816 sym
= intern (namestring
);
3817 val
= allocate_misc ();
3818 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3819 XOBJFWD (val
)->objvar
= address
;
3820 SET_SYMBOL_VALUE (sym
, val
);
3824 defvar_lisp (namestring
, address
)
3826 Lisp_Object
*address
;
3828 defvar_lisp_nopro (namestring
, address
);
3829 staticpro (address
);
3832 /* Similar but define a variable whose value is the Lisp Object stored in
3833 the current buffer. address is the address of the slot in the buffer
3834 that is current now. */
3837 defvar_per_buffer (namestring
, address
, type
, doc
)
3839 Lisp_Object
*address
;
3843 Lisp_Object sym
, val
;
3846 sym
= intern (namestring
);
3847 val
= allocate_misc ();
3848 offset
= (char *)address
- (char *)current_buffer
;
3850 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3851 XBUFFER_OBJFWD (val
)->offset
= offset
;
3852 SET_SYMBOL_VALUE (sym
, val
);
3853 PER_BUFFER_SYMBOL (offset
) = sym
;
3854 PER_BUFFER_TYPE (offset
) = type
;
3856 if (PER_BUFFER_IDX (offset
) == 0)
3857 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3858 slot of buffer_local_flags */
3863 /* Similar but define a variable whose value is the Lisp Object stored
3864 at a particular offset in the current kboard object. */
3867 defvar_kboard (namestring
, offset
)
3871 Lisp_Object sym
, val
;
3872 sym
= intern (namestring
);
3873 val
= allocate_misc ();
3874 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3875 XKBOARD_OBJFWD (val
)->offset
= offset
;
3876 SET_SYMBOL_VALUE (sym
, val
);
3879 /* Record the value of load-path used at the start of dumping
3880 so we can see if the site changed it later during dumping. */
3881 static Lisp_Object dump_path
;
3887 int turn_off_warning
= 0;
3889 /* Compute the default load-path. */
3891 normal
= PATH_LOADSEARCH
;
3892 Vload_path
= decode_env_path (0, normal
);
3894 if (NILP (Vpurify_flag
))
3895 normal
= PATH_LOADSEARCH
;
3897 normal
= PATH_DUMPLOADSEARCH
;
3899 /* In a dumped Emacs, we normally have to reset the value of
3900 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3901 uses ../lisp, instead of the path of the installed elisp
3902 libraries. However, if it appears that Vload_path was changed
3903 from the default before dumping, don't override that value. */
3906 if (! NILP (Fequal (dump_path
, Vload_path
)))
3908 Vload_path
= decode_env_path (0, normal
);
3909 if (!NILP (Vinstallation_directory
))
3911 Lisp_Object tem
, tem1
, sitelisp
;
3913 /* Remove site-lisp dirs from path temporarily and store
3914 them in sitelisp, then conc them on at the end so
3915 they're always first in path. */
3919 tem
= Fcar (Vload_path
);
3920 tem1
= Fstring_match (build_string ("site-lisp"),
3924 Vload_path
= Fcdr (Vload_path
);
3925 sitelisp
= Fcons (tem
, sitelisp
);
3931 /* Add to the path the lisp subdir of the
3932 installation dir, if it exists. */
3933 tem
= Fexpand_file_name (build_string ("lisp"),
3934 Vinstallation_directory
);
3935 tem1
= Ffile_exists_p (tem
);
3938 if (NILP (Fmember (tem
, Vload_path
)))
3940 turn_off_warning
= 1;
3941 Vload_path
= Fcons (tem
, Vload_path
);
3945 /* That dir doesn't exist, so add the build-time
3946 Lisp dirs instead. */
3947 Vload_path
= nconc2 (Vload_path
, dump_path
);
3949 /* Add leim under the installation dir, if it exists. */
3950 tem
= Fexpand_file_name (build_string ("leim"),
3951 Vinstallation_directory
);
3952 tem1
= Ffile_exists_p (tem
);
3955 if (NILP (Fmember (tem
, Vload_path
)))
3956 Vload_path
= Fcons (tem
, Vload_path
);
3959 /* Add site-list under the installation dir, if it exists. */
3960 tem
= Fexpand_file_name (build_string ("site-lisp"),
3961 Vinstallation_directory
);
3962 tem1
= Ffile_exists_p (tem
);
3965 if (NILP (Fmember (tem
, Vload_path
)))
3966 Vload_path
= Fcons (tem
, Vload_path
);
3969 /* If Emacs was not built in the source directory,
3970 and it is run from where it was built, add to load-path
3971 the lisp, leim and site-lisp dirs under that directory. */
3973 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3977 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3978 Vinstallation_directory
);
3979 tem1
= Ffile_exists_p (tem
);
3981 /* Don't be fooled if they moved the entire source tree
3982 AFTER dumping Emacs. If the build directory is indeed
3983 different from the source dir, src/Makefile.in and
3984 src/Makefile will not be found together. */
3985 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3986 Vinstallation_directory
);
3987 tem2
= Ffile_exists_p (tem
);
3988 if (!NILP (tem1
) && NILP (tem2
))
3990 tem
= Fexpand_file_name (build_string ("lisp"),
3993 if (NILP (Fmember (tem
, Vload_path
)))
3994 Vload_path
= Fcons (tem
, Vload_path
);
3996 tem
= Fexpand_file_name (build_string ("leim"),
3999 if (NILP (Fmember (tem
, Vload_path
)))
4000 Vload_path
= Fcons (tem
, Vload_path
);
4002 tem
= Fexpand_file_name (build_string ("site-lisp"),
4005 if (NILP (Fmember (tem
, Vload_path
)))
4006 Vload_path
= Fcons (tem
, Vload_path
);
4009 if (!NILP (sitelisp
))
4010 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4016 /* NORMAL refers to the lisp dir in the source directory. */
4017 /* We used to add ../lisp at the front here, but
4018 that caused trouble because it was copied from dump_path
4019 into Vload_path, aboe, when Vinstallation_directory was non-nil.
4020 It should be unnecessary. */
4021 Vload_path
= decode_env_path (0, normal
);
4022 dump_path
= Vload_path
;
4026 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
4027 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4028 almost never correct, thereby causing a warning to be printed out that
4029 confuses users. Since PATH_LOADSEARCH is always overridden by the
4030 EMACSLOADPATH environment variable below, disable the warning on NT.
4031 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
4032 the "standard" paths may not exist and would be overridden by
4033 EMACSLOADPATH as on NT. Since this depends on how the executable
4034 was build and packaged, turn off the warnings in general */
4036 /* Warn if dirs in the *standard* path don't exist. */
4037 if (!turn_off_warning
)
4039 Lisp_Object path_tail
;
4041 for (path_tail
= Vload_path
;
4043 path_tail
= XCDR (path_tail
))
4045 Lisp_Object dirfile
;
4046 dirfile
= Fcar (path_tail
);
4047 if (STRINGP (dirfile
))
4049 dirfile
= Fdirectory_file_name (dirfile
);
4050 if (access (SDATA (dirfile
), 0) < 0)
4051 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4056 #endif /* !(WINDOWSNT || HAVE_CARBON) */
4058 /* If the EMACSLOADPATH environment variable is set, use its value.
4059 This doesn't apply if we're dumping. */
4061 if (NILP (Vpurify_flag
)
4062 && egetenv ("EMACSLOADPATH"))
4064 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4068 load_in_progress
= 0;
4069 Vload_file_name
= Qnil
;
4071 load_descriptor_list
= Qnil
;
4073 Vstandard_input
= Qt
;
4074 Vloads_in_progress
= Qnil
;
4077 /* Print a warning, using format string FORMAT, that directory DIRNAME
4078 does not exist. Print it on stderr and put it in *Message*. */
4081 dir_warning (format
, dirname
)
4083 Lisp_Object dirname
;
4086 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4088 fprintf (stderr
, format
, SDATA (dirname
));
4089 sprintf (buffer
, format
, SDATA (dirname
));
4090 /* Don't log the warning before we've initialized!! */
4092 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4099 defsubr (&Sread_from_string
);
4101 defsubr (&Sintern_soft
);
4102 defsubr (&Sunintern
);
4103 defsubr (&Sget_load_suffixes
);
4105 defsubr (&Seval_buffer
);
4106 defsubr (&Seval_region
);
4107 defsubr (&Sread_char
);
4108 defsubr (&Sread_char_exclusive
);
4109 defsubr (&Sread_event
);
4110 defsubr (&Sget_file_char
);
4111 defsubr (&Smapatoms
);
4112 defsubr (&Slocate_file_internal
);
4114 DEFVAR_LISP ("obarray", &Vobarray
,
4115 doc
: /* Symbol table for use by `intern' and `read'.
4116 It is a vector whose length ought to be prime for best results.
4117 The vector's contents don't make sense if examined from Lisp programs;
4118 to find all the symbols in an obarray, use `mapatoms'. */);
4120 DEFVAR_LISP ("values", &Vvalues
,
4121 doc
: /* List of values of all expressions which were read, evaluated and printed.
4122 Order is reverse chronological. */);
4124 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4125 doc
: /* Stream for read to get input from.
4126 See documentation of `read' for possible values. */);
4127 Vstandard_input
= Qt
;
4129 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4130 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4132 If this variable is a buffer, then only forms read from that buffer
4133 will be added to `read-symbol-positions-list'.
4134 If this variable is t, then all read forms will be added.
4135 The effect of all other values other than nil are not currently
4136 defined, although they may be in the future.
4138 The positions are relative to the last call to `read' or
4139 `read-from-string'. It is probably a bad idea to set this variable at
4140 the toplevel; bind it instead. */);
4141 Vread_with_symbol_positions
= Qnil
;
4143 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4144 doc
: /* A list mapping read symbols to their positions.
4145 This variable is modified during calls to `read' or
4146 `read-from-string', but only when `read-with-symbol-positions' is
4149 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4150 CHAR-POSITION is an integer giving the offset of that occurrence of the
4151 symbol from the position where `read' or `read-from-string' started.
4153 Note that a symbol will appear multiple times in this list, if it was
4154 read multiple times. The list is in the same order as the symbols
4156 Vread_symbol_positions_list
= Qnil
;
4158 DEFVAR_LISP ("load-path", &Vload_path
,
4159 doc
: /* *List of directories to search for files to load.
4160 Each element is a string (directory name) or nil (try default directory).
4161 Initialized based on EMACSLOADPATH environment variable, if any,
4162 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4164 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4165 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4166 This list should not include the empty string.
4167 `load' and related functions try to append these suffixes, in order,
4168 to the specified file name if a Lisp suffix is allowed or required. */);
4169 Vload_suffixes
= Fcons (build_string (".elc"),
4170 Fcons (build_string (".el"), Qnil
));
4171 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4172 doc
: /* List of suffixes that indicate representations of \
4174 This list should normally start with the empty string.
4176 Enabling Auto Compression mode appends the suffixes in
4177 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4178 mode removes them again. `load' and related functions use this list to
4179 determine whether they should look for compressed versions of a file
4180 and, if so, which suffixes they should try to append to the file name
4181 in order to do so. However, if you want to customize which suffixes
4182 the loading functions recognize as compression suffixes, you should
4183 customize `jka-compr-load-suffixes' rather than the present variable. */);
4184 /* We don't use empty_string because it's not initialized yet. */
4185 Vload_file_rep_suffixes
= Fcons (build_string (""), Qnil
);
4187 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4188 doc
: /* Non-nil iff inside of `load'. */);
4190 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4191 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4192 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4194 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4195 a symbol \(a feature name).
4197 When `load' is run and the file-name argument matches an element's
4198 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4199 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4201 An error in FORMS does not undo the load, but does prevent execution of
4202 the rest of the FORMS. */);
4203 Vafter_load_alist
= Qnil
;
4205 DEFVAR_LISP ("load-history", &Vload_history
,
4206 doc
: /* Alist mapping file names to symbols and features.
4207 Each alist element is a list that starts with a file name,
4208 except for one element (optional) that starts with nil and describes
4209 definitions evaluated from buffers not visiting files.
4211 The file name is absolute and is the true file name (i.e. it doesn't
4212 contain symbolic links) of the loaded file.
4214 The remaining elements of each list are symbols defined as variables
4215 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4216 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
4217 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
4218 and means that SYMBOL was an autoload before this file redefined it
4221 During preloading, the file name recorded is relative to the main Lisp
4222 directory. These file names are converted to absolute at startup. */);
4223 Vload_history
= Qnil
;
4225 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4226 doc
: /* Full name of file being loaded by `load'. */);
4227 Vload_file_name
= Qnil
;
4229 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4230 doc
: /* File name, including directory, of user's initialization file.
4231 If the file loaded had extension `.elc', and the corresponding source file
4232 exists, this variable contains the name of source file, suitable for use
4233 by functions like `custom-save-all' which edit the init file. */);
4234 Vuser_init_file
= Qnil
;
4236 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4237 doc
: /* Used for internal purposes by `load'. */);
4238 Vcurrent_load_list
= Qnil
;
4240 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4241 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4242 The default is nil, which means use the function `read'. */);
4243 Vload_read_function
= Qnil
;
4245 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4246 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4247 This function is for doing code conversion before reading the source file.
4248 If nil, loading is done without any code conversion.
4249 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4250 FULLNAME is the full name of FILE.
4251 See `load' for the meaning of the remaining arguments. */);
4252 Vload_source_file_function
= Qnil
;
4254 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4255 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4256 This is useful when the file being loaded is a temporary copy. */);
4257 load_force_doc_strings
= 0;
4259 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4260 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4261 This is normally bound by `load' and `eval-buffer' to control `read',
4262 and is not meant for users to change. */);
4263 load_convert_to_unibyte
= 0;
4265 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4266 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4267 You cannot count on them to still be there! */);
4269 = Fexpand_file_name (build_string ("../"),
4270 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4272 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4273 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4274 Vpreloaded_file_list
= Qnil
;
4276 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4277 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4278 Vbyte_boolean_vars
= Qnil
;
4280 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4281 doc
: /* Non-nil means load dangerous compiled Lisp files.
4282 Some versions of XEmacs use different byte codes than Emacs. These
4283 incompatible byte codes can make Emacs crash when it tries to execute
4285 load_dangerous_libraries
= 0;
4287 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4288 doc
: /* Regular expression matching safe to load compiled Lisp files.
4289 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4290 from the file, and matches them against this regular expression.
4291 When the regular expression matches, the file is considered to be safe
4292 to load. See also `load-dangerous-libraries'. */);
4293 Vbytecomp_version_regexp
4294 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4296 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4297 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4298 Veval_buffer_list
= Qnil
;
4300 /* Vsource_directory was initialized in init_lread. */
4302 load_descriptor_list
= Qnil
;
4303 staticpro (&load_descriptor_list
);
4305 Qcurrent_load_list
= intern ("current-load-list");
4306 staticpro (&Qcurrent_load_list
);
4308 Qstandard_input
= intern ("standard-input");
4309 staticpro (&Qstandard_input
);
4311 Qread_char
= intern ("read-char");
4312 staticpro (&Qread_char
);
4314 Qget_file_char
= intern ("get-file-char");
4315 staticpro (&Qget_file_char
);
4317 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4318 staticpro (&Qget_emacs_mule_file_char
);
4320 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4321 staticpro (&Qload_force_doc_strings
);
4323 Qbackquote
= intern ("`");
4324 staticpro (&Qbackquote
);
4325 Qcomma
= intern (",");
4326 staticpro (&Qcomma
);
4327 Qcomma_at
= intern (",@");
4328 staticpro (&Qcomma_at
);
4329 Qcomma_dot
= intern (",.");
4330 staticpro (&Qcomma_dot
);
4332 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4333 staticpro (&Qinhibit_file_name_operation
);
4335 Qascii_character
= intern ("ascii-character");
4336 staticpro (&Qascii_character
);
4338 Qfunction
= intern ("function");
4339 staticpro (&Qfunction
);
4341 Qload
= intern ("load");
4344 Qload_file_name
= intern ("load-file-name");
4345 staticpro (&Qload_file_name
);
4347 Qeval_buffer_list
= intern ("eval-buffer-list");
4348 staticpro (&Qeval_buffer_list
);
4350 Qfile_truename
= intern ("file-truename");
4351 staticpro (&Qfile_truename
) ;
4353 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4354 staticpro (&Qdo_after_load_evaluation
) ;
4356 staticpro (&dump_path
);
4358 staticpro (&read_objects
);
4359 read_objects
= Qnil
;
4360 staticpro (&seen_list
);
4363 Vloads_in_progress
= Qnil
;
4364 staticpro (&Vloads_in_progress
);
4367 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4368 (do not change this comment) */