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 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, or (at your option)
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; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
32 #include "intervals.h"
34 #include "character.h"
41 #include "termhooks.h"
43 #include "blockinput.h"
46 #include <sys/inode.h>
51 #include <unistd.h> /* to get X_OK */
68 #endif /* HAVE_SETLOCALE */
78 #define file_offset off_t
79 #define file_tell ftello
81 #define file_offset long
82 #define file_tell ftell
89 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
90 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
91 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
92 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
93 Lisp_Object Qinhibit_file_name_operation
;
94 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
95 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
97 /* Used instead of Qget_file_char while loading *.elc files compiled
98 by Emacs 21 or older. */
99 static Lisp_Object Qget_emacs_mule_file_char
;
101 static Lisp_Object Qload_force_doc_strings
;
103 extern Lisp_Object Qevent_symbol_element_mask
;
104 extern Lisp_Object Qfile_exists_p
;
106 /* non-zero if inside `load' */
107 int load_in_progress
;
109 /* Directory in which the sources were found. */
110 Lisp_Object Vsource_directory
;
112 /* Search path and suffixes for files to be loaded. */
113 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
115 /* File name of user's init file. */
116 Lisp_Object Vuser_init_file
;
118 /* This is the user-visible association list that maps features to
119 lists of defs in their load files. */
120 Lisp_Object Vload_history
;
122 /* This is used to build the load history. */
123 Lisp_Object Vcurrent_load_list
;
125 /* List of files that were preloaded. */
126 Lisp_Object Vpreloaded_file_list
;
128 /* Name of file actually being read by `load'. */
129 Lisp_Object Vload_file_name
;
131 /* Function to use for reading, in `load' and friends. */
132 Lisp_Object Vload_read_function
;
134 /* The association list of objects read with the #n=object form.
135 Each member of the list has the form (n . object), and is used to
136 look up the object for the corresponding #n# construct.
137 It must be set to nil before all top-level calls to read0. */
138 Lisp_Object read_objects
;
140 /* Nonzero means load should forcibly load all dynamic doc strings. */
141 static int load_force_doc_strings
;
143 /* Nonzero means read should convert strings to unibyte. */
144 static int load_convert_to_unibyte
;
146 /* Nonzero means READCHAR should read bytes one by one (not character)
147 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
148 This is set to 1 by read1 temporarily while handling #@NUMBER. */
149 static int load_each_byte
;
151 /* Function to use for loading an Emacs Lisp source file (not
152 compiled) instead of readevalloop. */
153 Lisp_Object Vload_source_file_function
;
155 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
156 Lisp_Object Vbyte_boolean_vars
;
158 /* Whether or not to add a `read-positions' property to symbols
160 Lisp_Object Vread_with_symbol_positions
;
162 /* List of (SYMBOL . POSITION) accumulated so far. */
163 Lisp_Object Vread_symbol_positions_list
;
165 /* List of descriptors now open for Fload. */
166 static Lisp_Object load_descriptor_list
;
168 /* File for get_file_char to read from. Use by load. */
169 static FILE *instream
;
171 /* When nonzero, read conses in pure space */
172 static int read_pure
;
174 /* For use within read-from-string (this reader is non-reentrant!!) */
175 static int read_from_string_index
;
176 static int read_from_string_index_byte
;
177 static int read_from_string_limit
;
179 /* Number of characters read in the current call to Fread or
180 Fread_from_string. */
181 static int readchar_count
;
183 /* This contains the last string skipped with #@. */
184 static char *saved_doc_string
;
185 /* Length of buffer allocated in saved_doc_string. */
186 static int saved_doc_string_size
;
187 /* Length of actual data in saved_doc_string. */
188 static int saved_doc_string_length
;
189 /* This is the file position that string came from. */
190 static file_offset saved_doc_string_position
;
192 /* This contains the previous string skipped with #@.
193 We copy it from saved_doc_string when a new string
194 is put in saved_doc_string. */
195 static char *prev_saved_doc_string
;
196 /* Length of buffer allocated in prev_saved_doc_string. */
197 static int prev_saved_doc_string_size
;
198 /* Length of actual data in prev_saved_doc_string. */
199 static int prev_saved_doc_string_length
;
200 /* This is the file position that string came from. */
201 static file_offset prev_saved_doc_string_position
;
203 /* Nonzero means inside a new-style backquote
204 with no surrounding parentheses.
205 Fread initializes this to zero, so we need not specbind it
206 or worry about what happens to it when there is an error. */
207 static int new_backquote_flag
;
208 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
210 /* A list of file names for files being loaded in Fload. Used to
211 check for recursive loads. */
213 static Lisp_Object Vloads_in_progress
;
215 /* Non-zero means load dangerous compiled Lisp files. */
217 int load_dangerous_libraries
;
219 /* A regular expression used to detect files compiled with Emacs. */
221 static Lisp_Object Vbytecomp_version_regexp
;
223 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
226 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
227 Lisp_Object (*) (), int,
228 Lisp_Object
, Lisp_Object
,
229 Lisp_Object
, Lisp_Object
));
230 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
231 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
233 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
234 static void end_of_file_error
P_ (()) NO_RETURN
;
237 /* Functions that read one byte from the current source READCHARFUN
238 or unreads one byte. If the integer argument C is -1, it returns
239 one read byte, or -1 when there's no more byte in the source. If C
240 is 0 or positive, it unreads C, and the return value is not
243 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
244 static int readbyte_from_file
P_ ((int, Lisp_Object
));
245 static int readbyte_from_string
P_ ((int, Lisp_Object
));
247 /* Handle unreading and rereading of characters.
248 Write READCHAR to read a character,
249 UNREAD(c) to unread c to be read again.
251 These macros correctly read/unread multibyte characters. */
253 #define READCHAR readchar (readcharfun, NULL)
254 #define UNREAD(c) unreadchar (readcharfun, c)
256 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
257 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
259 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
260 Qlambda, or a cons, we use this to keep an unread character because
261 a file stream can't handle multibyte-char unreading. The value -1
262 means that there's no unread character. */
263 static int unread_char
;
266 readchar (readcharfun
, multibyte
)
267 Lisp_Object readcharfun
;
272 int (*readbyte
) P_ ((int, Lisp_Object
));
273 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
275 int emacs_mule_encoding
= 0;
282 if (BUFFERP (readcharfun
))
284 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
286 int pt_byte
= BUF_PT_BYTE (inbuffer
);
288 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
291 if (! NILP (inbuffer
->enable_multibyte_characters
))
293 /* Fetch the character code from the buffer. */
294 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
295 BUF_INC_POS (inbuffer
, pt_byte
);
296 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
302 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
303 if (! ASCII_BYTE_P (c
))
304 c
= BYTE8_TO_CHAR (c
);
307 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
311 if (MARKERP (readcharfun
))
313 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
315 int bytepos
= marker_byte_position (readcharfun
);
317 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
320 if (! NILP (inbuffer
->enable_multibyte_characters
))
322 /* Fetch the character code from the buffer. */
323 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
324 BUF_INC_POS (inbuffer
, bytepos
);
325 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
331 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
332 if (! ASCII_BYTE_P (c
))
333 c
= BYTE8_TO_CHAR (c
);
337 XMARKER (readcharfun
)->bytepos
= bytepos
;
338 XMARKER (readcharfun
)->charpos
++;
343 if (EQ (readcharfun
, Qlambda
))
345 readbyte
= readbyte_for_lambda
;
349 if (EQ (readcharfun
, Qget_file_char
))
351 readbyte
= readbyte_from_file
;
355 if (STRINGP (readcharfun
))
357 if (read_from_string_index
>= read_from_string_limit
)
359 else if (STRING_MULTIBYTE (readcharfun
))
363 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
364 read_from_string_index
,
365 read_from_string_index_byte
);
369 c
= SREF (readcharfun
, read_from_string_index_byte
);
370 read_from_string_index
++;
371 read_from_string_index_byte
++;
376 if (CONSP (readcharfun
))
378 /* This is the case that read_vector is reading from a unibyte
379 string that contains a byte sequence previously skipped
380 because of #@NUMBER. The car part of readcharfun is that
381 string, and the cdr part is a value of readcharfun given to
383 readbyte
= readbyte_from_string
;
384 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
385 emacs_mule_encoding
= 1;
389 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
391 readbyte
= readbyte_from_file
;
392 emacs_mule_encoding
= 1;
396 tem
= call0 (readcharfun
);
403 if (unread_char
>= 0)
409 c
= (*readbyte
) (-1, readcharfun
);
410 if (c
< 0 || load_each_byte
)
414 if (ASCII_BYTE_P (c
))
416 if (emacs_mule_encoding
)
417 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
420 len
= BYTES_BY_CHAR_HEAD (c
);
423 c
= (*readbyte
) (-1, readcharfun
);
424 if (c
< 0 || ! TRAILING_CODE_P (c
))
427 (*readbyte
) (buf
[i
], readcharfun
);
428 return BYTE8_TO_CHAR (buf
[0]);
432 return STRING_CHAR (buf
, i
);
435 /* Unread the character C in the way appropriate for the stream READCHARFUN.
436 If the stream is a user function, call it with the char as argument. */
439 unreadchar (readcharfun
, c
)
440 Lisp_Object readcharfun
;
445 /* Don't back up the pointer if we're unreading the end-of-input mark,
446 since readchar didn't advance it when we read it. */
448 else if (BUFFERP (readcharfun
))
450 struct buffer
*b
= XBUFFER (readcharfun
);
451 int bytepos
= BUF_PT_BYTE (b
);
454 if (! NILP (b
->enable_multibyte_characters
))
455 BUF_DEC_POS (b
, bytepos
);
459 BUF_PT_BYTE (b
) = bytepos
;
461 else if (MARKERP (readcharfun
))
463 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
464 int bytepos
= XMARKER (readcharfun
)->bytepos
;
466 XMARKER (readcharfun
)->charpos
--;
467 if (! NILP (b
->enable_multibyte_characters
))
468 BUF_DEC_POS (b
, bytepos
);
472 XMARKER (readcharfun
)->bytepos
= bytepos
;
474 else if (STRINGP (readcharfun
))
476 read_from_string_index
--;
477 read_from_string_index_byte
478 = string_char_to_byte (readcharfun
, read_from_string_index
);
480 else if (CONSP (readcharfun
))
484 else if (EQ (readcharfun
, Qlambda
))
488 else if (EQ (readcharfun
, Qget_file_char
)
489 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
494 ungetc (c
, instream
);
501 call1 (readcharfun
, make_number (c
));
505 readbyte_for_lambda (c
, readcharfun
)
507 Lisp_Object readcharfun
;
509 return read_bytecode_char (c
>= 0);
514 readbyte_from_file (c
, readcharfun
)
516 Lisp_Object readcharfun
;
521 ungetc (c
, instream
);
530 /* Interrupted reads have been observed while reading over the network */
531 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
543 return (c
== EOF
? -1 : c
);
547 readbyte_from_string (c
, readcharfun
)
549 Lisp_Object readcharfun
;
551 Lisp_Object string
= XCAR (readcharfun
);
555 read_from_string_index
--;
556 read_from_string_index_byte
557 = string_char_to_byte (string
, read_from_string_index
);
560 if (read_from_string_index
>= read_from_string_limit
)
563 FETCH_STRING_CHAR_ADVANCE (c
, string
,
564 read_from_string_index
,
565 read_from_string_index_byte
);
570 /* Read one non-ASCII character from INSTREAM. The character is
571 encoded in `emacs-mule' and the first byte is already read in
574 extern char emacs_mule_bytes
[256];
577 read_emacs_mule_char (c
, readbyte
, readcharfun
)
579 int (*readbyte
) P_ ((int, Lisp_Object
));
580 Lisp_Object readcharfun
;
582 /* Emacs-mule coding uses at most 4-byte for one character. */
583 unsigned char buf
[4];
584 int len
= emacs_mule_bytes
[c
];
585 struct charset
*charset
;
590 /* C is not a valid leading-code of `emacs-mule'. */
591 return BYTE8_TO_CHAR (c
);
597 c
= (*readbyte
) (-1, readcharfun
);
601 (*readbyte
) (buf
[i
], readcharfun
);
602 return BYTE8_TO_CHAR (buf
[0]);
609 charset
= emacs_mule_charset
[buf
[0]];
610 code
= buf
[1] & 0x7F;
614 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
615 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
617 charset
= emacs_mule_charset
[buf
[1]];
618 code
= buf
[2] & 0x7F;
622 charset
= emacs_mule_charset
[buf
[0]];
623 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
628 charset
= emacs_mule_charset
[buf
[1]];
629 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
631 c
= DECODE_CHAR (charset
, code
);
633 Fsignal (Qinvalid_read_syntax
,
634 Fcons (build_string ("invalid multibyte form"), Qnil
));
639 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
641 static Lisp_Object read0
P_ ((Lisp_Object
));
642 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
644 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
645 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
647 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
649 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
651 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
654 /* Get a character from the tty. */
656 /* Read input events until we get one that's acceptable for our purposes.
658 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
659 until we get a character we like, and then stuffed into
662 If ASCII_REQUIRED is non-zero, we check function key events to see
663 if the unmodified version of the symbol has a Qascii_character
664 property, and use that character, if present.
666 If ERROR_NONASCII is non-zero, we signal an error if the input we
667 get isn't an ASCII character with modifiers. If it's zero but
668 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
671 If INPUT_METHOD is nonzero, we invoke the current input method
672 if the character warrants that.
674 If SECONDS is a number, we wait that many seconds for input, and
675 return Qnil if no input arrives within that time. */
678 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
679 input_method
, seconds
)
680 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
683 Lisp_Object val
, delayed_switch_frame
;
686 #ifdef HAVE_WINDOW_SYSTEM
687 if (display_hourglass_p
)
691 delayed_switch_frame
= Qnil
;
693 /* Compute timeout. */
694 if (NUMBERP (seconds
))
696 EMACS_TIME wait_time
;
698 double duration
= extract_float (seconds
);
700 sec
= (int) duration
;
701 usec
= (duration
- sec
) * 1000000;
702 EMACS_GET_TIME (end_time
);
703 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
704 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
707 /* Read until we get an acceptable event. */
710 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
711 NUMBERP (seconds
) ? &end_time
: NULL
);
712 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
717 /* switch-frame events are put off until after the next ASCII
718 character. This is better than signaling an error just because
719 the last characters were typed to a separate minibuffer frame,
720 for example. Eventually, some code which can deal with
721 switch-frame events will read it and process it. */
723 && EVENT_HAS_PARAMETERS (val
)
724 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
726 delayed_switch_frame
= val
;
730 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
732 /* Convert certain symbols to their ASCII equivalents. */
735 Lisp_Object tem
, tem1
;
736 tem
= Fget (val
, Qevent_symbol_element_mask
);
739 tem1
= Fget (Fcar (tem
), Qascii_character
);
740 /* Merge this symbol's modifier bits
741 with the ASCII equivalent of its basic code. */
743 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
747 /* If we don't have a character now, deal with it appropriately. */
752 Vunread_command_events
= Fcons (val
, Qnil
);
753 error ("Non-character input-event");
760 if (! NILP (delayed_switch_frame
))
761 unread_switch_frame
= delayed_switch_frame
;
765 #ifdef HAVE_WINDOW_SYSTEM
766 if (display_hourglass_p
)
775 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
776 doc
: /* Read a character from the command input (keyboard or macro).
777 It is returned as a number.
778 If the user generates an event which is not a character (i.e. a mouse
779 click or function key event), `read-char' signals an error. As an
780 exception, switch-frame events are put off until non-ASCII events can
782 If you want to read non-character events, or ignore them, call
783 `read-event' or `read-char-exclusive' instead.
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 (prompt
, inherit_input_method
, seconds
)
794 Lisp_Object prompt
, inherit_input_method
, seconds
;
797 message_with_string ("%s", prompt
, 0);
798 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
801 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
802 doc
: /* Read an event object from the input stream.
803 If the optional argument PROMPT is non-nil, display that as a prompt.
804 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
805 input method is turned on in the current buffer, that input method
806 is used for reading a character.
807 If the optional argument SECONDS is non-nil, it should be a number
808 specifying the maximum number of seconds to wait for input. If no
809 input arrives in that time, return nil. SECONDS may be a
810 floating-point value. */)
811 (prompt
, inherit_input_method
, seconds
)
812 Lisp_Object prompt
, inherit_input_method
, seconds
;
815 message_with_string ("%s", prompt
, 0);
816 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
819 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
820 doc
: /* Read a character from the command input (keyboard or macro).
821 It is returned as a number. Non-character events are ignored.
823 If the optional argument PROMPT is non-nil, display that as a prompt.
824 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
825 input method is turned on in the current buffer, that input method
826 is used for reading a character.
827 If the optional argument SECONDS is non-nil, it should be a number
828 specifying the maximum number of seconds to wait for input. If no
829 input arrives in that time, return nil. SECONDS may be a
830 floating-point value. */)
831 (prompt
, inherit_input_method
, seconds
)
832 Lisp_Object prompt
, inherit_input_method
, seconds
;
835 message_with_string ("%s", prompt
, 0);
836 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
839 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
840 doc
: /* Don't use this yourself. */)
843 register Lisp_Object val
;
845 XSETINT (val
, getc (instream
));
852 /* Value is a version number of byte compiled code if the file
853 associated with file descriptor FD is a compiled Lisp file that's
854 safe to load. Only files compiled with Emacs are safe to load.
855 Files compiled with XEmacs can lead to a crash in Fbyte_code
856 because of an incompatible change in the byte compiler. */
867 /* Read the first few bytes from the file, and look for a line
868 specifying the byte compiler version used. */
869 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
874 /* Skip to the next newline, skipping over the initial `ELC'
875 with NUL bytes following it, but note the version. */
876 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
881 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
888 lseek (fd
, 0, SEEK_SET
);
893 /* Callback for record_unwind_protect. Restore the old load list OLD,
894 after loading a file successfully. */
897 record_load_unwind (old
)
900 return Vloads_in_progress
= old
;
903 /* This handler function is used via internal_condition_case_1. */
906 load_error_handler (data
)
913 load_warn_old_style_backquotes (file
)
916 if (!NILP (Vold_style_backquotes
))
919 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
926 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
927 doc
: /* Return the suffixes that `load' should try if a suffix is \
929 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
932 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
933 while (CONSP (suffixes
))
935 Lisp_Object exts
= Vload_file_rep_suffixes
;
936 suffix
= XCAR (suffixes
);
937 suffixes
= XCDR (suffixes
);
942 lst
= Fcons (concat2 (suffix
, ext
), lst
);
945 return Fnreverse (lst
);
948 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
949 doc
: /* Execute a file of Lisp code named FILE.
950 First try FILE with `.elc' appended, then try with `.el',
951 then try FILE unmodified (the exact suffixes in the exact order are
952 determined by `load-suffixes'). Environment variable references in
953 FILE are replaced with their values by calling `substitute-in-file-name'.
954 This function searches the directories in `load-path'.
956 If optional second arg NOERROR is non-nil,
957 report no error if FILE doesn't exist.
958 Print messages at start and end of loading unless
959 optional third arg NOMESSAGE is non-nil.
960 If optional fourth arg NOSUFFIX is non-nil, don't try adding
961 suffixes `.elc' or `.el' to the specified name FILE.
962 If optional fifth arg MUST-SUFFIX is non-nil, insist on
963 the suffix `.elc' or `.el'; don't accept just FILE unless
964 it ends in one of those suffixes or includes a directory name.
966 If this function fails to find a file, it may look for different
967 representations of that file before trying another file.
968 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
969 to the file name. Emacs uses this feature mainly to find compressed
970 versions of files when Auto Compression mode is enabled.
972 The exact suffixes that this function tries out, in the exact order,
973 are given by the value of the variable `load-file-rep-suffixes' if
974 NOSUFFIX is non-nil and by the return value of the function
975 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
976 MUST-SUFFIX are nil, this function first tries out the latter suffixes
979 Loading a file records its definitions, and its `provide' and
980 `require' calls, in an element of `load-history' whose
981 car is the file name loaded. See `load-history'.
983 Return t if the file exists and loads successfully. */)
984 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
985 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
987 register FILE *stream
;
988 register int fd
= -1;
989 int count
= SPECPDL_INDEX ();
990 struct gcpro gcpro1
, gcpro2
, gcpro3
;
991 Lisp_Object found
, efound
, hist_file_name
;
992 /* 1 means we printed the ".el is newer" message. */
994 /* 1 means we are loading a compiled file. */
1006 CHECK_STRING (file
);
1008 /* If file name is magic, call the handler. */
1009 /* This shouldn't be necessary any more now that `openp' handles it right.
1010 handler = Ffind_file_name_handler (file, Qload);
1011 if (!NILP (handler))
1012 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1014 /* Do this after the handler to avoid
1015 the need to gcpro noerror, nomessage and nosuffix.
1016 (Below here, we care only whether they are nil or not.)
1017 The presence of this call is the result of a historical accident:
1018 it used to be in every file-operation and when it got removed
1019 everywhere, it accidentally stayed here. Since then, enough people
1020 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1021 that it seemed risky to remove. */
1022 if (! NILP (noerror
))
1024 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1025 Qt
, load_error_handler
);
1030 file
= Fsubstitute_in_file_name (file
);
1033 /* Avoid weird lossage with null string as arg,
1034 since it would try to load a directory as a Lisp file */
1035 if (SCHARS (file
) > 0)
1037 int size
= SBYTES (file
);
1040 GCPRO2 (file
, found
);
1042 if (! NILP (must_suffix
))
1044 /* Don't insist on adding a suffix if FILE already ends with one. */
1046 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1049 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1051 /* Don't insist on adding a suffix
1052 if the argument includes a directory name. */
1053 else if (! NILP (Ffile_name_directory (file
)))
1057 fd
= openp (Vload_path
, file
,
1058 (!NILP (nosuffix
) ? Qnil
1059 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1060 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1061 tmp
[1] = Vload_file_rep_suffixes
,
1070 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1074 /* Tell startup.el whether or not we found the user's init file. */
1075 if (EQ (Qt
, Vuser_init_file
))
1076 Vuser_init_file
= found
;
1078 /* If FD is -2, that means openp found a magic file. */
1081 if (NILP (Fequal (found
, file
)))
1082 /* If FOUND is a different file name from FILE,
1083 find its handler even if we have already inhibited
1084 the `load' operation on FILE. */
1085 handler
= Ffind_file_name_handler (found
, Qt
);
1087 handler
= Ffind_file_name_handler (found
, Qload
);
1088 if (! NILP (handler
))
1089 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1092 /* Check if we're stuck in a recursive load cycle.
1094 2000-09-21: It's not possible to just check for the file loaded
1095 being a member of Vloads_in_progress. This fails because of the
1096 way the byte compiler currently works; `provide's are not
1097 evaluted, see font-lock.el/jit-lock.el as an example. This
1098 leads to a certain amount of ``normal'' recursion.
1100 Also, just loading a file recursively is not always an error in
1101 the general case; the second load may do something different. */
1105 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1106 if (!NILP (Fequal (found
, XCAR (tem
))))
1112 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1114 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1115 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1118 /* Get the name for load-history. */
1119 hist_file_name
= (! NILP (Vpurify_flag
)
1120 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1121 tmp
[1] = Ffile_name_nondirectory (found
),
1127 /* Check for the presence of old-style quotes and warn about them. */
1128 specbind (Qold_style_backquotes
, Qnil
);
1129 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1131 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1133 || (version
= safe_to_load_p (fd
)) > 0)
1134 /* Load .elc files directly, but not when they are
1135 remote and have no handler! */
1142 GCPRO3 (file
, found
, hist_file_name
);
1145 && ! (version
= safe_to_load_p (fd
)))
1148 if (!load_dangerous_libraries
)
1152 error ("File `%s' was not compiled in Emacs",
1155 else if (!NILP (nomessage
))
1156 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1161 efound
= ENCODE_FILE (found
);
1166 stat ((char *)SDATA (efound
), &s1
);
1167 SSET (efound
, SBYTES (efound
) - 1, 0);
1168 result
= stat ((char *)SDATA (efound
), &s2
);
1169 SSET (efound
, SBYTES (efound
) - 1, 'c');
1171 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1173 /* Make the progress messages mention that source is newer. */
1176 /* If we won't print another message, mention this anyway. */
1177 if (!NILP (nomessage
))
1179 Lisp_Object msg_file
;
1180 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1181 message_with_string ("Source file `%s' newer than byte-compiled file",
1190 /* We are loading a source file (*.el). */
1191 if (!NILP (Vload_source_file_function
))
1197 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1198 NILP (noerror
) ? Qnil
: Qt
,
1199 NILP (nomessage
) ? Qnil
: Qt
);
1200 return unbind_to (count
, val
);
1204 GCPRO3 (file
, found
, hist_file_name
);
1208 efound
= ENCODE_FILE (found
);
1209 stream
= fopen ((char *) SDATA (efound
), fmode
);
1210 #else /* not WINDOWSNT */
1211 stream
= fdopen (fd
, fmode
);
1212 #endif /* not WINDOWSNT */
1216 error ("Failure to create stdio stream for %s", SDATA (file
));
1219 if (! NILP (Vpurify_flag
))
1220 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1222 if (NILP (nomessage
))
1225 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1228 message_with_string ("Loading %s (source)...", file
, 1);
1230 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1232 else /* The typical case; compiled file newer than source file. */
1233 message_with_string ("Loading %s...", file
, 1);
1236 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1237 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1238 specbind (Qload_file_name
, found
);
1239 specbind (Qinhibit_file_name_operation
, Qnil
);
1240 load_descriptor_list
1241 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1243 if (! version
|| version
>= 22)
1244 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1245 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1248 /* We can't handle a file which was compiled with
1249 byte-compile-dynamic by older version of Emacs. */
1250 specbind (Qload_force_doc_strings
, Qt
);
1251 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1252 0, Qnil
, Qnil
, Qnil
, Qnil
);
1254 unbind_to (count
, Qnil
);
1256 /* Run any eval-after-load forms for this file */
1257 if (NILP (Vpurify_flag
)
1258 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1259 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1263 if (saved_doc_string
)
1264 free (saved_doc_string
);
1265 saved_doc_string
= 0;
1266 saved_doc_string_size
= 0;
1268 if (prev_saved_doc_string
)
1269 xfree (prev_saved_doc_string
);
1270 prev_saved_doc_string
= 0;
1271 prev_saved_doc_string_size
= 0;
1273 if (!noninteractive
&& NILP (nomessage
))
1276 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1279 message_with_string ("Loading %s (source)...done", file
, 1);
1281 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1283 else /* The typical case; compiled file newer than source file. */
1284 message_with_string ("Loading %s...done", file
, 1);
1287 if (!NILP (Fequal (build_string ("obsolete"),
1288 Ffile_name_nondirectory
1289 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1290 message_with_string ("Package %s is obsolete", file
, 1);
1296 load_unwind (arg
) /* used as unwind-protect function in load */
1299 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1306 if (--load_in_progress
< 0) load_in_progress
= 0;
1311 load_descriptor_unwind (oldlist
)
1312 Lisp_Object oldlist
;
1314 load_descriptor_list
= oldlist
;
1318 /* Close all descriptors in use for Floads.
1319 This is used when starting a subprocess. */
1326 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1327 emacs_close (XFASTINT (XCAR (tail
)));
1332 complete_filename_p (pathname
)
1333 Lisp_Object pathname
;
1335 register const unsigned char *s
= SDATA (pathname
);
1336 return (IS_DIRECTORY_SEP (s
[0])
1337 || (SCHARS (pathname
) > 2
1338 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1348 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1349 doc
: /* Search for FILENAME through PATH.
1350 Returns the file's name in absolute form, or nil if not found.
1351 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1352 file name when searching.
1353 If non-nil, PREDICATE is used instead of `file-readable-p'.
1354 PREDICATE can also be an integer to pass to the access(2) function,
1355 in which case file-name-handlers are ignored. */)
1356 (filename
, path
, suffixes
, predicate
)
1357 Lisp_Object filename
, path
, suffixes
, predicate
;
1360 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1361 if (NILP (predicate
) && fd
> 0)
1367 /* Search for a file whose name is STR, looking in directories
1368 in the Lisp list PATH, and trying suffixes from SUFFIX.
1369 On success, returns a file descriptor. On failure, returns -1.
1371 SUFFIXES is a list of strings containing possible suffixes.
1372 The empty suffix is automatically added if the list is empty.
1374 PREDICATE non-nil means don't open the files,
1375 just look for one that satisfies the predicate. In this case,
1376 returns 1 on success. The predicate can be a lisp function or
1377 an integer to pass to `access' (in which case file-name-handlers
1380 If STOREPTR is nonzero, it points to a slot where the name of
1381 the file actually found should be stored as a Lisp string.
1382 nil is stored there on failure.
1384 If the file we find is remote, return -2
1385 but store the found remote file name in *STOREPTR. */
1388 openp (path
, str
, suffixes
, storeptr
, predicate
)
1389 Lisp_Object path
, str
;
1390 Lisp_Object suffixes
;
1391 Lisp_Object
*storeptr
;
1392 Lisp_Object predicate
;
1397 register char *fn
= buf
;
1400 Lisp_Object filename
;
1402 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1403 Lisp_Object string
, tail
, encoded_fn
;
1404 int max_suffix_len
= 0;
1408 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1410 CHECK_STRING_CAR (tail
);
1411 max_suffix_len
= max (max_suffix_len
,
1412 SBYTES (XCAR (tail
)));
1415 string
= filename
= encoded_fn
= Qnil
;
1416 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1421 if (complete_filename_p (str
))
1424 for (; CONSP (path
); path
= XCDR (path
))
1426 filename
= Fexpand_file_name (str
, XCAR (path
));
1427 if (!complete_filename_p (filename
))
1428 /* If there are non-absolute elts in PATH (eg ".") */
1429 /* Of course, this could conceivably lose if luser sets
1430 default-directory to be something non-absolute... */
1432 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1433 if (!complete_filename_p (filename
))
1434 /* Give up on this path element! */
1438 /* Calculate maximum size of any filename made from
1439 this path element/specified file name and any possible suffix. */
1440 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1441 if (fn_size
< want_size
)
1442 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1444 /* Loop over suffixes. */
1445 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1446 CONSP (tail
); tail
= XCDR (tail
))
1448 int lsuffix
= SBYTES (XCAR (tail
));
1449 Lisp_Object handler
;
1452 /* Concatenate path element/specified name with the suffix.
1453 If the directory starts with /:, remove that. */
1454 if (SCHARS (filename
) > 2
1455 && SREF (filename
, 0) == '/'
1456 && SREF (filename
, 1) == ':')
1458 strncpy (fn
, SDATA (filename
) + 2,
1459 SBYTES (filename
) - 2);
1460 fn
[SBYTES (filename
) - 2] = 0;
1464 strncpy (fn
, SDATA (filename
),
1466 fn
[SBYTES (filename
)] = 0;
1469 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1470 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1472 /* Check that the file exists and is not a directory. */
1473 /* We used to only check for handlers on non-absolute file names:
1477 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1478 It's not clear why that was the case and it breaks things like
1479 (load "/bar.el") where the file is actually "/bar.el.gz". */
1480 string
= build_string (fn
);
1481 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1482 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1484 if (NILP (predicate
))
1485 exists
= !NILP (Ffile_readable_p (string
));
1487 exists
= !NILP (call1 (predicate
, string
));
1488 if (exists
&& !NILP (Ffile_directory_p (string
)))
1493 /* We succeeded; return this descriptor and filename. */
1504 encoded_fn
= ENCODE_FILE (string
);
1505 pfn
= SDATA (encoded_fn
);
1506 exists
= (stat (pfn
, &st
) >= 0
1507 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1510 /* Check that we can access or open it. */
1511 if (NATNUMP (predicate
))
1512 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1514 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1518 /* We succeeded; return this descriptor and filename. */
1536 /* Merge the list we've accumulated of globals from the current input source
1537 into the load_history variable. The details depend on whether
1538 the source has an associated file name or not.
1540 FILENAME is the file name that we are loading from.
1541 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1544 build_load_history (filename
, entire
)
1545 Lisp_Object filename
;
1548 register Lisp_Object tail
, prev
, newelt
;
1549 register Lisp_Object tem
, tem2
;
1550 register int foundit
= 0;
1552 tail
= Vload_history
;
1555 while (CONSP (tail
))
1559 /* Find the feature's previous assoc list... */
1560 if (!NILP (Fequal (filename
, Fcar (tem
))))
1564 /* If we're loading the entire file, remove old data. */
1568 Vload_history
= XCDR (tail
);
1570 Fsetcdr (prev
, XCDR (tail
));
1573 /* Otherwise, cons on new symbols that are not already members. */
1576 tem2
= Vcurrent_load_list
;
1578 while (CONSP (tem2
))
1580 newelt
= XCAR (tem2
);
1582 if (NILP (Fmember (newelt
, tem
)))
1583 Fsetcar (tail
, Fcons (XCAR (tem
),
1584 Fcons (newelt
, XCDR (tem
))));
1597 /* If we're loading an entire file, cons the new assoc onto the
1598 front of load-history, the most-recently-loaded position. Also
1599 do this if we didn't find an existing member for the file. */
1600 if (entire
|| !foundit
)
1601 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1606 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1614 readevalloop_1 (old
)
1617 load_convert_to_unibyte
= ! NILP (old
);
1621 /* Signal an `end-of-file' error, if possible with file name
1625 end_of_file_error ()
1627 if (STRINGP (Vload_file_name
))
1628 xsignal1 (Qend_of_file
, Vload_file_name
);
1630 xsignal0 (Qend_of_file
);
1633 /* UNIBYTE specifies how to set load_convert_to_unibyte
1634 for this invocation.
1635 READFUN, if non-nil, is used instead of `read'.
1637 START, END specify region to read in current buffer (from eval-region).
1638 If the input is not from a buffer, they must be nil. */
1641 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1642 printflag
, unibyte
, readfun
, start
, end
)
1643 Lisp_Object readcharfun
;
1645 Lisp_Object sourcename
;
1646 Lisp_Object (*evalfun
) ();
1648 Lisp_Object unibyte
, readfun
;
1649 Lisp_Object start
, end
;
1652 register Lisp_Object val
;
1653 int count
= SPECPDL_INDEX ();
1654 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1655 struct buffer
*b
= 0;
1656 int continue_reading_p
;
1657 /* Nonzero if reading an entire buffer. */
1658 int whole_buffer
= 0;
1659 /* 1 on the first time around. */
1662 if (MARKERP (readcharfun
))
1665 start
= readcharfun
;
1668 if (BUFFERP (readcharfun
))
1669 b
= XBUFFER (readcharfun
);
1670 else if (MARKERP (readcharfun
))
1671 b
= XMARKER (readcharfun
)->buffer
;
1673 /* We assume START is nil when input is not from a buffer. */
1674 if (! NILP (start
) && !b
)
1677 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1678 specbind (Qcurrent_load_list
, Qnil
);
1679 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1680 load_convert_to_unibyte
= !NILP (unibyte
);
1682 GCPRO4 (sourcename
, readfun
, start
, end
);
1684 /* Try to ensure sourcename is a truename, except whilst preloading. */
1685 if (NILP (Vpurify_flag
)
1686 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1687 && !NILP (Ffboundp (Qfile_truename
)))
1688 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1690 LOADHIST_ATTACH (sourcename
);
1692 continue_reading_p
= 1;
1693 while (continue_reading_p
)
1695 int count1
= SPECPDL_INDEX ();
1697 if (b
!= 0 && NILP (b
->name
))
1698 error ("Reading from killed buffer");
1702 /* Switch to the buffer we are reading from. */
1703 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1704 set_buffer_internal (b
);
1706 /* Save point in it. */
1707 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1708 /* Save ZV in it. */
1709 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1710 /* Those get unbound after we read one expression. */
1712 /* Set point and ZV around stuff to be read. */
1715 Fnarrow_to_region (make_number (BEGV
), end
);
1717 /* Just for cleanliness, convert END to a marker
1718 if it is an integer. */
1720 end
= Fpoint_max_marker ();
1723 /* On the first cycle, we can easily test here
1724 whether we are reading the whole buffer. */
1725 if (b
&& first_sexp
)
1726 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1733 while ((c
= READCHAR
) != '\n' && c
!= -1);
1738 unbind_to (count1
, Qnil
);
1742 /* Ignore whitespace here, so we can detect eof. */
1743 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1744 || c
== 0x8a0) /* NBSP */
1747 if (!NILP (Vpurify_flag
) && c
== '(')
1749 record_unwind_protect (unreadpure
, Qnil
);
1750 val
= read_list (-1, readcharfun
);
1755 read_objects
= Qnil
;
1756 if (!NILP (readfun
))
1758 val
= call1 (readfun
, readcharfun
);
1760 /* If READCHARFUN has set point to ZV, we should
1761 stop reading, even if the form read sets point
1762 to a different value when evaluated. */
1763 if (BUFFERP (readcharfun
))
1765 struct buffer
*b
= XBUFFER (readcharfun
);
1766 if (BUF_PT (b
) == BUF_ZV (b
))
1767 continue_reading_p
= 0;
1770 else if (! NILP (Vload_read_function
))
1771 val
= call1 (Vload_read_function
, readcharfun
);
1773 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1776 if (!NILP (start
) && continue_reading_p
)
1777 start
= Fpoint_marker ();
1779 /* Restore saved point and BEGV. */
1780 unbind_to (count1
, Qnil
);
1782 /* Now eval what we just read. */
1783 val
= (*evalfun
) (val
);
1787 Vvalues
= Fcons (val
, Vvalues
);
1788 if (EQ (Vstandard_output
, Qt
))
1797 build_load_history (sourcename
,
1798 stream
|| whole_buffer
);
1802 unbind_to (count
, Qnil
);
1805 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1806 doc
: /* Execute the current buffer as Lisp code.
1807 Programs can pass two arguments, BUFFER and PRINTFLAG.
1808 BUFFER is the buffer to evaluate (nil means use current buffer).
1809 PRINTFLAG controls printing of output:
1810 A value of nil means discard it; anything else is stream for print.
1812 If the optional third argument FILENAME is non-nil,
1813 it specifies the file name to use for `load-history'.
1814 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1815 for this invocation.
1817 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1818 `print' and related functions should work normally even if PRINTFLAG is nil.
1820 This function preserves the position of point. */)
1821 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1822 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1824 int count
= SPECPDL_INDEX ();
1825 Lisp_Object tem
, buf
;
1828 buf
= Fcurrent_buffer ();
1830 buf
= Fget_buffer (buffer
);
1832 error ("No such buffer");
1834 if (NILP (printflag
) && NILP (do_allow_print
))
1839 if (NILP (filename
))
1840 filename
= XBUFFER (buf
)->filename
;
1842 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1843 specbind (Qstandard_output
, tem
);
1844 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1845 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1846 readevalloop (buf
, 0, filename
, Feval
,
1847 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1848 unbind_to (count
, Qnil
);
1853 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1854 doc
: /* Execute the region as Lisp code.
1855 When called from programs, expects two arguments,
1856 giving starting and ending indices in the current buffer
1857 of the text to be executed.
1858 Programs can pass third argument PRINTFLAG which controls output:
1859 A value of nil means discard it; anything else is stream for printing it.
1860 Also the fourth argument READ-FUNCTION, if non-nil, is used
1861 instead of `read' to read each expression. It gets one argument
1862 which is the input stream for reading characters.
1864 This function does not move point. */)
1865 (start
, end
, printflag
, read_function
)
1866 Lisp_Object start
, end
, printflag
, read_function
;
1868 int count
= SPECPDL_INDEX ();
1869 Lisp_Object tem
, cbuf
;
1871 cbuf
= Fcurrent_buffer ();
1873 if (NILP (printflag
))
1877 specbind (Qstandard_output
, tem
);
1878 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1880 /* readevalloop calls functions which check the type of start and end. */
1881 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1882 !NILP (printflag
), Qnil
, read_function
,
1885 return unbind_to (count
, Qnil
);
1889 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1890 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1891 If STREAM is nil, use the value of `standard-input' (which see).
1892 STREAM or the value of `standard-input' may be:
1893 a buffer (read from point and advance it)
1894 a marker (read from where it points and advance it)
1895 a function (call it with no arguments for each character,
1896 call it with a char as argument to push a char back)
1897 a string (takes text from string, starting at the beginning)
1898 t (read text line using minibuffer and use it, or read from
1899 standard input in batch mode). */)
1904 stream
= Vstandard_input
;
1905 if (EQ (stream
, Qt
))
1906 stream
= Qread_char
;
1907 if (EQ (stream
, Qread_char
))
1908 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1910 return read_internal_start (stream
, Qnil
, Qnil
);
1913 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1914 doc
: /* Read one Lisp expression which is represented as text by STRING.
1915 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1916 START and END optionally delimit a substring of STRING from which to read;
1917 they default to 0 and (length STRING) respectively. */)
1918 (string
, start
, end
)
1919 Lisp_Object string
, start
, end
;
1922 CHECK_STRING (string
);
1923 /* read_internal_start sets read_from_string_index. */
1924 ret
= read_internal_start (string
, start
, end
);
1925 return Fcons (ret
, make_number (read_from_string_index
));
1928 /* Function to set up the global context we need in toplevel read
1931 read_internal_start (stream
, start
, end
)
1933 Lisp_Object start
; /* Only used when stream is a string. */
1934 Lisp_Object end
; /* Only used when stream is a string. */
1939 new_backquote_flag
= 0;
1940 read_objects
= Qnil
;
1941 if (EQ (Vread_with_symbol_positions
, Qt
)
1942 || EQ (Vread_with_symbol_positions
, stream
))
1943 Vread_symbol_positions_list
= Qnil
;
1945 if (STRINGP (stream
)
1946 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1948 int startval
, endval
;
1951 if (STRINGP (stream
))
1954 string
= XCAR (stream
);
1957 endval
= SCHARS (string
);
1961 endval
= XINT (end
);
1962 if (endval
< 0 || endval
> SCHARS (string
))
1963 args_out_of_range (string
, end
);
1970 CHECK_NUMBER (start
);
1971 startval
= XINT (start
);
1972 if (startval
< 0 || startval
> endval
)
1973 args_out_of_range (string
, start
);
1975 read_from_string_index
= startval
;
1976 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1977 read_from_string_limit
= endval
;
1980 retval
= read0 (stream
);
1981 if (EQ (Vread_with_symbol_positions
, Qt
)
1982 || EQ (Vread_with_symbol_positions
, stream
))
1983 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1988 /* Signal Qinvalid_read_syntax error.
1989 S is error string of length N (if > 0) */
1992 invalid_syntax (s
, n
)
1998 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2002 /* Use this for recursive reads, in contexts where internal tokens
2007 Lisp_Object readcharfun
;
2009 register Lisp_Object val
;
2012 val
= read1 (readcharfun
, &c
, 0);
2016 xsignal1 (Qinvalid_read_syntax
,
2017 Fmake_string (make_number (1), make_number (c
)));
2020 static int read_buffer_size
;
2021 static char *read_buffer
;
2023 /* Read a \-escape sequence, assuming we already read the `\'.
2024 If the escape sequence forces unibyte, return eight-bit char. */
2027 read_escape (readcharfun
, stringp
)
2028 Lisp_Object readcharfun
;
2031 register int c
= READCHAR
;
2032 /* \u allows up to four hex digits, \U up to eight. Default to the
2033 behaviour for \u, and change this value in the case that \U is seen. */
2034 int unicode_hex_count
= 4;
2039 end_of_file_error ();
2069 error ("Invalid escape character syntax");
2072 c
= read_escape (readcharfun
, 0);
2073 return c
| meta_modifier
;
2078 error ("Invalid escape character syntax");
2081 c
= read_escape (readcharfun
, 0);
2082 return c
| shift_modifier
;
2087 error ("Invalid escape character syntax");
2090 c
= read_escape (readcharfun
, 0);
2091 return c
| hyper_modifier
;
2096 error ("Invalid escape character syntax");
2099 c
= read_escape (readcharfun
, 0);
2100 return c
| alt_modifier
;
2104 if (stringp
|| c
!= '-')
2111 c
= read_escape (readcharfun
, 0);
2112 return c
| super_modifier
;
2117 error ("Invalid escape character syntax");
2121 c
= read_escape (readcharfun
, 0);
2122 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2123 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2124 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2125 return c
| ctrl_modifier
;
2126 /* ASCII control chars are made from letters (both cases),
2127 as well as the non-letters within 0100...0137. */
2128 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2129 return (c
& (037 | ~0177));
2130 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2131 return (c
& (037 | ~0177));
2133 return c
| ctrl_modifier
;
2143 /* An octal escape, as in ANSI C. */
2145 register int i
= c
- '0';
2146 register int count
= 0;
2149 if ((c
= READCHAR
) >= '0' && c
<= '7')
2161 if (i
>= 0x80 && i
< 0x100)
2162 i
= BYTE8_TO_CHAR (i
);
2167 /* A hex escape, as in ANSI C. */
2174 if (c
>= '0' && c
<= '9')
2179 else if ((c
>= 'a' && c
<= 'f')
2180 || (c
>= 'A' && c
<= 'F'))
2183 if (c
>= 'a' && c
<= 'f')
2196 if (count
< 3 && i
>= 0x80)
2197 return BYTE8_TO_CHAR (i
);
2202 /* Post-Unicode-2.0: Up to eight hex chars. */
2203 unicode_hex_count
= 8;
2206 /* A Unicode escape. We only permit them in strings and characters,
2207 not arbitrarily in the source code, as in some other languages. */
2212 while (++count
<= unicode_hex_count
)
2215 /* isdigit and isalpha may be locale-specific, which we don't
2217 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2218 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2219 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2222 error ("Non-hex digit used for Unicode escape");
2235 /* Read an integer in radix RADIX using READCHARFUN to read
2236 characters. RADIX must be in the interval [2..36]; if it isn't, a
2237 read error is signaled . Value is the integer read. Signals an
2238 error if encountering invalid read syntax or if RADIX is out of
2242 read_integer (readcharfun
, radix
)
2243 Lisp_Object readcharfun
;
2246 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2247 EMACS_INT number
= 0;
2249 if (radix
< 2 || radix
> 36)
2253 number
= ndigits
= invalid_p
= 0;
2269 if (c
>= '0' && c
<= '9')
2271 else if (c
>= 'a' && c
<= 'z')
2272 digit
= c
- 'a' + 10;
2273 else if (c
>= 'A' && c
<= 'Z')
2274 digit
= c
- 'A' + 10;
2281 if (digit
< 0 || digit
>= radix
)
2284 number
= radix
* number
+ digit
;
2290 if (ndigits
== 0 || invalid_p
)
2293 sprintf (buf
, "integer, radix %d", radix
);
2294 invalid_syntax (buf
, 0);
2297 return make_number (sign
* number
);
2301 /* If the next token is ')' or ']' or '.', we store that character
2302 in *PCH and the return value is not interesting. Else, we store
2303 zero in *PCH and we read and return one lisp object.
2305 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2308 read1 (readcharfun
, pch
, first_in_list
)
2309 register Lisp_Object readcharfun
;
2314 int uninterned_symbol
= 0;
2322 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2324 end_of_file_error ();
2329 return read_list (0, readcharfun
);
2332 return read_vector (readcharfun
, 0);
2349 tmp
= read_vector (readcharfun
, 0);
2350 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2351 error ("Invalid size char-table");
2352 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2363 tmp
= read_vector (readcharfun
, 0);
2364 if (!INTEGERP (AREF (tmp
, 0)))
2365 error ("Invalid depth in char-table");
2366 depth
= XINT (AREF (tmp
, 0));
2367 if (depth
< 1 || depth
> 3)
2368 error ("Invalid depth in char-table");
2369 size
= XVECTOR (tmp
)->size
- 2;
2370 if (chartab_size
[depth
] != size
)
2371 error ("Invalid size char-table");
2372 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2375 invalid_syntax ("#^^", 3);
2377 invalid_syntax ("#^", 2);
2382 length
= read1 (readcharfun
, pch
, first_in_list
);
2386 Lisp_Object tmp
, val
;
2388 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2389 / BOOL_VECTOR_BITS_PER_CHAR
);
2392 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2393 if (STRING_MULTIBYTE (tmp
)
2394 || (size_in_chars
!= SCHARS (tmp
)
2395 /* We used to print 1 char too many
2396 when the number of bits was a multiple of 8.
2397 Accept such input in case it came from an old
2399 && ! (XFASTINT (length
)
2400 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2401 invalid_syntax ("#&...", 5);
2403 val
= Fmake_bool_vector (length
, Qnil
);
2404 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2406 /* Clear the extraneous bits in the last byte. */
2407 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2408 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2409 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2412 invalid_syntax ("#&...", 5);
2416 /* Accept compiled functions at read-time so that we don't have to
2417 build them using function calls. */
2419 tmp
= read_vector (readcharfun
, 1);
2420 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2421 XVECTOR (tmp
)->contents
);
2426 struct gcpro gcpro1
;
2429 /* Read the string itself. */
2430 tmp
= read1 (readcharfun
, &ch
, 0);
2431 if (ch
!= 0 || !STRINGP (tmp
))
2432 invalid_syntax ("#", 1);
2434 /* Read the intervals and their properties. */
2437 Lisp_Object beg
, end
, plist
;
2439 beg
= read1 (readcharfun
, &ch
, 0);
2444 end
= read1 (readcharfun
, &ch
, 0);
2446 plist
= read1 (readcharfun
, &ch
, 0);
2448 invalid_syntax ("Invalid string property list", 0);
2449 Fset_text_properties (beg
, end
, plist
, tmp
);
2455 /* #@NUMBER is used to skip NUMBER following characters.
2456 That's used in .elc files to skip over doc strings
2457 and function definitions. */
2463 /* Read a decimal integer. */
2464 while ((c
= READCHAR
) >= 0
2465 && c
>= '0' && c
<= '9')
2473 if (load_force_doc_strings
2474 && (EQ (readcharfun
, Qget_file_char
)
2475 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2477 /* If we are supposed to force doc strings into core right now,
2478 record the last string that we skipped,
2479 and record where in the file it comes from. */
2481 /* But first exchange saved_doc_string
2482 with prev_saved_doc_string, so we save two strings. */
2484 char *temp
= saved_doc_string
;
2485 int temp_size
= saved_doc_string_size
;
2486 file_offset temp_pos
= saved_doc_string_position
;
2487 int temp_len
= saved_doc_string_length
;
2489 saved_doc_string
= prev_saved_doc_string
;
2490 saved_doc_string_size
= prev_saved_doc_string_size
;
2491 saved_doc_string_position
= prev_saved_doc_string_position
;
2492 saved_doc_string_length
= prev_saved_doc_string_length
;
2494 prev_saved_doc_string
= temp
;
2495 prev_saved_doc_string_size
= temp_size
;
2496 prev_saved_doc_string_position
= temp_pos
;
2497 prev_saved_doc_string_length
= temp_len
;
2500 if (saved_doc_string_size
== 0)
2502 saved_doc_string_size
= nskip
+ 100;
2503 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2505 if (nskip
> saved_doc_string_size
)
2507 saved_doc_string_size
= nskip
+ 100;
2508 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2509 saved_doc_string_size
);
2512 saved_doc_string_position
= file_tell (instream
);
2514 /* Copy that many characters into saved_doc_string. */
2515 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2516 saved_doc_string
[i
] = c
= READCHAR
;
2518 saved_doc_string_length
= i
;
2522 /* Skip that many characters. */
2523 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2532 /* #! appears at the beginning of an executable file.
2533 Skip the first line. */
2534 while (c
!= '\n' && c
>= 0)
2539 return Vload_file_name
;
2541 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2542 /* #:foo is the uninterned symbol named foo. */
2545 uninterned_symbol
= 1;
2549 /* Reader forms that can reuse previously read objects. */
2550 if (c
>= '0' && c
<= '9')
2555 /* Read a non-negative integer. */
2556 while (c
>= '0' && c
<= '9')
2562 /* #n=object returns object, but associates it with n for #n#. */
2565 /* Make a placeholder for #n# to use temporarily */
2566 Lisp_Object placeholder
;
2569 placeholder
= Fcons(Qnil
, Qnil
);
2570 cell
= Fcons (make_number (n
), placeholder
);
2571 read_objects
= Fcons (cell
, read_objects
);
2573 /* Read the object itself. */
2574 tem
= read0 (readcharfun
);
2576 /* Now put it everywhere the placeholder was... */
2577 substitute_object_in_subtree (tem
, placeholder
);
2579 /* ...and #n# will use the real value from now on. */
2580 Fsetcdr (cell
, tem
);
2584 /* #n# returns a previously read object. */
2587 tem
= Fassq (make_number (n
), read_objects
);
2590 /* Fall through to error message. */
2592 else if (c
== 'r' || c
== 'R')
2593 return read_integer (readcharfun
, n
);
2595 /* Fall through to error message. */
2597 else if (c
== 'x' || c
== 'X')
2598 return read_integer (readcharfun
, 16);
2599 else if (c
== 'o' || c
== 'O')
2600 return read_integer (readcharfun
, 8);
2601 else if (c
== 'b' || c
== 'B')
2602 return read_integer (readcharfun
, 2);
2605 invalid_syntax ("#", 1);
2608 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2613 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2619 Vold_style_backquotes
= Qt
;
2626 new_backquote_flag
++;
2627 value
= read0 (readcharfun
);
2628 new_backquote_flag
--;
2630 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2634 if (new_backquote_flag
)
2636 Lisp_Object comma_type
= Qnil
;
2641 comma_type
= Qcomma_at
;
2643 comma_type
= Qcomma_dot
;
2646 if (ch
>= 0) UNREAD (ch
);
2647 comma_type
= Qcomma
;
2650 new_backquote_flag
--;
2651 value
= read0 (readcharfun
);
2652 new_backquote_flag
++;
2653 return Fcons (comma_type
, Fcons (value
, Qnil
));
2657 Vold_style_backquotes
= Qt
;
2669 end_of_file_error ();
2671 /* Accept `single space' syntax like (list ? x) where the
2672 whitespace character is SPC or TAB.
2673 Other literal whitespace like NL, CR, and FF are not accepted,
2674 as there are well-established escape sequences for these. */
2675 if (c
== ' ' || c
== '\t')
2676 return make_number (c
);
2679 c
= read_escape (readcharfun
, 0);
2680 modifiers
= c
& CHAR_MODIFIER_MASK
;
2681 c
&= ~CHAR_MODIFIER_MASK
;
2682 if (CHAR_BYTE8_P (c
))
2683 c
= CHAR_TO_BYTE8 (c
);
2686 next_char
= READCHAR
;
2687 if (next_char
== '.')
2689 /* Only a dotted-pair dot is valid after a char constant. */
2690 int next_next_char
= READCHAR
;
2691 UNREAD (next_next_char
);
2693 ok
= (next_next_char
<= 040
2694 || (next_next_char
< 0200
2695 && (index ("\"';([#?", next_next_char
)
2696 || (!first_in_list
&& next_next_char
== '`')
2697 || (new_backquote_flag
&& next_next_char
== ','))));
2701 ok
= (next_char
<= 040
2702 || (next_char
< 0200
2703 && (index ("\"';()[]#?", next_char
)
2704 || (!first_in_list
&& next_char
== '`')
2705 || (new_backquote_flag
&& next_char
== ','))));
2709 return make_number (c
);
2711 invalid_syntax ("?", 1);
2716 char *p
= read_buffer
;
2717 char *end
= read_buffer
+ read_buffer_size
;
2719 /* Nonzero if we saw an escape sequence specifying
2720 a multibyte character. */
2721 int force_multibyte
= 0;
2722 /* Nonzero if we saw an escape sequence specifying
2723 a single-byte character. */
2724 int force_singlebyte
= 0;
2728 while ((c
= READCHAR
) >= 0
2731 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2733 int offset
= p
- read_buffer
;
2734 read_buffer
= (char *) xrealloc (read_buffer
,
2735 read_buffer_size
*= 2);
2736 p
= read_buffer
+ offset
;
2737 end
= read_buffer
+ read_buffer_size
;
2744 c
= read_escape (readcharfun
, 1);
2746 /* C is -1 if \ newline has just been seen */
2749 if (p
== read_buffer
)
2754 modifiers
= c
& CHAR_MODIFIER_MASK
;
2755 c
= c
& ~CHAR_MODIFIER_MASK
;
2757 if (CHAR_BYTE8_P (c
))
2758 force_singlebyte
= 1;
2759 else if (! ASCII_CHAR_P (c
))
2760 force_multibyte
= 1;
2761 else /* i.e. ASCII_CHAR_P (c) */
2763 /* Allow `\C- ' and `\C-?'. */
2764 if (modifiers
== CHAR_CTL
)
2767 c
= 0, modifiers
= 0;
2769 c
= 127, modifiers
= 0;
2771 if (modifiers
& CHAR_SHIFT
)
2773 /* Shift modifier is valid only with [A-Za-z]. */
2774 if (c
>= 'A' && c
<= 'Z')
2775 modifiers
&= ~CHAR_SHIFT
;
2776 else if (c
>= 'a' && c
<= 'z')
2777 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2780 if (modifiers
& CHAR_META
)
2782 /* Move the meta bit to the right place for a
2784 modifiers
&= ~CHAR_META
;
2785 c
= BYTE8_TO_CHAR (c
| 0x80);
2786 force_singlebyte
= 1;
2790 /* Any modifiers remaining are invalid. */
2792 error ("Invalid modifier in string");
2793 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2797 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2798 if (CHAR_BYTE8_P (c
))
2799 force_singlebyte
= 1;
2800 else if (! ASCII_CHAR_P (c
))
2801 force_multibyte
= 1;
2807 end_of_file_error ();
2809 /* If purifying, and string starts with \ newline,
2810 return zero instead. This is for doc strings
2811 that we are really going to find in etc/DOC.nn.nn */
2812 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2813 return make_number (0);
2815 if (force_multibyte
)
2816 /* READ_BUFFER already contains valid multibyte forms. */
2818 else if (force_singlebyte
)
2820 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2821 p
= read_buffer
+ nchars
;
2824 /* Otherwise, READ_BUFFER contains only ASCII. */
2827 /* We want readchar_count to be the number of characters, not
2828 bytes. Hence we adjust for multibyte characters in the
2829 string. ... But it doesn't seem to be necessary, because
2830 READCHAR *does* read multibyte characters from buffers. */
2831 /* readchar_count -= (p - read_buffer) - nchars; */
2833 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2835 || (p
- read_buffer
!= nchars
)));
2836 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2838 || (p
- read_buffer
!= nchars
)));
2843 int next_char
= READCHAR
;
2846 if (next_char
<= 040
2847 || (next_char
< 0200
2848 && (index ("\"';([#?", next_char
)
2849 || (!first_in_list
&& next_char
== '`')
2850 || (new_backquote_flag
&& next_char
== ','))))
2856 /* Otherwise, we fall through! Note that the atom-reading loop
2857 below will now loop at least once, assuring that we will not
2858 try to UNREAD two characters in a row. */
2862 if (c
<= 040) goto retry
;
2863 if (c
== 0x8a0) /* NBSP */
2866 char *p
= read_buffer
;
2870 char *end
= read_buffer
+ read_buffer_size
;
2873 && c
!= 0x8a0 /* NBSP */
2875 || (!index ("\"';()[]#", c
)
2876 && !(!first_in_list
&& c
== '`')
2877 && !(new_backquote_flag
&& c
== ','))))
2879 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2881 int offset
= p
- read_buffer
;
2882 read_buffer
= (char *) xrealloc (read_buffer
,
2883 read_buffer_size
*= 2);
2884 p
= read_buffer
+ offset
;
2885 end
= read_buffer
+ read_buffer_size
;
2892 end_of_file_error ();
2897 p
+= CHAR_STRING (c
, p
);
2905 int offset
= p
- read_buffer
;
2906 read_buffer
= (char *) xrealloc (read_buffer
,
2907 read_buffer_size
*= 2);
2908 p
= read_buffer
+ offset
;
2909 end
= read_buffer
+ read_buffer_size
;
2916 if (!quoted
&& !uninterned_symbol
)
2919 register Lisp_Object val
;
2921 if (*p1
== '+' || *p1
== '-') p1
++;
2922 /* Is it an integer? */
2925 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2926 /* Integers can have trailing decimal points. */
2927 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2929 /* It is an integer. */
2933 /* Fixme: if we have strtol, use that, and check
2935 if (sizeof (int) == sizeof (EMACS_INT
))
2936 XSETINT (val
, atoi (read_buffer
));
2937 else if (sizeof (long) == sizeof (EMACS_INT
))
2938 XSETINT (val
, atol (read_buffer
));
2944 if (isfloat_string (read_buffer
))
2946 /* Compute NaN and infinities using 0.0 in a variable,
2947 to cope with compilers that think they are smarter
2953 /* Negate the value ourselves. This treats 0, NaNs,
2954 and infinity properly on IEEE floating point hosts,
2955 and works around a common bug where atof ("-0.0")
2957 int negative
= read_buffer
[0] == '-';
2959 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2960 returns 1, is if the input ends in e+INF or e+NaN. */
2967 value
= zero
/ zero
;
2969 /* If that made a "negative" NaN, negate it. */
2973 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2976 u_minus_zero
.d
= - 0.0;
2977 for (i
= 0; i
< sizeof (double); i
++)
2978 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2984 /* Now VALUE is a positive NaN. */
2987 value
= atof (read_buffer
+ negative
);
2991 return make_float (negative
? - value
: value
);
2995 Lisp_Object name
, result
;
2996 EMACS_INT nbytes
= p
- read_buffer
;
2998 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3001 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3002 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3004 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3005 result
= (uninterned_symbol
? Fmake_symbol (name
)
3006 : Fintern (name
, Qnil
));
3008 if (EQ (Vread_with_symbol_positions
, Qt
)
3009 || EQ (Vread_with_symbol_positions
, readcharfun
))
3010 Vread_symbol_positions_list
=
3011 /* Kind of a hack; this will probably fail if characters
3012 in the symbol name were escaped. Not really a big
3014 Fcons (Fcons (result
,
3015 make_number (readchar_count
3016 - XFASTINT (Flength (Fsymbol_name (result
))))),
3017 Vread_symbol_positions_list
);
3025 /* List of nodes we've seen during substitute_object_in_subtree. */
3026 static Lisp_Object seen_list
;
3029 substitute_object_in_subtree (object
, placeholder
)
3031 Lisp_Object placeholder
;
3033 Lisp_Object check_object
;
3035 /* We haven't seen any objects when we start. */
3038 /* Make all the substitutions. */
3040 = substitute_object_recurse (object
, placeholder
, object
);
3042 /* Clear seen_list because we're done with it. */
3045 /* The returned object here is expected to always eq the
3047 if (!EQ (check_object
, object
))
3048 error ("Unexpected mutation error in reader");
3051 /* Feval doesn't get called from here, so no gc protection is needed. */
3052 #define SUBSTITUTE(get_val, set_val) \
3054 Lisp_Object old_value = get_val; \
3055 Lisp_Object true_value \
3056 = substitute_object_recurse (object, placeholder,\
3059 if (!EQ (old_value, true_value)) \
3066 substitute_object_recurse (object
, placeholder
, subtree
)
3068 Lisp_Object placeholder
;
3069 Lisp_Object subtree
;
3071 /* If we find the placeholder, return the target object. */
3072 if (EQ (placeholder
, subtree
))
3075 /* If we've been to this node before, don't explore it again. */
3076 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3079 /* If this node can be the entry point to a cycle, remember that
3080 we've seen it. It can only be such an entry point if it was made
3081 by #n=, which means that we can find it as a value in
3083 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3084 seen_list
= Fcons (subtree
, seen_list
);
3086 /* Recurse according to subtree's type.
3087 Every branch must return a Lisp_Object. */
3088 switch (XTYPE (subtree
))
3090 case Lisp_Vectorlike
:
3093 int length
= XINT (Flength(subtree
));
3094 for (i
= 0; i
< length
; i
++)
3096 Lisp_Object idx
= make_number (i
);
3097 SUBSTITUTE (Faref (subtree
, idx
),
3098 Faset (subtree
, idx
, true_value
));
3105 SUBSTITUTE (Fcar_safe (subtree
),
3106 Fsetcar (subtree
, true_value
));
3107 SUBSTITUTE (Fcdr_safe (subtree
),
3108 Fsetcdr (subtree
, true_value
));
3114 /* Check for text properties in each interval.
3115 substitute_in_interval contains part of the logic. */
3117 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3118 Lisp_Object arg
= Fcons (object
, placeholder
);
3120 traverse_intervals_noorder (root_interval
,
3121 &substitute_in_interval
, arg
);
3126 /* Other types don't recurse any further. */
3132 /* Helper function for substitute_object_recurse. */
3134 substitute_in_interval (interval
, arg
)
3138 Lisp_Object object
= Fcar (arg
);
3139 Lisp_Object placeholder
= Fcdr (arg
);
3141 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3160 if (*cp
== '+' || *cp
== '-')
3163 if (*cp
>= '0' && *cp
<= '9')
3166 while (*cp
>= '0' && *cp
<= '9')
3174 if (*cp
>= '0' && *cp
<= '9')
3177 while (*cp
>= '0' && *cp
<= '9')
3180 if (*cp
== 'e' || *cp
== 'E')
3184 if (*cp
== '+' || *cp
== '-')
3188 if (*cp
>= '0' && *cp
<= '9')
3191 while (*cp
>= '0' && *cp
<= '9')
3194 else if (cp
== start
)
3196 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3201 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3207 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3208 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3209 || state
== (DOT_CHAR
|TRAIL_INT
)
3210 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3211 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3212 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3217 read_vector (readcharfun
, bytecodeflag
)
3218 Lisp_Object readcharfun
;
3223 register Lisp_Object
*ptr
;
3224 register Lisp_Object tem
, item
, vector
;
3225 register struct Lisp_Cons
*otem
;
3228 tem
= read_list (1, readcharfun
);
3229 len
= Flength (tem
);
3230 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3232 size
= XVECTOR (vector
)->size
;
3233 ptr
= XVECTOR (vector
)->contents
;
3234 for (i
= 0; i
< size
; i
++)
3237 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3238 bytecode object, the docstring containing the bytecode and
3239 constants values must be treated as unibyte and passed to
3240 Fread, to get the actual bytecode string and constants vector. */
3241 if (bytecodeflag
&& load_force_doc_strings
)
3243 if (i
== COMPILED_BYTECODE
)
3245 if (!STRINGP (item
))
3246 error ("Invalid byte code");
3248 /* Delay handling the bytecode slot until we know whether
3249 it is lazily-loaded (we can tell by whether the
3250 constants slot is nil). */
3251 ptr
[COMPILED_CONSTANTS
] = item
;
3254 else if (i
== COMPILED_CONSTANTS
)
3256 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3260 /* Coerce string to unibyte (like string-as-unibyte,
3261 but without generating extra garbage and
3262 guaranteeing no change in the contents). */
3263 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3264 STRING_SET_UNIBYTE (bytestr
);
3266 item
= Fread (Fcons (bytestr
, readcharfun
));
3268 error ("Invalid byte code");
3270 otem
= XCONS (item
);
3271 bytestr
= XCAR (item
);
3276 /* Now handle the bytecode slot. */
3277 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3279 else if (i
== COMPILED_DOC_STRING
3281 && ! STRING_MULTIBYTE (item
))
3283 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3284 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3286 item
= Fstring_as_multibyte (item
);
3289 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3297 /* FLAG = 1 means check for ] to terminate rather than ) and .
3298 FLAG = -1 means check for starting with defun
3299 and make structure pure. */
3302 read_list (flag
, readcharfun
)
3304 register Lisp_Object readcharfun
;
3306 /* -1 means check next element for defun,
3307 0 means don't check,
3308 1 means already checked and found defun. */
3309 int defunflag
= flag
< 0 ? -1 : 0;
3310 Lisp_Object val
, tail
;
3311 register Lisp_Object elt
, tem
;
3312 struct gcpro gcpro1
, gcpro2
;
3313 /* 0 is the normal case.
3314 1 means this list is a doc reference; replace it with the number 0.
3315 2 means this list is a doc reference; replace it with the doc string. */
3316 int doc_reference
= 0;
3318 /* Initialize this to 1 if we are reading a list. */
3319 int first_in_list
= flag
<= 0;
3328 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3333 /* While building, if the list starts with #$, treat it specially. */
3334 if (EQ (elt
, Vload_file_name
)
3336 && !NILP (Vpurify_flag
))
3338 if (NILP (Vdoc_file_name
))
3339 /* We have not yet called Snarf-documentation, so assume
3340 this file is described in the DOC-MM.NN file
3341 and Snarf-documentation will fill in the right value later.
3342 For now, replace the whole list with 0. */
3345 /* We have already called Snarf-documentation, so make a relative
3346 file name for this file, so it can be found properly
3347 in the installed Lisp directory.
3348 We don't use Fexpand_file_name because that would make
3349 the directory absolute now. */
3350 elt
= concat2 (build_string ("../lisp/"),
3351 Ffile_name_nondirectory (elt
));
3353 else if (EQ (elt
, Vload_file_name
)
3355 && load_force_doc_strings
)
3364 invalid_syntax (") or . in a vector", 18);
3372 XSETCDR (tail
, read0 (readcharfun
));
3374 val
= read0 (readcharfun
);
3375 read1 (readcharfun
, &ch
, 0);
3379 if (doc_reference
== 1)
3380 return make_number (0);
3381 if (doc_reference
== 2)
3383 /* Get a doc string from the file we are loading.
3384 If it's in saved_doc_string, get it from there.
3386 Here, we don't know if the string is a
3387 bytecode string or a doc string. As a
3388 bytecode string must be unibyte, we always
3389 return a unibyte string. If it is actually a
3390 doc string, caller must make it
3393 int pos
= XINT (XCDR (val
));
3394 /* Position is negative for user variables. */
3395 if (pos
< 0) pos
= -pos
;
3396 if (pos
>= saved_doc_string_position
3397 && pos
< (saved_doc_string_position
3398 + saved_doc_string_length
))
3400 int start
= pos
- saved_doc_string_position
;
3403 /* Process quoting with ^A,
3404 and find the end of the string,
3405 which is marked with ^_ (037). */
3406 for (from
= start
, to
= start
;
3407 saved_doc_string
[from
] != 037;)
3409 int c
= saved_doc_string
[from
++];
3412 c
= saved_doc_string
[from
++];
3414 saved_doc_string
[to
++] = c
;
3416 saved_doc_string
[to
++] = 0;
3418 saved_doc_string
[to
++] = 037;
3421 saved_doc_string
[to
++] = c
;
3424 return make_unibyte_string (saved_doc_string
+ start
,
3427 /* Look in prev_saved_doc_string the same way. */
3428 else if (pos
>= prev_saved_doc_string_position
3429 && pos
< (prev_saved_doc_string_position
3430 + prev_saved_doc_string_length
))
3432 int start
= pos
- prev_saved_doc_string_position
;
3435 /* Process quoting with ^A,
3436 and find the end of the string,
3437 which is marked with ^_ (037). */
3438 for (from
= start
, to
= start
;
3439 prev_saved_doc_string
[from
] != 037;)
3441 int c
= prev_saved_doc_string
[from
++];
3444 c
= prev_saved_doc_string
[from
++];
3446 prev_saved_doc_string
[to
++] = c
;
3448 prev_saved_doc_string
[to
++] = 0;
3450 prev_saved_doc_string
[to
++] = 037;
3453 prev_saved_doc_string
[to
++] = c
;
3456 return make_unibyte_string (prev_saved_doc_string
3461 return get_doc_string (val
, 1, 0);
3466 invalid_syntax (". in wrong context", 18);
3468 invalid_syntax ("] in a list", 11);
3470 tem
= (read_pure
&& flag
<= 0
3471 ? pure_cons (elt
, Qnil
)
3472 : Fcons (elt
, Qnil
));
3474 XSETCDR (tail
, tem
);
3479 defunflag
= EQ (elt
, Qdefun
);
3480 else if (defunflag
> 0)
3485 Lisp_Object Vobarray
;
3486 Lisp_Object initial_obarray
;
3488 /* oblookup stores the bucket number here, for the sake of Funintern. */
3490 int oblookup_last_bucket_number
;
3492 static int hash_string ();
3494 /* Get an error if OBARRAY is not an obarray.
3495 If it is one, return it. */
3498 check_obarray (obarray
)
3499 Lisp_Object obarray
;
3501 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3503 /* If Vobarray is now invalid, force it to be valid. */
3504 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3505 wrong_type_argument (Qvectorp
, obarray
);
3510 /* Intern the C string STR: return a symbol with that name,
3511 interned in the current obarray. */
3518 int len
= strlen (str
);
3519 Lisp_Object obarray
;
3522 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3523 obarray
= check_obarray (obarray
);
3524 tem
= oblookup (obarray
, str
, len
, len
);
3527 return Fintern (make_string (str
, len
), obarray
);
3530 /* Create an uninterned symbol with name STR. */
3536 int len
= strlen (str
);
3538 return Fmake_symbol ((!NILP (Vpurify_flag
)
3539 ? make_pure_string (str
, len
, len
, 0)
3540 : make_string (str
, len
)));
3543 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3544 doc
: /* Return the canonical symbol whose name is STRING.
3545 If there is none, one is created by this function and returned.
3546 A second optional argument specifies the obarray to use;
3547 it defaults to the value of `obarray'. */)
3549 Lisp_Object string
, obarray
;
3551 register Lisp_Object tem
, sym
, *ptr
;
3553 if (NILP (obarray
)) obarray
= Vobarray
;
3554 obarray
= check_obarray (obarray
);
3556 CHECK_STRING (string
);
3558 tem
= oblookup (obarray
, SDATA (string
),
3561 if (!INTEGERP (tem
))
3564 if (!NILP (Vpurify_flag
))
3565 string
= Fpurecopy (string
);
3566 sym
= Fmake_symbol (string
);
3568 if (EQ (obarray
, initial_obarray
))
3569 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3571 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3573 if ((SREF (string
, 0) == ':')
3574 && EQ (obarray
, initial_obarray
))
3576 XSYMBOL (sym
)->constant
= 1;
3577 XSYMBOL (sym
)->value
= sym
;
3580 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3582 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3584 XSYMBOL (sym
)->next
= 0;
3589 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3590 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3591 NAME may be a string or a symbol. If it is a symbol, that exact
3592 symbol is searched for.
3593 A second optional argument specifies the obarray to use;
3594 it defaults to the value of `obarray'. */)
3596 Lisp_Object name
, obarray
;
3598 register Lisp_Object tem
, string
;
3600 if (NILP (obarray
)) obarray
= Vobarray
;
3601 obarray
= check_obarray (obarray
);
3603 if (!SYMBOLP (name
))
3605 CHECK_STRING (name
);
3609 string
= SYMBOL_NAME (name
);
3611 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3612 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3618 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3619 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3620 The value is t if a symbol was found and deleted, nil otherwise.
3621 NAME may be a string or a symbol. If it is a symbol, that symbol
3622 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3623 OBARRAY defaults to the value of the variable `obarray'. */)
3625 Lisp_Object name
, obarray
;
3627 register Lisp_Object string
, tem
;
3630 if (NILP (obarray
)) obarray
= Vobarray
;
3631 obarray
= check_obarray (obarray
);
3634 string
= SYMBOL_NAME (name
);
3637 CHECK_STRING (name
);
3641 tem
= oblookup (obarray
, SDATA (string
),
3646 /* If arg was a symbol, don't delete anything but that symbol itself. */
3647 if (SYMBOLP (name
) && !EQ (name
, tem
))
3650 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3651 XSYMBOL (tem
)->constant
= 0;
3652 XSYMBOL (tem
)->indirect_variable
= 0;
3654 hash
= oblookup_last_bucket_number
;
3656 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3658 if (XSYMBOL (tem
)->next
)
3659 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3661 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3665 Lisp_Object tail
, following
;
3667 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3668 XSYMBOL (tail
)->next
;
3671 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3672 if (EQ (following
, tem
))
3674 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3683 /* Return the symbol in OBARRAY whose names matches the string
3684 of SIZE characters (SIZE_BYTE bytes) at PTR.
3685 If there is no such symbol in OBARRAY, return nil.
3687 Also store the bucket number in oblookup_last_bucket_number. */
3690 oblookup (obarray
, ptr
, size
, size_byte
)
3691 Lisp_Object obarray
;
3692 register const char *ptr
;
3693 int size
, size_byte
;
3697 register Lisp_Object tail
;
3698 Lisp_Object bucket
, tem
;
3700 if (!VECTORP (obarray
)
3701 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3703 obarray
= check_obarray (obarray
);
3704 obsize
= XVECTOR (obarray
)->size
;
3706 /* This is sometimes needed in the middle of GC. */
3707 obsize
&= ~ARRAY_MARK_FLAG
;
3708 /* Combining next two lines breaks VMS C 2.3. */
3709 hash
= hash_string (ptr
, size_byte
);
3711 bucket
= XVECTOR (obarray
)->contents
[hash
];
3712 oblookup_last_bucket_number
= hash
;
3713 if (EQ (bucket
, make_number (0)))
3715 else if (!SYMBOLP (bucket
))
3716 error ("Bad data in guts of obarray"); /* Like CADR error message */
3718 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3720 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3721 && SCHARS (SYMBOL_NAME (tail
)) == size
3722 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3724 else if (XSYMBOL (tail
)->next
== 0)
3727 XSETINT (tem
, hash
);
3732 hash_string (ptr
, len
)
3733 const unsigned char *ptr
;
3736 register const unsigned char *p
= ptr
;
3737 register const unsigned char *end
= p
+ len
;
3738 register unsigned char c
;
3739 register int hash
= 0;
3744 if (c
>= 0140) c
-= 40;
3745 hash
= ((hash
<<3) + (hash
>>28) + c
);
3747 return hash
& 07777777777;
3751 map_obarray (obarray
, fn
, arg
)
3752 Lisp_Object obarray
;
3753 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3757 register Lisp_Object tail
;
3758 CHECK_VECTOR (obarray
);
3759 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3761 tail
= XVECTOR (obarray
)->contents
[i
];
3766 if (XSYMBOL (tail
)->next
== 0)
3768 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3774 mapatoms_1 (sym
, function
)
3775 Lisp_Object sym
, function
;
3777 call1 (function
, sym
);
3780 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3781 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3782 OBARRAY defaults to the value of `obarray'. */)
3784 Lisp_Object function
, obarray
;
3786 if (NILP (obarray
)) obarray
= Vobarray
;
3787 obarray
= check_obarray (obarray
);
3789 map_obarray (obarray
, mapatoms_1
, function
);
3793 #define OBARRAY_SIZE 1511
3798 Lisp_Object oblength
;
3802 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3804 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3805 Vobarray
= Fmake_vector (oblength
, make_number (0));
3806 initial_obarray
= Vobarray
;
3807 staticpro (&initial_obarray
);
3808 /* Intern nil in the obarray */
3809 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3810 XSYMBOL (Qnil
)->constant
= 1;
3812 /* These locals are to kludge around a pyramid compiler bug. */
3813 hash
= hash_string ("nil", 3);
3814 /* Separate statement here to avoid VAXC bug. */
3815 hash
%= OBARRAY_SIZE
;
3816 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3819 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3820 XSYMBOL (Qnil
)->function
= Qunbound
;
3821 XSYMBOL (Qunbound
)->value
= Qunbound
;
3822 XSYMBOL (Qunbound
)->function
= Qunbound
;
3825 XSYMBOL (Qnil
)->value
= Qnil
;
3826 XSYMBOL (Qnil
)->plist
= Qnil
;
3827 XSYMBOL (Qt
)->value
= Qt
;
3828 XSYMBOL (Qt
)->constant
= 1;
3830 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3833 Qvariable_documentation
= intern ("variable-documentation");
3834 staticpro (&Qvariable_documentation
);
3836 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3837 read_buffer
= (char *) xmalloc (read_buffer_size
);
3842 struct Lisp_Subr
*sname
;
3845 sym
= intern (sname
->symbol_name
);
3846 XSETPVECTYPE (sname
, PVEC_SUBR
);
3847 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3850 #ifdef NOTDEF /* use fset in subr.el now */
3852 defalias (sname
, string
)
3853 struct Lisp_Subr
*sname
;
3857 sym
= intern (string
);
3858 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3862 /* Define an "integer variable"; a symbol whose value is forwarded
3863 to a C variable of type int. Sample call:
3864 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3866 defvar_int (namestring
, address
)
3870 Lisp_Object sym
, val
;
3871 sym
= intern (namestring
);
3872 val
= allocate_misc ();
3873 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3874 XINTFWD (val
)->intvar
= address
;
3875 SET_SYMBOL_VALUE (sym
, val
);
3878 /* Similar but define a variable whose value is t if address contains 1,
3879 nil if address contains 0. */
3881 defvar_bool (namestring
, address
)
3885 Lisp_Object sym
, val
;
3886 sym
= intern (namestring
);
3887 val
= allocate_misc ();
3888 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3889 XBOOLFWD (val
)->boolvar
= address
;
3890 SET_SYMBOL_VALUE (sym
, val
);
3891 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3894 /* Similar but define a variable whose value is the Lisp Object stored
3895 at address. Two versions: with and without gc-marking of the C
3896 variable. The nopro version is used when that variable will be
3897 gc-marked for some other reason, since marking the same slot twice
3898 can cause trouble with strings. */
3900 defvar_lisp_nopro (namestring
, address
)
3902 Lisp_Object
*address
;
3904 Lisp_Object sym
, val
;
3905 sym
= intern (namestring
);
3906 val
= allocate_misc ();
3907 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3908 XOBJFWD (val
)->objvar
= address
;
3909 SET_SYMBOL_VALUE (sym
, val
);
3913 defvar_lisp (namestring
, address
)
3915 Lisp_Object
*address
;
3917 defvar_lisp_nopro (namestring
, address
);
3918 staticpro (address
);
3921 /* Similar but define a variable whose value is the Lisp Object stored
3922 at a particular offset in the current kboard object. */
3925 defvar_kboard (namestring
, offset
)
3929 Lisp_Object sym
, val
;
3930 sym
= intern (namestring
);
3931 val
= allocate_misc ();
3932 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3933 XKBOARD_OBJFWD (val
)->offset
= offset
;
3934 SET_SYMBOL_VALUE (sym
, val
);
3937 /* Record the value of load-path used at the start of dumping
3938 so we can see if the site changed it later during dumping. */
3939 static Lisp_Object dump_path
;
3945 int turn_off_warning
= 0;
3947 /* Compute the default load-path. */
3949 normal
= PATH_LOADSEARCH
;
3950 Vload_path
= decode_env_path (0, normal
);
3952 if (NILP (Vpurify_flag
))
3953 normal
= PATH_LOADSEARCH
;
3955 normal
= PATH_DUMPLOADSEARCH
;
3957 /* In a dumped Emacs, we normally have to reset the value of
3958 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3959 uses ../lisp, instead of the path of the installed elisp
3960 libraries. However, if it appears that Vload_path was changed
3961 from the default before dumping, don't override that value. */
3964 if (! NILP (Fequal (dump_path
, Vload_path
)))
3966 Vload_path
= decode_env_path (0, normal
);
3967 if (!NILP (Vinstallation_directory
))
3969 Lisp_Object tem
, tem1
, sitelisp
;
3971 /* Remove site-lisp dirs from path temporarily and store
3972 them in sitelisp, then conc them on at the end so
3973 they're always first in path. */
3977 tem
= Fcar (Vload_path
);
3978 tem1
= Fstring_match (build_string ("site-lisp"),
3982 Vload_path
= Fcdr (Vload_path
);
3983 sitelisp
= Fcons (tem
, sitelisp
);
3989 /* Add to the path the lisp subdir of the
3990 installation dir, if it exists. */
3991 tem
= Fexpand_file_name (build_string ("lisp"),
3992 Vinstallation_directory
);
3993 tem1
= Ffile_exists_p (tem
);
3996 if (NILP (Fmember (tem
, Vload_path
)))
3998 turn_off_warning
= 1;
3999 Vload_path
= Fcons (tem
, Vload_path
);
4003 /* That dir doesn't exist, so add the build-time
4004 Lisp dirs instead. */
4005 Vload_path
= nconc2 (Vload_path
, dump_path
);
4007 /* Add leim under the installation dir, if it exists. */
4008 tem
= Fexpand_file_name (build_string ("leim"),
4009 Vinstallation_directory
);
4010 tem1
= Ffile_exists_p (tem
);
4013 if (NILP (Fmember (tem
, Vload_path
)))
4014 Vload_path
= Fcons (tem
, Vload_path
);
4017 /* Add site-lisp under the installation dir, if it exists. */
4018 tem
= Fexpand_file_name (build_string ("site-lisp"),
4019 Vinstallation_directory
);
4020 tem1
= Ffile_exists_p (tem
);
4023 if (NILP (Fmember (tem
, Vload_path
)))
4024 Vload_path
= Fcons (tem
, Vload_path
);
4027 /* If Emacs was not built in the source directory,
4028 and it is run from where it was built, add to load-path
4029 the lisp, leim and site-lisp dirs under that directory. */
4031 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4035 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4036 Vinstallation_directory
);
4037 tem1
= Ffile_exists_p (tem
);
4039 /* Don't be fooled if they moved the entire source tree
4040 AFTER dumping Emacs. If the build directory is indeed
4041 different from the source dir, src/Makefile.in and
4042 src/Makefile will not be found together. */
4043 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4044 Vinstallation_directory
);
4045 tem2
= Ffile_exists_p (tem
);
4046 if (!NILP (tem1
) && NILP (tem2
))
4048 tem
= Fexpand_file_name (build_string ("lisp"),
4051 if (NILP (Fmember (tem
, Vload_path
)))
4052 Vload_path
= Fcons (tem
, Vload_path
);
4054 tem
= Fexpand_file_name (build_string ("leim"),
4057 if (NILP (Fmember (tem
, Vload_path
)))
4058 Vload_path
= Fcons (tem
, Vload_path
);
4060 tem
= Fexpand_file_name (build_string ("site-lisp"),
4063 if (NILP (Fmember (tem
, Vload_path
)))
4064 Vload_path
= Fcons (tem
, Vload_path
);
4067 if (!NILP (sitelisp
))
4068 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4074 /* NORMAL refers to the lisp dir in the source directory. */
4075 /* We used to add ../lisp at the front here, but
4076 that caused trouble because it was copied from dump_path
4077 into Vload_path, above, when Vinstallation_directory was non-nil.
4078 It should be unnecessary. */
4079 Vload_path
= decode_env_path (0, normal
);
4080 dump_path
= Vload_path
;
4084 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
4085 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4086 almost never correct, thereby causing a warning to be printed out that
4087 confuses users. Since PATH_LOADSEARCH is always overridden by the
4088 EMACSLOADPATH environment variable below, disable the warning on NT.
4089 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
4090 the "standard" paths may not exist and would be overridden by
4091 EMACSLOADPATH as on NT. Since this depends on how the executable
4092 was build and packaged, turn off the warnings in general */
4094 /* Warn if dirs in the *standard* path don't exist. */
4095 if (!turn_off_warning
)
4097 Lisp_Object path_tail
;
4099 for (path_tail
= Vload_path
;
4101 path_tail
= XCDR (path_tail
))
4103 Lisp_Object dirfile
;
4104 dirfile
= Fcar (path_tail
);
4105 if (STRINGP (dirfile
))
4107 dirfile
= Fdirectory_file_name (dirfile
);
4108 if (access (SDATA (dirfile
), 0) < 0)
4109 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4114 #endif /* !(WINDOWSNT || HAVE_CARBON) */
4116 /* If the EMACSLOADPATH environment variable is set, use its value.
4117 This doesn't apply if we're dumping. */
4119 if (NILP (Vpurify_flag
)
4120 && egetenv ("EMACSLOADPATH"))
4122 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4126 load_in_progress
= 0;
4127 Vload_file_name
= Qnil
;
4129 load_descriptor_list
= Qnil
;
4131 Vstandard_input
= Qt
;
4132 Vloads_in_progress
= Qnil
;
4135 /* Print a warning, using format string FORMAT, that directory DIRNAME
4136 does not exist. Print it on stderr and put it in *Messages*. */
4139 dir_warning (format
, dirname
)
4141 Lisp_Object dirname
;
4144 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4146 fprintf (stderr
, format
, SDATA (dirname
));
4147 sprintf (buffer
, format
, SDATA (dirname
));
4148 /* Don't log the warning before we've initialized!! */
4150 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4157 defsubr (&Sread_from_string
);
4159 defsubr (&Sintern_soft
);
4160 defsubr (&Sunintern
);
4161 defsubr (&Sget_load_suffixes
);
4163 defsubr (&Seval_buffer
);
4164 defsubr (&Seval_region
);
4165 defsubr (&Sread_char
);
4166 defsubr (&Sread_char_exclusive
);
4167 defsubr (&Sread_event
);
4168 defsubr (&Sget_file_char
);
4169 defsubr (&Smapatoms
);
4170 defsubr (&Slocate_file_internal
);
4172 DEFVAR_LISP ("obarray", &Vobarray
,
4173 doc
: /* Symbol table for use by `intern' and `read'.
4174 It is a vector whose length ought to be prime for best results.
4175 The vector's contents don't make sense if examined from Lisp programs;
4176 to find all the symbols in an obarray, use `mapatoms'. */);
4178 DEFVAR_LISP ("values", &Vvalues
,
4179 doc
: /* List of values of all expressions which were read, evaluated and printed.
4180 Order is reverse chronological. */);
4182 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4183 doc
: /* Stream for read to get input from.
4184 See documentation of `read' for possible values. */);
4185 Vstandard_input
= Qt
;
4187 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4188 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4190 If this variable is a buffer, then only forms read from that buffer
4191 will be added to `read-symbol-positions-list'.
4192 If this variable is t, then all read forms will be added.
4193 The effect of all other values other than nil are not currently
4194 defined, although they may be in the future.
4196 The positions are relative to the last call to `read' or
4197 `read-from-string'. It is probably a bad idea to set this variable at
4198 the toplevel; bind it instead. */);
4199 Vread_with_symbol_positions
= Qnil
;
4201 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4202 doc
: /* A list mapping read symbols to their positions.
4203 This variable is modified during calls to `read' or
4204 `read-from-string', but only when `read-with-symbol-positions' is
4207 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4208 CHAR-POSITION is an integer giving the offset of that occurrence of the
4209 symbol from the position where `read' or `read-from-string' started.
4211 Note that a symbol will appear multiple times in this list, if it was
4212 read multiple times. The list is in the same order as the symbols
4214 Vread_symbol_positions_list
= Qnil
;
4216 DEFVAR_LISP ("load-path", &Vload_path
,
4217 doc
: /* *List of directories to search for files to load.
4218 Each element is a string (directory name) or nil (try default directory).
4219 Initialized based on EMACSLOADPATH environment variable, if any,
4220 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4222 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4223 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4224 This list should not include the empty string.
4225 `load' and related functions try to append these suffixes, in order,
4226 to the specified file name if a Lisp suffix is allowed or required. */);
4227 Vload_suffixes
= Fcons (build_string (".elc"),
4228 Fcons (build_string (".el"), Qnil
));
4229 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4230 doc
: /* List of suffixes that indicate representations of \
4232 This list should normally start with the empty string.
4234 Enabling Auto Compression mode appends the suffixes in
4235 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4236 mode removes them again. `load' and related functions use this list to
4237 determine whether they should look for compressed versions of a file
4238 and, if so, which suffixes they should try to append to the file name
4239 in order to do so. However, if you want to customize which suffixes
4240 the loading functions recognize as compression suffixes, you should
4241 customize `jka-compr-load-suffixes' rather than the present variable. */);
4242 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4244 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4245 doc
: /* Non-nil if inside of `load'. */);
4247 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4248 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4249 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4251 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4252 a symbol \(a feature name).
4254 When `load' is run and the file-name argument matches an element's
4255 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4256 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4258 An error in FORMS does not undo the load, but does prevent execution of
4259 the rest of the FORMS. */);
4260 Vafter_load_alist
= Qnil
;
4262 DEFVAR_LISP ("load-history", &Vload_history
,
4263 doc
: /* Alist mapping file names to symbols and features.
4264 Each alist element is a list that starts with a file name,
4265 except for one element (optional) that starts with nil and describes
4266 definitions evaluated from buffers not visiting files.
4268 The file name is absolute and is the true file name (i.e. it doesn't
4269 contain symbolic links) of the loaded file.
4271 The remaining elements of each list are symbols defined as variables
4272 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4273 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4274 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4275 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
4276 this file redefined it as a function.
4278 During preloading, the file name recorded is relative to the main Lisp
4279 directory. These file names are converted to absolute at startup. */);
4280 Vload_history
= Qnil
;
4282 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4283 doc
: /* Full name of file being loaded by `load'. */);
4284 Vload_file_name
= Qnil
;
4286 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4287 doc
: /* File name, including directory, of user's initialization file.
4288 If the file loaded had extension `.elc', and the corresponding source file
4289 exists, this variable contains the name of source file, suitable for use
4290 by functions like `custom-save-all' which edit the init file.
4291 While Emacs loads and evaluates the init file, value is the real name
4292 of the file, regardless of whether or not it has the `.elc' extension. */);
4293 Vuser_init_file
= Qnil
;
4295 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4296 doc
: /* Used for internal purposes by `load'. */);
4297 Vcurrent_load_list
= Qnil
;
4299 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4300 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4301 The default is nil, which means use the function `read'. */);
4302 Vload_read_function
= Qnil
;
4304 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4305 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4306 This function is for doing code conversion before reading the source file.
4307 If nil, loading is done without any code conversion.
4308 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4309 FULLNAME is the full name of FILE.
4310 See `load' for the meaning of the remaining arguments. */);
4311 Vload_source_file_function
= Qnil
;
4313 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4314 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4315 This is useful when the file being loaded is a temporary copy. */);
4316 load_force_doc_strings
= 0;
4318 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4319 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4320 This is normally bound by `load' and `eval-buffer' to control `read',
4321 and is not meant for users to change. */);
4322 load_convert_to_unibyte
= 0;
4324 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4325 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4326 You cannot count on them to still be there! */);
4328 = Fexpand_file_name (build_string ("../"),
4329 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4331 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4332 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4333 Vpreloaded_file_list
= Qnil
;
4335 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4336 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4337 Vbyte_boolean_vars
= Qnil
;
4339 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4340 doc
: /* Non-nil means load dangerous compiled Lisp files.
4341 Some versions of XEmacs use different byte codes than Emacs. These
4342 incompatible byte codes can make Emacs crash when it tries to execute
4344 load_dangerous_libraries
= 0;
4346 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4347 doc
: /* Regular expression matching safe to load compiled Lisp files.
4348 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4349 from the file, and matches them against this regular expression.
4350 When the regular expression matches, the file is considered to be safe
4351 to load. See also `load-dangerous-libraries'. */);
4352 Vbytecomp_version_regexp
4353 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4355 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4356 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4357 Veval_buffer_list
= Qnil
;
4359 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4360 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4361 Vold_style_backquotes
= Qnil
;
4362 Qold_style_backquotes
= intern ("old-style-backquotes");
4363 staticpro (&Qold_style_backquotes
);
4365 /* Vsource_directory was initialized in init_lread. */
4367 load_descriptor_list
= Qnil
;
4368 staticpro (&load_descriptor_list
);
4370 Qcurrent_load_list
= intern ("current-load-list");
4371 staticpro (&Qcurrent_load_list
);
4373 Qstandard_input
= intern ("standard-input");
4374 staticpro (&Qstandard_input
);
4376 Qread_char
= intern ("read-char");
4377 staticpro (&Qread_char
);
4379 Qget_file_char
= intern ("get-file-char");
4380 staticpro (&Qget_file_char
);
4382 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4383 staticpro (&Qget_emacs_mule_file_char
);
4385 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4386 staticpro (&Qload_force_doc_strings
);
4388 Qbackquote
= intern ("`");
4389 staticpro (&Qbackquote
);
4390 Qcomma
= intern (",");
4391 staticpro (&Qcomma
);
4392 Qcomma_at
= intern (",@");
4393 staticpro (&Qcomma_at
);
4394 Qcomma_dot
= intern (",.");
4395 staticpro (&Qcomma_dot
);
4397 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4398 staticpro (&Qinhibit_file_name_operation
);
4400 Qascii_character
= intern ("ascii-character");
4401 staticpro (&Qascii_character
);
4403 Qfunction
= intern ("function");
4404 staticpro (&Qfunction
);
4406 Qload
= intern ("load");
4409 Qload_file_name
= intern ("load-file-name");
4410 staticpro (&Qload_file_name
);
4412 Qeval_buffer_list
= intern ("eval-buffer-list");
4413 staticpro (&Qeval_buffer_list
);
4415 Qfile_truename
= intern ("file-truename");
4416 staticpro (&Qfile_truename
) ;
4418 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4419 staticpro (&Qdo_after_load_evaluation
) ;
4421 staticpro (&dump_path
);
4423 staticpro (&read_objects
);
4424 read_objects
= Qnil
;
4425 staticpro (&seen_list
);
4428 Vloads_in_progress
= Qnil
;
4429 staticpro (&Vloads_in_progress
);
4432 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4433 (do not change this comment) */