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
556 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
558 /* Emacs-mule coding uses at most 4-byte for one character. */
559 unsigned char buf
[4];
560 int len
= emacs_mule_bytes
[c
];
561 struct charset
*charset
;
566 /* C is not a valid leading-code of `emacs-mule'. */
567 return BYTE8_TO_CHAR (c
);
573 c
= (*readbyte
) (-1, readcharfun
);
577 (*readbyte
) (buf
[i
], readcharfun
);
578 return BYTE8_TO_CHAR (buf
[0]);
585 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
586 code
= buf
[1] & 0x7F;
590 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
591 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
593 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
594 code
= buf
[2] & 0x7F;
598 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
599 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
604 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
605 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
607 c
= DECODE_CHAR (charset
, code
);
609 Fsignal (Qinvalid_read_syntax
,
610 Fcons (build_string ("invalid multibyte form"), Qnil
));
615 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
617 static Lisp_Object
read0 (Lisp_Object
);
618 static Lisp_Object
read1 (Lisp_Object
, int *, int);
620 static Lisp_Object
read_list (int, Lisp_Object
);
621 static Lisp_Object
read_vector (Lisp_Object
, int);
623 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
625 static void substitute_object_in_subtree (Lisp_Object
,
627 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
630 /* Get a character from the tty. */
632 /* Read input events until we get one that's acceptable for our purposes.
634 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
635 until we get a character we like, and then stuffed into
638 If ASCII_REQUIRED is non-zero, we check function key events to see
639 if the unmodified version of the symbol has a Qascii_character
640 property, and use that character, if present.
642 If ERROR_NONASCII is non-zero, we signal an error if the input we
643 get isn't an ASCII character with modifiers. If it's zero but
644 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
647 If INPUT_METHOD is nonzero, we invoke the current input method
648 if the character warrants that.
650 If SECONDS is a number, we wait that many seconds for input, and
651 return Qnil if no input arrives within that time. */
654 read_filtered_event (int no_switch_frame
, int ascii_required
,
655 int error_nonascii
, int input_method
, Lisp_Object seconds
)
657 Lisp_Object val
, delayed_switch_frame
;
660 #ifdef HAVE_WINDOW_SYSTEM
661 if (display_hourglass_p
)
665 delayed_switch_frame
= Qnil
;
667 /* Compute timeout. */
668 if (NUMBERP (seconds
))
670 EMACS_TIME wait_time
;
672 double duration
= extract_float (seconds
);
674 sec
= (int) duration
;
675 usec
= (duration
- sec
) * 1000000;
676 EMACS_GET_TIME (end_time
);
677 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
678 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
681 /* Read until we get an acceptable event. */
684 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
685 NUMBERP (seconds
) ? &end_time
: NULL
);
686 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
691 /* switch-frame events are put off until after the next ASCII
692 character. This is better than signaling an error just because
693 the last characters were typed to a separate minibuffer frame,
694 for example. Eventually, some code which can deal with
695 switch-frame events will read it and process it. */
697 && EVENT_HAS_PARAMETERS (val
)
698 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
700 delayed_switch_frame
= val
;
704 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
706 /* Convert certain symbols to their ASCII equivalents. */
709 Lisp_Object tem
, tem1
;
710 tem
= Fget (val
, Qevent_symbol_element_mask
);
713 tem1
= Fget (Fcar (tem
), Qascii_character
);
714 /* Merge this symbol's modifier bits
715 with the ASCII equivalent of its basic code. */
717 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
721 /* If we don't have a character now, deal with it appropriately. */
726 Vunread_command_events
= Fcons (val
, Qnil
);
727 error ("Non-character input-event");
734 if (! NILP (delayed_switch_frame
))
735 unread_switch_frame
= delayed_switch_frame
;
739 #ifdef HAVE_WINDOW_SYSTEM
740 if (display_hourglass_p
)
749 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
750 doc
: /* Read a character from the command input (keyboard or macro).
751 It is returned as a number.
752 If the character has modifiers, they are resolved and reflected to the
753 character code if possible (e.g. C-SPC -> 0).
755 If the user generates an event which is not a character (i.e. a mouse
756 click or function key event), `read-char' signals an error. As an
757 exception, switch-frame events are put off until non-character events
759 If you want to read non-character events, or ignore them, call
760 `read-event' or `read-char-exclusive' instead.
762 If the optional argument PROMPT is non-nil, display that as a prompt.
763 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
764 input method is turned on in the current buffer, that input method
765 is used for reading a character.
766 If the optional argument SECONDS is non-nil, it should be a number
767 specifying the maximum number of seconds to wait for input. If no
768 input arrives in that time, return nil. SECONDS may be a
769 floating-point value. */)
770 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
775 message_with_string ("%s", prompt
, 0);
776 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
778 return (NILP (val
) ? Qnil
779 : make_number (char_resolve_modifier_mask (XINT (val
))));
782 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
783 doc
: /* Read an event object from the input stream.
784 If the optional argument PROMPT is non-nil, display that as a prompt.
785 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
786 input method is turned on in the current buffer, that input method
787 is used for reading a character.
788 If the optional argument SECONDS is non-nil, it should be a number
789 specifying the maximum number of seconds to wait for input. If no
790 input arrives in that time, return nil. SECONDS may be a
791 floating-point value. */)
792 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
795 message_with_string ("%s", prompt
, 0);
796 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
799 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
800 doc
: /* Read a character from the command input (keyboard or macro).
801 It is returned as a number. Non-character events are ignored.
802 If the character has modifiers, they are resolved and reflected to the
803 character code if possible (e.g. C-SPC -> 0).
805 If the optional argument PROMPT is non-nil, display that as a prompt.
806 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
807 input method is turned on in the current buffer, that input method
808 is used for reading a character.
809 If the optional argument SECONDS is non-nil, it should be a number
810 specifying the maximum number of seconds to wait for input. If no
811 input arrives in that time, return nil. SECONDS may be a
812 floating-point value. */)
813 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
818 message_with_string ("%s", prompt
, 0);
820 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
822 return (NILP (val
) ? Qnil
823 : make_number (char_resolve_modifier_mask (XINT (val
))));
826 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
827 doc
: /* Don't use this yourself. */)
830 register Lisp_Object val
;
832 XSETINT (val
, getc (instream
));
839 /* Value is a version number of byte compiled code if the file
840 associated with file descriptor FD is a compiled Lisp file that's
841 safe to load. Only files compiled with Emacs are safe to load.
842 Files compiled with XEmacs can lead to a crash in Fbyte_code
843 because of an incompatible change in the byte compiler. */
846 safe_to_load_p (int fd
)
853 /* Read the first few bytes from the file, and look for a line
854 specifying the byte compiler version used. */
855 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
860 /* Skip to the next newline, skipping over the initial `ELC'
861 with NUL bytes following it, but note the version. */
862 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
867 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
874 lseek (fd
, 0, SEEK_SET
);
879 /* Callback for record_unwind_protect. Restore the old load list OLD,
880 after loading a file successfully. */
883 record_load_unwind (Lisp_Object old
)
885 return Vloads_in_progress
= old
;
888 /* This handler function is used via internal_condition_case_1. */
891 load_error_handler (Lisp_Object data
)
897 load_warn_old_style_backquotes (Lisp_Object file
)
899 if (!NILP (Vold_style_backquotes
))
902 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
909 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
910 doc
: /* Return the suffixes that `load' should try if a suffix is \
912 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
915 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
916 while (CONSP (suffixes
))
918 Lisp_Object exts
= Vload_file_rep_suffixes
;
919 suffix
= XCAR (suffixes
);
920 suffixes
= XCDR (suffixes
);
925 lst
= Fcons (concat2 (suffix
, ext
), lst
);
928 return Fnreverse (lst
);
931 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
932 doc
: /* Execute a file of Lisp code named FILE.
933 First try FILE with `.elc' appended, then try with `.el',
934 then try FILE unmodified (the exact suffixes in the exact order are
935 determined by `load-suffixes'). Environment variable references in
936 FILE are replaced with their values by calling `substitute-in-file-name'.
937 This function searches the directories in `load-path'.
939 If optional second arg NOERROR is non-nil,
940 report no error if FILE doesn't exist.
941 Print messages at start and end of loading unless
942 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
944 If optional fourth arg NOSUFFIX is non-nil, don't try adding
945 suffixes `.elc' or `.el' to the specified name FILE.
946 If optional fifth arg MUST-SUFFIX is non-nil, insist on
947 the suffix `.elc' or `.el'; don't accept just FILE unless
948 it ends in one of those suffixes or includes a directory name.
950 If this function fails to find a file, it may look for different
951 representations of that file before trying another file.
952 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
953 to the file name. Emacs uses this feature mainly to find compressed
954 versions of files when Auto Compression mode is enabled.
956 The exact suffixes that this function tries out, in the exact order,
957 are given by the value of the variable `load-file-rep-suffixes' if
958 NOSUFFIX is non-nil and by the return value of the function
959 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
960 MUST-SUFFIX are nil, this function first tries out the latter suffixes
963 Loading a file records its definitions, and its `provide' and
964 `require' calls, in an element of `load-history' whose
965 car is the file name loaded. See `load-history'.
967 While the file is in the process of being loaded, the variable
968 `load-in-progress' is non-nil and the variable `load-file-name'
969 is bound to the file's name.
971 Return t if the file exists and loads successfully. */)
972 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
974 register FILE *stream
;
975 register int fd
= -1;
976 int count
= SPECPDL_INDEX ();
977 struct gcpro gcpro1
, gcpro2
, gcpro3
;
978 Lisp_Object found
, efound
, hist_file_name
;
979 /* 1 means we printed the ".el is newer" message. */
981 /* 1 means we are loading a compiled file. */
985 const char *fmode
= "r";
995 /* If file name is magic, call the handler. */
996 /* This shouldn't be necessary any more now that `openp' handles it right.
997 handler = Ffind_file_name_handler (file, Qload);
999 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1001 /* Do this after the handler to avoid
1002 the need to gcpro noerror, nomessage and nosuffix.
1003 (Below here, we care only whether they are nil or not.)
1004 The presence of this call is the result of a historical accident:
1005 it used to be in every file-operation and when it got removed
1006 everywhere, it accidentally stayed here. Since then, enough people
1007 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1008 that it seemed risky to remove. */
1009 if (! NILP (noerror
))
1011 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1012 Qt
, load_error_handler
);
1017 file
= Fsubstitute_in_file_name (file
);
1020 /* Avoid weird lossage with null string as arg,
1021 since it would try to load a directory as a Lisp file */
1022 if (SCHARS (file
) > 0)
1024 int size
= SBYTES (file
);
1027 GCPRO2 (file
, found
);
1029 if (! NILP (must_suffix
))
1031 /* Don't insist on adding a suffix if FILE already ends with one. */
1033 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1036 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1038 /* Don't insist on adding a suffix
1039 if the argument includes a directory name. */
1040 else if (! NILP (Ffile_name_directory (file
)))
1044 fd
= openp (Vload_path
, file
,
1045 (!NILP (nosuffix
) ? Qnil
1046 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1047 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1048 tmp
[1] = Vload_file_rep_suffixes
,
1057 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1061 /* Tell startup.el whether or not we found the user's init file. */
1062 if (EQ (Qt
, Vuser_init_file
))
1063 Vuser_init_file
= found
;
1065 /* If FD is -2, that means openp found a magic file. */
1068 if (NILP (Fequal (found
, file
)))
1069 /* If FOUND is a different file name from FILE,
1070 find its handler even if we have already inhibited
1071 the `load' operation on FILE. */
1072 handler
= Ffind_file_name_handler (found
, Qt
);
1074 handler
= Ffind_file_name_handler (found
, Qload
);
1075 if (! NILP (handler
))
1076 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1079 /* Check if we're stuck in a recursive load cycle.
1081 2000-09-21: It's not possible to just check for the file loaded
1082 being a member of Vloads_in_progress. This fails because of the
1083 way the byte compiler currently works; `provide's are not
1084 evaluated, see font-lock.el/jit-lock.el as an example. This
1085 leads to a certain amount of ``normal'' recursion.
1087 Also, just loading a file recursively is not always an error in
1088 the general case; the second load may do something different. */
1092 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1093 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1097 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1099 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1100 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1103 /* Get the name for load-history. */
1104 hist_file_name
= (! NILP (Vpurify_flag
)
1105 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1106 tmp
[1] = Ffile_name_nondirectory (found
),
1112 /* Check for the presence of old-style quotes and warn about them. */
1113 specbind (Qold_style_backquotes
, Qnil
);
1114 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1116 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1117 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1118 /* Load .elc files directly, but not when they are
1119 remote and have no handler! */
1126 GCPRO3 (file
, found
, hist_file_name
);
1129 && ! (version
= safe_to_load_p (fd
)))
1132 if (!load_dangerous_libraries
)
1136 error ("File `%s' was not compiled in Emacs",
1139 else if (!NILP (nomessage
) && !force_load_messages
)
1140 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1145 efound
= ENCODE_FILE (found
);
1150 stat ((char *)SDATA (efound
), &s1
);
1151 SSET (efound
, SBYTES (efound
) - 1, 0);
1152 result
= stat ((char *)SDATA (efound
), &s2
);
1153 SSET (efound
, SBYTES (efound
) - 1, 'c');
1155 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1157 /* Make the progress messages mention that source is newer. */
1160 /* If we won't print another message, mention this anyway. */
1161 if (!NILP (nomessage
) && !force_load_messages
)
1163 Lisp_Object msg_file
;
1164 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1165 message_with_string ("Source file `%s' newer than byte-compiled file",
1174 /* We are loading a source file (*.el). */
1175 if (!NILP (Vload_source_file_function
))
1181 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1182 NILP (noerror
) ? Qnil
: Qt
,
1183 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1184 return unbind_to (count
, val
);
1188 GCPRO3 (file
, found
, hist_file_name
);
1192 efound
= ENCODE_FILE (found
);
1193 stream
= fopen ((char *) SDATA (efound
), fmode
);
1194 #else /* not WINDOWSNT */
1195 stream
= fdopen (fd
, fmode
);
1196 #endif /* not WINDOWSNT */
1200 error ("Failure to create stdio stream for %s", SDATA (file
));
1203 if (! NILP (Vpurify_flag
))
1204 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1206 if (NILP (nomessage
) || force_load_messages
)
1209 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1212 message_with_string ("Loading %s (source)...", file
, 1);
1214 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1216 else /* The typical case; compiled file newer than source file. */
1217 message_with_string ("Loading %s...", file
, 1);
1220 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1221 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1222 specbind (Qload_file_name
, found
);
1223 specbind (Qinhibit_file_name_operation
, Qnil
);
1224 load_descriptor_list
1225 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1226 specbind (Qload_in_progress
, Qt
);
1227 if (! version
|| version
>= 22)
1228 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1229 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1232 /* We can't handle a file which was compiled with
1233 byte-compile-dynamic by older version of Emacs. */
1234 specbind (Qload_force_doc_strings
, Qt
);
1235 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1236 0, Qnil
, Qnil
, Qnil
, Qnil
);
1238 unbind_to (count
, Qnil
);
1240 /* Run any eval-after-load forms for this file */
1241 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1242 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1246 xfree (saved_doc_string
);
1247 saved_doc_string
= 0;
1248 saved_doc_string_size
= 0;
1250 xfree (prev_saved_doc_string
);
1251 prev_saved_doc_string
= 0;
1252 prev_saved_doc_string_size
= 0;
1254 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1257 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1260 message_with_string ("Loading %s (source)...done", file
, 1);
1262 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1264 else /* The typical case; compiled file newer than source file. */
1265 message_with_string ("Loading %s...done", file
, 1);
1272 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1274 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1285 load_descriptor_unwind (Lisp_Object oldlist
)
1287 load_descriptor_list
= oldlist
;
1291 /* Close all descriptors in use for Floads.
1292 This is used when starting a subprocess. */
1295 close_load_descs (void)
1299 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1300 emacs_close (XFASTINT (XCAR (tail
)));
1305 complete_filename_p (Lisp_Object pathname
)
1307 register const unsigned char *s
= SDATA (pathname
);
1308 return (IS_DIRECTORY_SEP (s
[0])
1309 || (SCHARS (pathname
) > 2
1310 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1313 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1314 doc
: /* Search for FILENAME through PATH.
1315 Returns the file's name in absolute form, or nil if not found.
1316 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1317 file name when searching.
1318 If non-nil, PREDICATE is used instead of `file-readable-p'.
1319 PREDICATE can also be an integer to pass to the access(2) function,
1320 in which case file-name-handlers are ignored. */)
1321 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1324 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1325 if (NILP (predicate
) && fd
> 0)
1331 /* Search for a file whose name is STR, looking in directories
1332 in the Lisp list PATH, and trying suffixes from SUFFIX.
1333 On success, returns a file descriptor. On failure, returns -1.
1335 SUFFIXES is a list of strings containing possible suffixes.
1336 The empty suffix is automatically added if the list is empty.
1338 PREDICATE non-nil means don't open the files,
1339 just look for one that satisfies the predicate. In this case,
1340 returns 1 on success. The predicate can be a lisp function or
1341 an integer to pass to `access' (in which case file-name-handlers
1344 If STOREPTR is nonzero, it points to a slot where the name of
1345 the file actually found should be stored as a Lisp string.
1346 nil is stored there on failure.
1348 If the file we find is remote, return -2
1349 but store the found remote file name in *STOREPTR. */
1352 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1357 register char *fn
= buf
;
1360 Lisp_Object filename
;
1362 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1363 Lisp_Object string
, tail
, encoded_fn
;
1364 int max_suffix_len
= 0;
1368 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1370 CHECK_STRING_CAR (tail
);
1371 max_suffix_len
= max (max_suffix_len
,
1372 SBYTES (XCAR (tail
)));
1375 string
= filename
= encoded_fn
= Qnil
;
1376 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1381 if (complete_filename_p (str
))
1384 for (; CONSP (path
); path
= XCDR (path
))
1386 filename
= Fexpand_file_name (str
, XCAR (path
));
1387 if (!complete_filename_p (filename
))
1388 /* If there are non-absolute elts in PATH (eg ".") */
1389 /* Of course, this could conceivably lose if luser sets
1390 default-directory to be something non-absolute... */
1392 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1393 if (!complete_filename_p (filename
))
1394 /* Give up on this path element! */
1398 /* Calculate maximum size of any filename made from
1399 this path element/specified file name and any possible suffix. */
1400 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1401 if (fn_size
< want_size
)
1402 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1404 /* Loop over suffixes. */
1405 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1406 CONSP (tail
); tail
= XCDR (tail
))
1408 int lsuffix
= SBYTES (XCAR (tail
));
1409 Lisp_Object handler
;
1412 /* Concatenate path element/specified name with the suffix.
1413 If the directory starts with /:, remove that. */
1414 if (SCHARS (filename
) > 2
1415 && SREF (filename
, 0) == '/'
1416 && SREF (filename
, 1) == ':')
1418 strncpy (fn
, SDATA (filename
) + 2,
1419 SBYTES (filename
) - 2);
1420 fn
[SBYTES (filename
) - 2] = 0;
1424 strncpy (fn
, SDATA (filename
),
1426 fn
[SBYTES (filename
)] = 0;
1429 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1430 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1432 /* Check that the file exists and is not a directory. */
1433 /* We used to only check for handlers on non-absolute file names:
1437 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1438 It's not clear why that was the case and it breaks things like
1439 (load "/bar.el") where the file is actually "/bar.el.gz". */
1440 string
= build_string (fn
);
1441 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1442 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1444 if (NILP (predicate
))
1445 exists
= !NILP (Ffile_readable_p (string
));
1447 exists
= !NILP (call1 (predicate
, string
));
1448 if (exists
&& !NILP (Ffile_directory_p (string
)))
1453 /* We succeeded; return this descriptor and filename. */
1464 encoded_fn
= ENCODE_FILE (string
);
1465 pfn
= SDATA (encoded_fn
);
1466 exists
= (stat (pfn
, &st
) >= 0
1467 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1470 /* Check that we can access or open it. */
1471 if (NATNUMP (predicate
))
1472 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1474 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1478 /* We succeeded; return this descriptor and filename. */
1496 /* Merge the list we've accumulated of globals from the current input source
1497 into the load_history variable. The details depend on whether
1498 the source has an associated file name or not.
1500 FILENAME is the file name that we are loading from.
1501 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1504 build_load_history (Lisp_Object filename
, int entire
)
1506 register Lisp_Object tail
, prev
, newelt
;
1507 register Lisp_Object tem
, tem2
;
1508 register int foundit
= 0;
1510 tail
= Vload_history
;
1513 while (CONSP (tail
))
1517 /* Find the feature's previous assoc list... */
1518 if (!NILP (Fequal (filename
, Fcar (tem
))))
1522 /* If we're loading the entire file, remove old data. */
1526 Vload_history
= XCDR (tail
);
1528 Fsetcdr (prev
, XCDR (tail
));
1531 /* Otherwise, cons on new symbols that are not already members. */
1534 tem2
= Vcurrent_load_list
;
1536 while (CONSP (tem2
))
1538 newelt
= XCAR (tem2
);
1540 if (NILP (Fmember (newelt
, tem
)))
1541 Fsetcar (tail
, Fcons (XCAR (tem
),
1542 Fcons (newelt
, XCDR (tem
))));
1555 /* If we're loading an entire file, cons the new assoc onto the
1556 front of load-history, the most-recently-loaded position. Also
1557 do this if we didn't find an existing member for the file. */
1558 if (entire
|| !foundit
)
1559 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1564 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1571 readevalloop_1 (Lisp_Object old
)
1573 load_convert_to_unibyte
= ! NILP (old
);
1577 /* Signal an `end-of-file' error, if possible with file name
1581 end_of_file_error (void)
1583 if (STRINGP (Vload_file_name
))
1584 xsignal1 (Qend_of_file
, Vload_file_name
);
1586 xsignal0 (Qend_of_file
);
1589 /* UNIBYTE specifies how to set load_convert_to_unibyte
1590 for this invocation.
1591 READFUN, if non-nil, is used instead of `read'.
1593 START, END specify region to read in current buffer (from eval-region).
1594 If the input is not from a buffer, they must be nil. */
1597 readevalloop (Lisp_Object readcharfun
,
1599 Lisp_Object sourcename
,
1600 Lisp_Object (*evalfun
) (Lisp_Object
),
1602 Lisp_Object unibyte
, Lisp_Object readfun
,
1603 Lisp_Object start
, Lisp_Object end
)
1606 register Lisp_Object val
;
1607 int count
= SPECPDL_INDEX ();
1608 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1609 struct buffer
*b
= 0;
1610 int continue_reading_p
;
1611 /* Nonzero if reading an entire buffer. */
1612 int whole_buffer
= 0;
1613 /* 1 on the first time around. */
1616 if (MARKERP (readcharfun
))
1619 start
= readcharfun
;
1622 if (BUFFERP (readcharfun
))
1623 b
= XBUFFER (readcharfun
);
1624 else if (MARKERP (readcharfun
))
1625 b
= XMARKER (readcharfun
)->buffer
;
1627 /* We assume START is nil when input is not from a buffer. */
1628 if (! NILP (start
) && !b
)
1631 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1632 specbind (Qcurrent_load_list
, Qnil
);
1633 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1634 load_convert_to_unibyte
= !NILP (unibyte
);
1636 GCPRO4 (sourcename
, readfun
, start
, end
);
1638 /* Try to ensure sourcename is a truename, except whilst preloading. */
1639 if (NILP (Vpurify_flag
)
1640 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1641 && !NILP (Ffboundp (Qfile_truename
)))
1642 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1644 LOADHIST_ATTACH (sourcename
);
1646 continue_reading_p
= 1;
1647 while (continue_reading_p
)
1649 int count1
= SPECPDL_INDEX ();
1651 if (b
!= 0 && NILP (b
->name
))
1652 error ("Reading from killed buffer");
1656 /* Switch to the buffer we are reading from. */
1657 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1658 set_buffer_internal (b
);
1660 /* Save point in it. */
1661 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1662 /* Save ZV in it. */
1663 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1664 /* Those get unbound after we read one expression. */
1666 /* Set point and ZV around stuff to be read. */
1669 Fnarrow_to_region (make_number (BEGV
), end
);
1671 /* Just for cleanliness, convert END to a marker
1672 if it is an integer. */
1674 end
= Fpoint_max_marker ();
1677 /* On the first cycle, we can easily test here
1678 whether we are reading the whole buffer. */
1679 if (b
&& first_sexp
)
1680 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1687 while ((c
= READCHAR
) != '\n' && c
!= -1);
1692 unbind_to (count1
, Qnil
);
1696 /* Ignore whitespace here, so we can detect eof. */
1697 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1698 || c
== 0x8a0) /* NBSP */
1701 if (!NILP (Vpurify_flag
) && c
== '(')
1703 record_unwind_protect (unreadpure
, Qnil
);
1704 val
= read_list (-1, readcharfun
);
1709 read_objects
= Qnil
;
1710 if (!NILP (readfun
))
1712 val
= call1 (readfun
, readcharfun
);
1714 /* If READCHARFUN has set point to ZV, we should
1715 stop reading, even if the form read sets point
1716 to a different value when evaluated. */
1717 if (BUFFERP (readcharfun
))
1719 struct buffer
*b
= XBUFFER (readcharfun
);
1720 if (BUF_PT (b
) == BUF_ZV (b
))
1721 continue_reading_p
= 0;
1724 else if (! NILP (Vload_read_function
))
1725 val
= call1 (Vload_read_function
, readcharfun
);
1727 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1730 if (!NILP (start
) && continue_reading_p
)
1731 start
= Fpoint_marker ();
1733 /* Restore saved point and BEGV. */
1734 unbind_to (count1
, Qnil
);
1736 /* Now eval what we just read. */
1737 val
= (*evalfun
) (val
);
1741 Vvalues
= Fcons (val
, Vvalues
);
1742 if (EQ (Vstandard_output
, Qt
))
1751 build_load_history (sourcename
,
1752 stream
|| whole_buffer
);
1756 unbind_to (count
, Qnil
);
1759 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1760 doc
: /* Execute the current buffer as Lisp code.
1761 When called from a Lisp program (i.e., not interactively), this
1762 function accepts up to five optional arguments:
1763 BUFFER is the buffer to evaluate (nil means use current buffer).
1764 PRINTFLAG controls printing of output:
1765 A value of nil means discard it; anything else is stream for print.
1766 FILENAME specifies the file name to use for `load-history'.
1767 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1769 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1770 functions should work normally even if PRINTFLAG is nil.
1772 This function preserves the position of point. */)
1773 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1775 int count
= SPECPDL_INDEX ();
1776 Lisp_Object tem
, buf
;
1779 buf
= Fcurrent_buffer ();
1781 buf
= Fget_buffer (buffer
);
1783 error ("No such buffer");
1785 if (NILP (printflag
) && NILP (do_allow_print
))
1790 if (NILP (filename
))
1791 filename
= XBUFFER (buf
)->filename
;
1793 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1794 specbind (Qstandard_output
, tem
);
1795 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1796 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1797 readevalloop (buf
, 0, filename
, Feval
,
1798 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1799 unbind_to (count
, Qnil
);
1804 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1805 doc
: /* Execute the region as Lisp code.
1806 When called from programs, expects two arguments,
1807 giving starting and ending indices in the current buffer
1808 of the text to be executed.
1809 Programs can pass third argument PRINTFLAG which controls output:
1810 A value of nil means discard it; anything else is stream for printing it.
1811 Also the fourth argument READ-FUNCTION, if non-nil, is used
1812 instead of `read' to read each expression. It gets one argument
1813 which is the input stream for reading characters.
1815 This function does not move point. */)
1816 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1818 int count
= SPECPDL_INDEX ();
1819 Lisp_Object tem
, cbuf
;
1821 cbuf
= Fcurrent_buffer ();
1823 if (NILP (printflag
))
1827 specbind (Qstandard_output
, tem
);
1828 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1830 /* readevalloop calls functions which check the type of start and end. */
1831 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1832 !NILP (printflag
), Qnil
, read_function
,
1835 return unbind_to (count
, Qnil
);
1839 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1840 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1841 If STREAM is nil, use the value of `standard-input' (which see).
1842 STREAM or the value of `standard-input' may be:
1843 a buffer (read from point and advance it)
1844 a marker (read from where it points and advance it)
1845 a function (call it with no arguments for each character,
1846 call it with a char as argument to push a char back)
1847 a string (takes text from string, starting at the beginning)
1848 t (read text line using minibuffer and use it, or read from
1849 standard input in batch mode). */)
1850 (Lisp_Object stream
)
1853 stream
= Vstandard_input
;
1854 if (EQ (stream
, Qt
))
1855 stream
= Qread_char
;
1856 if (EQ (stream
, Qread_char
))
1857 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1859 return read_internal_start (stream
, Qnil
, Qnil
);
1862 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1863 doc
: /* Read one Lisp expression which is represented as text by STRING.
1864 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1865 START and END optionally delimit a substring of STRING from which to read;
1866 they default to 0 and (length STRING) respectively. */)
1867 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1870 CHECK_STRING (string
);
1871 /* read_internal_start sets read_from_string_index. */
1872 ret
= read_internal_start (string
, start
, end
);
1873 return Fcons (ret
, make_number (read_from_string_index
));
1876 /* Function to set up the global context we need in toplevel read
1879 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1880 /* start, end only used when stream is a string. */
1885 new_backquote_flag
= 0;
1886 read_objects
= Qnil
;
1887 if (EQ (Vread_with_symbol_positions
, Qt
)
1888 || EQ (Vread_with_symbol_positions
, stream
))
1889 Vread_symbol_positions_list
= Qnil
;
1891 if (STRINGP (stream
)
1892 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1894 EMACS_INT startval
, endval
;
1897 if (STRINGP (stream
))
1900 string
= XCAR (stream
);
1903 endval
= SCHARS (string
);
1907 endval
= XINT (end
);
1908 if (endval
< 0 || endval
> SCHARS (string
))
1909 args_out_of_range (string
, end
);
1916 CHECK_NUMBER (start
);
1917 startval
= XINT (start
);
1918 if (startval
< 0 || startval
> endval
)
1919 args_out_of_range (string
, start
);
1921 read_from_string_index
= startval
;
1922 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1923 read_from_string_limit
= endval
;
1926 retval
= read0 (stream
);
1927 if (EQ (Vread_with_symbol_positions
, Qt
)
1928 || EQ (Vread_with_symbol_positions
, stream
))
1929 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1934 /* Signal Qinvalid_read_syntax error.
1935 S is error string of length N (if > 0) */
1938 invalid_syntax (const char *s
, int n
)
1942 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1946 /* Use this for recursive reads, in contexts where internal tokens
1950 read0 (Lisp_Object readcharfun
)
1952 register Lisp_Object val
;
1955 val
= read1 (readcharfun
, &c
, 0);
1959 xsignal1 (Qinvalid_read_syntax
,
1960 Fmake_string (make_number (1), make_number (c
)));
1963 static int read_buffer_size
;
1964 static char *read_buffer
;
1966 /* Read a \-escape sequence, assuming we already read the `\'.
1967 If the escape sequence forces unibyte, return eight-bit char. */
1970 read_escape (Lisp_Object readcharfun
, int stringp
)
1972 register int c
= READCHAR
;
1973 /* \u allows up to four hex digits, \U up to eight. Default to the
1974 behavior for \u, and change this value in the case that \U is seen. */
1975 int unicode_hex_count
= 4;
1980 end_of_file_error ();
2010 error ("Invalid escape character syntax");
2013 c
= read_escape (readcharfun
, 0);
2014 return c
| meta_modifier
;
2019 error ("Invalid escape character syntax");
2022 c
= read_escape (readcharfun
, 0);
2023 return c
| shift_modifier
;
2028 error ("Invalid escape character syntax");
2031 c
= read_escape (readcharfun
, 0);
2032 return c
| hyper_modifier
;
2037 error ("Invalid escape character syntax");
2040 c
= read_escape (readcharfun
, 0);
2041 return c
| alt_modifier
;
2045 if (stringp
|| c
!= '-')
2052 c
= read_escape (readcharfun
, 0);
2053 return c
| super_modifier
;
2058 error ("Invalid escape character syntax");
2062 c
= read_escape (readcharfun
, 0);
2063 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2064 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2065 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2066 return c
| ctrl_modifier
;
2067 /* ASCII control chars are made from letters (both cases),
2068 as well as the non-letters within 0100...0137. */
2069 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2070 return (c
& (037 | ~0177));
2071 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2072 return (c
& (037 | ~0177));
2074 return c
| ctrl_modifier
;
2084 /* An octal escape, as in ANSI C. */
2086 register int i
= c
- '0';
2087 register int count
= 0;
2090 if ((c
= READCHAR
) >= '0' && c
<= '7')
2102 if (i
>= 0x80 && i
< 0x100)
2103 i
= BYTE8_TO_CHAR (i
);
2108 /* A hex escape, as in ANSI C. */
2115 if (c
>= '0' && c
<= '9')
2120 else if ((c
>= 'a' && c
<= 'f')
2121 || (c
>= 'A' && c
<= 'F'))
2124 if (c
>= 'a' && c
<= 'f')
2137 if (count
< 3 && i
>= 0x80)
2138 return BYTE8_TO_CHAR (i
);
2143 /* Post-Unicode-2.0: Up to eight hex chars. */
2144 unicode_hex_count
= 8;
2147 /* A Unicode escape. We only permit them in strings and characters,
2148 not arbitrarily in the source code, as in some other languages. */
2153 while (++count
<= unicode_hex_count
)
2156 /* isdigit and isalpha may be locale-specific, which we don't
2158 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2159 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2160 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2163 error ("Non-hex digit used for Unicode escape");
2168 error ("Non-Unicode character: 0x%x", i
);
2177 /* Read an integer in radix RADIX using READCHARFUN to read
2178 characters. RADIX must be in the interval [2..36]; if it isn't, a
2179 read error is signaled . Value is the integer read. Signals an
2180 error if encountering invalid read syntax or if RADIX is out of
2184 read_integer (Lisp_Object readcharfun
, int radix
)
2186 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2187 /* We use a floating point number because */
2190 if (radix
< 2 || radix
> 36)
2194 number
= ndigits
= invalid_p
= 0;
2210 if (c
>= '0' && c
<= '9')
2212 else if (c
>= 'a' && c
<= 'z')
2213 digit
= c
- 'a' + 10;
2214 else if (c
>= 'A' && c
<= 'Z')
2215 digit
= c
- 'A' + 10;
2222 if (digit
< 0 || digit
>= radix
)
2225 number
= radix
* number
+ digit
;
2231 if (ndigits
== 0 || invalid_p
)
2234 sprintf (buf
, "integer, radix %d", radix
);
2235 invalid_syntax (buf
, 0);
2238 return make_fixnum_or_float (sign
* number
);
2242 /* If the next token is ')' or ']' or '.', we store that character
2243 in *PCH and the return value is not interesting. Else, we store
2244 zero in *PCH and we read and return one lisp object.
2246 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2249 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2252 int uninterned_symbol
= 0;
2260 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2262 end_of_file_error ();
2267 return read_list (0, readcharfun
);
2270 return read_vector (readcharfun
, 0);
2286 /* Accept extended format for hashtables (extensible to
2288 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2289 Lisp_Object tmp
= read_list (0, readcharfun
);
2290 Lisp_Object head
= CAR_SAFE (tmp
);
2291 Lisp_Object data
= Qnil
;
2292 Lisp_Object val
= Qnil
;
2293 /* The size is 2 * number of allowed keywords to
2295 Lisp_Object params
[10];
2297 Lisp_Object key
= Qnil
;
2298 int param_count
= 0;
2300 if (!EQ (head
, Qhash_table
))
2301 error ("Invalid extended read marker at head of #s list "
2302 "(only hash-table allowed)");
2304 tmp
= CDR_SAFE (tmp
);
2306 /* This is repetitive but fast and simple. */
2307 params
[param_count
] = QCsize
;
2308 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2309 if (!NILP (params
[param_count
+ 1]))
2312 params
[param_count
] = QCtest
;
2313 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2314 if (!NILP (params
[param_count
+ 1]))
2317 params
[param_count
] = QCweakness
;
2318 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2319 if (!NILP (params
[param_count
+ 1]))
2322 params
[param_count
] = QCrehash_size
;
2323 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2324 if (!NILP (params
[param_count
+ 1]))
2327 params
[param_count
] = QCrehash_threshold
;
2328 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2329 if (!NILP (params
[param_count
+ 1]))
2332 /* This is the hashtable data. */
2333 data
= Fplist_get (tmp
, Qdata
);
2335 /* Now use params to make a new hashtable and fill it. */
2336 ht
= Fmake_hash_table (param_count
, params
);
2338 while (CONSP (data
))
2343 error ("Odd number of elements in hashtable data");
2346 Fputhash (key
, val
, ht
);
2352 invalid_syntax ("#", 1);
2360 tmp
= read_vector (readcharfun
, 0);
2361 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2362 error ("Invalid size char-table");
2363 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2374 tmp
= read_vector (readcharfun
, 0);
2375 if (!INTEGERP (AREF (tmp
, 0)))
2376 error ("Invalid depth in char-table");
2377 depth
= XINT (AREF (tmp
, 0));
2378 if (depth
< 1 || depth
> 3)
2379 error ("Invalid depth in char-table");
2380 size
= XVECTOR (tmp
)->size
- 2;
2381 if (chartab_size
[depth
] != size
)
2382 error ("Invalid size char-table");
2383 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2386 invalid_syntax ("#^^", 3);
2388 invalid_syntax ("#^", 2);
2393 length
= read1 (readcharfun
, pch
, first_in_list
);
2397 Lisp_Object tmp
, val
;
2399 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2400 / BOOL_VECTOR_BITS_PER_CHAR
);
2403 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2404 if (STRING_MULTIBYTE (tmp
)
2405 || (size_in_chars
!= SCHARS (tmp
)
2406 /* We used to print 1 char too many
2407 when the number of bits was a multiple of 8.
2408 Accept such input in case it came from an old
2410 && ! (XFASTINT (length
)
2411 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2412 invalid_syntax ("#&...", 5);
2414 val
= Fmake_bool_vector (length
, Qnil
);
2415 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2416 /* Clear the extraneous bits in the last byte. */
2417 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2418 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2419 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2422 invalid_syntax ("#&...", 5);
2426 /* Accept compiled functions at read-time so that we don't have to
2427 build them using function calls. */
2429 tmp
= read_vector (readcharfun
, 1);
2430 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2431 XVECTOR (tmp
)->contents
);
2436 struct gcpro gcpro1
;
2439 /* Read the string itself. */
2440 tmp
= read1 (readcharfun
, &ch
, 0);
2441 if (ch
!= 0 || !STRINGP (tmp
))
2442 invalid_syntax ("#", 1);
2444 /* Read the intervals and their properties. */
2447 Lisp_Object beg
, end
, plist
;
2449 beg
= read1 (readcharfun
, &ch
, 0);
2454 end
= read1 (readcharfun
, &ch
, 0);
2456 plist
= read1 (readcharfun
, &ch
, 0);
2458 invalid_syntax ("Invalid string property list", 0);
2459 Fset_text_properties (beg
, end
, plist
, tmp
);
2465 /* #@NUMBER is used to skip NUMBER following characters.
2466 That's used in .elc files to skip over doc strings
2467 and function definitions. */
2473 /* Read a decimal integer. */
2474 while ((c
= READCHAR
) >= 0
2475 && c
>= '0' && c
<= '9')
2483 if (load_force_doc_strings
2484 && (EQ (readcharfun
, Qget_file_char
)
2485 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2487 /* If we are supposed to force doc strings into core right now,
2488 record the last string that we skipped,
2489 and record where in the file it comes from. */
2491 /* But first exchange saved_doc_string
2492 with prev_saved_doc_string, so we save two strings. */
2494 char *temp
= saved_doc_string
;
2495 int temp_size
= saved_doc_string_size
;
2496 file_offset temp_pos
= saved_doc_string_position
;
2497 int temp_len
= saved_doc_string_length
;
2499 saved_doc_string
= prev_saved_doc_string
;
2500 saved_doc_string_size
= prev_saved_doc_string_size
;
2501 saved_doc_string_position
= prev_saved_doc_string_position
;
2502 saved_doc_string_length
= prev_saved_doc_string_length
;
2504 prev_saved_doc_string
= temp
;
2505 prev_saved_doc_string_size
= temp_size
;
2506 prev_saved_doc_string_position
= temp_pos
;
2507 prev_saved_doc_string_length
= temp_len
;
2510 if (saved_doc_string_size
== 0)
2512 saved_doc_string_size
= nskip
+ 100;
2513 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2515 if (nskip
> saved_doc_string_size
)
2517 saved_doc_string_size
= nskip
+ 100;
2518 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2519 saved_doc_string_size
);
2522 saved_doc_string_position
= file_tell (instream
);
2524 /* Copy that many characters into saved_doc_string. */
2525 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2526 saved_doc_string
[i
] = c
= READCHAR
;
2528 saved_doc_string_length
= i
;
2532 /* Skip that many characters. */
2533 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2542 /* #! appears at the beginning of an executable file.
2543 Skip the first line. */
2544 while (c
!= '\n' && c
>= 0)
2549 return Vload_file_name
;
2551 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2552 /* #:foo is the uninterned symbol named foo. */
2555 uninterned_symbol
= 1;
2559 /* Reader forms that can reuse previously read objects. */
2560 if (c
>= '0' && c
<= '9')
2565 /* Read a non-negative integer. */
2566 while (c
>= '0' && c
<= '9')
2572 /* #n=object returns object, but associates it with n for #n#. */
2573 if (c
== '=' && !NILP (Vread_circle
))
2575 /* Make a placeholder for #n# to use temporarily */
2576 Lisp_Object placeholder
;
2579 placeholder
= Fcons (Qnil
, Qnil
);
2580 cell
= Fcons (make_number (n
), placeholder
);
2581 read_objects
= Fcons (cell
, read_objects
);
2583 /* Read the object itself. */
2584 tem
= read0 (readcharfun
);
2586 /* Now put it everywhere the placeholder was... */
2587 substitute_object_in_subtree (tem
, placeholder
);
2589 /* ...and #n# will use the real value from now on. */
2590 Fsetcdr (cell
, tem
);
2594 /* #n# returns a previously read object. */
2595 if (c
== '#' && !NILP (Vread_circle
))
2597 tem
= Fassq (make_number (n
), read_objects
);
2600 /* Fall through to error message. */
2602 else if (c
== 'r' || c
== 'R')
2603 return read_integer (readcharfun
, n
);
2605 /* Fall through to error message. */
2607 else if (c
== 'x' || c
== 'X')
2608 return read_integer (readcharfun
, 16);
2609 else if (c
== 'o' || c
== 'O')
2610 return read_integer (readcharfun
, 8);
2611 else if (c
== 'b' || c
== 'B')
2612 return read_integer (readcharfun
, 2);
2615 invalid_syntax ("#", 1);
2618 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2623 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2628 int next_char
= READCHAR
;
2630 /* Transition from old-style to new-style:
2631 If we see "(`" it used to mean old-style, which usually works
2632 fine because ` should almost never appear in such a position
2633 for new-style. But occasionally we need "(`" to mean new
2634 style, so we try to distinguish the two by the fact that we
2635 can either write "( `foo" or "(` foo", where the first
2636 intends to use new-style whereas the second intends to use
2637 old-style. For Emacs-25, we should completely remove this
2638 first_in_list exception (old-style can still be obtained via
2640 if (first_in_list
&& next_char
== ' ')
2642 Vold_style_backquotes
= Qt
;
2649 new_backquote_flag
++;
2650 value
= read0 (readcharfun
);
2651 new_backquote_flag
--;
2653 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2657 if (new_backquote_flag
)
2659 Lisp_Object comma_type
= Qnil
;
2664 comma_type
= Qcomma_at
;
2666 comma_type
= Qcomma_dot
;
2669 if (ch
>= 0) UNREAD (ch
);
2670 comma_type
= Qcomma
;
2673 new_backquote_flag
--;
2674 value
= read0 (readcharfun
);
2675 new_backquote_flag
++;
2676 return Fcons (comma_type
, Fcons (value
, Qnil
));
2680 Vold_style_backquotes
= Qt
;
2692 end_of_file_error ();
2694 /* Accept `single space' syntax like (list ? x) where the
2695 whitespace character is SPC or TAB.
2696 Other literal whitespace like NL, CR, and FF are not accepted,
2697 as there are well-established escape sequences for these. */
2698 if (c
== ' ' || c
== '\t')
2699 return make_number (c
);
2702 c
= read_escape (readcharfun
, 0);
2703 modifiers
= c
& CHAR_MODIFIER_MASK
;
2704 c
&= ~CHAR_MODIFIER_MASK
;
2705 if (CHAR_BYTE8_P (c
))
2706 c
= CHAR_TO_BYTE8 (c
);
2709 next_char
= READCHAR
;
2710 if (next_char
== '.')
2712 /* Only a dotted-pair dot is valid after a char constant. */
2713 int next_next_char
= READCHAR
;
2714 UNREAD (next_next_char
);
2716 ok
= (next_next_char
<= 040
2717 || (next_next_char
< 0200
2718 && (strchr ("\"';([#?", next_next_char
)
2719 || (!first_in_list
&& next_next_char
== '`')
2720 || (new_backquote_flag
&& next_next_char
== ','))));
2724 ok
= (next_char
<= 040
2725 || (next_char
< 0200
2726 && (strchr ("\"';()[]#?", next_char
)
2727 || (!first_in_list
&& next_char
== '`')
2728 || (new_backquote_flag
&& next_char
== ','))));
2732 return make_number (c
);
2734 invalid_syntax ("?", 1);
2739 char *p
= read_buffer
;
2740 char *end
= read_buffer
+ read_buffer_size
;
2742 /* Nonzero if we saw an escape sequence specifying
2743 a multibyte character. */
2744 int force_multibyte
= 0;
2745 /* Nonzero if we saw an escape sequence specifying
2746 a single-byte character. */
2747 int force_singlebyte
= 0;
2751 while ((c
= READCHAR
) >= 0
2754 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2756 int offset
= p
- read_buffer
;
2757 read_buffer
= (char *) xrealloc (read_buffer
,
2758 read_buffer_size
*= 2);
2759 p
= read_buffer
+ offset
;
2760 end
= read_buffer
+ read_buffer_size
;
2767 c
= read_escape (readcharfun
, 1);
2769 /* C is -1 if \ newline has just been seen */
2772 if (p
== read_buffer
)
2777 modifiers
= c
& CHAR_MODIFIER_MASK
;
2778 c
= c
& ~CHAR_MODIFIER_MASK
;
2780 if (CHAR_BYTE8_P (c
))
2781 force_singlebyte
= 1;
2782 else if (! ASCII_CHAR_P (c
))
2783 force_multibyte
= 1;
2784 else /* i.e. ASCII_CHAR_P (c) */
2786 /* Allow `\C- ' and `\C-?'. */
2787 if (modifiers
== CHAR_CTL
)
2790 c
= 0, modifiers
= 0;
2792 c
= 127, modifiers
= 0;
2794 if (modifiers
& CHAR_SHIFT
)
2796 /* Shift modifier is valid only with [A-Za-z]. */
2797 if (c
>= 'A' && c
<= 'Z')
2798 modifiers
&= ~CHAR_SHIFT
;
2799 else if (c
>= 'a' && c
<= 'z')
2800 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2803 if (modifiers
& CHAR_META
)
2805 /* Move the meta bit to the right place for a
2807 modifiers
&= ~CHAR_META
;
2808 c
= BYTE8_TO_CHAR (c
| 0x80);
2809 force_singlebyte
= 1;
2813 /* Any modifiers remaining are invalid. */
2815 error ("Invalid modifier in string");
2816 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2820 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2821 if (CHAR_BYTE8_P (c
))
2822 force_singlebyte
= 1;
2823 else if (! ASCII_CHAR_P (c
))
2824 force_multibyte
= 1;
2830 end_of_file_error ();
2832 /* If purifying, and string starts with \ newline,
2833 return zero instead. This is for doc strings
2834 that we are really going to find in etc/DOC.nn.nn */
2835 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2836 return make_number (0);
2838 if (force_multibyte
)
2839 /* READ_BUFFER already contains valid multibyte forms. */
2841 else if (force_singlebyte
)
2843 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2844 p
= read_buffer
+ nchars
;
2847 /* Otherwise, READ_BUFFER contains only ASCII. */
2850 /* We want readchar_count to be the number of characters, not
2851 bytes. Hence we adjust for multibyte characters in the
2852 string. ... But it doesn't seem to be necessary, because
2853 READCHAR *does* read multibyte characters from buffers. */
2854 /* readchar_count -= (p - read_buffer) - nchars; */
2856 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2858 || (p
- read_buffer
!= nchars
)));
2859 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2861 || (p
- read_buffer
!= nchars
)));
2866 int next_char
= READCHAR
;
2869 if (next_char
<= 040
2870 || (next_char
< 0200
2871 && (strchr ("\"';([#?", next_char
)
2872 || (!first_in_list
&& next_char
== '`')
2873 || (new_backquote_flag
&& next_char
== ','))))
2879 /* Otherwise, we fall through! Note that the atom-reading loop
2880 below will now loop at least once, assuring that we will not
2881 try to UNREAD two characters in a row. */
2885 if (c
<= 040) goto retry
;
2886 if (c
== 0x8a0) /* NBSP */
2889 char *p
= read_buffer
;
2893 char *end
= read_buffer
+ read_buffer_size
;
2896 && c
!= 0x8a0 /* NBSP */
2898 || (!strchr ("\"';()[]#", c
)
2899 && !(!first_in_list
&& c
== '`')
2900 && !(new_backquote_flag
&& c
== ','))))
2902 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2904 int offset
= p
- read_buffer
;
2905 read_buffer
= (char *) xrealloc (read_buffer
,
2906 read_buffer_size
*= 2);
2907 p
= read_buffer
+ offset
;
2908 end
= read_buffer
+ read_buffer_size
;
2915 end_of_file_error ();
2920 p
+= CHAR_STRING (c
, p
);
2928 int offset
= p
- read_buffer
;
2929 read_buffer
= (char *) xrealloc (read_buffer
,
2930 read_buffer_size
*= 2);
2931 p
= read_buffer
+ offset
;
2932 end
= read_buffer
+ read_buffer_size
;
2939 if (!quoted
&& !uninterned_symbol
)
2943 if (*p1
== '+' || *p1
== '-') p1
++;
2944 /* Is it an integer? */
2947 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2948 /* Integers can have trailing decimal points. */
2949 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2951 /* It is an integer. */
2956 /* EMACS_INT n = atol (read_buffer); */
2957 char *endptr
= NULL
;
2958 EMACS_INT n
= (errno
= 0,
2959 strtol (read_buffer
, &endptr
, 10));
2960 if (errno
== ERANGE
&& endptr
)
2963 = Fcons (make_string (read_buffer
,
2964 endptr
- read_buffer
),
2966 xsignal (Qoverflow_error
, args
);
2968 return make_fixnum_or_float (n
);
2972 if (isfloat_string (read_buffer
, 0))
2974 /* Compute NaN and infinities using 0.0 in a variable,
2975 to cope with compilers that think they are smarter
2981 /* Negate the value ourselves. This treats 0, NaNs,
2982 and infinity properly on IEEE floating point hosts,
2983 and works around a common bug where atof ("-0.0")
2985 int negative
= read_buffer
[0] == '-';
2987 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2988 returns 1, is if the input ends in e+INF or e+NaN. */
2995 value
= zero
/ zero
;
2997 /* If that made a "negative" NaN, negate it. */
3001 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3004 u_minus_zero
.d
= - 0.0;
3005 for (i
= 0; i
< sizeof (double); i
++)
3006 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3012 /* Now VALUE is a positive NaN. */
3015 value
= atof (read_buffer
+ negative
);
3019 return make_float (negative
? - value
: value
);
3023 Lisp_Object name
, result
;
3024 EMACS_INT nbytes
= p
- read_buffer
;
3026 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3029 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3030 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3032 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3033 result
= (uninterned_symbol
? Fmake_symbol (name
)
3034 : Fintern (name
, Qnil
));
3036 if (EQ (Vread_with_symbol_positions
, Qt
)
3037 || EQ (Vread_with_symbol_positions
, readcharfun
))
3038 Vread_symbol_positions_list
=
3039 /* Kind of a hack; this will probably fail if characters
3040 in the symbol name were escaped. Not really a big
3042 Fcons (Fcons (result
,
3043 make_number (readchar_count
3044 - XFASTINT (Flength (Fsymbol_name (result
))))),
3045 Vread_symbol_positions_list
);
3053 /* List of nodes we've seen during substitute_object_in_subtree. */
3054 static Lisp_Object seen_list
;
3057 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3059 Lisp_Object check_object
;
3061 /* We haven't seen any objects when we start. */
3064 /* Make all the substitutions. */
3066 = substitute_object_recurse (object
, placeholder
, object
);
3068 /* Clear seen_list because we're done with it. */
3071 /* The returned object here is expected to always eq the
3073 if (!EQ (check_object
, object
))
3074 error ("Unexpected mutation error in reader");
3077 /* Feval doesn't get called from here, so no gc protection is needed. */
3078 #define SUBSTITUTE(get_val, set_val) \
3080 Lisp_Object old_value = get_val; \
3081 Lisp_Object true_value \
3082 = substitute_object_recurse (object, placeholder, \
3085 if (!EQ (old_value, true_value)) \
3092 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3094 /* If we find the placeholder, return the target object. */
3095 if (EQ (placeholder
, subtree
))
3098 /* If we've been to this node before, don't explore it again. */
3099 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3102 /* If this node can be the entry point to a cycle, remember that
3103 we've seen it. It can only be such an entry point if it was made
3104 by #n=, which means that we can find it as a value in
3106 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3107 seen_list
= Fcons (subtree
, seen_list
);
3109 /* Recurse according to subtree's type.
3110 Every branch must return a Lisp_Object. */
3111 switch (XTYPE (subtree
))
3113 case Lisp_Vectorlike
:
3116 if (BOOL_VECTOR_P (subtree
))
3117 return subtree
; /* No sub-objects anyway. */
3118 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3119 || COMPILEDP (subtree
))
3120 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3121 else if (VECTORP (subtree
))
3122 length
= ASIZE (subtree
);
3124 /* An unknown pseudovector may contain non-Lisp fields, so we
3125 can't just blindly traverse all its fields. We used to call
3126 `Flength' which signaled `sequencep', so I just preserved this
3128 wrong_type_argument (Qsequencep
, subtree
);
3130 for (i
= 0; i
< length
; i
++)
3131 SUBSTITUTE (AREF (subtree
, i
),
3132 ASET (subtree
, i
, true_value
));
3138 SUBSTITUTE (XCAR (subtree
),
3139 XSETCAR (subtree
, true_value
));
3140 SUBSTITUTE (XCDR (subtree
),
3141 XSETCDR (subtree
, true_value
));
3147 /* Check for text properties in each interval.
3148 substitute_in_interval contains part of the logic. */
3150 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3151 Lisp_Object arg
= Fcons (object
, placeholder
);
3153 traverse_intervals_noorder (root_interval
,
3154 &substitute_in_interval
, arg
);
3159 /* Other types don't recurse any further. */
3165 /* Helper function for substitute_object_recurse. */
3167 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3169 Lisp_Object object
= Fcar (arg
);
3170 Lisp_Object placeholder
= Fcdr (arg
);
3172 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3183 isfloat_string (const char *cp
, int ignore_trailing
)
3186 const char *start
= cp
;
3189 if (*cp
== '+' || *cp
== '-')
3192 if (*cp
>= '0' && *cp
<= '9')
3195 while (*cp
>= '0' && *cp
<= '9')
3203 if (*cp
>= '0' && *cp
<= '9')
3206 while (*cp
>= '0' && *cp
<= '9')
3209 if (*cp
== 'e' || *cp
== 'E')
3213 if (*cp
== '+' || *cp
== '-')
3217 if (*cp
>= '0' && *cp
<= '9')
3220 while (*cp
>= '0' && *cp
<= '9')
3223 else if (cp
== start
)
3225 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3230 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3236 return ((ignore_trailing
3237 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3238 || *cp
== '\r' || *cp
== '\f')
3239 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3240 || state
== (DOT_CHAR
|TRAIL_INT
)
3241 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3242 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3243 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3248 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3252 register Lisp_Object
*ptr
;
3253 register Lisp_Object tem
, item
, vector
;
3254 register struct Lisp_Cons
*otem
;
3257 tem
= read_list (1, readcharfun
);
3258 len
= Flength (tem
);
3259 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3261 size
= XVECTOR (vector
)->size
;
3262 ptr
= XVECTOR (vector
)->contents
;
3263 for (i
= 0; i
< size
; i
++)
3266 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3267 bytecode object, the docstring containing the bytecode and
3268 constants values must be treated as unibyte and passed to
3269 Fread, to get the actual bytecode string and constants vector. */
3270 if (bytecodeflag
&& load_force_doc_strings
)
3272 if (i
== COMPILED_BYTECODE
)
3274 if (!STRINGP (item
))
3275 error ("Invalid byte code");
3277 /* Delay handling the bytecode slot until we know whether
3278 it is lazily-loaded (we can tell by whether the
3279 constants slot is nil). */
3280 ptr
[COMPILED_CONSTANTS
] = item
;
3283 else if (i
== COMPILED_CONSTANTS
)
3285 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3289 /* Coerce string to unibyte (like string-as-unibyte,
3290 but without generating extra garbage and
3291 guaranteeing no change in the contents). */
3292 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3293 STRING_SET_UNIBYTE (bytestr
);
3295 item
= Fread (Fcons (bytestr
, readcharfun
));
3297 error ("Invalid byte code");
3299 otem
= XCONS (item
);
3300 bytestr
= XCAR (item
);
3305 /* Now handle the bytecode slot. */
3306 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3308 else if (i
== COMPILED_DOC_STRING
3310 && ! STRING_MULTIBYTE (item
))
3312 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3313 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3315 item
= Fstring_as_multibyte (item
);
3318 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3326 /* FLAG = 1 means check for ] to terminate rather than ) and .
3327 FLAG = -1 means check for starting with defun
3328 and make structure pure. */
3331 read_list (int flag
, register Lisp_Object readcharfun
)
3333 /* -1 means check next element for defun,
3334 0 means don't check,
3335 1 means already checked and found defun. */
3336 int defunflag
= flag
< 0 ? -1 : 0;
3337 Lisp_Object val
, tail
;
3338 register Lisp_Object elt
, tem
;
3339 struct gcpro gcpro1
, gcpro2
;
3340 /* 0 is the normal case.
3341 1 means this list is a doc reference; replace it with the number 0.
3342 2 means this list is a doc reference; replace it with the doc string. */
3343 int doc_reference
= 0;
3345 /* Initialize this to 1 if we are reading a list. */
3346 int first_in_list
= flag
<= 0;
3355 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3360 /* While building, if the list starts with #$, treat it specially. */
3361 if (EQ (elt
, Vload_file_name
)
3363 && !NILP (Vpurify_flag
))
3365 if (NILP (Vdoc_file_name
))
3366 /* We have not yet called Snarf-documentation, so assume
3367 this file is described in the DOC-MM.NN file
3368 and Snarf-documentation will fill in the right value later.
3369 For now, replace the whole list with 0. */
3372 /* We have already called Snarf-documentation, so make a relative
3373 file name for this file, so it can be found properly
3374 in the installed Lisp directory.
3375 We don't use Fexpand_file_name because that would make
3376 the directory absolute now. */
3377 elt
= concat2 (build_string ("../lisp/"),
3378 Ffile_name_nondirectory (elt
));
3380 else if (EQ (elt
, Vload_file_name
)
3382 && load_force_doc_strings
)
3391 invalid_syntax (") or . in a vector", 18);
3399 XSETCDR (tail
, read0 (readcharfun
));
3401 val
= read0 (readcharfun
);
3402 read1 (readcharfun
, &ch
, 0);
3406 if (doc_reference
== 1)
3407 return make_number (0);
3408 if (doc_reference
== 2)
3410 /* Get a doc string from the file we are loading.
3411 If it's in saved_doc_string, get it from there.
3413 Here, we don't know if the string is a
3414 bytecode string or a doc string. As a
3415 bytecode string must be unibyte, we always
3416 return a unibyte string. If it is actually a
3417 doc string, caller must make it
3420 int pos
= XINT (XCDR (val
));
3421 /* Position is negative for user variables. */
3422 if (pos
< 0) pos
= -pos
;
3423 if (pos
>= saved_doc_string_position
3424 && pos
< (saved_doc_string_position
3425 + saved_doc_string_length
))
3427 int start
= pos
- saved_doc_string_position
;
3430 /* Process quoting with ^A,
3431 and find the end of the string,
3432 which is marked with ^_ (037). */
3433 for (from
= start
, to
= start
;
3434 saved_doc_string
[from
] != 037;)
3436 int c
= saved_doc_string
[from
++];
3439 c
= saved_doc_string
[from
++];
3441 saved_doc_string
[to
++] = c
;
3443 saved_doc_string
[to
++] = 0;
3445 saved_doc_string
[to
++] = 037;
3448 saved_doc_string
[to
++] = c
;
3451 return make_unibyte_string (saved_doc_string
+ start
,
3454 /* Look in prev_saved_doc_string the same way. */
3455 else if (pos
>= prev_saved_doc_string_position
3456 && pos
< (prev_saved_doc_string_position
3457 + prev_saved_doc_string_length
))
3459 int start
= pos
- prev_saved_doc_string_position
;
3462 /* Process quoting with ^A,
3463 and find the end of the string,
3464 which is marked with ^_ (037). */
3465 for (from
= start
, to
= start
;
3466 prev_saved_doc_string
[from
] != 037;)
3468 int c
= prev_saved_doc_string
[from
++];
3471 c
= prev_saved_doc_string
[from
++];
3473 prev_saved_doc_string
[to
++] = c
;
3475 prev_saved_doc_string
[to
++] = 0;
3477 prev_saved_doc_string
[to
++] = 037;
3480 prev_saved_doc_string
[to
++] = c
;
3483 return make_unibyte_string (prev_saved_doc_string
3488 return get_doc_string (val
, 1, 0);
3493 invalid_syntax (". in wrong context", 18);
3495 invalid_syntax ("] in a list", 11);
3497 tem
= (read_pure
&& flag
<= 0
3498 ? pure_cons (elt
, Qnil
)
3499 : Fcons (elt
, Qnil
));
3501 XSETCDR (tail
, tem
);
3506 defunflag
= EQ (elt
, Qdefun
);
3507 else if (defunflag
> 0)
3512 Lisp_Object Vobarray
;
3513 Lisp_Object initial_obarray
;
3515 /* oblookup stores the bucket number here, for the sake of Funintern. */
3517 int oblookup_last_bucket_number
;
3519 static int hash_string (const unsigned char *ptr
, int len
);
3521 /* Get an error if OBARRAY is not an obarray.
3522 If it is one, return it. */
3525 check_obarray (Lisp_Object obarray
)
3527 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3529 /* If Vobarray is now invalid, force it to be valid. */
3530 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3531 wrong_type_argument (Qvectorp
, obarray
);
3536 /* Intern the C string STR: return a symbol with that name,
3537 interned in the current obarray. */
3540 intern (const char *str
)
3543 int len
= strlen (str
);
3544 Lisp_Object obarray
;
3547 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3548 obarray
= check_obarray (obarray
);
3549 tem
= oblookup (obarray
, str
, len
, len
);
3552 return Fintern (make_string (str
, len
), obarray
);
3556 intern_c_string (const char *str
)
3559 int len
= strlen (str
);
3560 Lisp_Object obarray
;
3563 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3564 obarray
= check_obarray (obarray
);
3565 tem
= oblookup (obarray
, str
, len
, len
);
3569 if (NILP (Vpurify_flag
))
3570 /* Creating a non-pure string from a string literal not
3571 implemented yet. We could just use make_string here and live
3572 with the extra copy. */
3575 return Fintern (make_pure_c_string (str
), obarray
);
3578 /* Create an uninterned symbol with name STR. */
3581 make_symbol (const char *str
)
3583 int len
= strlen (str
);
3585 return Fmake_symbol (!NILP (Vpurify_flag
)
3586 ? make_pure_string (str
, len
, len
, 0)
3587 : make_string (str
, len
));
3590 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3591 doc
: /* Return the canonical symbol whose name is STRING.
3592 If there is none, one is created by this function and returned.
3593 A second optional argument specifies the obarray to use;
3594 it defaults to the value of `obarray'. */)
3595 (Lisp_Object string
, Lisp_Object obarray
)
3597 register Lisp_Object tem
, sym
, *ptr
;
3599 if (NILP (obarray
)) obarray
= Vobarray
;
3600 obarray
= check_obarray (obarray
);
3602 CHECK_STRING (string
);
3604 tem
= oblookup (obarray
, SDATA (string
),
3607 if (!INTEGERP (tem
))
3610 if (!NILP (Vpurify_flag
))
3611 string
= Fpurecopy (string
);
3612 sym
= Fmake_symbol (string
);
3614 if (EQ (obarray
, initial_obarray
))
3615 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3617 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3619 if ((SREF (string
, 0) == ':')
3620 && EQ (obarray
, initial_obarray
))
3622 XSYMBOL (sym
)->constant
= 1;
3623 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3624 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3627 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3629 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3631 XSYMBOL (sym
)->next
= 0;
3636 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3637 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3638 NAME may be a string or a symbol. If it is a symbol, that exact
3639 symbol is searched for.
3640 A second optional argument specifies the obarray to use;
3641 it defaults to the value of `obarray'. */)
3642 (Lisp_Object name
, Lisp_Object obarray
)
3644 register Lisp_Object tem
, string
;
3646 if (NILP (obarray
)) obarray
= Vobarray
;
3647 obarray
= check_obarray (obarray
);
3649 if (!SYMBOLP (name
))
3651 CHECK_STRING (name
);
3655 string
= SYMBOL_NAME (name
);
3657 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3658 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3664 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3665 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3666 The value is t if a symbol was found and deleted, nil otherwise.
3667 NAME may be a string or a symbol. If it is a symbol, that symbol
3668 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3669 OBARRAY defaults to the value of the variable `obarray'. */)
3670 (Lisp_Object name
, Lisp_Object obarray
)
3672 register Lisp_Object string
, tem
;
3675 if (NILP (obarray
)) obarray
= Vobarray
;
3676 obarray
= check_obarray (obarray
);
3679 string
= SYMBOL_NAME (name
);
3682 CHECK_STRING (name
);
3686 tem
= oblookup (obarray
, SDATA (string
),
3691 /* If arg was a symbol, don't delete anything but that symbol itself. */
3692 if (SYMBOLP (name
) && !EQ (name
, tem
))
3695 /* There are plenty of other symbols which will screw up the Emacs
3696 session if we unintern them, as well as even more ways to use
3697 `setq' or `fset' or whatnot to make the Emacs session
3698 unusable. Let's not go down this silly road. --Stef */
3699 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3700 error ("Attempt to unintern t or nil"); */
3702 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3704 hash
= oblookup_last_bucket_number
;
3706 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3708 if (XSYMBOL (tem
)->next
)
3709 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3711 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3715 Lisp_Object tail
, following
;
3717 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3718 XSYMBOL (tail
)->next
;
3721 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3722 if (EQ (following
, tem
))
3724 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3733 /* Return the symbol in OBARRAY whose names matches the string
3734 of SIZE characters (SIZE_BYTE bytes) at PTR.
3735 If there is no such symbol in OBARRAY, return nil.
3737 Also store the bucket number in oblookup_last_bucket_number. */
3740 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3744 register Lisp_Object tail
;
3745 Lisp_Object bucket
, tem
;
3747 if (!VECTORP (obarray
)
3748 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3750 obarray
= check_obarray (obarray
);
3751 obsize
= XVECTOR (obarray
)->size
;
3753 /* This is sometimes needed in the middle of GC. */
3754 obsize
&= ~ARRAY_MARK_FLAG
;
3755 hash
= hash_string (ptr
, size_byte
) % obsize
;
3756 bucket
= XVECTOR (obarray
)->contents
[hash
];
3757 oblookup_last_bucket_number
= hash
;
3758 if (EQ (bucket
, make_number (0)))
3760 else if (!SYMBOLP (bucket
))
3761 error ("Bad data in guts of obarray"); /* Like CADR error message */
3763 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3765 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3766 && SCHARS (SYMBOL_NAME (tail
)) == size
3767 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3769 else if (XSYMBOL (tail
)->next
== 0)
3772 XSETINT (tem
, hash
);
3777 hash_string (const unsigned char *ptr
, int len
)
3779 register const unsigned char *p
= ptr
;
3780 register const unsigned char *end
= p
+ len
;
3781 register unsigned char c
;
3782 register int hash
= 0;
3787 if (c
>= 0140) c
-= 40;
3788 hash
= ((hash
<<3) + (hash
>>28) + c
);
3790 return hash
& 07777777777;
3794 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3797 register Lisp_Object tail
;
3798 CHECK_VECTOR (obarray
);
3799 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3801 tail
= XVECTOR (obarray
)->contents
[i
];
3806 if (XSYMBOL (tail
)->next
== 0)
3808 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3814 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3816 call1 (function
, sym
);
3819 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3820 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3821 OBARRAY defaults to the value of `obarray'. */)
3822 (Lisp_Object function
, Lisp_Object obarray
)
3824 if (NILP (obarray
)) obarray
= Vobarray
;
3825 obarray
= check_obarray (obarray
);
3827 map_obarray (obarray
, mapatoms_1
, function
);
3831 #define OBARRAY_SIZE 1511
3836 Lisp_Object oblength
;
3838 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3840 Vobarray
= Fmake_vector (oblength
, make_number (0));
3841 initial_obarray
= Vobarray
;
3842 staticpro (&initial_obarray
);
3844 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3845 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3846 NILP (Vpurify_flag) check in intern_c_string. */
3847 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3848 Qnil
= intern_c_string ("nil");
3850 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3851 so those two need to be fixed manally. */
3852 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3853 XSYMBOL (Qunbound
)->function
= Qunbound
;
3854 XSYMBOL (Qunbound
)->plist
= Qnil
;
3855 /* XSYMBOL (Qnil)->function = Qunbound; */
3856 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3857 XSYMBOL (Qnil
)->constant
= 1;
3858 XSYMBOL (Qnil
)->plist
= Qnil
;
3860 Qt
= intern_c_string ("t");
3861 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3862 XSYMBOL (Qt
)->constant
= 1;
3864 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3867 Qvariable_documentation
= intern_c_string ("variable-documentation");
3868 staticpro (&Qvariable_documentation
);
3870 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3871 read_buffer
= (char *) xmalloc (read_buffer_size
);
3875 defsubr (struct Lisp_Subr
*sname
)
3878 sym
= intern_c_string (sname
->symbol_name
);
3879 XSETPVECTYPE (sname
, PVEC_SUBR
);
3880 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3883 #ifdef NOTDEF /* use fset in subr.el now */
3885 defalias (sname
, string
)
3886 struct Lisp_Subr
*sname
;
3890 sym
= intern (string
);
3891 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3895 /* Define an "integer variable"; a symbol whose value is forwarded to a
3896 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3897 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3899 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3900 const char *namestring
, EMACS_INT
*address
)
3903 sym
= intern_c_string (namestring
);
3904 i_fwd
->type
= Lisp_Fwd_Int
;
3905 i_fwd
->intvar
= address
;
3906 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3907 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3910 /* Similar but define a variable whose value is t if address contains 1,
3911 nil if address contains 0. */
3913 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3914 const char *namestring
, int *address
)
3917 sym
= intern_c_string (namestring
);
3918 b_fwd
->type
= Lisp_Fwd_Bool
;
3919 b_fwd
->boolvar
= address
;
3920 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3921 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3922 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3925 /* Similar but define a variable whose value is the Lisp Object stored
3926 at address. Two versions: with and without gc-marking of the C
3927 variable. The nopro version is used when that variable will be
3928 gc-marked for some other reason, since marking the same slot twice
3929 can cause trouble with strings. */
3931 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
3932 const char *namestring
, Lisp_Object
*address
)
3935 sym
= intern_c_string (namestring
);
3936 o_fwd
->type
= Lisp_Fwd_Obj
;
3937 o_fwd
->objvar
= address
;
3938 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3939 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
3943 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
3944 const char *namestring
, Lisp_Object
*address
)
3946 defvar_lisp_nopro (o_fwd
, namestring
, address
);
3947 staticpro (address
);
3950 /* Similar but define a variable whose value is the Lisp Object stored
3951 at a particular offset in the current kboard object. */
3954 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
3955 const char *namestring
, int offset
)
3958 sym
= intern_c_string (namestring
);
3959 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
3960 ko_fwd
->offset
= offset
;
3961 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3962 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
3965 /* Record the value of load-path used at the start of dumping
3966 so we can see if the site changed it later during dumping. */
3967 static Lisp_Object dump_path
;
3973 int turn_off_warning
= 0;
3975 /* Compute the default load-path. */
3977 normal
= PATH_LOADSEARCH
;
3978 Vload_path
= decode_env_path (0, normal
);
3980 if (NILP (Vpurify_flag
))
3981 normal
= PATH_LOADSEARCH
;
3983 normal
= PATH_DUMPLOADSEARCH
;
3985 /* In a dumped Emacs, we normally have to reset the value of
3986 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3987 uses ../lisp, instead of the path of the installed elisp
3988 libraries. However, if it appears that Vload_path was changed
3989 from the default before dumping, don't override that value. */
3992 if (! NILP (Fequal (dump_path
, Vload_path
)))
3994 Vload_path
= decode_env_path (0, normal
);
3995 if (!NILP (Vinstallation_directory
))
3997 Lisp_Object tem
, tem1
, sitelisp
;
3999 /* Remove site-lisp dirs from path temporarily and store
4000 them in sitelisp, then conc them on at the end so
4001 they're always first in path. */
4005 tem
= Fcar (Vload_path
);
4006 tem1
= Fstring_match (build_string ("site-lisp"),
4010 Vload_path
= Fcdr (Vload_path
);
4011 sitelisp
= Fcons (tem
, sitelisp
);
4017 /* Add to the path the lisp subdir of the
4018 installation dir, if it exists. */
4019 tem
= Fexpand_file_name (build_string ("lisp"),
4020 Vinstallation_directory
);
4021 tem1
= Ffile_exists_p (tem
);
4024 if (NILP (Fmember (tem
, Vload_path
)))
4026 turn_off_warning
= 1;
4027 Vload_path
= Fcons (tem
, Vload_path
);
4031 /* That dir doesn't exist, so add the build-time
4032 Lisp dirs instead. */
4033 Vload_path
= nconc2 (Vload_path
, dump_path
);
4035 /* Add leim under the installation dir, if it exists. */
4036 tem
= Fexpand_file_name (build_string ("leim"),
4037 Vinstallation_directory
);
4038 tem1
= Ffile_exists_p (tem
);
4041 if (NILP (Fmember (tem
, Vload_path
)))
4042 Vload_path
= Fcons (tem
, Vload_path
);
4045 /* Add site-lisp under the installation dir, if it exists. */
4046 tem
= Fexpand_file_name (build_string ("site-lisp"),
4047 Vinstallation_directory
);
4048 tem1
= Ffile_exists_p (tem
);
4051 if (NILP (Fmember (tem
, Vload_path
)))
4052 Vload_path
= Fcons (tem
, Vload_path
);
4055 /* If Emacs was not built in the source directory,
4056 and it is run from where it was built, add to load-path
4057 the lisp, leim and site-lisp dirs under that directory. */
4059 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4063 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4064 Vinstallation_directory
);
4065 tem1
= Ffile_exists_p (tem
);
4067 /* Don't be fooled if they moved the entire source tree
4068 AFTER dumping Emacs. If the build directory is indeed
4069 different from the source dir, src/Makefile.in and
4070 src/Makefile will not be found together. */
4071 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4072 Vinstallation_directory
);
4073 tem2
= Ffile_exists_p (tem
);
4074 if (!NILP (tem1
) && NILP (tem2
))
4076 tem
= Fexpand_file_name (build_string ("lisp"),
4079 if (NILP (Fmember (tem
, Vload_path
)))
4080 Vload_path
= Fcons (tem
, Vload_path
);
4082 tem
= Fexpand_file_name (build_string ("leim"),
4085 if (NILP (Fmember (tem
, Vload_path
)))
4086 Vload_path
= Fcons (tem
, Vload_path
);
4088 tem
= Fexpand_file_name (build_string ("site-lisp"),
4091 if (NILP (Fmember (tem
, Vload_path
)))
4092 Vload_path
= Fcons (tem
, Vload_path
);
4095 if (!NILP (sitelisp
))
4096 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4102 /* NORMAL refers to the lisp dir in the source directory. */
4103 /* We used to add ../lisp at the front here, but
4104 that caused trouble because it was copied from dump_path
4105 into Vload_path, above, when Vinstallation_directory was non-nil.
4106 It should be unnecessary. */
4107 Vload_path
= decode_env_path (0, normal
);
4108 dump_path
= Vload_path
;
4112 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4113 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4114 almost never correct, thereby causing a warning to be printed out that
4115 confuses users. Since PATH_LOADSEARCH is always overridden by the
4116 EMACSLOADPATH environment variable below, disable the warning on NT. */
4118 /* Warn if dirs in the *standard* path don't exist. */
4119 if (!turn_off_warning
)
4121 Lisp_Object path_tail
;
4123 for (path_tail
= Vload_path
;
4125 path_tail
= XCDR (path_tail
))
4127 Lisp_Object dirfile
;
4128 dirfile
= Fcar (path_tail
);
4129 if (STRINGP (dirfile
))
4131 dirfile
= Fdirectory_file_name (dirfile
);
4132 if (access (SDATA (dirfile
), 0) < 0)
4133 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4138 #endif /* !(WINDOWSNT || HAVE_NS) */
4140 /* If the EMACSLOADPATH environment variable is set, use its value.
4141 This doesn't apply if we're dumping. */
4143 if (NILP (Vpurify_flag
)
4144 && egetenv ("EMACSLOADPATH"))
4146 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4150 load_in_progress
= 0;
4151 Vload_file_name
= Qnil
;
4153 load_descriptor_list
= Qnil
;
4155 Vstandard_input
= Qt
;
4156 Vloads_in_progress
= Qnil
;
4159 /* Print a warning, using format string FORMAT, that directory DIRNAME
4160 does not exist. Print it on stderr and put it in *Messages*. */
4163 dir_warning (const char *format
, Lisp_Object dirname
)
4166 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4168 fprintf (stderr
, format
, SDATA (dirname
));
4169 sprintf (buffer
, format
, SDATA (dirname
));
4170 /* Don't log the warning before we've initialized!! */
4172 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4176 syms_of_lread (void)
4179 defsubr (&Sread_from_string
);
4181 defsubr (&Sintern_soft
);
4182 defsubr (&Sunintern
);
4183 defsubr (&Sget_load_suffixes
);
4185 defsubr (&Seval_buffer
);
4186 defsubr (&Seval_region
);
4187 defsubr (&Sread_char
);
4188 defsubr (&Sread_char_exclusive
);
4189 defsubr (&Sread_event
);
4190 defsubr (&Sget_file_char
);
4191 defsubr (&Smapatoms
);
4192 defsubr (&Slocate_file_internal
);
4194 DEFVAR_LISP ("obarray", &Vobarray
,
4195 doc
: /* Symbol table for use by `intern' and `read'.
4196 It is a vector whose length ought to be prime for best results.
4197 The vector's contents don't make sense if examined from Lisp programs;
4198 to find all the symbols in an obarray, use `mapatoms'. */);
4200 DEFVAR_LISP ("values", &Vvalues
,
4201 doc
: /* List of values of all expressions which were read, evaluated and printed.
4202 Order is reverse chronological. */);
4204 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4205 doc
: /* Stream for read to get input from.
4206 See documentation of `read' for possible values. */);
4207 Vstandard_input
= Qt
;
4209 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4210 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4212 If this variable is a buffer, then only forms read from that buffer
4213 will be added to `read-symbol-positions-list'.
4214 If this variable is t, then all read forms will be added.
4215 The effect of all other values other than nil are not currently
4216 defined, although they may be in the future.
4218 The positions are relative to the last call to `read' or
4219 `read-from-string'. It is probably a bad idea to set this variable at
4220 the toplevel; bind it instead. */);
4221 Vread_with_symbol_positions
= Qnil
;
4223 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4224 doc
: /* A list mapping read symbols to their positions.
4225 This variable is modified during calls to `read' or
4226 `read-from-string', but only when `read-with-symbol-positions' is
4229 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4230 CHAR-POSITION is an integer giving the offset of that occurrence of the
4231 symbol from the position where `read' or `read-from-string' started.
4233 Note that a symbol will appear multiple times in this list, if it was
4234 read multiple times. The list is in the same order as the symbols
4236 Vread_symbol_positions_list
= Qnil
;
4238 DEFVAR_LISP ("read-circle", &Vread_circle
,
4239 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4242 DEFVAR_LISP ("load-path", &Vload_path
,
4243 doc
: /* *List of directories to search for files to load.
4244 Each element is a string (directory name) or nil (try default directory).
4245 Initialized based on EMACSLOADPATH environment variable, if any,
4246 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4248 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4249 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4250 This list should not include the empty string.
4251 `load' and related functions try to append these suffixes, in order,
4252 to the specified file name if a Lisp suffix is allowed or required. */);
4253 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4254 Fcons (make_pure_c_string (".el"), Qnil
));
4255 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4256 doc
: /* List of suffixes that indicate representations of \
4258 This list should normally start with the empty string.
4260 Enabling Auto Compression mode appends the suffixes in
4261 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4262 mode removes them again. `load' and related functions use this list to
4263 determine whether they should look for compressed versions of a file
4264 and, if so, which suffixes they should try to append to the file name
4265 in order to do so. However, if you want to customize which suffixes
4266 the loading functions recognize as compression suffixes, you should
4267 customize `jka-compr-load-suffixes' rather than the present variable. */);
4268 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4270 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4271 doc
: /* Non-nil if inside of `load'. */);
4272 Qload_in_progress
= intern_c_string ("load-in-progress");
4273 staticpro (&Qload_in_progress
);
4275 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4276 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4277 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4279 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4280 a symbol \(a feature name).
4282 When `load' is run and the file-name argument matches an element's
4283 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4284 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4286 An error in FORMS does not undo the load, but does prevent execution of
4287 the rest of the FORMS. */);
4288 Vafter_load_alist
= Qnil
;
4290 DEFVAR_LISP ("load-history", &Vload_history
,
4291 doc
: /* Alist mapping loaded file names to symbols and features.
4292 Each alist element should be a list (FILE-NAME ENTRIES...), where
4293 FILE-NAME is the name of a file that has been loaded into Emacs.
4294 The file name is absolute and true (i.e. it doesn't contain symlinks).
4295 As an exception, one of the alist elements may have FILE-NAME nil,
4296 for symbols and features not associated with any file.
4298 The remaining ENTRIES in the alist element describe the functions and
4299 variables defined in that file, the features provided, and the
4300 features required. Each entry has the form `(provide . FEATURE)',
4301 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4302 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4303 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4304 SYMBOL was an autoload before this file redefined it as a function.
4306 During preloading, the file name recorded is relative to the main Lisp
4307 directory. These file names are converted to absolute at startup. */);
4308 Vload_history
= Qnil
;
4310 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4311 doc
: /* Full name of file being loaded by `load'. */);
4312 Vload_file_name
= Qnil
;
4314 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4315 doc
: /* File name, including directory, of user's initialization file.
4316 If the file loaded had extension `.elc', and the corresponding source file
4317 exists, this variable contains the name of source file, suitable for use
4318 by functions like `custom-save-all' which edit the init file.
4319 While Emacs loads and evaluates the init file, value is the real name
4320 of the file, regardless of whether or not it has the `.elc' extension. */);
4321 Vuser_init_file
= Qnil
;
4323 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4324 doc
: /* Used for internal purposes by `load'. */);
4325 Vcurrent_load_list
= Qnil
;
4327 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4328 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4329 The default is nil, which means use the function `read'. */);
4330 Vload_read_function
= Qnil
;
4332 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4333 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4334 This function is for doing code conversion before reading the source file.
4335 If nil, loading is done without any code conversion.
4336 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4337 FULLNAME is the full name of FILE.
4338 See `load' for the meaning of the remaining arguments. */);
4339 Vload_source_file_function
= Qnil
;
4341 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4342 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4343 This is useful when the file being loaded is a temporary copy. */);
4344 load_force_doc_strings
= 0;
4346 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4347 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4348 This is normally bound by `load' and `eval-buffer' to control `read',
4349 and is not meant for users to change. */);
4350 load_convert_to_unibyte
= 0;
4352 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4353 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4354 You cannot count on them to still be there! */);
4356 = Fexpand_file_name (build_string ("../"),
4357 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4359 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4360 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4361 Vpreloaded_file_list
= Qnil
;
4363 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4364 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4365 Vbyte_boolean_vars
= Qnil
;
4367 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4368 doc
: /* Non-nil means load dangerous compiled Lisp files.
4369 Some versions of XEmacs use different byte codes than Emacs. These
4370 incompatible byte codes can make Emacs crash when it tries to execute
4372 load_dangerous_libraries
= 0;
4374 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4375 doc
: /* Non-nil means force printing messages when loading Lisp files.
4376 This overrides the value of the NOMESSAGE argument to `load'. */);
4377 force_load_messages
= 0;
4379 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4380 doc
: /* Regular expression matching safe to load compiled Lisp files.
4381 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4382 from the file, and matches them against this regular expression.
4383 When the regular expression matches, the file is considered to be safe
4384 to load. See also `load-dangerous-libraries'. */);
4385 Vbytecomp_version_regexp
4386 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4388 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4389 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4390 Veval_buffer_list
= Qnil
;
4392 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4393 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4394 Vold_style_backquotes
= Qnil
;
4395 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4396 staticpro (&Qold_style_backquotes
);
4398 /* Vsource_directory was initialized in init_lread. */
4400 load_descriptor_list
= Qnil
;
4401 staticpro (&load_descriptor_list
);
4403 Qcurrent_load_list
= intern_c_string ("current-load-list");
4404 staticpro (&Qcurrent_load_list
);
4406 Qstandard_input
= intern_c_string ("standard-input");
4407 staticpro (&Qstandard_input
);
4409 Qread_char
= intern_c_string ("read-char");
4410 staticpro (&Qread_char
);
4412 Qget_file_char
= intern_c_string ("get-file-char");
4413 staticpro (&Qget_file_char
);
4415 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4416 staticpro (&Qget_emacs_mule_file_char
);
4418 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4419 staticpro (&Qload_force_doc_strings
);
4421 Qbackquote
= intern_c_string ("`");
4422 staticpro (&Qbackquote
);
4423 Qcomma
= intern_c_string (",");
4424 staticpro (&Qcomma
);
4425 Qcomma_at
= intern_c_string (",@");
4426 staticpro (&Qcomma_at
);
4427 Qcomma_dot
= intern_c_string (",.");
4428 staticpro (&Qcomma_dot
);
4430 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4431 staticpro (&Qinhibit_file_name_operation
);
4433 Qascii_character
= intern_c_string ("ascii-character");
4434 staticpro (&Qascii_character
);
4436 Qfunction
= intern_c_string ("function");
4437 staticpro (&Qfunction
);
4439 Qload
= intern_c_string ("load");
4442 Qload_file_name
= intern_c_string ("load-file-name");
4443 staticpro (&Qload_file_name
);
4445 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4446 staticpro (&Qeval_buffer_list
);
4448 Qfile_truename
= intern_c_string ("file-truename");
4449 staticpro (&Qfile_truename
) ;
4451 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4452 staticpro (&Qdo_after_load_evaluation
) ;
4454 staticpro (&dump_path
);
4456 staticpro (&read_objects
);
4457 read_objects
= Qnil
;
4458 staticpro (&seen_list
);
4461 Vloads_in_progress
= Qnil
;
4462 staticpro (&Vloads_in_progress
);
4464 Qhash_table
= intern_c_string ("hash-table");
4465 staticpro (&Qhash_table
);
4466 Qdata
= intern_c_string ("data");
4468 Qtest
= intern_c_string ("test");
4470 Qsize
= intern_c_string ("size");
4472 Qweakness
= intern_c_string ("weakness");
4473 staticpro (&Qweakness
);
4474 Qrehash_size
= intern_c_string ("rehash-size");
4475 staticpro (&Qrehash_size
);
4476 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4477 staticpro (&Qrehash_threshold
);