1 /* Lisp parsing and input streams.
3 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997,
4 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 2009, 2010 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include <sys/types.h>
31 #include "intervals.h"
33 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
56 #endif /* HAVE_SETLOCALE */
61 #define file_offset off_t
62 #define file_tell ftello
64 #define file_offset long
65 #define file_tell ftell
68 /* hash table read constants */
69 Lisp_Object Qhash_table
, Qdata
;
70 Lisp_Object Qtest
, Qsize
;
71 Lisp_Object Qweakness
;
72 Lisp_Object Qrehash_size
;
73 Lisp_Object Qrehash_threshold
;
75 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
76 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
77 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
78 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
79 Lisp_Object Qinhibit_file_name_operation
;
80 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
81 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
83 /* Used instead of Qget_file_char while loading *.elc files compiled
84 by Emacs 21 or older. */
85 static Lisp_Object Qget_emacs_mule_file_char
;
87 static Lisp_Object Qload_force_doc_strings
;
89 /* non-zero if inside `load' */
91 static Lisp_Object Qload_in_progress
;
93 /* Directory in which the sources were found. */
94 Lisp_Object Vsource_directory
;
96 /* Search path and suffixes for files to be loaded. */
97 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
99 /* File name of user's init file. */
100 Lisp_Object Vuser_init_file
;
102 /* This is the user-visible association list that maps features to
103 lists of defs in their load files. */
104 Lisp_Object Vload_history
;
106 /* This is used to build the load history. */
107 Lisp_Object Vcurrent_load_list
;
109 /* List of files that were preloaded. */
110 Lisp_Object Vpreloaded_file_list
;
112 /* Name of file actually being read by `load'. */
113 Lisp_Object Vload_file_name
;
115 /* Function to use for reading, in `load' and friends. */
116 Lisp_Object Vload_read_function
;
118 /* Non-nil means read recursive structures using #n= and #n# syntax. */
119 Lisp_Object Vread_circle
;
121 /* The association list of objects read with the #n=object form.
122 Each member of the list has the form (n . object), and is used to
123 look up the object for the corresponding #n# construct.
124 It must be set to nil before all top-level calls to read0. */
125 Lisp_Object read_objects
;
127 /* Nonzero means load should forcibly load all dynamic doc strings. */
128 static int load_force_doc_strings
;
130 /* Nonzero means read should convert strings to unibyte. */
131 static int load_convert_to_unibyte
;
133 /* Nonzero means READCHAR should read bytes one by one (not character)
134 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
135 This is set to 1 by read1 temporarily while handling #@NUMBER. */
136 static int load_each_byte
;
138 /* Function to use for loading an Emacs Lisp source file (not
139 compiled) instead of readevalloop. */
140 Lisp_Object Vload_source_file_function
;
142 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
143 Lisp_Object Vbyte_boolean_vars
;
145 /* Whether or not to add a `read-positions' property to symbols
147 Lisp_Object Vread_with_symbol_positions
;
149 /* List of (SYMBOL . POSITION) accumulated so far. */
150 Lisp_Object Vread_symbol_positions_list
;
152 /* List of descriptors now open for Fload. */
153 static Lisp_Object load_descriptor_list
;
155 /* File for get_file_char to read from. Use by load. */
156 static FILE *instream
;
158 /* When nonzero, read conses in pure space */
159 static int read_pure
;
161 /* For use within read-from-string (this reader is non-reentrant!!) */
162 static EMACS_INT read_from_string_index
;
163 static EMACS_INT read_from_string_index_byte
;
164 static EMACS_INT read_from_string_limit
;
166 /* Number of characters read in the current call to Fread or
167 Fread_from_string. */
168 static EMACS_INT readchar_count
;
170 /* This contains the last string skipped with #@. */
171 static char *saved_doc_string
;
172 /* Length of buffer allocated in saved_doc_string. */
173 static int saved_doc_string_size
;
174 /* Length of actual data in saved_doc_string. */
175 static int saved_doc_string_length
;
176 /* This is the file position that string came from. */
177 static file_offset saved_doc_string_position
;
179 /* This contains the previous string skipped with #@.
180 We copy it from saved_doc_string when a new string
181 is put in saved_doc_string. */
182 static char *prev_saved_doc_string
;
183 /* Length of buffer allocated in prev_saved_doc_string. */
184 static int prev_saved_doc_string_size
;
185 /* Length of actual data in prev_saved_doc_string. */
186 static int prev_saved_doc_string_length
;
187 /* This is the file position that string came from. */
188 static file_offset prev_saved_doc_string_position
;
190 /* Nonzero means inside a new-style backquote
191 with no surrounding parentheses.
192 Fread initializes this to zero, so we need not specbind it
193 or worry about what happens to it when there is an error. */
194 static int new_backquote_flag
;
195 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
197 /* A list of file names for files being loaded in Fload. Used to
198 check for recursive loads. */
200 static Lisp_Object Vloads_in_progress
;
202 /* Non-zero means load dangerous compiled Lisp files. */
204 int load_dangerous_libraries
;
206 /* Non-zero means force printing messages when loading Lisp files. */
208 int force_load_messages
;
210 /* A regular expression used to detect files compiled with Emacs. */
212 static Lisp_Object Vbytecomp_version_regexp
;
214 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
217 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
,
218 Lisp_Object (*) (Lisp_Object
), int,
219 Lisp_Object
, Lisp_Object
,
220 Lisp_Object
, Lisp_Object
);
221 static Lisp_Object
load_unwind (Lisp_Object
);
222 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
224 static void invalid_syntax (const char *, int) NO_RETURN
;
225 static void end_of_file_error (void) NO_RETURN
;
228 /* Functions that read one byte from the current source READCHARFUN
229 or unreads one byte. If the integer argument C is -1, it returns
230 one read byte, or -1 when there's no more byte in the source. If C
231 is 0 or positive, it unreads C, and the return value is not
234 static int readbyte_for_lambda (int, Lisp_Object
);
235 static int readbyte_from_file (int, Lisp_Object
);
236 static int readbyte_from_string (int, Lisp_Object
);
238 /* Handle unreading and rereading of characters.
239 Write READCHAR to read a character,
240 UNREAD(c) to unread c to be read again.
242 These macros correctly read/unread multibyte characters. */
244 #define READCHAR readchar (readcharfun, NULL)
245 #define UNREAD(c) unreadchar (readcharfun, c)
247 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
248 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
250 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
251 Qlambda, or a cons, we use this to keep an unread character because
252 a file stream can't handle multibyte-char unreading. The value -1
253 means that there's no unread character. */
254 static int unread_char
;
257 readchar (Lisp_Object readcharfun
, int *multibyte
)
261 int (*readbyte
) (int, Lisp_Object
);
262 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
264 int emacs_mule_encoding
= 0;
271 if (BUFFERP (readcharfun
))
273 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
275 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
277 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
280 if (! NILP (inbuffer
->enable_multibyte_characters
))
282 /* Fetch the character code from the buffer. */
283 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
284 BUF_INC_POS (inbuffer
, pt_byte
);
291 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
292 if (! ASCII_BYTE_P (c
))
293 c
= BYTE8_TO_CHAR (c
);
296 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
300 if (MARKERP (readcharfun
))
302 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
304 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
306 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
309 if (! NILP (inbuffer
->enable_multibyte_characters
))
311 /* Fetch the character code from the buffer. */
312 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
313 BUF_INC_POS (inbuffer
, bytepos
);
320 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
321 if (! ASCII_BYTE_P (c
))
322 c
= BYTE8_TO_CHAR (c
);
326 XMARKER (readcharfun
)->bytepos
= bytepos
;
327 XMARKER (readcharfun
)->charpos
++;
332 if (EQ (readcharfun
, Qlambda
))
334 readbyte
= readbyte_for_lambda
;
338 if (EQ (readcharfun
, Qget_file_char
))
340 readbyte
= readbyte_from_file
;
344 if (STRINGP (readcharfun
))
346 if (read_from_string_index
>= read_from_string_limit
)
348 else if (STRING_MULTIBYTE (readcharfun
))
352 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
353 read_from_string_index
,
354 read_from_string_index_byte
);
358 c
= SREF (readcharfun
, read_from_string_index_byte
);
359 read_from_string_index
++;
360 read_from_string_index_byte
++;
365 if (CONSP (readcharfun
))
367 /* This is the case that read_vector is reading from a unibyte
368 string that contains a byte sequence previously skipped
369 because of #@NUMBER. The car part of readcharfun is that
370 string, and the cdr part is a value of readcharfun given to
372 readbyte
= readbyte_from_string
;
373 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
374 emacs_mule_encoding
= 1;
378 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
380 readbyte
= readbyte_from_file
;
381 emacs_mule_encoding
= 1;
385 tem
= call0 (readcharfun
);
392 if (unread_char
>= 0)
398 c
= (*readbyte
) (-1, readcharfun
);
399 if (c
< 0 || load_each_byte
)
403 if (ASCII_BYTE_P (c
))
405 if (emacs_mule_encoding
)
406 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
409 len
= BYTES_BY_CHAR_HEAD (c
);
412 c
= (*readbyte
) (-1, readcharfun
);
413 if (c
< 0 || ! TRAILING_CODE_P (c
))
416 (*readbyte
) (buf
[i
], readcharfun
);
417 return BYTE8_TO_CHAR (buf
[0]);
421 return STRING_CHAR (buf
);
424 /* Unread the character C in the way appropriate for the stream READCHARFUN.
425 If the stream is a user function, call it with the char as argument. */
428 unreadchar (Lisp_Object readcharfun
, int c
)
432 /* Don't back up the pointer if we're unreading the end-of-input mark,
433 since readchar didn't advance it when we read it. */
435 else if (BUFFERP (readcharfun
))
437 struct buffer
*b
= XBUFFER (readcharfun
);
438 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
441 if (! NILP (b
->enable_multibyte_characters
))
442 BUF_DEC_POS (b
, bytepos
);
446 BUF_PT_BYTE (b
) = bytepos
;
448 else if (MARKERP (readcharfun
))
450 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
451 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
453 XMARKER (readcharfun
)->charpos
--;
454 if (! NILP (b
->enable_multibyte_characters
))
455 BUF_DEC_POS (b
, bytepos
);
459 XMARKER (readcharfun
)->bytepos
= bytepos
;
461 else if (STRINGP (readcharfun
))
463 read_from_string_index
--;
464 read_from_string_index_byte
465 = string_char_to_byte (readcharfun
, read_from_string_index
);
467 else if (CONSP (readcharfun
))
471 else if (EQ (readcharfun
, Qlambda
))
475 else if (EQ (readcharfun
, Qget_file_char
)
476 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
481 ungetc (c
, instream
);
488 call1 (readcharfun
, make_number (c
));
492 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
494 return read_bytecode_char (c
>= 0);
499 readbyte_from_file (int c
, Lisp_Object readcharfun
)
504 ungetc (c
, instream
);
513 /* Interrupted reads have been observed while reading over the network */
514 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
526 return (c
== EOF
? -1 : c
);
530 readbyte_from_string (int c
, Lisp_Object readcharfun
)
532 Lisp_Object string
= XCAR (readcharfun
);
536 read_from_string_index
--;
537 read_from_string_index_byte
538 = string_char_to_byte (string
, read_from_string_index
);
541 if (read_from_string_index
>= read_from_string_limit
)
544 FETCH_STRING_CHAR_ADVANCE (c
, string
,
545 read_from_string_index
,
546 read_from_string_index_byte
);
551 /* Read one non-ASCII character from INSTREAM. The character is
552 encoded in `emacs-mule' and the first byte is already read in
555 extern char emacs_mule_bytes
[256];
558 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
560 /* Emacs-mule coding uses at most 4-byte for one character. */
561 unsigned char buf
[4];
562 int len
= emacs_mule_bytes
[c
];
563 struct charset
*charset
;
568 /* C is not a valid leading-code of `emacs-mule'. */
569 return BYTE8_TO_CHAR (c
);
575 c
= (*readbyte
) (-1, readcharfun
);
579 (*readbyte
) (buf
[i
], readcharfun
);
580 return BYTE8_TO_CHAR (buf
[0]);
587 charset
= emacs_mule_charset
[buf
[0]];
588 code
= buf
[1] & 0x7F;
592 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
593 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
595 charset
= emacs_mule_charset
[buf
[1]];
596 code
= buf
[2] & 0x7F;
600 charset
= emacs_mule_charset
[buf
[0]];
601 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
606 charset
= emacs_mule_charset
[buf
[1]];
607 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
609 c
= DECODE_CHAR (charset
, code
);
611 Fsignal (Qinvalid_read_syntax
,
612 Fcons (build_string ("invalid multibyte form"), Qnil
));
617 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
619 static Lisp_Object
read0 (Lisp_Object
);
620 static Lisp_Object
read1 (Lisp_Object
, int *, int);
622 static Lisp_Object
read_list (int, Lisp_Object
);
623 static Lisp_Object
read_vector (Lisp_Object
, int);
625 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
627 static void substitute_object_in_subtree (Lisp_Object
,
629 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
632 /* Get a character from the tty. */
634 /* Read input events until we get one that's acceptable for our purposes.
636 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
637 until we get a character we like, and then stuffed into
640 If ASCII_REQUIRED is non-zero, we check function key events to see
641 if the unmodified version of the symbol has a Qascii_character
642 property, and use that character, if present.
644 If ERROR_NONASCII is non-zero, we signal an error if the input we
645 get isn't an ASCII character with modifiers. If it's zero but
646 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
649 If INPUT_METHOD is nonzero, we invoke the current input method
650 if the character warrants that.
652 If SECONDS is a number, we wait that many seconds for input, and
653 return Qnil if no input arrives within that time. */
656 read_filtered_event (int no_switch_frame
, int ascii_required
,
657 int error_nonascii
, int input_method
, Lisp_Object seconds
)
659 Lisp_Object val
, delayed_switch_frame
;
662 #ifdef HAVE_WINDOW_SYSTEM
663 if (display_hourglass_p
)
667 delayed_switch_frame
= Qnil
;
669 /* Compute timeout. */
670 if (NUMBERP (seconds
))
672 EMACS_TIME wait_time
;
674 double duration
= extract_float (seconds
);
676 sec
= (int) duration
;
677 usec
= (duration
- sec
) * 1000000;
678 EMACS_GET_TIME (end_time
);
679 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
680 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
683 /* Read until we get an acceptable event. */
686 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
687 NUMBERP (seconds
) ? &end_time
: NULL
);
688 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
693 /* switch-frame events are put off until after the next ASCII
694 character. This is better than signaling an error just because
695 the last characters were typed to a separate minibuffer frame,
696 for example. Eventually, some code which can deal with
697 switch-frame events will read it and process it. */
699 && EVENT_HAS_PARAMETERS (val
)
700 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
702 delayed_switch_frame
= val
;
706 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
708 /* Convert certain symbols to their ASCII equivalents. */
711 Lisp_Object tem
, tem1
;
712 tem
= Fget (val
, Qevent_symbol_element_mask
);
715 tem1
= Fget (Fcar (tem
), Qascii_character
);
716 /* Merge this symbol's modifier bits
717 with the ASCII equivalent of its basic code. */
719 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
723 /* If we don't have a character now, deal with it appropriately. */
728 Vunread_command_events
= Fcons (val
, Qnil
);
729 error ("Non-character input-event");
736 if (! NILP (delayed_switch_frame
))
737 unread_switch_frame
= delayed_switch_frame
;
741 #ifdef HAVE_WINDOW_SYSTEM
742 if (display_hourglass_p
)
751 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
752 doc
: /* Read a character from the command input (keyboard or macro).
753 It is returned as a number.
754 If the character has modifiers, they are resolved and reflected to the
755 character code if possible (e.g. C-SPC -> 0).
757 If the user generates an event which is not a character (i.e. a mouse
758 click or function key event), `read-char' signals an error. As an
759 exception, switch-frame events are put off until non-character events
761 If you want to read non-character events, or ignore them, call
762 `read-event' or `read-char-exclusive' instead.
764 If the optional argument PROMPT is non-nil, display that as a prompt.
765 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
766 input method is turned on in the current buffer, that input method
767 is used for reading a character.
768 If the optional argument SECONDS is non-nil, it should be a number
769 specifying the maximum number of seconds to wait for input. If no
770 input arrives in that time, return nil. SECONDS may be a
771 floating-point value. */)
772 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
777 message_with_string ("%s", prompt
, 0);
778 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
780 return (NILP (val
) ? Qnil
781 : make_number (char_resolve_modifier_mask (XINT (val
))));
784 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
785 doc
: /* Read an event object from the input stream.
786 If the optional argument PROMPT is non-nil, display that as a prompt.
787 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
788 input method is turned on in the current buffer, that input method
789 is used for reading a character.
790 If the optional argument SECONDS is non-nil, it should be a number
791 specifying the maximum number of seconds to wait for input. If no
792 input arrives in that time, return nil. SECONDS may be a
793 floating-point value. */)
794 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
797 message_with_string ("%s", prompt
, 0);
798 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
801 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
802 doc
: /* Read a character from the command input (keyboard or macro).
803 It is returned as a number. Non-character events are ignored.
804 If the character has modifiers, they are resolved and reflected to the
805 character code if possible (e.g. C-SPC -> 0).
807 If the optional argument PROMPT is non-nil, display that as a prompt.
808 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
809 input method is turned on in the current buffer, that input method
810 is used for reading a character.
811 If the optional argument SECONDS is non-nil, it should be a number
812 specifying the maximum number of seconds to wait for input. If no
813 input arrives in that time, return nil. SECONDS may be a
814 floating-point value. */)
815 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
820 message_with_string ("%s", prompt
, 0);
822 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
824 return (NILP (val
) ? Qnil
825 : make_number (char_resolve_modifier_mask (XINT (val
))));
828 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
829 doc
: /* Don't use this yourself. */)
832 register Lisp_Object val
;
834 XSETINT (val
, getc (instream
));
841 /* Value is a version number of byte compiled code if the file
842 associated with file descriptor FD is a compiled Lisp file that's
843 safe to load. Only files compiled with Emacs are safe to load.
844 Files compiled with XEmacs can lead to a crash in Fbyte_code
845 because of an incompatible change in the byte compiler. */
848 safe_to_load_p (int fd
)
855 /* Read the first few bytes from the file, and look for a line
856 specifying the byte compiler version used. */
857 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
862 /* Skip to the next newline, skipping over the initial `ELC'
863 with NUL bytes following it, but note the version. */
864 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
869 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
876 lseek (fd
, 0, SEEK_SET
);
881 /* Callback for record_unwind_protect. Restore the old load list OLD,
882 after loading a file successfully. */
885 record_load_unwind (Lisp_Object old
)
887 return Vloads_in_progress
= old
;
890 /* This handler function is used via internal_condition_case_1. */
893 load_error_handler (Lisp_Object data
)
899 load_warn_old_style_backquotes (Lisp_Object file
)
901 if (!NILP (Vold_style_backquotes
))
904 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
911 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
912 doc
: /* Return the suffixes that `load' should try if a suffix is \
914 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
917 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
918 while (CONSP (suffixes
))
920 Lisp_Object exts
= Vload_file_rep_suffixes
;
921 suffix
= XCAR (suffixes
);
922 suffixes
= XCDR (suffixes
);
927 lst
= Fcons (concat2 (suffix
, ext
), lst
);
930 return Fnreverse (lst
);
933 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
934 doc
: /* Execute a file of Lisp code named FILE.
935 First try FILE with `.elc' appended, then try with `.el',
936 then try FILE unmodified (the exact suffixes in the exact order are
937 determined by `load-suffixes'). Environment variable references in
938 FILE are replaced with their values by calling `substitute-in-file-name'.
939 This function searches the directories in `load-path'.
941 If optional second arg NOERROR is non-nil,
942 report no error if FILE doesn't exist.
943 Print messages at start and end of loading unless
944 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
946 If optional fourth arg NOSUFFIX is non-nil, don't try adding
947 suffixes `.elc' or `.el' to the specified name FILE.
948 If optional fifth arg MUST-SUFFIX is non-nil, insist on
949 the suffix `.elc' or `.el'; don't accept just FILE unless
950 it ends in one of those suffixes or includes a directory name.
952 If this function fails to find a file, it may look for different
953 representations of that file before trying another file.
954 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
955 to the file name. Emacs uses this feature mainly to find compressed
956 versions of files when Auto Compression mode is enabled.
958 The exact suffixes that this function tries out, in the exact order,
959 are given by the value of the variable `load-file-rep-suffixes' if
960 NOSUFFIX is non-nil and by the return value of the function
961 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
962 MUST-SUFFIX are nil, this function first tries out the latter suffixes
965 Loading a file records its definitions, and its `provide' and
966 `require' calls, in an element of `load-history' whose
967 car is the file name loaded. See `load-history'.
969 Return t if the file exists and loads successfully. */)
970 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
972 register FILE *stream
;
973 register int fd
= -1;
974 int count
= SPECPDL_INDEX ();
975 struct gcpro gcpro1
, gcpro2
, gcpro3
;
976 Lisp_Object found
, efound
, hist_file_name
;
977 /* 1 means we printed the ".el is newer" message. */
979 /* 1 means we are loading a compiled file. */
983 const char *fmode
= "r";
993 /* If file name is magic, call the handler. */
994 /* This shouldn't be necessary any more now that `openp' handles it right.
995 handler = Ffind_file_name_handler (file, Qload);
997 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
999 /* Do this after the handler to avoid
1000 the need to gcpro noerror, nomessage and nosuffix.
1001 (Below here, we care only whether they are nil or not.)
1002 The presence of this call is the result of a historical accident:
1003 it used to be in every file-operation and when it got removed
1004 everywhere, it accidentally stayed here. Since then, enough people
1005 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1006 that it seemed risky to remove. */
1007 if (! NILP (noerror
))
1009 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1010 Qt
, load_error_handler
);
1015 file
= Fsubstitute_in_file_name (file
);
1018 /* Avoid weird lossage with null string as arg,
1019 since it would try to load a directory as a Lisp file */
1020 if (SCHARS (file
) > 0)
1022 int size
= SBYTES (file
);
1025 GCPRO2 (file
, found
);
1027 if (! NILP (must_suffix
))
1029 /* Don't insist on adding a suffix if FILE already ends with one. */
1031 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1034 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1036 /* Don't insist on adding a suffix
1037 if the argument includes a directory name. */
1038 else if (! NILP (Ffile_name_directory (file
)))
1042 fd
= openp (Vload_path
, file
,
1043 (!NILP (nosuffix
) ? Qnil
1044 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1045 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1046 tmp
[1] = Vload_file_rep_suffixes
,
1055 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1059 /* Tell startup.el whether or not we found the user's init file. */
1060 if (EQ (Qt
, Vuser_init_file
))
1061 Vuser_init_file
= found
;
1063 /* If FD is -2, that means openp found a magic file. */
1066 if (NILP (Fequal (found
, file
)))
1067 /* If FOUND is a different file name from FILE,
1068 find its handler even if we have already inhibited
1069 the `load' operation on FILE. */
1070 handler
= Ffind_file_name_handler (found
, Qt
);
1072 handler
= Ffind_file_name_handler (found
, Qload
);
1073 if (! NILP (handler
))
1074 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1077 /* Check if we're stuck in a recursive load cycle.
1079 2000-09-21: It's not possible to just check for the file loaded
1080 being a member of Vloads_in_progress. This fails because of the
1081 way the byte compiler currently works; `provide's are not
1082 evaluated, see font-lock.el/jit-lock.el as an example. This
1083 leads to a certain amount of ``normal'' recursion.
1085 Also, just loading a file recursively is not always an error in
1086 the general case; the second load may do something different. */
1090 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1091 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1095 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1097 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1098 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1101 /* Get the name for load-history. */
1102 hist_file_name
= (! NILP (Vpurify_flag
)
1103 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1104 tmp
[1] = Ffile_name_nondirectory (found
),
1110 /* Check for the presence of old-style quotes and warn about them. */
1111 specbind (Qold_style_backquotes
, Qnil
);
1112 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1114 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1115 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1116 /* Load .elc files directly, but not when they are
1117 remote and have no handler! */
1124 GCPRO3 (file
, found
, hist_file_name
);
1127 && ! (version
= safe_to_load_p (fd
)))
1130 if (!load_dangerous_libraries
)
1134 error ("File `%s' was not compiled in Emacs",
1137 else if (!NILP (nomessage
) && !force_load_messages
)
1138 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1143 efound
= ENCODE_FILE (found
);
1148 stat ((char *)SDATA (efound
), &s1
);
1149 SSET (efound
, SBYTES (efound
) - 1, 0);
1150 result
= stat ((char *)SDATA (efound
), &s2
);
1151 SSET (efound
, SBYTES (efound
) - 1, 'c');
1153 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1155 /* Make the progress messages mention that source is newer. */
1158 /* If we won't print another message, mention this anyway. */
1159 if (!NILP (nomessage
) && !force_load_messages
)
1161 Lisp_Object msg_file
;
1162 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1163 message_with_string ("Source file `%s' newer than byte-compiled file",
1172 /* We are loading a source file (*.el). */
1173 if (!NILP (Vload_source_file_function
))
1179 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1180 NILP (noerror
) ? Qnil
: Qt
,
1181 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1182 return unbind_to (count
, val
);
1186 GCPRO3 (file
, found
, hist_file_name
);
1190 efound
= ENCODE_FILE (found
);
1191 stream
= fopen ((char *) SDATA (efound
), fmode
);
1192 #else /* not WINDOWSNT */
1193 stream
= fdopen (fd
, fmode
);
1194 #endif /* not WINDOWSNT */
1198 error ("Failure to create stdio stream for %s", SDATA (file
));
1201 if (! NILP (Vpurify_flag
))
1202 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1204 if (NILP (nomessage
) || force_load_messages
)
1207 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1210 message_with_string ("Loading %s (source)...", file
, 1);
1212 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1214 else /* The typical case; compiled file newer than source file. */
1215 message_with_string ("Loading %s...", file
, 1);
1218 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1219 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1220 specbind (Qload_file_name
, found
);
1221 specbind (Qinhibit_file_name_operation
, Qnil
);
1222 load_descriptor_list
1223 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1224 specbind (Qload_in_progress
, Qt
);
1225 if (! version
|| version
>= 22)
1226 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1227 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1230 /* We can't handle a file which was compiled with
1231 byte-compile-dynamic by older version of Emacs. */
1232 specbind (Qload_force_doc_strings
, Qt
);
1233 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1234 0, Qnil
, Qnil
, Qnil
, Qnil
);
1236 unbind_to (count
, Qnil
);
1238 /* Run any eval-after-load forms for this file */
1239 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1240 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1244 xfree (saved_doc_string
);
1245 saved_doc_string
= 0;
1246 saved_doc_string_size
= 0;
1248 xfree (prev_saved_doc_string
);
1249 prev_saved_doc_string
= 0;
1250 prev_saved_doc_string_size
= 0;
1252 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1255 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1258 message_with_string ("Loading %s (source)...done", file
, 1);
1260 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1262 else /* The typical case; compiled file newer than source file. */
1263 message_with_string ("Loading %s...done", file
, 1);
1270 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1272 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1283 load_descriptor_unwind (Lisp_Object oldlist
)
1285 load_descriptor_list
= oldlist
;
1289 /* Close all descriptors in use for Floads.
1290 This is used when starting a subprocess. */
1293 close_load_descs (void)
1297 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1298 emacs_close (XFASTINT (XCAR (tail
)));
1303 complete_filename_p (Lisp_Object pathname
)
1305 register const unsigned char *s
= SDATA (pathname
);
1306 return (IS_DIRECTORY_SEP (s
[0])
1307 || (SCHARS (pathname
) > 2
1308 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1311 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1312 doc
: /* Search for FILENAME through PATH.
1313 Returns the file's name in absolute form, or nil if not found.
1314 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1315 file name when searching.
1316 If non-nil, PREDICATE is used instead of `file-readable-p'.
1317 PREDICATE can also be an integer to pass to the access(2) function,
1318 in which case file-name-handlers are ignored. */)
1319 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1322 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1323 if (NILP (predicate
) && fd
> 0)
1329 /* Search for a file whose name is STR, looking in directories
1330 in the Lisp list PATH, and trying suffixes from SUFFIX.
1331 On success, returns a file descriptor. On failure, returns -1.
1333 SUFFIXES is a list of strings containing possible suffixes.
1334 The empty suffix is automatically added if the list is empty.
1336 PREDICATE non-nil means don't open the files,
1337 just look for one that satisfies the predicate. In this case,
1338 returns 1 on success. The predicate can be a lisp function or
1339 an integer to pass to `access' (in which case file-name-handlers
1342 If STOREPTR is nonzero, it points to a slot where the name of
1343 the file actually found should be stored as a Lisp string.
1344 nil is stored there on failure.
1346 If the file we find is remote, return -2
1347 but store the found remote file name in *STOREPTR. */
1350 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1355 register char *fn
= buf
;
1358 Lisp_Object filename
;
1360 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1361 Lisp_Object string
, tail
, encoded_fn
;
1362 int max_suffix_len
= 0;
1366 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1368 CHECK_STRING_CAR (tail
);
1369 max_suffix_len
= max (max_suffix_len
,
1370 SBYTES (XCAR (tail
)));
1373 string
= filename
= encoded_fn
= Qnil
;
1374 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1379 if (complete_filename_p (str
))
1382 for (; CONSP (path
); path
= XCDR (path
))
1384 filename
= Fexpand_file_name (str
, XCAR (path
));
1385 if (!complete_filename_p (filename
))
1386 /* If there are non-absolute elts in PATH (eg ".") */
1387 /* Of course, this could conceivably lose if luser sets
1388 default-directory to be something non-absolute... */
1390 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1391 if (!complete_filename_p (filename
))
1392 /* Give up on this path element! */
1396 /* Calculate maximum size of any filename made from
1397 this path element/specified file name and any possible suffix. */
1398 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1399 if (fn_size
< want_size
)
1400 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1402 /* Loop over suffixes. */
1403 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1404 CONSP (tail
); tail
= XCDR (tail
))
1406 int lsuffix
= SBYTES (XCAR (tail
));
1407 Lisp_Object handler
;
1410 /* Concatenate path element/specified name with the suffix.
1411 If the directory starts with /:, remove that. */
1412 if (SCHARS (filename
) > 2
1413 && SREF (filename
, 0) == '/'
1414 && SREF (filename
, 1) == ':')
1416 strncpy (fn
, SDATA (filename
) + 2,
1417 SBYTES (filename
) - 2);
1418 fn
[SBYTES (filename
) - 2] = 0;
1422 strncpy (fn
, SDATA (filename
),
1424 fn
[SBYTES (filename
)] = 0;
1427 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1428 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1430 /* Check that the file exists and is not a directory. */
1431 /* We used to only check for handlers on non-absolute file names:
1435 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1436 It's not clear why that was the case and it breaks things like
1437 (load "/bar.el") where the file is actually "/bar.el.gz". */
1438 string
= build_string (fn
);
1439 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1440 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1442 if (NILP (predicate
))
1443 exists
= !NILP (Ffile_readable_p (string
));
1445 exists
= !NILP (call1 (predicate
, string
));
1446 if (exists
&& !NILP (Ffile_directory_p (string
)))
1451 /* We succeeded; return this descriptor and filename. */
1462 encoded_fn
= ENCODE_FILE (string
);
1463 pfn
= SDATA (encoded_fn
);
1464 exists
= (stat (pfn
, &st
) >= 0
1465 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1468 /* Check that we can access or open it. */
1469 if (NATNUMP (predicate
))
1470 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1472 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1476 /* We succeeded; return this descriptor and filename. */
1494 /* Merge the list we've accumulated of globals from the current input source
1495 into the load_history variable. The details depend on whether
1496 the source has an associated file name or not.
1498 FILENAME is the file name that we are loading from.
1499 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1502 build_load_history (Lisp_Object filename
, int entire
)
1504 register Lisp_Object tail
, prev
, newelt
;
1505 register Lisp_Object tem
, tem2
;
1506 register int foundit
= 0;
1508 tail
= Vload_history
;
1511 while (CONSP (tail
))
1515 /* Find the feature's previous assoc list... */
1516 if (!NILP (Fequal (filename
, Fcar (tem
))))
1520 /* If we're loading the entire file, remove old data. */
1524 Vload_history
= XCDR (tail
);
1526 Fsetcdr (prev
, XCDR (tail
));
1529 /* Otherwise, cons on new symbols that are not already members. */
1532 tem2
= Vcurrent_load_list
;
1534 while (CONSP (tem2
))
1536 newelt
= XCAR (tem2
);
1538 if (NILP (Fmember (newelt
, tem
)))
1539 Fsetcar (tail
, Fcons (XCAR (tem
),
1540 Fcons (newelt
, XCDR (tem
))));
1553 /* If we're loading an entire file, cons the new assoc onto the
1554 front of load-history, the most-recently-loaded position. Also
1555 do this if we didn't find an existing member for the file. */
1556 if (entire
|| !foundit
)
1557 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1562 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1569 readevalloop_1 (Lisp_Object old
)
1571 load_convert_to_unibyte
= ! NILP (old
);
1575 /* Signal an `end-of-file' error, if possible with file name
1579 end_of_file_error (void)
1581 if (STRINGP (Vload_file_name
))
1582 xsignal1 (Qend_of_file
, Vload_file_name
);
1584 xsignal0 (Qend_of_file
);
1587 /* UNIBYTE specifies how to set load_convert_to_unibyte
1588 for this invocation.
1589 READFUN, if non-nil, is used instead of `read'.
1591 START, END specify region to read in current buffer (from eval-region).
1592 If the input is not from a buffer, they must be nil. */
1595 readevalloop (Lisp_Object readcharfun
,
1597 Lisp_Object sourcename
,
1598 Lisp_Object (*evalfun
) (Lisp_Object
),
1600 Lisp_Object unibyte
, Lisp_Object readfun
,
1601 Lisp_Object start
, Lisp_Object end
)
1604 register Lisp_Object val
;
1605 int count
= SPECPDL_INDEX ();
1606 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1607 struct buffer
*b
= 0;
1608 int continue_reading_p
;
1609 /* Nonzero if reading an entire buffer. */
1610 int whole_buffer
= 0;
1611 /* 1 on the first time around. */
1614 if (MARKERP (readcharfun
))
1617 start
= readcharfun
;
1620 if (BUFFERP (readcharfun
))
1621 b
= XBUFFER (readcharfun
);
1622 else if (MARKERP (readcharfun
))
1623 b
= XMARKER (readcharfun
)->buffer
;
1625 /* We assume START is nil when input is not from a buffer. */
1626 if (! NILP (start
) && !b
)
1629 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1630 specbind (Qcurrent_load_list
, Qnil
);
1631 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1632 load_convert_to_unibyte
= !NILP (unibyte
);
1634 GCPRO4 (sourcename
, readfun
, start
, end
);
1636 /* Try to ensure sourcename is a truename, except whilst preloading. */
1637 if (NILP (Vpurify_flag
)
1638 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1639 && !NILP (Ffboundp (Qfile_truename
)))
1640 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1642 LOADHIST_ATTACH (sourcename
);
1644 continue_reading_p
= 1;
1645 while (continue_reading_p
)
1647 int count1
= SPECPDL_INDEX ();
1649 if (b
!= 0 && NILP (b
->name
))
1650 error ("Reading from killed buffer");
1654 /* Switch to the buffer we are reading from. */
1655 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1656 set_buffer_internal (b
);
1658 /* Save point in it. */
1659 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1660 /* Save ZV in it. */
1661 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1662 /* Those get unbound after we read one expression. */
1664 /* Set point and ZV around stuff to be read. */
1667 Fnarrow_to_region (make_number (BEGV
), end
);
1669 /* Just for cleanliness, convert END to a marker
1670 if it is an integer. */
1672 end
= Fpoint_max_marker ();
1675 /* On the first cycle, we can easily test here
1676 whether we are reading the whole buffer. */
1677 if (b
&& first_sexp
)
1678 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1685 while ((c
= READCHAR
) != '\n' && c
!= -1);
1690 unbind_to (count1
, Qnil
);
1694 /* Ignore whitespace here, so we can detect eof. */
1695 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1696 || c
== 0x8a0) /* NBSP */
1699 if (!NILP (Vpurify_flag
) && c
== '(')
1701 record_unwind_protect (unreadpure
, Qnil
);
1702 val
= read_list (-1, readcharfun
);
1707 read_objects
= Qnil
;
1708 if (!NILP (readfun
))
1710 val
= call1 (readfun
, readcharfun
);
1712 /* If READCHARFUN has set point to ZV, we should
1713 stop reading, even if the form read sets point
1714 to a different value when evaluated. */
1715 if (BUFFERP (readcharfun
))
1717 struct buffer
*b
= XBUFFER (readcharfun
);
1718 if (BUF_PT (b
) == BUF_ZV (b
))
1719 continue_reading_p
= 0;
1722 else if (! NILP (Vload_read_function
))
1723 val
= call1 (Vload_read_function
, readcharfun
);
1725 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1728 if (!NILP (start
) && continue_reading_p
)
1729 start
= Fpoint_marker ();
1731 /* Restore saved point and BEGV. */
1732 unbind_to (count1
, Qnil
);
1734 /* Now eval what we just read. */
1735 val
= (*evalfun
) (val
);
1739 Vvalues
= Fcons (val
, Vvalues
);
1740 if (EQ (Vstandard_output
, Qt
))
1749 build_load_history (sourcename
,
1750 stream
|| whole_buffer
);
1754 unbind_to (count
, Qnil
);
1757 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1758 doc
: /* Execute the current buffer as Lisp code.
1759 When called from a Lisp program (i.e., not interactively), this
1760 function accepts up to five optional arguments:
1761 BUFFER is the buffer to evaluate (nil means use current buffer).
1762 PRINTFLAG controls printing of output:
1763 A value of nil means discard it; anything else is stream for print.
1764 FILENAME specifies the file name to use for `load-history'.
1765 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1767 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1768 functions should work normally even if PRINTFLAG is nil.
1770 This function preserves the position of point. */)
1771 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1773 int count
= SPECPDL_INDEX ();
1774 Lisp_Object tem
, buf
;
1777 buf
= Fcurrent_buffer ();
1779 buf
= Fget_buffer (buffer
);
1781 error ("No such buffer");
1783 if (NILP (printflag
) && NILP (do_allow_print
))
1788 if (NILP (filename
))
1789 filename
= XBUFFER (buf
)->filename
;
1791 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1792 specbind (Qstandard_output
, tem
);
1793 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1794 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1795 readevalloop (buf
, 0, filename
, Feval
,
1796 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1797 unbind_to (count
, Qnil
);
1802 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1803 doc
: /* Execute the region as Lisp code.
1804 When called from programs, expects two arguments,
1805 giving starting and ending indices in the current buffer
1806 of the text to be executed.
1807 Programs can pass third argument PRINTFLAG which controls output:
1808 A value of nil means discard it; anything else is stream for printing it.
1809 Also the fourth argument READ-FUNCTION, if non-nil, is used
1810 instead of `read' to read each expression. It gets one argument
1811 which is the input stream for reading characters.
1813 This function does not move point. */)
1814 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1816 int count
= SPECPDL_INDEX ();
1817 Lisp_Object tem
, cbuf
;
1819 cbuf
= Fcurrent_buffer ();
1821 if (NILP (printflag
))
1825 specbind (Qstandard_output
, tem
);
1826 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1828 /* readevalloop calls functions which check the type of start and end. */
1829 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1830 !NILP (printflag
), Qnil
, read_function
,
1833 return unbind_to (count
, Qnil
);
1837 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1838 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1839 If STREAM is nil, use the value of `standard-input' (which see).
1840 STREAM or the value of `standard-input' may be:
1841 a buffer (read from point and advance it)
1842 a marker (read from where it points and advance it)
1843 a function (call it with no arguments for each character,
1844 call it with a char as argument to push a char back)
1845 a string (takes text from string, starting at the beginning)
1846 t (read text line using minibuffer and use it, or read from
1847 standard input in batch mode). */)
1848 (Lisp_Object stream
)
1851 stream
= Vstandard_input
;
1852 if (EQ (stream
, Qt
))
1853 stream
= Qread_char
;
1854 if (EQ (stream
, Qread_char
))
1855 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1857 return read_internal_start (stream
, Qnil
, Qnil
);
1860 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1861 doc
: /* Read one Lisp expression which is represented as text by STRING.
1862 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1863 START and END optionally delimit a substring of STRING from which to read;
1864 they default to 0 and (length STRING) respectively. */)
1865 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1868 CHECK_STRING (string
);
1869 /* read_internal_start sets read_from_string_index. */
1870 ret
= read_internal_start (string
, start
, end
);
1871 return Fcons (ret
, make_number (read_from_string_index
));
1874 /* Function to set up the global context we need in toplevel read
1877 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1878 /* start, end only used when stream is a string. */
1883 new_backquote_flag
= 0;
1884 read_objects
= Qnil
;
1885 if (EQ (Vread_with_symbol_positions
, Qt
)
1886 || EQ (Vread_with_symbol_positions
, stream
))
1887 Vread_symbol_positions_list
= Qnil
;
1889 if (STRINGP (stream
)
1890 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1892 EMACS_INT startval
, endval
;
1895 if (STRINGP (stream
))
1898 string
= XCAR (stream
);
1901 endval
= SCHARS (string
);
1905 endval
= XINT (end
);
1906 if (endval
< 0 || endval
> SCHARS (string
))
1907 args_out_of_range (string
, end
);
1914 CHECK_NUMBER (start
);
1915 startval
= XINT (start
);
1916 if (startval
< 0 || startval
> endval
)
1917 args_out_of_range (string
, start
);
1919 read_from_string_index
= startval
;
1920 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1921 read_from_string_limit
= endval
;
1924 retval
= read0 (stream
);
1925 if (EQ (Vread_with_symbol_positions
, Qt
)
1926 || EQ (Vread_with_symbol_positions
, stream
))
1927 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1932 /* Signal Qinvalid_read_syntax error.
1933 S is error string of length N (if > 0) */
1936 invalid_syntax (const char *s
, int n
)
1940 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1944 /* Use this for recursive reads, in contexts where internal tokens
1948 read0 (Lisp_Object readcharfun
)
1950 register Lisp_Object val
;
1953 val
= read1 (readcharfun
, &c
, 0);
1957 xsignal1 (Qinvalid_read_syntax
,
1958 Fmake_string (make_number (1), make_number (c
)));
1961 static int read_buffer_size
;
1962 static char *read_buffer
;
1964 /* Read a \-escape sequence, assuming we already read the `\'.
1965 If the escape sequence forces unibyte, return eight-bit char. */
1968 read_escape (Lisp_Object readcharfun
, int stringp
)
1970 register int c
= READCHAR
;
1971 /* \u allows up to four hex digits, \U up to eight. Default to the
1972 behavior for \u, and change this value in the case that \U is seen. */
1973 int unicode_hex_count
= 4;
1978 end_of_file_error ();
2008 error ("Invalid escape character syntax");
2011 c
= read_escape (readcharfun
, 0);
2012 return c
| meta_modifier
;
2017 error ("Invalid escape character syntax");
2020 c
= read_escape (readcharfun
, 0);
2021 return c
| shift_modifier
;
2026 error ("Invalid escape character syntax");
2029 c
= read_escape (readcharfun
, 0);
2030 return c
| hyper_modifier
;
2035 error ("Invalid escape character syntax");
2038 c
= read_escape (readcharfun
, 0);
2039 return c
| alt_modifier
;
2043 if (stringp
|| c
!= '-')
2050 c
= read_escape (readcharfun
, 0);
2051 return c
| super_modifier
;
2056 error ("Invalid escape character syntax");
2060 c
= read_escape (readcharfun
, 0);
2061 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2062 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2063 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2064 return c
| ctrl_modifier
;
2065 /* ASCII control chars are made from letters (both cases),
2066 as well as the non-letters within 0100...0137. */
2067 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2068 return (c
& (037 | ~0177));
2069 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2070 return (c
& (037 | ~0177));
2072 return c
| ctrl_modifier
;
2082 /* An octal escape, as in ANSI C. */
2084 register int i
= c
- '0';
2085 register int count
= 0;
2088 if ((c
= READCHAR
) >= '0' && c
<= '7')
2100 if (i
>= 0x80 && i
< 0x100)
2101 i
= BYTE8_TO_CHAR (i
);
2106 /* A hex escape, as in ANSI C. */
2113 if (c
>= '0' && c
<= '9')
2118 else if ((c
>= 'a' && c
<= 'f')
2119 || (c
>= 'A' && c
<= 'F'))
2122 if (c
>= 'a' && c
<= 'f')
2135 if (count
< 3 && i
>= 0x80)
2136 return BYTE8_TO_CHAR (i
);
2141 /* Post-Unicode-2.0: Up to eight hex chars. */
2142 unicode_hex_count
= 8;
2145 /* A Unicode escape. We only permit them in strings and characters,
2146 not arbitrarily in the source code, as in some other languages. */
2151 while (++count
<= unicode_hex_count
)
2154 /* isdigit and isalpha may be locale-specific, which we don't
2156 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2157 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2158 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2161 error ("Non-hex digit used for Unicode escape");
2166 error ("Non-Unicode character: 0x%x", i
);
2175 /* Read an integer in radix RADIX using READCHARFUN to read
2176 characters. RADIX must be in the interval [2..36]; if it isn't, a
2177 read error is signaled . Value is the integer read. Signals an
2178 error if encountering invalid read syntax or if RADIX is out of
2182 read_integer (Lisp_Object readcharfun
, int radix
)
2184 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2185 /* We use a floating point number because */
2188 if (radix
< 2 || radix
> 36)
2192 number
= ndigits
= invalid_p
= 0;
2208 if (c
>= '0' && c
<= '9')
2210 else if (c
>= 'a' && c
<= 'z')
2211 digit
= c
- 'a' + 10;
2212 else if (c
>= 'A' && c
<= 'Z')
2213 digit
= c
- 'A' + 10;
2220 if (digit
< 0 || digit
>= radix
)
2223 number
= radix
* number
+ digit
;
2229 if (ndigits
== 0 || invalid_p
)
2232 sprintf (buf
, "integer, radix %d", radix
);
2233 invalid_syntax (buf
, 0);
2236 return make_fixnum_or_float (sign
* number
);
2240 /* If the next token is ')' or ']' or '.', we store that character
2241 in *PCH and the return value is not interesting. Else, we store
2242 zero in *PCH and we read and return one lisp object.
2244 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2247 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2250 int uninterned_symbol
= 0;
2258 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2260 end_of_file_error ();
2265 return read_list (0, readcharfun
);
2268 return read_vector (readcharfun
, 0);
2284 /* Accept extended format for hashtables (extensible to
2286 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2287 Lisp_Object tmp
= read_list (0, readcharfun
);
2288 Lisp_Object head
= CAR_SAFE (tmp
);
2289 Lisp_Object data
= Qnil
;
2290 Lisp_Object val
= Qnil
;
2291 /* The size is 2 * number of allowed keywords to
2293 Lisp_Object params
[10];
2295 Lisp_Object key
= Qnil
;
2296 int param_count
= 0;
2298 if (!EQ (head
, Qhash_table
))
2299 error ("Invalid extended read marker at head of #s list "
2300 "(only hash-table allowed)");
2302 tmp
= CDR_SAFE (tmp
);
2304 /* This is repetitive but fast and simple. */
2305 params
[param_count
] = QCsize
;
2306 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2307 if (!NILP (params
[param_count
+ 1]))
2310 params
[param_count
] = QCtest
;
2311 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2312 if (!NILP (params
[param_count
+ 1]))
2315 params
[param_count
] = QCweakness
;
2316 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2317 if (!NILP (params
[param_count
+ 1]))
2320 params
[param_count
] = QCrehash_size
;
2321 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2322 if (!NILP (params
[param_count
+ 1]))
2325 params
[param_count
] = QCrehash_threshold
;
2326 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2327 if (!NILP (params
[param_count
+ 1]))
2330 /* This is the hashtable data. */
2331 data
= Fplist_get (tmp
, Qdata
);
2333 /* Now use params to make a new hashtable and fill it. */
2334 ht
= Fmake_hash_table (param_count
, params
);
2336 while (CONSP (data
))
2341 error ("Odd number of elements in hashtable data");
2344 Fputhash (key
, val
, ht
);
2350 invalid_syntax ("#", 1);
2358 tmp
= read_vector (readcharfun
, 0);
2359 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2360 error ("Invalid size char-table");
2361 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2372 tmp
= read_vector (readcharfun
, 0);
2373 if (!INTEGERP (AREF (tmp
, 0)))
2374 error ("Invalid depth in char-table");
2375 depth
= XINT (AREF (tmp
, 0));
2376 if (depth
< 1 || depth
> 3)
2377 error ("Invalid depth in char-table");
2378 size
= XVECTOR (tmp
)->size
- 2;
2379 if (chartab_size
[depth
] != size
)
2380 error ("Invalid size char-table");
2381 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2384 invalid_syntax ("#^^", 3);
2386 invalid_syntax ("#^", 2);
2391 length
= read1 (readcharfun
, pch
, first_in_list
);
2395 Lisp_Object tmp
, val
;
2397 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2398 / BOOL_VECTOR_BITS_PER_CHAR
);
2401 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2402 if (STRING_MULTIBYTE (tmp
)
2403 || (size_in_chars
!= SCHARS (tmp
)
2404 /* We used to print 1 char too many
2405 when the number of bits was a multiple of 8.
2406 Accept such input in case it came from an old
2408 && ! (XFASTINT (length
)
2409 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2410 invalid_syntax ("#&...", 5);
2412 val
= Fmake_bool_vector (length
, Qnil
);
2413 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2414 /* Clear the extraneous bits in the last byte. */
2415 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2416 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2417 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2420 invalid_syntax ("#&...", 5);
2424 /* Accept compiled functions at read-time so that we don't have to
2425 build them using function calls. */
2427 tmp
= read_vector (readcharfun
, 1);
2428 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2429 XVECTOR (tmp
)->contents
);
2434 struct gcpro gcpro1
;
2437 /* Read the string itself. */
2438 tmp
= read1 (readcharfun
, &ch
, 0);
2439 if (ch
!= 0 || !STRINGP (tmp
))
2440 invalid_syntax ("#", 1);
2442 /* Read the intervals and their properties. */
2445 Lisp_Object beg
, end
, plist
;
2447 beg
= read1 (readcharfun
, &ch
, 0);
2452 end
= read1 (readcharfun
, &ch
, 0);
2454 plist
= read1 (readcharfun
, &ch
, 0);
2456 invalid_syntax ("Invalid string property list", 0);
2457 Fset_text_properties (beg
, end
, plist
, tmp
);
2463 /* #@NUMBER is used to skip NUMBER following characters.
2464 That's used in .elc files to skip over doc strings
2465 and function definitions. */
2471 /* Read a decimal integer. */
2472 while ((c
= READCHAR
) >= 0
2473 && c
>= '0' && c
<= '9')
2481 if (load_force_doc_strings
2482 && (EQ (readcharfun
, Qget_file_char
)
2483 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2485 /* If we are supposed to force doc strings into core right now,
2486 record the last string that we skipped,
2487 and record where in the file it comes from. */
2489 /* But first exchange saved_doc_string
2490 with prev_saved_doc_string, so we save two strings. */
2492 char *temp
= saved_doc_string
;
2493 int temp_size
= saved_doc_string_size
;
2494 file_offset temp_pos
= saved_doc_string_position
;
2495 int temp_len
= saved_doc_string_length
;
2497 saved_doc_string
= prev_saved_doc_string
;
2498 saved_doc_string_size
= prev_saved_doc_string_size
;
2499 saved_doc_string_position
= prev_saved_doc_string_position
;
2500 saved_doc_string_length
= prev_saved_doc_string_length
;
2502 prev_saved_doc_string
= temp
;
2503 prev_saved_doc_string_size
= temp_size
;
2504 prev_saved_doc_string_position
= temp_pos
;
2505 prev_saved_doc_string_length
= temp_len
;
2508 if (saved_doc_string_size
== 0)
2510 saved_doc_string_size
= nskip
+ 100;
2511 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2513 if (nskip
> saved_doc_string_size
)
2515 saved_doc_string_size
= nskip
+ 100;
2516 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2517 saved_doc_string_size
);
2520 saved_doc_string_position
= file_tell (instream
);
2522 /* Copy that many characters into saved_doc_string. */
2523 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2524 saved_doc_string
[i
] = c
= READCHAR
;
2526 saved_doc_string_length
= i
;
2530 /* Skip that many characters. */
2531 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2540 /* #! appears at the beginning of an executable file.
2541 Skip the first line. */
2542 while (c
!= '\n' && c
>= 0)
2547 return Vload_file_name
;
2549 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2550 /* #:foo is the uninterned symbol named foo. */
2553 uninterned_symbol
= 1;
2557 /* Reader forms that can reuse previously read objects. */
2558 if (c
>= '0' && c
<= '9')
2563 /* Read a non-negative integer. */
2564 while (c
>= '0' && c
<= '9')
2570 /* #n=object returns object, but associates it with n for #n#. */
2571 if (c
== '=' && !NILP (Vread_circle
))
2573 /* Make a placeholder for #n# to use temporarily */
2574 Lisp_Object placeholder
;
2577 placeholder
= Fcons (Qnil
, Qnil
);
2578 cell
= Fcons (make_number (n
), placeholder
);
2579 read_objects
= Fcons (cell
, read_objects
);
2581 /* Read the object itself. */
2582 tem
= read0 (readcharfun
);
2584 /* Now put it everywhere the placeholder was... */
2585 substitute_object_in_subtree (tem
, placeholder
);
2587 /* ...and #n# will use the real value from now on. */
2588 Fsetcdr (cell
, tem
);
2592 /* #n# returns a previously read object. */
2593 if (c
== '#' && !NILP (Vread_circle
))
2595 tem
= Fassq (make_number (n
), read_objects
);
2598 /* Fall through to error message. */
2600 else if (c
== 'r' || c
== 'R')
2601 return read_integer (readcharfun
, n
);
2603 /* Fall through to error message. */
2605 else if (c
== 'x' || c
== 'X')
2606 return read_integer (readcharfun
, 16);
2607 else if (c
== 'o' || c
== 'O')
2608 return read_integer (readcharfun
, 8);
2609 else if (c
== 'b' || c
== 'B')
2610 return read_integer (readcharfun
, 2);
2613 invalid_syntax ("#", 1);
2616 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2621 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2626 int next_char
= READCHAR
;
2628 /* Transition from old-style to new-style:
2629 If we see "(`" it used to mean old-style, which usually works
2630 fine because ` should almost never appear in such a position
2631 for new-style. But occasionally we need "(`" to mean new
2632 style, so we try to distinguish the two by the fact that we
2633 can either write "( `foo" or "(` foo", where the first
2634 intends to use new-style whereas the second intends to use
2635 old-style. For Emacs-25, we should completely remove this
2636 first_in_list exception (old-style can still be obtained via
2638 if (first_in_list
&& next_char
== ' ')
2640 Vold_style_backquotes
= Qt
;
2647 new_backquote_flag
++;
2648 value
= read0 (readcharfun
);
2649 new_backquote_flag
--;
2651 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2655 if (new_backquote_flag
)
2657 Lisp_Object comma_type
= Qnil
;
2662 comma_type
= Qcomma_at
;
2664 comma_type
= Qcomma_dot
;
2667 if (ch
>= 0) UNREAD (ch
);
2668 comma_type
= Qcomma
;
2671 new_backquote_flag
--;
2672 value
= read0 (readcharfun
);
2673 new_backquote_flag
++;
2674 return Fcons (comma_type
, Fcons (value
, Qnil
));
2678 Vold_style_backquotes
= Qt
;
2690 end_of_file_error ();
2692 /* Accept `single space' syntax like (list ? x) where the
2693 whitespace character is SPC or TAB.
2694 Other literal whitespace like NL, CR, and FF are not accepted,
2695 as there are well-established escape sequences for these. */
2696 if (c
== ' ' || c
== '\t')
2697 return make_number (c
);
2700 c
= read_escape (readcharfun
, 0);
2701 modifiers
= c
& CHAR_MODIFIER_MASK
;
2702 c
&= ~CHAR_MODIFIER_MASK
;
2703 if (CHAR_BYTE8_P (c
))
2704 c
= CHAR_TO_BYTE8 (c
);
2707 next_char
= READCHAR
;
2708 if (next_char
== '.')
2710 /* Only a dotted-pair dot is valid after a char constant. */
2711 int next_next_char
= READCHAR
;
2712 UNREAD (next_next_char
);
2714 ok
= (next_next_char
<= 040
2715 || (next_next_char
< 0200
2716 && (strchr ("\"';([#?", next_next_char
)
2717 || (!first_in_list
&& next_next_char
== '`')
2718 || (new_backquote_flag
&& next_next_char
== ','))));
2722 ok
= (next_char
<= 040
2723 || (next_char
< 0200
2724 && (strchr ("\"';()[]#?", next_char
)
2725 || (!first_in_list
&& next_char
== '`')
2726 || (new_backquote_flag
&& next_char
== ','))));
2730 return make_number (c
);
2732 invalid_syntax ("?", 1);
2737 char *p
= read_buffer
;
2738 char *end
= read_buffer
+ read_buffer_size
;
2740 /* Nonzero if we saw an escape sequence specifying
2741 a multibyte character. */
2742 int force_multibyte
= 0;
2743 /* Nonzero if we saw an escape sequence specifying
2744 a single-byte character. */
2745 int force_singlebyte
= 0;
2749 while ((c
= READCHAR
) >= 0
2752 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2754 int offset
= p
- read_buffer
;
2755 read_buffer
= (char *) xrealloc (read_buffer
,
2756 read_buffer_size
*= 2);
2757 p
= read_buffer
+ offset
;
2758 end
= read_buffer
+ read_buffer_size
;
2765 c
= read_escape (readcharfun
, 1);
2767 /* C is -1 if \ newline has just been seen */
2770 if (p
== read_buffer
)
2775 modifiers
= c
& CHAR_MODIFIER_MASK
;
2776 c
= c
& ~CHAR_MODIFIER_MASK
;
2778 if (CHAR_BYTE8_P (c
))
2779 force_singlebyte
= 1;
2780 else if (! ASCII_CHAR_P (c
))
2781 force_multibyte
= 1;
2782 else /* i.e. ASCII_CHAR_P (c) */
2784 /* Allow `\C- ' and `\C-?'. */
2785 if (modifiers
== CHAR_CTL
)
2788 c
= 0, modifiers
= 0;
2790 c
= 127, modifiers
= 0;
2792 if (modifiers
& CHAR_SHIFT
)
2794 /* Shift modifier is valid only with [A-Za-z]. */
2795 if (c
>= 'A' && c
<= 'Z')
2796 modifiers
&= ~CHAR_SHIFT
;
2797 else if (c
>= 'a' && c
<= 'z')
2798 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2801 if (modifiers
& CHAR_META
)
2803 /* Move the meta bit to the right place for a
2805 modifiers
&= ~CHAR_META
;
2806 c
= BYTE8_TO_CHAR (c
| 0x80);
2807 force_singlebyte
= 1;
2811 /* Any modifiers remaining are invalid. */
2813 error ("Invalid modifier in string");
2814 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2818 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2819 if (CHAR_BYTE8_P (c
))
2820 force_singlebyte
= 1;
2821 else if (! ASCII_CHAR_P (c
))
2822 force_multibyte
= 1;
2828 end_of_file_error ();
2830 /* If purifying, and string starts with \ newline,
2831 return zero instead. This is for doc strings
2832 that we are really going to find in etc/DOC.nn.nn */
2833 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2834 return make_number (0);
2836 if (force_multibyte
)
2837 /* READ_BUFFER already contains valid multibyte forms. */
2839 else if (force_singlebyte
)
2841 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2842 p
= read_buffer
+ nchars
;
2845 /* Otherwise, READ_BUFFER contains only ASCII. */
2848 /* We want readchar_count to be the number of characters, not
2849 bytes. Hence we adjust for multibyte characters in the
2850 string. ... But it doesn't seem to be necessary, because
2851 READCHAR *does* read multibyte characters from buffers. */
2852 /* readchar_count -= (p - read_buffer) - nchars; */
2854 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2856 || (p
- read_buffer
!= nchars
)));
2857 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2859 || (p
- read_buffer
!= nchars
)));
2864 int next_char
= READCHAR
;
2867 if (next_char
<= 040
2868 || (next_char
< 0200
2869 && (strchr ("\"';([#?", next_char
)
2870 || (!first_in_list
&& next_char
== '`')
2871 || (new_backquote_flag
&& next_char
== ','))))
2877 /* Otherwise, we fall through! Note that the atom-reading loop
2878 below will now loop at least once, assuring that we will not
2879 try to UNREAD two characters in a row. */
2883 if (c
<= 040) goto retry
;
2884 if (c
== 0x8a0) /* NBSP */
2887 char *p
= read_buffer
;
2891 char *end
= read_buffer
+ read_buffer_size
;
2894 && c
!= 0x8a0 /* NBSP */
2896 || (!strchr ("\"';()[]#", c
)
2897 && !(!first_in_list
&& c
== '`')
2898 && !(new_backquote_flag
&& c
== ','))))
2900 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2902 int offset
= p
- read_buffer
;
2903 read_buffer
= (char *) xrealloc (read_buffer
,
2904 read_buffer_size
*= 2);
2905 p
= read_buffer
+ offset
;
2906 end
= read_buffer
+ read_buffer_size
;
2913 end_of_file_error ();
2918 p
+= CHAR_STRING (c
, p
);
2926 int offset
= p
- read_buffer
;
2927 read_buffer
= (char *) xrealloc (read_buffer
,
2928 read_buffer_size
*= 2);
2929 p
= read_buffer
+ offset
;
2930 end
= read_buffer
+ read_buffer_size
;
2937 if (!quoted
&& !uninterned_symbol
)
2941 if (*p1
== '+' || *p1
== '-') p1
++;
2942 /* Is it an integer? */
2945 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2946 /* Integers can have trailing decimal points. */
2947 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2949 /* It is an integer. */
2954 /* EMACS_INT n = atol (read_buffer); */
2955 char *endptr
= NULL
;
2956 EMACS_INT n
= (errno
= 0,
2957 strtol (read_buffer
, &endptr
, 10));
2958 if (errno
== ERANGE
&& endptr
)
2961 = Fcons (make_string (read_buffer
,
2962 endptr
- read_buffer
),
2964 xsignal (Qoverflow_error
, args
);
2966 return make_fixnum_or_float (n
);
2970 if (isfloat_string (read_buffer
, 0))
2972 /* Compute NaN and infinities using 0.0 in a variable,
2973 to cope with compilers that think they are smarter
2979 /* Negate the value ourselves. This treats 0, NaNs,
2980 and infinity properly on IEEE floating point hosts,
2981 and works around a common bug where atof ("-0.0")
2983 int negative
= read_buffer
[0] == '-';
2985 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2986 returns 1, is if the input ends in e+INF or e+NaN. */
2993 value
= zero
/ zero
;
2995 /* If that made a "negative" NaN, negate it. */
2999 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3002 u_minus_zero
.d
= - 0.0;
3003 for (i
= 0; i
< sizeof (double); i
++)
3004 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3010 /* Now VALUE is a positive NaN. */
3013 value
= atof (read_buffer
+ negative
);
3017 return make_float (negative
? - value
: value
);
3021 Lisp_Object name
, result
;
3022 EMACS_INT nbytes
= p
- read_buffer
;
3024 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3027 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3028 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3030 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3031 result
= (uninterned_symbol
? Fmake_symbol (name
)
3032 : Fintern (name
, Qnil
));
3034 if (EQ (Vread_with_symbol_positions
, Qt
)
3035 || EQ (Vread_with_symbol_positions
, readcharfun
))
3036 Vread_symbol_positions_list
=
3037 /* Kind of a hack; this will probably fail if characters
3038 in the symbol name were escaped. Not really a big
3040 Fcons (Fcons (result
,
3041 make_number (readchar_count
3042 - XFASTINT (Flength (Fsymbol_name (result
))))),
3043 Vread_symbol_positions_list
);
3051 /* List of nodes we've seen during substitute_object_in_subtree. */
3052 static Lisp_Object seen_list
;
3055 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3057 Lisp_Object check_object
;
3059 /* We haven't seen any objects when we start. */
3062 /* Make all the substitutions. */
3064 = substitute_object_recurse (object
, placeholder
, object
);
3066 /* Clear seen_list because we're done with it. */
3069 /* The returned object here is expected to always eq the
3071 if (!EQ (check_object
, object
))
3072 error ("Unexpected mutation error in reader");
3075 /* Feval doesn't get called from here, so no gc protection is needed. */
3076 #define SUBSTITUTE(get_val, set_val) \
3078 Lisp_Object old_value = get_val; \
3079 Lisp_Object true_value \
3080 = substitute_object_recurse (object, placeholder, \
3083 if (!EQ (old_value, true_value)) \
3090 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3092 /* If we find the placeholder, return the target object. */
3093 if (EQ (placeholder
, subtree
))
3096 /* If we've been to this node before, don't explore it again. */
3097 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3100 /* If this node can be the entry point to a cycle, remember that
3101 we've seen it. It can only be such an entry point if it was made
3102 by #n=, which means that we can find it as a value in
3104 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3105 seen_list
= Fcons (subtree
, seen_list
);
3107 /* Recurse according to subtree's type.
3108 Every branch must return a Lisp_Object. */
3109 switch (XTYPE (subtree
))
3111 case Lisp_Vectorlike
:
3114 if (BOOL_VECTOR_P (subtree
))
3115 return subtree
; /* No sub-objects anyway. */
3116 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3117 || COMPILEDP (subtree
))
3118 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3119 else if (VECTORP (subtree
))
3120 length
= ASIZE (subtree
);
3122 /* An unknown pseudovector may contain non-Lisp fields, so we
3123 can't just blindly traverse all its fields. We used to call
3124 `Flength' which signaled `sequencep', so I just preserved this
3126 wrong_type_argument (Qsequencep
, subtree
);
3128 for (i
= 0; i
< length
; i
++)
3129 SUBSTITUTE (AREF (subtree
, i
),
3130 ASET (subtree
, i
, true_value
));
3136 SUBSTITUTE (XCAR (subtree
),
3137 XSETCAR (subtree
, true_value
));
3138 SUBSTITUTE (XCDR (subtree
),
3139 XSETCDR (subtree
, true_value
));
3145 /* Check for text properties in each interval.
3146 substitute_in_interval contains part of the logic. */
3148 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3149 Lisp_Object arg
= Fcons (object
, placeholder
);
3151 traverse_intervals_noorder (root_interval
,
3152 &substitute_in_interval
, arg
);
3157 /* Other types don't recurse any further. */
3163 /* Helper function for substitute_object_recurse. */
3165 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3167 Lisp_Object object
= Fcar (arg
);
3168 Lisp_Object placeholder
= Fcdr (arg
);
3170 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3181 isfloat_string (const char *cp
, int ignore_trailing
)
3184 const char *start
= cp
;
3187 if (*cp
== '+' || *cp
== '-')
3190 if (*cp
>= '0' && *cp
<= '9')
3193 while (*cp
>= '0' && *cp
<= '9')
3201 if (*cp
>= '0' && *cp
<= '9')
3204 while (*cp
>= '0' && *cp
<= '9')
3207 if (*cp
== 'e' || *cp
== 'E')
3211 if (*cp
== '+' || *cp
== '-')
3215 if (*cp
>= '0' && *cp
<= '9')
3218 while (*cp
>= '0' && *cp
<= '9')
3221 else if (cp
== start
)
3223 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3228 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3234 return ((ignore_trailing
3235 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3236 || *cp
== '\r' || *cp
== '\f')
3237 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3238 || state
== (DOT_CHAR
|TRAIL_INT
)
3239 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3240 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3241 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3246 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3250 register Lisp_Object
*ptr
;
3251 register Lisp_Object tem
, item
, vector
;
3252 register struct Lisp_Cons
*otem
;
3255 tem
= read_list (1, readcharfun
);
3256 len
= Flength (tem
);
3257 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3259 size
= XVECTOR (vector
)->size
;
3260 ptr
= XVECTOR (vector
)->contents
;
3261 for (i
= 0; i
< size
; i
++)
3264 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3265 bytecode object, the docstring containing the bytecode and
3266 constants values must be treated as unibyte and passed to
3267 Fread, to get the actual bytecode string and constants vector. */
3268 if (bytecodeflag
&& load_force_doc_strings
)
3270 if (i
== COMPILED_BYTECODE
)
3272 if (!STRINGP (item
))
3273 error ("Invalid byte code");
3275 /* Delay handling the bytecode slot until we know whether
3276 it is lazily-loaded (we can tell by whether the
3277 constants slot is nil). */
3278 ptr
[COMPILED_CONSTANTS
] = item
;
3281 else if (i
== COMPILED_CONSTANTS
)
3283 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3287 /* Coerce string to unibyte (like string-as-unibyte,
3288 but without generating extra garbage and
3289 guaranteeing no change in the contents). */
3290 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3291 STRING_SET_UNIBYTE (bytestr
);
3293 item
= Fread (Fcons (bytestr
, readcharfun
));
3295 error ("Invalid byte code");
3297 otem
= XCONS (item
);
3298 bytestr
= XCAR (item
);
3303 /* Now handle the bytecode slot. */
3304 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3306 else if (i
== COMPILED_DOC_STRING
3308 && ! STRING_MULTIBYTE (item
))
3310 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3311 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3313 item
= Fstring_as_multibyte (item
);
3316 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3324 /* FLAG = 1 means check for ] to terminate rather than ) and .
3325 FLAG = -1 means check for starting with defun
3326 and make structure pure. */
3329 read_list (int flag
, register Lisp_Object readcharfun
)
3331 /* -1 means check next element for defun,
3332 0 means don't check,
3333 1 means already checked and found defun. */
3334 int defunflag
= flag
< 0 ? -1 : 0;
3335 Lisp_Object val
, tail
;
3336 register Lisp_Object elt
, tem
;
3337 struct gcpro gcpro1
, gcpro2
;
3338 /* 0 is the normal case.
3339 1 means this list is a doc reference; replace it with the number 0.
3340 2 means this list is a doc reference; replace it with the doc string. */
3341 int doc_reference
= 0;
3343 /* Initialize this to 1 if we are reading a list. */
3344 int first_in_list
= flag
<= 0;
3353 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3358 /* While building, if the list starts with #$, treat it specially. */
3359 if (EQ (elt
, Vload_file_name
)
3361 && !NILP (Vpurify_flag
))
3363 if (NILP (Vdoc_file_name
))
3364 /* We have not yet called Snarf-documentation, so assume
3365 this file is described in the DOC-MM.NN file
3366 and Snarf-documentation will fill in the right value later.
3367 For now, replace the whole list with 0. */
3370 /* We have already called Snarf-documentation, so make a relative
3371 file name for this file, so it can be found properly
3372 in the installed Lisp directory.
3373 We don't use Fexpand_file_name because that would make
3374 the directory absolute now. */
3375 elt
= concat2 (build_string ("../lisp/"),
3376 Ffile_name_nondirectory (elt
));
3378 else if (EQ (elt
, Vload_file_name
)
3380 && load_force_doc_strings
)
3389 invalid_syntax (") or . in a vector", 18);
3397 XSETCDR (tail
, read0 (readcharfun
));
3399 val
= read0 (readcharfun
);
3400 read1 (readcharfun
, &ch
, 0);
3404 if (doc_reference
== 1)
3405 return make_number (0);
3406 if (doc_reference
== 2)
3408 /* Get a doc string from the file we are loading.
3409 If it's in saved_doc_string, get it from there.
3411 Here, we don't know if the string is a
3412 bytecode string or a doc string. As a
3413 bytecode string must be unibyte, we always
3414 return a unibyte string. If it is actually a
3415 doc string, caller must make it
3418 int pos
= XINT (XCDR (val
));
3419 /* Position is negative for user variables. */
3420 if (pos
< 0) pos
= -pos
;
3421 if (pos
>= saved_doc_string_position
3422 && pos
< (saved_doc_string_position
3423 + saved_doc_string_length
))
3425 int start
= pos
- saved_doc_string_position
;
3428 /* Process quoting with ^A,
3429 and find the end of the string,
3430 which is marked with ^_ (037). */
3431 for (from
= start
, to
= start
;
3432 saved_doc_string
[from
] != 037;)
3434 int c
= saved_doc_string
[from
++];
3437 c
= saved_doc_string
[from
++];
3439 saved_doc_string
[to
++] = c
;
3441 saved_doc_string
[to
++] = 0;
3443 saved_doc_string
[to
++] = 037;
3446 saved_doc_string
[to
++] = c
;
3449 return make_unibyte_string (saved_doc_string
+ start
,
3452 /* Look in prev_saved_doc_string the same way. */
3453 else if (pos
>= prev_saved_doc_string_position
3454 && pos
< (prev_saved_doc_string_position
3455 + prev_saved_doc_string_length
))
3457 int start
= pos
- prev_saved_doc_string_position
;
3460 /* Process quoting with ^A,
3461 and find the end of the string,
3462 which is marked with ^_ (037). */
3463 for (from
= start
, to
= start
;
3464 prev_saved_doc_string
[from
] != 037;)
3466 int c
= prev_saved_doc_string
[from
++];
3469 c
= prev_saved_doc_string
[from
++];
3471 prev_saved_doc_string
[to
++] = c
;
3473 prev_saved_doc_string
[to
++] = 0;
3475 prev_saved_doc_string
[to
++] = 037;
3478 prev_saved_doc_string
[to
++] = c
;
3481 return make_unibyte_string (prev_saved_doc_string
3486 return get_doc_string (val
, 1, 0);
3491 invalid_syntax (". in wrong context", 18);
3493 invalid_syntax ("] in a list", 11);
3495 tem
= (read_pure
&& flag
<= 0
3496 ? pure_cons (elt
, Qnil
)
3497 : Fcons (elt
, Qnil
));
3499 XSETCDR (tail
, tem
);
3504 defunflag
= EQ (elt
, Qdefun
);
3505 else if (defunflag
> 0)
3510 Lisp_Object Vobarray
;
3511 Lisp_Object initial_obarray
;
3513 /* oblookup stores the bucket number here, for the sake of Funintern. */
3515 int oblookup_last_bucket_number
;
3517 static int hash_string (const unsigned char *ptr
, int len
);
3519 /* Get an error if OBARRAY is not an obarray.
3520 If it is one, return it. */
3523 check_obarray (Lisp_Object obarray
)
3525 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3527 /* If Vobarray is now invalid, force it to be valid. */
3528 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3529 wrong_type_argument (Qvectorp
, obarray
);
3534 /* Intern the C string STR: return a symbol with that name,
3535 interned in the current obarray. */
3538 intern (const char *str
)
3541 int len
= strlen (str
);
3542 Lisp_Object obarray
;
3545 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3546 obarray
= check_obarray (obarray
);
3547 tem
= oblookup (obarray
, str
, len
, len
);
3550 return Fintern (make_string (str
, len
), obarray
);
3554 intern_c_string (const char *str
)
3557 int len
= strlen (str
);
3558 Lisp_Object obarray
;
3561 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3562 obarray
= check_obarray (obarray
);
3563 tem
= oblookup (obarray
, str
, len
, len
);
3567 if (NILP (Vpurify_flag
))
3568 /* Creating a non-pure string from a string literal not
3569 implemented yet. We could just use make_string here and live
3570 with the extra copy. */
3573 return Fintern (make_pure_c_string (str
), obarray
);
3576 /* Create an uninterned symbol with name STR. */
3579 make_symbol (const char *str
)
3581 int len
= strlen (str
);
3583 return Fmake_symbol (!NILP (Vpurify_flag
)
3584 ? make_pure_string (str
, len
, len
, 0)
3585 : make_string (str
, len
));
3588 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3589 doc
: /* Return the canonical symbol whose name is STRING.
3590 If there is none, one is created by this function and returned.
3591 A second optional argument specifies the obarray to use;
3592 it defaults to the value of `obarray'. */)
3593 (Lisp_Object string
, Lisp_Object obarray
)
3595 register Lisp_Object tem
, sym
, *ptr
;
3597 if (NILP (obarray
)) obarray
= Vobarray
;
3598 obarray
= check_obarray (obarray
);
3600 CHECK_STRING (string
);
3602 tem
= oblookup (obarray
, SDATA (string
),
3605 if (!INTEGERP (tem
))
3608 if (!NILP (Vpurify_flag
))
3609 string
= Fpurecopy (string
);
3610 sym
= Fmake_symbol (string
);
3612 if (EQ (obarray
, initial_obarray
))
3613 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3615 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3617 if ((SREF (string
, 0) == ':')
3618 && EQ (obarray
, initial_obarray
))
3620 XSYMBOL (sym
)->constant
= 1;
3621 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3622 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3625 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3627 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3629 XSYMBOL (sym
)->next
= 0;
3634 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3635 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3636 NAME may be a string or a symbol. If it is a symbol, that exact
3637 symbol is searched for.
3638 A second optional argument specifies the obarray to use;
3639 it defaults to the value of `obarray'. */)
3640 (Lisp_Object name
, Lisp_Object obarray
)
3642 register Lisp_Object tem
, string
;
3644 if (NILP (obarray
)) obarray
= Vobarray
;
3645 obarray
= check_obarray (obarray
);
3647 if (!SYMBOLP (name
))
3649 CHECK_STRING (name
);
3653 string
= SYMBOL_NAME (name
);
3655 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3656 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3662 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3663 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3664 The value is t if a symbol was found and deleted, nil otherwise.
3665 NAME may be a string or a symbol. If it is a symbol, that symbol
3666 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3667 OBARRAY defaults to the value of the variable `obarray'. */)
3668 (Lisp_Object name
, Lisp_Object obarray
)
3670 register Lisp_Object string
, tem
;
3673 if (NILP (obarray
)) obarray
= Vobarray
;
3674 obarray
= check_obarray (obarray
);
3677 string
= SYMBOL_NAME (name
);
3680 CHECK_STRING (name
);
3684 tem
= oblookup (obarray
, SDATA (string
),
3689 /* If arg was a symbol, don't delete anything but that symbol itself. */
3690 if (SYMBOLP (name
) && !EQ (name
, tem
))
3693 /* There are plenty of other symbols which will screw up the Emacs
3694 session if we unintern them, as well as even more ways to use
3695 `setq' or `fset' or whatnot to make the Emacs session
3696 unusable. Let's not go down this silly road. --Stef */
3697 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3698 error ("Attempt to unintern t or nil"); */
3700 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3702 hash
= oblookup_last_bucket_number
;
3704 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3706 if (XSYMBOL (tem
)->next
)
3707 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3709 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3713 Lisp_Object tail
, following
;
3715 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3716 XSYMBOL (tail
)->next
;
3719 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3720 if (EQ (following
, tem
))
3722 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3731 /* Return the symbol in OBARRAY whose names matches the string
3732 of SIZE characters (SIZE_BYTE bytes) at PTR.
3733 If there is no such symbol in OBARRAY, return nil.
3735 Also store the bucket number in oblookup_last_bucket_number. */
3738 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3742 register Lisp_Object tail
;
3743 Lisp_Object bucket
, tem
;
3745 if (!VECTORP (obarray
)
3746 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3748 obarray
= check_obarray (obarray
);
3749 obsize
= XVECTOR (obarray
)->size
;
3751 /* This is sometimes needed in the middle of GC. */
3752 obsize
&= ~ARRAY_MARK_FLAG
;
3753 hash
= hash_string (ptr
, size_byte
) % obsize
;
3754 bucket
= XVECTOR (obarray
)->contents
[hash
];
3755 oblookup_last_bucket_number
= hash
;
3756 if (EQ (bucket
, make_number (0)))
3758 else if (!SYMBOLP (bucket
))
3759 error ("Bad data in guts of obarray"); /* Like CADR error message */
3761 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3763 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3764 && SCHARS (SYMBOL_NAME (tail
)) == size
3765 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3767 else if (XSYMBOL (tail
)->next
== 0)
3770 XSETINT (tem
, hash
);
3775 hash_string (const unsigned char *ptr
, int len
)
3777 register const unsigned char *p
= ptr
;
3778 register const unsigned char *end
= p
+ len
;
3779 register unsigned char c
;
3780 register int hash
= 0;
3785 if (c
>= 0140) c
-= 40;
3786 hash
= ((hash
<<3) + (hash
>>28) + c
);
3788 return hash
& 07777777777;
3792 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3795 register Lisp_Object tail
;
3796 CHECK_VECTOR (obarray
);
3797 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3799 tail
= XVECTOR (obarray
)->contents
[i
];
3804 if (XSYMBOL (tail
)->next
== 0)
3806 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3812 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3814 call1 (function
, sym
);
3817 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3818 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3819 OBARRAY defaults to the value of `obarray'. */)
3820 (Lisp_Object function
, Lisp_Object obarray
)
3822 if (NILP (obarray
)) obarray
= Vobarray
;
3823 obarray
= check_obarray (obarray
);
3825 map_obarray (obarray
, mapatoms_1
, function
);
3829 #define OBARRAY_SIZE 1511
3834 Lisp_Object oblength
;
3836 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3838 Vobarray
= Fmake_vector (oblength
, make_number (0));
3839 initial_obarray
= Vobarray
;
3840 staticpro (&initial_obarray
);
3842 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3843 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3844 NILP (Vpurify_flag) check in intern_c_string. */
3845 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3846 Qnil
= intern_c_string ("nil");
3848 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3849 so those two need to be fixed manally. */
3850 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3851 XSYMBOL (Qunbound
)->function
= Qunbound
;
3852 XSYMBOL (Qunbound
)->plist
= Qnil
;
3853 /* XSYMBOL (Qnil)->function = Qunbound; */
3854 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3855 XSYMBOL (Qnil
)->constant
= 1;
3856 XSYMBOL (Qnil
)->plist
= Qnil
;
3858 Qt
= intern_c_string ("t");
3859 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3860 XSYMBOL (Qt
)->constant
= 1;
3862 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3865 Qvariable_documentation
= intern_c_string ("variable-documentation");
3866 staticpro (&Qvariable_documentation
);
3868 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3869 read_buffer
= (char *) xmalloc (read_buffer_size
);
3873 defsubr (struct Lisp_Subr
*sname
)
3876 sym
= intern_c_string (sname
->symbol_name
);
3877 XSETPVECTYPE (sname
, PVEC_SUBR
);
3878 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3881 #ifdef NOTDEF /* use fset in subr.el now */
3883 defalias (sname
, string
)
3884 struct Lisp_Subr
*sname
;
3888 sym
= intern (string
);
3889 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3893 /* Define an "integer variable"; a symbol whose value is forwarded to a
3894 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3895 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3897 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3898 const char *namestring
, EMACS_INT
*address
)
3901 sym
= intern_c_string (namestring
);
3902 i_fwd
->type
= Lisp_Fwd_Int
;
3903 i_fwd
->intvar
= address
;
3904 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3905 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3908 /* Similar but define a variable whose value is t if address contains 1,
3909 nil if address contains 0. */
3911 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3912 const char *namestring
, int *address
)
3915 sym
= intern_c_string (namestring
);
3916 b_fwd
->type
= Lisp_Fwd_Bool
;
3917 b_fwd
->boolvar
= address
;
3918 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3919 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3920 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3923 /* Similar but define a variable whose value is the Lisp Object stored
3924 at address. Two versions: with and without gc-marking of the C
3925 variable. The nopro version is used when that variable will be
3926 gc-marked for some other reason, since marking the same slot twice
3927 can cause trouble with strings. */
3929 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
3930 const char *namestring
, Lisp_Object
*address
)
3933 sym
= intern_c_string (namestring
);
3934 o_fwd
->type
= Lisp_Fwd_Obj
;
3935 o_fwd
->objvar
= address
;
3936 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3937 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
3941 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
3942 const char *namestring
, Lisp_Object
*address
)
3944 defvar_lisp_nopro (o_fwd
, namestring
, address
);
3945 staticpro (address
);
3948 /* Similar but define a variable whose value is the Lisp Object stored
3949 at a particular offset in the current kboard object. */
3952 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
3953 const char *namestring
, int offset
)
3956 sym
= intern_c_string (namestring
);
3957 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
3958 ko_fwd
->offset
= offset
;
3959 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3960 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
3963 /* Record the value of load-path used at the start of dumping
3964 so we can see if the site changed it later during dumping. */
3965 static Lisp_Object dump_path
;
3971 int turn_off_warning
= 0;
3973 /* Compute the default load-path. */
3975 normal
= PATH_LOADSEARCH
;
3976 Vload_path
= decode_env_path (0, normal
);
3978 if (NILP (Vpurify_flag
))
3979 normal
= PATH_LOADSEARCH
;
3981 normal
= PATH_DUMPLOADSEARCH
;
3983 /* In a dumped Emacs, we normally have to reset the value of
3984 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3985 uses ../lisp, instead of the path of the installed elisp
3986 libraries. However, if it appears that Vload_path was changed
3987 from the default before dumping, don't override that value. */
3990 if (! NILP (Fequal (dump_path
, Vload_path
)))
3992 Vload_path
= decode_env_path (0, normal
);
3993 if (!NILP (Vinstallation_directory
))
3995 Lisp_Object tem
, tem1
, sitelisp
;
3997 /* Remove site-lisp dirs from path temporarily and store
3998 them in sitelisp, then conc them on at the end so
3999 they're always first in path. */
4003 tem
= Fcar (Vload_path
);
4004 tem1
= Fstring_match (build_string ("site-lisp"),
4008 Vload_path
= Fcdr (Vload_path
);
4009 sitelisp
= Fcons (tem
, sitelisp
);
4015 /* Add to the path the lisp subdir of the
4016 installation dir, if it exists. */
4017 tem
= Fexpand_file_name (build_string ("lisp"),
4018 Vinstallation_directory
);
4019 tem1
= Ffile_exists_p (tem
);
4022 if (NILP (Fmember (tem
, Vload_path
)))
4024 turn_off_warning
= 1;
4025 Vload_path
= Fcons (tem
, Vload_path
);
4029 /* That dir doesn't exist, so add the build-time
4030 Lisp dirs instead. */
4031 Vload_path
= nconc2 (Vload_path
, dump_path
);
4033 /* Add leim under the installation dir, if it exists. */
4034 tem
= Fexpand_file_name (build_string ("leim"),
4035 Vinstallation_directory
);
4036 tem1
= Ffile_exists_p (tem
);
4039 if (NILP (Fmember (tem
, Vload_path
)))
4040 Vload_path
= Fcons (tem
, Vload_path
);
4043 /* Add site-lisp under the installation dir, if it exists. */
4044 tem
= Fexpand_file_name (build_string ("site-lisp"),
4045 Vinstallation_directory
);
4046 tem1
= Ffile_exists_p (tem
);
4049 if (NILP (Fmember (tem
, Vload_path
)))
4050 Vload_path
= Fcons (tem
, Vload_path
);
4053 /* If Emacs was not built in the source directory,
4054 and it is run from where it was built, add to load-path
4055 the lisp, leim and site-lisp dirs under that directory. */
4057 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4061 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4062 Vinstallation_directory
);
4063 tem1
= Ffile_exists_p (tem
);
4065 /* Don't be fooled if they moved the entire source tree
4066 AFTER dumping Emacs. If the build directory is indeed
4067 different from the source dir, src/Makefile.in and
4068 src/Makefile will not be found together. */
4069 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4070 Vinstallation_directory
);
4071 tem2
= Ffile_exists_p (tem
);
4072 if (!NILP (tem1
) && NILP (tem2
))
4074 tem
= Fexpand_file_name (build_string ("lisp"),
4077 if (NILP (Fmember (tem
, Vload_path
)))
4078 Vload_path
= Fcons (tem
, Vload_path
);
4080 tem
= Fexpand_file_name (build_string ("leim"),
4083 if (NILP (Fmember (tem
, Vload_path
)))
4084 Vload_path
= Fcons (tem
, Vload_path
);
4086 tem
= Fexpand_file_name (build_string ("site-lisp"),
4089 if (NILP (Fmember (tem
, Vload_path
)))
4090 Vload_path
= Fcons (tem
, Vload_path
);
4093 if (!NILP (sitelisp
))
4094 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4100 /* NORMAL refers to the lisp dir in the source directory. */
4101 /* We used to add ../lisp at the front here, but
4102 that caused trouble because it was copied from dump_path
4103 into Vload_path, above, when Vinstallation_directory was non-nil.
4104 It should be unnecessary. */
4105 Vload_path
= decode_env_path (0, normal
);
4106 dump_path
= Vload_path
;
4110 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4111 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4112 almost never correct, thereby causing a warning to be printed out that
4113 confuses users. Since PATH_LOADSEARCH is always overridden by the
4114 EMACSLOADPATH environment variable below, disable the warning on NT. */
4116 /* Warn if dirs in the *standard* path don't exist. */
4117 if (!turn_off_warning
)
4119 Lisp_Object path_tail
;
4121 for (path_tail
= Vload_path
;
4123 path_tail
= XCDR (path_tail
))
4125 Lisp_Object dirfile
;
4126 dirfile
= Fcar (path_tail
);
4127 if (STRINGP (dirfile
))
4129 dirfile
= Fdirectory_file_name (dirfile
);
4130 if (access (SDATA (dirfile
), 0) < 0)
4131 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4136 #endif /* !(WINDOWSNT || HAVE_NS) */
4138 /* If the EMACSLOADPATH environment variable is set, use its value.
4139 This doesn't apply if we're dumping. */
4141 if (NILP (Vpurify_flag
)
4142 && egetenv ("EMACSLOADPATH"))
4144 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4148 load_in_progress
= 0;
4149 Vload_file_name
= Qnil
;
4151 load_descriptor_list
= Qnil
;
4153 Vstandard_input
= Qt
;
4154 Vloads_in_progress
= Qnil
;
4157 /* Print a warning, using format string FORMAT, that directory DIRNAME
4158 does not exist. Print it on stderr and put it in *Messages*. */
4161 dir_warning (const char *format
, Lisp_Object dirname
)
4164 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4166 fprintf (stderr
, format
, SDATA (dirname
));
4167 sprintf (buffer
, format
, SDATA (dirname
));
4168 /* Don't log the warning before we've initialized!! */
4170 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4174 syms_of_lread (void)
4177 defsubr (&Sread_from_string
);
4179 defsubr (&Sintern_soft
);
4180 defsubr (&Sunintern
);
4181 defsubr (&Sget_load_suffixes
);
4183 defsubr (&Seval_buffer
);
4184 defsubr (&Seval_region
);
4185 defsubr (&Sread_char
);
4186 defsubr (&Sread_char_exclusive
);
4187 defsubr (&Sread_event
);
4188 defsubr (&Sget_file_char
);
4189 defsubr (&Smapatoms
);
4190 defsubr (&Slocate_file_internal
);
4192 DEFVAR_LISP ("obarray", &Vobarray
,
4193 doc
: /* Symbol table for use by `intern' and `read'.
4194 It is a vector whose length ought to be prime for best results.
4195 The vector's contents don't make sense if examined from Lisp programs;
4196 to find all the symbols in an obarray, use `mapatoms'. */);
4198 DEFVAR_LISP ("values", &Vvalues
,
4199 doc
: /* List of values of all expressions which were read, evaluated and printed.
4200 Order is reverse chronological. */);
4202 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4203 doc
: /* Stream for read to get input from.
4204 See documentation of `read' for possible values. */);
4205 Vstandard_input
= Qt
;
4207 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4208 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4210 If this variable is a buffer, then only forms read from that buffer
4211 will be added to `read-symbol-positions-list'.
4212 If this variable is t, then all read forms will be added.
4213 The effect of all other values other than nil are not currently
4214 defined, although they may be in the future.
4216 The positions are relative to the last call to `read' or
4217 `read-from-string'. It is probably a bad idea to set this variable at
4218 the toplevel; bind it instead. */);
4219 Vread_with_symbol_positions
= Qnil
;
4221 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4222 doc
: /* A list mapping read symbols to their positions.
4223 This variable is modified during calls to `read' or
4224 `read-from-string', but only when `read-with-symbol-positions' is
4227 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4228 CHAR-POSITION is an integer giving the offset of that occurrence of the
4229 symbol from the position where `read' or `read-from-string' started.
4231 Note that a symbol will appear multiple times in this list, if it was
4232 read multiple times. The list is in the same order as the symbols
4234 Vread_symbol_positions_list
= Qnil
;
4236 DEFVAR_LISP ("read-circle", &Vread_circle
,
4237 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4240 DEFVAR_LISP ("load-path", &Vload_path
,
4241 doc
: /* *List of directories to search for files to load.
4242 Each element is a string (directory name) or nil (try default directory).
4243 Initialized based on EMACSLOADPATH environment variable, if any,
4244 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4246 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4247 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4248 This list should not include the empty string.
4249 `load' and related functions try to append these suffixes, in order,
4250 to the specified file name if a Lisp suffix is allowed or required. */);
4251 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4252 Fcons (make_pure_c_string (".el"), Qnil
));
4253 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4254 doc
: /* List of suffixes that indicate representations of \
4256 This list should normally start with the empty string.
4258 Enabling Auto Compression mode appends the suffixes in
4259 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4260 mode removes them again. `load' and related functions use this list to
4261 determine whether they should look for compressed versions of a file
4262 and, if so, which suffixes they should try to append to the file name
4263 in order to do so. However, if you want to customize which suffixes
4264 the loading functions recognize as compression suffixes, you should
4265 customize `jka-compr-load-suffixes' rather than the present variable. */);
4266 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4268 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4269 doc
: /* Non-nil if inside of `load'. */);
4270 Qload_in_progress
= intern_c_string ("load-in-progress");
4271 staticpro (&Qload_in_progress
);
4273 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4274 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4275 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4277 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4278 a symbol \(a feature name).
4280 When `load' is run and the file-name argument matches an element's
4281 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4282 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4284 An error in FORMS does not undo the load, but does prevent execution of
4285 the rest of the FORMS. */);
4286 Vafter_load_alist
= Qnil
;
4288 DEFVAR_LISP ("load-history", &Vload_history
,
4289 doc
: /* Alist mapping loaded file names to symbols and features.
4290 Each alist element should be a list (FILE-NAME ENTRIES...), where
4291 FILE-NAME is the name of a file that has been loaded into Emacs.
4292 The file name is absolute and true (i.e. it doesn't contain symlinks).
4293 As an exception, one of the alist elements may have FILE-NAME nil,
4294 for symbols and features not associated with any file.
4296 The remaining ENTRIES in the alist element describe the functions and
4297 variables defined in that file, the features provided, and the
4298 features required. Each entry has the form `(provide . FEATURE)',
4299 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4300 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4301 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4302 SYMBOL was an autoload before this file redefined it as a function.
4304 During preloading, the file name recorded is relative to the main Lisp
4305 directory. These file names are converted to absolute at startup. */);
4306 Vload_history
= Qnil
;
4308 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4309 doc
: /* Full name of file being loaded by `load'. */);
4310 Vload_file_name
= Qnil
;
4312 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4313 doc
: /* File name, including directory, of user's initialization file.
4314 If the file loaded had extension `.elc', and the corresponding source file
4315 exists, this variable contains the name of source file, suitable for use
4316 by functions like `custom-save-all' which edit the init file.
4317 While Emacs loads and evaluates the init file, value is the real name
4318 of the file, regardless of whether or not it has the `.elc' extension. */);
4319 Vuser_init_file
= Qnil
;
4321 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4322 doc
: /* Used for internal purposes by `load'. */);
4323 Vcurrent_load_list
= Qnil
;
4325 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4326 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4327 The default is nil, which means use the function `read'. */);
4328 Vload_read_function
= Qnil
;
4330 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4331 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4332 This function is for doing code conversion before reading the source file.
4333 If nil, loading is done without any code conversion.
4334 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4335 FULLNAME is the full name of FILE.
4336 See `load' for the meaning of the remaining arguments. */);
4337 Vload_source_file_function
= Qnil
;
4339 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4340 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4341 This is useful when the file being loaded is a temporary copy. */);
4342 load_force_doc_strings
= 0;
4344 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4345 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4346 This is normally bound by `load' and `eval-buffer' to control `read',
4347 and is not meant for users to change. */);
4348 load_convert_to_unibyte
= 0;
4350 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4351 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4352 You cannot count on them to still be there! */);
4354 = Fexpand_file_name (build_string ("../"),
4355 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4357 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4358 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4359 Vpreloaded_file_list
= Qnil
;
4361 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4362 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4363 Vbyte_boolean_vars
= Qnil
;
4365 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4366 doc
: /* Non-nil means load dangerous compiled Lisp files.
4367 Some versions of XEmacs use different byte codes than Emacs. These
4368 incompatible byte codes can make Emacs crash when it tries to execute
4370 load_dangerous_libraries
= 0;
4372 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4373 doc
: /* Non-nil means force printing messages when loading Lisp files.
4374 This overrides the value of the NOMESSAGE argument to `load'. */);
4375 force_load_messages
= 0;
4377 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4378 doc
: /* Regular expression matching safe to load compiled Lisp files.
4379 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4380 from the file, and matches them against this regular expression.
4381 When the regular expression matches, the file is considered to be safe
4382 to load. See also `load-dangerous-libraries'. */);
4383 Vbytecomp_version_regexp
4384 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4386 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4387 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4388 Veval_buffer_list
= Qnil
;
4390 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4391 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4392 Vold_style_backquotes
= Qnil
;
4393 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4394 staticpro (&Qold_style_backquotes
);
4396 /* Vsource_directory was initialized in init_lread. */
4398 load_descriptor_list
= Qnil
;
4399 staticpro (&load_descriptor_list
);
4401 Qcurrent_load_list
= intern_c_string ("current-load-list");
4402 staticpro (&Qcurrent_load_list
);
4404 Qstandard_input
= intern_c_string ("standard-input");
4405 staticpro (&Qstandard_input
);
4407 Qread_char
= intern_c_string ("read-char");
4408 staticpro (&Qread_char
);
4410 Qget_file_char
= intern_c_string ("get-file-char");
4411 staticpro (&Qget_file_char
);
4413 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4414 staticpro (&Qget_emacs_mule_file_char
);
4416 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4417 staticpro (&Qload_force_doc_strings
);
4419 Qbackquote
= intern_c_string ("`");
4420 staticpro (&Qbackquote
);
4421 Qcomma
= intern_c_string (",");
4422 staticpro (&Qcomma
);
4423 Qcomma_at
= intern_c_string (",@");
4424 staticpro (&Qcomma_at
);
4425 Qcomma_dot
= intern_c_string (",.");
4426 staticpro (&Qcomma_dot
);
4428 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4429 staticpro (&Qinhibit_file_name_operation
);
4431 Qascii_character
= intern_c_string ("ascii-character");
4432 staticpro (&Qascii_character
);
4434 Qfunction
= intern_c_string ("function");
4435 staticpro (&Qfunction
);
4437 Qload
= intern_c_string ("load");
4440 Qload_file_name
= intern_c_string ("load-file-name");
4441 staticpro (&Qload_file_name
);
4443 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4444 staticpro (&Qeval_buffer_list
);
4446 Qfile_truename
= intern_c_string ("file-truename");
4447 staticpro (&Qfile_truename
) ;
4449 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4450 staticpro (&Qdo_after_load_evaluation
) ;
4452 staticpro (&dump_path
);
4454 staticpro (&read_objects
);
4455 read_objects
= Qnil
;
4456 staticpro (&seen_list
);
4459 Vloads_in_progress
= Qnil
;
4460 staticpro (&Vloads_in_progress
);
4462 Qhash_table
= intern_c_string ("hash-table");
4463 staticpro (&Qhash_table
);
4464 Qdata
= intern_c_string ("data");
4466 Qtest
= intern_c_string ("test");
4468 Qsize
= intern_c_string ("size");
4470 Qweakness
= intern_c_string ("weakness");
4471 staticpro (&Qweakness
);
4472 Qrehash_size
= intern_c_string ("rehash-size");
4473 staticpro (&Qrehash_size
);
4474 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4475 staticpro (&Qrehash_threshold
);