1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
65 #define file_offset off_t
66 #define file_tell ftello
68 #define file_offset long
69 #define file_tell ftell
72 /* hash table read constants */
73 Lisp_Object Qhash_table
, Qdata
;
74 Lisp_Object Qtest
, Qsize
;
75 Lisp_Object Qweakness
;
76 Lisp_Object Qrehash_size
;
77 Lisp_Object Qrehash_threshold
;
78 extern Lisp_Object QCtest
, QCsize
, QCrehash_size
, QCrehash_threshold
, QCweakness
;
80 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
81 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
82 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
83 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
84 Lisp_Object Qinhibit_file_name_operation
;
85 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
86 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
88 /* Used instead of Qget_file_char while loading *.elc files compiled
89 by Emacs 21 or older. */
90 static Lisp_Object Qget_emacs_mule_file_char
;
92 static Lisp_Object Qload_force_doc_strings
;
94 extern Lisp_Object Qevent_symbol_element_mask
;
95 extern Lisp_Object Qfile_exists_p
;
97 /* non-zero if inside `load' */
99 static Lisp_Object Qload_in_progress
;
101 /* Directory in which the sources were found. */
102 Lisp_Object Vsource_directory
;
104 /* Search path and suffixes for files to be loaded. */
105 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
107 /* File name of user's init file. */
108 Lisp_Object Vuser_init_file
;
110 /* This is the user-visible association list that maps features to
111 lists of defs in their load files. */
112 Lisp_Object Vload_history
;
114 /* This is used to build the load history. */
115 Lisp_Object Vcurrent_load_list
;
117 /* List of files that were preloaded. */
118 Lisp_Object Vpreloaded_file_list
;
120 /* Name of file actually being read by `load'. */
121 Lisp_Object Vload_file_name
;
123 /* Function to use for reading, in `load' and friends. */
124 Lisp_Object Vload_read_function
;
126 /* Non-nil means read recursive structures using #n= and #n# syntax. */
127 Lisp_Object Vread_circle
;
129 /* The association list of objects read with the #n=object form.
130 Each member of the list has the form (n . object), and is used to
131 look up the object for the corresponding #n# construct.
132 It must be set to nil before all top-level calls to read0. */
133 Lisp_Object read_objects
;
135 /* Nonzero means load should forcibly load all dynamic doc strings. */
136 static int load_force_doc_strings
;
138 /* Nonzero means read should convert strings to unibyte. */
139 static int load_convert_to_unibyte
;
141 /* Nonzero means READCHAR should read bytes one by one (not character)
142 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
143 This is set to 1 by read1 temporarily while handling #@NUMBER. */
144 static int load_each_byte
;
146 /* Function to use for loading an Emacs Lisp source file (not
147 compiled) instead of readevalloop. */
148 Lisp_Object Vload_source_file_function
;
150 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
151 Lisp_Object Vbyte_boolean_vars
;
153 /* Whether or not to add a `read-positions' property to symbols
155 Lisp_Object Vread_with_symbol_positions
;
157 /* List of (SYMBOL . POSITION) accumulated so far. */
158 Lisp_Object Vread_symbol_positions_list
;
160 /* List of descriptors now open for Fload. */
161 static Lisp_Object load_descriptor_list
;
163 /* File for get_file_char to read from. Use by load. */
164 static FILE *instream
;
166 /* When nonzero, read conses in pure space */
167 static int read_pure
;
169 /* For use within read-from-string (this reader is non-reentrant!!) */
170 static int read_from_string_index
;
171 static int read_from_string_index_byte
;
172 static int read_from_string_limit
;
174 /* Number of characters read in the current call to Fread or
175 Fread_from_string. */
176 static int readchar_count
;
178 /* This contains the last string skipped with #@. */
179 static char *saved_doc_string
;
180 /* Length of buffer allocated in saved_doc_string. */
181 static int saved_doc_string_size
;
182 /* Length of actual data in saved_doc_string. */
183 static int saved_doc_string_length
;
184 /* This is the file position that string came from. */
185 static file_offset saved_doc_string_position
;
187 /* This contains the previous string skipped with #@.
188 We copy it from saved_doc_string when a new string
189 is put in saved_doc_string. */
190 static char *prev_saved_doc_string
;
191 /* Length of buffer allocated in prev_saved_doc_string. */
192 static int prev_saved_doc_string_size
;
193 /* Length of actual data in prev_saved_doc_string. */
194 static int prev_saved_doc_string_length
;
195 /* This is the file position that string came from. */
196 static file_offset prev_saved_doc_string_position
;
198 /* Nonzero means inside a new-style backquote
199 with no surrounding parentheses.
200 Fread initializes this to zero, so we need not specbind it
201 or worry about what happens to it when there is an error. */
202 static int new_backquote_flag
;
203 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
205 /* A list of file names for files being loaded in Fload. Used to
206 check for recursive loads. */
208 static Lisp_Object Vloads_in_progress
;
210 /* Non-zero means load dangerous compiled Lisp files. */
212 int load_dangerous_libraries
;
214 /* Non-zero means force printing messages when loading Lisp files. */
216 int force_load_messages
;
218 /* A regular expression used to detect files compiled with Emacs. */
220 static Lisp_Object Vbytecomp_version_regexp
;
222 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
225 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
,
226 Lisp_Object (*) (Lisp_Object
), int,
227 Lisp_Object
, Lisp_Object
,
228 Lisp_Object
, Lisp_Object
);
229 static Lisp_Object
load_unwind (Lisp_Object
);
230 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
232 static void invalid_syntax (const char *, int) NO_RETURN
;
233 static void end_of_file_error (void) NO_RETURN
;
236 /* Functions that read one byte from the current source READCHARFUN
237 or unreads one byte. If the integer argument C is -1, it returns
238 one read byte, or -1 when there's no more byte in the source. If C
239 is 0 or positive, it unreads C, and the return value is not
242 static int readbyte_for_lambda (int, Lisp_Object
);
243 static int readbyte_from_file (int, Lisp_Object
);
244 static int readbyte_from_string (int, Lisp_Object
);
246 /* Handle unreading and rereading of characters.
247 Write READCHAR to read a character,
248 UNREAD(c) to unread c to be read again.
250 These macros correctly read/unread multibyte characters. */
252 #define READCHAR readchar (readcharfun, NULL)
253 #define UNREAD(c) unreadchar (readcharfun, c)
255 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
256 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
258 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
259 Qlambda, or a cons, we use this to keep an unread character because
260 a file stream can't handle multibyte-char unreading. The value -1
261 means that there's no unread character. */
262 static int unread_char
;
265 readchar (Lisp_Object readcharfun
, int *multibyte
)
269 int (*readbyte
) (int, Lisp_Object
);
270 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
272 int emacs_mule_encoding
= 0;
279 if (BUFFERP (readcharfun
))
281 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
283 int pt_byte
= BUF_PT_BYTE (inbuffer
);
285 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
288 if (! NILP (inbuffer
->enable_multibyte_characters
))
290 /* Fetch the character code from the buffer. */
291 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
292 BUF_INC_POS (inbuffer
, pt_byte
);
299 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
300 if (! ASCII_BYTE_P (c
))
301 c
= BYTE8_TO_CHAR (c
);
304 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
308 if (MARKERP (readcharfun
))
310 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
312 int bytepos
= marker_byte_position (readcharfun
);
314 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
317 if (! NILP (inbuffer
->enable_multibyte_characters
))
319 /* Fetch the character code from the buffer. */
320 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
321 BUF_INC_POS (inbuffer
, bytepos
);
328 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
329 if (! ASCII_BYTE_P (c
))
330 c
= BYTE8_TO_CHAR (c
);
334 XMARKER (readcharfun
)->bytepos
= bytepos
;
335 XMARKER (readcharfun
)->charpos
++;
340 if (EQ (readcharfun
, Qlambda
))
342 readbyte
= readbyte_for_lambda
;
346 if (EQ (readcharfun
, Qget_file_char
))
348 readbyte
= readbyte_from_file
;
352 if (STRINGP (readcharfun
))
354 if (read_from_string_index
>= read_from_string_limit
)
356 else if (STRING_MULTIBYTE (readcharfun
))
360 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
361 read_from_string_index
,
362 read_from_string_index_byte
);
366 c
= SREF (readcharfun
, read_from_string_index_byte
);
367 read_from_string_index
++;
368 read_from_string_index_byte
++;
373 if (CONSP (readcharfun
))
375 /* This is the case that read_vector is reading from a unibyte
376 string that contains a byte sequence previously skipped
377 because of #@NUMBER. The car part of readcharfun is that
378 string, and the cdr part is a value of readcharfun given to
380 readbyte
= readbyte_from_string
;
381 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
382 emacs_mule_encoding
= 1;
386 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
388 readbyte
= readbyte_from_file
;
389 emacs_mule_encoding
= 1;
393 tem
= call0 (readcharfun
);
400 if (unread_char
>= 0)
406 c
= (*readbyte
) (-1, readcharfun
);
407 if (c
< 0 || load_each_byte
)
411 if (ASCII_BYTE_P (c
))
413 if (emacs_mule_encoding
)
414 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
417 len
= BYTES_BY_CHAR_HEAD (c
);
420 c
= (*readbyte
) (-1, readcharfun
);
421 if (c
< 0 || ! TRAILING_CODE_P (c
))
424 (*readbyte
) (buf
[i
], readcharfun
);
425 return BYTE8_TO_CHAR (buf
[0]);
429 return STRING_CHAR (buf
);
432 /* Unread the character C in the way appropriate for the stream READCHARFUN.
433 If the stream is a user function, call it with the char as argument. */
436 unreadchar (Lisp_Object readcharfun
, int c
)
440 /* Don't back up the pointer if we're unreading the end-of-input mark,
441 since readchar didn't advance it when we read it. */
443 else if (BUFFERP (readcharfun
))
445 struct buffer
*b
= XBUFFER (readcharfun
);
446 int bytepos
= BUF_PT_BYTE (b
);
449 if (! NILP (b
->enable_multibyte_characters
))
450 BUF_DEC_POS (b
, bytepos
);
454 BUF_PT_BYTE (b
) = bytepos
;
456 else if (MARKERP (readcharfun
))
458 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
459 int bytepos
= XMARKER (readcharfun
)->bytepos
;
461 XMARKER (readcharfun
)->charpos
--;
462 if (! NILP (b
->enable_multibyte_characters
))
463 BUF_DEC_POS (b
, bytepos
);
467 XMARKER (readcharfun
)->bytepos
= bytepos
;
469 else if (STRINGP (readcharfun
))
471 read_from_string_index
--;
472 read_from_string_index_byte
473 = string_char_to_byte (readcharfun
, read_from_string_index
);
475 else if (CONSP (readcharfun
))
479 else if (EQ (readcharfun
, Qlambda
))
483 else if (EQ (readcharfun
, Qget_file_char
)
484 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
489 ungetc (c
, instream
);
496 call1 (readcharfun
, make_number (c
));
500 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
502 return read_bytecode_char (c
>= 0);
507 readbyte_from_file (int c
, Lisp_Object readcharfun
)
512 ungetc (c
, instream
);
521 /* Interrupted reads have been observed while reading over the network */
522 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
534 return (c
== EOF
? -1 : c
);
538 readbyte_from_string (int c
, Lisp_Object readcharfun
)
540 Lisp_Object string
= XCAR (readcharfun
);
544 read_from_string_index
--;
545 read_from_string_index_byte
546 = string_char_to_byte (string
, read_from_string_index
);
549 if (read_from_string_index
>= read_from_string_limit
)
552 FETCH_STRING_CHAR_ADVANCE (c
, string
,
553 read_from_string_index
,
554 read_from_string_index_byte
);
559 /* Read one non-ASCII character from INSTREAM. The character is
560 encoded in `emacs-mule' and the first byte is already read in
563 extern char emacs_mule_bytes
[256];
566 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
568 /* Emacs-mule coding uses at most 4-byte for one character. */
569 unsigned char buf
[4];
570 int len
= emacs_mule_bytes
[c
];
571 struct charset
*charset
;
576 /* C is not a valid leading-code of `emacs-mule'. */
577 return BYTE8_TO_CHAR (c
);
583 c
= (*readbyte
) (-1, readcharfun
);
587 (*readbyte
) (buf
[i
], readcharfun
);
588 return BYTE8_TO_CHAR (buf
[0]);
595 charset
= emacs_mule_charset
[buf
[0]];
596 code
= buf
[1] & 0x7F;
600 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
601 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
603 charset
= emacs_mule_charset
[buf
[1]];
604 code
= buf
[2] & 0x7F;
608 charset
= emacs_mule_charset
[buf
[0]];
609 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
614 charset
= emacs_mule_charset
[buf
[1]];
615 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
617 c
= DECODE_CHAR (charset
, code
);
619 Fsignal (Qinvalid_read_syntax
,
620 Fcons (build_string ("invalid multibyte form"), Qnil
));
625 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
627 static Lisp_Object
read0 (Lisp_Object
);
628 static Lisp_Object
read1 (Lisp_Object
, int *, int);
630 static Lisp_Object
read_list (int, Lisp_Object
);
631 static Lisp_Object
read_vector (Lisp_Object
, int);
633 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
635 static void substitute_object_in_subtree (Lisp_Object
,
637 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
640 /* Get a character from the tty. */
642 /* Read input events until we get one that's acceptable for our purposes.
644 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
645 until we get a character we like, and then stuffed into
648 If ASCII_REQUIRED is non-zero, we check function key events to see
649 if the unmodified version of the symbol has a Qascii_character
650 property, and use that character, if present.
652 If ERROR_NONASCII is non-zero, we signal an error if the input we
653 get isn't an ASCII character with modifiers. If it's zero but
654 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
657 If INPUT_METHOD is nonzero, we invoke the current input method
658 if the character warrants that.
660 If SECONDS is a number, we wait that many seconds for input, and
661 return Qnil if no input arrives within that time. */
664 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
665 input_method
, seconds
)
666 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
669 Lisp_Object val
, delayed_switch_frame
;
672 #ifdef HAVE_WINDOW_SYSTEM
673 if (display_hourglass_p
)
677 delayed_switch_frame
= Qnil
;
679 /* Compute timeout. */
680 if (NUMBERP (seconds
))
682 EMACS_TIME wait_time
;
684 double duration
= extract_float (seconds
);
686 sec
= (int) duration
;
687 usec
= (duration
- sec
) * 1000000;
688 EMACS_GET_TIME (end_time
);
689 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
690 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
693 /* Read until we get an acceptable event. */
696 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
697 NUMBERP (seconds
) ? &end_time
: NULL
);
698 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
703 /* switch-frame events are put off until after the next ASCII
704 character. This is better than signaling an error just because
705 the last characters were typed to a separate minibuffer frame,
706 for example. Eventually, some code which can deal with
707 switch-frame events will read it and process it. */
709 && EVENT_HAS_PARAMETERS (val
)
710 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
712 delayed_switch_frame
= val
;
716 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
718 /* Convert certain symbols to their ASCII equivalents. */
721 Lisp_Object tem
, tem1
;
722 tem
= Fget (val
, Qevent_symbol_element_mask
);
725 tem1
= Fget (Fcar (tem
), Qascii_character
);
726 /* Merge this symbol's modifier bits
727 with the ASCII equivalent of its basic code. */
729 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
733 /* If we don't have a character now, deal with it appropriately. */
738 Vunread_command_events
= Fcons (val
, Qnil
);
739 error ("Non-character input-event");
746 if (! NILP (delayed_switch_frame
))
747 unread_switch_frame
= delayed_switch_frame
;
751 #ifdef HAVE_WINDOW_SYSTEM
752 if (display_hourglass_p
)
761 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
762 doc
: /* Read a character from the command input (keyboard or macro).
763 It is returned as a number.
764 If the character has modifiers, they are resolved and reflected to the
765 character code if possible (e.g. C-SPC -> 0).
767 If the user generates an event which is not a character (i.e. a mouse
768 click or function key event), `read-char' signals an error. As an
769 exception, switch-frame events are put off until non-character events
771 If you want to read non-character events, or ignore them, call
772 `read-event' or `read-char-exclusive' instead.
774 If the optional argument PROMPT is non-nil, display that as a prompt.
775 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
776 input method is turned on in the current buffer, that input method
777 is used for reading a character.
778 If the optional argument SECONDS is non-nil, it should be a number
779 specifying the maximum number of seconds to wait for input. If no
780 input arrives in that time, return nil. SECONDS may be a
781 floating-point value. */)
782 (prompt
, inherit_input_method
, seconds
)
783 Lisp_Object prompt
, inherit_input_method
, seconds
;
788 message_with_string ("%s", prompt
, 0);
789 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
791 return (NILP (val
) ? Qnil
792 : make_number (char_resolve_modifier_mask (XINT (val
))));
795 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
796 doc
: /* Read an event object from the input stream.
797 If the optional argument PROMPT is non-nil, display that as a prompt.
798 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
799 input method is turned on in the current buffer, that input method
800 is used for reading a character.
801 If the optional argument SECONDS is non-nil, it should be a number
802 specifying the maximum number of seconds to wait for input. If no
803 input arrives in that time, return nil. SECONDS may be a
804 floating-point value. */)
805 (prompt
, inherit_input_method
, seconds
)
806 Lisp_Object prompt
, inherit_input_method
, seconds
;
809 message_with_string ("%s", prompt
, 0);
810 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
813 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
814 doc
: /* Read a character from the command input (keyboard or macro).
815 It is returned as a number. Non-character events are ignored.
816 If the character has modifiers, they are resolved and reflected to the
817 character code if possible (e.g. C-SPC -> 0).
819 If the optional argument PROMPT is non-nil, display that as a prompt.
820 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
821 input method is turned on in the current buffer, that input method
822 is used for reading a character.
823 If the optional argument SECONDS is non-nil, it should be a number
824 specifying the maximum number of seconds to wait for input. If no
825 input arrives in that time, return nil. SECONDS may be a
826 floating-point value. */)
827 (prompt
, inherit_input_method
, seconds
)
828 Lisp_Object prompt
, inherit_input_method
, seconds
;
833 message_with_string ("%s", prompt
, 0);
835 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
837 return (NILP (val
) ? Qnil
838 : make_number (char_resolve_modifier_mask (XINT (val
))));
841 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
842 doc
: /* Don't use this yourself. */)
845 register Lisp_Object val
;
847 XSETINT (val
, getc (instream
));
854 /* Value is a version number of byte compiled code if the file
855 associated with file descriptor FD is a compiled Lisp file that's
856 safe to load. Only files compiled with Emacs are safe to load.
857 Files compiled with XEmacs can lead to a crash in Fbyte_code
858 because of an incompatible change in the byte compiler. */
861 safe_to_load_p (int fd
)
868 /* Read the first few bytes from the file, and look for a line
869 specifying the byte compiler version used. */
870 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
875 /* Skip to the next newline, skipping over the initial `ELC'
876 with NUL bytes following it, but note the version. */
877 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
882 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
889 lseek (fd
, 0, SEEK_SET
);
894 /* Callback for record_unwind_protect. Restore the old load list OLD,
895 after loading a file successfully. */
898 record_load_unwind (Lisp_Object old
)
900 return Vloads_in_progress
= old
;
903 /* This handler function is used via internal_condition_case_1. */
906 load_error_handler (Lisp_Object data
)
912 load_warn_old_style_backquotes (Lisp_Object file
)
914 if (!NILP (Vold_style_backquotes
))
917 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
924 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
925 doc
: /* Return the suffixes that `load' should try if a suffix is \
927 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
930 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
931 while (CONSP (suffixes
))
933 Lisp_Object exts
= Vload_file_rep_suffixes
;
934 suffix
= XCAR (suffixes
);
935 suffixes
= XCDR (suffixes
);
940 lst
= Fcons (concat2 (suffix
, ext
), lst
);
943 return Fnreverse (lst
);
946 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
947 doc
: /* Execute a file of Lisp code named FILE.
948 First try FILE with `.elc' appended, then try with `.el',
949 then try FILE unmodified (the exact suffixes in the exact order are
950 determined by `load-suffixes'). Environment variable references in
951 FILE are replaced with their values by calling `substitute-in-file-name'.
952 This function searches the directories in `load-path'.
954 If optional second arg NOERROR is non-nil,
955 report no error if FILE doesn't exist.
956 Print messages at start and end of loading unless
957 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
959 If optional fourth arg NOSUFFIX is non-nil, don't try adding
960 suffixes `.elc' or `.el' to the specified name FILE.
961 If optional fifth arg MUST-SUFFIX is non-nil, insist on
962 the suffix `.elc' or `.el'; don't accept just FILE unless
963 it ends in one of those suffixes or includes a directory name.
965 If this function fails to find a file, it may look for different
966 representations of that file before trying another file.
967 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
968 to the file name. Emacs uses this feature mainly to find compressed
969 versions of files when Auto Compression mode is enabled.
971 The exact suffixes that this function tries out, in the exact order,
972 are given by the value of the variable `load-file-rep-suffixes' if
973 NOSUFFIX is non-nil and by the return value of the function
974 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
975 MUST-SUFFIX are nil, this function first tries out the latter suffixes
978 Loading a file records its definitions, and its `provide' and
979 `require' calls, in an element of `load-history' whose
980 car is the file name loaded. See `load-history'.
982 Return t if the file exists and loads successfully. */)
983 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
984 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
986 register FILE *stream
;
987 register int fd
= -1;
988 int count
= SPECPDL_INDEX ();
989 struct gcpro gcpro1
, gcpro2
, gcpro3
;
990 Lisp_Object found
, efound
, hist_file_name
;
991 /* 1 means we printed the ".el is newer" message. */
993 /* 1 means we are loading a compiled file. */
1005 CHECK_STRING (file
);
1007 /* If file name is magic, call the handler. */
1008 /* This shouldn't be necessary any more now that `openp' handles it right.
1009 handler = Ffind_file_name_handler (file, Qload);
1010 if (!NILP (handler))
1011 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1013 /* Do this after the handler to avoid
1014 the need to gcpro noerror, nomessage and nosuffix.
1015 (Below here, we care only whether they are nil or not.)
1016 The presence of this call is the result of a historical accident:
1017 it used to be in every file-operation and when it got removed
1018 everywhere, it accidentally stayed here. Since then, enough people
1019 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1020 that it seemed risky to remove. */
1021 if (! NILP (noerror
))
1023 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1024 Qt
, load_error_handler
);
1029 file
= Fsubstitute_in_file_name (file
);
1032 /* Avoid weird lossage with null string as arg,
1033 since it would try to load a directory as a Lisp file */
1034 if (SCHARS (file
) > 0)
1036 int size
= SBYTES (file
);
1039 GCPRO2 (file
, found
);
1041 if (! NILP (must_suffix
))
1043 /* Don't insist on adding a suffix if FILE already ends with one. */
1045 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1048 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1050 /* Don't insist on adding a suffix
1051 if the argument includes a directory name. */
1052 else if (! NILP (Ffile_name_directory (file
)))
1056 fd
= openp (Vload_path
, file
,
1057 (!NILP (nosuffix
) ? Qnil
1058 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1059 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1060 tmp
[1] = Vload_file_rep_suffixes
,
1069 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1073 /* Tell startup.el whether or not we found the user's init file. */
1074 if (EQ (Qt
, Vuser_init_file
))
1075 Vuser_init_file
= found
;
1077 /* If FD is -2, that means openp found a magic file. */
1080 if (NILP (Fequal (found
, file
)))
1081 /* If FOUND is a different file name from FILE,
1082 find its handler even if we have already inhibited
1083 the `load' operation on FILE. */
1084 handler
= Ffind_file_name_handler (found
, Qt
);
1086 handler
= Ffind_file_name_handler (found
, Qload
);
1087 if (! NILP (handler
))
1088 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1091 /* Check if we're stuck in a recursive load cycle.
1093 2000-09-21: It's not possible to just check for the file loaded
1094 being a member of Vloads_in_progress. This fails because of the
1095 way the byte compiler currently works; `provide's are not
1096 evaluated, see font-lock.el/jit-lock.el as an example. This
1097 leads to a certain amount of ``normal'' recursion.
1099 Also, just loading a file recursively is not always an error in
1100 the general case; the second load may do something different. */
1104 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1105 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1109 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1111 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1112 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1115 /* Get the name for load-history. */
1116 hist_file_name
= (! NILP (Vpurify_flag
)
1117 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1118 tmp
[1] = Ffile_name_nondirectory (found
),
1124 /* Check for the presence of old-style quotes and warn about them. */
1125 specbind (Qold_style_backquotes
, Qnil
);
1126 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1128 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1129 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1130 /* Load .elc files directly, but not when they are
1131 remote and have no handler! */
1138 GCPRO3 (file
, found
, hist_file_name
);
1141 && ! (version
= safe_to_load_p (fd
)))
1144 if (!load_dangerous_libraries
)
1148 error ("File `%s' was not compiled in Emacs",
1151 else if (!NILP (nomessage
) && !force_load_messages
)
1152 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1157 efound
= ENCODE_FILE (found
);
1162 stat ((char *)SDATA (efound
), &s1
);
1163 SSET (efound
, SBYTES (efound
) - 1, 0);
1164 result
= stat ((char *)SDATA (efound
), &s2
);
1165 SSET (efound
, SBYTES (efound
) - 1, 'c');
1167 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1169 /* Make the progress messages mention that source is newer. */
1172 /* If we won't print another message, mention this anyway. */
1173 if (!NILP (nomessage
) && !force_load_messages
)
1175 Lisp_Object msg_file
;
1176 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1177 message_with_string ("Source file `%s' newer than byte-compiled file",
1186 /* We are loading a source file (*.el). */
1187 if (!NILP (Vload_source_file_function
))
1193 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1194 NILP (noerror
) ? Qnil
: Qt
,
1195 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1196 return unbind_to (count
, val
);
1200 GCPRO3 (file
, found
, hist_file_name
);
1204 efound
= ENCODE_FILE (found
);
1205 stream
= fopen ((char *) SDATA (efound
), fmode
);
1206 #else /* not WINDOWSNT */
1207 stream
= fdopen (fd
, fmode
);
1208 #endif /* not WINDOWSNT */
1212 error ("Failure to create stdio stream for %s", SDATA (file
));
1215 if (! NILP (Vpurify_flag
))
1216 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1218 if (NILP (nomessage
) || force_load_messages
)
1221 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1224 message_with_string ("Loading %s (source)...", file
, 1);
1226 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1228 else /* The typical case; compiled file newer than source file. */
1229 message_with_string ("Loading %s...", file
, 1);
1232 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1233 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1234 specbind (Qload_file_name
, found
);
1235 specbind (Qinhibit_file_name_operation
, Qnil
);
1236 load_descriptor_list
1237 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1238 specbind (Qload_in_progress
, Qt
);
1239 if (! version
|| version
>= 22)
1240 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1241 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1244 /* We can't handle a file which was compiled with
1245 byte-compile-dynamic by older version of Emacs. */
1246 specbind (Qload_force_doc_strings
, Qt
);
1247 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1248 0, Qnil
, Qnil
, Qnil
, Qnil
);
1250 unbind_to (count
, Qnil
);
1252 /* Run any eval-after-load forms for this file */
1253 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1254 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1258 xfree (saved_doc_string
);
1259 saved_doc_string
= 0;
1260 saved_doc_string_size
= 0;
1262 xfree (prev_saved_doc_string
);
1263 prev_saved_doc_string
= 0;
1264 prev_saved_doc_string_size
= 0;
1266 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1269 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1272 message_with_string ("Loading %s (source)...done", file
, 1);
1274 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1276 else /* The typical case; compiled file newer than source file. */
1277 message_with_string ("Loading %s...done", file
, 1);
1284 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1287 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1298 load_descriptor_unwind (Lisp_Object oldlist
)
1300 load_descriptor_list
= oldlist
;
1304 /* Close all descriptors in use for Floads.
1305 This is used when starting a subprocess. */
1308 close_load_descs (void)
1312 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1313 emacs_close (XFASTINT (XCAR (tail
)));
1318 complete_filename_p (Lisp_Object pathname
)
1320 register const unsigned char *s
= SDATA (pathname
);
1321 return (IS_DIRECTORY_SEP (s
[0])
1322 || (SCHARS (pathname
) > 2
1323 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1326 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1327 doc
: /* Search for FILENAME through PATH.
1328 Returns the file's name in absolute form, or nil if not found.
1329 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1330 file name when searching.
1331 If non-nil, PREDICATE is used instead of `file-readable-p'.
1332 PREDICATE can also be an integer to pass to the access(2) function,
1333 in which case file-name-handlers are ignored. */)
1334 (filename
, path
, suffixes
, predicate
)
1335 Lisp_Object filename
, path
, suffixes
, predicate
;
1338 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1339 if (NILP (predicate
) && fd
> 0)
1345 /* Search for a file whose name is STR, looking in directories
1346 in the Lisp list PATH, and trying suffixes from SUFFIX.
1347 On success, returns a file descriptor. On failure, returns -1.
1349 SUFFIXES is a list of strings containing possible suffixes.
1350 The empty suffix is automatically added if the list is empty.
1352 PREDICATE non-nil means don't open the files,
1353 just look for one that satisfies the predicate. In this case,
1354 returns 1 on success. The predicate can be a lisp function or
1355 an integer to pass to `access' (in which case file-name-handlers
1358 If STOREPTR is nonzero, it points to a slot where the name of
1359 the file actually found should be stored as a Lisp string.
1360 nil is stored there on failure.
1362 If the file we find is remote, return -2
1363 but store the found remote file name in *STOREPTR. */
1366 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1371 register char *fn
= buf
;
1374 Lisp_Object filename
;
1376 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1377 Lisp_Object string
, tail
, encoded_fn
;
1378 int max_suffix_len
= 0;
1382 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1384 CHECK_STRING_CAR (tail
);
1385 max_suffix_len
= max (max_suffix_len
,
1386 SBYTES (XCAR (tail
)));
1389 string
= filename
= encoded_fn
= Qnil
;
1390 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1395 if (complete_filename_p (str
))
1398 for (; CONSP (path
); path
= XCDR (path
))
1400 filename
= Fexpand_file_name (str
, XCAR (path
));
1401 if (!complete_filename_p (filename
))
1402 /* If there are non-absolute elts in PATH (eg ".") */
1403 /* Of course, this could conceivably lose if luser sets
1404 default-directory to be something non-absolute... */
1406 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1407 if (!complete_filename_p (filename
))
1408 /* Give up on this path element! */
1412 /* Calculate maximum size of any filename made from
1413 this path element/specified file name and any possible suffix. */
1414 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1415 if (fn_size
< want_size
)
1416 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1418 /* Loop over suffixes. */
1419 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1420 CONSP (tail
); tail
= XCDR (tail
))
1422 int lsuffix
= SBYTES (XCAR (tail
));
1423 Lisp_Object handler
;
1426 /* Concatenate path element/specified name with the suffix.
1427 If the directory starts with /:, remove that. */
1428 if (SCHARS (filename
) > 2
1429 && SREF (filename
, 0) == '/'
1430 && SREF (filename
, 1) == ':')
1432 strncpy (fn
, SDATA (filename
) + 2,
1433 SBYTES (filename
) - 2);
1434 fn
[SBYTES (filename
) - 2] = 0;
1438 strncpy (fn
, SDATA (filename
),
1440 fn
[SBYTES (filename
)] = 0;
1443 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1444 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1446 /* Check that the file exists and is not a directory. */
1447 /* We used to only check for handlers on non-absolute file names:
1451 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1452 It's not clear why that was the case and it breaks things like
1453 (load "/bar.el") where the file is actually "/bar.el.gz". */
1454 string
= build_string (fn
);
1455 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1456 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1458 if (NILP (predicate
))
1459 exists
= !NILP (Ffile_readable_p (string
));
1461 exists
= !NILP (call1 (predicate
, string
));
1462 if (exists
&& !NILP (Ffile_directory_p (string
)))
1467 /* We succeeded; return this descriptor and filename. */
1478 encoded_fn
= ENCODE_FILE (string
);
1479 pfn
= SDATA (encoded_fn
);
1480 exists
= (stat (pfn
, &st
) >= 0
1481 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1484 /* Check that we can access or open it. */
1485 if (NATNUMP (predicate
))
1486 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1488 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1492 /* We succeeded; return this descriptor and filename. */
1510 /* Merge the list we've accumulated of globals from the current input source
1511 into the load_history variable. The details depend on whether
1512 the source has an associated file name or not.
1514 FILENAME is the file name that we are loading from.
1515 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1518 build_load_history (Lisp_Object filename
, int entire
)
1520 register Lisp_Object tail
, prev
, newelt
;
1521 register Lisp_Object tem
, tem2
;
1522 register int foundit
= 0;
1524 tail
= Vload_history
;
1527 while (CONSP (tail
))
1531 /* Find the feature's previous assoc list... */
1532 if (!NILP (Fequal (filename
, Fcar (tem
))))
1536 /* If we're loading the entire file, remove old data. */
1540 Vload_history
= XCDR (tail
);
1542 Fsetcdr (prev
, XCDR (tail
));
1545 /* Otherwise, cons on new symbols that are not already members. */
1548 tem2
= Vcurrent_load_list
;
1550 while (CONSP (tem2
))
1552 newelt
= XCAR (tem2
);
1554 if (NILP (Fmember (newelt
, tem
)))
1555 Fsetcar (tail
, Fcons (XCAR (tem
),
1556 Fcons (newelt
, XCDR (tem
))));
1569 /* If we're loading an entire file, cons the new assoc onto the
1570 front of load-history, the most-recently-loaded position. Also
1571 do this if we didn't find an existing member for the file. */
1572 if (entire
|| !foundit
)
1573 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1578 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1586 readevalloop_1 (Lisp_Object old
)
1588 load_convert_to_unibyte
= ! NILP (old
);
1592 /* Signal an `end-of-file' error, if possible with file name
1596 end_of_file_error (void)
1598 if (STRINGP (Vload_file_name
))
1599 xsignal1 (Qend_of_file
, Vload_file_name
);
1601 xsignal0 (Qend_of_file
);
1604 /* UNIBYTE specifies how to set load_convert_to_unibyte
1605 for this invocation.
1606 READFUN, if non-nil, is used instead of `read'.
1608 START, END specify region to read in current buffer (from eval-region).
1609 If the input is not from a buffer, they must be nil. */
1612 readevalloop (Lisp_Object readcharfun
,
1614 Lisp_Object sourcename
,
1615 Lisp_Object (*evalfun
) (Lisp_Object
),
1617 Lisp_Object unibyte
, Lisp_Object readfun
,
1618 Lisp_Object start
, Lisp_Object end
)
1621 register Lisp_Object val
;
1622 int count
= SPECPDL_INDEX ();
1623 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1624 struct buffer
*b
= 0;
1625 int continue_reading_p
;
1626 /* Nonzero if reading an entire buffer. */
1627 int whole_buffer
= 0;
1628 /* 1 on the first time around. */
1631 if (MARKERP (readcharfun
))
1634 start
= readcharfun
;
1637 if (BUFFERP (readcharfun
))
1638 b
= XBUFFER (readcharfun
);
1639 else if (MARKERP (readcharfun
))
1640 b
= XMARKER (readcharfun
)->buffer
;
1642 /* We assume START is nil when input is not from a buffer. */
1643 if (! NILP (start
) && !b
)
1646 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1647 specbind (Qcurrent_load_list
, Qnil
);
1648 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1649 load_convert_to_unibyte
= !NILP (unibyte
);
1651 GCPRO4 (sourcename
, readfun
, start
, end
);
1653 /* Try to ensure sourcename is a truename, except whilst preloading. */
1654 if (NILP (Vpurify_flag
)
1655 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1656 && !NILP (Ffboundp (Qfile_truename
)))
1657 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1659 LOADHIST_ATTACH (sourcename
);
1661 continue_reading_p
= 1;
1662 while (continue_reading_p
)
1664 int count1
= SPECPDL_INDEX ();
1666 if (b
!= 0 && NILP (b
->name
))
1667 error ("Reading from killed buffer");
1671 /* Switch to the buffer we are reading from. */
1672 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1673 set_buffer_internal (b
);
1675 /* Save point in it. */
1676 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1677 /* Save ZV in it. */
1678 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1679 /* Those get unbound after we read one expression. */
1681 /* Set point and ZV around stuff to be read. */
1684 Fnarrow_to_region (make_number (BEGV
), end
);
1686 /* Just for cleanliness, convert END to a marker
1687 if it is an integer. */
1689 end
= Fpoint_max_marker ();
1692 /* On the first cycle, we can easily test here
1693 whether we are reading the whole buffer. */
1694 if (b
&& first_sexp
)
1695 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1702 while ((c
= READCHAR
) != '\n' && c
!= -1);
1707 unbind_to (count1
, Qnil
);
1711 /* Ignore whitespace here, so we can detect eof. */
1712 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1713 || c
== 0x8a0) /* NBSP */
1716 if (!NILP (Vpurify_flag
) && c
== '(')
1718 record_unwind_protect (unreadpure
, Qnil
);
1719 val
= read_list (-1, readcharfun
);
1724 read_objects
= Qnil
;
1725 if (!NILP (readfun
))
1727 val
= call1 (readfun
, readcharfun
);
1729 /* If READCHARFUN has set point to ZV, we should
1730 stop reading, even if the form read sets point
1731 to a different value when evaluated. */
1732 if (BUFFERP (readcharfun
))
1734 struct buffer
*b
= XBUFFER (readcharfun
);
1735 if (BUF_PT (b
) == BUF_ZV (b
))
1736 continue_reading_p
= 0;
1739 else if (! NILP (Vload_read_function
))
1740 val
= call1 (Vload_read_function
, readcharfun
);
1742 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1745 if (!NILP (start
) && continue_reading_p
)
1746 start
= Fpoint_marker ();
1748 /* Restore saved point and BEGV. */
1749 unbind_to (count1
, Qnil
);
1751 /* Now eval what we just read. */
1752 val
= (*evalfun
) (val
);
1756 Vvalues
= Fcons (val
, Vvalues
);
1757 if (EQ (Vstandard_output
, Qt
))
1766 build_load_history (sourcename
,
1767 stream
|| whole_buffer
);
1771 unbind_to (count
, Qnil
);
1774 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1775 doc
: /* Execute the current buffer as Lisp code.
1776 When called from a Lisp program (i.e., not interactively), this
1777 function accepts up to five optional arguments:
1778 BUFFER is the buffer to evaluate (nil means use current buffer).
1779 PRINTFLAG controls printing of output:
1780 A value of nil means discard it; anything else is stream for print.
1781 FILENAME specifies the file name to use for `load-history'.
1782 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1784 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1785 functions should work normally even if PRINTFLAG is nil.
1787 This function preserves the position of point. */)
1788 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1789 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1791 int count
= SPECPDL_INDEX ();
1792 Lisp_Object tem
, buf
;
1795 buf
= Fcurrent_buffer ();
1797 buf
= Fget_buffer (buffer
);
1799 error ("No such buffer");
1801 if (NILP (printflag
) && NILP (do_allow_print
))
1806 if (NILP (filename
))
1807 filename
= XBUFFER (buf
)->filename
;
1809 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1810 specbind (Qstandard_output
, tem
);
1811 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1812 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1813 readevalloop (buf
, 0, filename
, Feval
,
1814 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1815 unbind_to (count
, Qnil
);
1820 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1821 doc
: /* Execute the region as Lisp code.
1822 When called from programs, expects two arguments,
1823 giving starting and ending indices in the current buffer
1824 of the text to be executed.
1825 Programs can pass third argument PRINTFLAG which controls output:
1826 A value of nil means discard it; anything else is stream for printing it.
1827 Also the fourth argument READ-FUNCTION, if non-nil, is used
1828 instead of `read' to read each expression. It gets one argument
1829 which is the input stream for reading characters.
1831 This function does not move point. */)
1832 (start
, end
, printflag
, read_function
)
1833 Lisp_Object start
, end
, printflag
, read_function
;
1835 int count
= SPECPDL_INDEX ();
1836 Lisp_Object tem
, cbuf
;
1838 cbuf
= Fcurrent_buffer ();
1840 if (NILP (printflag
))
1844 specbind (Qstandard_output
, tem
);
1845 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1847 /* readevalloop calls functions which check the type of start and end. */
1848 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1849 !NILP (printflag
), Qnil
, read_function
,
1852 return unbind_to (count
, Qnil
);
1856 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1857 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1858 If STREAM is nil, use the value of `standard-input' (which see).
1859 STREAM or the value of `standard-input' may be:
1860 a buffer (read from point and advance it)
1861 a marker (read from where it points and advance it)
1862 a function (call it with no arguments for each character,
1863 call it with a char as argument to push a char back)
1864 a string (takes text from string, starting at the beginning)
1865 t (read text line using minibuffer and use it, or read from
1866 standard input in batch mode). */)
1871 stream
= Vstandard_input
;
1872 if (EQ (stream
, Qt
))
1873 stream
= Qread_char
;
1874 if (EQ (stream
, Qread_char
))
1875 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1877 return read_internal_start (stream
, Qnil
, Qnil
);
1880 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1881 doc
: /* Read one Lisp expression which is represented as text by STRING.
1882 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1883 START and END optionally delimit a substring of STRING from which to read;
1884 they default to 0 and (length STRING) respectively. */)
1885 (string
, start
, end
)
1886 Lisp_Object string
, start
, end
;
1889 CHECK_STRING (string
);
1890 /* read_internal_start sets read_from_string_index. */
1891 ret
= read_internal_start (string
, start
, end
);
1892 return Fcons (ret
, make_number (read_from_string_index
));
1895 /* Function to set up the global context we need in toplevel read
1898 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1899 /* start, end only used when stream is a string. */
1904 new_backquote_flag
= 0;
1905 read_objects
= Qnil
;
1906 if (EQ (Vread_with_symbol_positions
, Qt
)
1907 || EQ (Vread_with_symbol_positions
, stream
))
1908 Vread_symbol_positions_list
= Qnil
;
1910 if (STRINGP (stream
)
1911 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1913 int startval
, endval
;
1916 if (STRINGP (stream
))
1919 string
= XCAR (stream
);
1922 endval
= SCHARS (string
);
1926 endval
= XINT (end
);
1927 if (endval
< 0 || endval
> SCHARS (string
))
1928 args_out_of_range (string
, end
);
1935 CHECK_NUMBER (start
);
1936 startval
= XINT (start
);
1937 if (startval
< 0 || startval
> endval
)
1938 args_out_of_range (string
, start
);
1940 read_from_string_index
= startval
;
1941 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1942 read_from_string_limit
= endval
;
1945 retval
= read0 (stream
);
1946 if (EQ (Vread_with_symbol_positions
, Qt
)
1947 || EQ (Vread_with_symbol_positions
, stream
))
1948 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1953 /* Signal Qinvalid_read_syntax error.
1954 S is error string of length N (if > 0) */
1957 invalid_syntax (const char *s
, int n
)
1961 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1965 /* Use this for recursive reads, in contexts where internal tokens
1969 read0 (Lisp_Object readcharfun
)
1971 register Lisp_Object val
;
1974 val
= read1 (readcharfun
, &c
, 0);
1978 xsignal1 (Qinvalid_read_syntax
,
1979 Fmake_string (make_number (1), make_number (c
)));
1982 static int read_buffer_size
;
1983 static char *read_buffer
;
1985 /* Read a \-escape sequence, assuming we already read the `\'.
1986 If the escape sequence forces unibyte, return eight-bit char. */
1989 read_escape (Lisp_Object readcharfun
, int stringp
)
1991 register int c
= READCHAR
;
1992 /* \u allows up to four hex digits, \U up to eight. Default to the
1993 behavior for \u, and change this value in the case that \U is seen. */
1994 int unicode_hex_count
= 4;
1999 end_of_file_error ();
2029 error ("Invalid escape character syntax");
2032 c
= read_escape (readcharfun
, 0);
2033 return c
| meta_modifier
;
2038 error ("Invalid escape character syntax");
2041 c
= read_escape (readcharfun
, 0);
2042 return c
| shift_modifier
;
2047 error ("Invalid escape character syntax");
2050 c
= read_escape (readcharfun
, 0);
2051 return c
| hyper_modifier
;
2056 error ("Invalid escape character syntax");
2059 c
= read_escape (readcharfun
, 0);
2060 return c
| alt_modifier
;
2064 if (stringp
|| c
!= '-')
2071 c
= read_escape (readcharfun
, 0);
2072 return c
| super_modifier
;
2077 error ("Invalid escape character syntax");
2081 c
= read_escape (readcharfun
, 0);
2082 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2083 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2084 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2085 return c
| ctrl_modifier
;
2086 /* ASCII control chars are made from letters (both cases),
2087 as well as the non-letters within 0100...0137. */
2088 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2089 return (c
& (037 | ~0177));
2090 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2091 return (c
& (037 | ~0177));
2093 return c
| ctrl_modifier
;
2103 /* An octal escape, as in ANSI C. */
2105 register int i
= c
- '0';
2106 register int count
= 0;
2109 if ((c
= READCHAR
) >= '0' && c
<= '7')
2121 if (i
>= 0x80 && i
< 0x100)
2122 i
= BYTE8_TO_CHAR (i
);
2127 /* A hex escape, as in ANSI C. */
2134 if (c
>= '0' && c
<= '9')
2139 else if ((c
>= 'a' && c
<= 'f')
2140 || (c
>= 'A' && c
<= 'F'))
2143 if (c
>= 'a' && c
<= 'f')
2156 if (count
< 3 && i
>= 0x80)
2157 return BYTE8_TO_CHAR (i
);
2162 /* Post-Unicode-2.0: Up to eight hex chars. */
2163 unicode_hex_count
= 8;
2166 /* A Unicode escape. We only permit them in strings and characters,
2167 not arbitrarily in the source code, as in some other languages. */
2172 while (++count
<= unicode_hex_count
)
2175 /* isdigit and isalpha may be locale-specific, which we don't
2177 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2178 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2179 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2182 error ("Non-hex digit used for Unicode escape");
2187 error ("Non-Unicode character: 0x%x", i
);
2196 /* Read an integer in radix RADIX using READCHARFUN to read
2197 characters. RADIX must be in the interval [2..36]; if it isn't, a
2198 read error is signaled . Value is the integer read. Signals an
2199 error if encountering invalid read syntax or if RADIX is out of
2203 read_integer (Lisp_Object readcharfun
, int radix
)
2205 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2206 /* We use a floating point number because */
2209 if (radix
< 2 || radix
> 36)
2213 number
= ndigits
= invalid_p
= 0;
2229 if (c
>= '0' && c
<= '9')
2231 else if (c
>= 'a' && c
<= 'z')
2232 digit
= c
- 'a' + 10;
2233 else if (c
>= 'A' && c
<= 'Z')
2234 digit
= c
- 'A' + 10;
2241 if (digit
< 0 || digit
>= radix
)
2244 number
= radix
* number
+ digit
;
2250 if (ndigits
== 0 || invalid_p
)
2253 sprintf (buf
, "integer, radix %d", radix
);
2254 invalid_syntax (buf
, 0);
2257 return make_fixnum_or_float (sign
* number
);
2261 /* If the next token is ')' or ']' or '.', we store that character
2262 in *PCH and the return value is not interesting. Else, we store
2263 zero in *PCH and we read and return one lisp object.
2265 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2268 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2271 int uninterned_symbol
= 0;
2279 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2281 end_of_file_error ();
2286 return read_list (0, readcharfun
);
2289 return read_vector (readcharfun
, 0);
2305 /* Accept extended format for hashtables (extensible to
2307 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2308 Lisp_Object tmp
= read_list (0, readcharfun
);
2309 Lisp_Object head
= CAR_SAFE (tmp
);
2310 Lisp_Object data
= Qnil
;
2311 Lisp_Object val
= Qnil
;
2312 /* The size is 2 * number of allowed keywords to
2314 Lisp_Object params
[10];
2316 Lisp_Object key
= Qnil
;
2317 int param_count
= 0;
2319 if (!EQ (head
, Qhash_table
))
2320 error ("Invalid extended read marker at head of #s list "
2321 "(only hash-table allowed)");
2323 tmp
= CDR_SAFE (tmp
);
2325 /* This is repetitive but fast and simple. */
2326 params
[param_count
] = QCsize
;
2327 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2328 if (!NILP (params
[param_count
+1]))
2331 params
[param_count
] = QCtest
;
2332 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2333 if (!NILP (params
[param_count
+1]))
2336 params
[param_count
] = QCweakness
;
2337 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2338 if (!NILP (params
[param_count
+1]))
2341 params
[param_count
] = QCrehash_size
;
2342 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2343 if (!NILP (params
[param_count
+1]))
2346 params
[param_count
] = QCrehash_threshold
;
2347 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2348 if (!NILP (params
[param_count
+1]))
2351 /* This is the hashtable data. */
2352 data
= Fplist_get (tmp
, Qdata
);
2354 /* Now use params to make a new hashtable and fill it. */
2355 ht
= Fmake_hash_table (param_count
, params
);
2357 while (CONSP (data
))
2362 error ("Odd number of elements in hashtable data");
2365 Fputhash (key
, val
, ht
);
2377 tmp
= read_vector (readcharfun
, 0);
2378 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2379 error ("Invalid size char-table");
2380 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2391 tmp
= read_vector (readcharfun
, 0);
2392 if (!INTEGERP (AREF (tmp
, 0)))
2393 error ("Invalid depth in char-table");
2394 depth
= XINT (AREF (tmp
, 0));
2395 if (depth
< 1 || depth
> 3)
2396 error ("Invalid depth in char-table");
2397 size
= XVECTOR (tmp
)->size
- 2;
2398 if (chartab_size
[depth
] != size
)
2399 error ("Invalid size char-table");
2400 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2403 invalid_syntax ("#^^", 3);
2405 invalid_syntax ("#^", 2);
2410 length
= read1 (readcharfun
, pch
, first_in_list
);
2414 Lisp_Object tmp
, val
;
2416 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2417 / BOOL_VECTOR_BITS_PER_CHAR
);
2420 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2421 if (STRING_MULTIBYTE (tmp
)
2422 || (size_in_chars
!= SCHARS (tmp
)
2423 /* We used to print 1 char too many
2424 when the number of bits was a multiple of 8.
2425 Accept such input in case it came from an old
2427 && ! (XFASTINT (length
)
2428 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2429 invalid_syntax ("#&...", 5);
2431 val
= Fmake_bool_vector (length
, Qnil
);
2432 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2433 /* Clear the extraneous bits in the last byte. */
2434 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2435 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2436 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2439 invalid_syntax ("#&...", 5);
2443 /* Accept compiled functions at read-time so that we don't have to
2444 build them using function calls. */
2446 tmp
= read_vector (readcharfun
, 1);
2447 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2448 XVECTOR (tmp
)->contents
);
2453 struct gcpro gcpro1
;
2456 /* Read the string itself. */
2457 tmp
= read1 (readcharfun
, &ch
, 0);
2458 if (ch
!= 0 || !STRINGP (tmp
))
2459 invalid_syntax ("#", 1);
2461 /* Read the intervals and their properties. */
2464 Lisp_Object beg
, end
, plist
;
2466 beg
= read1 (readcharfun
, &ch
, 0);
2471 end
= read1 (readcharfun
, &ch
, 0);
2473 plist
= read1 (readcharfun
, &ch
, 0);
2475 invalid_syntax ("Invalid string property list", 0);
2476 Fset_text_properties (beg
, end
, plist
, tmp
);
2482 /* #@NUMBER is used to skip NUMBER following characters.
2483 That's used in .elc files to skip over doc strings
2484 and function definitions. */
2490 /* Read a decimal integer. */
2491 while ((c
= READCHAR
) >= 0
2492 && c
>= '0' && c
<= '9')
2500 if (load_force_doc_strings
2501 && (EQ (readcharfun
, Qget_file_char
)
2502 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2504 /* If we are supposed to force doc strings into core right now,
2505 record the last string that we skipped,
2506 and record where in the file it comes from. */
2508 /* But first exchange saved_doc_string
2509 with prev_saved_doc_string, so we save two strings. */
2511 char *temp
= saved_doc_string
;
2512 int temp_size
= saved_doc_string_size
;
2513 file_offset temp_pos
= saved_doc_string_position
;
2514 int temp_len
= saved_doc_string_length
;
2516 saved_doc_string
= prev_saved_doc_string
;
2517 saved_doc_string_size
= prev_saved_doc_string_size
;
2518 saved_doc_string_position
= prev_saved_doc_string_position
;
2519 saved_doc_string_length
= prev_saved_doc_string_length
;
2521 prev_saved_doc_string
= temp
;
2522 prev_saved_doc_string_size
= temp_size
;
2523 prev_saved_doc_string_position
= temp_pos
;
2524 prev_saved_doc_string_length
= temp_len
;
2527 if (saved_doc_string_size
== 0)
2529 saved_doc_string_size
= nskip
+ 100;
2530 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2532 if (nskip
> saved_doc_string_size
)
2534 saved_doc_string_size
= nskip
+ 100;
2535 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2536 saved_doc_string_size
);
2539 saved_doc_string_position
= file_tell (instream
);
2541 /* Copy that many characters into saved_doc_string. */
2542 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2543 saved_doc_string
[i
] = c
= READCHAR
;
2545 saved_doc_string_length
= i
;
2549 /* Skip that many characters. */
2550 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2559 /* #! appears at the beginning of an executable file.
2560 Skip the first line. */
2561 while (c
!= '\n' && c
>= 0)
2566 return Vload_file_name
;
2568 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2569 /* #:foo is the uninterned symbol named foo. */
2572 uninterned_symbol
= 1;
2576 /* Reader forms that can reuse previously read objects. */
2577 if (c
>= '0' && c
<= '9')
2582 /* Read a non-negative integer. */
2583 while (c
>= '0' && c
<= '9')
2589 /* #n=object returns object, but associates it with n for #n#. */
2590 if (c
== '=' && !NILP (Vread_circle
))
2592 /* Make a placeholder for #n# to use temporarily */
2593 Lisp_Object placeholder
;
2596 placeholder
= Fcons (Qnil
, Qnil
);
2597 cell
= Fcons (make_number (n
), placeholder
);
2598 read_objects
= Fcons (cell
, read_objects
);
2600 /* Read the object itself. */
2601 tem
= read0 (readcharfun
);
2603 /* Now put it everywhere the placeholder was... */
2604 substitute_object_in_subtree (tem
, placeholder
);
2606 /* ...and #n# will use the real value from now on. */
2607 Fsetcdr (cell
, tem
);
2611 /* #n# returns a previously read object. */
2612 if (c
== '#' && !NILP (Vread_circle
))
2614 tem
= Fassq (make_number (n
), read_objects
);
2617 /* Fall through to error message. */
2619 else if (c
== 'r' || c
== 'R')
2620 return read_integer (readcharfun
, n
);
2622 /* Fall through to error message. */
2624 else if (c
== 'x' || c
== 'X')
2625 return read_integer (readcharfun
, 16);
2626 else if (c
== 'o' || c
== 'O')
2627 return read_integer (readcharfun
, 8);
2628 else if (c
== 'b' || c
== 'B')
2629 return read_integer (readcharfun
, 2);
2632 invalid_syntax ("#", 1);
2635 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2640 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2645 int next_char
= READCHAR
;
2647 /* Transition from old-style to new-style:
2648 If we see "(`" it used to mean old-style, which usually works
2649 fine because ` should almost never appear in such a position
2650 for new-style. But occasionally we need "(`" to mean new
2651 style, so we try to distinguish the two by the fact that we
2652 can either write "( `foo" or "(` foo", where the first
2653 intends to use new-style whereas the second intends to use
2654 old-style. For Emacs-25, we should completely remove this
2655 first_in_list exception (old-style can still be obtained via
2657 if (first_in_list
&& next_char
== ' ')
2659 Vold_style_backquotes
= Qt
;
2666 new_backquote_flag
++;
2667 value
= read0 (readcharfun
);
2668 new_backquote_flag
--;
2670 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2674 if (new_backquote_flag
)
2676 Lisp_Object comma_type
= Qnil
;
2681 comma_type
= Qcomma_at
;
2683 comma_type
= Qcomma_dot
;
2686 if (ch
>= 0) UNREAD (ch
);
2687 comma_type
= Qcomma
;
2690 new_backquote_flag
--;
2691 value
= read0 (readcharfun
);
2692 new_backquote_flag
++;
2693 return Fcons (comma_type
, Fcons (value
, Qnil
));
2697 Vold_style_backquotes
= Qt
;
2709 end_of_file_error ();
2711 /* Accept `single space' syntax like (list ? x) where the
2712 whitespace character is SPC or TAB.
2713 Other literal whitespace like NL, CR, and FF are not accepted,
2714 as there are well-established escape sequences for these. */
2715 if (c
== ' ' || c
== '\t')
2716 return make_number (c
);
2719 c
= read_escape (readcharfun
, 0);
2720 modifiers
= c
& CHAR_MODIFIER_MASK
;
2721 c
&= ~CHAR_MODIFIER_MASK
;
2722 if (CHAR_BYTE8_P (c
))
2723 c
= CHAR_TO_BYTE8 (c
);
2726 next_char
= READCHAR
;
2727 if (next_char
== '.')
2729 /* Only a dotted-pair dot is valid after a char constant. */
2730 int next_next_char
= READCHAR
;
2731 UNREAD (next_next_char
);
2733 ok
= (next_next_char
<= 040
2734 || (next_next_char
< 0200
2735 && (index ("\"';([#?", next_next_char
)
2736 || (!first_in_list
&& next_next_char
== '`')
2737 || (new_backquote_flag
&& next_next_char
== ','))));
2741 ok
= (next_char
<= 040
2742 || (next_char
< 0200
2743 && (index ("\"';()[]#?", next_char
)
2744 || (!first_in_list
&& next_char
== '`')
2745 || (new_backquote_flag
&& next_char
== ','))));
2749 return make_number (c
);
2751 invalid_syntax ("?", 1);
2756 char *p
= read_buffer
;
2757 char *end
= read_buffer
+ read_buffer_size
;
2759 /* Nonzero if we saw an escape sequence specifying
2760 a multibyte character. */
2761 int force_multibyte
= 0;
2762 /* Nonzero if we saw an escape sequence specifying
2763 a single-byte character. */
2764 int force_singlebyte
= 0;
2768 while ((c
= READCHAR
) >= 0
2771 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2773 int offset
= p
- read_buffer
;
2774 read_buffer
= (char *) xrealloc (read_buffer
,
2775 read_buffer_size
*= 2);
2776 p
= read_buffer
+ offset
;
2777 end
= read_buffer
+ read_buffer_size
;
2784 c
= read_escape (readcharfun
, 1);
2786 /* C is -1 if \ newline has just been seen */
2789 if (p
== read_buffer
)
2794 modifiers
= c
& CHAR_MODIFIER_MASK
;
2795 c
= c
& ~CHAR_MODIFIER_MASK
;
2797 if (CHAR_BYTE8_P (c
))
2798 force_singlebyte
= 1;
2799 else if (! ASCII_CHAR_P (c
))
2800 force_multibyte
= 1;
2801 else /* i.e. ASCII_CHAR_P (c) */
2803 /* Allow `\C- ' and `\C-?'. */
2804 if (modifiers
== CHAR_CTL
)
2807 c
= 0, modifiers
= 0;
2809 c
= 127, modifiers
= 0;
2811 if (modifiers
& CHAR_SHIFT
)
2813 /* Shift modifier is valid only with [A-Za-z]. */
2814 if (c
>= 'A' && c
<= 'Z')
2815 modifiers
&= ~CHAR_SHIFT
;
2816 else if (c
>= 'a' && c
<= 'z')
2817 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2820 if (modifiers
& CHAR_META
)
2822 /* Move the meta bit to the right place for a
2824 modifiers
&= ~CHAR_META
;
2825 c
= BYTE8_TO_CHAR (c
| 0x80);
2826 force_singlebyte
= 1;
2830 /* Any modifiers remaining are invalid. */
2832 error ("Invalid modifier in string");
2833 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2837 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2838 if (CHAR_BYTE8_P (c
))
2839 force_singlebyte
= 1;
2840 else if (! ASCII_CHAR_P (c
))
2841 force_multibyte
= 1;
2847 end_of_file_error ();
2849 /* If purifying, and string starts with \ newline,
2850 return zero instead. This is for doc strings
2851 that we are really going to find in etc/DOC.nn.nn */
2852 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2853 return make_number (0);
2855 if (force_multibyte
)
2856 /* READ_BUFFER already contains valid multibyte forms. */
2858 else if (force_singlebyte
)
2860 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2861 p
= read_buffer
+ nchars
;
2864 /* Otherwise, READ_BUFFER contains only ASCII. */
2867 /* We want readchar_count to be the number of characters, not
2868 bytes. Hence we adjust for multibyte characters in the
2869 string. ... But it doesn't seem to be necessary, because
2870 READCHAR *does* read multibyte characters from buffers. */
2871 /* readchar_count -= (p - read_buffer) - nchars; */
2873 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2875 || (p
- read_buffer
!= nchars
)));
2876 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2878 || (p
- read_buffer
!= nchars
)));
2883 int next_char
= READCHAR
;
2886 if (next_char
<= 040
2887 || (next_char
< 0200
2888 && (index ("\"';([#?", next_char
)
2889 || (!first_in_list
&& next_char
== '`')
2890 || (new_backquote_flag
&& next_char
== ','))))
2896 /* Otherwise, we fall through! Note that the atom-reading loop
2897 below will now loop at least once, assuring that we will not
2898 try to UNREAD two characters in a row. */
2902 if (c
<= 040) goto retry
;
2903 if (c
== 0x8a0) /* NBSP */
2906 char *p
= read_buffer
;
2910 char *end
= read_buffer
+ read_buffer_size
;
2913 && c
!= 0x8a0 /* NBSP */
2915 || (!index ("\"';()[]#", c
)
2916 && !(!first_in_list
&& c
== '`')
2917 && !(new_backquote_flag
&& c
== ','))))
2919 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2921 int offset
= p
- read_buffer
;
2922 read_buffer
= (char *) xrealloc (read_buffer
,
2923 read_buffer_size
*= 2);
2924 p
= read_buffer
+ offset
;
2925 end
= read_buffer
+ read_buffer_size
;
2932 end_of_file_error ();
2937 p
+= CHAR_STRING (c
, p
);
2945 int offset
= p
- read_buffer
;
2946 read_buffer
= (char *) xrealloc (read_buffer
,
2947 read_buffer_size
*= 2);
2948 p
= read_buffer
+ offset
;
2949 end
= read_buffer
+ read_buffer_size
;
2956 if (!quoted
&& !uninterned_symbol
)
2960 if (*p1
== '+' || *p1
== '-') p1
++;
2961 /* Is it an integer? */
2964 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2965 /* Integers can have trailing decimal points. */
2966 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2968 /* It is an integer. */
2973 /* EMACS_INT n = atol (read_buffer); */
2974 char *endptr
= NULL
;
2975 EMACS_INT n
= (errno
= 0,
2976 strtol (read_buffer
, &endptr
, 10));
2977 if (errno
== ERANGE
&& endptr
)
2980 = Fcons (make_string (read_buffer
,
2981 endptr
- read_buffer
),
2983 xsignal (Qoverflow_error
, args
);
2985 return make_fixnum_or_float (n
);
2989 if (isfloat_string (read_buffer
, 0))
2991 /* Compute NaN and infinities using 0.0 in a variable,
2992 to cope with compilers that think they are smarter
2998 /* Negate the value ourselves. This treats 0, NaNs,
2999 and infinity properly on IEEE floating point hosts,
3000 and works around a common bug where atof ("-0.0")
3002 int negative
= read_buffer
[0] == '-';
3004 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3005 returns 1, is if the input ends in e+INF or e+NaN. */
3012 value
= zero
/ zero
;
3014 /* If that made a "negative" NaN, negate it. */
3018 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3021 u_minus_zero
.d
= - 0.0;
3022 for (i
= 0; i
< sizeof (double); i
++)
3023 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3029 /* Now VALUE is a positive NaN. */
3032 value
= atof (read_buffer
+ negative
);
3036 return make_float (negative
? - value
: value
);
3040 Lisp_Object name
, result
;
3041 EMACS_INT nbytes
= p
- read_buffer
;
3043 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3046 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3047 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3049 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3050 result
= (uninterned_symbol
? Fmake_symbol (name
)
3051 : Fintern (name
, Qnil
));
3053 if (EQ (Vread_with_symbol_positions
, Qt
)
3054 || EQ (Vread_with_symbol_positions
, readcharfun
))
3055 Vread_symbol_positions_list
=
3056 /* Kind of a hack; this will probably fail if characters
3057 in the symbol name were escaped. Not really a big
3059 Fcons (Fcons (result
,
3060 make_number (readchar_count
3061 - XFASTINT (Flength (Fsymbol_name (result
))))),
3062 Vread_symbol_positions_list
);
3070 /* List of nodes we've seen during substitute_object_in_subtree. */
3071 static Lisp_Object seen_list
;
3074 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3076 Lisp_Object check_object
;
3078 /* We haven't seen any objects when we start. */
3081 /* Make all the substitutions. */
3083 = substitute_object_recurse (object
, placeholder
, object
);
3085 /* Clear seen_list because we're done with it. */
3088 /* The returned object here is expected to always eq the
3090 if (!EQ (check_object
, object
))
3091 error ("Unexpected mutation error in reader");
3094 /* Feval doesn't get called from here, so no gc protection is needed. */
3095 #define SUBSTITUTE(get_val, set_val) \
3097 Lisp_Object old_value = get_val; \
3098 Lisp_Object true_value \
3099 = substitute_object_recurse (object, placeholder, \
3102 if (!EQ (old_value, true_value)) \
3109 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3111 /* If we find the placeholder, return the target object. */
3112 if (EQ (placeholder
, subtree
))
3115 /* If we've been to this node before, don't explore it again. */
3116 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3119 /* If this node can be the entry point to a cycle, remember that
3120 we've seen it. It can only be such an entry point if it was made
3121 by #n=, which means that we can find it as a value in
3123 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3124 seen_list
= Fcons (subtree
, seen_list
);
3126 /* Recurse according to subtree's type.
3127 Every branch must return a Lisp_Object. */
3128 switch (XTYPE (subtree
))
3130 case Lisp_Vectorlike
:
3133 if (BOOL_VECTOR_P (subtree
))
3134 return subtree
; /* No sub-objects anyway. */
3135 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3136 || COMPILEDP (subtree
))
3137 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3138 else if (VECTORP (subtree
))
3139 length
= ASIZE (subtree
);
3141 /* An unknown pseudovector may contain non-Lisp fields, so we
3142 can't just blindly traverse all its fields. We used to call
3143 `Flength' which signaled `sequencep', so I just preserved this
3145 wrong_type_argument (Qsequencep
, subtree
);
3147 for (i
= 0; i
< length
; i
++)
3148 SUBSTITUTE (AREF (subtree
, i
),
3149 ASET (subtree
, i
, true_value
));
3155 SUBSTITUTE (XCAR (subtree
),
3156 XSETCAR (subtree
, true_value
));
3157 SUBSTITUTE (XCDR (subtree
),
3158 XSETCDR (subtree
, true_value
));
3164 /* Check for text properties in each interval.
3165 substitute_in_interval contains part of the logic. */
3167 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3168 Lisp_Object arg
= Fcons (object
, placeholder
);
3170 traverse_intervals_noorder (root_interval
,
3171 &substitute_in_interval
, arg
);
3176 /* Other types don't recurse any further. */
3182 /* Helper function for substitute_object_recurse. */
3184 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3186 Lisp_Object object
= Fcar (arg
);
3187 Lisp_Object placeholder
= Fcdr (arg
);
3189 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3200 isfloat_string (register char *cp
, int ignore_trailing
)
3207 if (*cp
== '+' || *cp
== '-')
3210 if (*cp
>= '0' && *cp
<= '9')
3213 while (*cp
>= '0' && *cp
<= '9')
3221 if (*cp
>= '0' && *cp
<= '9')
3224 while (*cp
>= '0' && *cp
<= '9')
3227 if (*cp
== 'e' || *cp
== 'E')
3231 if (*cp
== '+' || *cp
== '-')
3235 if (*cp
>= '0' && *cp
<= '9')
3238 while (*cp
>= '0' && *cp
<= '9')
3241 else if (cp
== start
)
3243 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3248 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3254 return ((ignore_trailing
3255 || (*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3256 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3257 || state
== (DOT_CHAR
|TRAIL_INT
)
3258 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3259 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3260 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3265 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3269 register Lisp_Object
*ptr
;
3270 register Lisp_Object tem
, item
, vector
;
3271 register struct Lisp_Cons
*otem
;
3274 tem
= read_list (1, readcharfun
);
3275 len
= Flength (tem
);
3276 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3278 size
= XVECTOR (vector
)->size
;
3279 ptr
= XVECTOR (vector
)->contents
;
3280 for (i
= 0; i
< size
; i
++)
3283 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3284 bytecode object, the docstring containing the bytecode and
3285 constants values must be treated as unibyte and passed to
3286 Fread, to get the actual bytecode string and constants vector. */
3287 if (bytecodeflag
&& load_force_doc_strings
)
3289 if (i
== COMPILED_BYTECODE
)
3291 if (!STRINGP (item
))
3292 error ("Invalid byte code");
3294 /* Delay handling the bytecode slot until we know whether
3295 it is lazily-loaded (we can tell by whether the
3296 constants slot is nil). */
3297 ptr
[COMPILED_CONSTANTS
] = item
;
3300 else if (i
== COMPILED_CONSTANTS
)
3302 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3306 /* Coerce string to unibyte (like string-as-unibyte,
3307 but without generating extra garbage and
3308 guaranteeing no change in the contents). */
3309 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3310 STRING_SET_UNIBYTE (bytestr
);
3312 item
= Fread (Fcons (bytestr
, readcharfun
));
3314 error ("Invalid byte code");
3316 otem
= XCONS (item
);
3317 bytestr
= XCAR (item
);
3322 /* Now handle the bytecode slot. */
3323 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3325 else if (i
== COMPILED_DOC_STRING
3327 && ! STRING_MULTIBYTE (item
))
3329 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3330 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3332 item
= Fstring_as_multibyte (item
);
3335 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3343 /* FLAG = 1 means check for ] to terminate rather than ) and .
3344 FLAG = -1 means check for starting with defun
3345 and make structure pure. */
3348 read_list (int flag
, register Lisp_Object readcharfun
)
3350 /* -1 means check next element for defun,
3351 0 means don't check,
3352 1 means already checked and found defun. */
3353 int defunflag
= flag
< 0 ? -1 : 0;
3354 Lisp_Object val
, tail
;
3355 register Lisp_Object elt
, tem
;
3356 struct gcpro gcpro1
, gcpro2
;
3357 /* 0 is the normal case.
3358 1 means this list is a doc reference; replace it with the number 0.
3359 2 means this list is a doc reference; replace it with the doc string. */
3360 int doc_reference
= 0;
3362 /* Initialize this to 1 if we are reading a list. */
3363 int first_in_list
= flag
<= 0;
3372 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3377 /* While building, if the list starts with #$, treat it specially. */
3378 if (EQ (elt
, Vload_file_name
)
3380 && !NILP (Vpurify_flag
))
3382 if (NILP (Vdoc_file_name
))
3383 /* We have not yet called Snarf-documentation, so assume
3384 this file is described in the DOC-MM.NN file
3385 and Snarf-documentation will fill in the right value later.
3386 For now, replace the whole list with 0. */
3389 /* We have already called Snarf-documentation, so make a relative
3390 file name for this file, so it can be found properly
3391 in the installed Lisp directory.
3392 We don't use Fexpand_file_name because that would make
3393 the directory absolute now. */
3394 elt
= concat2 (build_string ("../lisp/"),
3395 Ffile_name_nondirectory (elt
));
3397 else if (EQ (elt
, Vload_file_name
)
3399 && load_force_doc_strings
)
3408 invalid_syntax (") or . in a vector", 18);
3416 XSETCDR (tail
, read0 (readcharfun
));
3418 val
= read0 (readcharfun
);
3419 read1 (readcharfun
, &ch
, 0);
3423 if (doc_reference
== 1)
3424 return make_number (0);
3425 if (doc_reference
== 2)
3427 /* Get a doc string from the file we are loading.
3428 If it's in saved_doc_string, get it from there.
3430 Here, we don't know if the string is a
3431 bytecode string or a doc string. As a
3432 bytecode string must be unibyte, we always
3433 return a unibyte string. If it is actually a
3434 doc string, caller must make it
3437 int pos
= XINT (XCDR (val
));
3438 /* Position is negative for user variables. */
3439 if (pos
< 0) pos
= -pos
;
3440 if (pos
>= saved_doc_string_position
3441 && pos
< (saved_doc_string_position
3442 + saved_doc_string_length
))
3444 int start
= pos
- saved_doc_string_position
;
3447 /* Process quoting with ^A,
3448 and find the end of the string,
3449 which is marked with ^_ (037). */
3450 for (from
= start
, to
= start
;
3451 saved_doc_string
[from
] != 037;)
3453 int c
= saved_doc_string
[from
++];
3456 c
= saved_doc_string
[from
++];
3458 saved_doc_string
[to
++] = c
;
3460 saved_doc_string
[to
++] = 0;
3462 saved_doc_string
[to
++] = 037;
3465 saved_doc_string
[to
++] = c
;
3468 return make_unibyte_string (saved_doc_string
+ start
,
3471 /* Look in prev_saved_doc_string the same way. */
3472 else if (pos
>= prev_saved_doc_string_position
3473 && pos
< (prev_saved_doc_string_position
3474 + prev_saved_doc_string_length
))
3476 int start
= pos
- prev_saved_doc_string_position
;
3479 /* Process quoting with ^A,
3480 and find the end of the string,
3481 which is marked with ^_ (037). */
3482 for (from
= start
, to
= start
;
3483 prev_saved_doc_string
[from
] != 037;)
3485 int c
= prev_saved_doc_string
[from
++];
3488 c
= prev_saved_doc_string
[from
++];
3490 prev_saved_doc_string
[to
++] = c
;
3492 prev_saved_doc_string
[to
++] = 0;
3494 prev_saved_doc_string
[to
++] = 037;
3497 prev_saved_doc_string
[to
++] = c
;
3500 return make_unibyte_string (prev_saved_doc_string
3505 return get_doc_string (val
, 1, 0);
3510 invalid_syntax (". in wrong context", 18);
3512 invalid_syntax ("] in a list", 11);
3514 tem
= (read_pure
&& flag
<= 0
3515 ? pure_cons (elt
, Qnil
)
3516 : Fcons (elt
, Qnil
));
3518 XSETCDR (tail
, tem
);
3523 defunflag
= EQ (elt
, Qdefun
);
3524 else if (defunflag
> 0)
3529 Lisp_Object Vobarray
;
3530 Lisp_Object initial_obarray
;
3532 /* oblookup stores the bucket number here, for the sake of Funintern. */
3534 int oblookup_last_bucket_number
;
3536 static int hash_string (const unsigned char *ptr
, int len
);
3538 /* Get an error if OBARRAY is not an obarray.
3539 If it is one, return it. */
3542 check_obarray (Lisp_Object obarray
)
3544 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3546 /* If Vobarray is now invalid, force it to be valid. */
3547 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3548 wrong_type_argument (Qvectorp
, obarray
);
3553 /* Intern the C string STR: return a symbol with that name,
3554 interned in the current obarray. */
3557 intern (const char *str
)
3560 int len
= strlen (str
);
3561 Lisp_Object obarray
;
3564 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3565 obarray
= check_obarray (obarray
);
3566 tem
= oblookup (obarray
, str
, len
, len
);
3569 return Fintern (make_string (str
, len
), obarray
);
3573 intern_c_string (const char *str
)
3576 int len
= strlen (str
);
3577 Lisp_Object obarray
;
3580 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3581 obarray
= check_obarray (obarray
);
3582 tem
= oblookup (obarray
, str
, len
, len
);
3586 if (NILP (Vpurify_flag
))
3587 /* Creating a non-pure string from a string literal not
3588 implemented yet. We could just use make_string here and live
3589 with the extra copy. */
3592 return Fintern (make_pure_c_string (str
), obarray
);
3595 /* Create an uninterned symbol with name STR. */
3598 make_symbol (char *str
)
3600 int len
= strlen (str
);
3602 return Fmake_symbol ((!NILP (Vpurify_flag
)
3603 ? make_pure_string (str
, len
, len
, 0)
3604 : make_string (str
, len
)));
3607 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3608 doc
: /* Return the canonical symbol whose name is STRING.
3609 If there is none, one is created by this function and returned.
3610 A second optional argument specifies the obarray to use;
3611 it defaults to the value of `obarray'. */)
3613 Lisp_Object string
, obarray
;
3615 register Lisp_Object tem
, sym
, *ptr
;
3617 if (NILP (obarray
)) obarray
= Vobarray
;
3618 obarray
= check_obarray (obarray
);
3620 CHECK_STRING (string
);
3622 tem
= oblookup (obarray
, SDATA (string
),
3625 if (!INTEGERP (tem
))
3628 if (!NILP (Vpurify_flag
))
3629 string
= Fpurecopy (string
);
3630 sym
= Fmake_symbol (string
);
3632 if (EQ (obarray
, initial_obarray
))
3633 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3635 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3637 if ((SREF (string
, 0) == ':')
3638 && EQ (obarray
, initial_obarray
))
3640 XSYMBOL (sym
)->constant
= 1;
3641 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3642 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3645 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3647 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3649 XSYMBOL (sym
)->next
= 0;
3654 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3655 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3656 NAME may be a string or a symbol. If it is a symbol, that exact
3657 symbol is searched for.
3658 A second optional argument specifies the obarray to use;
3659 it defaults to the value of `obarray'. */)
3661 Lisp_Object name
, obarray
;
3663 register Lisp_Object tem
, string
;
3665 if (NILP (obarray
)) obarray
= Vobarray
;
3666 obarray
= check_obarray (obarray
);
3668 if (!SYMBOLP (name
))
3670 CHECK_STRING (name
);
3674 string
= SYMBOL_NAME (name
);
3676 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3677 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3683 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3684 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3685 The value is t if a symbol was found and deleted, nil otherwise.
3686 NAME may be a string or a symbol. If it is a symbol, that symbol
3687 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3688 OBARRAY defaults to the value of the variable `obarray'. */)
3690 Lisp_Object name
, obarray
;
3692 register Lisp_Object string
, tem
;
3695 if (NILP (obarray
)) obarray
= Vobarray
;
3696 obarray
= check_obarray (obarray
);
3699 string
= SYMBOL_NAME (name
);
3702 CHECK_STRING (name
);
3706 tem
= oblookup (obarray
, SDATA (string
),
3711 /* If arg was a symbol, don't delete anything but that symbol itself. */
3712 if (SYMBOLP (name
) && !EQ (name
, tem
))
3715 /* There are plenty of other symbols which will screw up the Emacs
3716 session if we unintern them, as well as even more ways to use
3717 `setq' or `fset' or whatnot to make the Emacs session
3718 unusable. Let's not go down this silly road. --Stef */
3719 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3720 error ("Attempt to unintern t or nil"); */
3722 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3724 hash
= oblookup_last_bucket_number
;
3726 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3728 if (XSYMBOL (tem
)->next
)
3729 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3731 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3735 Lisp_Object tail
, following
;
3737 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3738 XSYMBOL (tail
)->next
;
3741 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3742 if (EQ (following
, tem
))
3744 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3753 /* Return the symbol in OBARRAY whose names matches the string
3754 of SIZE characters (SIZE_BYTE bytes) at PTR.
3755 If there is no such symbol in OBARRAY, return nil.
3757 Also store the bucket number in oblookup_last_bucket_number. */
3760 oblookup (Lisp_Object obarray
, register const char *ptr
, int size
, int size_byte
)
3764 register Lisp_Object tail
;
3765 Lisp_Object bucket
, tem
;
3767 if (!VECTORP (obarray
)
3768 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3770 obarray
= check_obarray (obarray
);
3771 obsize
= XVECTOR (obarray
)->size
;
3773 /* This is sometimes needed in the middle of GC. */
3774 obsize
&= ~ARRAY_MARK_FLAG
;
3775 hash
= hash_string (ptr
, size_byte
) % obsize
;
3776 bucket
= XVECTOR (obarray
)->contents
[hash
];
3777 oblookup_last_bucket_number
= hash
;
3778 if (EQ (bucket
, make_number (0)))
3780 else if (!SYMBOLP (bucket
))
3781 error ("Bad data in guts of obarray"); /* Like CADR error message */
3783 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3785 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3786 && SCHARS (SYMBOL_NAME (tail
)) == size
3787 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3789 else if (XSYMBOL (tail
)->next
== 0)
3792 XSETINT (tem
, hash
);
3797 hash_string (const unsigned char *ptr
, int len
)
3799 register const unsigned char *p
= ptr
;
3800 register const unsigned char *end
= p
+ len
;
3801 register unsigned char c
;
3802 register int hash
= 0;
3807 if (c
>= 0140) c
-= 40;
3808 hash
= ((hash
<<3) + (hash
>>28) + c
);
3810 return hash
& 07777777777;
3814 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3817 register Lisp_Object tail
;
3818 CHECK_VECTOR (obarray
);
3819 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3821 tail
= XVECTOR (obarray
)->contents
[i
];
3826 if (XSYMBOL (tail
)->next
== 0)
3828 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3834 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3836 call1 (function
, sym
);
3839 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3840 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3841 OBARRAY defaults to the value of `obarray'. */)
3843 Lisp_Object function
, obarray
;
3845 if (NILP (obarray
)) obarray
= Vobarray
;
3846 obarray
= check_obarray (obarray
);
3848 map_obarray (obarray
, mapatoms_1
, function
);
3852 #define OBARRAY_SIZE 1511
3857 Lisp_Object oblength
;
3859 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3861 Vobarray
= Fmake_vector (oblength
, make_number (0));
3862 initial_obarray
= Vobarray
;
3863 staticpro (&initial_obarray
);
3865 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3866 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3867 NILP (Vpurify_flag) check in intern_c_string. */
3868 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3869 Qnil
= intern_c_string ("nil");
3871 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3872 so those two need to be fixed manally. */
3873 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3874 XSYMBOL (Qunbound
)->function
= Qunbound
;
3875 XSYMBOL (Qunbound
)->plist
= Qnil
;
3876 /* XSYMBOL (Qnil)->function = Qunbound; */
3877 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3878 XSYMBOL (Qnil
)->constant
= 1;
3879 XSYMBOL (Qnil
)->plist
= Qnil
;
3881 Qt
= intern_c_string ("t");
3882 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3883 XSYMBOL (Qt
)->constant
= 1;
3885 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3888 Qvariable_documentation
= intern_c_string ("variable-documentation");
3889 staticpro (&Qvariable_documentation
);
3891 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3892 read_buffer
= (char *) xmalloc (read_buffer_size
);
3896 defsubr (struct Lisp_Subr
*sname
)
3899 sym
= intern_c_string (sname
->symbol_name
);
3900 XSETPVECTYPE (sname
, PVEC_SUBR
);
3901 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3904 #ifdef NOTDEF /* use fset in subr.el now */
3906 defalias (sname
, string
)
3907 struct Lisp_Subr
*sname
;
3911 sym
= intern (string
);
3912 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3916 /* Define an "integer variable"; a symbol whose value is forwarded
3917 to a C variable of type int. Sample call:
3918 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3920 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3921 const char *namestring
, EMACS_INT
*address
)
3924 sym
= intern_c_string (namestring
);
3925 i_fwd
->type
= Lisp_Fwd_Int
;
3926 i_fwd
->intvar
= address
;
3927 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3928 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3931 /* Similar but define a variable whose value is t if address contains 1,
3932 nil if address contains 0. */
3934 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3935 const char *namestring
, int *address
)
3938 sym
= intern_c_string (namestring
);
3939 b_fwd
->type
= Lisp_Fwd_Bool
;
3940 b_fwd
->boolvar
= address
;
3941 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3942 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3943 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3946 /* Similar but define a variable whose value is the Lisp Object stored
3947 at address. Two versions: with and without gc-marking of the C
3948 variable. The nopro version is used when that variable will be
3949 gc-marked for some other reason, since marking the same slot twice
3950 can cause trouble with strings. */
3952 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
3953 const char *namestring
, Lisp_Object
*address
)
3956 sym
= intern_c_string (namestring
);
3957 o_fwd
->type
= Lisp_Fwd_Obj
;
3958 o_fwd
->objvar
= address
;
3959 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3960 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
3964 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
3965 const char *namestring
, Lisp_Object
*address
)
3967 defvar_lisp_nopro (o_fwd
, namestring
, address
);
3968 staticpro (address
);
3971 /* Similar but define a variable whose value is the Lisp Object stored
3972 at a particular offset in the current kboard object. */
3975 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
3976 const char *namestring
, int offset
)
3979 sym
= intern_c_string (namestring
);
3980 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
3981 ko_fwd
->offset
= offset
;
3982 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3983 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
3986 /* Record the value of load-path used at the start of dumping
3987 so we can see if the site changed it later during dumping. */
3988 static Lisp_Object dump_path
;
3994 int turn_off_warning
= 0;
3996 /* Compute the default load-path. */
3998 normal
= PATH_LOADSEARCH
;
3999 Vload_path
= decode_env_path (0, normal
);
4001 if (NILP (Vpurify_flag
))
4002 normal
= PATH_LOADSEARCH
;
4004 normal
= PATH_DUMPLOADSEARCH
;
4006 /* In a dumped Emacs, we normally have to reset the value of
4007 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4008 uses ../lisp, instead of the path of the installed elisp
4009 libraries. However, if it appears that Vload_path was changed
4010 from the default before dumping, don't override that value. */
4013 if (! NILP (Fequal (dump_path
, Vload_path
)))
4015 Vload_path
= decode_env_path (0, normal
);
4016 if (!NILP (Vinstallation_directory
))
4018 Lisp_Object tem
, tem1
, sitelisp
;
4020 /* Remove site-lisp dirs from path temporarily and store
4021 them in sitelisp, then conc them on at the end so
4022 they're always first in path. */
4026 tem
= Fcar (Vload_path
);
4027 tem1
= Fstring_match (build_string ("site-lisp"),
4031 Vload_path
= Fcdr (Vload_path
);
4032 sitelisp
= Fcons (tem
, sitelisp
);
4038 /* Add to the path the lisp subdir of the
4039 installation dir, if it exists. */
4040 tem
= Fexpand_file_name (build_string ("lisp"),
4041 Vinstallation_directory
);
4042 tem1
= Ffile_exists_p (tem
);
4045 if (NILP (Fmember (tem
, Vload_path
)))
4047 turn_off_warning
= 1;
4048 Vload_path
= Fcons (tem
, Vload_path
);
4052 /* That dir doesn't exist, so add the build-time
4053 Lisp dirs instead. */
4054 Vload_path
= nconc2 (Vload_path
, dump_path
);
4056 /* Add leim under the installation dir, if it exists. */
4057 tem
= Fexpand_file_name (build_string ("leim"),
4058 Vinstallation_directory
);
4059 tem1
= Ffile_exists_p (tem
);
4062 if (NILP (Fmember (tem
, Vload_path
)))
4063 Vload_path
= Fcons (tem
, Vload_path
);
4066 /* Add site-lisp under the installation dir, if it exists. */
4067 tem
= Fexpand_file_name (build_string ("site-lisp"),
4068 Vinstallation_directory
);
4069 tem1
= Ffile_exists_p (tem
);
4072 if (NILP (Fmember (tem
, Vload_path
)))
4073 Vload_path
= Fcons (tem
, Vload_path
);
4076 /* If Emacs was not built in the source directory,
4077 and it is run from where it was built, add to load-path
4078 the lisp, leim and site-lisp dirs under that directory. */
4080 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4084 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4085 Vinstallation_directory
);
4086 tem1
= Ffile_exists_p (tem
);
4088 /* Don't be fooled if they moved the entire source tree
4089 AFTER dumping Emacs. If the build directory is indeed
4090 different from the source dir, src/Makefile.in and
4091 src/Makefile will not be found together. */
4092 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4093 Vinstallation_directory
);
4094 tem2
= Ffile_exists_p (tem
);
4095 if (!NILP (tem1
) && NILP (tem2
))
4097 tem
= Fexpand_file_name (build_string ("lisp"),
4100 if (NILP (Fmember (tem
, Vload_path
)))
4101 Vload_path
= Fcons (tem
, Vload_path
);
4103 tem
= Fexpand_file_name (build_string ("leim"),
4106 if (NILP (Fmember (tem
, Vload_path
)))
4107 Vload_path
= Fcons (tem
, Vload_path
);
4109 tem
= Fexpand_file_name (build_string ("site-lisp"),
4112 if (NILP (Fmember (tem
, Vload_path
)))
4113 Vload_path
= Fcons (tem
, Vload_path
);
4116 if (!NILP (sitelisp
))
4117 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4123 /* NORMAL refers to the lisp dir in the source directory. */
4124 /* We used to add ../lisp at the front here, but
4125 that caused trouble because it was copied from dump_path
4126 into Vload_path, above, when Vinstallation_directory was non-nil.
4127 It should be unnecessary. */
4128 Vload_path
= decode_env_path (0, normal
);
4129 dump_path
= Vload_path
;
4133 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4134 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4135 almost never correct, thereby causing a warning to be printed out that
4136 confuses users. Since PATH_LOADSEARCH is always overridden by the
4137 EMACSLOADPATH environment variable below, disable the warning on NT. */
4139 /* Warn if dirs in the *standard* path don't exist. */
4140 if (!turn_off_warning
)
4142 Lisp_Object path_tail
;
4144 for (path_tail
= Vload_path
;
4146 path_tail
= XCDR (path_tail
))
4148 Lisp_Object dirfile
;
4149 dirfile
= Fcar (path_tail
);
4150 if (STRINGP (dirfile
))
4152 dirfile
= Fdirectory_file_name (dirfile
);
4153 if (access (SDATA (dirfile
), 0) < 0)
4154 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4159 #endif /* !(WINDOWSNT || HAVE_NS) */
4161 /* If the EMACSLOADPATH environment variable is set, use its value.
4162 This doesn't apply if we're dumping. */
4164 if (NILP (Vpurify_flag
)
4165 && egetenv ("EMACSLOADPATH"))
4167 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4171 load_in_progress
= 0;
4172 Vload_file_name
= Qnil
;
4174 load_descriptor_list
= Qnil
;
4176 Vstandard_input
= Qt
;
4177 Vloads_in_progress
= Qnil
;
4180 /* Print a warning, using format string FORMAT, that directory DIRNAME
4181 does not exist. Print it on stderr and put it in *Messages*. */
4184 dir_warning (char *format
, Lisp_Object dirname
)
4187 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4189 fprintf (stderr
, format
, SDATA (dirname
));
4190 sprintf (buffer
, format
, SDATA (dirname
));
4191 /* Don't log the warning before we've initialized!! */
4193 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4197 syms_of_lread (void)
4200 defsubr (&Sread_from_string
);
4202 defsubr (&Sintern_soft
);
4203 defsubr (&Sunintern
);
4204 defsubr (&Sget_load_suffixes
);
4206 defsubr (&Seval_buffer
);
4207 defsubr (&Seval_region
);
4208 defsubr (&Sread_char
);
4209 defsubr (&Sread_char_exclusive
);
4210 defsubr (&Sread_event
);
4211 defsubr (&Sget_file_char
);
4212 defsubr (&Smapatoms
);
4213 defsubr (&Slocate_file_internal
);
4215 DEFVAR_LISP ("obarray", &Vobarray
,
4216 doc
: /* Symbol table for use by `intern' and `read'.
4217 It is a vector whose length ought to be prime for best results.
4218 The vector's contents don't make sense if examined from Lisp programs;
4219 to find all the symbols in an obarray, use `mapatoms'. */);
4221 DEFVAR_LISP ("values", &Vvalues
,
4222 doc
: /* List of values of all expressions which were read, evaluated and printed.
4223 Order is reverse chronological. */);
4225 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4226 doc
: /* Stream for read to get input from.
4227 See documentation of `read' for possible values. */);
4228 Vstandard_input
= Qt
;
4230 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4231 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4233 If this variable is a buffer, then only forms read from that buffer
4234 will be added to `read-symbol-positions-list'.
4235 If this variable is t, then all read forms will be added.
4236 The effect of all other values other than nil are not currently
4237 defined, although they may be in the future.
4239 The positions are relative to the last call to `read' or
4240 `read-from-string'. It is probably a bad idea to set this variable at
4241 the toplevel; bind it instead. */);
4242 Vread_with_symbol_positions
= Qnil
;
4244 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4245 doc
: /* A list mapping read symbols to their positions.
4246 This variable is modified during calls to `read' or
4247 `read-from-string', but only when `read-with-symbol-positions' is
4250 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4251 CHAR-POSITION is an integer giving the offset of that occurrence of the
4252 symbol from the position where `read' or `read-from-string' started.
4254 Note that a symbol will appear multiple times in this list, if it was
4255 read multiple times. The list is in the same order as the symbols
4257 Vread_symbol_positions_list
= Qnil
;
4259 DEFVAR_LISP ("read-circle", &Vread_circle
,
4260 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4263 DEFVAR_LISP ("load-path", &Vload_path
,
4264 doc
: /* *List of directories to search for files to load.
4265 Each element is a string (directory name) or nil (try default directory).
4266 Initialized based on EMACSLOADPATH environment variable, if any,
4267 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4269 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4270 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4271 This list should not include the empty string.
4272 `load' and related functions try to append these suffixes, in order,
4273 to the specified file name if a Lisp suffix is allowed or required. */);
4274 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4275 Fcons (make_pure_c_string (".el"), Qnil
));
4276 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4277 doc
: /* List of suffixes that indicate representations of \
4279 This list should normally start with the empty string.
4281 Enabling Auto Compression mode appends the suffixes in
4282 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4283 mode removes them again. `load' and related functions use this list to
4284 determine whether they should look for compressed versions of a file
4285 and, if so, which suffixes they should try to append to the file name
4286 in order to do so. However, if you want to customize which suffixes
4287 the loading functions recognize as compression suffixes, you should
4288 customize `jka-compr-load-suffixes' rather than the present variable. */);
4289 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4291 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4292 doc
: /* Non-nil if inside of `load'. */);
4293 Qload_in_progress
= intern_c_string ("load-in-progress");
4294 staticpro (&Qload_in_progress
);
4296 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4297 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4298 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4300 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4301 a symbol \(a feature name).
4303 When `load' is run and the file-name argument matches an element's
4304 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4305 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4307 An error in FORMS does not undo the load, but does prevent execution of
4308 the rest of the FORMS. */);
4309 Vafter_load_alist
= Qnil
;
4311 DEFVAR_LISP ("load-history", &Vload_history
,
4312 doc
: /* Alist mapping loaded file names to symbols and features.
4313 Each alist element should be a list (FILE-NAME ENTRIES...), where
4314 FILE-NAME is the name of a file that has been loaded into Emacs.
4315 The file name is absolute and true (i.e. it doesn't contain symlinks).
4316 As an exception, one of the alist elements may have FILE-NAME nil,
4317 for symbols and features not associated with any file.
4319 The remaining ENTRIES in the alist element describe the functions and
4320 variables defined in that file, the features provided, and the
4321 features required. Each entry has the form `(provide . FEATURE)',
4322 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4323 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4324 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4325 SYMBOL was an autoload before this file redefined it as a function.
4327 During preloading, the file name recorded is relative to the main Lisp
4328 directory. These file names are converted to absolute at startup. */);
4329 Vload_history
= Qnil
;
4331 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4332 doc
: /* Full name of file being loaded by `load'. */);
4333 Vload_file_name
= Qnil
;
4335 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4336 doc
: /* File name, including directory, of user's initialization file.
4337 If the file loaded had extension `.elc', and the corresponding source file
4338 exists, this variable contains the name of source file, suitable for use
4339 by functions like `custom-save-all' which edit the init file.
4340 While Emacs loads and evaluates the init file, value is the real name
4341 of the file, regardless of whether or not it has the `.elc' extension. */);
4342 Vuser_init_file
= Qnil
;
4344 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4345 doc
: /* Used for internal purposes by `load'. */);
4346 Vcurrent_load_list
= Qnil
;
4348 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4349 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4350 The default is nil, which means use the function `read'. */);
4351 Vload_read_function
= Qnil
;
4353 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4354 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4355 This function is for doing code conversion before reading the source file.
4356 If nil, loading is done without any code conversion.
4357 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4358 FULLNAME is the full name of FILE.
4359 See `load' for the meaning of the remaining arguments. */);
4360 Vload_source_file_function
= Qnil
;
4362 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4363 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4364 This is useful when the file being loaded is a temporary copy. */);
4365 load_force_doc_strings
= 0;
4367 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4368 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4369 This is normally bound by `load' and `eval-buffer' to control `read',
4370 and is not meant for users to change. */);
4371 load_convert_to_unibyte
= 0;
4373 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4374 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4375 You cannot count on them to still be there! */);
4377 = Fexpand_file_name (build_string ("../"),
4378 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4380 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4381 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4382 Vpreloaded_file_list
= Qnil
;
4384 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4385 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4386 Vbyte_boolean_vars
= Qnil
;
4388 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4389 doc
: /* Non-nil means load dangerous compiled Lisp files.
4390 Some versions of XEmacs use different byte codes than Emacs. These
4391 incompatible byte codes can make Emacs crash when it tries to execute
4393 load_dangerous_libraries
= 0;
4395 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4396 doc
: /* Non-nil means force printing messages when loading Lisp files.
4397 This overrides the value of the NOMESSAGE argument to `load'. */);
4398 force_load_messages
= 0;
4400 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4401 doc
: /* Regular expression matching safe to load compiled Lisp files.
4402 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4403 from the file, and matches them against this regular expression.
4404 When the regular expression matches, the file is considered to be safe
4405 to load. See also `load-dangerous-libraries'. */);
4406 Vbytecomp_version_regexp
4407 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4409 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4410 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4411 Veval_buffer_list
= Qnil
;
4413 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4414 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4415 Vold_style_backquotes
= Qnil
;
4416 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4417 staticpro (&Qold_style_backquotes
);
4419 /* Vsource_directory was initialized in init_lread. */
4421 load_descriptor_list
= Qnil
;
4422 staticpro (&load_descriptor_list
);
4424 Qcurrent_load_list
= intern_c_string ("current-load-list");
4425 staticpro (&Qcurrent_load_list
);
4427 Qstandard_input
= intern_c_string ("standard-input");
4428 staticpro (&Qstandard_input
);
4430 Qread_char
= intern_c_string ("read-char");
4431 staticpro (&Qread_char
);
4433 Qget_file_char
= intern_c_string ("get-file-char");
4434 staticpro (&Qget_file_char
);
4436 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4437 staticpro (&Qget_emacs_mule_file_char
);
4439 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4440 staticpro (&Qload_force_doc_strings
);
4442 Qbackquote
= intern_c_string ("`");
4443 staticpro (&Qbackquote
);
4444 Qcomma
= intern_c_string (",");
4445 staticpro (&Qcomma
);
4446 Qcomma_at
= intern_c_string (",@");
4447 staticpro (&Qcomma_at
);
4448 Qcomma_dot
= intern_c_string (",.");
4449 staticpro (&Qcomma_dot
);
4451 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4452 staticpro (&Qinhibit_file_name_operation
);
4454 Qascii_character
= intern_c_string ("ascii-character");
4455 staticpro (&Qascii_character
);
4457 Qfunction
= intern_c_string ("function");
4458 staticpro (&Qfunction
);
4460 Qload
= intern_c_string ("load");
4463 Qload_file_name
= intern_c_string ("load-file-name");
4464 staticpro (&Qload_file_name
);
4466 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4467 staticpro (&Qeval_buffer_list
);
4469 Qfile_truename
= intern_c_string ("file-truename");
4470 staticpro (&Qfile_truename
) ;
4472 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4473 staticpro (&Qdo_after_load_evaluation
) ;
4475 staticpro (&dump_path
);
4477 staticpro (&read_objects
);
4478 read_objects
= Qnil
;
4479 staticpro (&seen_list
);
4482 Vloads_in_progress
= Qnil
;
4483 staticpro (&Vloads_in_progress
);
4485 Qhash_table
= intern_c_string ("hash-table");
4486 staticpro (&Qhash_table
);
4487 Qdata
= intern_c_string ("data");
4489 Qtest
= intern_c_string ("test");
4491 Qsize
= intern_c_string ("size");
4493 Qweakness
= intern_c_string ("weakness");
4494 staticpro (&Qweakness
);
4495 Qrehash_size
= intern_c_string ("rehash-size");
4496 staticpro (&Qrehash_size
);
4497 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4498 staticpro (&Qrehash_threshold
);
4501 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4502 (do not change this comment) */