1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
60 #define file_offset off_t
61 #define file_tell ftello
63 #define file_offset long
64 #define file_tell ftell
67 /* hash table read constants */
68 Lisp_Object Qhash_table
, Qdata
;
69 Lisp_Object Qtest
, Qsize
;
70 Lisp_Object Qweakness
;
71 Lisp_Object Qrehash_size
;
72 Lisp_Object Qrehash_threshold
;
74 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
75 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
76 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
77 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
78 Lisp_Object Qinhibit_file_name_operation
;
79 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
80 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
82 /* Used instead of Qget_file_char while loading *.elc files compiled
83 by Emacs 21 or older. */
84 static Lisp_Object Qget_emacs_mule_file_char
;
86 static Lisp_Object Qload_force_doc_strings
;
88 /* non-zero if inside `load' */
90 static Lisp_Object Qload_in_progress
;
92 /* Directory in which the sources were found. */
93 Lisp_Object Vsource_directory
;
95 /* Search path and suffixes for files to be loaded. */
96 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
98 /* File name of user's init file. */
99 Lisp_Object Vuser_init_file
;
101 /* This is the user-visible association list that maps features to
102 lists of defs in their load files. */
103 Lisp_Object Vload_history
;
105 /* This is used to build the load history. */
106 Lisp_Object Vcurrent_load_list
;
108 /* List of files that were preloaded. */
109 Lisp_Object Vpreloaded_file_list
;
111 /* Name of file actually being read by `load'. */
112 Lisp_Object Vload_file_name
;
114 /* Function to use for reading, in `load' and friends. */
115 Lisp_Object Vload_read_function
;
117 /* Non-nil means read recursive structures using #n= and #n# syntax. */
118 Lisp_Object Vread_circle
;
120 /* The association list of objects read with the #n=object form.
121 Each member of the list has the form (n . object), and is used to
122 look up the object for the corresponding #n# construct.
123 It must be set to nil before all top-level calls to read0. */
124 Lisp_Object read_objects
;
126 /* Nonzero means load should forcibly load all dynamic doc strings. */
127 static int load_force_doc_strings
;
129 /* Nonzero means read should convert strings to unibyte. */
130 static int load_convert_to_unibyte
;
132 /* Nonzero means READCHAR should read bytes one by one (not character)
133 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
134 This is set to 1 by read1 temporarily while handling #@NUMBER. */
135 static int load_each_byte
;
137 /* Function to use for loading an Emacs Lisp source file (not
138 compiled) instead of readevalloop. */
139 Lisp_Object Vload_source_file_function
;
141 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
142 Lisp_Object Vbyte_boolean_vars
;
144 /* Whether or not to add a `read-positions' property to symbols
146 Lisp_Object Vread_with_symbol_positions
;
148 /* List of (SYMBOL . POSITION) accumulated so far. */
149 Lisp_Object Vread_symbol_positions_list
;
151 /* List of descriptors now open for Fload. */
152 static Lisp_Object load_descriptor_list
;
154 /* File for get_file_char to read from. Use by load. */
155 static FILE *instream
;
157 /* When nonzero, read conses in pure space */
158 static int read_pure
;
160 /* For use within read-from-string (this reader is non-reentrant!!) */
161 static EMACS_INT read_from_string_index
;
162 static EMACS_INT read_from_string_index_byte
;
163 static EMACS_INT read_from_string_limit
;
165 /* Number of characters read in the current call to Fread or
166 Fread_from_string. */
167 static EMACS_INT readchar_count
;
169 /* This contains the last string skipped with #@. */
170 static char *saved_doc_string
;
171 /* Length of buffer allocated in saved_doc_string. */
172 static int saved_doc_string_size
;
173 /* Length of actual data in saved_doc_string. */
174 static int saved_doc_string_length
;
175 /* This is the file position that string came from. */
176 static file_offset saved_doc_string_position
;
178 /* This contains the previous string skipped with #@.
179 We copy it from saved_doc_string when a new string
180 is put in saved_doc_string. */
181 static char *prev_saved_doc_string
;
182 /* Length of buffer allocated in prev_saved_doc_string. */
183 static int prev_saved_doc_string_size
;
184 /* Length of actual data in prev_saved_doc_string. */
185 static int prev_saved_doc_string_length
;
186 /* This is the file position that string came from. */
187 static file_offset prev_saved_doc_string_position
;
189 /* Nonzero means inside a new-style backquote
190 with no surrounding parentheses.
191 Fread initializes this to zero, so we need not specbind it
192 or worry about what happens to it when there is an error. */
193 static int new_backquote_flag
;
194 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
196 /* A list of file names for files being loaded in Fload. Used to
197 check for recursive loads. */
199 static Lisp_Object Vloads_in_progress
;
201 /* Non-zero means load dangerous compiled Lisp files. */
203 int load_dangerous_libraries
;
205 /* Non-zero means force printing messages when loading Lisp files. */
207 int force_load_messages
;
209 /* A regular expression used to detect files compiled with Emacs. */
211 static Lisp_Object Vbytecomp_version_regexp
;
213 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
216 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
,
217 Lisp_Object (*) (Lisp_Object
), int,
218 Lisp_Object
, Lisp_Object
,
219 Lisp_Object
, Lisp_Object
);
220 static Lisp_Object
load_unwind (Lisp_Object
);
221 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
223 static void invalid_syntax (const char *, int) NO_RETURN
;
224 static void end_of_file_error (void) NO_RETURN
;
227 /* Functions that read one byte from the current source READCHARFUN
228 or unreads one byte. If the integer argument C is -1, it returns
229 one read byte, or -1 when there's no more byte in the source. If C
230 is 0 or positive, it unreads C, and the return value is not
233 static int readbyte_for_lambda (int, Lisp_Object
);
234 static int readbyte_from_file (int, Lisp_Object
);
235 static int readbyte_from_string (int, Lisp_Object
);
237 /* Handle unreading and rereading of characters.
238 Write READCHAR to read a character,
239 UNREAD(c) to unread c to be read again.
241 These macros correctly read/unread multibyte characters. */
243 #define READCHAR readchar (readcharfun, NULL)
244 #define UNREAD(c) unreadchar (readcharfun, c)
246 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
247 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
249 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
250 Qlambda, or a cons, we use this to keep an unread character because
251 a file stream can't handle multibyte-char unreading. The value -1
252 means that there's no unread character. */
253 static int unread_char
;
256 readchar (Lisp_Object readcharfun
, int *multibyte
)
260 int (*readbyte
) (int, Lisp_Object
);
261 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
263 int emacs_mule_encoding
= 0;
270 if (BUFFERP (readcharfun
))
272 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
274 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
276 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
279 if (! NILP (inbuffer
->enable_multibyte_characters
))
281 /* Fetch the character code from the buffer. */
282 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
283 BUF_INC_POS (inbuffer
, pt_byte
);
290 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
291 if (! ASCII_BYTE_P (c
))
292 c
= BYTE8_TO_CHAR (c
);
295 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
299 if (MARKERP (readcharfun
))
301 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
303 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
305 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
308 if (! NILP (inbuffer
->enable_multibyte_characters
))
310 /* Fetch the character code from the buffer. */
311 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
312 BUF_INC_POS (inbuffer
, bytepos
);
319 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
320 if (! ASCII_BYTE_P (c
))
321 c
= BYTE8_TO_CHAR (c
);
325 XMARKER (readcharfun
)->bytepos
= bytepos
;
326 XMARKER (readcharfun
)->charpos
++;
331 if (EQ (readcharfun
, Qlambda
))
333 readbyte
= readbyte_for_lambda
;
337 if (EQ (readcharfun
, Qget_file_char
))
339 readbyte
= readbyte_from_file
;
343 if (STRINGP (readcharfun
))
345 if (read_from_string_index
>= read_from_string_limit
)
347 else if (STRING_MULTIBYTE (readcharfun
))
351 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
352 read_from_string_index
,
353 read_from_string_index_byte
);
357 c
= SREF (readcharfun
, read_from_string_index_byte
);
358 read_from_string_index
++;
359 read_from_string_index_byte
++;
364 if (CONSP (readcharfun
))
366 /* This is the case that read_vector is reading from a unibyte
367 string that contains a byte sequence previously skipped
368 because of #@NUMBER. The car part of readcharfun is that
369 string, and the cdr part is a value of readcharfun given to
371 readbyte
= readbyte_from_string
;
372 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
373 emacs_mule_encoding
= 1;
377 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
379 readbyte
= readbyte_from_file
;
380 emacs_mule_encoding
= 1;
384 tem
= call0 (readcharfun
);
391 if (unread_char
>= 0)
397 c
= (*readbyte
) (-1, readcharfun
);
398 if (c
< 0 || load_each_byte
)
402 if (ASCII_BYTE_P (c
))
404 if (emacs_mule_encoding
)
405 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
408 len
= BYTES_BY_CHAR_HEAD (c
);
411 c
= (*readbyte
) (-1, readcharfun
);
412 if (c
< 0 || ! TRAILING_CODE_P (c
))
415 (*readbyte
) (buf
[i
], readcharfun
);
416 return BYTE8_TO_CHAR (buf
[0]);
420 return STRING_CHAR (buf
);
423 /* Unread the character C in the way appropriate for the stream READCHARFUN.
424 If the stream is a user function, call it with the char as argument. */
427 unreadchar (Lisp_Object readcharfun
, int c
)
431 /* Don't back up the pointer if we're unreading the end-of-input mark,
432 since readchar didn't advance it when we read it. */
434 else if (BUFFERP (readcharfun
))
436 struct buffer
*b
= XBUFFER (readcharfun
);
437 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
440 if (! NILP (b
->enable_multibyte_characters
))
441 BUF_DEC_POS (b
, bytepos
);
445 BUF_PT_BYTE (b
) = bytepos
;
447 else if (MARKERP (readcharfun
))
449 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
450 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
452 XMARKER (readcharfun
)->charpos
--;
453 if (! NILP (b
->enable_multibyte_characters
))
454 BUF_DEC_POS (b
, bytepos
);
458 XMARKER (readcharfun
)->bytepos
= bytepos
;
460 else if (STRINGP (readcharfun
))
462 read_from_string_index
--;
463 read_from_string_index_byte
464 = string_char_to_byte (readcharfun
, read_from_string_index
);
466 else if (CONSP (readcharfun
))
470 else if (EQ (readcharfun
, Qlambda
))
474 else if (EQ (readcharfun
, Qget_file_char
)
475 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
480 ungetc (c
, instream
);
487 call1 (readcharfun
, make_number (c
));
491 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
493 return read_bytecode_char (c
>= 0);
498 readbyte_from_file (int c
, Lisp_Object readcharfun
)
503 ungetc (c
, instream
);
512 /* Interrupted reads have been observed while reading over the network */
513 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
525 return (c
== EOF
? -1 : c
);
529 readbyte_from_string (int c
, Lisp_Object readcharfun
)
531 Lisp_Object string
= XCAR (readcharfun
);
535 read_from_string_index
--;
536 read_from_string_index_byte
537 = string_char_to_byte (string
, read_from_string_index
);
540 if (read_from_string_index
>= read_from_string_limit
)
543 FETCH_STRING_CHAR_ADVANCE (c
, string
,
544 read_from_string_index
,
545 read_from_string_index_byte
);
550 /* Read one non-ASCII character from INSTREAM. The character is
551 encoded in `emacs-mule' and the first byte is already read in
554 extern char emacs_mule_bytes
[256];
557 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
559 /* Emacs-mule coding uses at most 4-byte for one character. */
560 unsigned char buf
[4];
561 int len
= emacs_mule_bytes
[c
];
562 struct charset
*charset
;
567 /* C is not a valid leading-code of `emacs-mule'. */
568 return BYTE8_TO_CHAR (c
);
574 c
= (*readbyte
) (-1, readcharfun
);
578 (*readbyte
) (buf
[i
], readcharfun
);
579 return BYTE8_TO_CHAR (buf
[0]);
586 charset
= emacs_mule_charset
[buf
[0]];
587 code
= buf
[1] & 0x7F;
591 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
592 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
594 charset
= emacs_mule_charset
[buf
[1]];
595 code
= buf
[2] & 0x7F;
599 charset
= emacs_mule_charset
[buf
[0]];
600 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
605 charset
= emacs_mule_charset
[buf
[1]];
606 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
608 c
= DECODE_CHAR (charset
, code
);
610 Fsignal (Qinvalid_read_syntax
,
611 Fcons (build_string ("invalid multibyte form"), Qnil
));
616 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
618 static Lisp_Object
read0 (Lisp_Object
);
619 static Lisp_Object
read1 (Lisp_Object
, int *, int);
621 static Lisp_Object
read_list (int, Lisp_Object
);
622 static Lisp_Object
read_vector (Lisp_Object
, int);
624 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
626 static void substitute_object_in_subtree (Lisp_Object
,
628 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
631 /* Get a character from the tty. */
633 /* Read input events until we get one that's acceptable for our purposes.
635 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
636 until we get a character we like, and then stuffed into
639 If ASCII_REQUIRED is non-zero, we check function key events to see
640 if the unmodified version of the symbol has a Qascii_character
641 property, and use that character, if present.
643 If ERROR_NONASCII is non-zero, we signal an error if the input we
644 get isn't an ASCII character with modifiers. If it's zero but
645 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
648 If INPUT_METHOD is nonzero, we invoke the current input method
649 if the character warrants that.
651 If SECONDS is a number, we wait that many seconds for input, and
652 return Qnil if no input arrives within that time. */
655 read_filtered_event (int no_switch_frame
, int ascii_required
,
656 int error_nonascii
, int input_method
, Lisp_Object seconds
)
658 Lisp_Object val
, delayed_switch_frame
;
661 #ifdef HAVE_WINDOW_SYSTEM
662 if (display_hourglass_p
)
666 delayed_switch_frame
= Qnil
;
668 /* Compute timeout. */
669 if (NUMBERP (seconds
))
671 EMACS_TIME wait_time
;
673 double duration
= extract_float (seconds
);
675 sec
= (int) duration
;
676 usec
= (duration
- sec
) * 1000000;
677 EMACS_GET_TIME (end_time
);
678 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
679 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
682 /* Read until we get an acceptable event. */
685 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
686 NUMBERP (seconds
) ? &end_time
: NULL
);
687 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
692 /* switch-frame events are put off until after the next ASCII
693 character. This is better than signaling an error just because
694 the last characters were typed to a separate minibuffer frame,
695 for example. Eventually, some code which can deal with
696 switch-frame events will read it and process it. */
698 && EVENT_HAS_PARAMETERS (val
)
699 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
701 delayed_switch_frame
= val
;
705 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
707 /* Convert certain symbols to their ASCII equivalents. */
710 Lisp_Object tem
, tem1
;
711 tem
= Fget (val
, Qevent_symbol_element_mask
);
714 tem1
= Fget (Fcar (tem
), Qascii_character
);
715 /* Merge this symbol's modifier bits
716 with the ASCII equivalent of its basic code. */
718 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
722 /* If we don't have a character now, deal with it appropriately. */
727 Vunread_command_events
= Fcons (val
, Qnil
);
728 error ("Non-character input-event");
735 if (! NILP (delayed_switch_frame
))
736 unread_switch_frame
= delayed_switch_frame
;
740 #ifdef HAVE_WINDOW_SYSTEM
741 if (display_hourglass_p
)
750 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
751 doc
: /* Read a character from the command input (keyboard or macro).
752 It is returned as a number.
753 If the character has modifiers, they are resolved and reflected to the
754 character code if possible (e.g. C-SPC -> 0).
756 If the user generates an event which is not a character (i.e. a mouse
757 click or function key event), `read-char' signals an error. As an
758 exception, switch-frame events are put off until non-character events
760 If you want to read non-character events, or ignore them, call
761 `read-event' or `read-char-exclusive' instead.
763 If the optional argument PROMPT is non-nil, display that as a prompt.
764 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
765 input method is turned on in the current buffer, that input method
766 is used for reading a character.
767 If the optional argument SECONDS is non-nil, it should be a number
768 specifying the maximum number of seconds to wait for input. If no
769 input arrives in that time, return nil. SECONDS may be a
770 floating-point value. */)
771 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
776 message_with_string ("%s", prompt
, 0);
777 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
779 return (NILP (val
) ? Qnil
780 : make_number (char_resolve_modifier_mask (XINT (val
))));
783 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
784 doc
: /* Read an event object from the input stream.
785 If the optional argument PROMPT is non-nil, display that as a prompt.
786 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
787 input method is turned on in the current buffer, that input method
788 is used for reading a character.
789 If the optional argument SECONDS is non-nil, it should be a number
790 specifying the maximum number of seconds to wait for input. If no
791 input arrives in that time, return nil. SECONDS may be a
792 floating-point value. */)
793 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
796 message_with_string ("%s", prompt
, 0);
797 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
800 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
801 doc
: /* Read a character from the command input (keyboard or macro).
802 It is returned as a number. Non-character events are ignored.
803 If the character has modifiers, they are resolved and reflected to the
804 character code if possible (e.g. C-SPC -> 0).
806 If the optional argument PROMPT is non-nil, display that as a prompt.
807 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
808 input method is turned on in the current buffer, that input method
809 is used for reading a character.
810 If the optional argument SECONDS is non-nil, it should be a number
811 specifying the maximum number of seconds to wait for input. If no
812 input arrives in that time, return nil. SECONDS may be a
813 floating-point value. */)
814 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
819 message_with_string ("%s", prompt
, 0);
821 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
823 return (NILP (val
) ? Qnil
824 : make_number (char_resolve_modifier_mask (XINT (val
))));
827 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
828 doc
: /* Don't use this yourself. */)
831 register Lisp_Object val
;
833 XSETINT (val
, getc (instream
));
840 /* Value is a version number of byte compiled code if the file
841 associated with file descriptor FD is a compiled Lisp file that's
842 safe to load. Only files compiled with Emacs are safe to load.
843 Files compiled with XEmacs can lead to a crash in Fbyte_code
844 because of an incompatible change in the byte compiler. */
847 safe_to_load_p (int fd
)
854 /* Read the first few bytes from the file, and look for a line
855 specifying the byte compiler version used. */
856 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
861 /* Skip to the next newline, skipping over the initial `ELC'
862 with NUL bytes following it, but note the version. */
863 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
868 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
875 lseek (fd
, 0, SEEK_SET
);
880 /* Callback for record_unwind_protect. Restore the old load list OLD,
881 after loading a file successfully. */
884 record_load_unwind (Lisp_Object old
)
886 return Vloads_in_progress
= old
;
889 /* This handler function is used via internal_condition_case_1. */
892 load_error_handler (Lisp_Object data
)
898 load_warn_old_style_backquotes (Lisp_Object file
)
900 if (!NILP (Vold_style_backquotes
))
903 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
910 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
911 doc
: /* Return the suffixes that `load' should try if a suffix is \
913 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
916 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
917 while (CONSP (suffixes
))
919 Lisp_Object exts
= Vload_file_rep_suffixes
;
920 suffix
= XCAR (suffixes
);
921 suffixes
= XCDR (suffixes
);
926 lst
= Fcons (concat2 (suffix
, ext
), lst
);
929 return Fnreverse (lst
);
932 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
933 doc
: /* Execute a file of Lisp code named FILE.
934 First try FILE with `.elc' appended, then try with `.el',
935 then try FILE unmodified (the exact suffixes in the exact order are
936 determined by `load-suffixes'). Environment variable references in
937 FILE are replaced with their values by calling `substitute-in-file-name'.
938 This function searches the directories in `load-path'.
940 If optional second arg NOERROR is non-nil,
941 report no error if FILE doesn't exist.
942 Print messages at start and end of loading unless
943 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
945 If optional fourth arg NOSUFFIX is non-nil, don't try adding
946 suffixes `.elc' or `.el' to the specified name FILE.
947 If optional fifth arg MUST-SUFFIX is non-nil, insist on
948 the suffix `.elc' or `.el'; don't accept just FILE unless
949 it ends in one of those suffixes or includes a directory name.
951 If this function fails to find a file, it may look for different
952 representations of that file before trying another file.
953 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
954 to the file name. Emacs uses this feature mainly to find compressed
955 versions of files when Auto Compression mode is enabled.
957 The exact suffixes that this function tries out, in the exact order,
958 are given by the value of the variable `load-file-rep-suffixes' if
959 NOSUFFIX is non-nil and by the return value of the function
960 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
961 MUST-SUFFIX are nil, this function first tries out the latter suffixes
964 Loading a file records its definitions, and its `provide' and
965 `require' calls, in an element of `load-history' whose
966 car is the file name loaded. See `load-history'.
968 Return t if the file exists and loads successfully. */)
969 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
971 register FILE *stream
;
972 register int fd
= -1;
973 int count
= SPECPDL_INDEX ();
974 struct gcpro gcpro1
, gcpro2
, gcpro3
;
975 Lisp_Object found
, efound
, hist_file_name
;
976 /* 1 means we printed the ".el is newer" message. */
978 /* 1 means we are loading a compiled file. */
982 const char *fmode
= "r";
992 /* If file name is magic, call the handler. */
993 /* This shouldn't be necessary any more now that `openp' handles it right.
994 handler = Ffind_file_name_handler (file, Qload);
996 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
998 /* Do this after the handler to avoid
999 the need to gcpro noerror, nomessage and nosuffix.
1000 (Below here, we care only whether they are nil or not.)
1001 The presence of this call is the result of a historical accident:
1002 it used to be in every file-operation and when it got removed
1003 everywhere, it accidentally stayed here. Since then, enough people
1004 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1005 that it seemed risky to remove. */
1006 if (! NILP (noerror
))
1008 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1009 Qt
, load_error_handler
);
1014 file
= Fsubstitute_in_file_name (file
);
1017 /* Avoid weird lossage with null string as arg,
1018 since it would try to load a directory as a Lisp file */
1019 if (SCHARS (file
) > 0)
1021 int size
= SBYTES (file
);
1024 GCPRO2 (file
, found
);
1026 if (! NILP (must_suffix
))
1028 /* Don't insist on adding a suffix if FILE already ends with one. */
1030 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1033 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1035 /* Don't insist on adding a suffix
1036 if the argument includes a directory name. */
1037 else if (! NILP (Ffile_name_directory (file
)))
1041 fd
= openp (Vload_path
, file
,
1042 (!NILP (nosuffix
) ? Qnil
1043 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1044 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1045 tmp
[1] = Vload_file_rep_suffixes
,
1054 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1058 /* Tell startup.el whether or not we found the user's init file. */
1059 if (EQ (Qt
, Vuser_init_file
))
1060 Vuser_init_file
= found
;
1062 /* If FD is -2, that means openp found a magic file. */
1065 if (NILP (Fequal (found
, file
)))
1066 /* If FOUND is a different file name from FILE,
1067 find its handler even if we have already inhibited
1068 the `load' operation on FILE. */
1069 handler
= Ffind_file_name_handler (found
, Qt
);
1071 handler
= Ffind_file_name_handler (found
, Qload
);
1072 if (! NILP (handler
))
1073 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1076 /* Check if we're stuck in a recursive load cycle.
1078 2000-09-21: It's not possible to just check for the file loaded
1079 being a member of Vloads_in_progress. This fails because of the
1080 way the byte compiler currently works; `provide's are not
1081 evaluated, see font-lock.el/jit-lock.el as an example. This
1082 leads to a certain amount of ``normal'' recursion.
1084 Also, just loading a file recursively is not always an error in
1085 the general case; the second load may do something different. */
1089 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1090 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1094 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1096 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1097 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1100 /* Get the name for load-history. */
1101 hist_file_name
= (! NILP (Vpurify_flag
)
1102 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1103 tmp
[1] = Ffile_name_nondirectory (found
),
1109 /* Check for the presence of old-style quotes and warn about them. */
1110 specbind (Qold_style_backquotes
, Qnil
);
1111 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1113 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1114 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1115 /* Load .elc files directly, but not when they are
1116 remote and have no handler! */
1123 GCPRO3 (file
, found
, hist_file_name
);
1126 && ! (version
= safe_to_load_p (fd
)))
1129 if (!load_dangerous_libraries
)
1133 error ("File `%s' was not compiled in Emacs",
1136 else if (!NILP (nomessage
) && !force_load_messages
)
1137 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1142 efound
= ENCODE_FILE (found
);
1147 stat ((char *)SDATA (efound
), &s1
);
1148 SSET (efound
, SBYTES (efound
) - 1, 0);
1149 result
= stat ((char *)SDATA (efound
), &s2
);
1150 SSET (efound
, SBYTES (efound
) - 1, 'c');
1152 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1154 /* Make the progress messages mention that source is newer. */
1157 /* If we won't print another message, mention this anyway. */
1158 if (!NILP (nomessage
) && !force_load_messages
)
1160 Lisp_Object msg_file
;
1161 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1162 message_with_string ("Source file `%s' newer than byte-compiled file",
1171 /* We are loading a source file (*.el). */
1172 if (!NILP (Vload_source_file_function
))
1178 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1179 NILP (noerror
) ? Qnil
: Qt
,
1180 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1181 return unbind_to (count
, val
);
1185 GCPRO3 (file
, found
, hist_file_name
);
1189 efound
= ENCODE_FILE (found
);
1190 stream
= fopen ((char *) SDATA (efound
), fmode
);
1191 #else /* not WINDOWSNT */
1192 stream
= fdopen (fd
, fmode
);
1193 #endif /* not WINDOWSNT */
1197 error ("Failure to create stdio stream for %s", SDATA (file
));
1200 if (! NILP (Vpurify_flag
))
1201 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1203 if (NILP (nomessage
) || force_load_messages
)
1206 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1209 message_with_string ("Loading %s (source)...", file
, 1);
1211 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1213 else /* The typical case; compiled file newer than source file. */
1214 message_with_string ("Loading %s...", file
, 1);
1217 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1218 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1219 specbind (Qload_file_name
, found
);
1220 specbind (Qinhibit_file_name_operation
, Qnil
);
1221 load_descriptor_list
1222 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1223 specbind (Qload_in_progress
, Qt
);
1224 if (! version
|| version
>= 22)
1225 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1226 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1229 /* We can't handle a file which was compiled with
1230 byte-compile-dynamic by older version of Emacs. */
1231 specbind (Qload_force_doc_strings
, Qt
);
1232 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1233 0, Qnil
, Qnil
, Qnil
, Qnil
);
1235 unbind_to (count
, Qnil
);
1237 /* Run any eval-after-load forms for this file */
1238 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1239 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1243 xfree (saved_doc_string
);
1244 saved_doc_string
= 0;
1245 saved_doc_string_size
= 0;
1247 xfree (prev_saved_doc_string
);
1248 prev_saved_doc_string
= 0;
1249 prev_saved_doc_string_size
= 0;
1251 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1254 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1257 message_with_string ("Loading %s (source)...done", file
, 1);
1259 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1261 else /* The typical case; compiled file newer than source file. */
1262 message_with_string ("Loading %s...done", file
, 1);
1269 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1271 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1282 load_descriptor_unwind (Lisp_Object oldlist
)
1284 load_descriptor_list
= oldlist
;
1288 /* Close all descriptors in use for Floads.
1289 This is used when starting a subprocess. */
1292 close_load_descs (void)
1296 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1297 emacs_close (XFASTINT (XCAR (tail
)));
1302 complete_filename_p (Lisp_Object pathname
)
1304 register const unsigned char *s
= SDATA (pathname
);
1305 return (IS_DIRECTORY_SEP (s
[0])
1306 || (SCHARS (pathname
) > 2
1307 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1310 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1311 doc
: /* Search for FILENAME through PATH.
1312 Returns the file's name in absolute form, or nil if not found.
1313 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1314 file name when searching.
1315 If non-nil, PREDICATE is used instead of `file-readable-p'.
1316 PREDICATE can also be an integer to pass to the access(2) function,
1317 in which case file-name-handlers are ignored. */)
1318 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1321 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1322 if (NILP (predicate
) && fd
> 0)
1328 /* Search for a file whose name is STR, looking in directories
1329 in the Lisp list PATH, and trying suffixes from SUFFIX.
1330 On success, returns a file descriptor. On failure, returns -1.
1332 SUFFIXES is a list of strings containing possible suffixes.
1333 The empty suffix is automatically added if the list is empty.
1335 PREDICATE non-nil means don't open the files,
1336 just look for one that satisfies the predicate. In this case,
1337 returns 1 on success. The predicate can be a lisp function or
1338 an integer to pass to `access' (in which case file-name-handlers
1341 If STOREPTR is nonzero, it points to a slot where the name of
1342 the file actually found should be stored as a Lisp string.
1343 nil is stored there on failure.
1345 If the file we find is remote, return -2
1346 but store the found remote file name in *STOREPTR. */
1349 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1354 register char *fn
= buf
;
1357 Lisp_Object filename
;
1359 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1360 Lisp_Object string
, tail
, encoded_fn
;
1361 int max_suffix_len
= 0;
1365 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1367 CHECK_STRING_CAR (tail
);
1368 max_suffix_len
= max (max_suffix_len
,
1369 SBYTES (XCAR (tail
)));
1372 string
= filename
= encoded_fn
= Qnil
;
1373 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1378 if (complete_filename_p (str
))
1381 for (; CONSP (path
); path
= XCDR (path
))
1383 filename
= Fexpand_file_name (str
, XCAR (path
));
1384 if (!complete_filename_p (filename
))
1385 /* If there are non-absolute elts in PATH (eg ".") */
1386 /* Of course, this could conceivably lose if luser sets
1387 default-directory to be something non-absolute... */
1389 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1390 if (!complete_filename_p (filename
))
1391 /* Give up on this path element! */
1395 /* Calculate maximum size of any filename made from
1396 this path element/specified file name and any possible suffix. */
1397 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1398 if (fn_size
< want_size
)
1399 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1401 /* Loop over suffixes. */
1402 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1403 CONSP (tail
); tail
= XCDR (tail
))
1405 int lsuffix
= SBYTES (XCAR (tail
));
1406 Lisp_Object handler
;
1409 /* Concatenate path element/specified name with the suffix.
1410 If the directory starts with /:, remove that. */
1411 if (SCHARS (filename
) > 2
1412 && SREF (filename
, 0) == '/'
1413 && SREF (filename
, 1) == ':')
1415 strncpy (fn
, SDATA (filename
) + 2,
1416 SBYTES (filename
) - 2);
1417 fn
[SBYTES (filename
) - 2] = 0;
1421 strncpy (fn
, SDATA (filename
),
1423 fn
[SBYTES (filename
)] = 0;
1426 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1427 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1429 /* Check that the file exists and is not a directory. */
1430 /* We used to only check for handlers on non-absolute file names:
1434 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1435 It's not clear why that was the case and it breaks things like
1436 (load "/bar.el") where the file is actually "/bar.el.gz". */
1437 string
= build_string (fn
);
1438 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1439 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1441 if (NILP (predicate
))
1442 exists
= !NILP (Ffile_readable_p (string
));
1444 exists
= !NILP (call1 (predicate
, string
));
1445 if (exists
&& !NILP (Ffile_directory_p (string
)))
1450 /* We succeeded; return this descriptor and filename. */
1461 encoded_fn
= ENCODE_FILE (string
);
1462 pfn
= SDATA (encoded_fn
);
1463 exists
= (stat (pfn
, &st
) >= 0
1464 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1467 /* Check that we can access or open it. */
1468 if (NATNUMP (predicate
))
1469 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1471 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1475 /* We succeeded; return this descriptor and filename. */
1493 /* Merge the list we've accumulated of globals from the current input source
1494 into the load_history variable. The details depend on whether
1495 the source has an associated file name or not.
1497 FILENAME is the file name that we are loading from.
1498 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1501 build_load_history (Lisp_Object filename
, int entire
)
1503 register Lisp_Object tail
, prev
, newelt
;
1504 register Lisp_Object tem
, tem2
;
1505 register int foundit
= 0;
1507 tail
= Vload_history
;
1510 while (CONSP (tail
))
1514 /* Find the feature's previous assoc list... */
1515 if (!NILP (Fequal (filename
, Fcar (tem
))))
1519 /* If we're loading the entire file, remove old data. */
1523 Vload_history
= XCDR (tail
);
1525 Fsetcdr (prev
, XCDR (tail
));
1528 /* Otherwise, cons on new symbols that are not already members. */
1531 tem2
= Vcurrent_load_list
;
1533 while (CONSP (tem2
))
1535 newelt
= XCAR (tem2
);
1537 if (NILP (Fmember (newelt
, tem
)))
1538 Fsetcar (tail
, Fcons (XCAR (tem
),
1539 Fcons (newelt
, XCDR (tem
))));
1552 /* If we're loading an entire file, cons the new assoc onto the
1553 front of load-history, the most-recently-loaded position. Also
1554 do this if we didn't find an existing member for the file. */
1555 if (entire
|| !foundit
)
1556 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1561 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1568 readevalloop_1 (Lisp_Object old
)
1570 load_convert_to_unibyte
= ! NILP (old
);
1574 /* Signal an `end-of-file' error, if possible with file name
1578 end_of_file_error (void)
1580 if (STRINGP (Vload_file_name
))
1581 xsignal1 (Qend_of_file
, Vload_file_name
);
1583 xsignal0 (Qend_of_file
);
1586 /* UNIBYTE specifies how to set load_convert_to_unibyte
1587 for this invocation.
1588 READFUN, if non-nil, is used instead of `read'.
1590 START, END specify region to read in current buffer (from eval-region).
1591 If the input is not from a buffer, they must be nil. */
1594 readevalloop (Lisp_Object readcharfun
,
1596 Lisp_Object sourcename
,
1597 Lisp_Object (*evalfun
) (Lisp_Object
),
1599 Lisp_Object unibyte
, Lisp_Object readfun
,
1600 Lisp_Object start
, Lisp_Object end
)
1603 register Lisp_Object val
;
1604 int count
= SPECPDL_INDEX ();
1605 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1606 struct buffer
*b
= 0;
1607 int continue_reading_p
;
1608 /* Nonzero if reading an entire buffer. */
1609 int whole_buffer
= 0;
1610 /* 1 on the first time around. */
1613 if (MARKERP (readcharfun
))
1616 start
= readcharfun
;
1619 if (BUFFERP (readcharfun
))
1620 b
= XBUFFER (readcharfun
);
1621 else if (MARKERP (readcharfun
))
1622 b
= XMARKER (readcharfun
)->buffer
;
1624 /* We assume START is nil when input is not from a buffer. */
1625 if (! NILP (start
) && !b
)
1628 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1629 specbind (Qcurrent_load_list
, Qnil
);
1630 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1631 load_convert_to_unibyte
= !NILP (unibyte
);
1633 GCPRO4 (sourcename
, readfun
, start
, end
);
1635 /* Try to ensure sourcename is a truename, except whilst preloading. */
1636 if (NILP (Vpurify_flag
)
1637 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1638 && !NILP (Ffboundp (Qfile_truename
)))
1639 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1641 LOADHIST_ATTACH (sourcename
);
1643 continue_reading_p
= 1;
1644 while (continue_reading_p
)
1646 int count1
= SPECPDL_INDEX ();
1648 if (b
!= 0 && NILP (b
->name
))
1649 error ("Reading from killed buffer");
1653 /* Switch to the buffer we are reading from. */
1654 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1655 set_buffer_internal (b
);
1657 /* Save point in it. */
1658 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1659 /* Save ZV in it. */
1660 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1661 /* Those get unbound after we read one expression. */
1663 /* Set point and ZV around stuff to be read. */
1666 Fnarrow_to_region (make_number (BEGV
), end
);
1668 /* Just for cleanliness, convert END to a marker
1669 if it is an integer. */
1671 end
= Fpoint_max_marker ();
1674 /* On the first cycle, we can easily test here
1675 whether we are reading the whole buffer. */
1676 if (b
&& first_sexp
)
1677 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1684 while ((c
= READCHAR
) != '\n' && c
!= -1);
1689 unbind_to (count1
, Qnil
);
1693 /* Ignore whitespace here, so we can detect eof. */
1694 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1695 || c
== 0x8a0) /* NBSP */
1698 if (!NILP (Vpurify_flag
) && c
== '(')
1700 record_unwind_protect (unreadpure
, Qnil
);
1701 val
= read_list (-1, readcharfun
);
1706 read_objects
= Qnil
;
1707 if (!NILP (readfun
))
1709 val
= call1 (readfun
, readcharfun
);
1711 /* If READCHARFUN has set point to ZV, we should
1712 stop reading, even if the form read sets point
1713 to a different value when evaluated. */
1714 if (BUFFERP (readcharfun
))
1716 struct buffer
*b
= XBUFFER (readcharfun
);
1717 if (BUF_PT (b
) == BUF_ZV (b
))
1718 continue_reading_p
= 0;
1721 else if (! NILP (Vload_read_function
))
1722 val
= call1 (Vload_read_function
, readcharfun
);
1724 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1727 if (!NILP (start
) && continue_reading_p
)
1728 start
= Fpoint_marker ();
1730 /* Restore saved point and BEGV. */
1731 unbind_to (count1
, Qnil
);
1733 /* Now eval what we just read. */
1734 val
= (*evalfun
) (val
);
1738 Vvalues
= Fcons (val
, Vvalues
);
1739 if (EQ (Vstandard_output
, Qt
))
1748 build_load_history (sourcename
,
1749 stream
|| whole_buffer
);
1753 unbind_to (count
, Qnil
);
1756 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1757 doc
: /* Execute the current buffer as Lisp code.
1758 When called from a Lisp program (i.e., not interactively), this
1759 function accepts up to five optional arguments:
1760 BUFFER is the buffer to evaluate (nil means use current buffer).
1761 PRINTFLAG controls printing of output:
1762 A value of nil means discard it; anything else is stream for print.
1763 FILENAME specifies the file name to use for `load-history'.
1764 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1766 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1767 functions should work normally even if PRINTFLAG is nil.
1769 This function preserves the position of point. */)
1770 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1772 int count
= SPECPDL_INDEX ();
1773 Lisp_Object tem
, buf
;
1776 buf
= Fcurrent_buffer ();
1778 buf
= Fget_buffer (buffer
);
1780 error ("No such buffer");
1782 if (NILP (printflag
) && NILP (do_allow_print
))
1787 if (NILP (filename
))
1788 filename
= XBUFFER (buf
)->filename
;
1790 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1791 specbind (Qstandard_output
, tem
);
1792 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1793 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1794 readevalloop (buf
, 0, filename
, Feval
,
1795 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1796 unbind_to (count
, Qnil
);
1801 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1802 doc
: /* Execute the region as Lisp code.
1803 When called from programs, expects two arguments,
1804 giving starting and ending indices in the current buffer
1805 of the text to be executed.
1806 Programs can pass third argument PRINTFLAG which controls output:
1807 A value of nil means discard it; anything else is stream for printing it.
1808 Also the fourth argument READ-FUNCTION, if non-nil, is used
1809 instead of `read' to read each expression. It gets one argument
1810 which is the input stream for reading characters.
1812 This function does not move point. */)
1813 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1815 int count
= SPECPDL_INDEX ();
1816 Lisp_Object tem
, cbuf
;
1818 cbuf
= Fcurrent_buffer ();
1820 if (NILP (printflag
))
1824 specbind (Qstandard_output
, tem
);
1825 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1827 /* readevalloop calls functions which check the type of start and end. */
1828 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1829 !NILP (printflag
), Qnil
, read_function
,
1832 return unbind_to (count
, Qnil
);
1836 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1837 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1838 If STREAM is nil, use the value of `standard-input' (which see).
1839 STREAM or the value of `standard-input' may be:
1840 a buffer (read from point and advance it)
1841 a marker (read from where it points and advance it)
1842 a function (call it with no arguments for each character,
1843 call it with a char as argument to push a char back)
1844 a string (takes text from string, starting at the beginning)
1845 t (read text line using minibuffer and use it, or read from
1846 standard input in batch mode). */)
1847 (Lisp_Object stream
)
1850 stream
= Vstandard_input
;
1851 if (EQ (stream
, Qt
))
1852 stream
= Qread_char
;
1853 if (EQ (stream
, Qread_char
))
1854 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1856 return read_internal_start (stream
, Qnil
, Qnil
);
1859 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1860 doc
: /* Read one Lisp expression which is represented as text by STRING.
1861 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1862 START and END optionally delimit a substring of STRING from which to read;
1863 they default to 0 and (length STRING) respectively. */)
1864 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1867 CHECK_STRING (string
);
1868 /* read_internal_start sets read_from_string_index. */
1869 ret
= read_internal_start (string
, start
, end
);
1870 return Fcons (ret
, make_number (read_from_string_index
));
1873 /* Function to set up the global context we need in toplevel read
1876 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1877 /* start, end only used when stream is a string. */
1882 new_backquote_flag
= 0;
1883 read_objects
= Qnil
;
1884 if (EQ (Vread_with_symbol_positions
, Qt
)
1885 || EQ (Vread_with_symbol_positions
, stream
))
1886 Vread_symbol_positions_list
= Qnil
;
1888 if (STRINGP (stream
)
1889 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1891 EMACS_INT startval
, endval
;
1894 if (STRINGP (stream
))
1897 string
= XCAR (stream
);
1900 endval
= SCHARS (string
);
1904 endval
= XINT (end
);
1905 if (endval
< 0 || endval
> SCHARS (string
))
1906 args_out_of_range (string
, end
);
1913 CHECK_NUMBER (start
);
1914 startval
= XINT (start
);
1915 if (startval
< 0 || startval
> endval
)
1916 args_out_of_range (string
, start
);
1918 read_from_string_index
= startval
;
1919 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1920 read_from_string_limit
= endval
;
1923 retval
= read0 (stream
);
1924 if (EQ (Vread_with_symbol_positions
, Qt
)
1925 || EQ (Vread_with_symbol_positions
, stream
))
1926 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1931 /* Signal Qinvalid_read_syntax error.
1932 S is error string of length N (if > 0) */
1935 invalid_syntax (const char *s
, int n
)
1939 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1943 /* Use this for recursive reads, in contexts where internal tokens
1947 read0 (Lisp_Object readcharfun
)
1949 register Lisp_Object val
;
1952 val
= read1 (readcharfun
, &c
, 0);
1956 xsignal1 (Qinvalid_read_syntax
,
1957 Fmake_string (make_number (1), make_number (c
)));
1960 static int read_buffer_size
;
1961 static char *read_buffer
;
1963 /* Read a \-escape sequence, assuming we already read the `\'.
1964 If the escape sequence forces unibyte, return eight-bit char. */
1967 read_escape (Lisp_Object readcharfun
, int stringp
)
1969 register int c
= READCHAR
;
1970 /* \u allows up to four hex digits, \U up to eight. Default to the
1971 behavior for \u, and change this value in the case that \U is seen. */
1972 int unicode_hex_count
= 4;
1977 end_of_file_error ();
2007 error ("Invalid escape character syntax");
2010 c
= read_escape (readcharfun
, 0);
2011 return c
| meta_modifier
;
2016 error ("Invalid escape character syntax");
2019 c
= read_escape (readcharfun
, 0);
2020 return c
| shift_modifier
;
2025 error ("Invalid escape character syntax");
2028 c
= read_escape (readcharfun
, 0);
2029 return c
| hyper_modifier
;
2034 error ("Invalid escape character syntax");
2037 c
= read_escape (readcharfun
, 0);
2038 return c
| alt_modifier
;
2042 if (stringp
|| c
!= '-')
2049 c
= read_escape (readcharfun
, 0);
2050 return c
| super_modifier
;
2055 error ("Invalid escape character syntax");
2059 c
= read_escape (readcharfun
, 0);
2060 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2061 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2062 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2063 return c
| ctrl_modifier
;
2064 /* ASCII control chars are made from letters (both cases),
2065 as well as the non-letters within 0100...0137. */
2066 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2067 return (c
& (037 | ~0177));
2068 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2069 return (c
& (037 | ~0177));
2071 return c
| ctrl_modifier
;
2081 /* An octal escape, as in ANSI C. */
2083 register int i
= c
- '0';
2084 register int count
= 0;
2087 if ((c
= READCHAR
) >= '0' && c
<= '7')
2099 if (i
>= 0x80 && i
< 0x100)
2100 i
= BYTE8_TO_CHAR (i
);
2105 /* A hex escape, as in ANSI C. */
2112 if (c
>= '0' && c
<= '9')
2117 else if ((c
>= 'a' && c
<= 'f')
2118 || (c
>= 'A' && c
<= 'F'))
2121 if (c
>= 'a' && c
<= 'f')
2134 if (count
< 3 && i
>= 0x80)
2135 return BYTE8_TO_CHAR (i
);
2140 /* Post-Unicode-2.0: Up to eight hex chars. */
2141 unicode_hex_count
= 8;
2144 /* A Unicode escape. We only permit them in strings and characters,
2145 not arbitrarily in the source code, as in some other languages. */
2150 while (++count
<= unicode_hex_count
)
2153 /* isdigit and isalpha may be locale-specific, which we don't
2155 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2156 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2157 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2160 error ("Non-hex digit used for Unicode escape");
2165 error ("Non-Unicode character: 0x%x", i
);
2174 /* Read an integer in radix RADIX using READCHARFUN to read
2175 characters. RADIX must be in the interval [2..36]; if it isn't, a
2176 read error is signaled . Value is the integer read. Signals an
2177 error if encountering invalid read syntax or if RADIX is out of
2181 read_integer (Lisp_Object readcharfun
, int radix
)
2183 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2184 /* We use a floating point number because */
2187 if (radix
< 2 || radix
> 36)
2191 number
= ndigits
= invalid_p
= 0;
2207 if (c
>= '0' && c
<= '9')
2209 else if (c
>= 'a' && c
<= 'z')
2210 digit
= c
- 'a' + 10;
2211 else if (c
>= 'A' && c
<= 'Z')
2212 digit
= c
- 'A' + 10;
2219 if (digit
< 0 || digit
>= radix
)
2222 number
= radix
* number
+ digit
;
2228 if (ndigits
== 0 || invalid_p
)
2231 sprintf (buf
, "integer, radix %d", radix
);
2232 invalid_syntax (buf
, 0);
2235 return make_fixnum_or_float (sign
* number
);
2239 /* If the next token is ')' or ']' or '.', we store that character
2240 in *PCH and the return value is not interesting. Else, we store
2241 zero in *PCH and we read and return one lisp object.
2243 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2246 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2249 int uninterned_symbol
= 0;
2257 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2259 end_of_file_error ();
2264 return read_list (0, readcharfun
);
2267 return read_vector (readcharfun
, 0);
2283 /* Accept extended format for hashtables (extensible to
2285 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2286 Lisp_Object tmp
= read_list (0, readcharfun
);
2287 Lisp_Object head
= CAR_SAFE (tmp
);
2288 Lisp_Object data
= Qnil
;
2289 Lisp_Object val
= Qnil
;
2290 /* The size is 2 * number of allowed keywords to
2292 Lisp_Object params
[10];
2294 Lisp_Object key
= Qnil
;
2295 int param_count
= 0;
2297 if (!EQ (head
, Qhash_table
))
2298 error ("Invalid extended read marker at head of #s list "
2299 "(only hash-table allowed)");
2301 tmp
= CDR_SAFE (tmp
);
2303 /* This is repetitive but fast and simple. */
2304 params
[param_count
] = QCsize
;
2305 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2306 if (!NILP (params
[param_count
+ 1]))
2309 params
[param_count
] = QCtest
;
2310 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2311 if (!NILP (params
[param_count
+ 1]))
2314 params
[param_count
] = QCweakness
;
2315 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2316 if (!NILP (params
[param_count
+ 1]))
2319 params
[param_count
] = QCrehash_size
;
2320 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2321 if (!NILP (params
[param_count
+ 1]))
2324 params
[param_count
] = QCrehash_threshold
;
2325 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2326 if (!NILP (params
[param_count
+ 1]))
2329 /* This is the hashtable data. */
2330 data
= Fplist_get (tmp
, Qdata
);
2332 /* Now use params to make a new hashtable and fill it. */
2333 ht
= Fmake_hash_table (param_count
, params
);
2335 while (CONSP (data
))
2340 error ("Odd number of elements in hashtable data");
2343 Fputhash (key
, val
, ht
);
2349 invalid_syntax ("#", 1);
2357 tmp
= read_vector (readcharfun
, 0);
2358 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2359 error ("Invalid size char-table");
2360 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2371 tmp
= read_vector (readcharfun
, 0);
2372 if (!INTEGERP (AREF (tmp
, 0)))
2373 error ("Invalid depth in char-table");
2374 depth
= XINT (AREF (tmp
, 0));
2375 if (depth
< 1 || depth
> 3)
2376 error ("Invalid depth in char-table");
2377 size
= XVECTOR (tmp
)->size
- 2;
2378 if (chartab_size
[depth
] != size
)
2379 error ("Invalid size char-table");
2380 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2383 invalid_syntax ("#^^", 3);
2385 invalid_syntax ("#^", 2);
2390 length
= read1 (readcharfun
, pch
, first_in_list
);
2394 Lisp_Object tmp
, val
;
2396 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2397 / BOOL_VECTOR_BITS_PER_CHAR
);
2400 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2401 if (STRING_MULTIBYTE (tmp
)
2402 || (size_in_chars
!= SCHARS (tmp
)
2403 /* We used to print 1 char too many
2404 when the number of bits was a multiple of 8.
2405 Accept such input in case it came from an old
2407 && ! (XFASTINT (length
)
2408 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2409 invalid_syntax ("#&...", 5);
2411 val
= Fmake_bool_vector (length
, Qnil
);
2412 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2413 /* Clear the extraneous bits in the last byte. */
2414 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2415 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2416 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2419 invalid_syntax ("#&...", 5);
2423 /* Accept compiled functions at read-time so that we don't have to
2424 build them using function calls. */
2426 tmp
= read_vector (readcharfun
, 1);
2427 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2428 XVECTOR (tmp
)->contents
);
2433 struct gcpro gcpro1
;
2436 /* Read the string itself. */
2437 tmp
= read1 (readcharfun
, &ch
, 0);
2438 if (ch
!= 0 || !STRINGP (tmp
))
2439 invalid_syntax ("#", 1);
2441 /* Read the intervals and their properties. */
2444 Lisp_Object beg
, end
, plist
;
2446 beg
= read1 (readcharfun
, &ch
, 0);
2451 end
= read1 (readcharfun
, &ch
, 0);
2453 plist
= read1 (readcharfun
, &ch
, 0);
2455 invalid_syntax ("Invalid string property list", 0);
2456 Fset_text_properties (beg
, end
, plist
, tmp
);
2462 /* #@NUMBER is used to skip NUMBER following characters.
2463 That's used in .elc files to skip over doc strings
2464 and function definitions. */
2470 /* Read a decimal integer. */
2471 while ((c
= READCHAR
) >= 0
2472 && c
>= '0' && c
<= '9')
2480 if (load_force_doc_strings
2481 && (EQ (readcharfun
, Qget_file_char
)
2482 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2484 /* If we are supposed to force doc strings into core right now,
2485 record the last string that we skipped,
2486 and record where in the file it comes from. */
2488 /* But first exchange saved_doc_string
2489 with prev_saved_doc_string, so we save two strings. */
2491 char *temp
= saved_doc_string
;
2492 int temp_size
= saved_doc_string_size
;
2493 file_offset temp_pos
= saved_doc_string_position
;
2494 int temp_len
= saved_doc_string_length
;
2496 saved_doc_string
= prev_saved_doc_string
;
2497 saved_doc_string_size
= prev_saved_doc_string_size
;
2498 saved_doc_string_position
= prev_saved_doc_string_position
;
2499 saved_doc_string_length
= prev_saved_doc_string_length
;
2501 prev_saved_doc_string
= temp
;
2502 prev_saved_doc_string_size
= temp_size
;
2503 prev_saved_doc_string_position
= temp_pos
;
2504 prev_saved_doc_string_length
= temp_len
;
2507 if (saved_doc_string_size
== 0)
2509 saved_doc_string_size
= nskip
+ 100;
2510 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2512 if (nskip
> saved_doc_string_size
)
2514 saved_doc_string_size
= nskip
+ 100;
2515 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2516 saved_doc_string_size
);
2519 saved_doc_string_position
= file_tell (instream
);
2521 /* Copy that many characters into saved_doc_string. */
2522 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2523 saved_doc_string
[i
] = c
= READCHAR
;
2525 saved_doc_string_length
= i
;
2529 /* Skip that many characters. */
2530 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2539 /* #! appears at the beginning of an executable file.
2540 Skip the first line. */
2541 while (c
!= '\n' && c
>= 0)
2546 return Vload_file_name
;
2548 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2549 /* #:foo is the uninterned symbol named foo. */
2552 uninterned_symbol
= 1;
2556 /* Reader forms that can reuse previously read objects. */
2557 if (c
>= '0' && c
<= '9')
2562 /* Read a non-negative integer. */
2563 while (c
>= '0' && c
<= '9')
2569 /* #n=object returns object, but associates it with n for #n#. */
2570 if (c
== '=' && !NILP (Vread_circle
))
2572 /* Make a placeholder for #n# to use temporarily */
2573 Lisp_Object placeholder
;
2576 placeholder
= Fcons (Qnil
, Qnil
);
2577 cell
= Fcons (make_number (n
), placeholder
);
2578 read_objects
= Fcons (cell
, read_objects
);
2580 /* Read the object itself. */
2581 tem
= read0 (readcharfun
);
2583 /* Now put it everywhere the placeholder was... */
2584 substitute_object_in_subtree (tem
, placeholder
);
2586 /* ...and #n# will use the real value from now on. */
2587 Fsetcdr (cell
, tem
);
2591 /* #n# returns a previously read object. */
2592 if (c
== '#' && !NILP (Vread_circle
))
2594 tem
= Fassq (make_number (n
), read_objects
);
2597 /* Fall through to error message. */
2599 else if (c
== 'r' || c
== 'R')
2600 return read_integer (readcharfun
, n
);
2602 /* Fall through to error message. */
2604 else if (c
== 'x' || c
== 'X')
2605 return read_integer (readcharfun
, 16);
2606 else if (c
== 'o' || c
== 'O')
2607 return read_integer (readcharfun
, 8);
2608 else if (c
== 'b' || c
== 'B')
2609 return read_integer (readcharfun
, 2);
2612 invalid_syntax ("#", 1);
2615 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2620 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2625 int next_char
= READCHAR
;
2627 /* Transition from old-style to new-style:
2628 If we see "(`" it used to mean old-style, which usually works
2629 fine because ` should almost never appear in such a position
2630 for new-style. But occasionally we need "(`" to mean new
2631 style, so we try to distinguish the two by the fact that we
2632 can either write "( `foo" or "(` foo", where the first
2633 intends to use new-style whereas the second intends to use
2634 old-style. For Emacs-25, we should completely remove this
2635 first_in_list exception (old-style can still be obtained via
2637 if (first_in_list
&& next_char
== ' ')
2639 Vold_style_backquotes
= Qt
;
2646 new_backquote_flag
++;
2647 value
= read0 (readcharfun
);
2648 new_backquote_flag
--;
2650 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2654 if (new_backquote_flag
)
2656 Lisp_Object comma_type
= Qnil
;
2661 comma_type
= Qcomma_at
;
2663 comma_type
= Qcomma_dot
;
2666 if (ch
>= 0) UNREAD (ch
);
2667 comma_type
= Qcomma
;
2670 new_backquote_flag
--;
2671 value
= read0 (readcharfun
);
2672 new_backquote_flag
++;
2673 return Fcons (comma_type
, Fcons (value
, Qnil
));
2677 Vold_style_backquotes
= Qt
;
2689 end_of_file_error ();
2691 /* Accept `single space' syntax like (list ? x) where the
2692 whitespace character is SPC or TAB.
2693 Other literal whitespace like NL, CR, and FF are not accepted,
2694 as there are well-established escape sequences for these. */
2695 if (c
== ' ' || c
== '\t')
2696 return make_number (c
);
2699 c
= read_escape (readcharfun
, 0);
2700 modifiers
= c
& CHAR_MODIFIER_MASK
;
2701 c
&= ~CHAR_MODIFIER_MASK
;
2702 if (CHAR_BYTE8_P (c
))
2703 c
= CHAR_TO_BYTE8 (c
);
2706 next_char
= READCHAR
;
2707 if (next_char
== '.')
2709 /* Only a dotted-pair dot is valid after a char constant. */
2710 int next_next_char
= READCHAR
;
2711 UNREAD (next_next_char
);
2713 ok
= (next_next_char
<= 040
2714 || (next_next_char
< 0200
2715 && (strchr ("\"';([#?", next_next_char
)
2716 || (!first_in_list
&& next_next_char
== '`')
2717 || (new_backquote_flag
&& next_next_char
== ','))));
2721 ok
= (next_char
<= 040
2722 || (next_char
< 0200
2723 && (strchr ("\"';()[]#?", next_char
)
2724 || (!first_in_list
&& next_char
== '`')
2725 || (new_backquote_flag
&& next_char
== ','))));
2729 return make_number (c
);
2731 invalid_syntax ("?", 1);
2736 char *p
= read_buffer
;
2737 char *end
= read_buffer
+ read_buffer_size
;
2739 /* Nonzero if we saw an escape sequence specifying
2740 a multibyte character. */
2741 int force_multibyte
= 0;
2742 /* Nonzero if we saw an escape sequence specifying
2743 a single-byte character. */
2744 int force_singlebyte
= 0;
2748 while ((c
= READCHAR
) >= 0
2751 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2753 int offset
= p
- read_buffer
;
2754 read_buffer
= (char *) xrealloc (read_buffer
,
2755 read_buffer_size
*= 2);
2756 p
= read_buffer
+ offset
;
2757 end
= read_buffer
+ read_buffer_size
;
2764 c
= read_escape (readcharfun
, 1);
2766 /* C is -1 if \ newline has just been seen */
2769 if (p
== read_buffer
)
2774 modifiers
= c
& CHAR_MODIFIER_MASK
;
2775 c
= c
& ~CHAR_MODIFIER_MASK
;
2777 if (CHAR_BYTE8_P (c
))
2778 force_singlebyte
= 1;
2779 else if (! ASCII_CHAR_P (c
))
2780 force_multibyte
= 1;
2781 else /* i.e. ASCII_CHAR_P (c) */
2783 /* Allow `\C- ' and `\C-?'. */
2784 if (modifiers
== CHAR_CTL
)
2787 c
= 0, modifiers
= 0;
2789 c
= 127, modifiers
= 0;
2791 if (modifiers
& CHAR_SHIFT
)
2793 /* Shift modifier is valid only with [A-Za-z]. */
2794 if (c
>= 'A' && c
<= 'Z')
2795 modifiers
&= ~CHAR_SHIFT
;
2796 else if (c
>= 'a' && c
<= 'z')
2797 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2800 if (modifiers
& CHAR_META
)
2802 /* Move the meta bit to the right place for a
2804 modifiers
&= ~CHAR_META
;
2805 c
= BYTE8_TO_CHAR (c
| 0x80);
2806 force_singlebyte
= 1;
2810 /* Any modifiers remaining are invalid. */
2812 error ("Invalid modifier in string");
2813 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2817 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2818 if (CHAR_BYTE8_P (c
))
2819 force_singlebyte
= 1;
2820 else if (! ASCII_CHAR_P (c
))
2821 force_multibyte
= 1;
2827 end_of_file_error ();
2829 /* If purifying, and string starts with \ newline,
2830 return zero instead. This is for doc strings
2831 that we are really going to find in etc/DOC.nn.nn */
2832 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2833 return make_number (0);
2835 if (force_multibyte
)
2836 /* READ_BUFFER already contains valid multibyte forms. */
2838 else if (force_singlebyte
)
2840 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2841 p
= read_buffer
+ nchars
;
2844 /* Otherwise, READ_BUFFER contains only ASCII. */
2847 /* We want readchar_count to be the number of characters, not
2848 bytes. Hence we adjust for multibyte characters in the
2849 string. ... But it doesn't seem to be necessary, because
2850 READCHAR *does* read multibyte characters from buffers. */
2851 /* readchar_count -= (p - read_buffer) - nchars; */
2853 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2855 || (p
- read_buffer
!= nchars
)));
2856 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2858 || (p
- read_buffer
!= nchars
)));
2863 int next_char
= READCHAR
;
2866 if (next_char
<= 040
2867 || (next_char
< 0200
2868 && (strchr ("\"';([#?", next_char
)
2869 || (!first_in_list
&& next_char
== '`')
2870 || (new_backquote_flag
&& next_char
== ','))))
2876 /* Otherwise, we fall through! Note that the atom-reading loop
2877 below will now loop at least once, assuring that we will not
2878 try to UNREAD two characters in a row. */
2882 if (c
<= 040) goto retry
;
2883 if (c
== 0x8a0) /* NBSP */
2886 char *p
= read_buffer
;
2890 char *end
= read_buffer
+ read_buffer_size
;
2893 && c
!= 0x8a0 /* NBSP */
2895 || (!strchr ("\"';()[]#", c
)
2896 && !(!first_in_list
&& c
== '`')
2897 && !(new_backquote_flag
&& c
== ','))))
2899 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2901 int offset
= p
- read_buffer
;
2902 read_buffer
= (char *) xrealloc (read_buffer
,
2903 read_buffer_size
*= 2);
2904 p
= read_buffer
+ offset
;
2905 end
= read_buffer
+ read_buffer_size
;
2912 end_of_file_error ();
2917 p
+= CHAR_STRING (c
, p
);
2925 int offset
= p
- read_buffer
;
2926 read_buffer
= (char *) xrealloc (read_buffer
,
2927 read_buffer_size
*= 2);
2928 p
= read_buffer
+ offset
;
2929 end
= read_buffer
+ read_buffer_size
;
2936 if (!quoted
&& !uninterned_symbol
)
2940 if (*p1
== '+' || *p1
== '-') p1
++;
2941 /* Is it an integer? */
2944 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2945 /* Integers can have trailing decimal points. */
2946 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2948 /* It is an integer. */
2953 /* EMACS_INT n = atol (read_buffer); */
2954 char *endptr
= NULL
;
2955 EMACS_INT n
= (errno
= 0,
2956 strtol (read_buffer
, &endptr
, 10));
2957 if (errno
== ERANGE
&& endptr
)
2960 = Fcons (make_string (read_buffer
,
2961 endptr
- read_buffer
),
2963 xsignal (Qoverflow_error
, args
);
2965 return make_fixnum_or_float (n
);
2969 if (isfloat_string (read_buffer
, 0))
2971 /* Compute NaN and infinities using 0.0 in a variable,
2972 to cope with compilers that think they are smarter
2978 /* Negate the value ourselves. This treats 0, NaNs,
2979 and infinity properly on IEEE floating point hosts,
2980 and works around a common bug where atof ("-0.0")
2982 int negative
= read_buffer
[0] == '-';
2984 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2985 returns 1, is if the input ends in e+INF or e+NaN. */
2992 value
= zero
/ zero
;
2994 /* If that made a "negative" NaN, negate it. */
2998 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3001 u_minus_zero
.d
= - 0.0;
3002 for (i
= 0; i
< sizeof (double); i
++)
3003 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3009 /* Now VALUE is a positive NaN. */
3012 value
= atof (read_buffer
+ negative
);
3016 return make_float (negative
? - value
: value
);
3020 Lisp_Object name
, result
;
3021 EMACS_INT nbytes
= p
- read_buffer
;
3023 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3026 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3027 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3029 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3030 result
= (uninterned_symbol
? Fmake_symbol (name
)
3031 : Fintern (name
, Qnil
));
3033 if (EQ (Vread_with_symbol_positions
, Qt
)
3034 || EQ (Vread_with_symbol_positions
, readcharfun
))
3035 Vread_symbol_positions_list
=
3036 /* Kind of a hack; this will probably fail if characters
3037 in the symbol name were escaped. Not really a big
3039 Fcons (Fcons (result
,
3040 make_number (readchar_count
3041 - XFASTINT (Flength (Fsymbol_name (result
))))),
3042 Vread_symbol_positions_list
);
3050 /* List of nodes we've seen during substitute_object_in_subtree. */
3051 static Lisp_Object seen_list
;
3054 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3056 Lisp_Object check_object
;
3058 /* We haven't seen any objects when we start. */
3061 /* Make all the substitutions. */
3063 = substitute_object_recurse (object
, placeholder
, object
);
3065 /* Clear seen_list because we're done with it. */
3068 /* The returned object here is expected to always eq the
3070 if (!EQ (check_object
, object
))
3071 error ("Unexpected mutation error in reader");
3074 /* Feval doesn't get called from here, so no gc protection is needed. */
3075 #define SUBSTITUTE(get_val, set_val) \
3077 Lisp_Object old_value = get_val; \
3078 Lisp_Object true_value \
3079 = substitute_object_recurse (object, placeholder, \
3082 if (!EQ (old_value, true_value)) \
3089 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3091 /* If we find the placeholder, return the target object. */
3092 if (EQ (placeholder
, subtree
))
3095 /* If we've been to this node before, don't explore it again. */
3096 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3099 /* If this node can be the entry point to a cycle, remember that
3100 we've seen it. It can only be such an entry point if it was made
3101 by #n=, which means that we can find it as a value in
3103 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3104 seen_list
= Fcons (subtree
, seen_list
);
3106 /* Recurse according to subtree's type.
3107 Every branch must return a Lisp_Object. */
3108 switch (XTYPE (subtree
))
3110 case Lisp_Vectorlike
:
3113 if (BOOL_VECTOR_P (subtree
))
3114 return subtree
; /* No sub-objects anyway. */
3115 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3116 || COMPILEDP (subtree
))
3117 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3118 else if (VECTORP (subtree
))
3119 length
= ASIZE (subtree
);
3121 /* An unknown pseudovector may contain non-Lisp fields, so we
3122 can't just blindly traverse all its fields. We used to call
3123 `Flength' which signaled `sequencep', so I just preserved this
3125 wrong_type_argument (Qsequencep
, subtree
);
3127 for (i
= 0; i
< length
; i
++)
3128 SUBSTITUTE (AREF (subtree
, i
),
3129 ASET (subtree
, i
, true_value
));
3135 SUBSTITUTE (XCAR (subtree
),
3136 XSETCAR (subtree
, true_value
));
3137 SUBSTITUTE (XCDR (subtree
),
3138 XSETCDR (subtree
, true_value
));
3144 /* Check for text properties in each interval.
3145 substitute_in_interval contains part of the logic. */
3147 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3148 Lisp_Object arg
= Fcons (object
, placeholder
);
3150 traverse_intervals_noorder (root_interval
,
3151 &substitute_in_interval
, arg
);
3156 /* Other types don't recurse any further. */
3162 /* Helper function for substitute_object_recurse. */
3164 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3166 Lisp_Object object
= Fcar (arg
);
3167 Lisp_Object placeholder
= Fcdr (arg
);
3169 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3180 isfloat_string (const char *cp
, int ignore_trailing
)
3183 const char *start
= cp
;
3186 if (*cp
== '+' || *cp
== '-')
3189 if (*cp
>= '0' && *cp
<= '9')
3192 while (*cp
>= '0' && *cp
<= '9')
3200 if (*cp
>= '0' && *cp
<= '9')
3203 while (*cp
>= '0' && *cp
<= '9')
3206 if (*cp
== 'e' || *cp
== 'E')
3210 if (*cp
== '+' || *cp
== '-')
3214 if (*cp
>= '0' && *cp
<= '9')
3217 while (*cp
>= '0' && *cp
<= '9')
3220 else if (cp
== start
)
3222 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3227 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3233 return ((ignore_trailing
3234 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3235 || *cp
== '\r' || *cp
== '\f')
3236 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3237 || state
== (DOT_CHAR
|TRAIL_INT
)
3238 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3239 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3240 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3245 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3249 register Lisp_Object
*ptr
;
3250 register Lisp_Object tem
, item
, vector
;
3251 register struct Lisp_Cons
*otem
;
3254 tem
= read_list (1, readcharfun
);
3255 len
= Flength (tem
);
3256 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3258 size
= XVECTOR (vector
)->size
;
3259 ptr
= XVECTOR (vector
)->contents
;
3260 for (i
= 0; i
< size
; i
++)
3263 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3264 bytecode object, the docstring containing the bytecode and
3265 constants values must be treated as unibyte and passed to
3266 Fread, to get the actual bytecode string and constants vector. */
3267 if (bytecodeflag
&& load_force_doc_strings
)
3269 if (i
== COMPILED_BYTECODE
)
3271 if (!STRINGP (item
))
3272 error ("Invalid byte code");
3274 /* Delay handling the bytecode slot until we know whether
3275 it is lazily-loaded (we can tell by whether the
3276 constants slot is nil). */
3277 ptr
[COMPILED_CONSTANTS
] = item
;
3280 else if (i
== COMPILED_CONSTANTS
)
3282 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3286 /* Coerce string to unibyte (like string-as-unibyte,
3287 but without generating extra garbage and
3288 guaranteeing no change in the contents). */
3289 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3290 STRING_SET_UNIBYTE (bytestr
);
3292 item
= Fread (Fcons (bytestr
, readcharfun
));
3294 error ("Invalid byte code");
3296 otem
= XCONS (item
);
3297 bytestr
= XCAR (item
);
3302 /* Now handle the bytecode slot. */
3303 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3305 else if (i
== COMPILED_DOC_STRING
3307 && ! STRING_MULTIBYTE (item
))
3309 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3310 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3312 item
= Fstring_as_multibyte (item
);
3315 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3323 /* FLAG = 1 means check for ] to terminate rather than ) and .
3324 FLAG = -1 means check for starting with defun
3325 and make structure pure. */
3328 read_list (int flag
, register Lisp_Object readcharfun
)
3330 /* -1 means check next element for defun,
3331 0 means don't check,
3332 1 means already checked and found defun. */
3333 int defunflag
= flag
< 0 ? -1 : 0;
3334 Lisp_Object val
, tail
;
3335 register Lisp_Object elt
, tem
;
3336 struct gcpro gcpro1
, gcpro2
;
3337 /* 0 is the normal case.
3338 1 means this list is a doc reference; replace it with the number 0.
3339 2 means this list is a doc reference; replace it with the doc string. */
3340 int doc_reference
= 0;
3342 /* Initialize this to 1 if we are reading a list. */
3343 int first_in_list
= flag
<= 0;
3352 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3357 /* While building, if the list starts with #$, treat it specially. */
3358 if (EQ (elt
, Vload_file_name
)
3360 && !NILP (Vpurify_flag
))
3362 if (NILP (Vdoc_file_name
))
3363 /* We have not yet called Snarf-documentation, so assume
3364 this file is described in the DOC-MM.NN file
3365 and Snarf-documentation will fill in the right value later.
3366 For now, replace the whole list with 0. */
3369 /* We have already called Snarf-documentation, so make a relative
3370 file name for this file, so it can be found properly
3371 in the installed Lisp directory.
3372 We don't use Fexpand_file_name because that would make
3373 the directory absolute now. */
3374 elt
= concat2 (build_string ("../lisp/"),
3375 Ffile_name_nondirectory (elt
));
3377 else if (EQ (elt
, Vload_file_name
)
3379 && load_force_doc_strings
)
3388 invalid_syntax (") or . in a vector", 18);
3396 XSETCDR (tail
, read0 (readcharfun
));
3398 val
= read0 (readcharfun
);
3399 read1 (readcharfun
, &ch
, 0);
3403 if (doc_reference
== 1)
3404 return make_number (0);
3405 if (doc_reference
== 2)
3407 /* Get a doc string from the file we are loading.
3408 If it's in saved_doc_string, get it from there.
3410 Here, we don't know if the string is a
3411 bytecode string or a doc string. As a
3412 bytecode string must be unibyte, we always
3413 return a unibyte string. If it is actually a
3414 doc string, caller must make it
3417 int pos
= XINT (XCDR (val
));
3418 /* Position is negative for user variables. */
3419 if (pos
< 0) pos
= -pos
;
3420 if (pos
>= saved_doc_string_position
3421 && pos
< (saved_doc_string_position
3422 + saved_doc_string_length
))
3424 int start
= pos
- saved_doc_string_position
;
3427 /* Process quoting with ^A,
3428 and find the end of the string,
3429 which is marked with ^_ (037). */
3430 for (from
= start
, to
= start
;
3431 saved_doc_string
[from
] != 037;)
3433 int c
= saved_doc_string
[from
++];
3436 c
= saved_doc_string
[from
++];
3438 saved_doc_string
[to
++] = c
;
3440 saved_doc_string
[to
++] = 0;
3442 saved_doc_string
[to
++] = 037;
3445 saved_doc_string
[to
++] = c
;
3448 return make_unibyte_string (saved_doc_string
+ start
,
3451 /* Look in prev_saved_doc_string the same way. */
3452 else if (pos
>= prev_saved_doc_string_position
3453 && pos
< (prev_saved_doc_string_position
3454 + prev_saved_doc_string_length
))
3456 int start
= pos
- prev_saved_doc_string_position
;
3459 /* Process quoting with ^A,
3460 and find the end of the string,
3461 which is marked with ^_ (037). */
3462 for (from
= start
, to
= start
;
3463 prev_saved_doc_string
[from
] != 037;)
3465 int c
= prev_saved_doc_string
[from
++];
3468 c
= prev_saved_doc_string
[from
++];
3470 prev_saved_doc_string
[to
++] = c
;
3472 prev_saved_doc_string
[to
++] = 0;
3474 prev_saved_doc_string
[to
++] = 037;
3477 prev_saved_doc_string
[to
++] = c
;
3480 return make_unibyte_string (prev_saved_doc_string
3485 return get_doc_string (val
, 1, 0);
3490 invalid_syntax (". in wrong context", 18);
3492 invalid_syntax ("] in a list", 11);
3494 tem
= (read_pure
&& flag
<= 0
3495 ? pure_cons (elt
, Qnil
)
3496 : Fcons (elt
, Qnil
));
3498 XSETCDR (tail
, tem
);
3503 defunflag
= EQ (elt
, Qdefun
);
3504 else if (defunflag
> 0)
3509 Lisp_Object Vobarray
;
3510 Lisp_Object initial_obarray
;
3512 /* oblookup stores the bucket number here, for the sake of Funintern. */
3514 int oblookup_last_bucket_number
;
3516 static int hash_string (const unsigned char *ptr
, int len
);
3518 /* Get an error if OBARRAY is not an obarray.
3519 If it is one, return it. */
3522 check_obarray (Lisp_Object obarray
)
3524 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3526 /* If Vobarray is now invalid, force it to be valid. */
3527 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3528 wrong_type_argument (Qvectorp
, obarray
);
3533 /* Intern the C string STR: return a symbol with that name,
3534 interned in the current obarray. */
3537 intern (const char *str
)
3540 int len
= strlen (str
);
3541 Lisp_Object obarray
;
3544 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3545 obarray
= check_obarray (obarray
);
3546 tem
= oblookup (obarray
, str
, len
, len
);
3549 return Fintern (make_string (str
, len
), obarray
);
3553 intern_c_string (const char *str
)
3556 int len
= strlen (str
);
3557 Lisp_Object obarray
;
3560 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3561 obarray
= check_obarray (obarray
);
3562 tem
= oblookup (obarray
, str
, len
, len
);
3566 if (NILP (Vpurify_flag
))
3567 /* Creating a non-pure string from a string literal not
3568 implemented yet. We could just use make_string here and live
3569 with the extra copy. */
3572 return Fintern (make_pure_c_string (str
), obarray
);
3575 /* Create an uninterned symbol with name STR. */
3578 make_symbol (const char *str
)
3580 int len
= strlen (str
);
3582 return Fmake_symbol (!NILP (Vpurify_flag
)
3583 ? make_pure_string (str
, len
, len
, 0)
3584 : make_string (str
, len
));
3587 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3588 doc
: /* Return the canonical symbol whose name is STRING.
3589 If there is none, one is created by this function and returned.
3590 A second optional argument specifies the obarray to use;
3591 it defaults to the value of `obarray'. */)
3592 (Lisp_Object string
, Lisp_Object obarray
)
3594 register Lisp_Object tem
, sym
, *ptr
;
3596 if (NILP (obarray
)) obarray
= Vobarray
;
3597 obarray
= check_obarray (obarray
);
3599 CHECK_STRING (string
);
3601 tem
= oblookup (obarray
, SDATA (string
),
3604 if (!INTEGERP (tem
))
3607 if (!NILP (Vpurify_flag
))
3608 string
= Fpurecopy (string
);
3609 sym
= Fmake_symbol (string
);
3611 if (EQ (obarray
, initial_obarray
))
3612 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3614 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3616 if ((SREF (string
, 0) == ':')
3617 && EQ (obarray
, initial_obarray
))
3619 XSYMBOL (sym
)->constant
= 1;
3620 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3621 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3624 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3626 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3628 XSYMBOL (sym
)->next
= 0;
3633 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3634 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3635 NAME may be a string or a symbol. If it is a symbol, that exact
3636 symbol is searched for.
3637 A second optional argument specifies the obarray to use;
3638 it defaults to the value of `obarray'. */)
3639 (Lisp_Object name
, Lisp_Object obarray
)
3641 register Lisp_Object tem
, string
;
3643 if (NILP (obarray
)) obarray
= Vobarray
;
3644 obarray
= check_obarray (obarray
);
3646 if (!SYMBOLP (name
))
3648 CHECK_STRING (name
);
3652 string
= SYMBOL_NAME (name
);
3654 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3655 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3661 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3662 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3663 The value is t if a symbol was found and deleted, nil otherwise.
3664 NAME may be a string or a symbol. If it is a symbol, that symbol
3665 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3666 OBARRAY defaults to the value of the variable `obarray'. */)
3667 (Lisp_Object name
, Lisp_Object obarray
)
3669 register Lisp_Object string
, tem
;
3672 if (NILP (obarray
)) obarray
= Vobarray
;
3673 obarray
= check_obarray (obarray
);
3676 string
= SYMBOL_NAME (name
);
3679 CHECK_STRING (name
);
3683 tem
= oblookup (obarray
, SDATA (string
),
3688 /* If arg was a symbol, don't delete anything but that symbol itself. */
3689 if (SYMBOLP (name
) && !EQ (name
, tem
))
3692 /* There are plenty of other symbols which will screw up the Emacs
3693 session if we unintern them, as well as even more ways to use
3694 `setq' or `fset' or whatnot to make the Emacs session
3695 unusable. Let's not go down this silly road. --Stef */
3696 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3697 error ("Attempt to unintern t or nil"); */
3699 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3701 hash
= oblookup_last_bucket_number
;
3703 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3705 if (XSYMBOL (tem
)->next
)
3706 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3708 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3712 Lisp_Object tail
, following
;
3714 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3715 XSYMBOL (tail
)->next
;
3718 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3719 if (EQ (following
, tem
))
3721 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3730 /* Return the symbol in OBARRAY whose names matches the string
3731 of SIZE characters (SIZE_BYTE bytes) at PTR.
3732 If there is no such symbol in OBARRAY, return nil.
3734 Also store the bucket number in oblookup_last_bucket_number. */
3737 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3741 register Lisp_Object tail
;
3742 Lisp_Object bucket
, tem
;
3744 if (!VECTORP (obarray
)
3745 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3747 obarray
= check_obarray (obarray
);
3748 obsize
= XVECTOR (obarray
)->size
;
3750 /* This is sometimes needed in the middle of GC. */
3751 obsize
&= ~ARRAY_MARK_FLAG
;
3752 hash
= hash_string (ptr
, size_byte
) % obsize
;
3753 bucket
= XVECTOR (obarray
)->contents
[hash
];
3754 oblookup_last_bucket_number
= hash
;
3755 if (EQ (bucket
, make_number (0)))
3757 else if (!SYMBOLP (bucket
))
3758 error ("Bad data in guts of obarray"); /* Like CADR error message */
3760 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3762 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3763 && SCHARS (SYMBOL_NAME (tail
)) == size
3764 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3766 else if (XSYMBOL (tail
)->next
== 0)
3769 XSETINT (tem
, hash
);
3774 hash_string (const unsigned char *ptr
, int len
)
3776 register const unsigned char *p
= ptr
;
3777 register const unsigned char *end
= p
+ len
;
3778 register unsigned char c
;
3779 register int hash
= 0;
3784 if (c
>= 0140) c
-= 40;
3785 hash
= ((hash
<<3) + (hash
>>28) + c
);
3787 return hash
& 07777777777;
3791 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3794 register Lisp_Object tail
;
3795 CHECK_VECTOR (obarray
);
3796 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3798 tail
= XVECTOR (obarray
)->contents
[i
];
3803 if (XSYMBOL (tail
)->next
== 0)
3805 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3811 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3813 call1 (function
, sym
);
3816 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3817 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3818 OBARRAY defaults to the value of `obarray'. */)
3819 (Lisp_Object function
, Lisp_Object obarray
)
3821 if (NILP (obarray
)) obarray
= Vobarray
;
3822 obarray
= check_obarray (obarray
);
3824 map_obarray (obarray
, mapatoms_1
, function
);
3828 #define OBARRAY_SIZE 1511
3833 Lisp_Object oblength
;
3835 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3837 Vobarray
= Fmake_vector (oblength
, make_number (0));
3838 initial_obarray
= Vobarray
;
3839 staticpro (&initial_obarray
);
3841 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3842 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3843 NILP (Vpurify_flag) check in intern_c_string. */
3844 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3845 Qnil
= intern_c_string ("nil");
3847 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3848 so those two need to be fixed manally. */
3849 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3850 XSYMBOL (Qunbound
)->function
= Qunbound
;
3851 XSYMBOL (Qunbound
)->plist
= Qnil
;
3852 /* XSYMBOL (Qnil)->function = Qunbound; */
3853 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3854 XSYMBOL (Qnil
)->constant
= 1;
3855 XSYMBOL (Qnil
)->plist
= Qnil
;
3857 Qt
= intern_c_string ("t");
3858 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3859 XSYMBOL (Qt
)->constant
= 1;
3861 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3864 Qvariable_documentation
= intern_c_string ("variable-documentation");
3865 staticpro (&Qvariable_documentation
);
3867 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3868 read_buffer
= (char *) xmalloc (read_buffer_size
);
3872 defsubr (struct Lisp_Subr
*sname
)
3875 sym
= intern_c_string (sname
->symbol_name
);
3876 XSETPVECTYPE (sname
, PVEC_SUBR
);
3877 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3880 #ifdef NOTDEF /* use fset in subr.el now */
3882 defalias (sname
, string
)
3883 struct Lisp_Subr
*sname
;
3887 sym
= intern (string
);
3888 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3892 /* Define an "integer variable"; a symbol whose value is forwarded
3893 to a C variable of type int. Sample call:
3894 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3896 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3897 const char *namestring
, EMACS_INT
*address
)
3900 sym
= intern_c_string (namestring
);
3901 i_fwd
->type
= Lisp_Fwd_Int
;
3902 i_fwd
->intvar
= address
;
3903 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3904 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3907 /* Similar but define a variable whose value is t if address contains 1,
3908 nil if address contains 0. */
3910 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3911 const char *namestring
, int *address
)
3914 sym
= intern_c_string (namestring
);
3915 b_fwd
->type
= Lisp_Fwd_Bool
;
3916 b_fwd
->boolvar
= address
;
3917 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3918 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3919 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3922 /* Similar but define a variable whose value is the Lisp Object stored
3923 at address. Two versions: with and without gc-marking of the C
3924 variable. The nopro version is used when that variable will be
3925 gc-marked for some other reason, since marking the same slot twice
3926 can cause trouble with strings. */
3928 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
3929 const char *namestring
, Lisp_Object
*address
)
3932 sym
= intern_c_string (namestring
);
3933 o_fwd
->type
= Lisp_Fwd_Obj
;
3934 o_fwd
->objvar
= address
;
3935 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3936 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
3940 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
3941 const char *namestring
, Lisp_Object
*address
)
3943 defvar_lisp_nopro (o_fwd
, namestring
, address
);
3944 staticpro (address
);
3947 /* Similar but define a variable whose value is the Lisp Object stored
3948 at a particular offset in the current kboard object. */
3951 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
3952 const char *namestring
, int offset
)
3955 sym
= intern_c_string (namestring
);
3956 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
3957 ko_fwd
->offset
= offset
;
3958 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3959 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
3962 /* Record the value of load-path used at the start of dumping
3963 so we can see if the site changed it later during dumping. */
3964 static Lisp_Object dump_path
;
3970 int turn_off_warning
= 0;
3972 /* Compute the default load-path. */
3974 normal
= PATH_LOADSEARCH
;
3975 Vload_path
= decode_env_path (0, normal
);
3977 if (NILP (Vpurify_flag
))
3978 normal
= PATH_LOADSEARCH
;
3980 normal
= PATH_DUMPLOADSEARCH
;
3982 /* In a dumped Emacs, we normally have to reset the value of
3983 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3984 uses ../lisp, instead of the path of the installed elisp
3985 libraries. However, if it appears that Vload_path was changed
3986 from the default before dumping, don't override that value. */
3989 if (! NILP (Fequal (dump_path
, Vload_path
)))
3991 Vload_path
= decode_env_path (0, normal
);
3992 if (!NILP (Vinstallation_directory
))
3994 Lisp_Object tem
, tem1
, sitelisp
;
3996 /* Remove site-lisp dirs from path temporarily and store
3997 them in sitelisp, then conc them on at the end so
3998 they're always first in path. */
4002 tem
= Fcar (Vload_path
);
4003 tem1
= Fstring_match (build_string ("site-lisp"),
4007 Vload_path
= Fcdr (Vload_path
);
4008 sitelisp
= Fcons (tem
, sitelisp
);
4014 /* Add to the path the lisp subdir of the
4015 installation dir, if it exists. */
4016 tem
= Fexpand_file_name (build_string ("lisp"),
4017 Vinstallation_directory
);
4018 tem1
= Ffile_exists_p (tem
);
4021 if (NILP (Fmember (tem
, Vload_path
)))
4023 turn_off_warning
= 1;
4024 Vload_path
= Fcons (tem
, Vload_path
);
4028 /* That dir doesn't exist, so add the build-time
4029 Lisp dirs instead. */
4030 Vload_path
= nconc2 (Vload_path
, dump_path
);
4032 /* Add leim under the installation dir, if it exists. */
4033 tem
= Fexpand_file_name (build_string ("leim"),
4034 Vinstallation_directory
);
4035 tem1
= Ffile_exists_p (tem
);
4038 if (NILP (Fmember (tem
, Vload_path
)))
4039 Vload_path
= Fcons (tem
, Vload_path
);
4042 /* Add site-lisp under the installation dir, if it exists. */
4043 tem
= Fexpand_file_name (build_string ("site-lisp"),
4044 Vinstallation_directory
);
4045 tem1
= Ffile_exists_p (tem
);
4048 if (NILP (Fmember (tem
, Vload_path
)))
4049 Vload_path
= Fcons (tem
, Vload_path
);
4052 /* If Emacs was not built in the source directory,
4053 and it is run from where it was built, add to load-path
4054 the lisp, leim and site-lisp dirs under that directory. */
4056 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4060 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4061 Vinstallation_directory
);
4062 tem1
= Ffile_exists_p (tem
);
4064 /* Don't be fooled if they moved the entire source tree
4065 AFTER dumping Emacs. If the build directory is indeed
4066 different from the source dir, src/Makefile.in and
4067 src/Makefile will not be found together. */
4068 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4069 Vinstallation_directory
);
4070 tem2
= Ffile_exists_p (tem
);
4071 if (!NILP (tem1
) && NILP (tem2
))
4073 tem
= Fexpand_file_name (build_string ("lisp"),
4076 if (NILP (Fmember (tem
, Vload_path
)))
4077 Vload_path
= Fcons (tem
, Vload_path
);
4079 tem
= Fexpand_file_name (build_string ("leim"),
4082 if (NILP (Fmember (tem
, Vload_path
)))
4083 Vload_path
= Fcons (tem
, Vload_path
);
4085 tem
= Fexpand_file_name (build_string ("site-lisp"),
4088 if (NILP (Fmember (tem
, Vload_path
)))
4089 Vload_path
= Fcons (tem
, Vload_path
);
4092 if (!NILP (sitelisp
))
4093 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4099 /* NORMAL refers to the lisp dir in the source directory. */
4100 /* We used to add ../lisp at the front here, but
4101 that caused trouble because it was copied from dump_path
4102 into Vload_path, above, when Vinstallation_directory was non-nil.
4103 It should be unnecessary. */
4104 Vload_path
= decode_env_path (0, normal
);
4105 dump_path
= Vload_path
;
4109 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4110 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4111 almost never correct, thereby causing a warning to be printed out that
4112 confuses users. Since PATH_LOADSEARCH is always overridden by the
4113 EMACSLOADPATH environment variable below, disable the warning on NT. */
4115 /* Warn if dirs in the *standard* path don't exist. */
4116 if (!turn_off_warning
)
4118 Lisp_Object path_tail
;
4120 for (path_tail
= Vload_path
;
4122 path_tail
= XCDR (path_tail
))
4124 Lisp_Object dirfile
;
4125 dirfile
= Fcar (path_tail
);
4126 if (STRINGP (dirfile
))
4128 dirfile
= Fdirectory_file_name (dirfile
);
4129 if (access (SDATA (dirfile
), 0) < 0)
4130 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4135 #endif /* !(WINDOWSNT || HAVE_NS) */
4137 /* If the EMACSLOADPATH environment variable is set, use its value.
4138 This doesn't apply if we're dumping. */
4140 if (NILP (Vpurify_flag
)
4141 && egetenv ("EMACSLOADPATH"))
4143 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4147 load_in_progress
= 0;
4148 Vload_file_name
= Qnil
;
4150 load_descriptor_list
= Qnil
;
4152 Vstandard_input
= Qt
;
4153 Vloads_in_progress
= Qnil
;
4156 /* Print a warning, using format string FORMAT, that directory DIRNAME
4157 does not exist. Print it on stderr and put it in *Messages*. */
4160 dir_warning (const char *format
, Lisp_Object dirname
)
4163 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4165 fprintf (stderr
, format
, SDATA (dirname
));
4166 sprintf (buffer
, format
, SDATA (dirname
));
4167 /* Don't log the warning before we've initialized!! */
4169 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4173 syms_of_lread (void)
4176 defsubr (&Sread_from_string
);
4178 defsubr (&Sintern_soft
);
4179 defsubr (&Sunintern
);
4180 defsubr (&Sget_load_suffixes
);
4182 defsubr (&Seval_buffer
);
4183 defsubr (&Seval_region
);
4184 defsubr (&Sread_char
);
4185 defsubr (&Sread_char_exclusive
);
4186 defsubr (&Sread_event
);
4187 defsubr (&Sget_file_char
);
4188 defsubr (&Smapatoms
);
4189 defsubr (&Slocate_file_internal
);
4191 DEFVAR_LISP ("obarray", &Vobarray
,
4192 doc
: /* Symbol table for use by `intern' and `read'.
4193 It is a vector whose length ought to be prime for best results.
4194 The vector's contents don't make sense if examined from Lisp programs;
4195 to find all the symbols in an obarray, use `mapatoms'. */);
4197 DEFVAR_LISP ("values", &Vvalues
,
4198 doc
: /* List of values of all expressions which were read, evaluated and printed.
4199 Order is reverse chronological. */);
4201 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4202 doc
: /* Stream for read to get input from.
4203 See documentation of `read' for possible values. */);
4204 Vstandard_input
= Qt
;
4206 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4207 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4209 If this variable is a buffer, then only forms read from that buffer
4210 will be added to `read-symbol-positions-list'.
4211 If this variable is t, then all read forms will be added.
4212 The effect of all other values other than nil are not currently
4213 defined, although they may be in the future.
4215 The positions are relative to the last call to `read' or
4216 `read-from-string'. It is probably a bad idea to set this variable at
4217 the toplevel; bind it instead. */);
4218 Vread_with_symbol_positions
= Qnil
;
4220 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4221 doc
: /* A list mapping read symbols to their positions.
4222 This variable is modified during calls to `read' or
4223 `read-from-string', but only when `read-with-symbol-positions' is
4226 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4227 CHAR-POSITION is an integer giving the offset of that occurrence of the
4228 symbol from the position where `read' or `read-from-string' started.
4230 Note that a symbol will appear multiple times in this list, if it was
4231 read multiple times. The list is in the same order as the symbols
4233 Vread_symbol_positions_list
= Qnil
;
4235 DEFVAR_LISP ("read-circle", &Vread_circle
,
4236 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4239 DEFVAR_LISP ("load-path", &Vload_path
,
4240 doc
: /* *List of directories to search for files to load.
4241 Each element is a string (directory name) or nil (try default directory).
4242 Initialized based on EMACSLOADPATH environment variable, if any,
4243 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4245 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4246 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4247 This list should not include the empty string.
4248 `load' and related functions try to append these suffixes, in order,
4249 to the specified file name if a Lisp suffix is allowed or required. */);
4250 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4251 Fcons (make_pure_c_string (".el"), Qnil
));
4252 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4253 doc
: /* List of suffixes that indicate representations of \
4255 This list should normally start with the empty string.
4257 Enabling Auto Compression mode appends the suffixes in
4258 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4259 mode removes them again. `load' and related functions use this list to
4260 determine whether they should look for compressed versions of a file
4261 and, if so, which suffixes they should try to append to the file name
4262 in order to do so. However, if you want to customize which suffixes
4263 the loading functions recognize as compression suffixes, you should
4264 customize `jka-compr-load-suffixes' rather than the present variable. */);
4265 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4267 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4268 doc
: /* Non-nil if inside of `load'. */);
4269 Qload_in_progress
= intern_c_string ("load-in-progress");
4270 staticpro (&Qload_in_progress
);
4272 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4273 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4274 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4276 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4277 a symbol \(a feature name).
4279 When `load' is run and the file-name argument matches an element's
4280 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4281 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4283 An error in FORMS does not undo the load, but does prevent execution of
4284 the rest of the FORMS. */);
4285 Vafter_load_alist
= Qnil
;
4287 DEFVAR_LISP ("load-history", &Vload_history
,
4288 doc
: /* Alist mapping loaded file names to symbols and features.
4289 Each alist element should be a list (FILE-NAME ENTRIES...), where
4290 FILE-NAME is the name of a file that has been loaded into Emacs.
4291 The file name is absolute and true (i.e. it doesn't contain symlinks).
4292 As an exception, one of the alist elements may have FILE-NAME nil,
4293 for symbols and features not associated with any file.
4295 The remaining ENTRIES in the alist element describe the functions and
4296 variables defined in that file, the features provided, and the
4297 features required. Each entry has the form `(provide . FEATURE)',
4298 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4299 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4300 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4301 SYMBOL was an autoload before this file redefined it as a function.
4303 During preloading, the file name recorded is relative to the main Lisp
4304 directory. These file names are converted to absolute at startup. */);
4305 Vload_history
= Qnil
;
4307 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4308 doc
: /* Full name of file being loaded by `load'. */);
4309 Vload_file_name
= Qnil
;
4311 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4312 doc
: /* File name, including directory, of user's initialization file.
4313 If the file loaded had extension `.elc', and the corresponding source file
4314 exists, this variable contains the name of source file, suitable for use
4315 by functions like `custom-save-all' which edit the init file.
4316 While Emacs loads and evaluates the init file, value is the real name
4317 of the file, regardless of whether or not it has the `.elc' extension. */);
4318 Vuser_init_file
= Qnil
;
4320 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4321 doc
: /* Used for internal purposes by `load'. */);
4322 Vcurrent_load_list
= Qnil
;
4324 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4325 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4326 The default is nil, which means use the function `read'. */);
4327 Vload_read_function
= Qnil
;
4329 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4330 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4331 This function is for doing code conversion before reading the source file.
4332 If nil, loading is done without any code conversion.
4333 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4334 FULLNAME is the full name of FILE.
4335 See `load' for the meaning of the remaining arguments. */);
4336 Vload_source_file_function
= Qnil
;
4338 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4339 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4340 This is useful when the file being loaded is a temporary copy. */);
4341 load_force_doc_strings
= 0;
4343 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4344 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4345 This is normally bound by `load' and `eval-buffer' to control `read',
4346 and is not meant for users to change. */);
4347 load_convert_to_unibyte
= 0;
4349 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4350 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4351 You cannot count on them to still be there! */);
4353 = Fexpand_file_name (build_string ("../"),
4354 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4356 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4357 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4358 Vpreloaded_file_list
= Qnil
;
4360 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4361 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4362 Vbyte_boolean_vars
= Qnil
;
4364 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4365 doc
: /* Non-nil means load dangerous compiled Lisp files.
4366 Some versions of XEmacs use different byte codes than Emacs. These
4367 incompatible byte codes can make Emacs crash when it tries to execute
4369 load_dangerous_libraries
= 0;
4371 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4372 doc
: /* Non-nil means force printing messages when loading Lisp files.
4373 This overrides the value of the NOMESSAGE argument to `load'. */);
4374 force_load_messages
= 0;
4376 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4377 doc
: /* Regular expression matching safe to load compiled Lisp files.
4378 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4379 from the file, and matches them against this regular expression.
4380 When the regular expression matches, the file is considered to be safe
4381 to load. See also `load-dangerous-libraries'. */);
4382 Vbytecomp_version_regexp
4383 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4385 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4386 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4387 Veval_buffer_list
= Qnil
;
4389 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4390 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4391 Vold_style_backquotes
= Qnil
;
4392 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4393 staticpro (&Qold_style_backquotes
);
4395 /* Vsource_directory was initialized in init_lread. */
4397 load_descriptor_list
= Qnil
;
4398 staticpro (&load_descriptor_list
);
4400 Qcurrent_load_list
= intern_c_string ("current-load-list");
4401 staticpro (&Qcurrent_load_list
);
4403 Qstandard_input
= intern_c_string ("standard-input");
4404 staticpro (&Qstandard_input
);
4406 Qread_char
= intern_c_string ("read-char");
4407 staticpro (&Qread_char
);
4409 Qget_file_char
= intern_c_string ("get-file-char");
4410 staticpro (&Qget_file_char
);
4412 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4413 staticpro (&Qget_emacs_mule_file_char
);
4415 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4416 staticpro (&Qload_force_doc_strings
);
4418 Qbackquote
= intern_c_string ("`");
4419 staticpro (&Qbackquote
);
4420 Qcomma
= intern_c_string (",");
4421 staticpro (&Qcomma
);
4422 Qcomma_at
= intern_c_string (",@");
4423 staticpro (&Qcomma_at
);
4424 Qcomma_dot
= intern_c_string (",.");
4425 staticpro (&Qcomma_dot
);
4427 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4428 staticpro (&Qinhibit_file_name_operation
);
4430 Qascii_character
= intern_c_string ("ascii-character");
4431 staticpro (&Qascii_character
);
4433 Qfunction
= intern_c_string ("function");
4434 staticpro (&Qfunction
);
4436 Qload
= intern_c_string ("load");
4439 Qload_file_name
= intern_c_string ("load-file-name");
4440 staticpro (&Qload_file_name
);
4442 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4443 staticpro (&Qeval_buffer_list
);
4445 Qfile_truename
= intern_c_string ("file-truename");
4446 staticpro (&Qfile_truename
) ;
4448 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4449 staticpro (&Qdo_after_load_evaluation
) ;
4451 staticpro (&dump_path
);
4453 staticpro (&read_objects
);
4454 read_objects
= Qnil
;
4455 staticpro (&seen_list
);
4458 Vloads_in_progress
= Qnil
;
4459 staticpro (&Vloads_in_progress
);
4461 Qhash_table
= intern_c_string ("hash-table");
4462 staticpro (&Qhash_table
);
4463 Qdata
= intern_c_string ("data");
4465 Qtest
= intern_c_string ("test");
4467 Qsize
= intern_c_string ("size");
4469 Qweakness
= intern_c_string ("weakness");
4470 staticpro (&Qweakness
);
4471 Qrehash_size
= intern_c_string ("rehash-size");
4472 staticpro (&Qrehash_size
);
4473 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4474 staticpro (&Qrehash_threshold
);
4477 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4478 (do not change this comment) */