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 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
787 message_with_string ("%s", prompt
, 0);
788 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
790 return (NILP (val
) ? Qnil
791 : make_number (char_resolve_modifier_mask (XINT (val
))));
794 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
795 doc
: /* Read an event object from the input stream.
796 If the optional argument PROMPT is non-nil, display that as a prompt.
797 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
798 input method is turned on in the current buffer, that input method
799 is used for reading a character.
800 If the optional argument SECONDS is non-nil, it should be a number
801 specifying the maximum number of seconds to wait for input. If no
802 input arrives in that time, return nil. SECONDS may be a
803 floating-point value. */)
804 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
807 message_with_string ("%s", prompt
, 0);
808 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
811 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
812 doc
: /* Read a character from the command input (keyboard or macro).
813 It is returned as a number. Non-character events are ignored.
814 If the character has modifiers, they are resolved and reflected to the
815 character code if possible (e.g. C-SPC -> 0).
817 If the optional argument PROMPT is non-nil, display that as a prompt.
818 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
819 input method is turned on in the current buffer, that input method
820 is used for reading a character.
821 If the optional argument SECONDS is non-nil, it should be a number
822 specifying the maximum number of seconds to wait for input. If no
823 input arrives in that time, return nil. SECONDS may be a
824 floating-point value. */)
825 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
830 message_with_string ("%s", prompt
, 0);
832 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
834 return (NILP (val
) ? Qnil
835 : make_number (char_resolve_modifier_mask (XINT (val
))));
838 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
839 doc
: /* Don't use this yourself. */)
842 register Lisp_Object val
;
844 XSETINT (val
, getc (instream
));
851 /* Value is a version number of byte compiled code if the file
852 associated with file descriptor FD is a compiled Lisp file that's
853 safe to load. Only files compiled with Emacs are safe to load.
854 Files compiled with XEmacs can lead to a crash in Fbyte_code
855 because of an incompatible change in the byte compiler. */
858 safe_to_load_p (int fd
)
865 /* Read the first few bytes from the file, and look for a line
866 specifying the byte compiler version used. */
867 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
872 /* Skip to the next newline, skipping over the initial `ELC'
873 with NUL bytes following it, but note the version. */
874 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
879 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
886 lseek (fd
, 0, SEEK_SET
);
891 /* Callback for record_unwind_protect. Restore the old load list OLD,
892 after loading a file successfully. */
895 record_load_unwind (Lisp_Object old
)
897 return Vloads_in_progress
= old
;
900 /* This handler function is used via internal_condition_case_1. */
903 load_error_handler (Lisp_Object data
)
909 load_warn_old_style_backquotes (Lisp_Object file
)
911 if (!NILP (Vold_style_backquotes
))
914 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
921 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
922 doc
: /* Return the suffixes that `load' should try if a suffix is \
924 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
927 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
928 while (CONSP (suffixes
))
930 Lisp_Object exts
= Vload_file_rep_suffixes
;
931 suffix
= XCAR (suffixes
);
932 suffixes
= XCDR (suffixes
);
937 lst
= Fcons (concat2 (suffix
, ext
), lst
);
940 return Fnreverse (lst
);
943 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
944 doc
: /* Execute a file of Lisp code named FILE.
945 First try FILE with `.elc' appended, then try with `.el',
946 then try FILE unmodified (the exact suffixes in the exact order are
947 determined by `load-suffixes'). Environment variable references in
948 FILE are replaced with their values by calling `substitute-in-file-name'.
949 This function searches the directories in `load-path'.
951 If optional second arg NOERROR is non-nil,
952 report no error if FILE doesn't exist.
953 Print messages at start and end of loading unless
954 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
956 If optional fourth arg NOSUFFIX is non-nil, don't try adding
957 suffixes `.elc' or `.el' to the specified name FILE.
958 If optional fifth arg MUST-SUFFIX is non-nil, insist on
959 the suffix `.elc' or `.el'; don't accept just FILE unless
960 it ends in one of those suffixes or includes a directory name.
962 If this function fails to find a file, it may look for different
963 representations of that file before trying another file.
964 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
965 to the file name. Emacs uses this feature mainly to find compressed
966 versions of files when Auto Compression mode is enabled.
968 The exact suffixes that this function tries out, in the exact order,
969 are given by the value of the variable `load-file-rep-suffixes' if
970 NOSUFFIX is non-nil and by the return value of the function
971 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
972 MUST-SUFFIX are nil, this function first tries out the latter suffixes
975 Loading a file records its definitions, and its `provide' and
976 `require' calls, in an element of `load-history' whose
977 car is the file name loaded. See `load-history'.
979 Return t if the file exists and loads successfully. */)
980 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
982 register FILE *stream
;
983 register int fd
= -1;
984 int count
= SPECPDL_INDEX ();
985 struct gcpro gcpro1
, gcpro2
, gcpro3
;
986 Lisp_Object found
, efound
, hist_file_name
;
987 /* 1 means we printed the ".el is newer" message. */
989 /* 1 means we are loading a compiled file. */
1001 CHECK_STRING (file
);
1003 /* If file name is magic, call the handler. */
1004 /* This shouldn't be necessary any more now that `openp' handles it right.
1005 handler = Ffind_file_name_handler (file, Qload);
1006 if (!NILP (handler))
1007 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1009 /* Do this after the handler to avoid
1010 the need to gcpro noerror, nomessage and nosuffix.
1011 (Below here, we care only whether they are nil or not.)
1012 The presence of this call is the result of a historical accident:
1013 it used to be in every file-operation and when it got removed
1014 everywhere, it accidentally stayed here. Since then, enough people
1015 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1016 that it seemed risky to remove. */
1017 if (! NILP (noerror
))
1019 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1020 Qt
, load_error_handler
);
1025 file
= Fsubstitute_in_file_name (file
);
1028 /* Avoid weird lossage with null string as arg,
1029 since it would try to load a directory as a Lisp file */
1030 if (SCHARS (file
) > 0)
1032 int size
= SBYTES (file
);
1035 GCPRO2 (file
, found
);
1037 if (! NILP (must_suffix
))
1039 /* Don't insist on adding a suffix if FILE already ends with one. */
1041 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1044 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1046 /* Don't insist on adding a suffix
1047 if the argument includes a directory name. */
1048 else if (! NILP (Ffile_name_directory (file
)))
1052 fd
= openp (Vload_path
, file
,
1053 (!NILP (nosuffix
) ? Qnil
1054 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1055 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1056 tmp
[1] = Vload_file_rep_suffixes
,
1065 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1069 /* Tell startup.el whether or not we found the user's init file. */
1070 if (EQ (Qt
, Vuser_init_file
))
1071 Vuser_init_file
= found
;
1073 /* If FD is -2, that means openp found a magic file. */
1076 if (NILP (Fequal (found
, file
)))
1077 /* If FOUND is a different file name from FILE,
1078 find its handler even if we have already inhibited
1079 the `load' operation on FILE. */
1080 handler
= Ffind_file_name_handler (found
, Qt
);
1082 handler
= Ffind_file_name_handler (found
, Qload
);
1083 if (! NILP (handler
))
1084 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1087 /* Check if we're stuck in a recursive load cycle.
1089 2000-09-21: It's not possible to just check for the file loaded
1090 being a member of Vloads_in_progress. This fails because of the
1091 way the byte compiler currently works; `provide's are not
1092 evaluated, see font-lock.el/jit-lock.el as an example. This
1093 leads to a certain amount of ``normal'' recursion.
1095 Also, just loading a file recursively is not always an error in
1096 the general case; the second load may do something different. */
1100 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1101 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1105 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1107 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1108 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1111 /* Get the name for load-history. */
1112 hist_file_name
= (! NILP (Vpurify_flag
)
1113 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1114 tmp
[1] = Ffile_name_nondirectory (found
),
1120 /* Check for the presence of old-style quotes and warn about them. */
1121 specbind (Qold_style_backquotes
, Qnil
);
1122 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1124 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1125 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1126 /* Load .elc files directly, but not when they are
1127 remote and have no handler! */
1134 GCPRO3 (file
, found
, hist_file_name
);
1137 && ! (version
= safe_to_load_p (fd
)))
1140 if (!load_dangerous_libraries
)
1144 error ("File `%s' was not compiled in Emacs",
1147 else if (!NILP (nomessage
) && !force_load_messages
)
1148 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1153 efound
= ENCODE_FILE (found
);
1158 stat ((char *)SDATA (efound
), &s1
);
1159 SSET (efound
, SBYTES (efound
) - 1, 0);
1160 result
= stat ((char *)SDATA (efound
), &s2
);
1161 SSET (efound
, SBYTES (efound
) - 1, 'c');
1163 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1165 /* Make the progress messages mention that source is newer. */
1168 /* If we won't print another message, mention this anyway. */
1169 if (!NILP (nomessage
) && !force_load_messages
)
1171 Lisp_Object msg_file
;
1172 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1173 message_with_string ("Source file `%s' newer than byte-compiled file",
1182 /* We are loading a source file (*.el). */
1183 if (!NILP (Vload_source_file_function
))
1189 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1190 NILP (noerror
) ? Qnil
: Qt
,
1191 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1192 return unbind_to (count
, val
);
1196 GCPRO3 (file
, found
, hist_file_name
);
1200 efound
= ENCODE_FILE (found
);
1201 stream
= fopen ((char *) SDATA (efound
), fmode
);
1202 #else /* not WINDOWSNT */
1203 stream
= fdopen (fd
, fmode
);
1204 #endif /* not WINDOWSNT */
1208 error ("Failure to create stdio stream for %s", SDATA (file
));
1211 if (! NILP (Vpurify_flag
))
1212 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1214 if (NILP (nomessage
) || force_load_messages
)
1217 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1220 message_with_string ("Loading %s (source)...", file
, 1);
1222 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1224 else /* The typical case; compiled file newer than source file. */
1225 message_with_string ("Loading %s...", file
, 1);
1228 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1229 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1230 specbind (Qload_file_name
, found
);
1231 specbind (Qinhibit_file_name_operation
, Qnil
);
1232 load_descriptor_list
1233 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1234 specbind (Qload_in_progress
, Qt
);
1235 if (! version
|| version
>= 22)
1236 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1237 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1240 /* We can't handle a file which was compiled with
1241 byte-compile-dynamic by older version of Emacs. */
1242 specbind (Qload_force_doc_strings
, Qt
);
1243 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1244 0, Qnil
, Qnil
, Qnil
, Qnil
);
1246 unbind_to (count
, Qnil
);
1248 /* Run any eval-after-load forms for this file */
1249 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1250 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1254 xfree (saved_doc_string
);
1255 saved_doc_string
= 0;
1256 saved_doc_string_size
= 0;
1258 xfree (prev_saved_doc_string
);
1259 prev_saved_doc_string
= 0;
1260 prev_saved_doc_string_size
= 0;
1262 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1265 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1268 message_with_string ("Loading %s (source)...done", file
, 1);
1270 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1272 else /* The typical case; compiled file newer than source file. */
1273 message_with_string ("Loading %s...done", file
, 1);
1280 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1283 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1294 load_descriptor_unwind (Lisp_Object oldlist
)
1296 load_descriptor_list
= oldlist
;
1300 /* Close all descriptors in use for Floads.
1301 This is used when starting a subprocess. */
1304 close_load_descs (void)
1308 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1309 emacs_close (XFASTINT (XCAR (tail
)));
1314 complete_filename_p (Lisp_Object pathname
)
1316 register const unsigned char *s
= SDATA (pathname
);
1317 return (IS_DIRECTORY_SEP (s
[0])
1318 || (SCHARS (pathname
) > 2
1319 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1322 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1323 doc
: /* Search for FILENAME through PATH.
1324 Returns the file's name in absolute form, or nil if not found.
1325 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1326 file name when searching.
1327 If non-nil, PREDICATE is used instead of `file-readable-p'.
1328 PREDICATE can also be an integer to pass to the access(2) function,
1329 in which case file-name-handlers are ignored. */)
1330 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1333 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1334 if (NILP (predicate
) && fd
> 0)
1340 /* Search for a file whose name is STR, looking in directories
1341 in the Lisp list PATH, and trying suffixes from SUFFIX.
1342 On success, returns a file descriptor. On failure, returns -1.
1344 SUFFIXES is a list of strings containing possible suffixes.
1345 The empty suffix is automatically added if the list is empty.
1347 PREDICATE non-nil means don't open the files,
1348 just look for one that satisfies the predicate. In this case,
1349 returns 1 on success. The predicate can be a lisp function or
1350 an integer to pass to `access' (in which case file-name-handlers
1353 If STOREPTR is nonzero, it points to a slot where the name of
1354 the file actually found should be stored as a Lisp string.
1355 nil is stored there on failure.
1357 If the file we find is remote, return -2
1358 but store the found remote file name in *STOREPTR. */
1361 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1366 register char *fn
= buf
;
1369 Lisp_Object filename
;
1371 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1372 Lisp_Object string
, tail
, encoded_fn
;
1373 int max_suffix_len
= 0;
1377 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1379 CHECK_STRING_CAR (tail
);
1380 max_suffix_len
= max (max_suffix_len
,
1381 SBYTES (XCAR (tail
)));
1384 string
= filename
= encoded_fn
= Qnil
;
1385 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1390 if (complete_filename_p (str
))
1393 for (; CONSP (path
); path
= XCDR (path
))
1395 filename
= Fexpand_file_name (str
, XCAR (path
));
1396 if (!complete_filename_p (filename
))
1397 /* If there are non-absolute elts in PATH (eg ".") */
1398 /* Of course, this could conceivably lose if luser sets
1399 default-directory to be something non-absolute... */
1401 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1402 if (!complete_filename_p (filename
))
1403 /* Give up on this path element! */
1407 /* Calculate maximum size of any filename made from
1408 this path element/specified file name and any possible suffix. */
1409 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1410 if (fn_size
< want_size
)
1411 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1413 /* Loop over suffixes. */
1414 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1415 CONSP (tail
); tail
= XCDR (tail
))
1417 int lsuffix
= SBYTES (XCAR (tail
));
1418 Lisp_Object handler
;
1421 /* Concatenate path element/specified name with the suffix.
1422 If the directory starts with /:, remove that. */
1423 if (SCHARS (filename
) > 2
1424 && SREF (filename
, 0) == '/'
1425 && SREF (filename
, 1) == ':')
1427 strncpy (fn
, SDATA (filename
) + 2,
1428 SBYTES (filename
) - 2);
1429 fn
[SBYTES (filename
) - 2] = 0;
1433 strncpy (fn
, SDATA (filename
),
1435 fn
[SBYTES (filename
)] = 0;
1438 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1439 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1441 /* Check that the file exists and is not a directory. */
1442 /* We used to only check for handlers on non-absolute file names:
1446 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1447 It's not clear why that was the case and it breaks things like
1448 (load "/bar.el") where the file is actually "/bar.el.gz". */
1449 string
= build_string (fn
);
1450 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1451 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1453 if (NILP (predicate
))
1454 exists
= !NILP (Ffile_readable_p (string
));
1456 exists
= !NILP (call1 (predicate
, string
));
1457 if (exists
&& !NILP (Ffile_directory_p (string
)))
1462 /* We succeeded; return this descriptor and filename. */
1473 encoded_fn
= ENCODE_FILE (string
);
1474 pfn
= SDATA (encoded_fn
);
1475 exists
= (stat (pfn
, &st
) >= 0
1476 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1479 /* Check that we can access or open it. */
1480 if (NATNUMP (predicate
))
1481 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1483 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1487 /* We succeeded; return this descriptor and filename. */
1505 /* Merge the list we've accumulated of globals from the current input source
1506 into the load_history variable. The details depend on whether
1507 the source has an associated file name or not.
1509 FILENAME is the file name that we are loading from.
1510 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1513 build_load_history (Lisp_Object filename
, int entire
)
1515 register Lisp_Object tail
, prev
, newelt
;
1516 register Lisp_Object tem
, tem2
;
1517 register int foundit
= 0;
1519 tail
= Vload_history
;
1522 while (CONSP (tail
))
1526 /* Find the feature's previous assoc list... */
1527 if (!NILP (Fequal (filename
, Fcar (tem
))))
1531 /* If we're loading the entire file, remove old data. */
1535 Vload_history
= XCDR (tail
);
1537 Fsetcdr (prev
, XCDR (tail
));
1540 /* Otherwise, cons on new symbols that are not already members. */
1543 tem2
= Vcurrent_load_list
;
1545 while (CONSP (tem2
))
1547 newelt
= XCAR (tem2
);
1549 if (NILP (Fmember (newelt
, tem
)))
1550 Fsetcar (tail
, Fcons (XCAR (tem
),
1551 Fcons (newelt
, XCDR (tem
))));
1564 /* If we're loading an entire file, cons the new assoc onto the
1565 front of load-history, the most-recently-loaded position. Also
1566 do this if we didn't find an existing member for the file. */
1567 if (entire
|| !foundit
)
1568 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1573 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1581 readevalloop_1 (Lisp_Object old
)
1583 load_convert_to_unibyte
= ! NILP (old
);
1587 /* Signal an `end-of-file' error, if possible with file name
1591 end_of_file_error (void)
1593 if (STRINGP (Vload_file_name
))
1594 xsignal1 (Qend_of_file
, Vload_file_name
);
1596 xsignal0 (Qend_of_file
);
1599 /* UNIBYTE specifies how to set load_convert_to_unibyte
1600 for this invocation.
1601 READFUN, if non-nil, is used instead of `read'.
1603 START, END specify region to read in current buffer (from eval-region).
1604 If the input is not from a buffer, they must be nil. */
1607 readevalloop (Lisp_Object readcharfun
,
1609 Lisp_Object sourcename
,
1610 Lisp_Object (*evalfun
) (Lisp_Object
),
1612 Lisp_Object unibyte
, Lisp_Object readfun
,
1613 Lisp_Object start
, Lisp_Object end
)
1616 register Lisp_Object val
;
1617 int count
= SPECPDL_INDEX ();
1618 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1619 struct buffer
*b
= 0;
1620 int continue_reading_p
;
1621 /* Nonzero if reading an entire buffer. */
1622 int whole_buffer
= 0;
1623 /* 1 on the first time around. */
1626 if (MARKERP (readcharfun
))
1629 start
= readcharfun
;
1632 if (BUFFERP (readcharfun
))
1633 b
= XBUFFER (readcharfun
);
1634 else if (MARKERP (readcharfun
))
1635 b
= XMARKER (readcharfun
)->buffer
;
1637 /* We assume START is nil when input is not from a buffer. */
1638 if (! NILP (start
) && !b
)
1641 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1642 specbind (Qcurrent_load_list
, Qnil
);
1643 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1644 load_convert_to_unibyte
= !NILP (unibyte
);
1646 GCPRO4 (sourcename
, readfun
, start
, end
);
1648 /* Try to ensure sourcename is a truename, except whilst preloading. */
1649 if (NILP (Vpurify_flag
)
1650 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1651 && !NILP (Ffboundp (Qfile_truename
)))
1652 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1654 LOADHIST_ATTACH (sourcename
);
1656 continue_reading_p
= 1;
1657 while (continue_reading_p
)
1659 int count1
= SPECPDL_INDEX ();
1661 if (b
!= 0 && NILP (b
->name
))
1662 error ("Reading from killed buffer");
1666 /* Switch to the buffer we are reading from. */
1667 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1668 set_buffer_internal (b
);
1670 /* Save point in it. */
1671 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1672 /* Save ZV in it. */
1673 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1674 /* Those get unbound after we read one expression. */
1676 /* Set point and ZV around stuff to be read. */
1679 Fnarrow_to_region (make_number (BEGV
), end
);
1681 /* Just for cleanliness, convert END to a marker
1682 if it is an integer. */
1684 end
= Fpoint_max_marker ();
1687 /* On the first cycle, we can easily test here
1688 whether we are reading the whole buffer. */
1689 if (b
&& first_sexp
)
1690 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1697 while ((c
= READCHAR
) != '\n' && c
!= -1);
1702 unbind_to (count1
, Qnil
);
1706 /* Ignore whitespace here, so we can detect eof. */
1707 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1708 || c
== 0x8a0) /* NBSP */
1711 if (!NILP (Vpurify_flag
) && c
== '(')
1713 record_unwind_protect (unreadpure
, Qnil
);
1714 val
= read_list (-1, readcharfun
);
1719 read_objects
= Qnil
;
1720 if (!NILP (readfun
))
1722 val
= call1 (readfun
, readcharfun
);
1724 /* If READCHARFUN has set point to ZV, we should
1725 stop reading, even if the form read sets point
1726 to a different value when evaluated. */
1727 if (BUFFERP (readcharfun
))
1729 struct buffer
*b
= XBUFFER (readcharfun
);
1730 if (BUF_PT (b
) == BUF_ZV (b
))
1731 continue_reading_p
= 0;
1734 else if (! NILP (Vload_read_function
))
1735 val
= call1 (Vload_read_function
, readcharfun
);
1737 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1740 if (!NILP (start
) && continue_reading_p
)
1741 start
= Fpoint_marker ();
1743 /* Restore saved point and BEGV. */
1744 unbind_to (count1
, Qnil
);
1746 /* Now eval what we just read. */
1747 val
= (*evalfun
) (val
);
1751 Vvalues
= Fcons (val
, Vvalues
);
1752 if (EQ (Vstandard_output
, Qt
))
1761 build_load_history (sourcename
,
1762 stream
|| whole_buffer
);
1766 unbind_to (count
, Qnil
);
1769 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1770 doc
: /* Execute the current buffer as Lisp code.
1771 When called from a Lisp program (i.e., not interactively), this
1772 function accepts up to five optional arguments:
1773 BUFFER is the buffer to evaluate (nil means use current buffer).
1774 PRINTFLAG controls printing of output:
1775 A value of nil means discard it; anything else is stream for print.
1776 FILENAME specifies the file name to use for `load-history'.
1777 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1779 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1780 functions should work normally even if PRINTFLAG is nil.
1782 This function preserves the position of point. */)
1783 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1785 int count
= SPECPDL_INDEX ();
1786 Lisp_Object tem
, buf
;
1789 buf
= Fcurrent_buffer ();
1791 buf
= Fget_buffer (buffer
);
1793 error ("No such buffer");
1795 if (NILP (printflag
) && NILP (do_allow_print
))
1800 if (NILP (filename
))
1801 filename
= XBUFFER (buf
)->filename
;
1803 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1804 specbind (Qstandard_output
, tem
);
1805 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1806 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1807 readevalloop (buf
, 0, filename
, Feval
,
1808 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1809 unbind_to (count
, Qnil
);
1814 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1815 doc
: /* Execute the region as Lisp code.
1816 When called from programs, expects two arguments,
1817 giving starting and ending indices in the current buffer
1818 of the text to be executed.
1819 Programs can pass third argument PRINTFLAG which controls output:
1820 A value of nil means discard it; anything else is stream for printing it.
1821 Also the fourth argument READ-FUNCTION, if non-nil, is used
1822 instead of `read' to read each expression. It gets one argument
1823 which is the input stream for reading characters.
1825 This function does not move point. */)
1826 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1828 int count
= SPECPDL_INDEX ();
1829 Lisp_Object tem
, cbuf
;
1831 cbuf
= Fcurrent_buffer ();
1833 if (NILP (printflag
))
1837 specbind (Qstandard_output
, tem
);
1838 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1840 /* readevalloop calls functions which check the type of start and end. */
1841 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1842 !NILP (printflag
), Qnil
, read_function
,
1845 return unbind_to (count
, Qnil
);
1849 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1850 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1851 If STREAM is nil, use the value of `standard-input' (which see).
1852 STREAM or the value of `standard-input' may be:
1853 a buffer (read from point and advance it)
1854 a marker (read from where it points and advance it)
1855 a function (call it with no arguments for each character,
1856 call it with a char as argument to push a char back)
1857 a string (takes text from string, starting at the beginning)
1858 t (read text line using minibuffer and use it, or read from
1859 standard input in batch mode). */)
1860 (Lisp_Object stream
)
1863 stream
= Vstandard_input
;
1864 if (EQ (stream
, Qt
))
1865 stream
= Qread_char
;
1866 if (EQ (stream
, Qread_char
))
1867 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1869 return read_internal_start (stream
, Qnil
, Qnil
);
1872 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1873 doc
: /* Read one Lisp expression which is represented as text by STRING.
1874 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1875 START and END optionally delimit a substring of STRING from which to read;
1876 they default to 0 and (length STRING) respectively. */)
1877 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1880 CHECK_STRING (string
);
1881 /* read_internal_start sets read_from_string_index. */
1882 ret
= read_internal_start (string
, start
, end
);
1883 return Fcons (ret
, make_number (read_from_string_index
));
1886 /* Function to set up the global context we need in toplevel read
1889 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1890 /* start, end only used when stream is a string. */
1895 new_backquote_flag
= 0;
1896 read_objects
= Qnil
;
1897 if (EQ (Vread_with_symbol_positions
, Qt
)
1898 || EQ (Vread_with_symbol_positions
, stream
))
1899 Vread_symbol_positions_list
= Qnil
;
1901 if (STRINGP (stream
)
1902 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1904 int startval
, endval
;
1907 if (STRINGP (stream
))
1910 string
= XCAR (stream
);
1913 endval
= SCHARS (string
);
1917 endval
= XINT (end
);
1918 if (endval
< 0 || endval
> SCHARS (string
))
1919 args_out_of_range (string
, end
);
1926 CHECK_NUMBER (start
);
1927 startval
= XINT (start
);
1928 if (startval
< 0 || startval
> endval
)
1929 args_out_of_range (string
, start
);
1931 read_from_string_index
= startval
;
1932 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1933 read_from_string_limit
= endval
;
1936 retval
= read0 (stream
);
1937 if (EQ (Vread_with_symbol_positions
, Qt
)
1938 || EQ (Vread_with_symbol_positions
, stream
))
1939 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1944 /* Signal Qinvalid_read_syntax error.
1945 S is error string of length N (if > 0) */
1948 invalid_syntax (const char *s
, int n
)
1952 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1956 /* Use this for recursive reads, in contexts where internal tokens
1960 read0 (Lisp_Object readcharfun
)
1962 register Lisp_Object val
;
1965 val
= read1 (readcharfun
, &c
, 0);
1969 xsignal1 (Qinvalid_read_syntax
,
1970 Fmake_string (make_number (1), make_number (c
)));
1973 static int read_buffer_size
;
1974 static char *read_buffer
;
1976 /* Read a \-escape sequence, assuming we already read the `\'.
1977 If the escape sequence forces unibyte, return eight-bit char. */
1980 read_escape (Lisp_Object readcharfun
, int stringp
)
1982 register int c
= READCHAR
;
1983 /* \u allows up to four hex digits, \U up to eight. Default to the
1984 behavior for \u, and change this value in the case that \U is seen. */
1985 int unicode_hex_count
= 4;
1990 end_of_file_error ();
2020 error ("Invalid escape character syntax");
2023 c
= read_escape (readcharfun
, 0);
2024 return c
| meta_modifier
;
2029 error ("Invalid escape character syntax");
2032 c
= read_escape (readcharfun
, 0);
2033 return c
| shift_modifier
;
2038 error ("Invalid escape character syntax");
2041 c
= read_escape (readcharfun
, 0);
2042 return c
| hyper_modifier
;
2047 error ("Invalid escape character syntax");
2050 c
= read_escape (readcharfun
, 0);
2051 return c
| alt_modifier
;
2055 if (stringp
|| c
!= '-')
2062 c
= read_escape (readcharfun
, 0);
2063 return c
| super_modifier
;
2068 error ("Invalid escape character syntax");
2072 c
= read_escape (readcharfun
, 0);
2073 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2074 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2075 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2076 return c
| ctrl_modifier
;
2077 /* ASCII control chars are made from letters (both cases),
2078 as well as the non-letters within 0100...0137. */
2079 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2080 return (c
& (037 | ~0177));
2081 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2082 return (c
& (037 | ~0177));
2084 return c
| ctrl_modifier
;
2094 /* An octal escape, as in ANSI C. */
2096 register int i
= c
- '0';
2097 register int count
= 0;
2100 if ((c
= READCHAR
) >= '0' && c
<= '7')
2112 if (i
>= 0x80 && i
< 0x100)
2113 i
= BYTE8_TO_CHAR (i
);
2118 /* A hex escape, as in ANSI C. */
2125 if (c
>= '0' && c
<= '9')
2130 else if ((c
>= 'a' && c
<= 'f')
2131 || (c
>= 'A' && c
<= 'F'))
2134 if (c
>= 'a' && c
<= 'f')
2147 if (count
< 3 && i
>= 0x80)
2148 return BYTE8_TO_CHAR (i
);
2153 /* Post-Unicode-2.0: Up to eight hex chars. */
2154 unicode_hex_count
= 8;
2157 /* A Unicode escape. We only permit them in strings and characters,
2158 not arbitrarily in the source code, as in some other languages. */
2163 while (++count
<= unicode_hex_count
)
2166 /* isdigit and isalpha may be locale-specific, which we don't
2168 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2169 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2170 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2173 error ("Non-hex digit used for Unicode escape");
2178 error ("Non-Unicode character: 0x%x", i
);
2187 /* Read an integer in radix RADIX using READCHARFUN to read
2188 characters. RADIX must be in the interval [2..36]; if it isn't, a
2189 read error is signaled . Value is the integer read. Signals an
2190 error if encountering invalid read syntax or if RADIX is out of
2194 read_integer (Lisp_Object readcharfun
, int radix
)
2196 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2197 /* We use a floating point number because */
2200 if (radix
< 2 || radix
> 36)
2204 number
= ndigits
= invalid_p
= 0;
2220 if (c
>= '0' && c
<= '9')
2222 else if (c
>= 'a' && c
<= 'z')
2223 digit
= c
- 'a' + 10;
2224 else if (c
>= 'A' && c
<= 'Z')
2225 digit
= c
- 'A' + 10;
2232 if (digit
< 0 || digit
>= radix
)
2235 number
= radix
* number
+ digit
;
2241 if (ndigits
== 0 || invalid_p
)
2244 sprintf (buf
, "integer, radix %d", radix
);
2245 invalid_syntax (buf
, 0);
2248 return make_fixnum_or_float (sign
* number
);
2252 /* If the next token is ')' or ']' or '.', we store that character
2253 in *PCH and the return value is not interesting. Else, we store
2254 zero in *PCH and we read and return one lisp object.
2256 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2259 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2262 int uninterned_symbol
= 0;
2270 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2272 end_of_file_error ();
2277 return read_list (0, readcharfun
);
2280 return read_vector (readcharfun
, 0);
2296 /* Accept extended format for hashtables (extensible to
2298 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2299 Lisp_Object tmp
= read_list (0, readcharfun
);
2300 Lisp_Object head
= CAR_SAFE (tmp
);
2301 Lisp_Object data
= Qnil
;
2302 Lisp_Object val
= Qnil
;
2303 /* The size is 2 * number of allowed keywords to
2305 Lisp_Object params
[10];
2307 Lisp_Object key
= Qnil
;
2308 int param_count
= 0;
2310 if (!EQ (head
, Qhash_table
))
2311 error ("Invalid extended read marker at head of #s list "
2312 "(only hash-table allowed)");
2314 tmp
= CDR_SAFE (tmp
);
2316 /* This is repetitive but fast and simple. */
2317 params
[param_count
] = QCsize
;
2318 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2319 if (!NILP (params
[param_count
+ 1]))
2322 params
[param_count
] = QCtest
;
2323 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2324 if (!NILP (params
[param_count
+ 1]))
2327 params
[param_count
] = QCweakness
;
2328 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2329 if (!NILP (params
[param_count
+ 1]))
2332 params
[param_count
] = QCrehash_size
;
2333 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2334 if (!NILP (params
[param_count
+ 1]))
2337 params
[param_count
] = QCrehash_threshold
;
2338 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2339 if (!NILP (params
[param_count
+ 1]))
2342 /* This is the hashtable data. */
2343 data
= Fplist_get (tmp
, Qdata
);
2345 /* Now use params to make a new hashtable and fill it. */
2346 ht
= Fmake_hash_table (param_count
, params
);
2348 while (CONSP (data
))
2353 error ("Odd number of elements in hashtable data");
2356 Fputhash (key
, val
, ht
);
2362 invalid_syntax ("#", 1);
2370 tmp
= read_vector (readcharfun
, 0);
2371 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2372 error ("Invalid size char-table");
2373 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2384 tmp
= read_vector (readcharfun
, 0);
2385 if (!INTEGERP (AREF (tmp
, 0)))
2386 error ("Invalid depth in char-table");
2387 depth
= XINT (AREF (tmp
, 0));
2388 if (depth
< 1 || depth
> 3)
2389 error ("Invalid depth in char-table");
2390 size
= XVECTOR (tmp
)->size
- 2;
2391 if (chartab_size
[depth
] != size
)
2392 error ("Invalid size char-table");
2393 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2396 invalid_syntax ("#^^", 3);
2398 invalid_syntax ("#^", 2);
2403 length
= read1 (readcharfun
, pch
, first_in_list
);
2407 Lisp_Object tmp
, val
;
2409 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2410 / BOOL_VECTOR_BITS_PER_CHAR
);
2413 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2414 if (STRING_MULTIBYTE (tmp
)
2415 || (size_in_chars
!= SCHARS (tmp
)
2416 /* We used to print 1 char too many
2417 when the number of bits was a multiple of 8.
2418 Accept such input in case it came from an old
2420 && ! (XFASTINT (length
)
2421 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2422 invalid_syntax ("#&...", 5);
2424 val
= Fmake_bool_vector (length
, Qnil
);
2425 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2426 /* Clear the extraneous bits in the last byte. */
2427 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2428 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2429 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2432 invalid_syntax ("#&...", 5);
2436 /* Accept compiled functions at read-time so that we don't have to
2437 build them using function calls. */
2439 tmp
= read_vector (readcharfun
, 1);
2440 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2441 XVECTOR (tmp
)->contents
);
2446 struct gcpro gcpro1
;
2449 /* Read the string itself. */
2450 tmp
= read1 (readcharfun
, &ch
, 0);
2451 if (ch
!= 0 || !STRINGP (tmp
))
2452 invalid_syntax ("#", 1);
2454 /* Read the intervals and their properties. */
2457 Lisp_Object beg
, end
, plist
;
2459 beg
= read1 (readcharfun
, &ch
, 0);
2464 end
= read1 (readcharfun
, &ch
, 0);
2466 plist
= read1 (readcharfun
, &ch
, 0);
2468 invalid_syntax ("Invalid string property list", 0);
2469 Fset_text_properties (beg
, end
, plist
, tmp
);
2475 /* #@NUMBER is used to skip NUMBER following characters.
2476 That's used in .elc files to skip over doc strings
2477 and function definitions. */
2483 /* Read a decimal integer. */
2484 while ((c
= READCHAR
) >= 0
2485 && c
>= '0' && c
<= '9')
2493 if (load_force_doc_strings
2494 && (EQ (readcharfun
, Qget_file_char
)
2495 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2497 /* If we are supposed to force doc strings into core right now,
2498 record the last string that we skipped,
2499 and record where in the file it comes from. */
2501 /* But first exchange saved_doc_string
2502 with prev_saved_doc_string, so we save two strings. */
2504 char *temp
= saved_doc_string
;
2505 int temp_size
= saved_doc_string_size
;
2506 file_offset temp_pos
= saved_doc_string_position
;
2507 int temp_len
= saved_doc_string_length
;
2509 saved_doc_string
= prev_saved_doc_string
;
2510 saved_doc_string_size
= prev_saved_doc_string_size
;
2511 saved_doc_string_position
= prev_saved_doc_string_position
;
2512 saved_doc_string_length
= prev_saved_doc_string_length
;
2514 prev_saved_doc_string
= temp
;
2515 prev_saved_doc_string_size
= temp_size
;
2516 prev_saved_doc_string_position
= temp_pos
;
2517 prev_saved_doc_string_length
= temp_len
;
2520 if (saved_doc_string_size
== 0)
2522 saved_doc_string_size
= nskip
+ 100;
2523 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2525 if (nskip
> saved_doc_string_size
)
2527 saved_doc_string_size
= nskip
+ 100;
2528 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2529 saved_doc_string_size
);
2532 saved_doc_string_position
= file_tell (instream
);
2534 /* Copy that many characters into saved_doc_string. */
2535 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2536 saved_doc_string
[i
] = c
= READCHAR
;
2538 saved_doc_string_length
= i
;
2542 /* Skip that many characters. */
2543 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2552 /* #! appears at the beginning of an executable file.
2553 Skip the first line. */
2554 while (c
!= '\n' && c
>= 0)
2559 return Vload_file_name
;
2561 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2562 /* #:foo is the uninterned symbol named foo. */
2565 uninterned_symbol
= 1;
2569 /* Reader forms that can reuse previously read objects. */
2570 if (c
>= '0' && c
<= '9')
2575 /* Read a non-negative integer. */
2576 while (c
>= '0' && c
<= '9')
2582 /* #n=object returns object, but associates it with n for #n#. */
2583 if (c
== '=' && !NILP (Vread_circle
))
2585 /* Make a placeholder for #n# to use temporarily */
2586 Lisp_Object placeholder
;
2589 placeholder
= Fcons (Qnil
, Qnil
);
2590 cell
= Fcons (make_number (n
), placeholder
);
2591 read_objects
= Fcons (cell
, read_objects
);
2593 /* Read the object itself. */
2594 tem
= read0 (readcharfun
);
2596 /* Now put it everywhere the placeholder was... */
2597 substitute_object_in_subtree (tem
, placeholder
);
2599 /* ...and #n# will use the real value from now on. */
2600 Fsetcdr (cell
, tem
);
2604 /* #n# returns a previously read object. */
2605 if (c
== '#' && !NILP (Vread_circle
))
2607 tem
= Fassq (make_number (n
), read_objects
);
2610 /* Fall through to error message. */
2612 else if (c
== 'r' || c
== 'R')
2613 return read_integer (readcharfun
, n
);
2615 /* Fall through to error message. */
2617 else if (c
== 'x' || c
== 'X')
2618 return read_integer (readcharfun
, 16);
2619 else if (c
== 'o' || c
== 'O')
2620 return read_integer (readcharfun
, 8);
2621 else if (c
== 'b' || c
== 'B')
2622 return read_integer (readcharfun
, 2);
2625 invalid_syntax ("#", 1);
2628 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2633 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2638 int next_char
= READCHAR
;
2640 /* Transition from old-style to new-style:
2641 If we see "(`" it used to mean old-style, which usually works
2642 fine because ` should almost never appear in such a position
2643 for new-style. But occasionally we need "(`" to mean new
2644 style, so we try to distinguish the two by the fact that we
2645 can either write "( `foo" or "(` foo", where the first
2646 intends to use new-style whereas the second intends to use
2647 old-style. For Emacs-25, we should completely remove this
2648 first_in_list exception (old-style can still be obtained via
2650 if (first_in_list
&& next_char
== ' ')
2652 Vold_style_backquotes
= Qt
;
2659 new_backquote_flag
++;
2660 value
= read0 (readcharfun
);
2661 new_backquote_flag
--;
2663 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2667 if (new_backquote_flag
)
2669 Lisp_Object comma_type
= Qnil
;
2674 comma_type
= Qcomma_at
;
2676 comma_type
= Qcomma_dot
;
2679 if (ch
>= 0) UNREAD (ch
);
2680 comma_type
= Qcomma
;
2683 new_backquote_flag
--;
2684 value
= read0 (readcharfun
);
2685 new_backquote_flag
++;
2686 return Fcons (comma_type
, Fcons (value
, Qnil
));
2690 Vold_style_backquotes
= Qt
;
2702 end_of_file_error ();
2704 /* Accept `single space' syntax like (list ? x) where the
2705 whitespace character is SPC or TAB.
2706 Other literal whitespace like NL, CR, and FF are not accepted,
2707 as there are well-established escape sequences for these. */
2708 if (c
== ' ' || c
== '\t')
2709 return make_number (c
);
2712 c
= read_escape (readcharfun
, 0);
2713 modifiers
= c
& CHAR_MODIFIER_MASK
;
2714 c
&= ~CHAR_MODIFIER_MASK
;
2715 if (CHAR_BYTE8_P (c
))
2716 c
= CHAR_TO_BYTE8 (c
);
2719 next_char
= READCHAR
;
2720 if (next_char
== '.')
2722 /* Only a dotted-pair dot is valid after a char constant. */
2723 int next_next_char
= READCHAR
;
2724 UNREAD (next_next_char
);
2726 ok
= (next_next_char
<= 040
2727 || (next_next_char
< 0200
2728 && (index ("\"';([#?", next_next_char
)
2729 || (!first_in_list
&& next_next_char
== '`')
2730 || (new_backquote_flag
&& next_next_char
== ','))));
2734 ok
= (next_char
<= 040
2735 || (next_char
< 0200
2736 && (index ("\"';()[]#?", next_char
)
2737 || (!first_in_list
&& next_char
== '`')
2738 || (new_backquote_flag
&& next_char
== ','))));
2742 return make_number (c
);
2744 invalid_syntax ("?", 1);
2749 char *p
= read_buffer
;
2750 char *end
= read_buffer
+ read_buffer_size
;
2752 /* Nonzero if we saw an escape sequence specifying
2753 a multibyte character. */
2754 int force_multibyte
= 0;
2755 /* Nonzero if we saw an escape sequence specifying
2756 a single-byte character. */
2757 int force_singlebyte
= 0;
2761 while ((c
= READCHAR
) >= 0
2764 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2766 int offset
= p
- read_buffer
;
2767 read_buffer
= (char *) xrealloc (read_buffer
,
2768 read_buffer_size
*= 2);
2769 p
= read_buffer
+ offset
;
2770 end
= read_buffer
+ read_buffer_size
;
2777 c
= read_escape (readcharfun
, 1);
2779 /* C is -1 if \ newline has just been seen */
2782 if (p
== read_buffer
)
2787 modifiers
= c
& CHAR_MODIFIER_MASK
;
2788 c
= c
& ~CHAR_MODIFIER_MASK
;
2790 if (CHAR_BYTE8_P (c
))
2791 force_singlebyte
= 1;
2792 else if (! ASCII_CHAR_P (c
))
2793 force_multibyte
= 1;
2794 else /* i.e. ASCII_CHAR_P (c) */
2796 /* Allow `\C- ' and `\C-?'. */
2797 if (modifiers
== CHAR_CTL
)
2800 c
= 0, modifiers
= 0;
2802 c
= 127, modifiers
= 0;
2804 if (modifiers
& CHAR_SHIFT
)
2806 /* Shift modifier is valid only with [A-Za-z]. */
2807 if (c
>= 'A' && c
<= 'Z')
2808 modifiers
&= ~CHAR_SHIFT
;
2809 else if (c
>= 'a' && c
<= 'z')
2810 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2813 if (modifiers
& CHAR_META
)
2815 /* Move the meta bit to the right place for a
2817 modifiers
&= ~CHAR_META
;
2818 c
= BYTE8_TO_CHAR (c
| 0x80);
2819 force_singlebyte
= 1;
2823 /* Any modifiers remaining are invalid. */
2825 error ("Invalid modifier in string");
2826 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2830 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2831 if (CHAR_BYTE8_P (c
))
2832 force_singlebyte
= 1;
2833 else if (! ASCII_CHAR_P (c
))
2834 force_multibyte
= 1;
2840 end_of_file_error ();
2842 /* If purifying, and string starts with \ newline,
2843 return zero instead. This is for doc strings
2844 that we are really going to find in etc/DOC.nn.nn */
2845 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2846 return make_number (0);
2848 if (force_multibyte
)
2849 /* READ_BUFFER already contains valid multibyte forms. */
2851 else if (force_singlebyte
)
2853 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2854 p
= read_buffer
+ nchars
;
2857 /* Otherwise, READ_BUFFER contains only ASCII. */
2860 /* We want readchar_count to be the number of characters, not
2861 bytes. Hence we adjust for multibyte characters in the
2862 string. ... But it doesn't seem to be necessary, because
2863 READCHAR *does* read multibyte characters from buffers. */
2864 /* readchar_count -= (p - read_buffer) - nchars; */
2866 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2868 || (p
- read_buffer
!= nchars
)));
2869 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2871 || (p
- read_buffer
!= nchars
)));
2876 int next_char
= READCHAR
;
2879 if (next_char
<= 040
2880 || (next_char
< 0200
2881 && (index ("\"';([#?", next_char
)
2882 || (!first_in_list
&& next_char
== '`')
2883 || (new_backquote_flag
&& next_char
== ','))))
2889 /* Otherwise, we fall through! Note that the atom-reading loop
2890 below will now loop at least once, assuring that we will not
2891 try to UNREAD two characters in a row. */
2895 if (c
<= 040) goto retry
;
2896 if (c
== 0x8a0) /* NBSP */
2899 char *p
= read_buffer
;
2903 char *end
= read_buffer
+ read_buffer_size
;
2906 && c
!= 0x8a0 /* NBSP */
2908 || (!index ("\"';()[]#", c
)
2909 && !(!first_in_list
&& c
== '`')
2910 && !(new_backquote_flag
&& c
== ','))))
2912 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2914 int offset
= p
- read_buffer
;
2915 read_buffer
= (char *) xrealloc (read_buffer
,
2916 read_buffer_size
*= 2);
2917 p
= read_buffer
+ offset
;
2918 end
= read_buffer
+ read_buffer_size
;
2925 end_of_file_error ();
2930 p
+= CHAR_STRING (c
, p
);
2938 int offset
= p
- read_buffer
;
2939 read_buffer
= (char *) xrealloc (read_buffer
,
2940 read_buffer_size
*= 2);
2941 p
= read_buffer
+ offset
;
2942 end
= read_buffer
+ read_buffer_size
;
2949 if (!quoted
&& !uninterned_symbol
)
2953 if (*p1
== '+' || *p1
== '-') p1
++;
2954 /* Is it an integer? */
2957 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2958 /* Integers can have trailing decimal points. */
2959 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2961 /* It is an integer. */
2966 /* EMACS_INT n = atol (read_buffer); */
2967 char *endptr
= NULL
;
2968 EMACS_INT n
= (errno
= 0,
2969 strtol (read_buffer
, &endptr
, 10));
2970 if (errno
== ERANGE
&& endptr
)
2973 = Fcons (make_string (read_buffer
,
2974 endptr
- read_buffer
),
2976 xsignal (Qoverflow_error
, args
);
2978 return make_fixnum_or_float (n
);
2982 if (isfloat_string (read_buffer
, 0))
2984 /* Compute NaN and infinities using 0.0 in a variable,
2985 to cope with compilers that think they are smarter
2991 /* Negate the value ourselves. This treats 0, NaNs,
2992 and infinity properly on IEEE floating point hosts,
2993 and works around a common bug where atof ("-0.0")
2995 int negative
= read_buffer
[0] == '-';
2997 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2998 returns 1, is if the input ends in e+INF or e+NaN. */
3005 value
= zero
/ zero
;
3007 /* If that made a "negative" NaN, negate it. */
3011 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3014 u_minus_zero
.d
= - 0.0;
3015 for (i
= 0; i
< sizeof (double); i
++)
3016 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3022 /* Now VALUE is a positive NaN. */
3025 value
= atof (read_buffer
+ negative
);
3029 return make_float (negative
? - value
: value
);
3033 Lisp_Object name
, result
;
3034 EMACS_INT nbytes
= p
- read_buffer
;
3036 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3039 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3040 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3042 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3043 result
= (uninterned_symbol
? Fmake_symbol (name
)
3044 : Fintern (name
, Qnil
));
3046 if (EQ (Vread_with_symbol_positions
, Qt
)
3047 || EQ (Vread_with_symbol_positions
, readcharfun
))
3048 Vread_symbol_positions_list
=
3049 /* Kind of a hack; this will probably fail if characters
3050 in the symbol name were escaped. Not really a big
3052 Fcons (Fcons (result
,
3053 make_number (readchar_count
3054 - XFASTINT (Flength (Fsymbol_name (result
))))),
3055 Vread_symbol_positions_list
);
3063 /* List of nodes we've seen during substitute_object_in_subtree. */
3064 static Lisp_Object seen_list
;
3067 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3069 Lisp_Object check_object
;
3071 /* We haven't seen any objects when we start. */
3074 /* Make all the substitutions. */
3076 = substitute_object_recurse (object
, placeholder
, object
);
3078 /* Clear seen_list because we're done with it. */
3081 /* The returned object here is expected to always eq the
3083 if (!EQ (check_object
, object
))
3084 error ("Unexpected mutation error in reader");
3087 /* Feval doesn't get called from here, so no gc protection is needed. */
3088 #define SUBSTITUTE(get_val, set_val) \
3090 Lisp_Object old_value = get_val; \
3091 Lisp_Object true_value \
3092 = substitute_object_recurse (object, placeholder, \
3095 if (!EQ (old_value, true_value)) \
3102 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3104 /* If we find the placeholder, return the target object. */
3105 if (EQ (placeholder
, subtree
))
3108 /* If we've been to this node before, don't explore it again. */
3109 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3112 /* If this node can be the entry point to a cycle, remember that
3113 we've seen it. It can only be such an entry point if it was made
3114 by #n=, which means that we can find it as a value in
3116 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3117 seen_list
= Fcons (subtree
, seen_list
);
3119 /* Recurse according to subtree's type.
3120 Every branch must return a Lisp_Object. */
3121 switch (XTYPE (subtree
))
3123 case Lisp_Vectorlike
:
3126 if (BOOL_VECTOR_P (subtree
))
3127 return subtree
; /* No sub-objects anyway. */
3128 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3129 || COMPILEDP (subtree
))
3130 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3131 else if (VECTORP (subtree
))
3132 length
= ASIZE (subtree
);
3134 /* An unknown pseudovector may contain non-Lisp fields, so we
3135 can't just blindly traverse all its fields. We used to call
3136 `Flength' which signaled `sequencep', so I just preserved this
3138 wrong_type_argument (Qsequencep
, subtree
);
3140 for (i
= 0; i
< length
; i
++)
3141 SUBSTITUTE (AREF (subtree
, i
),
3142 ASET (subtree
, i
, true_value
));
3148 SUBSTITUTE (XCAR (subtree
),
3149 XSETCAR (subtree
, true_value
));
3150 SUBSTITUTE (XCDR (subtree
),
3151 XSETCDR (subtree
, true_value
));
3157 /* Check for text properties in each interval.
3158 substitute_in_interval contains part of the logic. */
3160 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3161 Lisp_Object arg
= Fcons (object
, placeholder
);
3163 traverse_intervals_noorder (root_interval
,
3164 &substitute_in_interval
, arg
);
3169 /* Other types don't recurse any further. */
3175 /* Helper function for substitute_object_recurse. */
3177 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3179 Lisp_Object object
= Fcar (arg
);
3180 Lisp_Object placeholder
= Fcdr (arg
);
3182 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3193 isfloat_string (register char *cp
, int ignore_trailing
)
3200 if (*cp
== '+' || *cp
== '-')
3203 if (*cp
>= '0' && *cp
<= '9')
3206 while (*cp
>= '0' && *cp
<= '9')
3214 if (*cp
>= '0' && *cp
<= '9')
3217 while (*cp
>= '0' && *cp
<= '9')
3220 if (*cp
== 'e' || *cp
== 'E')
3224 if (*cp
== '+' || *cp
== '-')
3228 if (*cp
>= '0' && *cp
<= '9')
3231 while (*cp
>= '0' && *cp
<= '9')
3234 else if (cp
== start
)
3236 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3241 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3247 return ((ignore_trailing
3248 || (*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3249 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3250 || state
== (DOT_CHAR
|TRAIL_INT
)
3251 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3252 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3253 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3258 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3262 register Lisp_Object
*ptr
;
3263 register Lisp_Object tem
, item
, vector
;
3264 register struct Lisp_Cons
*otem
;
3267 tem
= read_list (1, readcharfun
);
3268 len
= Flength (tem
);
3269 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3271 size
= XVECTOR (vector
)->size
;
3272 ptr
= XVECTOR (vector
)->contents
;
3273 for (i
= 0; i
< size
; i
++)
3276 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3277 bytecode object, the docstring containing the bytecode and
3278 constants values must be treated as unibyte and passed to
3279 Fread, to get the actual bytecode string and constants vector. */
3280 if (bytecodeflag
&& load_force_doc_strings
)
3282 if (i
== COMPILED_BYTECODE
)
3284 if (!STRINGP (item
))
3285 error ("Invalid byte code");
3287 /* Delay handling the bytecode slot until we know whether
3288 it is lazily-loaded (we can tell by whether the
3289 constants slot is nil). */
3290 ptr
[COMPILED_CONSTANTS
] = item
;
3293 else if (i
== COMPILED_CONSTANTS
)
3295 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3299 /* Coerce string to unibyte (like string-as-unibyte,
3300 but without generating extra garbage and
3301 guaranteeing no change in the contents). */
3302 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3303 STRING_SET_UNIBYTE (bytestr
);
3305 item
= Fread (Fcons (bytestr
, readcharfun
));
3307 error ("Invalid byte code");
3309 otem
= XCONS (item
);
3310 bytestr
= XCAR (item
);
3315 /* Now handle the bytecode slot. */
3316 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3318 else if (i
== COMPILED_DOC_STRING
3320 && ! STRING_MULTIBYTE (item
))
3322 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3323 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3325 item
= Fstring_as_multibyte (item
);
3328 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3336 /* FLAG = 1 means check for ] to terminate rather than ) and .
3337 FLAG = -1 means check for starting with defun
3338 and make structure pure. */
3341 read_list (int flag
, register Lisp_Object readcharfun
)
3343 /* -1 means check next element for defun,
3344 0 means don't check,
3345 1 means already checked and found defun. */
3346 int defunflag
= flag
< 0 ? -1 : 0;
3347 Lisp_Object val
, tail
;
3348 register Lisp_Object elt
, tem
;
3349 struct gcpro gcpro1
, gcpro2
;
3350 /* 0 is the normal case.
3351 1 means this list is a doc reference; replace it with the number 0.
3352 2 means this list is a doc reference; replace it with the doc string. */
3353 int doc_reference
= 0;
3355 /* Initialize this to 1 if we are reading a list. */
3356 int first_in_list
= flag
<= 0;
3365 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3370 /* While building, if the list starts with #$, treat it specially. */
3371 if (EQ (elt
, Vload_file_name
)
3373 && !NILP (Vpurify_flag
))
3375 if (NILP (Vdoc_file_name
))
3376 /* We have not yet called Snarf-documentation, so assume
3377 this file is described in the DOC-MM.NN file
3378 and Snarf-documentation will fill in the right value later.
3379 For now, replace the whole list with 0. */
3382 /* We have already called Snarf-documentation, so make a relative
3383 file name for this file, so it can be found properly
3384 in the installed Lisp directory.
3385 We don't use Fexpand_file_name because that would make
3386 the directory absolute now. */
3387 elt
= concat2 (build_string ("../lisp/"),
3388 Ffile_name_nondirectory (elt
));
3390 else if (EQ (elt
, Vload_file_name
)
3392 && load_force_doc_strings
)
3401 invalid_syntax (") or . in a vector", 18);
3409 XSETCDR (tail
, read0 (readcharfun
));
3411 val
= read0 (readcharfun
);
3412 read1 (readcharfun
, &ch
, 0);
3416 if (doc_reference
== 1)
3417 return make_number (0);
3418 if (doc_reference
== 2)
3420 /* Get a doc string from the file we are loading.
3421 If it's in saved_doc_string, get it from there.
3423 Here, we don't know if the string is a
3424 bytecode string or a doc string. As a
3425 bytecode string must be unibyte, we always
3426 return a unibyte string. If it is actually a
3427 doc string, caller must make it
3430 int pos
= XINT (XCDR (val
));
3431 /* Position is negative for user variables. */
3432 if (pos
< 0) pos
= -pos
;
3433 if (pos
>= saved_doc_string_position
3434 && pos
< (saved_doc_string_position
3435 + saved_doc_string_length
))
3437 int start
= pos
- saved_doc_string_position
;
3440 /* Process quoting with ^A,
3441 and find the end of the string,
3442 which is marked with ^_ (037). */
3443 for (from
= start
, to
= start
;
3444 saved_doc_string
[from
] != 037;)
3446 int c
= saved_doc_string
[from
++];
3449 c
= saved_doc_string
[from
++];
3451 saved_doc_string
[to
++] = c
;
3453 saved_doc_string
[to
++] = 0;
3455 saved_doc_string
[to
++] = 037;
3458 saved_doc_string
[to
++] = c
;
3461 return make_unibyte_string (saved_doc_string
+ start
,
3464 /* Look in prev_saved_doc_string the same way. */
3465 else if (pos
>= prev_saved_doc_string_position
3466 && pos
< (prev_saved_doc_string_position
3467 + prev_saved_doc_string_length
))
3469 int start
= pos
- prev_saved_doc_string_position
;
3472 /* Process quoting with ^A,
3473 and find the end of the string,
3474 which is marked with ^_ (037). */
3475 for (from
= start
, to
= start
;
3476 prev_saved_doc_string
[from
] != 037;)
3478 int c
= prev_saved_doc_string
[from
++];
3481 c
= prev_saved_doc_string
[from
++];
3483 prev_saved_doc_string
[to
++] = c
;
3485 prev_saved_doc_string
[to
++] = 0;
3487 prev_saved_doc_string
[to
++] = 037;
3490 prev_saved_doc_string
[to
++] = c
;
3493 return make_unibyte_string (prev_saved_doc_string
3498 return get_doc_string (val
, 1, 0);
3503 invalid_syntax (". in wrong context", 18);
3505 invalid_syntax ("] in a list", 11);
3507 tem
= (read_pure
&& flag
<= 0
3508 ? pure_cons (elt
, Qnil
)
3509 : Fcons (elt
, Qnil
));
3511 XSETCDR (tail
, tem
);
3516 defunflag
= EQ (elt
, Qdefun
);
3517 else if (defunflag
> 0)
3522 Lisp_Object Vobarray
;
3523 Lisp_Object initial_obarray
;
3525 /* oblookup stores the bucket number here, for the sake of Funintern. */
3527 int oblookup_last_bucket_number
;
3529 static int hash_string (const unsigned char *ptr
, int len
);
3531 /* Get an error if OBARRAY is not an obarray.
3532 If it is one, return it. */
3535 check_obarray (Lisp_Object obarray
)
3537 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3539 /* If Vobarray is now invalid, force it to be valid. */
3540 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3541 wrong_type_argument (Qvectorp
, obarray
);
3546 /* Intern the C string STR: return a symbol with that name,
3547 interned in the current obarray. */
3550 intern (const char *str
)
3553 int len
= strlen (str
);
3554 Lisp_Object obarray
;
3557 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3558 obarray
= check_obarray (obarray
);
3559 tem
= oblookup (obarray
, str
, len
, len
);
3562 return Fintern (make_string (str
, len
), obarray
);
3566 intern_c_string (const char *str
)
3569 int len
= strlen (str
);
3570 Lisp_Object obarray
;
3573 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3574 obarray
= check_obarray (obarray
);
3575 tem
= oblookup (obarray
, str
, len
, len
);
3579 if (NILP (Vpurify_flag
))
3580 /* Creating a non-pure string from a string literal not
3581 implemented yet. We could just use make_string here and live
3582 with the extra copy. */
3585 return Fintern (make_pure_c_string (str
), obarray
);
3588 /* Create an uninterned symbol with name STR. */
3591 make_symbol (char *str
)
3593 int len
= strlen (str
);
3595 return Fmake_symbol ((!NILP (Vpurify_flag
)
3596 ? make_pure_string (str
, len
, len
, 0)
3597 : make_string (str
, len
)));
3600 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3601 doc
: /* Return the canonical symbol whose name is STRING.
3602 If there is none, one is created by this function and returned.
3603 A second optional argument specifies the obarray to use;
3604 it defaults to the value of `obarray'. */)
3605 (Lisp_Object string
, Lisp_Object obarray
)
3607 register Lisp_Object tem
, sym
, *ptr
;
3609 if (NILP (obarray
)) obarray
= Vobarray
;
3610 obarray
= check_obarray (obarray
);
3612 CHECK_STRING (string
);
3614 tem
= oblookup (obarray
, SDATA (string
),
3617 if (!INTEGERP (tem
))
3620 if (!NILP (Vpurify_flag
))
3621 string
= Fpurecopy (string
);
3622 sym
= Fmake_symbol (string
);
3624 if (EQ (obarray
, initial_obarray
))
3625 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3627 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3629 if ((SREF (string
, 0) == ':')
3630 && EQ (obarray
, initial_obarray
))
3632 XSYMBOL (sym
)->constant
= 1;
3633 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3634 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3637 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3639 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3641 XSYMBOL (sym
)->next
= 0;
3646 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3647 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3648 NAME may be a string or a symbol. If it is a symbol, that exact
3649 symbol is searched for.
3650 A second optional argument specifies the obarray to use;
3651 it defaults to the value of `obarray'. */)
3652 (Lisp_Object name
, Lisp_Object obarray
)
3654 register Lisp_Object tem
, string
;
3656 if (NILP (obarray
)) obarray
= Vobarray
;
3657 obarray
= check_obarray (obarray
);
3659 if (!SYMBOLP (name
))
3661 CHECK_STRING (name
);
3665 string
= SYMBOL_NAME (name
);
3667 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3668 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3674 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3675 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3676 The value is t if a symbol was found and deleted, nil otherwise.
3677 NAME may be a string or a symbol. If it is a symbol, that symbol
3678 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3679 OBARRAY defaults to the value of the variable `obarray'. */)
3680 (Lisp_Object name
, Lisp_Object obarray
)
3682 register Lisp_Object string
, tem
;
3685 if (NILP (obarray
)) obarray
= Vobarray
;
3686 obarray
= check_obarray (obarray
);
3689 string
= SYMBOL_NAME (name
);
3692 CHECK_STRING (name
);
3696 tem
= oblookup (obarray
, SDATA (string
),
3701 /* If arg was a symbol, don't delete anything but that symbol itself. */
3702 if (SYMBOLP (name
) && !EQ (name
, tem
))
3705 /* There are plenty of other symbols which will screw up the Emacs
3706 session if we unintern them, as well as even more ways to use
3707 `setq' or `fset' or whatnot to make the Emacs session
3708 unusable. Let's not go down this silly road. --Stef */
3709 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3710 error ("Attempt to unintern t or nil"); */
3712 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3714 hash
= oblookup_last_bucket_number
;
3716 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3718 if (XSYMBOL (tem
)->next
)
3719 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3721 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3725 Lisp_Object tail
, following
;
3727 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3728 XSYMBOL (tail
)->next
;
3731 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3732 if (EQ (following
, tem
))
3734 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3743 /* Return the symbol in OBARRAY whose names matches the string
3744 of SIZE characters (SIZE_BYTE bytes) at PTR.
3745 If there is no such symbol in OBARRAY, return nil.
3747 Also store the bucket number in oblookup_last_bucket_number. */
3750 oblookup (Lisp_Object obarray
, register const char *ptr
, int size
, int size_byte
)
3754 register Lisp_Object tail
;
3755 Lisp_Object bucket
, tem
;
3757 if (!VECTORP (obarray
)
3758 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3760 obarray
= check_obarray (obarray
);
3761 obsize
= XVECTOR (obarray
)->size
;
3763 /* This is sometimes needed in the middle of GC. */
3764 obsize
&= ~ARRAY_MARK_FLAG
;
3765 hash
= hash_string (ptr
, size_byte
) % obsize
;
3766 bucket
= XVECTOR (obarray
)->contents
[hash
];
3767 oblookup_last_bucket_number
= hash
;
3768 if (EQ (bucket
, make_number (0)))
3770 else if (!SYMBOLP (bucket
))
3771 error ("Bad data in guts of obarray"); /* Like CADR error message */
3773 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3775 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3776 && SCHARS (SYMBOL_NAME (tail
)) == size
3777 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3779 else if (XSYMBOL (tail
)->next
== 0)
3782 XSETINT (tem
, hash
);
3787 hash_string (const unsigned char *ptr
, int len
)
3789 register const unsigned char *p
= ptr
;
3790 register const unsigned char *end
= p
+ len
;
3791 register unsigned char c
;
3792 register int hash
= 0;
3797 if (c
>= 0140) c
-= 40;
3798 hash
= ((hash
<<3) + (hash
>>28) + c
);
3800 return hash
& 07777777777;
3804 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3807 register Lisp_Object tail
;
3808 CHECK_VECTOR (obarray
);
3809 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3811 tail
= XVECTOR (obarray
)->contents
[i
];
3816 if (XSYMBOL (tail
)->next
== 0)
3818 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3824 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3826 call1 (function
, sym
);
3829 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3830 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3831 OBARRAY defaults to the value of `obarray'. */)
3832 (Lisp_Object function
, Lisp_Object obarray
)
3834 if (NILP (obarray
)) obarray
= Vobarray
;
3835 obarray
= check_obarray (obarray
);
3837 map_obarray (obarray
, mapatoms_1
, function
);
3841 #define OBARRAY_SIZE 1511
3846 Lisp_Object oblength
;
3848 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3850 Vobarray
= Fmake_vector (oblength
, make_number (0));
3851 initial_obarray
= Vobarray
;
3852 staticpro (&initial_obarray
);
3854 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3855 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3856 NILP (Vpurify_flag) check in intern_c_string. */
3857 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3858 Qnil
= intern_c_string ("nil");
3860 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3861 so those two need to be fixed manally. */
3862 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3863 XSYMBOL (Qunbound
)->function
= Qunbound
;
3864 XSYMBOL (Qunbound
)->plist
= Qnil
;
3865 /* XSYMBOL (Qnil)->function = Qunbound; */
3866 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3867 XSYMBOL (Qnil
)->constant
= 1;
3868 XSYMBOL (Qnil
)->plist
= Qnil
;
3870 Qt
= intern_c_string ("t");
3871 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3872 XSYMBOL (Qt
)->constant
= 1;
3874 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3877 Qvariable_documentation
= intern_c_string ("variable-documentation");
3878 staticpro (&Qvariable_documentation
);
3880 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3881 read_buffer
= (char *) xmalloc (read_buffer_size
);
3885 defsubr (struct Lisp_Subr
*sname
)
3888 sym
= intern_c_string (sname
->symbol_name
);
3889 XSETPVECTYPE (sname
, PVEC_SUBR
);
3890 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3893 #ifdef NOTDEF /* use fset in subr.el now */
3895 defalias (sname
, string
)
3896 struct Lisp_Subr
*sname
;
3900 sym
= intern (string
);
3901 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3905 /* Define an "integer variable"; a symbol whose value is forwarded
3906 to a C variable of type int. Sample call:
3907 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3909 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3910 const char *namestring
, EMACS_INT
*address
)
3913 sym
= intern_c_string (namestring
);
3914 i_fwd
->type
= Lisp_Fwd_Int
;
3915 i_fwd
->intvar
= address
;
3916 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3917 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3920 /* Similar but define a variable whose value is t if address contains 1,
3921 nil if address contains 0. */
3923 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3924 const char *namestring
, int *address
)
3927 sym
= intern_c_string (namestring
);
3928 b_fwd
->type
= Lisp_Fwd_Bool
;
3929 b_fwd
->boolvar
= address
;
3930 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3931 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3932 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3935 /* Similar but define a variable whose value is the Lisp Object stored
3936 at address. Two versions: with and without gc-marking of the C
3937 variable. The nopro version is used when that variable will be
3938 gc-marked for some other reason, since marking the same slot twice
3939 can cause trouble with strings. */
3941 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
3942 const char *namestring
, Lisp_Object
*address
)
3945 sym
= intern_c_string (namestring
);
3946 o_fwd
->type
= Lisp_Fwd_Obj
;
3947 o_fwd
->objvar
= address
;
3948 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3949 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
3953 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
3954 const char *namestring
, Lisp_Object
*address
)
3956 defvar_lisp_nopro (o_fwd
, namestring
, address
);
3957 staticpro (address
);
3960 /* Similar but define a variable whose value is the Lisp Object stored
3961 at a particular offset in the current kboard object. */
3964 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
3965 const char *namestring
, int offset
)
3968 sym
= intern_c_string (namestring
);
3969 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
3970 ko_fwd
->offset
= offset
;
3971 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3972 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
3975 /* Record the value of load-path used at the start of dumping
3976 so we can see if the site changed it later during dumping. */
3977 static Lisp_Object dump_path
;
3983 int turn_off_warning
= 0;
3985 /* Compute the default load-path. */
3987 normal
= PATH_LOADSEARCH
;
3988 Vload_path
= decode_env_path (0, normal
);
3990 if (NILP (Vpurify_flag
))
3991 normal
= PATH_LOADSEARCH
;
3993 normal
= PATH_DUMPLOADSEARCH
;
3995 /* In a dumped Emacs, we normally have to reset the value of
3996 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3997 uses ../lisp, instead of the path of the installed elisp
3998 libraries. However, if it appears that Vload_path was changed
3999 from the default before dumping, don't override that value. */
4002 if (! NILP (Fequal (dump_path
, Vload_path
)))
4004 Vload_path
= decode_env_path (0, normal
);
4005 if (!NILP (Vinstallation_directory
))
4007 Lisp_Object tem
, tem1
, sitelisp
;
4009 /* Remove site-lisp dirs from path temporarily and store
4010 them in sitelisp, then conc them on at the end so
4011 they're always first in path. */
4015 tem
= Fcar (Vload_path
);
4016 tem1
= Fstring_match (build_string ("site-lisp"),
4020 Vload_path
= Fcdr (Vload_path
);
4021 sitelisp
= Fcons (tem
, sitelisp
);
4027 /* Add to the path the lisp subdir of the
4028 installation dir, if it exists. */
4029 tem
= Fexpand_file_name (build_string ("lisp"),
4030 Vinstallation_directory
);
4031 tem1
= Ffile_exists_p (tem
);
4034 if (NILP (Fmember (tem
, Vload_path
)))
4036 turn_off_warning
= 1;
4037 Vload_path
= Fcons (tem
, Vload_path
);
4041 /* That dir doesn't exist, so add the build-time
4042 Lisp dirs instead. */
4043 Vload_path
= nconc2 (Vload_path
, dump_path
);
4045 /* Add leim under the installation dir, if it exists. */
4046 tem
= Fexpand_file_name (build_string ("leim"),
4047 Vinstallation_directory
);
4048 tem1
= Ffile_exists_p (tem
);
4051 if (NILP (Fmember (tem
, Vload_path
)))
4052 Vload_path
= Fcons (tem
, Vload_path
);
4055 /* Add site-lisp under the installation dir, if it exists. */
4056 tem
= Fexpand_file_name (build_string ("site-lisp"),
4057 Vinstallation_directory
);
4058 tem1
= Ffile_exists_p (tem
);
4061 if (NILP (Fmember (tem
, Vload_path
)))
4062 Vload_path
= Fcons (tem
, Vload_path
);
4065 /* If Emacs was not built in the source directory,
4066 and it is run from where it was built, add to load-path
4067 the lisp, leim and site-lisp dirs under that directory. */
4069 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4073 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4074 Vinstallation_directory
);
4075 tem1
= Ffile_exists_p (tem
);
4077 /* Don't be fooled if they moved the entire source tree
4078 AFTER dumping Emacs. If the build directory is indeed
4079 different from the source dir, src/Makefile.in and
4080 src/Makefile will not be found together. */
4081 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4082 Vinstallation_directory
);
4083 tem2
= Ffile_exists_p (tem
);
4084 if (!NILP (tem1
) && NILP (tem2
))
4086 tem
= Fexpand_file_name (build_string ("lisp"),
4089 if (NILP (Fmember (tem
, Vload_path
)))
4090 Vload_path
= Fcons (tem
, Vload_path
);
4092 tem
= Fexpand_file_name (build_string ("leim"),
4095 if (NILP (Fmember (tem
, Vload_path
)))
4096 Vload_path
= Fcons (tem
, Vload_path
);
4098 tem
= Fexpand_file_name (build_string ("site-lisp"),
4101 if (NILP (Fmember (tem
, Vload_path
)))
4102 Vload_path
= Fcons (tem
, Vload_path
);
4105 if (!NILP (sitelisp
))
4106 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4112 /* NORMAL refers to the lisp dir in the source directory. */
4113 /* We used to add ../lisp at the front here, but
4114 that caused trouble because it was copied from dump_path
4115 into Vload_path, above, when Vinstallation_directory was non-nil.
4116 It should be unnecessary. */
4117 Vload_path
= decode_env_path (0, normal
);
4118 dump_path
= Vload_path
;
4122 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4123 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4124 almost never correct, thereby causing a warning to be printed out that
4125 confuses users. Since PATH_LOADSEARCH is always overridden by the
4126 EMACSLOADPATH environment variable below, disable the warning on NT. */
4128 /* Warn if dirs in the *standard* path don't exist. */
4129 if (!turn_off_warning
)
4131 Lisp_Object path_tail
;
4133 for (path_tail
= Vload_path
;
4135 path_tail
= XCDR (path_tail
))
4137 Lisp_Object dirfile
;
4138 dirfile
= Fcar (path_tail
);
4139 if (STRINGP (dirfile
))
4141 dirfile
= Fdirectory_file_name (dirfile
);
4142 if (access (SDATA (dirfile
), 0) < 0)
4143 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4148 #endif /* !(WINDOWSNT || HAVE_NS) */
4150 /* If the EMACSLOADPATH environment variable is set, use its value.
4151 This doesn't apply if we're dumping. */
4153 if (NILP (Vpurify_flag
)
4154 && egetenv ("EMACSLOADPATH"))
4156 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4160 load_in_progress
= 0;
4161 Vload_file_name
= Qnil
;
4163 load_descriptor_list
= Qnil
;
4165 Vstandard_input
= Qt
;
4166 Vloads_in_progress
= Qnil
;
4169 /* Print a warning, using format string FORMAT, that directory DIRNAME
4170 does not exist. Print it on stderr and put it in *Messages*. */
4173 dir_warning (char *format
, Lisp_Object dirname
)
4176 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4178 fprintf (stderr
, format
, SDATA (dirname
));
4179 sprintf (buffer
, format
, SDATA (dirname
));
4180 /* Don't log the warning before we've initialized!! */
4182 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4186 syms_of_lread (void)
4189 defsubr (&Sread_from_string
);
4191 defsubr (&Sintern_soft
);
4192 defsubr (&Sunintern
);
4193 defsubr (&Sget_load_suffixes
);
4195 defsubr (&Seval_buffer
);
4196 defsubr (&Seval_region
);
4197 defsubr (&Sread_char
);
4198 defsubr (&Sread_char_exclusive
);
4199 defsubr (&Sread_event
);
4200 defsubr (&Sget_file_char
);
4201 defsubr (&Smapatoms
);
4202 defsubr (&Slocate_file_internal
);
4204 DEFVAR_LISP ("obarray", &Vobarray
,
4205 doc
: /* Symbol table for use by `intern' and `read'.
4206 It is a vector whose length ought to be prime for best results.
4207 The vector's contents don't make sense if examined from Lisp programs;
4208 to find all the symbols in an obarray, use `mapatoms'. */);
4210 DEFVAR_LISP ("values", &Vvalues
,
4211 doc
: /* List of values of all expressions which were read, evaluated and printed.
4212 Order is reverse chronological. */);
4214 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4215 doc
: /* Stream for read to get input from.
4216 See documentation of `read' for possible values. */);
4217 Vstandard_input
= Qt
;
4219 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4220 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4222 If this variable is a buffer, then only forms read from that buffer
4223 will be added to `read-symbol-positions-list'.
4224 If this variable is t, then all read forms will be added.
4225 The effect of all other values other than nil are not currently
4226 defined, although they may be in the future.
4228 The positions are relative to the last call to `read' or
4229 `read-from-string'. It is probably a bad idea to set this variable at
4230 the toplevel; bind it instead. */);
4231 Vread_with_symbol_positions
= Qnil
;
4233 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4234 doc
: /* A list mapping read symbols to their positions.
4235 This variable is modified during calls to `read' or
4236 `read-from-string', but only when `read-with-symbol-positions' is
4239 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4240 CHAR-POSITION is an integer giving the offset of that occurrence of the
4241 symbol from the position where `read' or `read-from-string' started.
4243 Note that a symbol will appear multiple times in this list, if it was
4244 read multiple times. The list is in the same order as the symbols
4246 Vread_symbol_positions_list
= Qnil
;
4248 DEFVAR_LISP ("read-circle", &Vread_circle
,
4249 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4252 DEFVAR_LISP ("load-path", &Vload_path
,
4253 doc
: /* *List of directories to search for files to load.
4254 Each element is a string (directory name) or nil (try default directory).
4255 Initialized based on EMACSLOADPATH environment variable, if any,
4256 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4258 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4259 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4260 This list should not include the empty string.
4261 `load' and related functions try to append these suffixes, in order,
4262 to the specified file name if a Lisp suffix is allowed or required. */);
4263 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4264 Fcons (make_pure_c_string (".el"), Qnil
));
4265 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4266 doc
: /* List of suffixes that indicate representations of \
4268 This list should normally start with the empty string.
4270 Enabling Auto Compression mode appends the suffixes in
4271 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4272 mode removes them again. `load' and related functions use this list to
4273 determine whether they should look for compressed versions of a file
4274 and, if so, which suffixes they should try to append to the file name
4275 in order to do so. However, if you want to customize which suffixes
4276 the loading functions recognize as compression suffixes, you should
4277 customize `jka-compr-load-suffixes' rather than the present variable. */);
4278 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4280 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4281 doc
: /* Non-nil if inside of `load'. */);
4282 Qload_in_progress
= intern_c_string ("load-in-progress");
4283 staticpro (&Qload_in_progress
);
4285 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4286 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4287 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4289 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4290 a symbol \(a feature name).
4292 When `load' is run and the file-name argument matches an element's
4293 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4294 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4296 An error in FORMS does not undo the load, but does prevent execution of
4297 the rest of the FORMS. */);
4298 Vafter_load_alist
= Qnil
;
4300 DEFVAR_LISP ("load-history", &Vload_history
,
4301 doc
: /* Alist mapping loaded file names to symbols and features.
4302 Each alist element should be a list (FILE-NAME ENTRIES...), where
4303 FILE-NAME is the name of a file that has been loaded into Emacs.
4304 The file name is absolute and true (i.e. it doesn't contain symlinks).
4305 As an exception, one of the alist elements may have FILE-NAME nil,
4306 for symbols and features not associated with any file.
4308 The remaining ENTRIES in the alist element describe the functions and
4309 variables defined in that file, the features provided, and the
4310 features required. Each entry has the form `(provide . FEATURE)',
4311 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4312 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4313 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4314 SYMBOL was an autoload before this file redefined it as a function.
4316 During preloading, the file name recorded is relative to the main Lisp
4317 directory. These file names are converted to absolute at startup. */);
4318 Vload_history
= Qnil
;
4320 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4321 doc
: /* Full name of file being loaded by `load'. */);
4322 Vload_file_name
= Qnil
;
4324 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4325 doc
: /* File name, including directory, of user's initialization file.
4326 If the file loaded had extension `.elc', and the corresponding source file
4327 exists, this variable contains the name of source file, suitable for use
4328 by functions like `custom-save-all' which edit the init file.
4329 While Emacs loads and evaluates the init file, value is the real name
4330 of the file, regardless of whether or not it has the `.elc' extension. */);
4331 Vuser_init_file
= Qnil
;
4333 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4334 doc
: /* Used for internal purposes by `load'. */);
4335 Vcurrent_load_list
= Qnil
;
4337 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4338 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4339 The default is nil, which means use the function `read'. */);
4340 Vload_read_function
= Qnil
;
4342 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4343 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4344 This function is for doing code conversion before reading the source file.
4345 If nil, loading is done without any code conversion.
4346 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4347 FULLNAME is the full name of FILE.
4348 See `load' for the meaning of the remaining arguments. */);
4349 Vload_source_file_function
= Qnil
;
4351 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4352 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4353 This is useful when the file being loaded is a temporary copy. */);
4354 load_force_doc_strings
= 0;
4356 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4357 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4358 This is normally bound by `load' and `eval-buffer' to control `read',
4359 and is not meant for users to change. */);
4360 load_convert_to_unibyte
= 0;
4362 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4363 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4364 You cannot count on them to still be there! */);
4366 = Fexpand_file_name (build_string ("../"),
4367 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4369 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4370 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4371 Vpreloaded_file_list
= Qnil
;
4373 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4374 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4375 Vbyte_boolean_vars
= Qnil
;
4377 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4378 doc
: /* Non-nil means load dangerous compiled Lisp files.
4379 Some versions of XEmacs use different byte codes than Emacs. These
4380 incompatible byte codes can make Emacs crash when it tries to execute
4382 load_dangerous_libraries
= 0;
4384 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4385 doc
: /* Non-nil means force printing messages when loading Lisp files.
4386 This overrides the value of the NOMESSAGE argument to `load'. */);
4387 force_load_messages
= 0;
4389 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4390 doc
: /* Regular expression matching safe to load compiled Lisp files.
4391 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4392 from the file, and matches them against this regular expression.
4393 When the regular expression matches, the file is considered to be safe
4394 to load. See also `load-dangerous-libraries'. */);
4395 Vbytecomp_version_regexp
4396 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4398 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4399 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4400 Veval_buffer_list
= Qnil
;
4402 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4403 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4404 Vold_style_backquotes
= Qnil
;
4405 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4406 staticpro (&Qold_style_backquotes
);
4408 /* Vsource_directory was initialized in init_lread. */
4410 load_descriptor_list
= Qnil
;
4411 staticpro (&load_descriptor_list
);
4413 Qcurrent_load_list
= intern_c_string ("current-load-list");
4414 staticpro (&Qcurrent_load_list
);
4416 Qstandard_input
= intern_c_string ("standard-input");
4417 staticpro (&Qstandard_input
);
4419 Qread_char
= intern_c_string ("read-char");
4420 staticpro (&Qread_char
);
4422 Qget_file_char
= intern_c_string ("get-file-char");
4423 staticpro (&Qget_file_char
);
4425 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4426 staticpro (&Qget_emacs_mule_file_char
);
4428 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4429 staticpro (&Qload_force_doc_strings
);
4431 Qbackquote
= intern_c_string ("`");
4432 staticpro (&Qbackquote
);
4433 Qcomma
= intern_c_string (",");
4434 staticpro (&Qcomma
);
4435 Qcomma_at
= intern_c_string (",@");
4436 staticpro (&Qcomma_at
);
4437 Qcomma_dot
= intern_c_string (",.");
4438 staticpro (&Qcomma_dot
);
4440 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4441 staticpro (&Qinhibit_file_name_operation
);
4443 Qascii_character
= intern_c_string ("ascii-character");
4444 staticpro (&Qascii_character
);
4446 Qfunction
= intern_c_string ("function");
4447 staticpro (&Qfunction
);
4449 Qload
= intern_c_string ("load");
4452 Qload_file_name
= intern_c_string ("load-file-name");
4453 staticpro (&Qload_file_name
);
4455 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4456 staticpro (&Qeval_buffer_list
);
4458 Qfile_truename
= intern_c_string ("file-truename");
4459 staticpro (&Qfile_truename
) ;
4461 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4462 staticpro (&Qdo_after_load_evaluation
) ;
4464 staticpro (&dump_path
);
4466 staticpro (&read_objects
);
4467 read_objects
= Qnil
;
4468 staticpro (&seen_list
);
4471 Vloads_in_progress
= Qnil
;
4472 staticpro (&Vloads_in_progress
);
4474 Qhash_table
= intern_c_string ("hash-table");
4475 staticpro (&Qhash_table
);
4476 Qdata
= intern_c_string ("data");
4478 Qtest
= intern_c_string ("test");
4480 Qsize
= intern_c_string ("size");
4482 Qweakness
= intern_c_string ("weakness");
4483 staticpro (&Qweakness
);
4484 Qrehash_size
= intern_c_string ("rehash-size");
4485 staticpro (&Qrehash_size
);
4486 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4487 staticpro (&Qrehash_threshold
);
4490 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4491 (do not change this comment) */