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 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
45 #include <unistd.h> /* to get X_OK */
62 #endif /* HAVE_SETLOCALE */
72 #define file_offset off_t
73 #define file_tell ftello
75 #define file_offset long
76 #define file_tell ftell
83 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
84 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
85 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
86 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
87 Lisp_Object Qinhibit_file_name_operation
;
88 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
89 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
91 /* Used instead of Qget_file_char while loading *.elc files compiled
92 by Emacs 21 or older. */
93 static Lisp_Object Qget_emacs_mule_file_char
;
95 static Lisp_Object Qload_force_doc_strings
;
97 extern Lisp_Object Qevent_symbol_element_mask
;
98 extern Lisp_Object Qfile_exists_p
;
100 /* non-zero if inside `load' */
101 int load_in_progress
;
103 /* Directory in which the sources were found. */
104 Lisp_Object Vsource_directory
;
106 /* Search path and suffixes for files to be loaded. */
107 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
109 /* File name of user's init file. */
110 Lisp_Object Vuser_init_file
;
112 /* This is the user-visible association list that maps features to
113 lists of defs in their load files. */
114 Lisp_Object Vload_history
;
116 /* This is used to build the load history. */
117 Lisp_Object Vcurrent_load_list
;
119 /* List of files that were preloaded. */
120 Lisp_Object Vpreloaded_file_list
;
122 /* Name of file actually being read by `load'. */
123 Lisp_Object Vload_file_name
;
125 /* Function to use for reading, in `load' and friends. */
126 Lisp_Object Vload_read_function
;
128 /* The association list of objects read with the #n=object form.
129 Each member of the list has the form (n . object), and is used to
130 look up the object for the corresponding #n# construct.
131 It must be set to nil before all top-level calls to read0. */
132 Lisp_Object read_objects
;
134 /* Nonzero means load should forcibly load all dynamic doc strings. */
135 static int load_force_doc_strings
;
137 /* Nonzero means read should convert strings to unibyte. */
138 static int load_convert_to_unibyte
;
140 /* Nonzero means READCHAR should read bytes one by one (not character)
141 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
142 This is set to 1 by read1 temporarily while handling #@NUMBER. */
143 static int load_each_byte
;
145 /* Function to use for loading an Emacs Lisp source file (not
146 compiled) instead of readevalloop. */
147 Lisp_Object Vload_source_file_function
;
149 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
150 Lisp_Object Vbyte_boolean_vars
;
152 /* Whether or not to add a `read-positions' property to symbols
154 Lisp_Object Vread_with_symbol_positions
;
156 /* List of (SYMBOL . POSITION) accumulated so far. */
157 Lisp_Object Vread_symbol_positions_list
;
159 /* List of descriptors now open for Fload. */
160 static Lisp_Object load_descriptor_list
;
162 /* File for get_file_char to read from. Use by load. */
163 static FILE *instream
;
165 /* When nonzero, read conses in pure space */
166 static int read_pure
;
168 /* For use within read-from-string (this reader is non-reentrant!!) */
169 static int read_from_string_index
;
170 static int read_from_string_index_byte
;
171 static int read_from_string_limit
;
173 /* Number of characters read in the current call to Fread or
174 Fread_from_string. */
175 static int readchar_count
;
177 /* This contains the last string skipped with #@. */
178 static char *saved_doc_string
;
179 /* Length of buffer allocated in saved_doc_string. */
180 static int saved_doc_string_size
;
181 /* Length of actual data in saved_doc_string. */
182 static int saved_doc_string_length
;
183 /* This is the file position that string came from. */
184 static file_offset saved_doc_string_position
;
186 /* This contains the previous string skipped with #@.
187 We copy it from saved_doc_string when a new string
188 is put in saved_doc_string. */
189 static char *prev_saved_doc_string
;
190 /* Length of buffer allocated in prev_saved_doc_string. */
191 static int prev_saved_doc_string_size
;
192 /* Length of actual data in prev_saved_doc_string. */
193 static int prev_saved_doc_string_length
;
194 /* This is the file position that string came from. */
195 static file_offset prev_saved_doc_string_position
;
197 /* Nonzero means inside a new-style backquote
198 with no surrounding parentheses.
199 Fread initializes this to zero, so we need not specbind it
200 or worry about what happens to it when there is an error. */
201 static int new_backquote_flag
;
202 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
204 /* A list of file names for files being loaded in Fload. Used to
205 check for recursive loads. */
207 static Lisp_Object Vloads_in_progress
;
209 /* Non-zero means load dangerous compiled Lisp files. */
211 int load_dangerous_libraries
;
213 /* A regular expression used to detect files compiled with Emacs. */
215 static Lisp_Object Vbytecomp_version_regexp
;
217 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
220 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
221 Lisp_Object (*) (), int,
222 Lisp_Object
, Lisp_Object
,
223 Lisp_Object
, Lisp_Object
));
224 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
225 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
227 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
228 static void end_of_file_error
P_ (()) NO_RETURN
;
231 /* Functions that read one byte from the current source READCHARFUN
232 or unreads one byte. If the integer argument C is -1, it returns
233 one read byte, or -1 when there's no more byte in the source. If C
234 is 0 or positive, it unreads C, and the return value is not
237 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
238 static int readbyte_from_file
P_ ((int, Lisp_Object
));
239 static int readbyte_from_string
P_ ((int, Lisp_Object
));
241 /* Handle unreading and rereading of characters.
242 Write READCHAR to read a character,
243 UNREAD(c) to unread c to be read again.
245 These macros correctly read/unread multibyte characters. */
247 #define READCHAR readchar (readcharfun, NULL)
248 #define UNREAD(c) unreadchar (readcharfun, c)
250 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
251 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
253 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
254 Qlambda, or a cons, we use this to keep an unread character because
255 a file stream can't handle multibyte-char unreading. The value -1
256 means that there's no unread character. */
257 static int unread_char
;
260 readchar (readcharfun
, multibyte
)
261 Lisp_Object readcharfun
;
266 int (*readbyte
) P_ ((int, Lisp_Object
));
267 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
269 int emacs_mule_encoding
= 0;
276 if (BUFFERP (readcharfun
))
278 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
280 int pt_byte
= BUF_PT_BYTE (inbuffer
);
282 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
285 if (! NILP (inbuffer
->enable_multibyte_characters
))
287 /* Fetch the character code from the buffer. */
288 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
289 BUF_INC_POS (inbuffer
, pt_byte
);
290 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
296 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
297 if (! ASCII_BYTE_P (c
))
298 c
= BYTE8_TO_CHAR (c
);
301 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
305 if (MARKERP (readcharfun
))
307 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
309 int bytepos
= marker_byte_position (readcharfun
);
311 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
314 if (! NILP (inbuffer
->enable_multibyte_characters
))
316 /* Fetch the character code from the buffer. */
317 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
318 BUF_INC_POS (inbuffer
, bytepos
);
319 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
325 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
326 if (! ASCII_BYTE_P (c
))
327 c
= BYTE8_TO_CHAR (c
);
331 XMARKER (readcharfun
)->bytepos
= bytepos
;
332 XMARKER (readcharfun
)->charpos
++;
337 if (EQ (readcharfun
, Qlambda
))
339 readbyte
= readbyte_for_lambda
;
343 if (EQ (readcharfun
, Qget_file_char
))
345 readbyte
= readbyte_from_file
;
349 if (STRINGP (readcharfun
))
351 if (read_from_string_index
>= read_from_string_limit
)
353 else if (STRING_MULTIBYTE (readcharfun
))
357 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
358 read_from_string_index
,
359 read_from_string_index_byte
);
363 c
= SREF (readcharfun
, read_from_string_index_byte
);
364 read_from_string_index
++;
365 read_from_string_index_byte
++;
370 if (CONSP (readcharfun
))
372 /* This is the case that read_vector is reading from a unibyte
373 string that contains a byte sequence previously skipped
374 because of #@NUMBER. The car part of readcharfun is that
375 string, and the cdr part is a value of readcharfun given to
377 readbyte
= readbyte_from_string
;
378 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
379 emacs_mule_encoding
= 1;
383 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
385 readbyte
= readbyte_from_file
;
386 emacs_mule_encoding
= 1;
390 tem
= call0 (readcharfun
);
397 if (unread_char
>= 0)
403 c
= (*readbyte
) (-1, readcharfun
);
404 if (c
< 0 || load_each_byte
)
408 if (ASCII_BYTE_P (c
))
410 if (emacs_mule_encoding
)
411 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
414 len
= BYTES_BY_CHAR_HEAD (c
);
417 c
= (*readbyte
) (-1, readcharfun
);
418 if (c
< 0 || ! TRAILING_CODE_P (c
))
421 (*readbyte
) (buf
[i
], readcharfun
);
422 return BYTE8_TO_CHAR (buf
[0]);
426 return STRING_CHAR (buf
, i
);
429 /* Unread the character C in the way appropriate for the stream READCHARFUN.
430 If the stream is a user function, call it with the char as argument. */
433 unreadchar (readcharfun
, c
)
434 Lisp_Object readcharfun
;
439 /* Don't back up the pointer if we're unreading the end-of-input mark,
440 since readchar didn't advance it when we read it. */
442 else if (BUFFERP (readcharfun
))
444 struct buffer
*b
= XBUFFER (readcharfun
);
445 int bytepos
= BUF_PT_BYTE (b
);
448 if (! NILP (b
->enable_multibyte_characters
))
449 BUF_DEC_POS (b
, bytepos
);
453 BUF_PT_BYTE (b
) = bytepos
;
455 else if (MARKERP (readcharfun
))
457 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
458 int bytepos
= XMARKER (readcharfun
)->bytepos
;
460 XMARKER (readcharfun
)->charpos
--;
461 if (! NILP (b
->enable_multibyte_characters
))
462 BUF_DEC_POS (b
, bytepos
);
466 XMARKER (readcharfun
)->bytepos
= bytepos
;
468 else if (STRINGP (readcharfun
))
470 read_from_string_index
--;
471 read_from_string_index_byte
472 = string_char_to_byte (readcharfun
, read_from_string_index
);
474 else if (CONSP (readcharfun
))
478 else if (EQ (readcharfun
, Qlambda
))
482 else if (EQ (readcharfun
, Qget_file_char
)
483 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
488 ungetc (c
, instream
);
495 call1 (readcharfun
, make_number (c
));
499 readbyte_for_lambda (c
, readcharfun
)
501 Lisp_Object readcharfun
;
503 return read_bytecode_char (c
>= 0);
508 readbyte_from_file (c
, readcharfun
)
510 Lisp_Object readcharfun
;
515 ungetc (c
, instream
);
524 /* Interrupted reads have been observed while reading over the network */
525 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
537 return (c
== EOF
? -1 : c
);
541 readbyte_from_string (c
, readcharfun
)
543 Lisp_Object readcharfun
;
545 Lisp_Object string
= XCAR (readcharfun
);
549 read_from_string_index
--;
550 read_from_string_index_byte
551 = string_char_to_byte (string
, read_from_string_index
);
554 if (read_from_string_index
>= read_from_string_limit
)
557 FETCH_STRING_CHAR_ADVANCE (c
, string
,
558 read_from_string_index
,
559 read_from_string_index_byte
);
564 /* Read one non-ASCII character from INSTREAM. The character is
565 encoded in `emacs-mule' and the first byte is already read in
568 extern char emacs_mule_bytes
[256];
571 read_emacs_mule_char (c
, readbyte
, readcharfun
)
573 int (*readbyte
) P_ ((int, Lisp_Object
));
574 Lisp_Object readcharfun
;
576 /* Emacs-mule coding uses at most 4-byte for one character. */
577 unsigned char buf
[4];
578 int len
= emacs_mule_bytes
[c
];
579 struct charset
*charset
;
584 /* C is not a valid leading-code of `emacs-mule'. */
585 return BYTE8_TO_CHAR (c
);
591 c
= (*readbyte
) (-1, readcharfun
);
595 (*readbyte
) (buf
[i
], readcharfun
);
596 return BYTE8_TO_CHAR (buf
[0]);
603 charset
= emacs_mule_charset
[buf
[0]];
604 code
= buf
[1] & 0x7F;
608 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
609 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
611 charset
= emacs_mule_charset
[buf
[1]];
612 code
= buf
[2] & 0x7F;
616 charset
= emacs_mule_charset
[buf
[0]];
617 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
622 charset
= emacs_mule_charset
[buf
[1]];
623 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
625 c
= DECODE_CHAR (charset
, code
);
627 Fsignal (Qinvalid_read_syntax
,
628 Fcons (build_string ("invalid multibyte form"), Qnil
));
633 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
635 static Lisp_Object read0
P_ ((Lisp_Object
));
636 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
638 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
639 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
641 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
643 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
645 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
648 /* Get a character from the tty. */
650 /* Read input events until we get one that's acceptable for our purposes.
652 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
653 until we get a character we like, and then stuffed into
656 If ASCII_REQUIRED is non-zero, we check function key events to see
657 if the unmodified version of the symbol has a Qascii_character
658 property, and use that character, if present.
660 If ERROR_NONASCII is non-zero, we signal an error if the input we
661 get isn't an ASCII character with modifiers. If it's zero but
662 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
665 If INPUT_METHOD is nonzero, we invoke the current input method
666 if the character warrants that.
668 If SECONDS is a number, we wait that many seconds for input, and
669 return Qnil if no input arrives within that time. */
672 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
673 input_method
, seconds
)
674 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
677 Lisp_Object val
, delayed_switch_frame
;
680 #ifdef HAVE_WINDOW_SYSTEM
681 if (display_hourglass_p
)
685 delayed_switch_frame
= Qnil
;
687 /* Compute timeout. */
688 if (NUMBERP (seconds
))
690 EMACS_TIME wait_time
;
692 double duration
= extract_float (seconds
);
694 sec
= (int) duration
;
695 usec
= (duration
- sec
) * 1000000;
696 EMACS_GET_TIME (end_time
);
697 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
698 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
701 /* Read until we get an acceptable event. */
704 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
705 NUMBERP (seconds
) ? &end_time
: NULL
);
706 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
711 /* switch-frame events are put off until after the next ASCII
712 character. This is better than signaling an error just because
713 the last characters were typed to a separate minibuffer frame,
714 for example. Eventually, some code which can deal with
715 switch-frame events will read it and process it. */
717 && EVENT_HAS_PARAMETERS (val
)
718 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
720 delayed_switch_frame
= val
;
724 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
726 /* Convert certain symbols to their ASCII equivalents. */
729 Lisp_Object tem
, tem1
;
730 tem
= Fget (val
, Qevent_symbol_element_mask
);
733 tem1
= Fget (Fcar (tem
), Qascii_character
);
734 /* Merge this symbol's modifier bits
735 with the ASCII equivalent of its basic code. */
737 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
741 /* If we don't have a character now, deal with it appropriately. */
746 Vunread_command_events
= Fcons (val
, Qnil
);
747 error ("Non-character input-event");
754 if (! NILP (delayed_switch_frame
))
755 unread_switch_frame
= delayed_switch_frame
;
759 #ifdef HAVE_WINDOW_SYSTEM
760 if (display_hourglass_p
)
769 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
770 doc
: /* Read a character from the command input (keyboard or macro).
771 It is returned as a number.
772 If the character has modifiers, they are resolved and reflected to the
773 character code if possible (e.g. C-SPC -> 0).
775 If the user generates an event which is not a character (i.e. a mouse
776 click or function key event), `read-char' signals an error. As an
777 exception, switch-frame events are put off until non-character events
779 If you want to read non-character events, or ignore them, call
780 `read-event' or `read-char-exclusive' instead.
782 If the optional argument PROMPT is non-nil, display that as a prompt.
783 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
784 input method is turned on in the current buffer, that input method
785 is used for reading a character.
786 If the optional argument SECONDS is non-nil, it should be a number
787 specifying the maximum number of seconds to wait for input. If no
788 input arrives in that time, return nil. SECONDS may be a
789 floating-point value. */)
790 (prompt
, inherit_input_method
, seconds
)
791 Lisp_Object prompt
, inherit_input_method
, seconds
;
797 message_with_string ("%s", prompt
, 0);
798 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
800 return make_number (char_resolve_modifier_mask (c
));
803 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
804 doc
: /* Read an event object from the input stream.
805 If the optional argument PROMPT is non-nil, display that as a prompt.
806 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
807 input method is turned on in the current buffer, that input method
808 is used for reading a character.
809 If the optional argument SECONDS is non-nil, it should be a number
810 specifying the maximum number of seconds to wait for input. If no
811 input arrives in that time, return nil. SECONDS may be a
812 floating-point value. */)
813 (prompt
, inherit_input_method
, seconds
)
814 Lisp_Object prompt
, inherit_input_method
, seconds
;
817 message_with_string ("%s", prompt
, 0);
818 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
821 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
822 doc
: /* Read a character from the command input (keyboard or macro).
823 It is returned as a number. Non-character events are ignored.
824 If the character has modifiers, they are resolved and reflected to the
825 character code if possible (e.g. C-SPC -> 0).
827 If the optional argument PROMPT is non-nil, display that as a prompt.
828 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
829 input method is turned on in the current buffer, that input method
830 is used for reading a character.
831 If the optional argument SECONDS is non-nil, it should be a number
832 specifying the maximum number of seconds to wait for input. If no
833 input arrives in that time, return nil. SECONDS may be a
834 floating-point value. */)
835 (prompt
, inherit_input_method
, seconds
)
836 Lisp_Object prompt
, inherit_input_method
, seconds
;
842 message_with_string ("%s", prompt
, 0);
843 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
845 return make_number (char_resolve_modifier_mask (c
));
848 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
849 doc
: /* Don't use this yourself. */)
852 register Lisp_Object val
;
854 XSETINT (val
, getc (instream
));
861 /* Value is a version number of byte compiled code if the file
862 associated with file descriptor FD is a compiled Lisp file that's
863 safe to load. Only files compiled with Emacs are safe to load.
864 Files compiled with XEmacs can lead to a crash in Fbyte_code
865 because of an incompatible change in the byte compiler. */
876 /* Read the first few bytes from the file, and look for a line
877 specifying the byte compiler version used. */
878 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
883 /* Skip to the next newline, skipping over the initial `ELC'
884 with NUL bytes following it, but note the version. */
885 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
890 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
897 lseek (fd
, 0, SEEK_SET
);
902 /* Callback for record_unwind_protect. Restore the old load list OLD,
903 after loading a file successfully. */
906 record_load_unwind (old
)
909 return Vloads_in_progress
= old
;
912 /* This handler function is used via internal_condition_case_1. */
915 load_error_handler (data
)
922 load_warn_old_style_backquotes (file
)
925 if (!NILP (Vold_style_backquotes
))
928 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
935 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
936 doc
: /* Return the suffixes that `load' should try if a suffix is \
938 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
941 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
942 while (CONSP (suffixes
))
944 Lisp_Object exts
= Vload_file_rep_suffixes
;
945 suffix
= XCAR (suffixes
);
946 suffixes
= XCDR (suffixes
);
951 lst
= Fcons (concat2 (suffix
, ext
), lst
);
954 return Fnreverse (lst
);
957 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
958 doc
: /* Execute a file of Lisp code named FILE.
959 First try FILE with `.elc' appended, then try with `.el',
960 then try FILE unmodified (the exact suffixes in the exact order are
961 determined by `load-suffixes'). Environment variable references in
962 FILE are replaced with their values by calling `substitute-in-file-name'.
963 This function searches the directories in `load-path'.
965 If optional second arg NOERROR is non-nil,
966 report no error if FILE doesn't exist.
967 Print messages at start and end of loading unless
968 optional third arg NOMESSAGE is non-nil.
969 If optional fourth arg NOSUFFIX is non-nil, don't try adding
970 suffixes `.elc' or `.el' to the specified name FILE.
971 If optional fifth arg MUST-SUFFIX is non-nil, insist on
972 the suffix `.elc' or `.el'; don't accept just FILE unless
973 it ends in one of those suffixes or includes a directory name.
975 If this function fails to find a file, it may look for different
976 representations of that file before trying another file.
977 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
978 to the file name. Emacs uses this feature mainly to find compressed
979 versions of files when Auto Compression mode is enabled.
981 The exact suffixes that this function tries out, in the exact order,
982 are given by the value of the variable `load-file-rep-suffixes' if
983 NOSUFFIX is non-nil and by the return value of the function
984 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
985 MUST-SUFFIX are nil, this function first tries out the latter suffixes
988 Loading a file records its definitions, and its `provide' and
989 `require' calls, in an element of `load-history' whose
990 car is the file name loaded. See `load-history'.
992 Return t if the file exists and loads successfully. */)
993 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
994 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
996 register FILE *stream
;
997 register int fd
= -1;
998 int count
= SPECPDL_INDEX ();
999 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1000 Lisp_Object found
, efound
, hist_file_name
;
1001 /* 1 means we printed the ".el is newer" message. */
1003 /* 1 means we are loading a compiled file. */
1005 Lisp_Object handler
;
1015 CHECK_STRING (file
);
1017 /* If file name is magic, call the handler. */
1018 /* This shouldn't be necessary any more now that `openp' handles it right.
1019 handler = Ffind_file_name_handler (file, Qload);
1020 if (!NILP (handler))
1021 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1023 /* Do this after the handler to avoid
1024 the need to gcpro noerror, nomessage and nosuffix.
1025 (Below here, we care only whether they are nil or not.)
1026 The presence of this call is the result of a historical accident:
1027 it used to be in every file-operation and when it got removed
1028 everywhere, it accidentally stayed here. Since then, enough people
1029 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1030 that it seemed risky to remove. */
1031 if (! NILP (noerror
))
1033 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1034 Qt
, load_error_handler
);
1039 file
= Fsubstitute_in_file_name (file
);
1042 /* Avoid weird lossage with null string as arg,
1043 since it would try to load a directory as a Lisp file */
1044 if (SCHARS (file
) > 0)
1046 int size
= SBYTES (file
);
1049 GCPRO2 (file
, found
);
1051 if (! NILP (must_suffix
))
1053 /* Don't insist on adding a suffix if FILE already ends with one. */
1055 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1058 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1060 /* Don't insist on adding a suffix
1061 if the argument includes a directory name. */
1062 else if (! NILP (Ffile_name_directory (file
)))
1066 fd
= openp (Vload_path
, file
,
1067 (!NILP (nosuffix
) ? Qnil
1068 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1069 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1070 tmp
[1] = Vload_file_rep_suffixes
,
1079 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1083 /* Tell startup.el whether or not we found the user's init file. */
1084 if (EQ (Qt
, Vuser_init_file
))
1085 Vuser_init_file
= found
;
1087 /* If FD is -2, that means openp found a magic file. */
1090 if (NILP (Fequal (found
, file
)))
1091 /* If FOUND is a different file name from FILE,
1092 find its handler even if we have already inhibited
1093 the `load' operation on FILE. */
1094 handler
= Ffind_file_name_handler (found
, Qt
);
1096 handler
= Ffind_file_name_handler (found
, Qload
);
1097 if (! NILP (handler
))
1098 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1101 /* Check if we're stuck in a recursive load cycle.
1103 2000-09-21: It's not possible to just check for the file loaded
1104 being a member of Vloads_in_progress. This fails because of the
1105 way the byte compiler currently works; `provide's are not
1106 evaluted, see font-lock.el/jit-lock.el as an example. This
1107 leads to a certain amount of ``normal'' recursion.
1109 Also, just loading a file recursively is not always an error in
1110 the general case; the second load may do something different. */
1114 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1115 if (!NILP (Fequal (found
, XCAR (tem
))))
1121 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1123 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1124 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1127 /* Get the name for load-history. */
1128 hist_file_name
= (! NILP (Vpurify_flag
)
1129 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1130 tmp
[1] = Ffile_name_nondirectory (found
),
1136 /* Check for the presence of old-style quotes and warn about them. */
1137 specbind (Qold_style_backquotes
, Qnil
);
1138 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1140 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1142 || (version
= safe_to_load_p (fd
)) > 0)
1143 /* Load .elc files directly, but not when they are
1144 remote and have no handler! */
1151 GCPRO3 (file
, found
, hist_file_name
);
1154 && ! (version
= safe_to_load_p (fd
)))
1157 if (!load_dangerous_libraries
)
1161 error ("File `%s' was not compiled in Emacs",
1164 else if (!NILP (nomessage
))
1165 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1170 efound
= ENCODE_FILE (found
);
1175 stat ((char *)SDATA (efound
), &s1
);
1176 SSET (efound
, SBYTES (efound
) - 1, 0);
1177 result
= stat ((char *)SDATA (efound
), &s2
);
1178 SSET (efound
, SBYTES (efound
) - 1, 'c');
1180 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1182 /* Make the progress messages mention that source is newer. */
1185 /* If we won't print another message, mention this anyway. */
1186 if (!NILP (nomessage
))
1188 Lisp_Object msg_file
;
1189 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1190 message_with_string ("Source file `%s' newer than byte-compiled file",
1199 /* We are loading a source file (*.el). */
1200 if (!NILP (Vload_source_file_function
))
1206 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1207 NILP (noerror
) ? Qnil
: Qt
,
1208 NILP (nomessage
) ? Qnil
: Qt
);
1209 return unbind_to (count
, val
);
1213 GCPRO3 (file
, found
, hist_file_name
);
1217 efound
= ENCODE_FILE (found
);
1218 stream
= fopen ((char *) SDATA (efound
), fmode
);
1219 #else /* not WINDOWSNT */
1220 stream
= fdopen (fd
, fmode
);
1221 #endif /* not WINDOWSNT */
1225 error ("Failure to create stdio stream for %s", SDATA (file
));
1228 if (! NILP (Vpurify_flag
))
1229 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1231 if (NILP (nomessage
))
1234 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1237 message_with_string ("Loading %s (source)...", file
, 1);
1239 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1241 else /* The typical case; compiled file newer than source file. */
1242 message_with_string ("Loading %s...", file
, 1);
1245 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1246 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1247 specbind (Qload_file_name
, found
);
1248 specbind (Qinhibit_file_name_operation
, Qnil
);
1249 load_descriptor_list
1250 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1252 if (! version
|| version
>= 22)
1253 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1254 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1257 /* We can't handle a file which was compiled with
1258 byte-compile-dynamic by older version of Emacs. */
1259 specbind (Qload_force_doc_strings
, Qt
);
1260 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1261 0, Qnil
, Qnil
, Qnil
, Qnil
);
1263 unbind_to (count
, Qnil
);
1265 /* Run any eval-after-load forms for this file */
1266 if (NILP (Vpurify_flag
)
1267 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1268 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1272 free (saved_doc_string
);
1273 saved_doc_string
= 0;
1274 saved_doc_string_size
= 0;
1276 xfree (prev_saved_doc_string
);
1277 prev_saved_doc_string
= 0;
1278 prev_saved_doc_string_size
= 0;
1280 if (!noninteractive
&& NILP (nomessage
))
1283 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1286 message_with_string ("Loading %s (source)...done", file
, 1);
1288 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1290 else /* The typical case; compiled file newer than source file. */
1291 message_with_string ("Loading %s...done", file
, 1);
1294 if (!NILP (Fequal (build_string ("obsolete"),
1295 Ffile_name_nondirectory
1296 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1297 message_with_string ("Package %s is obsolete", file
, 1);
1303 load_unwind (arg
) /* used as unwind-protect function in load */
1306 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1313 if (--load_in_progress
< 0) load_in_progress
= 0;
1318 load_descriptor_unwind (oldlist
)
1319 Lisp_Object oldlist
;
1321 load_descriptor_list
= oldlist
;
1325 /* Close all descriptors in use for Floads.
1326 This is used when starting a subprocess. */
1333 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1334 emacs_close (XFASTINT (XCAR (tail
)));
1339 complete_filename_p (pathname
)
1340 Lisp_Object pathname
;
1342 register const unsigned char *s
= SDATA (pathname
);
1343 return (IS_DIRECTORY_SEP (s
[0])
1344 || (SCHARS (pathname
) > 2
1345 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1352 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1353 doc
: /* Search for FILENAME through PATH.
1354 Returns the file's name in absolute form, or nil if not found.
1355 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1356 file name when searching.
1357 If non-nil, PREDICATE is used instead of `file-readable-p'.
1358 PREDICATE can also be an integer to pass to the access(2) function,
1359 in which case file-name-handlers are ignored. */)
1360 (filename
, path
, suffixes
, predicate
)
1361 Lisp_Object filename
, path
, suffixes
, predicate
;
1364 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1365 if (NILP (predicate
) && fd
> 0)
1371 /* Search for a file whose name is STR, looking in directories
1372 in the Lisp list PATH, and trying suffixes from SUFFIX.
1373 On success, returns a file descriptor. On failure, returns -1.
1375 SUFFIXES is a list of strings containing possible suffixes.
1376 The empty suffix is automatically added if the list is empty.
1378 PREDICATE non-nil means don't open the files,
1379 just look for one that satisfies the predicate. In this case,
1380 returns 1 on success. The predicate can be a lisp function or
1381 an integer to pass to `access' (in which case file-name-handlers
1384 If STOREPTR is nonzero, it points to a slot where the name of
1385 the file actually found should be stored as a Lisp string.
1386 nil is stored there on failure.
1388 If the file we find is remote, return -2
1389 but store the found remote file name in *STOREPTR. */
1392 openp (path
, str
, suffixes
, storeptr
, predicate
)
1393 Lisp_Object path
, str
;
1394 Lisp_Object suffixes
;
1395 Lisp_Object
*storeptr
;
1396 Lisp_Object predicate
;
1401 register char *fn
= buf
;
1404 Lisp_Object filename
;
1406 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1407 Lisp_Object string
, tail
, encoded_fn
;
1408 int max_suffix_len
= 0;
1412 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1414 CHECK_STRING_CAR (tail
);
1415 max_suffix_len
= max (max_suffix_len
,
1416 SBYTES (XCAR (tail
)));
1419 string
= filename
= encoded_fn
= Qnil
;
1420 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1425 if (complete_filename_p (str
))
1428 for (; CONSP (path
); path
= XCDR (path
))
1430 filename
= Fexpand_file_name (str
, XCAR (path
));
1431 if (!complete_filename_p (filename
))
1432 /* If there are non-absolute elts in PATH (eg ".") */
1433 /* Of course, this could conceivably lose if luser sets
1434 default-directory to be something non-absolute... */
1436 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1437 if (!complete_filename_p (filename
))
1438 /* Give up on this path element! */
1442 /* Calculate maximum size of any filename made from
1443 this path element/specified file name and any possible suffix. */
1444 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1445 if (fn_size
< want_size
)
1446 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1448 /* Loop over suffixes. */
1449 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1450 CONSP (tail
); tail
= XCDR (tail
))
1452 int lsuffix
= SBYTES (XCAR (tail
));
1453 Lisp_Object handler
;
1456 /* Concatenate path element/specified name with the suffix.
1457 If the directory starts with /:, remove that. */
1458 if (SCHARS (filename
) > 2
1459 && SREF (filename
, 0) == '/'
1460 && SREF (filename
, 1) == ':')
1462 strncpy (fn
, SDATA (filename
) + 2,
1463 SBYTES (filename
) - 2);
1464 fn
[SBYTES (filename
) - 2] = 0;
1468 strncpy (fn
, SDATA (filename
),
1470 fn
[SBYTES (filename
)] = 0;
1473 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1474 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1476 /* Check that the file exists and is not a directory. */
1477 /* We used to only check for handlers on non-absolute file names:
1481 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1482 It's not clear why that was the case and it breaks things like
1483 (load "/bar.el") where the file is actually "/bar.el.gz". */
1484 string
= build_string (fn
);
1485 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1486 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1488 if (NILP (predicate
))
1489 exists
= !NILP (Ffile_readable_p (string
));
1491 exists
= !NILP (call1 (predicate
, string
));
1492 if (exists
&& !NILP (Ffile_directory_p (string
)))
1497 /* We succeeded; return this descriptor and filename. */
1508 encoded_fn
= ENCODE_FILE (string
);
1509 pfn
= SDATA (encoded_fn
);
1510 exists
= (stat (pfn
, &st
) >= 0
1511 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1514 /* Check that we can access or open it. */
1515 if (NATNUMP (predicate
))
1516 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1518 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1522 /* We succeeded; return this descriptor and filename. */
1540 /* Merge the list we've accumulated of globals from the current input source
1541 into the load_history variable. The details depend on whether
1542 the source has an associated file name or not.
1544 FILENAME is the file name that we are loading from.
1545 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1548 build_load_history (filename
, entire
)
1549 Lisp_Object filename
;
1552 register Lisp_Object tail
, prev
, newelt
;
1553 register Lisp_Object tem
, tem2
;
1554 register int foundit
= 0;
1556 tail
= Vload_history
;
1559 while (CONSP (tail
))
1563 /* Find the feature's previous assoc list... */
1564 if (!NILP (Fequal (filename
, Fcar (tem
))))
1568 /* If we're loading the entire file, remove old data. */
1572 Vload_history
= XCDR (tail
);
1574 Fsetcdr (prev
, XCDR (tail
));
1577 /* Otherwise, cons on new symbols that are not already members. */
1580 tem2
= Vcurrent_load_list
;
1582 while (CONSP (tem2
))
1584 newelt
= XCAR (tem2
);
1586 if (NILP (Fmember (newelt
, tem
)))
1587 Fsetcar (tail
, Fcons (XCAR (tem
),
1588 Fcons (newelt
, XCDR (tem
))));
1601 /* If we're loading an entire file, cons the new assoc onto the
1602 front of load-history, the most-recently-loaded position. Also
1603 do this if we didn't find an existing member for the file. */
1604 if (entire
|| !foundit
)
1605 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1610 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1618 readevalloop_1 (old
)
1621 load_convert_to_unibyte
= ! NILP (old
);
1625 /* Signal an `end-of-file' error, if possible with file name
1629 end_of_file_error ()
1631 if (STRINGP (Vload_file_name
))
1632 xsignal1 (Qend_of_file
, Vload_file_name
);
1634 xsignal0 (Qend_of_file
);
1637 /* UNIBYTE specifies how to set load_convert_to_unibyte
1638 for this invocation.
1639 READFUN, if non-nil, is used instead of `read'.
1641 START, END specify region to read in current buffer (from eval-region).
1642 If the input is not from a buffer, they must be nil. */
1645 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1646 printflag
, unibyte
, readfun
, start
, end
)
1647 Lisp_Object readcharfun
;
1649 Lisp_Object sourcename
;
1650 Lisp_Object (*evalfun
) ();
1652 Lisp_Object unibyte
, readfun
;
1653 Lisp_Object start
, end
;
1656 register Lisp_Object val
;
1657 int count
= SPECPDL_INDEX ();
1658 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1659 struct buffer
*b
= 0;
1660 int continue_reading_p
;
1661 /* Nonzero if reading an entire buffer. */
1662 int whole_buffer
= 0;
1663 /* 1 on the first time around. */
1666 if (MARKERP (readcharfun
))
1669 start
= readcharfun
;
1672 if (BUFFERP (readcharfun
))
1673 b
= XBUFFER (readcharfun
);
1674 else if (MARKERP (readcharfun
))
1675 b
= XMARKER (readcharfun
)->buffer
;
1677 /* We assume START is nil when input is not from a buffer. */
1678 if (! NILP (start
) && !b
)
1681 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1682 specbind (Qcurrent_load_list
, Qnil
);
1683 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1684 load_convert_to_unibyte
= !NILP (unibyte
);
1686 GCPRO4 (sourcename
, readfun
, start
, end
);
1688 /* Try to ensure sourcename is a truename, except whilst preloading. */
1689 if (NILP (Vpurify_flag
)
1690 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1691 && !NILP (Ffboundp (Qfile_truename
)))
1692 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1694 LOADHIST_ATTACH (sourcename
);
1696 continue_reading_p
= 1;
1697 while (continue_reading_p
)
1699 int count1
= SPECPDL_INDEX ();
1701 if (b
!= 0 && NILP (b
->name
))
1702 error ("Reading from killed buffer");
1706 /* Switch to the buffer we are reading from. */
1707 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1708 set_buffer_internal (b
);
1710 /* Save point in it. */
1711 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1712 /* Save ZV in it. */
1713 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1714 /* Those get unbound after we read one expression. */
1716 /* Set point and ZV around stuff to be read. */
1719 Fnarrow_to_region (make_number (BEGV
), end
);
1721 /* Just for cleanliness, convert END to a marker
1722 if it is an integer. */
1724 end
= Fpoint_max_marker ();
1727 /* On the first cycle, we can easily test here
1728 whether we are reading the whole buffer. */
1729 if (b
&& first_sexp
)
1730 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1737 while ((c
= READCHAR
) != '\n' && c
!= -1);
1742 unbind_to (count1
, Qnil
);
1746 /* Ignore whitespace here, so we can detect eof. */
1747 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1748 || c
== 0x8a0) /* NBSP */
1751 if (!NILP (Vpurify_flag
) && c
== '(')
1753 record_unwind_protect (unreadpure
, Qnil
);
1754 val
= read_list (-1, readcharfun
);
1759 read_objects
= Qnil
;
1760 if (!NILP (readfun
))
1762 val
= call1 (readfun
, readcharfun
);
1764 /* If READCHARFUN has set point to ZV, we should
1765 stop reading, even if the form read sets point
1766 to a different value when evaluated. */
1767 if (BUFFERP (readcharfun
))
1769 struct buffer
*b
= XBUFFER (readcharfun
);
1770 if (BUF_PT (b
) == BUF_ZV (b
))
1771 continue_reading_p
= 0;
1774 else if (! NILP (Vload_read_function
))
1775 val
= call1 (Vload_read_function
, readcharfun
);
1777 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1780 if (!NILP (start
) && continue_reading_p
)
1781 start
= Fpoint_marker ();
1783 /* Restore saved point and BEGV. */
1784 unbind_to (count1
, Qnil
);
1786 /* Now eval what we just read. */
1787 val
= (*evalfun
) (val
);
1791 Vvalues
= Fcons (val
, Vvalues
);
1792 if (EQ (Vstandard_output
, Qt
))
1801 build_load_history (sourcename
,
1802 stream
|| whole_buffer
);
1806 unbind_to (count
, Qnil
);
1809 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1810 doc
: /* Execute the current buffer as Lisp code.
1811 Programs can pass two arguments, BUFFER and PRINTFLAG.
1812 BUFFER is the buffer to evaluate (nil means use current buffer).
1813 PRINTFLAG controls printing of output:
1814 A value of nil means discard it; anything else is stream for print.
1816 If the optional third argument FILENAME is non-nil,
1817 it specifies the file name to use for `load-history'.
1818 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1819 for this invocation.
1821 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1822 `print' and related functions should work normally even if PRINTFLAG is nil.
1824 This function preserves the position of point. */)
1825 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1826 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1828 int count
= SPECPDL_INDEX ();
1829 Lisp_Object tem
, buf
;
1832 buf
= Fcurrent_buffer ();
1834 buf
= Fget_buffer (buffer
);
1836 error ("No such buffer");
1838 if (NILP (printflag
) && NILP (do_allow_print
))
1843 if (NILP (filename
))
1844 filename
= XBUFFER (buf
)->filename
;
1846 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1847 specbind (Qstandard_output
, tem
);
1848 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1849 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1850 readevalloop (buf
, 0, filename
, Feval
,
1851 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1852 unbind_to (count
, Qnil
);
1857 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1858 doc
: /* Execute the region as Lisp code.
1859 When called from programs, expects two arguments,
1860 giving starting and ending indices in the current buffer
1861 of the text to be executed.
1862 Programs can pass third argument PRINTFLAG which controls output:
1863 A value of nil means discard it; anything else is stream for printing it.
1864 Also the fourth argument READ-FUNCTION, if non-nil, is used
1865 instead of `read' to read each expression. It gets one argument
1866 which is the input stream for reading characters.
1868 This function does not move point. */)
1869 (start
, end
, printflag
, read_function
)
1870 Lisp_Object start
, end
, printflag
, read_function
;
1872 int count
= SPECPDL_INDEX ();
1873 Lisp_Object tem
, cbuf
;
1875 cbuf
= Fcurrent_buffer ();
1877 if (NILP (printflag
))
1881 specbind (Qstandard_output
, tem
);
1882 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1884 /* readevalloop calls functions which check the type of start and end. */
1885 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1886 !NILP (printflag
), Qnil
, read_function
,
1889 return unbind_to (count
, Qnil
);
1893 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1894 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1895 If STREAM is nil, use the value of `standard-input' (which see).
1896 STREAM or the value of `standard-input' may be:
1897 a buffer (read from point and advance it)
1898 a marker (read from where it points and advance it)
1899 a function (call it with no arguments for each character,
1900 call it with a char as argument to push a char back)
1901 a string (takes text from string, starting at the beginning)
1902 t (read text line using minibuffer and use it, or read from
1903 standard input in batch mode). */)
1908 stream
= Vstandard_input
;
1909 if (EQ (stream
, Qt
))
1910 stream
= Qread_char
;
1911 if (EQ (stream
, Qread_char
))
1912 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1914 return read_internal_start (stream
, Qnil
, Qnil
);
1917 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1918 doc
: /* Read one Lisp expression which is represented as text by STRING.
1919 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1920 START and END optionally delimit a substring of STRING from which to read;
1921 they default to 0 and (length STRING) respectively. */)
1922 (string
, start
, end
)
1923 Lisp_Object string
, start
, end
;
1926 CHECK_STRING (string
);
1927 /* read_internal_start sets read_from_string_index. */
1928 ret
= read_internal_start (string
, start
, end
);
1929 return Fcons (ret
, make_number (read_from_string_index
));
1932 /* Function to set up the global context we need in toplevel read
1935 read_internal_start (stream
, start
, end
)
1937 Lisp_Object start
; /* Only used when stream is a string. */
1938 Lisp_Object end
; /* Only used when stream is a string. */
1943 new_backquote_flag
= 0;
1944 read_objects
= Qnil
;
1945 if (EQ (Vread_with_symbol_positions
, Qt
)
1946 || EQ (Vread_with_symbol_positions
, stream
))
1947 Vread_symbol_positions_list
= Qnil
;
1949 if (STRINGP (stream
)
1950 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1952 int startval
, endval
;
1955 if (STRINGP (stream
))
1958 string
= XCAR (stream
);
1961 endval
= SCHARS (string
);
1965 endval
= XINT (end
);
1966 if (endval
< 0 || endval
> SCHARS (string
))
1967 args_out_of_range (string
, end
);
1974 CHECK_NUMBER (start
);
1975 startval
= XINT (start
);
1976 if (startval
< 0 || startval
> endval
)
1977 args_out_of_range (string
, start
);
1979 read_from_string_index
= startval
;
1980 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1981 read_from_string_limit
= endval
;
1984 retval
= read0 (stream
);
1985 if (EQ (Vread_with_symbol_positions
, Qt
)
1986 || EQ (Vread_with_symbol_positions
, stream
))
1987 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1992 /* Signal Qinvalid_read_syntax error.
1993 S is error string of length N (if > 0) */
1996 invalid_syntax (s
, n
)
2002 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2006 /* Use this for recursive reads, in contexts where internal tokens
2011 Lisp_Object readcharfun
;
2013 register Lisp_Object val
;
2016 val
= read1 (readcharfun
, &c
, 0);
2020 xsignal1 (Qinvalid_read_syntax
,
2021 Fmake_string (make_number (1), make_number (c
)));
2024 static int read_buffer_size
;
2025 static char *read_buffer
;
2027 /* Read a \-escape sequence, assuming we already read the `\'.
2028 If the escape sequence forces unibyte, return eight-bit char. */
2031 read_escape (readcharfun
, stringp
)
2032 Lisp_Object readcharfun
;
2035 register int c
= READCHAR
;
2036 /* \u allows up to four hex digits, \U up to eight. Default to the
2037 behaviour for \u, and change this value in the case that \U is seen. */
2038 int unicode_hex_count
= 4;
2043 end_of_file_error ();
2073 error ("Invalid escape character syntax");
2076 c
= read_escape (readcharfun
, 0);
2077 return c
| meta_modifier
;
2082 error ("Invalid escape character syntax");
2085 c
= read_escape (readcharfun
, 0);
2086 return c
| shift_modifier
;
2091 error ("Invalid escape character syntax");
2094 c
= read_escape (readcharfun
, 0);
2095 return c
| hyper_modifier
;
2100 error ("Invalid escape character syntax");
2103 c
= read_escape (readcharfun
, 0);
2104 return c
| alt_modifier
;
2108 if (stringp
|| c
!= '-')
2115 c
= read_escape (readcharfun
, 0);
2116 return c
| super_modifier
;
2121 error ("Invalid escape character syntax");
2125 c
= read_escape (readcharfun
, 0);
2126 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2127 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2128 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2129 return c
| ctrl_modifier
;
2130 /* ASCII control chars are made from letters (both cases),
2131 as well as the non-letters within 0100...0137. */
2132 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2133 return (c
& (037 | ~0177));
2134 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2135 return (c
& (037 | ~0177));
2137 return c
| ctrl_modifier
;
2147 /* An octal escape, as in ANSI C. */
2149 register int i
= c
- '0';
2150 register int count
= 0;
2153 if ((c
= READCHAR
) >= '0' && c
<= '7')
2165 if (i
>= 0x80 && i
< 0x100)
2166 i
= BYTE8_TO_CHAR (i
);
2171 /* A hex escape, as in ANSI C. */
2178 if (c
>= '0' && c
<= '9')
2183 else if ((c
>= 'a' && c
<= 'f')
2184 || (c
>= 'A' && c
<= 'F'))
2187 if (c
>= 'a' && c
<= 'f')
2200 if (count
< 3 && i
>= 0x80)
2201 return BYTE8_TO_CHAR (i
);
2206 /* Post-Unicode-2.0: Up to eight hex chars. */
2207 unicode_hex_count
= 8;
2210 /* A Unicode escape. We only permit them in strings and characters,
2211 not arbitrarily in the source code, as in some other languages. */
2216 while (++count
<= unicode_hex_count
)
2219 /* isdigit and isalpha may be locale-specific, which we don't
2221 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2222 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2223 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2226 error ("Non-hex digit used for Unicode escape");
2239 /* Read an integer in radix RADIX using READCHARFUN to read
2240 characters. RADIX must be in the interval [2..36]; if it isn't, a
2241 read error is signaled . Value is the integer read. Signals an
2242 error if encountering invalid read syntax or if RADIX is out of
2246 read_integer (readcharfun
, radix
)
2247 Lisp_Object readcharfun
;
2250 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2251 EMACS_INT number
= 0;
2253 if (radix
< 2 || radix
> 36)
2257 number
= ndigits
= invalid_p
= 0;
2273 if (c
>= '0' && c
<= '9')
2275 else if (c
>= 'a' && c
<= 'z')
2276 digit
= c
- 'a' + 10;
2277 else if (c
>= 'A' && c
<= 'Z')
2278 digit
= c
- 'A' + 10;
2285 if (digit
< 0 || digit
>= radix
)
2288 number
= radix
* number
+ digit
;
2294 if (ndigits
== 0 || invalid_p
)
2297 sprintf (buf
, "integer, radix %d", radix
);
2298 invalid_syntax (buf
, 0);
2301 return make_number (sign
* number
);
2305 /* If the next token is ')' or ']' or '.', we store that character
2306 in *PCH and the return value is not interesting. Else, we store
2307 zero in *PCH and we read and return one lisp object.
2309 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2312 read1 (readcharfun
, pch
, first_in_list
)
2313 register Lisp_Object readcharfun
;
2318 int uninterned_symbol
= 0;
2326 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2328 end_of_file_error ();
2333 return read_list (0, readcharfun
);
2336 return read_vector (readcharfun
, 0);
2353 tmp
= read_vector (readcharfun
, 0);
2354 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2355 error ("Invalid size char-table");
2356 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2367 tmp
= read_vector (readcharfun
, 0);
2368 if (!INTEGERP (AREF (tmp
, 0)))
2369 error ("Invalid depth in char-table");
2370 depth
= XINT (AREF (tmp
, 0));
2371 if (depth
< 1 || depth
> 3)
2372 error ("Invalid depth in char-table");
2373 size
= XVECTOR (tmp
)->size
- 2;
2374 if (chartab_size
[depth
] != size
)
2375 error ("Invalid size char-table");
2376 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2379 invalid_syntax ("#^^", 3);
2381 invalid_syntax ("#^", 2);
2386 length
= read1 (readcharfun
, pch
, first_in_list
);
2390 Lisp_Object tmp
, val
;
2392 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2393 / BOOL_VECTOR_BITS_PER_CHAR
);
2396 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2397 if (STRING_MULTIBYTE (tmp
)
2398 || (size_in_chars
!= SCHARS (tmp
)
2399 /* We used to print 1 char too many
2400 when the number of bits was a multiple of 8.
2401 Accept such input in case it came from an old
2403 && ! (XFASTINT (length
)
2404 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2405 invalid_syntax ("#&...", 5);
2407 val
= Fmake_bool_vector (length
, Qnil
);
2408 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2410 /* Clear the extraneous bits in the last byte. */
2411 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2412 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2413 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2416 invalid_syntax ("#&...", 5);
2420 /* Accept compiled functions at read-time so that we don't have to
2421 build them using function calls. */
2423 tmp
= read_vector (readcharfun
, 1);
2424 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2425 XVECTOR (tmp
)->contents
);
2430 struct gcpro gcpro1
;
2433 /* Read the string itself. */
2434 tmp
= read1 (readcharfun
, &ch
, 0);
2435 if (ch
!= 0 || !STRINGP (tmp
))
2436 invalid_syntax ("#", 1);
2438 /* Read the intervals and their properties. */
2441 Lisp_Object beg
, end
, plist
;
2443 beg
= read1 (readcharfun
, &ch
, 0);
2448 end
= read1 (readcharfun
, &ch
, 0);
2450 plist
= read1 (readcharfun
, &ch
, 0);
2452 invalid_syntax ("Invalid string property list", 0);
2453 Fset_text_properties (beg
, end
, plist
, tmp
);
2459 /* #@NUMBER is used to skip NUMBER following characters.
2460 That's used in .elc files to skip over doc strings
2461 and function definitions. */
2467 /* Read a decimal integer. */
2468 while ((c
= READCHAR
) >= 0
2469 && c
>= '0' && c
<= '9')
2477 if (load_force_doc_strings
2478 && (EQ (readcharfun
, Qget_file_char
)
2479 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2481 /* If we are supposed to force doc strings into core right now,
2482 record the last string that we skipped,
2483 and record where in the file it comes from. */
2485 /* But first exchange saved_doc_string
2486 with prev_saved_doc_string, so we save two strings. */
2488 char *temp
= saved_doc_string
;
2489 int temp_size
= saved_doc_string_size
;
2490 file_offset temp_pos
= saved_doc_string_position
;
2491 int temp_len
= saved_doc_string_length
;
2493 saved_doc_string
= prev_saved_doc_string
;
2494 saved_doc_string_size
= prev_saved_doc_string_size
;
2495 saved_doc_string_position
= prev_saved_doc_string_position
;
2496 saved_doc_string_length
= prev_saved_doc_string_length
;
2498 prev_saved_doc_string
= temp
;
2499 prev_saved_doc_string_size
= temp_size
;
2500 prev_saved_doc_string_position
= temp_pos
;
2501 prev_saved_doc_string_length
= temp_len
;
2504 if (saved_doc_string_size
== 0)
2506 saved_doc_string_size
= nskip
+ 100;
2507 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2509 if (nskip
> saved_doc_string_size
)
2511 saved_doc_string_size
= nskip
+ 100;
2512 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2513 saved_doc_string_size
);
2516 saved_doc_string_position
= file_tell (instream
);
2518 /* Copy that many characters into saved_doc_string. */
2519 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2520 saved_doc_string
[i
] = c
= READCHAR
;
2522 saved_doc_string_length
= i
;
2526 /* Skip that many characters. */
2527 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2536 /* #! appears at the beginning of an executable file.
2537 Skip the first line. */
2538 while (c
!= '\n' && c
>= 0)
2543 return Vload_file_name
;
2545 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2546 /* #:foo is the uninterned symbol named foo. */
2549 uninterned_symbol
= 1;
2553 /* Reader forms that can reuse previously read objects. */
2554 if (c
>= '0' && c
<= '9')
2559 /* Read a non-negative integer. */
2560 while (c
>= '0' && c
<= '9')
2566 /* #n=object returns object, but associates it with n for #n#. */
2569 /* Make a placeholder for #n# to use temporarily */
2570 Lisp_Object placeholder
;
2573 placeholder
= Fcons(Qnil
, Qnil
);
2574 cell
= Fcons (make_number (n
), placeholder
);
2575 read_objects
= Fcons (cell
, read_objects
);
2577 /* Read the object itself. */
2578 tem
= read0 (readcharfun
);
2580 /* Now put it everywhere the placeholder was... */
2581 substitute_object_in_subtree (tem
, placeholder
);
2583 /* ...and #n# will use the real value from now on. */
2584 Fsetcdr (cell
, tem
);
2588 /* #n# returns a previously read object. */
2591 tem
= Fassq (make_number (n
), read_objects
);
2594 /* Fall through to error message. */
2596 else if (c
== 'r' || c
== 'R')
2597 return read_integer (readcharfun
, n
);
2599 /* Fall through to error message. */
2601 else if (c
== 'x' || c
== 'X')
2602 return read_integer (readcharfun
, 16);
2603 else if (c
== 'o' || c
== 'O')
2604 return read_integer (readcharfun
, 8);
2605 else if (c
== 'b' || c
== 'B')
2606 return read_integer (readcharfun
, 2);
2609 invalid_syntax ("#", 1);
2612 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2617 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2623 Vold_style_backquotes
= Qt
;
2630 new_backquote_flag
++;
2631 value
= read0 (readcharfun
);
2632 new_backquote_flag
--;
2634 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2638 if (new_backquote_flag
)
2640 Lisp_Object comma_type
= Qnil
;
2645 comma_type
= Qcomma_at
;
2647 comma_type
= Qcomma_dot
;
2650 if (ch
>= 0) UNREAD (ch
);
2651 comma_type
= Qcomma
;
2654 new_backquote_flag
--;
2655 value
= read0 (readcharfun
);
2656 new_backquote_flag
++;
2657 return Fcons (comma_type
, Fcons (value
, Qnil
));
2661 Vold_style_backquotes
= Qt
;
2673 end_of_file_error ();
2675 /* Accept `single space' syntax like (list ? x) where the
2676 whitespace character is SPC or TAB.
2677 Other literal whitespace like NL, CR, and FF are not accepted,
2678 as there are well-established escape sequences for these. */
2679 if (c
== ' ' || c
== '\t')
2680 return make_number (c
);
2683 c
= read_escape (readcharfun
, 0);
2684 modifiers
= c
& CHAR_MODIFIER_MASK
;
2685 c
&= ~CHAR_MODIFIER_MASK
;
2686 if (CHAR_BYTE8_P (c
))
2687 c
= CHAR_TO_BYTE8 (c
);
2690 next_char
= READCHAR
;
2691 if (next_char
== '.')
2693 /* Only a dotted-pair dot is valid after a char constant. */
2694 int next_next_char
= READCHAR
;
2695 UNREAD (next_next_char
);
2697 ok
= (next_next_char
<= 040
2698 || (next_next_char
< 0200
2699 && (index ("\"';([#?", next_next_char
)
2700 || (!first_in_list
&& next_next_char
== '`')
2701 || (new_backquote_flag
&& next_next_char
== ','))));
2705 ok
= (next_char
<= 040
2706 || (next_char
< 0200
2707 && (index ("\"';()[]#?", next_char
)
2708 || (!first_in_list
&& next_char
== '`')
2709 || (new_backquote_flag
&& next_char
== ','))));
2713 return make_number (c
);
2715 invalid_syntax ("?", 1);
2720 char *p
= read_buffer
;
2721 char *end
= read_buffer
+ read_buffer_size
;
2723 /* Nonzero if we saw an escape sequence specifying
2724 a multibyte character. */
2725 int force_multibyte
= 0;
2726 /* Nonzero if we saw an escape sequence specifying
2727 a single-byte character. */
2728 int force_singlebyte
= 0;
2732 while ((c
= READCHAR
) >= 0
2735 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2737 int offset
= p
- read_buffer
;
2738 read_buffer
= (char *) xrealloc (read_buffer
,
2739 read_buffer_size
*= 2);
2740 p
= read_buffer
+ offset
;
2741 end
= read_buffer
+ read_buffer_size
;
2748 c
= read_escape (readcharfun
, 1);
2750 /* C is -1 if \ newline has just been seen */
2753 if (p
== read_buffer
)
2758 modifiers
= c
& CHAR_MODIFIER_MASK
;
2759 c
= c
& ~CHAR_MODIFIER_MASK
;
2761 if (CHAR_BYTE8_P (c
))
2762 force_singlebyte
= 1;
2763 else if (! ASCII_CHAR_P (c
))
2764 force_multibyte
= 1;
2765 else /* i.e. ASCII_CHAR_P (c) */
2767 /* Allow `\C- ' and `\C-?'. */
2768 if (modifiers
== CHAR_CTL
)
2771 c
= 0, modifiers
= 0;
2773 c
= 127, modifiers
= 0;
2775 if (modifiers
& CHAR_SHIFT
)
2777 /* Shift modifier is valid only with [A-Za-z]. */
2778 if (c
>= 'A' && c
<= 'Z')
2779 modifiers
&= ~CHAR_SHIFT
;
2780 else if (c
>= 'a' && c
<= 'z')
2781 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2784 if (modifiers
& CHAR_META
)
2786 /* Move the meta bit to the right place for a
2788 modifiers
&= ~CHAR_META
;
2789 c
= BYTE8_TO_CHAR (c
| 0x80);
2790 force_singlebyte
= 1;
2794 /* Any modifiers remaining are invalid. */
2796 error ("Invalid modifier in string");
2797 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2801 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2802 if (CHAR_BYTE8_P (c
))
2803 force_singlebyte
= 1;
2804 else if (! ASCII_CHAR_P (c
))
2805 force_multibyte
= 1;
2811 end_of_file_error ();
2813 /* If purifying, and string starts with \ newline,
2814 return zero instead. This is for doc strings
2815 that we are really going to find in etc/DOC.nn.nn */
2816 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2817 return make_number (0);
2819 if (force_multibyte
)
2820 /* READ_BUFFER already contains valid multibyte forms. */
2822 else if (force_singlebyte
)
2824 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2825 p
= read_buffer
+ nchars
;
2828 /* Otherwise, READ_BUFFER contains only ASCII. */
2831 /* We want readchar_count to be the number of characters, not
2832 bytes. Hence we adjust for multibyte characters in the
2833 string. ... But it doesn't seem to be necessary, because
2834 READCHAR *does* read multibyte characters from buffers. */
2835 /* readchar_count -= (p - read_buffer) - nchars; */
2837 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2839 || (p
- read_buffer
!= nchars
)));
2840 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2842 || (p
- read_buffer
!= nchars
)));
2847 int next_char
= READCHAR
;
2850 if (next_char
<= 040
2851 || (next_char
< 0200
2852 && (index ("\"';([#?", next_char
)
2853 || (!first_in_list
&& next_char
== '`')
2854 || (new_backquote_flag
&& next_char
== ','))))
2860 /* Otherwise, we fall through! Note that the atom-reading loop
2861 below will now loop at least once, assuring that we will not
2862 try to UNREAD two characters in a row. */
2866 if (c
<= 040) goto retry
;
2867 if (c
== 0x8a0) /* NBSP */
2870 char *p
= read_buffer
;
2874 char *end
= read_buffer
+ read_buffer_size
;
2877 && c
!= 0x8a0 /* NBSP */
2879 || (!index ("\"';()[]#", c
)
2880 && !(!first_in_list
&& c
== '`')
2881 && !(new_backquote_flag
&& c
== ','))))
2883 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2885 int offset
= p
- read_buffer
;
2886 read_buffer
= (char *) xrealloc (read_buffer
,
2887 read_buffer_size
*= 2);
2888 p
= read_buffer
+ offset
;
2889 end
= read_buffer
+ read_buffer_size
;
2896 end_of_file_error ();
2901 p
+= CHAR_STRING (c
, p
);
2909 int offset
= p
- read_buffer
;
2910 read_buffer
= (char *) xrealloc (read_buffer
,
2911 read_buffer_size
*= 2);
2912 p
= read_buffer
+ offset
;
2913 end
= read_buffer
+ read_buffer_size
;
2920 if (!quoted
&& !uninterned_symbol
)
2923 register Lisp_Object val
;
2925 if (*p1
== '+' || *p1
== '-') p1
++;
2926 /* Is it an integer? */
2929 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2930 /* Integers can have trailing decimal points. */
2931 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2933 /* It is an integer. */
2937 /* Fixme: if we have strtol, use that, and check
2939 if (sizeof (int) == sizeof (EMACS_INT
))
2940 XSETINT (val
, atoi (read_buffer
));
2941 else if (sizeof (long) == sizeof (EMACS_INT
))
2942 XSETINT (val
, atol (read_buffer
));
2948 if (isfloat_string (read_buffer
))
2950 /* Compute NaN and infinities using 0.0 in a variable,
2951 to cope with compilers that think they are smarter
2957 /* Negate the value ourselves. This treats 0, NaNs,
2958 and infinity properly on IEEE floating point hosts,
2959 and works around a common bug where atof ("-0.0")
2961 int negative
= read_buffer
[0] == '-';
2963 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2964 returns 1, is if the input ends in e+INF or e+NaN. */
2971 value
= zero
/ zero
;
2973 /* If that made a "negative" NaN, negate it. */
2977 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2980 u_minus_zero
.d
= - 0.0;
2981 for (i
= 0; i
< sizeof (double); i
++)
2982 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2988 /* Now VALUE is a positive NaN. */
2991 value
= atof (read_buffer
+ negative
);
2995 return make_float (negative
? - value
: value
);
2999 Lisp_Object name
, result
;
3000 EMACS_INT nbytes
= p
- read_buffer
;
3002 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3005 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3006 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3008 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3009 result
= (uninterned_symbol
? Fmake_symbol (name
)
3010 : Fintern (name
, Qnil
));
3012 if (EQ (Vread_with_symbol_positions
, Qt
)
3013 || EQ (Vread_with_symbol_positions
, readcharfun
))
3014 Vread_symbol_positions_list
=
3015 /* Kind of a hack; this will probably fail if characters
3016 in the symbol name were escaped. Not really a big
3018 Fcons (Fcons (result
,
3019 make_number (readchar_count
3020 - XFASTINT (Flength (Fsymbol_name (result
))))),
3021 Vread_symbol_positions_list
);
3029 /* List of nodes we've seen during substitute_object_in_subtree. */
3030 static Lisp_Object seen_list
;
3033 substitute_object_in_subtree (object
, placeholder
)
3035 Lisp_Object placeholder
;
3037 Lisp_Object check_object
;
3039 /* We haven't seen any objects when we start. */
3042 /* Make all the substitutions. */
3044 = substitute_object_recurse (object
, placeholder
, object
);
3046 /* Clear seen_list because we're done with it. */
3049 /* The returned object here is expected to always eq the
3051 if (!EQ (check_object
, object
))
3052 error ("Unexpected mutation error in reader");
3055 /* Feval doesn't get called from here, so no gc protection is needed. */
3056 #define SUBSTITUTE(get_val, set_val) \
3058 Lisp_Object old_value = get_val; \
3059 Lisp_Object true_value \
3060 = substitute_object_recurse (object, placeholder, \
3063 if (!EQ (old_value, true_value)) \
3070 substitute_object_recurse (object
, placeholder
, subtree
)
3072 Lisp_Object placeholder
;
3073 Lisp_Object subtree
;
3075 /* If we find the placeholder, return the target object. */
3076 if (EQ (placeholder
, subtree
))
3079 /* If we've been to this node before, don't explore it again. */
3080 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3083 /* If this node can be the entry point to a cycle, remember that
3084 we've seen it. It can only be such an entry point if it was made
3085 by #n=, which means that we can find it as a value in
3087 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3088 seen_list
= Fcons (subtree
, seen_list
);
3090 /* Recurse according to subtree's type.
3091 Every branch must return a Lisp_Object. */
3092 switch (XTYPE (subtree
))
3094 case Lisp_Vectorlike
:
3097 if (BOOL_VECTOR_P (subtree
))
3098 return subtree
; /* No sub-objects anyway. */
3099 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3100 || COMPILEDP (subtree
))
3101 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3102 else if (VECTORP (subtree
))
3103 length
= ASIZE (subtree
);
3105 /* An unknown pseudovector may contain non-Lisp fields, so we
3106 can't just blindly traverse all its fields. We used to call
3107 `Flength' which signalled `sequencep', so I just preserved this
3109 wrong_type_argument (Qsequencep
, subtree
);
3111 for (i
= 0; i
< length
; i
++)
3112 SUBSTITUTE (AREF (subtree
, i
),
3113 ASET (subtree
, i
, true_value
));
3119 SUBSTITUTE (XCAR (subtree
),
3120 XSETCAR (subtree
, true_value
));
3121 SUBSTITUTE (XCDR (subtree
),
3122 XSETCDR (subtree
, true_value
));
3128 /* Check for text properties in each interval.
3129 substitute_in_interval contains part of the logic. */
3131 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3132 Lisp_Object arg
= Fcons (object
, placeholder
);
3134 traverse_intervals_noorder (root_interval
,
3135 &substitute_in_interval
, arg
);
3140 /* Other types don't recurse any further. */
3146 /* Helper function for substitute_object_recurse. */
3148 substitute_in_interval (interval
, arg
)
3152 Lisp_Object object
= Fcar (arg
);
3153 Lisp_Object placeholder
= Fcdr (arg
);
3155 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3174 if (*cp
== '+' || *cp
== '-')
3177 if (*cp
>= '0' && *cp
<= '9')
3180 while (*cp
>= '0' && *cp
<= '9')
3188 if (*cp
>= '0' && *cp
<= '9')
3191 while (*cp
>= '0' && *cp
<= '9')
3194 if (*cp
== 'e' || *cp
== 'E')
3198 if (*cp
== '+' || *cp
== '-')
3202 if (*cp
>= '0' && *cp
<= '9')
3205 while (*cp
>= '0' && *cp
<= '9')
3208 else if (cp
== start
)
3210 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3215 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3221 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3222 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3223 || state
== (DOT_CHAR
|TRAIL_INT
)
3224 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3225 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3226 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3231 read_vector (readcharfun
, bytecodeflag
)
3232 Lisp_Object readcharfun
;
3237 register Lisp_Object
*ptr
;
3238 register Lisp_Object tem
, item
, vector
;
3239 register struct Lisp_Cons
*otem
;
3242 tem
= read_list (1, readcharfun
);
3243 len
= Flength (tem
);
3244 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3246 size
= XVECTOR (vector
)->size
;
3247 ptr
= XVECTOR (vector
)->contents
;
3248 for (i
= 0; i
< size
; i
++)
3251 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3252 bytecode object, the docstring containing the bytecode and
3253 constants values must be treated as unibyte and passed to
3254 Fread, to get the actual bytecode string and constants vector. */
3255 if (bytecodeflag
&& load_force_doc_strings
)
3257 if (i
== COMPILED_BYTECODE
)
3259 if (!STRINGP (item
))
3260 error ("Invalid byte code");
3262 /* Delay handling the bytecode slot until we know whether
3263 it is lazily-loaded (we can tell by whether the
3264 constants slot is nil). */
3265 ptr
[COMPILED_CONSTANTS
] = item
;
3268 else if (i
== COMPILED_CONSTANTS
)
3270 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3274 /* Coerce string to unibyte (like string-as-unibyte,
3275 but without generating extra garbage and
3276 guaranteeing no change in the contents). */
3277 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3278 STRING_SET_UNIBYTE (bytestr
);
3280 item
= Fread (Fcons (bytestr
, readcharfun
));
3282 error ("Invalid byte code");
3284 otem
= XCONS (item
);
3285 bytestr
= XCAR (item
);
3290 /* Now handle the bytecode slot. */
3291 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3293 else if (i
== COMPILED_DOC_STRING
3295 && ! STRING_MULTIBYTE (item
))
3297 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3298 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3300 item
= Fstring_as_multibyte (item
);
3303 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3311 /* FLAG = 1 means check for ] to terminate rather than ) and .
3312 FLAG = -1 means check for starting with defun
3313 and make structure pure. */
3316 read_list (flag
, readcharfun
)
3318 register Lisp_Object readcharfun
;
3320 /* -1 means check next element for defun,
3321 0 means don't check,
3322 1 means already checked and found defun. */
3323 int defunflag
= flag
< 0 ? -1 : 0;
3324 Lisp_Object val
, tail
;
3325 register Lisp_Object elt
, tem
;
3326 struct gcpro gcpro1
, gcpro2
;
3327 /* 0 is the normal case.
3328 1 means this list is a doc reference; replace it with the number 0.
3329 2 means this list is a doc reference; replace it with the doc string. */
3330 int doc_reference
= 0;
3332 /* Initialize this to 1 if we are reading a list. */
3333 int first_in_list
= flag
<= 0;
3342 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3347 /* While building, if the list starts with #$, treat it specially. */
3348 if (EQ (elt
, Vload_file_name
)
3350 && !NILP (Vpurify_flag
))
3352 if (NILP (Vdoc_file_name
))
3353 /* We have not yet called Snarf-documentation, so assume
3354 this file is described in the DOC-MM.NN file
3355 and Snarf-documentation will fill in the right value later.
3356 For now, replace the whole list with 0. */
3359 /* We have already called Snarf-documentation, so make a relative
3360 file name for this file, so it can be found properly
3361 in the installed Lisp directory.
3362 We don't use Fexpand_file_name because that would make
3363 the directory absolute now. */
3364 elt
= concat2 (build_string ("../lisp/"),
3365 Ffile_name_nondirectory (elt
));
3367 else if (EQ (elt
, Vload_file_name
)
3369 && load_force_doc_strings
)
3378 invalid_syntax (") or . in a vector", 18);
3386 XSETCDR (tail
, read0 (readcharfun
));
3388 val
= read0 (readcharfun
);
3389 read1 (readcharfun
, &ch
, 0);
3393 if (doc_reference
== 1)
3394 return make_number (0);
3395 if (doc_reference
== 2)
3397 /* Get a doc string from the file we are loading.
3398 If it's in saved_doc_string, get it from there.
3400 Here, we don't know if the string is a
3401 bytecode string or a doc string. As a
3402 bytecode string must be unibyte, we always
3403 return a unibyte string. If it is actually a
3404 doc string, caller must make it
3407 int pos
= XINT (XCDR (val
));
3408 /* Position is negative for user variables. */
3409 if (pos
< 0) pos
= -pos
;
3410 if (pos
>= saved_doc_string_position
3411 && pos
< (saved_doc_string_position
3412 + saved_doc_string_length
))
3414 int start
= pos
- saved_doc_string_position
;
3417 /* Process quoting with ^A,
3418 and find the end of the string,
3419 which is marked with ^_ (037). */
3420 for (from
= start
, to
= start
;
3421 saved_doc_string
[from
] != 037;)
3423 int c
= saved_doc_string
[from
++];
3426 c
= saved_doc_string
[from
++];
3428 saved_doc_string
[to
++] = c
;
3430 saved_doc_string
[to
++] = 0;
3432 saved_doc_string
[to
++] = 037;
3435 saved_doc_string
[to
++] = c
;
3438 return make_unibyte_string (saved_doc_string
+ start
,
3441 /* Look in prev_saved_doc_string the same way. */
3442 else if (pos
>= prev_saved_doc_string_position
3443 && pos
< (prev_saved_doc_string_position
3444 + prev_saved_doc_string_length
))
3446 int start
= pos
- prev_saved_doc_string_position
;
3449 /* Process quoting with ^A,
3450 and find the end of the string,
3451 which is marked with ^_ (037). */
3452 for (from
= start
, to
= start
;
3453 prev_saved_doc_string
[from
] != 037;)
3455 int c
= prev_saved_doc_string
[from
++];
3458 c
= prev_saved_doc_string
[from
++];
3460 prev_saved_doc_string
[to
++] = c
;
3462 prev_saved_doc_string
[to
++] = 0;
3464 prev_saved_doc_string
[to
++] = 037;
3467 prev_saved_doc_string
[to
++] = c
;
3470 return make_unibyte_string (prev_saved_doc_string
3475 return get_doc_string (val
, 1, 0);
3480 invalid_syntax (". in wrong context", 18);
3482 invalid_syntax ("] in a list", 11);
3484 tem
= (read_pure
&& flag
<= 0
3485 ? pure_cons (elt
, Qnil
)
3486 : Fcons (elt
, Qnil
));
3488 XSETCDR (tail
, tem
);
3493 defunflag
= EQ (elt
, Qdefun
);
3494 else if (defunflag
> 0)
3499 Lisp_Object Vobarray
;
3500 Lisp_Object initial_obarray
;
3502 /* oblookup stores the bucket number here, for the sake of Funintern. */
3504 int oblookup_last_bucket_number
;
3506 static int hash_string ();
3508 /* Get an error if OBARRAY is not an obarray.
3509 If it is one, return it. */
3512 check_obarray (obarray
)
3513 Lisp_Object obarray
;
3515 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3517 /* If Vobarray is now invalid, force it to be valid. */
3518 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3519 wrong_type_argument (Qvectorp
, obarray
);
3524 /* Intern the C string STR: return a symbol with that name,
3525 interned in the current obarray. */
3532 int len
= strlen (str
);
3533 Lisp_Object obarray
;
3536 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3537 obarray
= check_obarray (obarray
);
3538 tem
= oblookup (obarray
, str
, len
, len
);
3541 return Fintern (make_string (str
, len
), obarray
);
3544 /* Create an uninterned symbol with name STR. */
3550 int len
= strlen (str
);
3552 return Fmake_symbol ((!NILP (Vpurify_flag
)
3553 ? make_pure_string (str
, len
, len
, 0)
3554 : make_string (str
, len
)));
3557 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3558 doc
: /* Return the canonical symbol whose name is STRING.
3559 If there is none, one is created by this function and returned.
3560 A second optional argument specifies the obarray to use;
3561 it defaults to the value of `obarray'. */)
3563 Lisp_Object string
, obarray
;
3565 register Lisp_Object tem
, sym
, *ptr
;
3567 if (NILP (obarray
)) obarray
= Vobarray
;
3568 obarray
= check_obarray (obarray
);
3570 CHECK_STRING (string
);
3572 tem
= oblookup (obarray
, SDATA (string
),
3575 if (!INTEGERP (tem
))
3578 if (!NILP (Vpurify_flag
))
3579 string
= Fpurecopy (string
);
3580 sym
= Fmake_symbol (string
);
3582 if (EQ (obarray
, initial_obarray
))
3583 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3585 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3587 if ((SREF (string
, 0) == ':')
3588 && EQ (obarray
, initial_obarray
))
3590 XSYMBOL (sym
)->constant
= 1;
3591 XSYMBOL (sym
)->value
= sym
;
3594 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3596 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3598 XSYMBOL (sym
)->next
= 0;
3603 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3604 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3605 NAME may be a string or a symbol. If it is a symbol, that exact
3606 symbol is searched for.
3607 A second optional argument specifies the obarray to use;
3608 it defaults to the value of `obarray'. */)
3610 Lisp_Object name
, obarray
;
3612 register Lisp_Object tem
, string
;
3614 if (NILP (obarray
)) obarray
= Vobarray
;
3615 obarray
= check_obarray (obarray
);
3617 if (!SYMBOLP (name
))
3619 CHECK_STRING (name
);
3623 string
= SYMBOL_NAME (name
);
3625 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3626 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3632 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3633 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3634 The value is t if a symbol was found and deleted, nil otherwise.
3635 NAME may be a string or a symbol. If it is a symbol, that symbol
3636 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3637 OBARRAY defaults to the value of the variable `obarray'. */)
3639 Lisp_Object name
, obarray
;
3641 register Lisp_Object string
, tem
;
3644 if (NILP (obarray
)) obarray
= Vobarray
;
3645 obarray
= check_obarray (obarray
);
3648 string
= SYMBOL_NAME (name
);
3651 CHECK_STRING (name
);
3655 tem
= oblookup (obarray
, SDATA (string
),
3660 /* If arg was a symbol, don't delete anything but that symbol itself. */
3661 if (SYMBOLP (name
) && !EQ (name
, tem
))
3664 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3665 XSYMBOL (tem
)->constant
= 0;
3666 XSYMBOL (tem
)->indirect_variable
= 0;
3668 hash
= oblookup_last_bucket_number
;
3670 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3672 if (XSYMBOL (tem
)->next
)
3673 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3675 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3679 Lisp_Object tail
, following
;
3681 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3682 XSYMBOL (tail
)->next
;
3685 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3686 if (EQ (following
, tem
))
3688 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3697 /* Return the symbol in OBARRAY whose names matches the string
3698 of SIZE characters (SIZE_BYTE bytes) at PTR.
3699 If there is no such symbol in OBARRAY, return nil.
3701 Also store the bucket number in oblookup_last_bucket_number. */
3704 oblookup (obarray
, ptr
, size
, size_byte
)
3705 Lisp_Object obarray
;
3706 register const char *ptr
;
3707 int size
, size_byte
;
3711 register Lisp_Object tail
;
3712 Lisp_Object bucket
, tem
;
3714 if (!VECTORP (obarray
)
3715 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3717 obarray
= check_obarray (obarray
);
3718 obsize
= XVECTOR (obarray
)->size
;
3720 /* This is sometimes needed in the middle of GC. */
3721 obsize
&= ~ARRAY_MARK_FLAG
;
3722 /* Combining next two lines breaks VMS C 2.3. */
3723 hash
= hash_string (ptr
, size_byte
);
3725 bucket
= XVECTOR (obarray
)->contents
[hash
];
3726 oblookup_last_bucket_number
= hash
;
3727 if (EQ (bucket
, make_number (0)))
3729 else if (!SYMBOLP (bucket
))
3730 error ("Bad data in guts of obarray"); /* Like CADR error message */
3732 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3734 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3735 && SCHARS (SYMBOL_NAME (tail
)) == size
3736 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3738 else if (XSYMBOL (tail
)->next
== 0)
3741 XSETINT (tem
, hash
);
3746 hash_string (ptr
, len
)
3747 const unsigned char *ptr
;
3750 register const unsigned char *p
= ptr
;
3751 register const unsigned char *end
= p
+ len
;
3752 register unsigned char c
;
3753 register int hash
= 0;
3758 if (c
>= 0140) c
-= 40;
3759 hash
= ((hash
<<3) + (hash
>>28) + c
);
3761 return hash
& 07777777777;
3765 map_obarray (obarray
, fn
, arg
)
3766 Lisp_Object obarray
;
3767 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3771 register Lisp_Object tail
;
3772 CHECK_VECTOR (obarray
);
3773 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3775 tail
= XVECTOR (obarray
)->contents
[i
];
3780 if (XSYMBOL (tail
)->next
== 0)
3782 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3788 mapatoms_1 (sym
, function
)
3789 Lisp_Object sym
, function
;
3791 call1 (function
, sym
);
3794 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3795 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3796 OBARRAY defaults to the value of `obarray'. */)
3798 Lisp_Object function
, obarray
;
3800 if (NILP (obarray
)) obarray
= Vobarray
;
3801 obarray
= check_obarray (obarray
);
3803 map_obarray (obarray
, mapatoms_1
, function
);
3807 #define OBARRAY_SIZE 1511
3812 Lisp_Object oblength
;
3816 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3818 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3819 Vobarray
= Fmake_vector (oblength
, make_number (0));
3820 initial_obarray
= Vobarray
;
3821 staticpro (&initial_obarray
);
3822 /* Intern nil in the obarray */
3823 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3824 XSYMBOL (Qnil
)->constant
= 1;
3826 /* These locals are to kludge around a pyramid compiler bug. */
3827 hash
= hash_string ("nil", 3);
3828 /* Separate statement here to avoid VAXC bug. */
3829 hash
%= OBARRAY_SIZE
;
3830 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3833 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3834 XSYMBOL (Qnil
)->function
= Qunbound
;
3835 XSYMBOL (Qunbound
)->value
= Qunbound
;
3836 XSYMBOL (Qunbound
)->function
= Qunbound
;
3839 XSYMBOL (Qnil
)->value
= Qnil
;
3840 XSYMBOL (Qnil
)->plist
= Qnil
;
3841 XSYMBOL (Qt
)->value
= Qt
;
3842 XSYMBOL (Qt
)->constant
= 1;
3844 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3847 Qvariable_documentation
= intern ("variable-documentation");
3848 staticpro (&Qvariable_documentation
);
3850 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3851 read_buffer
= (char *) xmalloc (read_buffer_size
);
3856 struct Lisp_Subr
*sname
;
3859 sym
= intern (sname
->symbol_name
);
3860 XSETPVECTYPE (sname
, PVEC_SUBR
);
3861 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3864 #ifdef NOTDEF /* use fset in subr.el now */
3866 defalias (sname
, string
)
3867 struct Lisp_Subr
*sname
;
3871 sym
= intern (string
);
3872 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3876 /* Define an "integer variable"; a symbol whose value is forwarded
3877 to a C variable of type int. Sample call:
3878 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3880 defvar_int (namestring
, address
)
3884 Lisp_Object sym
, val
;
3885 sym
= intern (namestring
);
3886 val
= allocate_misc ();
3887 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3888 XINTFWD (val
)->intvar
= address
;
3889 SET_SYMBOL_VALUE (sym
, val
);
3892 /* Similar but define a variable whose value is t if address contains 1,
3893 nil if address contains 0. */
3895 defvar_bool (namestring
, address
)
3899 Lisp_Object sym
, val
;
3900 sym
= intern (namestring
);
3901 val
= allocate_misc ();
3902 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3903 XBOOLFWD (val
)->boolvar
= address
;
3904 SET_SYMBOL_VALUE (sym
, val
);
3905 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3908 /* Similar but define a variable whose value is the Lisp Object stored
3909 at address. Two versions: with and without gc-marking of the C
3910 variable. The nopro version is used when that variable will be
3911 gc-marked for some other reason, since marking the same slot twice
3912 can cause trouble with strings. */
3914 defvar_lisp_nopro (namestring
, address
)
3916 Lisp_Object
*address
;
3918 Lisp_Object sym
, val
;
3919 sym
= intern (namestring
);
3920 val
= allocate_misc ();
3921 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3922 XOBJFWD (val
)->objvar
= address
;
3923 SET_SYMBOL_VALUE (sym
, val
);
3927 defvar_lisp (namestring
, address
)
3929 Lisp_Object
*address
;
3931 defvar_lisp_nopro (namestring
, address
);
3932 staticpro (address
);
3935 /* Similar but define a variable whose value is the Lisp Object stored
3936 at a particular offset in the current kboard object. */
3939 defvar_kboard (namestring
, offset
)
3943 Lisp_Object sym
, val
;
3944 sym
= intern (namestring
);
3945 val
= allocate_misc ();
3946 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3947 XKBOARD_OBJFWD (val
)->offset
= offset
;
3948 SET_SYMBOL_VALUE (sym
, val
);
3951 /* Record the value of load-path used at the start of dumping
3952 so we can see if the site changed it later during dumping. */
3953 static Lisp_Object dump_path
;
3959 int turn_off_warning
= 0;
3961 /* Compute the default load-path. */
3963 normal
= PATH_LOADSEARCH
;
3964 Vload_path
= decode_env_path (0, normal
);
3966 if (NILP (Vpurify_flag
))
3967 normal
= PATH_LOADSEARCH
;
3969 normal
= PATH_DUMPLOADSEARCH
;
3971 /* In a dumped Emacs, we normally have to reset the value of
3972 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3973 uses ../lisp, instead of the path of the installed elisp
3974 libraries. However, if it appears that Vload_path was changed
3975 from the default before dumping, don't override that value. */
3978 if (! NILP (Fequal (dump_path
, Vload_path
)))
3980 Vload_path
= decode_env_path (0, normal
);
3981 if (!NILP (Vinstallation_directory
))
3983 Lisp_Object tem
, tem1
, sitelisp
;
3985 /* Remove site-lisp dirs from path temporarily and store
3986 them in sitelisp, then conc them on at the end so
3987 they're always first in path. */
3991 tem
= Fcar (Vload_path
);
3992 tem1
= Fstring_match (build_string ("site-lisp"),
3996 Vload_path
= Fcdr (Vload_path
);
3997 sitelisp
= Fcons (tem
, sitelisp
);
4003 /* Add to the path the lisp subdir of the
4004 installation dir, if it exists. */
4005 tem
= Fexpand_file_name (build_string ("lisp"),
4006 Vinstallation_directory
);
4007 tem1
= Ffile_exists_p (tem
);
4010 if (NILP (Fmember (tem
, Vload_path
)))
4012 turn_off_warning
= 1;
4013 Vload_path
= Fcons (tem
, Vload_path
);
4017 /* That dir doesn't exist, so add the build-time
4018 Lisp dirs instead. */
4019 Vload_path
= nconc2 (Vload_path
, dump_path
);
4021 /* Add leim under the installation dir, if it exists. */
4022 tem
= Fexpand_file_name (build_string ("leim"),
4023 Vinstallation_directory
);
4024 tem1
= Ffile_exists_p (tem
);
4027 if (NILP (Fmember (tem
, Vload_path
)))
4028 Vload_path
= Fcons (tem
, Vload_path
);
4031 /* Add site-lisp under the installation dir, if it exists. */
4032 tem
= Fexpand_file_name (build_string ("site-lisp"),
4033 Vinstallation_directory
);
4034 tem1
= Ffile_exists_p (tem
);
4037 if (NILP (Fmember (tem
, Vload_path
)))
4038 Vload_path
= Fcons (tem
, Vload_path
);
4041 /* If Emacs was not built in the source directory,
4042 and it is run from where it was built, add to load-path
4043 the lisp, leim and site-lisp dirs under that directory. */
4045 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4049 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4050 Vinstallation_directory
);
4051 tem1
= Ffile_exists_p (tem
);
4053 /* Don't be fooled if they moved the entire source tree
4054 AFTER dumping Emacs. If the build directory is indeed
4055 different from the source dir, src/Makefile.in and
4056 src/Makefile will not be found together. */
4057 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4058 Vinstallation_directory
);
4059 tem2
= Ffile_exists_p (tem
);
4060 if (!NILP (tem1
) && NILP (tem2
))
4062 tem
= Fexpand_file_name (build_string ("lisp"),
4065 if (NILP (Fmember (tem
, Vload_path
)))
4066 Vload_path
= Fcons (tem
, Vload_path
);
4068 tem
= Fexpand_file_name (build_string ("leim"),
4071 if (NILP (Fmember (tem
, Vload_path
)))
4072 Vload_path
= Fcons (tem
, Vload_path
);
4074 tem
= Fexpand_file_name (build_string ("site-lisp"),
4077 if (NILP (Fmember (tem
, Vload_path
)))
4078 Vload_path
= Fcons (tem
, Vload_path
);
4081 if (!NILP (sitelisp
))
4082 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4088 /* NORMAL refers to the lisp dir in the source directory. */
4089 /* We used to add ../lisp at the front here, but
4090 that caused trouble because it was copied from dump_path
4091 into Vload_path, above, when Vinstallation_directory was non-nil.
4092 It should be unnecessary. */
4093 Vload_path
= decode_env_path (0, normal
);
4094 dump_path
= Vload_path
;
4098 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
4099 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4100 almost never correct, thereby causing a warning to be printed out that
4101 confuses users. Since PATH_LOADSEARCH is always overridden by the
4102 EMACSLOADPATH environment variable below, disable the warning on NT.
4103 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
4104 the "standard" paths may not exist and would be overridden by
4105 EMACSLOADPATH as on NT. Since this depends on how the executable
4106 was build and packaged, turn off the warnings in general */
4108 /* Warn if dirs in the *standard* path don't exist. */
4109 if (!turn_off_warning
)
4111 Lisp_Object path_tail
;
4113 for (path_tail
= Vload_path
;
4115 path_tail
= XCDR (path_tail
))
4117 Lisp_Object dirfile
;
4118 dirfile
= Fcar (path_tail
);
4119 if (STRINGP (dirfile
))
4121 dirfile
= Fdirectory_file_name (dirfile
);
4122 if (access (SDATA (dirfile
), 0) < 0)
4123 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4128 #endif /* !(WINDOWSNT || HAVE_CARBON) */
4130 /* If the EMACSLOADPATH environment variable is set, use its value.
4131 This doesn't apply if we're dumping. */
4133 if (NILP (Vpurify_flag
)
4134 && egetenv ("EMACSLOADPATH"))
4136 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4140 load_in_progress
= 0;
4141 Vload_file_name
= Qnil
;
4143 load_descriptor_list
= Qnil
;
4145 Vstandard_input
= Qt
;
4146 Vloads_in_progress
= Qnil
;
4149 /* Print a warning, using format string FORMAT, that directory DIRNAME
4150 does not exist. Print it on stderr and put it in *Messages*. */
4153 dir_warning (format
, dirname
)
4155 Lisp_Object dirname
;
4158 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4160 fprintf (stderr
, format
, SDATA (dirname
));
4161 sprintf (buffer
, format
, SDATA (dirname
));
4162 /* Don't log the warning before we've initialized!! */
4164 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4171 defsubr (&Sread_from_string
);
4173 defsubr (&Sintern_soft
);
4174 defsubr (&Sunintern
);
4175 defsubr (&Sget_load_suffixes
);
4177 defsubr (&Seval_buffer
);
4178 defsubr (&Seval_region
);
4179 defsubr (&Sread_char
);
4180 defsubr (&Sread_char_exclusive
);
4181 defsubr (&Sread_event
);
4182 defsubr (&Sget_file_char
);
4183 defsubr (&Smapatoms
);
4184 defsubr (&Slocate_file_internal
);
4186 DEFVAR_LISP ("obarray", &Vobarray
,
4187 doc
: /* Symbol table for use by `intern' and `read'.
4188 It is a vector whose length ought to be prime for best results.
4189 The vector's contents don't make sense if examined from Lisp programs;
4190 to find all the symbols in an obarray, use `mapatoms'. */);
4192 DEFVAR_LISP ("values", &Vvalues
,
4193 doc
: /* List of values of all expressions which were read, evaluated and printed.
4194 Order is reverse chronological. */);
4196 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4197 doc
: /* Stream for read to get input from.
4198 See documentation of `read' for possible values. */);
4199 Vstandard_input
= Qt
;
4201 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4202 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4204 If this variable is a buffer, then only forms read from that buffer
4205 will be added to `read-symbol-positions-list'.
4206 If this variable is t, then all read forms will be added.
4207 The effect of all other values other than nil are not currently
4208 defined, although they may be in the future.
4210 The positions are relative to the last call to `read' or
4211 `read-from-string'. It is probably a bad idea to set this variable at
4212 the toplevel; bind it instead. */);
4213 Vread_with_symbol_positions
= Qnil
;
4215 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4216 doc
: /* A list mapping read symbols to their positions.
4217 This variable is modified during calls to `read' or
4218 `read-from-string', but only when `read-with-symbol-positions' is
4221 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4222 CHAR-POSITION is an integer giving the offset of that occurrence of the
4223 symbol from the position where `read' or `read-from-string' started.
4225 Note that a symbol will appear multiple times in this list, if it was
4226 read multiple times. The list is in the same order as the symbols
4228 Vread_symbol_positions_list
= Qnil
;
4230 DEFVAR_LISP ("load-path", &Vload_path
,
4231 doc
: /* *List of directories to search for files to load.
4232 Each element is a string (directory name) or nil (try default directory).
4233 Initialized based on EMACSLOADPATH environment variable, if any,
4234 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4236 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4237 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4238 This list should not include the empty string.
4239 `load' and related functions try to append these suffixes, in order,
4240 to the specified file name if a Lisp suffix is allowed or required. */);
4241 Vload_suffixes
= Fcons (build_string (".elc"),
4242 Fcons (build_string (".el"), Qnil
));
4243 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4244 doc
: /* List of suffixes that indicate representations of \
4246 This list should normally start with the empty string.
4248 Enabling Auto Compression mode appends the suffixes in
4249 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4250 mode removes them again. `load' and related functions use this list to
4251 determine whether they should look for compressed versions of a file
4252 and, if so, which suffixes they should try to append to the file name
4253 in order to do so. However, if you want to customize which suffixes
4254 the loading functions recognize as compression suffixes, you should
4255 customize `jka-compr-load-suffixes' rather than the present variable. */);
4256 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4258 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4259 doc
: /* Non-nil if inside of `load'. */);
4261 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4262 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4263 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4265 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4266 a symbol \(a feature name).
4268 When `load' is run and the file-name argument matches an element's
4269 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4270 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4272 An error in FORMS does not undo the load, but does prevent execution of
4273 the rest of the FORMS. */);
4274 Vafter_load_alist
= Qnil
;
4276 DEFVAR_LISP ("load-history", &Vload_history
,
4277 doc
: /* Alist mapping file names to symbols and features.
4278 Each alist element is a list that starts with a file name,
4279 except for one element (optional) that starts with nil and describes
4280 definitions evaluated from buffers not visiting files.
4282 The file name is absolute and is the true file name (i.e. it doesn't
4283 contain symbolic links) of the loaded file.
4285 The remaining elements of each list are symbols defined as variables
4286 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4287 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4288 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4289 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
4290 this file redefined it as a function.
4292 During preloading, the file name recorded is relative to the main Lisp
4293 directory. These file names are converted to absolute at startup. */);
4294 Vload_history
= Qnil
;
4296 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4297 doc
: /* Full name of file being loaded by `load'. */);
4298 Vload_file_name
= Qnil
;
4300 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4301 doc
: /* File name, including directory, of user's initialization file.
4302 If the file loaded had extension `.elc', and the corresponding source file
4303 exists, this variable contains the name of source file, suitable for use
4304 by functions like `custom-save-all' which edit the init file.
4305 While Emacs loads and evaluates the init file, value is the real name
4306 of the file, regardless of whether or not it has the `.elc' extension. */);
4307 Vuser_init_file
= Qnil
;
4309 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4310 doc
: /* Used for internal purposes by `load'. */);
4311 Vcurrent_load_list
= Qnil
;
4313 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4314 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4315 The default is nil, which means use the function `read'. */);
4316 Vload_read_function
= Qnil
;
4318 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4319 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4320 This function is for doing code conversion before reading the source file.
4321 If nil, loading is done without any code conversion.
4322 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4323 FULLNAME is the full name of FILE.
4324 See `load' for the meaning of the remaining arguments. */);
4325 Vload_source_file_function
= Qnil
;
4327 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4328 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4329 This is useful when the file being loaded is a temporary copy. */);
4330 load_force_doc_strings
= 0;
4332 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4333 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4334 This is normally bound by `load' and `eval-buffer' to control `read',
4335 and is not meant for users to change. */);
4336 load_convert_to_unibyte
= 0;
4338 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4339 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4340 You cannot count on them to still be there! */);
4342 = Fexpand_file_name (build_string ("../"),
4343 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4345 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4346 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4347 Vpreloaded_file_list
= Qnil
;
4349 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4350 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4351 Vbyte_boolean_vars
= Qnil
;
4353 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4354 doc
: /* Non-nil means load dangerous compiled Lisp files.
4355 Some versions of XEmacs use different byte codes than Emacs. These
4356 incompatible byte codes can make Emacs crash when it tries to execute
4358 load_dangerous_libraries
= 0;
4360 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4361 doc
: /* Regular expression matching safe to load compiled Lisp files.
4362 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4363 from the file, and matches them against this regular expression.
4364 When the regular expression matches, the file is considered to be safe
4365 to load. See also `load-dangerous-libraries'. */);
4366 Vbytecomp_version_regexp
4367 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4369 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4370 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4371 Veval_buffer_list
= Qnil
;
4373 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4374 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4375 Vold_style_backquotes
= Qnil
;
4376 Qold_style_backquotes
= intern ("old-style-backquotes");
4377 staticpro (&Qold_style_backquotes
);
4379 /* Vsource_directory was initialized in init_lread. */
4381 load_descriptor_list
= Qnil
;
4382 staticpro (&load_descriptor_list
);
4384 Qcurrent_load_list
= intern ("current-load-list");
4385 staticpro (&Qcurrent_load_list
);
4387 Qstandard_input
= intern ("standard-input");
4388 staticpro (&Qstandard_input
);
4390 Qread_char
= intern ("read-char");
4391 staticpro (&Qread_char
);
4393 Qget_file_char
= intern ("get-file-char");
4394 staticpro (&Qget_file_char
);
4396 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4397 staticpro (&Qget_emacs_mule_file_char
);
4399 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4400 staticpro (&Qload_force_doc_strings
);
4402 Qbackquote
= intern ("`");
4403 staticpro (&Qbackquote
);
4404 Qcomma
= intern (",");
4405 staticpro (&Qcomma
);
4406 Qcomma_at
= intern (",@");
4407 staticpro (&Qcomma_at
);
4408 Qcomma_dot
= intern (",.");
4409 staticpro (&Qcomma_dot
);
4411 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4412 staticpro (&Qinhibit_file_name_operation
);
4414 Qascii_character
= intern ("ascii-character");
4415 staticpro (&Qascii_character
);
4417 Qfunction
= intern ("function");
4418 staticpro (&Qfunction
);
4420 Qload
= intern ("load");
4423 Qload_file_name
= intern ("load-file-name");
4424 staticpro (&Qload_file_name
);
4426 Qeval_buffer_list
= intern ("eval-buffer-list");
4427 staticpro (&Qeval_buffer_list
);
4429 Qfile_truename
= intern ("file-truename");
4430 staticpro (&Qfile_truename
) ;
4432 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4433 staticpro (&Qdo_after_load_evaluation
) ;
4435 staticpro (&dump_path
);
4437 staticpro (&read_objects
);
4438 read_objects
= Qnil
;
4439 staticpro (&seen_list
);
4442 Vloads_in_progress
= Qnil
;
4443 staticpro (&Vloads_in_progress
);
4446 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4447 (do not change this comment) */