1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
45 #include <unistd.h> /* to get X_OK */
62 #endif /* HAVE_SETLOCALE */
72 #define file_offset off_t
73 #define file_tell ftello
75 #define file_offset long
76 #define file_tell ftell
83 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
84 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
85 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
86 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
87 Lisp_Object Qinhibit_file_name_operation
;
88 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
89 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
91 /* Used instead of Qget_file_char while loading *.elc files compiled
92 by Emacs 21 or older. */
93 static Lisp_Object Qget_emacs_mule_file_char
;
95 static Lisp_Object Qload_force_doc_strings
;
97 extern Lisp_Object Qevent_symbol_element_mask
;
98 extern Lisp_Object Qfile_exists_p
;
100 /* non-zero if inside `load' */
101 int load_in_progress
;
102 static Lisp_Object Qload_in_progress
;
104 /* Directory in which the sources were found. */
105 Lisp_Object Vsource_directory
;
107 /* Search path and suffixes for files to be loaded. */
108 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
110 /* File name of user's init file. */
111 Lisp_Object Vuser_init_file
;
113 /* This is the user-visible association list that maps features to
114 lists of defs in their load files. */
115 Lisp_Object Vload_history
;
117 /* This is used to build the load history. */
118 Lisp_Object Vcurrent_load_list
;
120 /* List of files that were preloaded. */
121 Lisp_Object Vpreloaded_file_list
;
123 /* Name of file actually being read by `load'. */
124 Lisp_Object Vload_file_name
;
126 /* Function to use for reading, in `load' and friends. */
127 Lisp_Object Vload_read_function
;
129 /* Non-nil means read recursive structures using #n= and #n# syntax. */
130 Lisp_Object Vread_circle
;
132 /* The association list of objects read with the #n=object form.
133 Each member of the list has the form (n . object), and is used to
134 look up the object for the corresponding #n# construct.
135 It must be set to nil before all top-level calls to read0. */
136 Lisp_Object read_objects
;
138 /* Nonzero means load should forcibly load all dynamic doc strings. */
139 static int load_force_doc_strings
;
141 /* Nonzero means read should convert strings to unibyte. */
142 static int load_convert_to_unibyte
;
144 /* Nonzero means READCHAR should read bytes one by one (not character)
145 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
146 This is set to 1 by read1 temporarily while handling #@NUMBER. */
147 static int load_each_byte
;
149 /* Function to use for loading an Emacs Lisp source file (not
150 compiled) instead of readevalloop. */
151 Lisp_Object Vload_source_file_function
;
153 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
154 Lisp_Object Vbyte_boolean_vars
;
156 /* Whether or not to add a `read-positions' property to symbols
158 Lisp_Object Vread_with_symbol_positions
;
160 /* List of (SYMBOL . POSITION) accumulated so far. */
161 Lisp_Object Vread_symbol_positions_list
;
163 /* List of descriptors now open for Fload. */
164 static Lisp_Object load_descriptor_list
;
166 /* File for get_file_char to read from. Use by load. */
167 static FILE *instream
;
169 /* When nonzero, read conses in pure space */
170 static int read_pure
;
172 /* For use within read-from-string (this reader is non-reentrant!!) */
173 static int read_from_string_index
;
174 static int read_from_string_index_byte
;
175 static int read_from_string_limit
;
177 /* Number of characters read in the current call to Fread or
178 Fread_from_string. */
179 static int readchar_count
;
181 /* This contains the last string skipped with #@. */
182 static char *saved_doc_string
;
183 /* Length of buffer allocated in saved_doc_string. */
184 static int saved_doc_string_size
;
185 /* Length of actual data in saved_doc_string. */
186 static int saved_doc_string_length
;
187 /* This is the file position that string came from. */
188 static file_offset saved_doc_string_position
;
190 /* This contains the previous string skipped with #@.
191 We copy it from saved_doc_string when a new string
192 is put in saved_doc_string. */
193 static char *prev_saved_doc_string
;
194 /* Length of buffer allocated in prev_saved_doc_string. */
195 static int prev_saved_doc_string_size
;
196 /* Length of actual data in prev_saved_doc_string. */
197 static int prev_saved_doc_string_length
;
198 /* This is the file position that string came from. */
199 static file_offset prev_saved_doc_string_position
;
201 /* Nonzero means inside a new-style backquote
202 with no surrounding parentheses.
203 Fread initializes this to zero, so we need not specbind it
204 or worry about what happens to it when there is an error. */
205 static int new_backquote_flag
;
206 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
208 /* A list of file names for files being loaded in Fload. Used to
209 check for recursive loads. */
211 static Lisp_Object Vloads_in_progress
;
213 /* Non-zero means load dangerous compiled Lisp files. */
215 int load_dangerous_libraries
;
217 /* Non-zero means force printing messages when loading Lisp files. */
219 int force_load_messages
;
221 /* A regular expression used to detect files compiled with Emacs. */
223 static Lisp_Object Vbytecomp_version_regexp
;
225 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
228 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
229 Lisp_Object (*) (), int,
230 Lisp_Object
, Lisp_Object
,
231 Lisp_Object
, Lisp_Object
));
232 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
233 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
235 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
236 static void end_of_file_error
P_ (()) NO_RETURN
;
239 /* Functions that read one byte from the current source READCHARFUN
240 or unreads one byte. If the integer argument C is -1, it returns
241 one read byte, or -1 when there's no more byte in the source. If C
242 is 0 or positive, it unreads C, and the return value is not
245 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
246 static int readbyte_from_file
P_ ((int, Lisp_Object
));
247 static int readbyte_from_string
P_ ((int, Lisp_Object
));
249 /* Handle unreading and rereading of characters.
250 Write READCHAR to read a character,
251 UNREAD(c) to unread c to be read again.
253 These macros correctly read/unread multibyte characters. */
255 #define READCHAR readchar (readcharfun, NULL)
256 #define UNREAD(c) unreadchar (readcharfun, c)
258 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
259 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
261 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
262 Qlambda, or a cons, we use this to keep an unread character because
263 a file stream can't handle multibyte-char unreading. The value -1
264 means that there's no unread character. */
265 static int unread_char
;
268 readchar (readcharfun
, multibyte
)
269 Lisp_Object readcharfun
;
274 int (*readbyte
) P_ ((int, Lisp_Object
));
275 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
277 int emacs_mule_encoding
= 0;
284 if (BUFFERP (readcharfun
))
286 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
288 int pt_byte
= BUF_PT_BYTE (inbuffer
);
290 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
293 if (! NILP (inbuffer
->enable_multibyte_characters
))
295 /* Fetch the character code from the buffer. */
296 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
297 BUF_INC_POS (inbuffer
, pt_byte
);
298 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
304 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
305 if (! ASCII_BYTE_P (c
))
306 c
= BYTE8_TO_CHAR (c
);
309 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
313 if (MARKERP (readcharfun
))
315 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
317 int bytepos
= marker_byte_position (readcharfun
);
319 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
322 if (! NILP (inbuffer
->enable_multibyte_characters
))
324 /* Fetch the character code from the buffer. */
325 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
326 BUF_INC_POS (inbuffer
, bytepos
);
327 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
333 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
334 if (! ASCII_BYTE_P (c
))
335 c
= BYTE8_TO_CHAR (c
);
339 XMARKER (readcharfun
)->bytepos
= bytepos
;
340 XMARKER (readcharfun
)->charpos
++;
345 if (EQ (readcharfun
, Qlambda
))
347 readbyte
= readbyte_for_lambda
;
351 if (EQ (readcharfun
, Qget_file_char
))
353 readbyte
= readbyte_from_file
;
357 if (STRINGP (readcharfun
))
359 if (read_from_string_index
>= read_from_string_limit
)
361 else if (STRING_MULTIBYTE (readcharfun
))
365 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
366 read_from_string_index
,
367 read_from_string_index_byte
);
371 c
= SREF (readcharfun
, read_from_string_index_byte
);
372 read_from_string_index
++;
373 read_from_string_index_byte
++;
378 if (CONSP (readcharfun
))
380 /* This is the case that read_vector is reading from a unibyte
381 string that contains a byte sequence previously skipped
382 because of #@NUMBER. The car part of readcharfun is that
383 string, and the cdr part is a value of readcharfun given to
385 readbyte
= readbyte_from_string
;
386 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
387 emacs_mule_encoding
= 1;
391 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
393 readbyte
= readbyte_from_file
;
394 emacs_mule_encoding
= 1;
398 tem
= call0 (readcharfun
);
405 if (unread_char
>= 0)
411 c
= (*readbyte
) (-1, readcharfun
);
412 if (c
< 0 || load_each_byte
)
416 if (ASCII_BYTE_P (c
))
418 if (emacs_mule_encoding
)
419 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
422 len
= BYTES_BY_CHAR_HEAD (c
);
425 c
= (*readbyte
) (-1, readcharfun
);
426 if (c
< 0 || ! TRAILING_CODE_P (c
))
429 (*readbyte
) (buf
[i
], readcharfun
);
430 return BYTE8_TO_CHAR (buf
[0]);
434 return STRING_CHAR (buf
, i
);
437 /* Unread the character C in the way appropriate for the stream READCHARFUN.
438 If the stream is a user function, call it with the char as argument. */
441 unreadchar (readcharfun
, c
)
442 Lisp_Object readcharfun
;
447 /* Don't back up the pointer if we're unreading the end-of-input mark,
448 since readchar didn't advance it when we read it. */
450 else if (BUFFERP (readcharfun
))
452 struct buffer
*b
= XBUFFER (readcharfun
);
453 int bytepos
= BUF_PT_BYTE (b
);
456 if (! NILP (b
->enable_multibyte_characters
))
457 BUF_DEC_POS (b
, bytepos
);
461 BUF_PT_BYTE (b
) = bytepos
;
463 else if (MARKERP (readcharfun
))
465 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
466 int bytepos
= XMARKER (readcharfun
)->bytepos
;
468 XMARKER (readcharfun
)->charpos
--;
469 if (! NILP (b
->enable_multibyte_characters
))
470 BUF_DEC_POS (b
, bytepos
);
474 XMARKER (readcharfun
)->bytepos
= bytepos
;
476 else if (STRINGP (readcharfun
))
478 read_from_string_index
--;
479 read_from_string_index_byte
480 = string_char_to_byte (readcharfun
, read_from_string_index
);
482 else if (CONSP (readcharfun
))
486 else if (EQ (readcharfun
, Qlambda
))
490 else if (EQ (readcharfun
, Qget_file_char
)
491 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
496 ungetc (c
, instream
);
503 call1 (readcharfun
, make_number (c
));
507 readbyte_for_lambda (c
, readcharfun
)
509 Lisp_Object readcharfun
;
511 return read_bytecode_char (c
>= 0);
516 readbyte_from_file (c
, readcharfun
)
518 Lisp_Object readcharfun
;
523 ungetc (c
, instream
);
532 /* Interrupted reads have been observed while reading over the network */
533 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
545 return (c
== EOF
? -1 : c
);
549 readbyte_from_string (c
, readcharfun
)
551 Lisp_Object readcharfun
;
553 Lisp_Object string
= XCAR (readcharfun
);
557 read_from_string_index
--;
558 read_from_string_index_byte
559 = string_char_to_byte (string
, read_from_string_index
);
562 if (read_from_string_index
>= read_from_string_limit
)
565 FETCH_STRING_CHAR_ADVANCE (c
, string
,
566 read_from_string_index
,
567 read_from_string_index_byte
);
572 /* Read one non-ASCII character from INSTREAM. The character is
573 encoded in `emacs-mule' and the first byte is already read in
576 extern char emacs_mule_bytes
[256];
579 read_emacs_mule_char (c
, readbyte
, readcharfun
)
581 int (*readbyte
) P_ ((int, Lisp_Object
));
582 Lisp_Object readcharfun
;
584 /* Emacs-mule coding uses at most 4-byte for one character. */
585 unsigned char buf
[4];
586 int len
= emacs_mule_bytes
[c
];
587 struct charset
*charset
;
592 /* C is not a valid leading-code of `emacs-mule'. */
593 return BYTE8_TO_CHAR (c
);
599 c
= (*readbyte
) (-1, readcharfun
);
603 (*readbyte
) (buf
[i
], readcharfun
);
604 return BYTE8_TO_CHAR (buf
[0]);
611 charset
= emacs_mule_charset
[buf
[0]];
612 code
= buf
[1] & 0x7F;
616 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
617 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
619 charset
= emacs_mule_charset
[buf
[1]];
620 code
= buf
[2] & 0x7F;
624 charset
= emacs_mule_charset
[buf
[0]];
625 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
630 charset
= emacs_mule_charset
[buf
[1]];
631 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
633 c
= DECODE_CHAR (charset
, code
);
635 Fsignal (Qinvalid_read_syntax
,
636 Fcons (build_string ("invalid multibyte form"), Qnil
));
641 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
643 static Lisp_Object read0
P_ ((Lisp_Object
));
644 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
646 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
647 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
649 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
651 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
653 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
656 /* Get a character from the tty. */
658 /* Read input events until we get one that's acceptable for our purposes.
660 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
661 until we get a character we like, and then stuffed into
664 If ASCII_REQUIRED is non-zero, we check function key events to see
665 if the unmodified version of the symbol has a Qascii_character
666 property, and use that character, if present.
668 If ERROR_NONASCII is non-zero, we signal an error if the input we
669 get isn't an ASCII character with modifiers. If it's zero but
670 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
673 If INPUT_METHOD is nonzero, we invoke the current input method
674 if the character warrants that.
676 If SECONDS is a number, we wait that many seconds for input, and
677 return Qnil if no input arrives within that time. */
680 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
681 input_method
, seconds
)
682 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
685 Lisp_Object val
, delayed_switch_frame
;
688 #ifdef HAVE_WINDOW_SYSTEM
689 if (display_hourglass_p
)
693 delayed_switch_frame
= Qnil
;
695 /* Compute timeout. */
696 if (NUMBERP (seconds
))
698 EMACS_TIME wait_time
;
700 double duration
= extract_float (seconds
);
702 sec
= (int) duration
;
703 usec
= (duration
- sec
) * 1000000;
704 EMACS_GET_TIME (end_time
);
705 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
706 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
709 /* Read until we get an acceptable event. */
712 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
713 NUMBERP (seconds
) ? &end_time
: NULL
);
714 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
719 /* switch-frame events are put off until after the next ASCII
720 character. This is better than signaling an error just because
721 the last characters were typed to a separate minibuffer frame,
722 for example. Eventually, some code which can deal with
723 switch-frame events will read it and process it. */
725 && EVENT_HAS_PARAMETERS (val
)
726 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
728 delayed_switch_frame
= val
;
732 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
734 /* Convert certain symbols to their ASCII equivalents. */
737 Lisp_Object tem
, tem1
;
738 tem
= Fget (val
, Qevent_symbol_element_mask
);
741 tem1
= Fget (Fcar (tem
), Qascii_character
);
742 /* Merge this symbol's modifier bits
743 with the ASCII equivalent of its basic code. */
745 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
749 /* If we don't have a character now, deal with it appropriately. */
754 Vunread_command_events
= Fcons (val
, Qnil
);
755 error ("Non-character input-event");
762 if (! NILP (delayed_switch_frame
))
763 unread_switch_frame
= delayed_switch_frame
;
767 #ifdef HAVE_WINDOW_SYSTEM
768 if (display_hourglass_p
)
777 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
778 doc
: /* Read a character from the command input (keyboard or macro).
779 It is returned as a number.
780 If the character has modifiers, they are resolved and reflected to the
781 character code if possible (e.g. C-SPC -> 0).
783 If the user generates an event which is not a character (i.e. a mouse
784 click or function key event), `read-char' signals an error. As an
785 exception, switch-frame events are put off until non-character events
787 If you want to read non-character events, or ignore them, call
788 `read-event' or `read-char-exclusive' instead.
790 If the optional argument PROMPT is non-nil, display that as a prompt.
791 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
792 input method is turned on in the current buffer, that input method
793 is used for reading a character.
794 If the optional argument SECONDS is non-nil, it should be a number
795 specifying the maximum number of seconds to wait for input. If no
796 input arrives in that time, return nil. SECONDS may be a
797 floating-point value. */)
798 (prompt
, inherit_input_method
, seconds
)
799 Lisp_Object prompt
, inherit_input_method
, seconds
;
804 message_with_string ("%s", prompt
, 0);
805 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
807 return (NILP (val
) ? Qnil
808 : make_number (char_resolve_modifier_mask (XINT (val
))));
811 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
812 doc
: /* Read an event object from the input stream.
813 If the optional argument PROMPT is non-nil, display that as a prompt.
814 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
815 input method is turned on in the current buffer, that input method
816 is used for reading a character.
817 If the optional argument SECONDS is non-nil, it should be a number
818 specifying the maximum number of seconds to wait for input. If no
819 input arrives in that time, return nil. SECONDS may be a
820 floating-point value. */)
821 (prompt
, inherit_input_method
, seconds
)
822 Lisp_Object prompt
, inherit_input_method
, seconds
;
825 message_with_string ("%s", prompt
, 0);
826 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
829 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
830 doc
: /* Read a character from the command input (keyboard or macro).
831 It is returned as a number. Non-character events are ignored.
832 If the character has modifiers, they are resolved and reflected to the
833 character code if possible (e.g. C-SPC -> 0).
835 If the optional argument PROMPT is non-nil, display that as a prompt.
836 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
837 input method is turned on in the current buffer, that input method
838 is used for reading a character.
839 If the optional argument SECONDS is non-nil, it should be a number
840 specifying the maximum number of seconds to wait for input. If no
841 input arrives in that time, return nil. SECONDS may be a
842 floating-point value. */)
843 (prompt
, inherit_input_method
, seconds
)
844 Lisp_Object prompt
, inherit_input_method
, seconds
;
849 message_with_string ("%s", prompt
, 0);
851 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
853 return (NILP (val
) ? Qnil
854 : make_number (char_resolve_modifier_mask (XINT (val
))));
857 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
858 doc
: /* Don't use this yourself. */)
861 register Lisp_Object val
;
863 XSETINT (val
, getc (instream
));
870 /* Value is a version number of byte compiled code if the file
871 associated with file descriptor FD is a compiled Lisp file that's
872 safe to load. Only files compiled with Emacs are safe to load.
873 Files compiled with XEmacs can lead to a crash in Fbyte_code
874 because of an incompatible change in the byte compiler. */
885 /* Read the first few bytes from the file, and look for a line
886 specifying the byte compiler version used. */
887 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
892 /* Skip to the next newline, skipping over the initial `ELC'
893 with NUL bytes following it, but note the version. */
894 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
899 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
906 lseek (fd
, 0, SEEK_SET
);
911 /* Callback for record_unwind_protect. Restore the old load list OLD,
912 after loading a file successfully. */
915 record_load_unwind (old
)
918 return Vloads_in_progress
= old
;
921 /* This handler function is used via internal_condition_case_1. */
924 load_error_handler (data
)
931 load_warn_old_style_backquotes (file
)
934 if (!NILP (Vold_style_backquotes
))
937 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
944 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
945 doc
: /* Return the suffixes that `load' should try if a suffix is \
947 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
950 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
951 while (CONSP (suffixes
))
953 Lisp_Object exts
= Vload_file_rep_suffixes
;
954 suffix
= XCAR (suffixes
);
955 suffixes
= XCDR (suffixes
);
960 lst
= Fcons (concat2 (suffix
, ext
), lst
);
963 return Fnreverse (lst
);
966 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
967 doc
: /* Execute a file of Lisp code named FILE.
968 First try FILE with `.elc' appended, then try with `.el',
969 then try FILE unmodified (the exact suffixes in the exact order are
970 determined by `load-suffixes'). Environment variable references in
971 FILE are replaced with their values by calling `substitute-in-file-name'.
972 This function searches the directories in `load-path'.
974 If optional second arg NOERROR is non-nil,
975 report no error if FILE doesn't exist.
976 Print messages at start and end of loading unless
977 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
979 If optional fourth arg NOSUFFIX is non-nil, don't try adding
980 suffixes `.elc' or `.el' to the specified name FILE.
981 If optional fifth arg MUST-SUFFIX is non-nil, insist on
982 the suffix `.elc' or `.el'; don't accept just FILE unless
983 it ends in one of those suffixes or includes a directory name.
985 If this function fails to find a file, it may look for different
986 representations of that file before trying another file.
987 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
988 to the file name. Emacs uses this feature mainly to find compressed
989 versions of files when Auto Compression mode is enabled.
991 The exact suffixes that this function tries out, in the exact order,
992 are given by the value of the variable `load-file-rep-suffixes' if
993 NOSUFFIX is non-nil and by the return value of the function
994 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
995 MUST-SUFFIX are nil, this function first tries out the latter suffixes
998 Loading a file records its definitions, and its `provide' and
999 `require' calls, in an element of `load-history' whose
1000 car is the file name loaded. See `load-history'.
1002 Return t if the file exists and loads successfully. */)
1003 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
1004 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
1006 register FILE *stream
;
1007 register int fd
= -1;
1008 int count
= SPECPDL_INDEX ();
1009 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1010 Lisp_Object found
, efound
, hist_file_name
;
1011 /* 1 means we printed the ".el is newer" message. */
1013 /* 1 means we are loading a compiled file. */
1015 Lisp_Object handler
;
1025 CHECK_STRING (file
);
1027 /* If file name is magic, call the handler. */
1028 /* This shouldn't be necessary any more now that `openp' handles it right.
1029 handler = Ffind_file_name_handler (file, Qload);
1030 if (!NILP (handler))
1031 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1033 /* Do this after the handler to avoid
1034 the need to gcpro noerror, nomessage and nosuffix.
1035 (Below here, we care only whether they are nil or not.)
1036 The presence of this call is the result of a historical accident:
1037 it used to be in every file-operation and when it got removed
1038 everywhere, it accidentally stayed here. Since then, enough people
1039 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1040 that it seemed risky to remove. */
1041 if (! NILP (noerror
))
1043 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1044 Qt
, load_error_handler
);
1049 file
= Fsubstitute_in_file_name (file
);
1052 /* Avoid weird lossage with null string as arg,
1053 since it would try to load a directory as a Lisp file */
1054 if (SCHARS (file
) > 0)
1056 int size
= SBYTES (file
);
1059 GCPRO2 (file
, found
);
1061 if (! NILP (must_suffix
))
1063 /* Don't insist on adding a suffix if FILE already ends with one. */
1065 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1068 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1070 /* Don't insist on adding a suffix
1071 if the argument includes a directory name. */
1072 else if (! NILP (Ffile_name_directory (file
)))
1076 fd
= openp (Vload_path
, file
,
1077 (!NILP (nosuffix
) ? Qnil
1078 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1079 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1080 tmp
[1] = Vload_file_rep_suffixes
,
1089 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1093 /* Tell startup.el whether or not we found the user's init file. */
1094 if (EQ (Qt
, Vuser_init_file
))
1095 Vuser_init_file
= found
;
1097 /* If FD is -2, that means openp found a magic file. */
1100 if (NILP (Fequal (found
, file
)))
1101 /* If FOUND is a different file name from FILE,
1102 find its handler even if we have already inhibited
1103 the `load' operation on FILE. */
1104 handler
= Ffind_file_name_handler (found
, Qt
);
1106 handler
= Ffind_file_name_handler (found
, Qload
);
1107 if (! NILP (handler
))
1108 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1111 /* Check if we're stuck in a recursive load cycle.
1113 2000-09-21: It's not possible to just check for the file loaded
1114 being a member of Vloads_in_progress. This fails because of the
1115 way the byte compiler currently works; `provide's are not
1116 evaluated, see font-lock.el/jit-lock.el as an example. This
1117 leads to a certain amount of ``normal'' recursion.
1119 Also, just loading a file recursively is not always an error in
1120 the general case; the second load may do something different. */
1124 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1125 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1129 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1131 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1132 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1135 /* Get the name for load-history. */
1136 hist_file_name
= (! NILP (Vpurify_flag
)
1137 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1138 tmp
[1] = Ffile_name_nondirectory (found
),
1144 /* Check for the presence of old-style quotes and warn about them. */
1145 specbind (Qold_style_backquotes
, Qnil
);
1146 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1148 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1150 || (version
= safe_to_load_p (fd
)) > 0)
1151 /* Load .elc files directly, but not when they are
1152 remote and have no handler! */
1159 GCPRO3 (file
, found
, hist_file_name
);
1162 && ! (version
= safe_to_load_p (fd
)))
1165 if (!load_dangerous_libraries
)
1169 error ("File `%s' was not compiled in Emacs",
1172 else if (!NILP (nomessage
) && !force_load_messages
)
1173 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1178 efound
= ENCODE_FILE (found
);
1183 stat ((char *)SDATA (efound
), &s1
);
1184 SSET (efound
, SBYTES (efound
) - 1, 0);
1185 result
= stat ((char *)SDATA (efound
), &s2
);
1186 SSET (efound
, SBYTES (efound
) - 1, 'c');
1188 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1190 /* Make the progress messages mention that source is newer. */
1193 /* If we won't print another message, mention this anyway. */
1194 if (!NILP (nomessage
) && !force_load_messages
)
1196 Lisp_Object msg_file
;
1197 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1198 message_with_string ("Source file `%s' newer than byte-compiled file",
1207 /* We are loading a source file (*.el). */
1208 if (!NILP (Vload_source_file_function
))
1214 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1215 NILP (noerror
) ? Qnil
: Qt
,
1216 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1217 return unbind_to (count
, val
);
1221 GCPRO3 (file
, found
, hist_file_name
);
1225 efound
= ENCODE_FILE (found
);
1226 stream
= fopen ((char *) SDATA (efound
), fmode
);
1227 #else /* not WINDOWSNT */
1228 stream
= fdopen (fd
, fmode
);
1229 #endif /* not WINDOWSNT */
1233 error ("Failure to create stdio stream for %s", SDATA (file
));
1236 if (! NILP (Vpurify_flag
))
1237 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1239 if (NILP (nomessage
) || force_load_messages
)
1242 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1245 message_with_string ("Loading %s (source)...", file
, 1);
1247 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1249 else /* The typical case; compiled file newer than source file. */
1250 message_with_string ("Loading %s...", file
, 1);
1253 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1254 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1255 specbind (Qload_file_name
, found
);
1256 specbind (Qinhibit_file_name_operation
, Qnil
);
1257 load_descriptor_list
1258 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1259 specbind (Qload_in_progress
, Qt
);
1260 if (! version
|| version
>= 22)
1261 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1262 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1265 /* We can't handle a file which was compiled with
1266 byte-compile-dynamic by older version of Emacs. */
1267 specbind (Qload_force_doc_strings
, Qt
);
1268 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1269 0, Qnil
, Qnil
, Qnil
, Qnil
);
1271 unbind_to (count
, Qnil
);
1273 /* Run any eval-after-load forms for this file */
1274 if (NILP (Vpurify_flag
)
1275 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1276 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1280 xfree (saved_doc_string
);
1281 saved_doc_string
= 0;
1282 saved_doc_string_size
= 0;
1284 xfree (prev_saved_doc_string
);
1285 prev_saved_doc_string
= 0;
1286 prev_saved_doc_string_size
= 0;
1288 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1291 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1294 message_with_string ("Loading %s (source)...done", file
, 1);
1296 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1298 else /* The typical case; compiled file newer than source file. */
1299 message_with_string ("Loading %s...done", file
, 1);
1302 if (!NILP (Fequal (build_string ("obsolete"),
1303 Ffile_name_nondirectory
1304 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1305 message_with_string ("Package %s is obsolete", file
, 1);
1311 load_unwind (arg
) /* used as unwind-protect function in load */
1314 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1325 load_descriptor_unwind (oldlist
)
1326 Lisp_Object oldlist
;
1328 load_descriptor_list
= oldlist
;
1332 /* Close all descriptors in use for Floads.
1333 This is used when starting a subprocess. */
1340 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1341 emacs_close (XFASTINT (XCAR (tail
)));
1346 complete_filename_p (pathname
)
1347 Lisp_Object pathname
;
1349 register const unsigned char *s
= SDATA (pathname
);
1350 return (IS_DIRECTORY_SEP (s
[0])
1351 || (SCHARS (pathname
) > 2
1352 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1355 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1356 doc
: /* Search for FILENAME through PATH.
1357 Returns the file's name in absolute form, or nil if not found.
1358 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1359 file name when searching.
1360 If non-nil, PREDICATE is used instead of `file-readable-p'.
1361 PREDICATE can also be an integer to pass to the access(2) function,
1362 in which case file-name-handlers are ignored. */)
1363 (filename
, path
, suffixes
, predicate
)
1364 Lisp_Object filename
, path
, suffixes
, predicate
;
1367 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1368 if (NILP (predicate
) && fd
> 0)
1374 /* Search for a file whose name is STR, looking in directories
1375 in the Lisp list PATH, and trying suffixes from SUFFIX.
1376 On success, returns a file descriptor. On failure, returns -1.
1378 SUFFIXES is a list of strings containing possible suffixes.
1379 The empty suffix is automatically added if the list is empty.
1381 PREDICATE non-nil means don't open the files,
1382 just look for one that satisfies the predicate. In this case,
1383 returns 1 on success. The predicate can be a lisp function or
1384 an integer to pass to `access' (in which case file-name-handlers
1387 If STOREPTR is nonzero, it points to a slot where the name of
1388 the file actually found should be stored as a Lisp string.
1389 nil is stored there on failure.
1391 If the file we find is remote, return -2
1392 but store the found remote file name in *STOREPTR. */
1395 openp (path
, str
, suffixes
, storeptr
, predicate
)
1396 Lisp_Object path
, str
;
1397 Lisp_Object suffixes
;
1398 Lisp_Object
*storeptr
;
1399 Lisp_Object predicate
;
1404 register char *fn
= buf
;
1407 Lisp_Object filename
;
1409 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1410 Lisp_Object string
, tail
, encoded_fn
;
1411 int max_suffix_len
= 0;
1415 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1417 CHECK_STRING_CAR (tail
);
1418 max_suffix_len
= max (max_suffix_len
,
1419 SBYTES (XCAR (tail
)));
1422 string
= filename
= encoded_fn
= Qnil
;
1423 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1428 if (complete_filename_p (str
))
1431 for (; CONSP (path
); path
= XCDR (path
))
1433 filename
= Fexpand_file_name (str
, XCAR (path
));
1434 if (!complete_filename_p (filename
))
1435 /* If there are non-absolute elts in PATH (eg ".") */
1436 /* Of course, this could conceivably lose if luser sets
1437 default-directory to be something non-absolute... */
1439 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1440 if (!complete_filename_p (filename
))
1441 /* Give up on this path element! */
1445 /* Calculate maximum size of any filename made from
1446 this path element/specified file name and any possible suffix. */
1447 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1448 if (fn_size
< want_size
)
1449 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1451 /* Loop over suffixes. */
1452 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1453 CONSP (tail
); tail
= XCDR (tail
))
1455 int lsuffix
= SBYTES (XCAR (tail
));
1456 Lisp_Object handler
;
1459 /* Concatenate path element/specified name with the suffix.
1460 If the directory starts with /:, remove that. */
1461 if (SCHARS (filename
) > 2
1462 && SREF (filename
, 0) == '/'
1463 && SREF (filename
, 1) == ':')
1465 strncpy (fn
, SDATA (filename
) + 2,
1466 SBYTES (filename
) - 2);
1467 fn
[SBYTES (filename
) - 2] = 0;
1471 strncpy (fn
, SDATA (filename
),
1473 fn
[SBYTES (filename
)] = 0;
1476 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1477 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1479 /* Check that the file exists and is not a directory. */
1480 /* We used to only check for handlers on non-absolute file names:
1484 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1485 It's not clear why that was the case and it breaks things like
1486 (load "/bar.el") where the file is actually "/bar.el.gz". */
1487 string
= build_string (fn
);
1488 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1489 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1491 if (NILP (predicate
))
1492 exists
= !NILP (Ffile_readable_p (string
));
1494 exists
= !NILP (call1 (predicate
, string
));
1495 if (exists
&& !NILP (Ffile_directory_p (string
)))
1500 /* We succeeded; return this descriptor and filename. */
1511 encoded_fn
= ENCODE_FILE (string
);
1512 pfn
= SDATA (encoded_fn
);
1513 exists
= (stat (pfn
, &st
) >= 0
1514 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1517 /* Check that we can access or open it. */
1518 if (NATNUMP (predicate
))
1519 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1521 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1525 /* We succeeded; return this descriptor and filename. */
1543 /* Merge the list we've accumulated of globals from the current input source
1544 into the load_history variable. The details depend on whether
1545 the source has an associated file name or not.
1547 FILENAME is the file name that we are loading from.
1548 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1551 build_load_history (filename
, entire
)
1552 Lisp_Object filename
;
1555 register Lisp_Object tail
, prev
, newelt
;
1556 register Lisp_Object tem
, tem2
;
1557 register int foundit
= 0;
1559 tail
= Vload_history
;
1562 while (CONSP (tail
))
1566 /* Find the feature's previous assoc list... */
1567 if (!NILP (Fequal (filename
, Fcar (tem
))))
1571 /* If we're loading the entire file, remove old data. */
1575 Vload_history
= XCDR (tail
);
1577 Fsetcdr (prev
, XCDR (tail
));
1580 /* Otherwise, cons on new symbols that are not already members. */
1583 tem2
= Vcurrent_load_list
;
1585 while (CONSP (tem2
))
1587 newelt
= XCAR (tem2
);
1589 if (NILP (Fmember (newelt
, tem
)))
1590 Fsetcar (tail
, Fcons (XCAR (tem
),
1591 Fcons (newelt
, XCDR (tem
))));
1604 /* If we're loading an entire file, cons the new assoc onto the
1605 front of load-history, the most-recently-loaded position. Also
1606 do this if we didn't find an existing member for the file. */
1607 if (entire
|| !foundit
)
1608 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1613 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1621 readevalloop_1 (old
)
1624 load_convert_to_unibyte
= ! NILP (old
);
1628 /* Signal an `end-of-file' error, if possible with file name
1632 end_of_file_error ()
1634 if (STRINGP (Vload_file_name
))
1635 xsignal1 (Qend_of_file
, Vload_file_name
);
1637 xsignal0 (Qend_of_file
);
1640 /* UNIBYTE specifies how to set load_convert_to_unibyte
1641 for this invocation.
1642 READFUN, if non-nil, is used instead of `read'.
1644 START, END specify region to read in current buffer (from eval-region).
1645 If the input is not from a buffer, they must be nil. */
1648 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1649 printflag
, unibyte
, readfun
, start
, end
)
1650 Lisp_Object readcharfun
;
1652 Lisp_Object sourcename
;
1653 Lisp_Object (*evalfun
) ();
1655 Lisp_Object unibyte
, readfun
;
1656 Lisp_Object start
, end
;
1659 register Lisp_Object val
;
1660 int count
= SPECPDL_INDEX ();
1661 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1662 struct buffer
*b
= 0;
1663 int continue_reading_p
;
1664 /* Nonzero if reading an entire buffer. */
1665 int whole_buffer
= 0;
1666 /* 1 on the first time around. */
1669 if (MARKERP (readcharfun
))
1672 start
= readcharfun
;
1675 if (BUFFERP (readcharfun
))
1676 b
= XBUFFER (readcharfun
);
1677 else if (MARKERP (readcharfun
))
1678 b
= XMARKER (readcharfun
)->buffer
;
1680 /* We assume START is nil when input is not from a buffer. */
1681 if (! NILP (start
) && !b
)
1684 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1685 specbind (Qcurrent_load_list
, Qnil
);
1686 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1687 load_convert_to_unibyte
= !NILP (unibyte
);
1689 GCPRO4 (sourcename
, readfun
, start
, end
);
1691 /* Try to ensure sourcename is a truename, except whilst preloading. */
1692 if (NILP (Vpurify_flag
)
1693 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1694 && !NILP (Ffboundp (Qfile_truename
)))
1695 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1697 LOADHIST_ATTACH (sourcename
);
1699 continue_reading_p
= 1;
1700 while (continue_reading_p
)
1702 int count1
= SPECPDL_INDEX ();
1704 if (b
!= 0 && NILP (b
->name
))
1705 error ("Reading from killed buffer");
1709 /* Switch to the buffer we are reading from. */
1710 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1711 set_buffer_internal (b
);
1713 /* Save point in it. */
1714 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1715 /* Save ZV in it. */
1716 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1717 /* Those get unbound after we read one expression. */
1719 /* Set point and ZV around stuff to be read. */
1722 Fnarrow_to_region (make_number (BEGV
), end
);
1724 /* Just for cleanliness, convert END to a marker
1725 if it is an integer. */
1727 end
= Fpoint_max_marker ();
1730 /* On the first cycle, we can easily test here
1731 whether we are reading the whole buffer. */
1732 if (b
&& first_sexp
)
1733 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1740 while ((c
= READCHAR
) != '\n' && c
!= -1);
1745 unbind_to (count1
, Qnil
);
1749 /* Ignore whitespace here, so we can detect eof. */
1750 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1751 || c
== 0x8a0) /* NBSP */
1754 if (!NILP (Vpurify_flag
) && c
== '(')
1756 record_unwind_protect (unreadpure
, Qnil
);
1757 val
= read_list (-1, readcharfun
);
1762 read_objects
= Qnil
;
1763 if (!NILP (readfun
))
1765 val
= call1 (readfun
, readcharfun
);
1767 /* If READCHARFUN has set point to ZV, we should
1768 stop reading, even if the form read sets point
1769 to a different value when evaluated. */
1770 if (BUFFERP (readcharfun
))
1772 struct buffer
*b
= XBUFFER (readcharfun
);
1773 if (BUF_PT (b
) == BUF_ZV (b
))
1774 continue_reading_p
= 0;
1777 else if (! NILP (Vload_read_function
))
1778 val
= call1 (Vload_read_function
, readcharfun
);
1780 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1783 if (!NILP (start
) && continue_reading_p
)
1784 start
= Fpoint_marker ();
1786 /* Restore saved point and BEGV. */
1787 unbind_to (count1
, Qnil
);
1789 /* Now eval what we just read. */
1790 val
= (*evalfun
) (val
);
1794 Vvalues
= Fcons (val
, Vvalues
);
1795 if (EQ (Vstandard_output
, Qt
))
1804 build_load_history (sourcename
,
1805 stream
|| whole_buffer
);
1809 unbind_to (count
, Qnil
);
1812 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1813 doc
: /* Execute the current buffer as Lisp code.
1814 When called from a Lisp program (i.e., not interactively), this
1815 function accepts up to five optional arguments:
1816 BUFFER is the buffer to evaluate (nil means use current buffer).
1817 PRINTFLAG controls printing of output:
1818 A value of nil means discard it; anything else is stream for print.
1819 FILENAME specifies the file name to use for `load-history'.
1820 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1822 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1823 functions should work normally even if PRINTFLAG is nil.
1825 This function preserves the position of point. */)
1826 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1827 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1829 int count
= SPECPDL_INDEX ();
1830 Lisp_Object tem
, buf
;
1833 buf
= Fcurrent_buffer ();
1835 buf
= Fget_buffer (buffer
);
1837 error ("No such buffer");
1839 if (NILP (printflag
) && NILP (do_allow_print
))
1844 if (NILP (filename
))
1845 filename
= XBUFFER (buf
)->filename
;
1847 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1848 specbind (Qstandard_output
, tem
);
1849 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1850 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1851 readevalloop (buf
, 0, filename
, Feval
,
1852 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1853 unbind_to (count
, Qnil
);
1858 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1859 doc
: /* Execute the region as Lisp code.
1860 When called from programs, expects two arguments,
1861 giving starting and ending indices in the current buffer
1862 of the text to be executed.
1863 Programs can pass third argument PRINTFLAG which controls output:
1864 A value of nil means discard it; anything else is stream for printing it.
1865 Also the fourth argument READ-FUNCTION, if non-nil, is used
1866 instead of `read' to read each expression. It gets one argument
1867 which is the input stream for reading characters.
1869 This function does not move point. */)
1870 (start
, end
, printflag
, read_function
)
1871 Lisp_Object start
, end
, printflag
, read_function
;
1873 int count
= SPECPDL_INDEX ();
1874 Lisp_Object tem
, cbuf
;
1876 cbuf
= Fcurrent_buffer ();
1878 if (NILP (printflag
))
1882 specbind (Qstandard_output
, tem
);
1883 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1885 /* readevalloop calls functions which check the type of start and end. */
1886 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1887 !NILP (printflag
), Qnil
, read_function
,
1890 return unbind_to (count
, Qnil
);
1894 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1895 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1896 If STREAM is nil, use the value of `standard-input' (which see).
1897 STREAM or the value of `standard-input' may be:
1898 a buffer (read from point and advance it)
1899 a marker (read from where it points and advance it)
1900 a function (call it with no arguments for each character,
1901 call it with a char as argument to push a char back)
1902 a string (takes text from string, starting at the beginning)
1903 t (read text line using minibuffer and use it, or read from
1904 standard input in batch mode). */)
1909 stream
= Vstandard_input
;
1910 if (EQ (stream
, Qt
))
1911 stream
= Qread_char
;
1912 if (EQ (stream
, Qread_char
))
1913 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1915 return read_internal_start (stream
, Qnil
, Qnil
);
1918 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1919 doc
: /* Read one Lisp expression which is represented as text by STRING.
1920 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1921 START and END optionally delimit a substring of STRING from which to read;
1922 they default to 0 and (length STRING) respectively. */)
1923 (string
, start
, end
)
1924 Lisp_Object string
, start
, end
;
1927 CHECK_STRING (string
);
1928 /* read_internal_start sets read_from_string_index. */
1929 ret
= read_internal_start (string
, start
, end
);
1930 return Fcons (ret
, make_number (read_from_string_index
));
1933 /* Function to set up the global context we need in toplevel read
1936 read_internal_start (stream
, start
, end
)
1938 Lisp_Object start
; /* Only used when stream is a string. */
1939 Lisp_Object end
; /* Only used when stream is a string. */
1944 new_backquote_flag
= 0;
1945 read_objects
= Qnil
;
1946 if (EQ (Vread_with_symbol_positions
, Qt
)
1947 || EQ (Vread_with_symbol_positions
, stream
))
1948 Vread_symbol_positions_list
= Qnil
;
1950 if (STRINGP (stream
)
1951 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1953 int startval
, endval
;
1956 if (STRINGP (stream
))
1959 string
= XCAR (stream
);
1962 endval
= SCHARS (string
);
1966 endval
= XINT (end
);
1967 if (endval
< 0 || endval
> SCHARS (string
))
1968 args_out_of_range (string
, end
);
1975 CHECK_NUMBER (start
);
1976 startval
= XINT (start
);
1977 if (startval
< 0 || startval
> endval
)
1978 args_out_of_range (string
, start
);
1980 read_from_string_index
= startval
;
1981 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1982 read_from_string_limit
= endval
;
1985 retval
= read0 (stream
);
1986 if (EQ (Vread_with_symbol_positions
, Qt
)
1987 || EQ (Vread_with_symbol_positions
, stream
))
1988 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1993 /* Signal Qinvalid_read_syntax error.
1994 S is error string of length N (if > 0) */
1997 invalid_syntax (s
, n
)
2003 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2007 /* Use this for recursive reads, in contexts where internal tokens
2012 Lisp_Object readcharfun
;
2014 register Lisp_Object val
;
2017 val
= read1 (readcharfun
, &c
, 0);
2021 xsignal1 (Qinvalid_read_syntax
,
2022 Fmake_string (make_number (1), make_number (c
)));
2025 static int read_buffer_size
;
2026 static char *read_buffer
;
2028 /* Read a \-escape sequence, assuming we already read the `\'.
2029 If the escape sequence forces unibyte, return eight-bit char. */
2032 read_escape (readcharfun
, stringp
)
2033 Lisp_Object readcharfun
;
2036 register int c
= READCHAR
;
2037 /* \u allows up to four hex digits, \U up to eight. Default to the
2038 behavior for \u, and change this value in the case that \U is seen. */
2039 int unicode_hex_count
= 4;
2044 end_of_file_error ();
2074 error ("Invalid escape character syntax");
2077 c
= read_escape (readcharfun
, 0);
2078 return c
| meta_modifier
;
2083 error ("Invalid escape character syntax");
2086 c
= read_escape (readcharfun
, 0);
2087 return c
| shift_modifier
;
2092 error ("Invalid escape character syntax");
2095 c
= read_escape (readcharfun
, 0);
2096 return c
| hyper_modifier
;
2101 error ("Invalid escape character syntax");
2104 c
= read_escape (readcharfun
, 0);
2105 return c
| alt_modifier
;
2109 if (stringp
|| c
!= '-')
2116 c
= read_escape (readcharfun
, 0);
2117 return c
| super_modifier
;
2122 error ("Invalid escape character syntax");
2126 c
= read_escape (readcharfun
, 0);
2127 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2128 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2129 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2130 return c
| ctrl_modifier
;
2131 /* ASCII control chars are made from letters (both cases),
2132 as well as the non-letters within 0100...0137. */
2133 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2134 return (c
& (037 | ~0177));
2135 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2136 return (c
& (037 | ~0177));
2138 return c
| ctrl_modifier
;
2148 /* An octal escape, as in ANSI C. */
2150 register int i
= c
- '0';
2151 register int count
= 0;
2154 if ((c
= READCHAR
) >= '0' && c
<= '7')
2166 if (i
>= 0x80 && i
< 0x100)
2167 i
= BYTE8_TO_CHAR (i
);
2172 /* A hex escape, as in ANSI C. */
2179 if (c
>= '0' && c
<= '9')
2184 else if ((c
>= 'a' && c
<= 'f')
2185 || (c
>= 'A' && c
<= 'F'))
2188 if (c
>= 'a' && c
<= 'f')
2201 if (count
< 3 && i
>= 0x80)
2202 return BYTE8_TO_CHAR (i
);
2207 /* Post-Unicode-2.0: Up to eight hex chars. */
2208 unicode_hex_count
= 8;
2211 /* A Unicode escape. We only permit them in strings and characters,
2212 not arbitrarily in the source code, as in some other languages. */
2217 while (++count
<= unicode_hex_count
)
2220 /* isdigit and isalpha may be locale-specific, which we don't
2222 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2223 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2224 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2227 error ("Non-hex digit used for Unicode escape");
2232 error ("Non-Unicode character: 0x%x", i
);
2241 /* Read an integer in radix RADIX using READCHARFUN to read
2242 characters. RADIX must be in the interval [2..36]; if it isn't, a
2243 read error is signaled . Value is the integer read. Signals an
2244 error if encountering invalid read syntax or if RADIX is out of
2248 read_integer (readcharfun
, radix
)
2249 Lisp_Object readcharfun
;
2252 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2253 EMACS_INT number
= 0;
2255 if (radix
< 2 || radix
> 36)
2259 number
= ndigits
= invalid_p
= 0;
2275 if (c
>= '0' && c
<= '9')
2277 else if (c
>= 'a' && c
<= 'z')
2278 digit
= c
- 'a' + 10;
2279 else if (c
>= 'A' && c
<= 'Z')
2280 digit
= c
- 'A' + 10;
2287 if (digit
< 0 || digit
>= radix
)
2290 number
= radix
* number
+ digit
;
2296 if (ndigits
== 0 || invalid_p
)
2299 sprintf (buf
, "integer, radix %d", radix
);
2300 invalid_syntax (buf
, 0);
2303 return make_number (sign
* number
);
2307 /* If the next token is ')' or ']' or '.', we store that character
2308 in *PCH and the return value is not interesting. Else, we store
2309 zero in *PCH and we read and return one lisp object.
2311 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2314 read1 (readcharfun
, pch
, first_in_list
)
2315 register Lisp_Object readcharfun
;
2320 int uninterned_symbol
= 0;
2328 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2330 end_of_file_error ();
2335 return read_list (0, readcharfun
);
2338 return read_vector (readcharfun
, 0);
2355 tmp
= read_vector (readcharfun
, 0);
2356 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2357 error ("Invalid size char-table");
2358 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2369 tmp
= read_vector (readcharfun
, 0);
2370 if (!INTEGERP (AREF (tmp
, 0)))
2371 error ("Invalid depth in char-table");
2372 depth
= XINT (AREF (tmp
, 0));
2373 if (depth
< 1 || depth
> 3)
2374 error ("Invalid depth in char-table");
2375 size
= XVECTOR (tmp
)->size
- 2;
2376 if (chartab_size
[depth
] != size
)
2377 error ("Invalid size char-table");
2378 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2381 invalid_syntax ("#^^", 3);
2383 invalid_syntax ("#^", 2);
2388 length
= read1 (readcharfun
, pch
, first_in_list
);
2392 Lisp_Object tmp
, val
;
2394 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2395 / BOOL_VECTOR_BITS_PER_CHAR
);
2398 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2399 if (STRING_MULTIBYTE (tmp
)
2400 || (size_in_chars
!= SCHARS (tmp
)
2401 /* We used to print 1 char too many
2402 when the number of bits was a multiple of 8.
2403 Accept such input in case it came from an old
2405 && ! (XFASTINT (length
)
2406 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2407 invalid_syntax ("#&...", 5);
2409 val
= Fmake_bool_vector (length
, Qnil
);
2410 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2412 /* Clear the extraneous bits in the last byte. */
2413 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2414 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2415 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2418 invalid_syntax ("#&...", 5);
2422 /* Accept compiled functions at read-time so that we don't have to
2423 build them using function calls. */
2425 tmp
= read_vector (readcharfun
, 1);
2426 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2427 XVECTOR (tmp
)->contents
);
2432 struct gcpro gcpro1
;
2435 /* Read the string itself. */
2436 tmp
= read1 (readcharfun
, &ch
, 0);
2437 if (ch
!= 0 || !STRINGP (tmp
))
2438 invalid_syntax ("#", 1);
2440 /* Read the intervals and their properties. */
2443 Lisp_Object beg
, end
, plist
;
2445 beg
= read1 (readcharfun
, &ch
, 0);
2450 end
= read1 (readcharfun
, &ch
, 0);
2452 plist
= read1 (readcharfun
, &ch
, 0);
2454 invalid_syntax ("Invalid string property list", 0);
2455 Fset_text_properties (beg
, end
, plist
, tmp
);
2461 /* #@NUMBER is used to skip NUMBER following characters.
2462 That's used in .elc files to skip over doc strings
2463 and function definitions. */
2469 /* Read a decimal integer. */
2470 while ((c
= READCHAR
) >= 0
2471 && c
>= '0' && c
<= '9')
2479 if (load_force_doc_strings
2480 && (EQ (readcharfun
, Qget_file_char
)
2481 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2483 /* If we are supposed to force doc strings into core right now,
2484 record the last string that we skipped,
2485 and record where in the file it comes from. */
2487 /* But first exchange saved_doc_string
2488 with prev_saved_doc_string, so we save two strings. */
2490 char *temp
= saved_doc_string
;
2491 int temp_size
= saved_doc_string_size
;
2492 file_offset temp_pos
= saved_doc_string_position
;
2493 int temp_len
= saved_doc_string_length
;
2495 saved_doc_string
= prev_saved_doc_string
;
2496 saved_doc_string_size
= prev_saved_doc_string_size
;
2497 saved_doc_string_position
= prev_saved_doc_string_position
;
2498 saved_doc_string_length
= prev_saved_doc_string_length
;
2500 prev_saved_doc_string
= temp
;
2501 prev_saved_doc_string_size
= temp_size
;
2502 prev_saved_doc_string_position
= temp_pos
;
2503 prev_saved_doc_string_length
= temp_len
;
2506 if (saved_doc_string_size
== 0)
2508 saved_doc_string_size
= nskip
+ 100;
2509 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2511 if (nskip
> saved_doc_string_size
)
2513 saved_doc_string_size
= nskip
+ 100;
2514 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2515 saved_doc_string_size
);
2518 saved_doc_string_position
= file_tell (instream
);
2520 /* Copy that many characters into saved_doc_string. */
2521 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2522 saved_doc_string
[i
] = c
= READCHAR
;
2524 saved_doc_string_length
= i
;
2528 /* Skip that many characters. */
2529 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2538 /* #! appears at the beginning of an executable file.
2539 Skip the first line. */
2540 while (c
!= '\n' && c
>= 0)
2545 return Vload_file_name
;
2547 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2548 /* #:foo is the uninterned symbol named foo. */
2551 uninterned_symbol
= 1;
2555 /* Reader forms that can reuse previously read objects. */
2556 if (c
>= '0' && c
<= '9')
2561 /* Read a non-negative integer. */
2562 while (c
>= '0' && c
<= '9')
2568 /* #n=object returns object, but associates it with n for #n#. */
2569 if (c
== '=' && !NILP (Vread_circle
))
2571 /* Make a placeholder for #n# to use temporarily */
2572 Lisp_Object placeholder
;
2575 placeholder
= Fcons(Qnil
, Qnil
);
2576 cell
= Fcons (make_number (n
), placeholder
);
2577 read_objects
= Fcons (cell
, read_objects
);
2579 /* Read the object itself. */
2580 tem
= read0 (readcharfun
);
2582 /* Now put it everywhere the placeholder was... */
2583 substitute_object_in_subtree (tem
, placeholder
);
2585 /* ...and #n# will use the real value from now on. */
2586 Fsetcdr (cell
, tem
);
2590 /* #n# returns a previously read object. */
2591 if (c
== '#' && !NILP (Vread_circle
))
2593 tem
= Fassq (make_number (n
), read_objects
);
2596 /* Fall through to error message. */
2598 else if (c
== 'r' || c
== 'R')
2599 return read_integer (readcharfun
, n
);
2601 /* Fall through to error message. */
2603 else if (c
== 'x' || c
== 'X')
2604 return read_integer (readcharfun
, 16);
2605 else if (c
== 'o' || c
== 'O')
2606 return read_integer (readcharfun
, 8);
2607 else if (c
== 'b' || c
== 'B')
2608 return read_integer (readcharfun
, 2);
2611 invalid_syntax ("#", 1);
2614 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2619 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2625 Vold_style_backquotes
= Qt
;
2632 new_backquote_flag
++;
2633 value
= read0 (readcharfun
);
2634 new_backquote_flag
--;
2636 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2640 if (new_backquote_flag
)
2642 Lisp_Object comma_type
= Qnil
;
2647 comma_type
= Qcomma_at
;
2649 comma_type
= Qcomma_dot
;
2652 if (ch
>= 0) UNREAD (ch
);
2653 comma_type
= Qcomma
;
2656 new_backquote_flag
--;
2657 value
= read0 (readcharfun
);
2658 new_backquote_flag
++;
2659 return Fcons (comma_type
, Fcons (value
, Qnil
));
2663 Vold_style_backquotes
= Qt
;
2675 end_of_file_error ();
2677 /* Accept `single space' syntax like (list ? x) where the
2678 whitespace character is SPC or TAB.
2679 Other literal whitespace like NL, CR, and FF are not accepted,
2680 as there are well-established escape sequences for these. */
2681 if (c
== ' ' || c
== '\t')
2682 return make_number (c
);
2685 c
= read_escape (readcharfun
, 0);
2686 modifiers
= c
& CHAR_MODIFIER_MASK
;
2687 c
&= ~CHAR_MODIFIER_MASK
;
2688 if (CHAR_BYTE8_P (c
))
2689 c
= CHAR_TO_BYTE8 (c
);
2692 next_char
= READCHAR
;
2693 if (next_char
== '.')
2695 /* Only a dotted-pair dot is valid after a char constant. */
2696 int next_next_char
= READCHAR
;
2697 UNREAD (next_next_char
);
2699 ok
= (next_next_char
<= 040
2700 || (next_next_char
< 0200
2701 && (index ("\"';([#?", next_next_char
)
2702 || (!first_in_list
&& next_next_char
== '`')
2703 || (new_backquote_flag
&& next_next_char
== ','))));
2707 ok
= (next_char
<= 040
2708 || (next_char
< 0200
2709 && (index ("\"';()[]#?", next_char
)
2710 || (!first_in_list
&& next_char
== '`')
2711 || (new_backquote_flag
&& next_char
== ','))));
2715 return make_number (c
);
2717 invalid_syntax ("?", 1);
2722 char *p
= read_buffer
;
2723 char *end
= read_buffer
+ read_buffer_size
;
2725 /* Nonzero if we saw an escape sequence specifying
2726 a multibyte character. */
2727 int force_multibyte
= 0;
2728 /* Nonzero if we saw an escape sequence specifying
2729 a single-byte character. */
2730 int force_singlebyte
= 0;
2734 while ((c
= READCHAR
) >= 0
2737 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2739 int offset
= p
- read_buffer
;
2740 read_buffer
= (char *) xrealloc (read_buffer
,
2741 read_buffer_size
*= 2);
2742 p
= read_buffer
+ offset
;
2743 end
= read_buffer
+ read_buffer_size
;
2750 c
= read_escape (readcharfun
, 1);
2752 /* C is -1 if \ newline has just been seen */
2755 if (p
== read_buffer
)
2760 modifiers
= c
& CHAR_MODIFIER_MASK
;
2761 c
= c
& ~CHAR_MODIFIER_MASK
;
2763 if (CHAR_BYTE8_P (c
))
2764 force_singlebyte
= 1;
2765 else if (! ASCII_CHAR_P (c
))
2766 force_multibyte
= 1;
2767 else /* i.e. ASCII_CHAR_P (c) */
2769 /* Allow `\C- ' and `\C-?'. */
2770 if (modifiers
== CHAR_CTL
)
2773 c
= 0, modifiers
= 0;
2775 c
= 127, modifiers
= 0;
2777 if (modifiers
& CHAR_SHIFT
)
2779 /* Shift modifier is valid only with [A-Za-z]. */
2780 if (c
>= 'A' && c
<= 'Z')
2781 modifiers
&= ~CHAR_SHIFT
;
2782 else if (c
>= 'a' && c
<= 'z')
2783 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2786 if (modifiers
& CHAR_META
)
2788 /* Move the meta bit to the right place for a
2790 modifiers
&= ~CHAR_META
;
2791 c
= BYTE8_TO_CHAR (c
| 0x80);
2792 force_singlebyte
= 1;
2796 /* Any modifiers remaining are invalid. */
2798 error ("Invalid modifier in string");
2799 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2803 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2804 if (CHAR_BYTE8_P (c
))
2805 force_singlebyte
= 1;
2806 else if (! ASCII_CHAR_P (c
))
2807 force_multibyte
= 1;
2813 end_of_file_error ();
2815 /* If purifying, and string starts with \ newline,
2816 return zero instead. This is for doc strings
2817 that we are really going to find in etc/DOC.nn.nn */
2818 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2819 return make_number (0);
2821 if (force_multibyte
)
2822 /* READ_BUFFER already contains valid multibyte forms. */
2824 else if (force_singlebyte
)
2826 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2827 p
= read_buffer
+ nchars
;
2830 /* Otherwise, READ_BUFFER contains only ASCII. */
2833 /* We want readchar_count to be the number of characters, not
2834 bytes. Hence we adjust for multibyte characters in the
2835 string. ... But it doesn't seem to be necessary, because
2836 READCHAR *does* read multibyte characters from buffers. */
2837 /* readchar_count -= (p - read_buffer) - nchars; */
2839 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2841 || (p
- read_buffer
!= nchars
)));
2842 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2844 || (p
- read_buffer
!= nchars
)));
2849 int next_char
= READCHAR
;
2852 if (next_char
<= 040
2853 || (next_char
< 0200
2854 && (index ("\"';([#?", next_char
)
2855 || (!first_in_list
&& next_char
== '`')
2856 || (new_backquote_flag
&& next_char
== ','))))
2862 /* Otherwise, we fall through! Note that the atom-reading loop
2863 below will now loop at least once, assuring that we will not
2864 try to UNREAD two characters in a row. */
2868 if (c
<= 040) goto retry
;
2869 if (c
== 0x8a0) /* NBSP */
2872 char *p
= read_buffer
;
2876 char *end
= read_buffer
+ read_buffer_size
;
2879 && c
!= 0x8a0 /* NBSP */
2881 || (!index ("\"';()[]#", c
)
2882 && !(!first_in_list
&& c
== '`')
2883 && !(new_backquote_flag
&& c
== ','))))
2885 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2887 int offset
= p
- read_buffer
;
2888 read_buffer
= (char *) xrealloc (read_buffer
,
2889 read_buffer_size
*= 2);
2890 p
= read_buffer
+ offset
;
2891 end
= read_buffer
+ read_buffer_size
;
2898 end_of_file_error ();
2903 p
+= CHAR_STRING (c
, p
);
2911 int offset
= p
- read_buffer
;
2912 read_buffer
= (char *) xrealloc (read_buffer
,
2913 read_buffer_size
*= 2);
2914 p
= read_buffer
+ offset
;
2915 end
= read_buffer
+ read_buffer_size
;
2922 if (!quoted
&& !uninterned_symbol
)
2925 register Lisp_Object val
;
2927 if (*p1
== '+' || *p1
== '-') p1
++;
2928 /* Is it an integer? */
2931 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2932 /* Integers can have trailing decimal points. */
2933 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2935 /* It is an integer. */
2939 /* Fixme: if we have strtol, use that, and check
2941 if (sizeof (int) == sizeof (EMACS_INT
))
2942 XSETINT (val
, atoi (read_buffer
));
2943 else if (sizeof (long) == sizeof (EMACS_INT
))
2944 XSETINT (val
, atol (read_buffer
));
2950 if (isfloat_string (read_buffer
))
2952 /* Compute NaN and infinities using 0.0 in a variable,
2953 to cope with compilers that think they are smarter
2959 /* Negate the value ourselves. This treats 0, NaNs,
2960 and infinity properly on IEEE floating point hosts,
2961 and works around a common bug where atof ("-0.0")
2963 int negative
= read_buffer
[0] == '-';
2965 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2966 returns 1, is if the input ends in e+INF or e+NaN. */
2973 value
= zero
/ zero
;
2975 /* If that made a "negative" NaN, negate it. */
2979 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2982 u_minus_zero
.d
= - 0.0;
2983 for (i
= 0; i
< sizeof (double); i
++)
2984 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2990 /* Now VALUE is a positive NaN. */
2993 value
= atof (read_buffer
+ negative
);
2997 return make_float (negative
? - value
: value
);
3001 Lisp_Object name
, result
;
3002 EMACS_INT nbytes
= p
- read_buffer
;
3004 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3007 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3008 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3010 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3011 result
= (uninterned_symbol
? Fmake_symbol (name
)
3012 : Fintern (name
, Qnil
));
3014 if (EQ (Vread_with_symbol_positions
, Qt
)
3015 || EQ (Vread_with_symbol_positions
, readcharfun
))
3016 Vread_symbol_positions_list
=
3017 /* Kind of a hack; this will probably fail if characters
3018 in the symbol name were escaped. Not really a big
3020 Fcons (Fcons (result
,
3021 make_number (readchar_count
3022 - XFASTINT (Flength (Fsymbol_name (result
))))),
3023 Vread_symbol_positions_list
);
3031 /* List of nodes we've seen during substitute_object_in_subtree. */
3032 static Lisp_Object seen_list
;
3035 substitute_object_in_subtree (object
, placeholder
)
3037 Lisp_Object placeholder
;
3039 Lisp_Object check_object
;
3041 /* We haven't seen any objects when we start. */
3044 /* Make all the substitutions. */
3046 = substitute_object_recurse (object
, placeholder
, object
);
3048 /* Clear seen_list because we're done with it. */
3051 /* The returned object here is expected to always eq the
3053 if (!EQ (check_object
, object
))
3054 error ("Unexpected mutation error in reader");
3057 /* Feval doesn't get called from here, so no gc protection is needed. */
3058 #define SUBSTITUTE(get_val, set_val) \
3060 Lisp_Object old_value = get_val; \
3061 Lisp_Object true_value \
3062 = substitute_object_recurse (object, placeholder, \
3065 if (!EQ (old_value, true_value)) \
3072 substitute_object_recurse (object
, placeholder
, subtree
)
3074 Lisp_Object placeholder
;
3075 Lisp_Object subtree
;
3077 /* If we find the placeholder, return the target object. */
3078 if (EQ (placeholder
, subtree
))
3081 /* If we've been to this node before, don't explore it again. */
3082 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3085 /* If this node can be the entry point to a cycle, remember that
3086 we've seen it. It can only be such an entry point if it was made
3087 by #n=, which means that we can find it as a value in
3089 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3090 seen_list
= Fcons (subtree
, seen_list
);
3092 /* Recurse according to subtree's type.
3093 Every branch must return a Lisp_Object. */
3094 switch (XTYPE (subtree
))
3096 case Lisp_Vectorlike
:
3099 if (BOOL_VECTOR_P (subtree
))
3100 return subtree
; /* No sub-objects anyway. */
3101 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3102 || COMPILEDP (subtree
))
3103 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3104 else if (VECTORP (subtree
))
3105 length
= ASIZE (subtree
);
3107 /* An unknown pseudovector may contain non-Lisp fields, so we
3108 can't just blindly traverse all its fields. We used to call
3109 `Flength' which signaled `sequencep', so I just preserved this
3111 wrong_type_argument (Qsequencep
, subtree
);
3113 for (i
= 0; i
< length
; i
++)
3114 SUBSTITUTE (AREF (subtree
, i
),
3115 ASET (subtree
, i
, true_value
));
3121 SUBSTITUTE (XCAR (subtree
),
3122 XSETCAR (subtree
, true_value
));
3123 SUBSTITUTE (XCDR (subtree
),
3124 XSETCDR (subtree
, true_value
));
3130 /* Check for text properties in each interval.
3131 substitute_in_interval contains part of the logic. */
3133 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3134 Lisp_Object arg
= Fcons (object
, placeholder
);
3136 traverse_intervals_noorder (root_interval
,
3137 &substitute_in_interval
, arg
);
3142 /* Other types don't recurse any further. */
3148 /* Helper function for substitute_object_recurse. */
3150 substitute_in_interval (interval
, arg
)
3154 Lisp_Object object
= Fcar (arg
);
3155 Lisp_Object placeholder
= Fcdr (arg
);
3157 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3176 if (*cp
== '+' || *cp
== '-')
3179 if (*cp
>= '0' && *cp
<= '9')
3182 while (*cp
>= '0' && *cp
<= '9')
3190 if (*cp
>= '0' && *cp
<= '9')
3193 while (*cp
>= '0' && *cp
<= '9')
3196 if (*cp
== 'e' || *cp
== 'E')
3200 if (*cp
== '+' || *cp
== '-')
3204 if (*cp
>= '0' && *cp
<= '9')
3207 while (*cp
>= '0' && *cp
<= '9')
3210 else if (cp
== start
)
3212 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3217 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3223 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3224 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3225 || state
== (DOT_CHAR
|TRAIL_INT
)
3226 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3227 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3228 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3233 read_vector (readcharfun
, bytecodeflag
)
3234 Lisp_Object readcharfun
;
3239 register Lisp_Object
*ptr
;
3240 register Lisp_Object tem
, item
, vector
;
3241 register struct Lisp_Cons
*otem
;
3244 tem
= read_list (1, readcharfun
);
3245 len
= Flength (tem
);
3246 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3248 size
= XVECTOR (vector
)->size
;
3249 ptr
= XVECTOR (vector
)->contents
;
3250 for (i
= 0; i
< size
; i
++)
3253 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3254 bytecode object, the docstring containing the bytecode and
3255 constants values must be treated as unibyte and passed to
3256 Fread, to get the actual bytecode string and constants vector. */
3257 if (bytecodeflag
&& load_force_doc_strings
)
3259 if (i
== COMPILED_BYTECODE
)
3261 if (!STRINGP (item
))
3262 error ("Invalid byte code");
3264 /* Delay handling the bytecode slot until we know whether
3265 it is lazily-loaded (we can tell by whether the
3266 constants slot is nil). */
3267 ptr
[COMPILED_CONSTANTS
] = item
;
3270 else if (i
== COMPILED_CONSTANTS
)
3272 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3276 /* Coerce string to unibyte (like string-as-unibyte,
3277 but without generating extra garbage and
3278 guaranteeing no change in the contents). */
3279 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3280 STRING_SET_UNIBYTE (bytestr
);
3282 item
= Fread (Fcons (bytestr
, readcharfun
));
3284 error ("Invalid byte code");
3286 otem
= XCONS (item
);
3287 bytestr
= XCAR (item
);
3292 /* Now handle the bytecode slot. */
3293 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3295 else if (i
== COMPILED_DOC_STRING
3297 && ! STRING_MULTIBYTE (item
))
3299 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3300 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3302 item
= Fstring_as_multibyte (item
);
3305 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3313 /* FLAG = 1 means check for ] to terminate rather than ) and .
3314 FLAG = -1 means check for starting with defun
3315 and make structure pure. */
3318 read_list (flag
, readcharfun
)
3320 register Lisp_Object readcharfun
;
3322 /* -1 means check next element for defun,
3323 0 means don't check,
3324 1 means already checked and found defun. */
3325 int defunflag
= flag
< 0 ? -1 : 0;
3326 Lisp_Object val
, tail
;
3327 register Lisp_Object elt
, tem
;
3328 struct gcpro gcpro1
, gcpro2
;
3329 /* 0 is the normal case.
3330 1 means this list is a doc reference; replace it with the number 0.
3331 2 means this list is a doc reference; replace it with the doc string. */
3332 int doc_reference
= 0;
3334 /* Initialize this to 1 if we are reading a list. */
3335 int first_in_list
= flag
<= 0;
3344 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3349 /* While building, if the list starts with #$, treat it specially. */
3350 if (EQ (elt
, Vload_file_name
)
3352 && !NILP (Vpurify_flag
))
3354 if (NILP (Vdoc_file_name
))
3355 /* We have not yet called Snarf-documentation, so assume
3356 this file is described in the DOC-MM.NN file
3357 and Snarf-documentation will fill in the right value later.
3358 For now, replace the whole list with 0. */
3361 /* We have already called Snarf-documentation, so make a relative
3362 file name for this file, so it can be found properly
3363 in the installed Lisp directory.
3364 We don't use Fexpand_file_name because that would make
3365 the directory absolute now. */
3366 elt
= concat2 (build_string ("../lisp/"),
3367 Ffile_name_nondirectory (elt
));
3369 else if (EQ (elt
, Vload_file_name
)
3371 && load_force_doc_strings
)
3380 invalid_syntax (") or . in a vector", 18);
3388 XSETCDR (tail
, read0 (readcharfun
));
3390 val
= read0 (readcharfun
);
3391 read1 (readcharfun
, &ch
, 0);
3395 if (doc_reference
== 1)
3396 return make_number (0);
3397 if (doc_reference
== 2)
3399 /* Get a doc string from the file we are loading.
3400 If it's in saved_doc_string, get it from there.
3402 Here, we don't know if the string is a
3403 bytecode string or a doc string. As a
3404 bytecode string must be unibyte, we always
3405 return a unibyte string. If it is actually a
3406 doc string, caller must make it
3409 int pos
= XINT (XCDR (val
));
3410 /* Position is negative for user variables. */
3411 if (pos
< 0) pos
= -pos
;
3412 if (pos
>= saved_doc_string_position
3413 && pos
< (saved_doc_string_position
3414 + saved_doc_string_length
))
3416 int start
= pos
- saved_doc_string_position
;
3419 /* Process quoting with ^A,
3420 and find the end of the string,
3421 which is marked with ^_ (037). */
3422 for (from
= start
, to
= start
;
3423 saved_doc_string
[from
] != 037;)
3425 int c
= saved_doc_string
[from
++];
3428 c
= saved_doc_string
[from
++];
3430 saved_doc_string
[to
++] = c
;
3432 saved_doc_string
[to
++] = 0;
3434 saved_doc_string
[to
++] = 037;
3437 saved_doc_string
[to
++] = c
;
3440 return make_unibyte_string (saved_doc_string
+ start
,
3443 /* Look in prev_saved_doc_string the same way. */
3444 else if (pos
>= prev_saved_doc_string_position
3445 && pos
< (prev_saved_doc_string_position
3446 + prev_saved_doc_string_length
))
3448 int start
= pos
- prev_saved_doc_string_position
;
3451 /* Process quoting with ^A,
3452 and find the end of the string,
3453 which is marked with ^_ (037). */
3454 for (from
= start
, to
= start
;
3455 prev_saved_doc_string
[from
] != 037;)
3457 int c
= prev_saved_doc_string
[from
++];
3460 c
= prev_saved_doc_string
[from
++];
3462 prev_saved_doc_string
[to
++] = c
;
3464 prev_saved_doc_string
[to
++] = 0;
3466 prev_saved_doc_string
[to
++] = 037;
3469 prev_saved_doc_string
[to
++] = c
;
3472 return make_unibyte_string (prev_saved_doc_string
3477 return get_doc_string (val
, 1, 0);
3482 invalid_syntax (". in wrong context", 18);
3484 invalid_syntax ("] in a list", 11);
3486 tem
= (read_pure
&& flag
<= 0
3487 ? pure_cons (elt
, Qnil
)
3488 : Fcons (elt
, Qnil
));
3490 XSETCDR (tail
, tem
);
3495 defunflag
= EQ (elt
, Qdefun
);
3496 else if (defunflag
> 0)
3501 Lisp_Object Vobarray
;
3502 Lisp_Object initial_obarray
;
3504 /* oblookup stores the bucket number here, for the sake of Funintern. */
3506 int oblookup_last_bucket_number
;
3508 static int hash_string ();
3510 /* Get an error if OBARRAY is not an obarray.
3511 If it is one, return it. */
3514 check_obarray (obarray
)
3515 Lisp_Object obarray
;
3517 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3519 /* If Vobarray is now invalid, force it to be valid. */
3520 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3521 wrong_type_argument (Qvectorp
, obarray
);
3526 /* Intern the C string STR: return a symbol with that name,
3527 interned in the current obarray. */
3534 int len
= strlen (str
);
3535 Lisp_Object obarray
;
3538 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3539 obarray
= check_obarray (obarray
);
3540 tem
= oblookup (obarray
, str
, len
, len
);
3543 return Fintern (make_string (str
, len
), obarray
);
3546 /* Create an uninterned symbol with name STR. */
3552 int len
= strlen (str
);
3554 return Fmake_symbol ((!NILP (Vpurify_flag
)
3555 ? make_pure_string (str
, len
, len
, 0)
3556 : make_string (str
, len
)));
3559 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3560 doc
: /* Return the canonical symbol whose name is STRING.
3561 If there is none, one is created by this function and returned.
3562 A second optional argument specifies the obarray to use;
3563 it defaults to the value of `obarray'. */)
3565 Lisp_Object string
, obarray
;
3567 register Lisp_Object tem
, sym
, *ptr
;
3569 if (NILP (obarray
)) obarray
= Vobarray
;
3570 obarray
= check_obarray (obarray
);
3572 CHECK_STRING (string
);
3574 tem
= oblookup (obarray
, SDATA (string
),
3577 if (!INTEGERP (tem
))
3580 if (!NILP (Vpurify_flag
))
3581 string
= Fpurecopy (string
);
3582 sym
= Fmake_symbol (string
);
3584 if (EQ (obarray
, initial_obarray
))
3585 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3587 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3589 if ((SREF (string
, 0) == ':')
3590 && EQ (obarray
, initial_obarray
))
3592 XSYMBOL (sym
)->constant
= 1;
3593 XSYMBOL (sym
)->value
= sym
;
3596 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3598 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3600 XSYMBOL (sym
)->next
= 0;
3605 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3606 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3607 NAME may be a string or a symbol. If it is a symbol, that exact
3608 symbol is searched for.
3609 A second optional argument specifies the obarray to use;
3610 it defaults to the value of `obarray'. */)
3612 Lisp_Object name
, obarray
;
3614 register Lisp_Object tem
, string
;
3616 if (NILP (obarray
)) obarray
= Vobarray
;
3617 obarray
= check_obarray (obarray
);
3619 if (!SYMBOLP (name
))
3621 CHECK_STRING (name
);
3625 string
= SYMBOL_NAME (name
);
3627 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3628 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3634 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3635 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3636 The value is t if a symbol was found and deleted, nil otherwise.
3637 NAME may be a string or a symbol. If it is a symbol, that symbol
3638 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3639 OBARRAY defaults to the value of the variable `obarray'. */)
3641 Lisp_Object name
, obarray
;
3643 register Lisp_Object string
, tem
;
3646 if (NILP (obarray
)) obarray
= Vobarray
;
3647 obarray
= check_obarray (obarray
);
3650 string
= SYMBOL_NAME (name
);
3653 CHECK_STRING (name
);
3657 tem
= oblookup (obarray
, SDATA (string
),
3662 /* If arg was a symbol, don't delete anything but that symbol itself. */
3663 if (SYMBOLP (name
) && !EQ (name
, tem
))
3666 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3667 XSYMBOL (tem
)->constant
= 0;
3668 XSYMBOL (tem
)->indirect_variable
= 0;
3670 hash
= oblookup_last_bucket_number
;
3672 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3674 if (XSYMBOL (tem
)->next
)
3675 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3677 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3681 Lisp_Object tail
, following
;
3683 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3684 XSYMBOL (tail
)->next
;
3687 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3688 if (EQ (following
, tem
))
3690 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3699 /* Return the symbol in OBARRAY whose names matches the string
3700 of SIZE characters (SIZE_BYTE bytes) at PTR.
3701 If there is no such symbol in OBARRAY, return nil.
3703 Also store the bucket number in oblookup_last_bucket_number. */
3706 oblookup (obarray
, ptr
, size
, size_byte
)
3707 Lisp_Object obarray
;
3708 register const char *ptr
;
3709 int size
, size_byte
;
3713 register Lisp_Object tail
;
3714 Lisp_Object bucket
, tem
;
3716 if (!VECTORP (obarray
)
3717 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3719 obarray
= check_obarray (obarray
);
3720 obsize
= XVECTOR (obarray
)->size
;
3722 /* This is sometimes needed in the middle of GC. */
3723 obsize
&= ~ARRAY_MARK_FLAG
;
3724 hash
= hash_string (ptr
, size_byte
) % obsize
;
3725 bucket
= XVECTOR (obarray
)->contents
[hash
];
3726 oblookup_last_bucket_number
= hash
;
3727 if (EQ (bucket
, make_number (0)))
3729 else if (!SYMBOLP (bucket
))
3730 error ("Bad data in guts of obarray"); /* Like CADR error message */
3732 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3734 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3735 && SCHARS (SYMBOL_NAME (tail
)) == size
3736 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3738 else if (XSYMBOL (tail
)->next
== 0)
3741 XSETINT (tem
, hash
);
3746 hash_string (ptr
, len
)
3747 const unsigned char *ptr
;
3750 register const unsigned char *p
= ptr
;
3751 register const unsigned char *end
= p
+ len
;
3752 register unsigned char c
;
3753 register int hash
= 0;
3758 if (c
>= 0140) c
-= 40;
3759 hash
= ((hash
<<3) + (hash
>>28) + c
);
3761 return hash
& 07777777777;
3765 map_obarray (obarray
, fn
, arg
)
3766 Lisp_Object obarray
;
3767 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3771 register Lisp_Object tail
;
3772 CHECK_VECTOR (obarray
);
3773 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3775 tail
= XVECTOR (obarray
)->contents
[i
];
3780 if (XSYMBOL (tail
)->next
== 0)
3782 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3788 mapatoms_1 (sym
, function
)
3789 Lisp_Object sym
, function
;
3791 call1 (function
, sym
);
3794 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3795 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3796 OBARRAY defaults to the value of `obarray'. */)
3798 Lisp_Object function
, obarray
;
3800 if (NILP (obarray
)) obarray
= Vobarray
;
3801 obarray
= check_obarray (obarray
);
3803 map_obarray (obarray
, mapatoms_1
, function
);
3807 #define OBARRAY_SIZE 1511
3812 Lisp_Object oblength
;
3816 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3818 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3819 Vobarray
= Fmake_vector (oblength
, make_number (0));
3820 initial_obarray
= Vobarray
;
3821 staticpro (&initial_obarray
);
3822 /* Intern nil in the obarray */
3823 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3824 XSYMBOL (Qnil
)->constant
= 1;
3826 /* These locals are to kludge around a pyramid compiler bug. */
3827 hash
= hash_string ("nil", 3);
3828 /* Separate statement here to avoid VAXC bug. */
3829 hash
%= OBARRAY_SIZE
;
3830 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3833 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3834 XSYMBOL (Qnil
)->function
= Qunbound
;
3835 XSYMBOL (Qunbound
)->value
= Qunbound
;
3836 XSYMBOL (Qunbound
)->function
= Qunbound
;
3839 XSYMBOL (Qnil
)->value
= Qnil
;
3840 XSYMBOL (Qnil
)->plist
= Qnil
;
3841 XSYMBOL (Qt
)->value
= Qt
;
3842 XSYMBOL (Qt
)->constant
= 1;
3844 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3847 Qvariable_documentation
= intern ("variable-documentation");
3848 staticpro (&Qvariable_documentation
);
3850 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3851 read_buffer
= (char *) xmalloc (read_buffer_size
);
3856 struct Lisp_Subr
*sname
;
3859 sym
= intern (sname
->symbol_name
);
3860 XSETPVECTYPE (sname
, PVEC_SUBR
);
3861 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3864 #ifdef NOTDEF /* use fset in subr.el now */
3866 defalias (sname
, string
)
3867 struct Lisp_Subr
*sname
;
3871 sym
= intern (string
);
3872 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3876 /* Define an "integer variable"; a symbol whose value is forwarded
3877 to a C variable of type int. Sample call:
3878 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3880 defvar_int (namestring
, address
)
3884 Lisp_Object sym
, val
;
3885 sym
= intern (namestring
);
3886 val
= allocate_misc ();
3887 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3888 XINTFWD (val
)->intvar
= address
;
3889 SET_SYMBOL_VALUE (sym
, val
);
3892 /* Similar but define a variable whose value is t if address contains 1,
3893 nil if address contains 0. */
3895 defvar_bool (namestring
, address
)
3899 Lisp_Object sym
, val
;
3900 sym
= intern (namestring
);
3901 val
= allocate_misc ();
3902 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3903 XBOOLFWD (val
)->boolvar
= address
;
3904 SET_SYMBOL_VALUE (sym
, val
);
3905 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3908 /* Similar but define a variable whose value is the Lisp Object stored
3909 at address. Two versions: with and without gc-marking of the C
3910 variable. The nopro version is used when that variable will be
3911 gc-marked for some other reason, since marking the same slot twice
3912 can cause trouble with strings. */
3914 defvar_lisp_nopro (namestring
, address
)
3916 Lisp_Object
*address
;
3918 Lisp_Object sym
, val
;
3919 sym
= intern (namestring
);
3920 val
= allocate_misc ();
3921 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3922 XOBJFWD (val
)->objvar
= address
;
3923 SET_SYMBOL_VALUE (sym
, val
);
3927 defvar_lisp (namestring
, address
)
3929 Lisp_Object
*address
;
3931 defvar_lisp_nopro (namestring
, address
);
3932 staticpro (address
);
3935 /* Similar but define a variable whose value is the Lisp Object stored
3936 at a particular offset in the current kboard object. */
3939 defvar_kboard (namestring
, offset
)
3943 Lisp_Object sym
, val
;
3944 sym
= intern (namestring
);
3945 val
= allocate_misc ();
3946 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3947 XKBOARD_OBJFWD (val
)->offset
= offset
;
3948 SET_SYMBOL_VALUE (sym
, val
);
3951 /* Record the value of load-path used at the start of dumping
3952 so we can see if the site changed it later during dumping. */
3953 static Lisp_Object dump_path
;
3959 int turn_off_warning
= 0;
3961 /* Compute the default load-path. */
3963 normal
= PATH_LOADSEARCH
;
3964 Vload_path
= decode_env_path (0, normal
);
3966 if (NILP (Vpurify_flag
))
3967 normal
= PATH_LOADSEARCH
;
3969 normal
= PATH_DUMPLOADSEARCH
;
3971 /* In a dumped Emacs, we normally have to reset the value of
3972 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3973 uses ../lisp, instead of the path of the installed elisp
3974 libraries. However, if it appears that Vload_path was changed
3975 from the default before dumping, don't override that value. */
3978 if (! NILP (Fequal (dump_path
, Vload_path
)))
3980 Vload_path
= decode_env_path (0, normal
);
3981 if (!NILP (Vinstallation_directory
))
3983 Lisp_Object tem
, tem1
, sitelisp
;
3985 /* Remove site-lisp dirs from path temporarily and store
3986 them in sitelisp, then conc them on at the end so
3987 they're always first in path. */
3991 tem
= Fcar (Vload_path
);
3992 tem1
= Fstring_match (build_string ("site-lisp"),
3996 Vload_path
= Fcdr (Vload_path
);
3997 sitelisp
= Fcons (tem
, sitelisp
);
4003 /* Add to the path the lisp subdir of the
4004 installation dir, if it exists. */
4005 tem
= Fexpand_file_name (build_string ("lisp"),
4006 Vinstallation_directory
);
4007 tem1
= Ffile_exists_p (tem
);
4010 if (NILP (Fmember (tem
, Vload_path
)))
4012 turn_off_warning
= 1;
4013 Vload_path
= Fcons (tem
, Vload_path
);
4017 /* That dir doesn't exist, so add the build-time
4018 Lisp dirs instead. */
4019 Vload_path
= nconc2 (Vload_path
, dump_path
);
4021 /* Add leim under the installation dir, if it exists. */
4022 tem
= Fexpand_file_name (build_string ("leim"),
4023 Vinstallation_directory
);
4024 tem1
= Ffile_exists_p (tem
);
4027 if (NILP (Fmember (tem
, Vload_path
)))
4028 Vload_path
= Fcons (tem
, Vload_path
);
4031 /* Add site-lisp under the installation dir, if it exists. */
4032 tem
= Fexpand_file_name (build_string ("site-lisp"),
4033 Vinstallation_directory
);
4034 tem1
= Ffile_exists_p (tem
);
4037 if (NILP (Fmember (tem
, Vload_path
)))
4038 Vload_path
= Fcons (tem
, Vload_path
);
4041 /* If Emacs was not built in the source directory,
4042 and it is run from where it was built, add to load-path
4043 the lisp, leim and site-lisp dirs under that directory. */
4045 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4049 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4050 Vinstallation_directory
);
4051 tem1
= Ffile_exists_p (tem
);
4053 /* Don't be fooled if they moved the entire source tree
4054 AFTER dumping Emacs. If the build directory is indeed
4055 different from the source dir, src/Makefile.in and
4056 src/Makefile will not be found together. */
4057 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4058 Vinstallation_directory
);
4059 tem2
= Ffile_exists_p (tem
);
4060 if (!NILP (tem1
) && NILP (tem2
))
4062 tem
= Fexpand_file_name (build_string ("lisp"),
4065 if (NILP (Fmember (tem
, Vload_path
)))
4066 Vload_path
= Fcons (tem
, Vload_path
);
4068 tem
= Fexpand_file_name (build_string ("leim"),
4071 if (NILP (Fmember (tem
, Vload_path
)))
4072 Vload_path
= Fcons (tem
, Vload_path
);
4074 tem
= Fexpand_file_name (build_string ("site-lisp"),
4077 if (NILP (Fmember (tem
, Vload_path
)))
4078 Vload_path
= Fcons (tem
, Vload_path
);
4081 if (!NILP (sitelisp
))
4082 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4088 /* NORMAL refers to the lisp dir in the source directory. */
4089 /* We used to add ../lisp at the front here, but
4090 that caused trouble because it was copied from dump_path
4091 into Vload_path, above, when Vinstallation_directory was non-nil.
4092 It should be unnecessary. */
4093 Vload_path
= decode_env_path (0, normal
);
4094 dump_path
= Vload_path
;
4098 #if (!(defined(WINDOWSNT) || (defined(HAVE_NS))))
4099 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4100 almost never correct, thereby causing a warning to be printed out that
4101 confuses users. Since PATH_LOADSEARCH is always overridden by the
4102 EMACSLOADPATH environment variable below, disable the warning on NT. */
4104 /* Warn if dirs in the *standard* path don't exist. */
4105 if (!turn_off_warning
)
4107 Lisp_Object path_tail
;
4109 for (path_tail
= Vload_path
;
4111 path_tail
= XCDR (path_tail
))
4113 Lisp_Object dirfile
;
4114 dirfile
= Fcar (path_tail
);
4115 if (STRINGP (dirfile
))
4117 dirfile
= Fdirectory_file_name (dirfile
);
4118 if (access (SDATA (dirfile
), 0) < 0)
4119 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4124 #endif /* !(WINDOWSNT || HAVE_NS) */
4126 /* If the EMACSLOADPATH environment variable is set, use its value.
4127 This doesn't apply if we're dumping. */
4129 if (NILP (Vpurify_flag
)
4130 && egetenv ("EMACSLOADPATH"))
4132 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4136 load_in_progress
= 0;
4137 Vload_file_name
= Qnil
;
4139 load_descriptor_list
= Qnil
;
4141 Vstandard_input
= Qt
;
4142 Vloads_in_progress
= Qnil
;
4145 /* Print a warning, using format string FORMAT, that directory DIRNAME
4146 does not exist. Print it on stderr and put it in *Messages*. */
4149 dir_warning (format
, dirname
)
4151 Lisp_Object dirname
;
4154 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4156 fprintf (stderr
, format
, SDATA (dirname
));
4157 sprintf (buffer
, format
, SDATA (dirname
));
4158 /* Don't log the warning before we've initialized!! */
4160 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4167 defsubr (&Sread_from_string
);
4169 defsubr (&Sintern_soft
);
4170 defsubr (&Sunintern
);
4171 defsubr (&Sget_load_suffixes
);
4173 defsubr (&Seval_buffer
);
4174 defsubr (&Seval_region
);
4175 defsubr (&Sread_char
);
4176 defsubr (&Sread_char_exclusive
);
4177 defsubr (&Sread_event
);
4178 defsubr (&Sget_file_char
);
4179 defsubr (&Smapatoms
);
4180 defsubr (&Slocate_file_internal
);
4182 DEFVAR_LISP ("obarray", &Vobarray
,
4183 doc
: /* Symbol table for use by `intern' and `read'.
4184 It is a vector whose length ought to be prime for best results.
4185 The vector's contents don't make sense if examined from Lisp programs;
4186 to find all the symbols in an obarray, use `mapatoms'. */);
4188 DEFVAR_LISP ("values", &Vvalues
,
4189 doc
: /* List of values of all expressions which were read, evaluated and printed.
4190 Order is reverse chronological. */);
4192 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4193 doc
: /* Stream for read to get input from.
4194 See documentation of `read' for possible values. */);
4195 Vstandard_input
= Qt
;
4197 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4198 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4200 If this variable is a buffer, then only forms read from that buffer
4201 will be added to `read-symbol-positions-list'.
4202 If this variable is t, then all read forms will be added.
4203 The effect of all other values other than nil are not currently
4204 defined, although they may be in the future.
4206 The positions are relative to the last call to `read' or
4207 `read-from-string'. It is probably a bad idea to set this variable at
4208 the toplevel; bind it instead. */);
4209 Vread_with_symbol_positions
= Qnil
;
4211 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4212 doc
: /* A list mapping read symbols to their positions.
4213 This variable is modified during calls to `read' or
4214 `read-from-string', but only when `read-with-symbol-positions' is
4217 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4218 CHAR-POSITION is an integer giving the offset of that occurrence of the
4219 symbol from the position where `read' or `read-from-string' started.
4221 Note that a symbol will appear multiple times in this list, if it was
4222 read multiple times. The list is in the same order as the symbols
4224 Vread_symbol_positions_list
= Qnil
;
4226 DEFVAR_LISP ("read-circle", &Vread_circle
,
4227 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4230 DEFVAR_LISP ("load-path", &Vload_path
,
4231 doc
: /* *List of directories to search for files to load.
4232 Each element is a string (directory name) or nil (try default directory).
4233 Initialized based on EMACSLOADPATH environment variable, if any,
4234 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4236 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4237 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4238 This list should not include the empty string.
4239 `load' and related functions try to append these suffixes, in order,
4240 to the specified file name if a Lisp suffix is allowed or required. */);
4241 Vload_suffixes
= Fcons (build_string (".elc"),
4242 Fcons (build_string (".el"), Qnil
));
4243 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4244 doc
: /* List of suffixes that indicate representations of \
4246 This list should normally start with the empty string.
4248 Enabling Auto Compression mode appends the suffixes in
4249 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4250 mode removes them again. `load' and related functions use this list to
4251 determine whether they should look for compressed versions of a file
4252 and, if so, which suffixes they should try to append to the file name
4253 in order to do so. However, if you want to customize which suffixes
4254 the loading functions recognize as compression suffixes, you should
4255 customize `jka-compr-load-suffixes' rather than the present variable. */);
4256 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4258 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4259 doc
: /* Non-nil if inside of `load'. */);
4260 Qload_in_progress
= intern ("load-in-progress");
4261 staticpro (&Qload_in_progress
);
4263 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4264 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4265 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4267 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4268 a symbol \(a feature name).
4270 When `load' is run and the file-name argument matches an element's
4271 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4272 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4274 An error in FORMS does not undo the load, but does prevent execution of
4275 the rest of the FORMS. */);
4276 Vafter_load_alist
= Qnil
;
4278 DEFVAR_LISP ("load-history", &Vload_history
,
4279 doc
: /* Alist mapping file names to symbols and features.
4280 Each alist element is a list that starts with a file name,
4281 except for one element (optional) that starts with nil and describes
4282 definitions evaluated from buffers not visiting files.
4284 The file name is absolute and is the true file name (i.e. it doesn't
4285 contain symbolic links) of the loaded file.
4287 The remaining elements of each list are symbols defined as variables
4288 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4289 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4290 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4291 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
4292 this file redefined it as a function.
4294 During preloading, the file name recorded is relative to the main Lisp
4295 directory. These file names are converted to absolute at startup. */);
4296 Vload_history
= Qnil
;
4298 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4299 doc
: /* Full name of file being loaded by `load'. */);
4300 Vload_file_name
= Qnil
;
4302 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4303 doc
: /* File name, including directory, of user's initialization file.
4304 If the file loaded had extension `.elc', and the corresponding source file
4305 exists, this variable contains the name of source file, suitable for use
4306 by functions like `custom-save-all' which edit the init file.
4307 While Emacs loads and evaluates the init file, value is the real name
4308 of the file, regardless of whether or not it has the `.elc' extension. */);
4309 Vuser_init_file
= Qnil
;
4311 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4312 doc
: /* Used for internal purposes by `load'. */);
4313 Vcurrent_load_list
= Qnil
;
4315 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4316 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4317 The default is nil, which means use the function `read'. */);
4318 Vload_read_function
= Qnil
;
4320 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4321 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4322 This function is for doing code conversion before reading the source file.
4323 If nil, loading is done without any code conversion.
4324 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4325 FULLNAME is the full name of FILE.
4326 See `load' for the meaning of the remaining arguments. */);
4327 Vload_source_file_function
= Qnil
;
4329 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4330 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4331 This is useful when the file being loaded is a temporary copy. */);
4332 load_force_doc_strings
= 0;
4334 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4335 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4336 This is normally bound by `load' and `eval-buffer' to control `read',
4337 and is not meant for users to change. */);
4338 load_convert_to_unibyte
= 0;
4340 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4341 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4342 You cannot count on them to still be there! */);
4344 = Fexpand_file_name (build_string ("../"),
4345 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4347 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4348 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4349 Vpreloaded_file_list
= Qnil
;
4351 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4352 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4353 Vbyte_boolean_vars
= Qnil
;
4355 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4356 doc
: /* Non-nil means load dangerous compiled Lisp files.
4357 Some versions of XEmacs use different byte codes than Emacs. These
4358 incompatible byte codes can make Emacs crash when it tries to execute
4360 load_dangerous_libraries
= 0;
4362 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4363 doc
: /* Non-nil means force printing messages when loading Lisp files.
4364 This overrides the value of the NOMESSAGE argument to `load'. */);
4365 force_load_messages
= 0;
4367 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4368 doc
: /* Regular expression matching safe to load compiled Lisp files.
4369 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4370 from the file, and matches them against this regular expression.
4371 When the regular expression matches, the file is considered to be safe
4372 to load. See also `load-dangerous-libraries'. */);
4373 Vbytecomp_version_regexp
4374 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4376 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4377 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4378 Veval_buffer_list
= Qnil
;
4380 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4381 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4382 Vold_style_backquotes
= Qnil
;
4383 Qold_style_backquotes
= intern ("old-style-backquotes");
4384 staticpro (&Qold_style_backquotes
);
4386 /* Vsource_directory was initialized in init_lread. */
4388 load_descriptor_list
= Qnil
;
4389 staticpro (&load_descriptor_list
);
4391 Qcurrent_load_list
= intern ("current-load-list");
4392 staticpro (&Qcurrent_load_list
);
4394 Qstandard_input
= intern ("standard-input");
4395 staticpro (&Qstandard_input
);
4397 Qread_char
= intern ("read-char");
4398 staticpro (&Qread_char
);
4400 Qget_file_char
= intern ("get-file-char");
4401 staticpro (&Qget_file_char
);
4403 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4404 staticpro (&Qget_emacs_mule_file_char
);
4406 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4407 staticpro (&Qload_force_doc_strings
);
4409 Qbackquote
= intern ("`");
4410 staticpro (&Qbackquote
);
4411 Qcomma
= intern (",");
4412 staticpro (&Qcomma
);
4413 Qcomma_at
= intern (",@");
4414 staticpro (&Qcomma_at
);
4415 Qcomma_dot
= intern (",.");
4416 staticpro (&Qcomma_dot
);
4418 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4419 staticpro (&Qinhibit_file_name_operation
);
4421 Qascii_character
= intern ("ascii-character");
4422 staticpro (&Qascii_character
);
4424 Qfunction
= intern ("function");
4425 staticpro (&Qfunction
);
4427 Qload
= intern ("load");
4430 Qload_file_name
= intern ("load-file-name");
4431 staticpro (&Qload_file_name
);
4433 Qeval_buffer_list
= intern ("eval-buffer-list");
4434 staticpro (&Qeval_buffer_list
);
4436 Qfile_truename
= intern ("file-truename");
4437 staticpro (&Qfile_truename
) ;
4439 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4440 staticpro (&Qdo_after_load_evaluation
) ;
4442 staticpro (&dump_path
);
4444 staticpro (&read_objects
);
4445 read_objects
= Qnil
;
4446 staticpro (&seen_list
);
4449 Vloads_in_progress
= Qnil
;
4450 staticpro (&Vloads_in_progress
);
4453 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4454 (do not change this comment) */