1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009 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
;
796 message_with_string ("%s", prompt
, 0);
797 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
799 return (NILP (val
) ? Qnil
800 : make_number (char_resolve_modifier_mask (XINT (val
))));
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
;
841 message_with_string ("%s", prompt
, 0);
843 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
845 return (NILP (val
) ? Qnil
846 : make_number (char_resolve_modifier_mask (XINT (val
))));
849 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
850 doc
: /* Don't use this yourself. */)
853 register Lisp_Object val
;
855 XSETINT (val
, getc (instream
));
862 /* Value is a version number of byte compiled code if the file
863 associated with file descriptor FD is a compiled Lisp file that's
864 safe to load. Only files compiled with Emacs are safe to load.
865 Files compiled with XEmacs can lead to a crash in Fbyte_code
866 because of an incompatible change in the byte compiler. */
877 /* Read the first few bytes from the file, and look for a line
878 specifying the byte compiler version used. */
879 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
884 /* Skip to the next newline, skipping over the initial `ELC'
885 with NUL bytes following it, but note the version. */
886 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
891 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
898 lseek (fd
, 0, SEEK_SET
);
903 /* Callback for record_unwind_protect. Restore the old load list OLD,
904 after loading a file successfully. */
907 record_load_unwind (old
)
910 return Vloads_in_progress
= old
;
913 /* This handler function is used via internal_condition_case_1. */
916 load_error_handler (data
)
923 load_warn_old_style_backquotes (file
)
926 if (!NILP (Vold_style_backquotes
))
929 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
936 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
937 doc
: /* Return the suffixes that `load' should try if a suffix is \
939 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
942 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
943 while (CONSP (suffixes
))
945 Lisp_Object exts
= Vload_file_rep_suffixes
;
946 suffix
= XCAR (suffixes
);
947 suffixes
= XCDR (suffixes
);
952 lst
= Fcons (concat2 (suffix
, ext
), lst
);
955 return Fnreverse (lst
);
958 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
959 doc
: /* Execute a file of Lisp code named FILE.
960 First try FILE with `.elc' appended, then try with `.el',
961 then try FILE unmodified (the exact suffixes in the exact order are
962 determined by `load-suffixes'). Environment variable references in
963 FILE are replaced with their values by calling `substitute-in-file-name'.
964 This function searches the directories in `load-path'.
966 If optional second arg NOERROR is non-nil,
967 report no error if FILE doesn't exist.
968 Print messages at start and end of loading unless
969 optional third arg NOMESSAGE is non-nil.
970 If optional fourth arg NOSUFFIX is non-nil, don't try adding
971 suffixes `.elc' or `.el' to the specified name FILE.
972 If optional fifth arg MUST-SUFFIX is non-nil, insist on
973 the suffix `.elc' or `.el'; don't accept just FILE unless
974 it ends in one of those suffixes or includes a directory name.
976 If this function fails to find a file, it may look for different
977 representations of that file before trying another file.
978 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
979 to the file name. Emacs uses this feature mainly to find compressed
980 versions of files when Auto Compression mode is enabled.
982 The exact suffixes that this function tries out, in the exact order,
983 are given by the value of the variable `load-file-rep-suffixes' if
984 NOSUFFIX is non-nil and by the return value of the function
985 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
986 MUST-SUFFIX are nil, this function first tries out the latter suffixes
989 Loading a file records its definitions, and its `provide' and
990 `require' calls, in an element of `load-history' whose
991 car is the file name loaded. See `load-history'.
993 Return t if the file exists and loads successfully. */)
994 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
995 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
997 register FILE *stream
;
998 register int fd
= -1;
999 int count
= SPECPDL_INDEX ();
1000 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1001 Lisp_Object found
, efound
, hist_file_name
;
1002 /* 1 means we printed the ".el is newer" message. */
1004 /* 1 means we are loading a compiled file. */
1006 Lisp_Object handler
;
1016 CHECK_STRING (file
);
1018 /* If file name is magic, call the handler. */
1019 /* This shouldn't be necessary any more now that `openp' handles it right.
1020 handler = Ffind_file_name_handler (file, Qload);
1021 if (!NILP (handler))
1022 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1024 /* Do this after the handler to avoid
1025 the need to gcpro noerror, nomessage and nosuffix.
1026 (Below here, we care only whether they are nil or not.)
1027 The presence of this call is the result of a historical accident:
1028 it used to be in every file-operation and when it got removed
1029 everywhere, it accidentally stayed here. Since then, enough people
1030 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1031 that it seemed risky to remove. */
1032 if (! NILP (noerror
))
1034 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1035 Qt
, load_error_handler
);
1040 file
= Fsubstitute_in_file_name (file
);
1043 /* Avoid weird lossage with null string as arg,
1044 since it would try to load a directory as a Lisp file */
1045 if (SCHARS (file
) > 0)
1047 int size
= SBYTES (file
);
1050 GCPRO2 (file
, found
);
1052 if (! NILP (must_suffix
))
1054 /* Don't insist on adding a suffix if FILE already ends with one. */
1056 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1059 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1061 /* Don't insist on adding a suffix
1062 if the argument includes a directory name. */
1063 else if (! NILP (Ffile_name_directory (file
)))
1067 fd
= openp (Vload_path
, file
,
1068 (!NILP (nosuffix
) ? Qnil
1069 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1070 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1071 tmp
[1] = Vload_file_rep_suffixes
,
1080 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1084 /* Tell startup.el whether or not we found the user's init file. */
1085 if (EQ (Qt
, Vuser_init_file
))
1086 Vuser_init_file
= found
;
1088 /* If FD is -2, that means openp found a magic file. */
1091 if (NILP (Fequal (found
, file
)))
1092 /* If FOUND is a different file name from FILE,
1093 find its handler even if we have already inhibited
1094 the `load' operation on FILE. */
1095 handler
= Ffind_file_name_handler (found
, Qt
);
1097 handler
= Ffind_file_name_handler (found
, Qload
);
1098 if (! NILP (handler
))
1099 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1102 /* Check if we're stuck in a recursive load cycle.
1104 2000-09-21: It's not possible to just check for the file loaded
1105 being a member of Vloads_in_progress. This fails because of the
1106 way the byte compiler currently works; `provide's are not
1107 evaluated, see font-lock.el/jit-lock.el as an example. This
1108 leads to a certain amount of ``normal'' recursion.
1110 Also, just loading a file recursively is not always an error in
1111 the general case; the second load may do something different. */
1115 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1116 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1120 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1122 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1123 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1126 /* Get the name for load-history. */
1127 hist_file_name
= (! NILP (Vpurify_flag
)
1128 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1129 tmp
[1] = Ffile_name_nondirectory (found
),
1135 /* Check for the presence of old-style quotes and warn about them. */
1136 specbind (Qold_style_backquotes
, Qnil
);
1137 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1139 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1141 || (version
= safe_to_load_p (fd
)) > 0)
1142 /* Load .elc files directly, but not when they are
1143 remote and have no handler! */
1150 GCPRO3 (file
, found
, hist_file_name
);
1153 && ! (version
= safe_to_load_p (fd
)))
1156 if (!load_dangerous_libraries
)
1160 error ("File `%s' was not compiled in Emacs",
1163 else if (!NILP (nomessage
))
1164 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1169 efound
= ENCODE_FILE (found
);
1174 stat ((char *)SDATA (efound
), &s1
);
1175 SSET (efound
, SBYTES (efound
) - 1, 0);
1176 result
= stat ((char *)SDATA (efound
), &s2
);
1177 SSET (efound
, SBYTES (efound
) - 1, 'c');
1179 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1181 /* Make the progress messages mention that source is newer. */
1184 /* If we won't print another message, mention this anyway. */
1185 if (!NILP (nomessage
))
1187 Lisp_Object msg_file
;
1188 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1189 message_with_string ("Source file `%s' newer than byte-compiled file",
1198 /* We are loading a source file (*.el). */
1199 if (!NILP (Vload_source_file_function
))
1205 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1206 NILP (noerror
) ? Qnil
: Qt
,
1207 NILP (nomessage
) ? Qnil
: Qt
);
1208 return unbind_to (count
, val
);
1212 GCPRO3 (file
, found
, hist_file_name
);
1216 efound
= ENCODE_FILE (found
);
1217 stream
= fopen ((char *) SDATA (efound
), fmode
);
1218 #else /* not WINDOWSNT */
1219 stream
= fdopen (fd
, fmode
);
1220 #endif /* not WINDOWSNT */
1224 error ("Failure to create stdio stream for %s", SDATA (file
));
1227 if (! NILP (Vpurify_flag
))
1228 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1230 if (NILP (nomessage
))
1233 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1236 message_with_string ("Loading %s (source)...", file
, 1);
1238 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1240 else /* The typical case; compiled file newer than source file. */
1241 message_with_string ("Loading %s...", file
, 1);
1244 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1245 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1246 specbind (Qload_file_name
, found
);
1247 specbind (Qinhibit_file_name_operation
, Qnil
);
1248 load_descriptor_list
1249 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1251 if (! version
|| version
>= 22)
1252 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1253 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1256 /* We can't handle a file which was compiled with
1257 byte-compile-dynamic by older version of Emacs. */
1258 specbind (Qload_force_doc_strings
, Qt
);
1259 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1260 0, Qnil
, Qnil
, Qnil
, Qnil
);
1262 unbind_to (count
, Qnil
);
1264 /* Run any eval-after-load forms for this file */
1265 if (NILP (Vpurify_flag
)
1266 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1267 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1271 xfree (saved_doc_string
);
1272 saved_doc_string
= 0;
1273 saved_doc_string_size
= 0;
1275 xfree (prev_saved_doc_string
);
1276 prev_saved_doc_string
= 0;
1277 prev_saved_doc_string_size
= 0;
1279 if (!noninteractive
&& NILP (nomessage
))
1282 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1285 message_with_string ("Loading %s (source)...done", file
, 1);
1287 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1289 else /* The typical case; compiled file newer than source file. */
1290 message_with_string ("Loading %s...done", file
, 1);
1293 if (!NILP (Fequal (build_string ("obsolete"),
1294 Ffile_name_nondirectory
1295 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1296 message_with_string ("Package %s is obsolete", file
, 1);
1302 load_unwind (arg
) /* used as unwind-protect function in load */
1305 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1312 if (--load_in_progress
< 0) load_in_progress
= 0;
1317 load_descriptor_unwind (oldlist
)
1318 Lisp_Object oldlist
;
1320 load_descriptor_list
= oldlist
;
1324 /* Close all descriptors in use for Floads.
1325 This is used when starting a subprocess. */
1332 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1333 emacs_close (XFASTINT (XCAR (tail
)));
1338 complete_filename_p (pathname
)
1339 Lisp_Object pathname
;
1341 register const unsigned char *s
= SDATA (pathname
);
1342 return (IS_DIRECTORY_SEP (s
[0])
1343 || (SCHARS (pathname
) > 2
1344 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1347 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1348 doc
: /* Search for FILENAME through PATH.
1349 Returns the file's name in absolute form, or nil if not found.
1350 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1351 file name when searching.
1352 If non-nil, PREDICATE is used instead of `file-readable-p'.
1353 PREDICATE can also be an integer to pass to the access(2) function,
1354 in which case file-name-handlers are ignored. */)
1355 (filename
, path
, suffixes
, predicate
)
1356 Lisp_Object filename
, path
, suffixes
, predicate
;
1359 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1360 if (NILP (predicate
) && fd
> 0)
1366 /* Search for a file whose name is STR, looking in directories
1367 in the Lisp list PATH, and trying suffixes from SUFFIX.
1368 On success, returns a file descriptor. On failure, returns -1.
1370 SUFFIXES is a list of strings containing possible suffixes.
1371 The empty suffix is automatically added if the list is empty.
1373 PREDICATE non-nil means don't open the files,
1374 just look for one that satisfies the predicate. In this case,
1375 returns 1 on success. The predicate can be a lisp function or
1376 an integer to pass to `access' (in which case file-name-handlers
1379 If STOREPTR is nonzero, it points to a slot where the name of
1380 the file actually found should be stored as a Lisp string.
1381 nil is stored there on failure.
1383 If the file we find is remote, return -2
1384 but store the found remote file name in *STOREPTR. */
1387 openp (path
, str
, suffixes
, storeptr
, predicate
)
1388 Lisp_Object path
, str
;
1389 Lisp_Object suffixes
;
1390 Lisp_Object
*storeptr
;
1391 Lisp_Object predicate
;
1396 register char *fn
= buf
;
1399 Lisp_Object filename
;
1401 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1402 Lisp_Object string
, tail
, encoded_fn
;
1403 int max_suffix_len
= 0;
1407 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1409 CHECK_STRING_CAR (tail
);
1410 max_suffix_len
= max (max_suffix_len
,
1411 SBYTES (XCAR (tail
)));
1414 string
= filename
= encoded_fn
= Qnil
;
1415 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1420 if (complete_filename_p (str
))
1423 for (; CONSP (path
); path
= XCDR (path
))
1425 filename
= Fexpand_file_name (str
, XCAR (path
));
1426 if (!complete_filename_p (filename
))
1427 /* If there are non-absolute elts in PATH (eg ".") */
1428 /* Of course, this could conceivably lose if luser sets
1429 default-directory to be something non-absolute... */
1431 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1432 if (!complete_filename_p (filename
))
1433 /* Give up on this path element! */
1437 /* Calculate maximum size of any filename made from
1438 this path element/specified file name and any possible suffix. */
1439 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1440 if (fn_size
< want_size
)
1441 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1443 /* Loop over suffixes. */
1444 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1445 CONSP (tail
); tail
= XCDR (tail
))
1447 int lsuffix
= SBYTES (XCAR (tail
));
1448 Lisp_Object handler
;
1451 /* Concatenate path element/specified name with the suffix.
1452 If the directory starts with /:, remove that. */
1453 if (SCHARS (filename
) > 2
1454 && SREF (filename
, 0) == '/'
1455 && SREF (filename
, 1) == ':')
1457 strncpy (fn
, SDATA (filename
) + 2,
1458 SBYTES (filename
) - 2);
1459 fn
[SBYTES (filename
) - 2] = 0;
1463 strncpy (fn
, SDATA (filename
),
1465 fn
[SBYTES (filename
)] = 0;
1468 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1469 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1471 /* Check that the file exists and is not a directory. */
1472 /* We used to only check for handlers on non-absolute file names:
1476 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1477 It's not clear why that was the case and it breaks things like
1478 (load "/bar.el") where the file is actually "/bar.el.gz". */
1479 string
= build_string (fn
);
1480 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1481 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1483 if (NILP (predicate
))
1484 exists
= !NILP (Ffile_readable_p (string
));
1486 exists
= !NILP (call1 (predicate
, string
));
1487 if (exists
&& !NILP (Ffile_directory_p (string
)))
1492 /* We succeeded; return this descriptor and filename. */
1503 encoded_fn
= ENCODE_FILE (string
);
1504 pfn
= SDATA (encoded_fn
);
1505 exists
= (stat (pfn
, &st
) >= 0
1506 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1509 /* Check that we can access or open it. */
1510 if (NATNUMP (predicate
))
1511 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1513 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1517 /* We succeeded; return this descriptor and filename. */
1535 /* Merge the list we've accumulated of globals from the current input source
1536 into the load_history variable. The details depend on whether
1537 the source has an associated file name or not.
1539 FILENAME is the file name that we are loading from.
1540 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1543 build_load_history (filename
, entire
)
1544 Lisp_Object filename
;
1547 register Lisp_Object tail
, prev
, newelt
;
1548 register Lisp_Object tem
, tem2
;
1549 register int foundit
= 0;
1551 tail
= Vload_history
;
1554 while (CONSP (tail
))
1558 /* Find the feature's previous assoc list... */
1559 if (!NILP (Fequal (filename
, Fcar (tem
))))
1563 /* If we're loading the entire file, remove old data. */
1567 Vload_history
= XCDR (tail
);
1569 Fsetcdr (prev
, XCDR (tail
));
1572 /* Otherwise, cons on new symbols that are not already members. */
1575 tem2
= Vcurrent_load_list
;
1577 while (CONSP (tem2
))
1579 newelt
= XCAR (tem2
);
1581 if (NILP (Fmember (newelt
, tem
)))
1582 Fsetcar (tail
, Fcons (XCAR (tem
),
1583 Fcons (newelt
, XCDR (tem
))));
1596 /* If we're loading an entire file, cons the new assoc onto the
1597 front of load-history, the most-recently-loaded position. Also
1598 do this if we didn't find an existing member for the file. */
1599 if (entire
|| !foundit
)
1600 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1605 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1613 readevalloop_1 (old
)
1616 load_convert_to_unibyte
= ! NILP (old
);
1620 /* Signal an `end-of-file' error, if possible with file name
1624 end_of_file_error ()
1626 if (STRINGP (Vload_file_name
))
1627 xsignal1 (Qend_of_file
, Vload_file_name
);
1629 xsignal0 (Qend_of_file
);
1632 /* UNIBYTE specifies how to set load_convert_to_unibyte
1633 for this invocation.
1634 READFUN, if non-nil, is used instead of `read'.
1636 START, END specify region to read in current buffer (from eval-region).
1637 If the input is not from a buffer, they must be nil. */
1640 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1641 printflag
, unibyte
, readfun
, start
, end
)
1642 Lisp_Object readcharfun
;
1644 Lisp_Object sourcename
;
1645 Lisp_Object (*evalfun
) ();
1647 Lisp_Object unibyte
, readfun
;
1648 Lisp_Object start
, end
;
1651 register Lisp_Object val
;
1652 int count
= SPECPDL_INDEX ();
1653 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1654 struct buffer
*b
= 0;
1655 int continue_reading_p
;
1656 /* Nonzero if reading an entire buffer. */
1657 int whole_buffer
= 0;
1658 /* 1 on the first time around. */
1661 if (MARKERP (readcharfun
))
1664 start
= readcharfun
;
1667 if (BUFFERP (readcharfun
))
1668 b
= XBUFFER (readcharfun
);
1669 else if (MARKERP (readcharfun
))
1670 b
= XMARKER (readcharfun
)->buffer
;
1672 /* We assume START is nil when input is not from a buffer. */
1673 if (! NILP (start
) && !b
)
1676 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1677 specbind (Qcurrent_load_list
, Qnil
);
1678 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1679 load_convert_to_unibyte
= !NILP (unibyte
);
1681 GCPRO4 (sourcename
, readfun
, start
, end
);
1683 /* Try to ensure sourcename is a truename, except whilst preloading. */
1684 if (NILP (Vpurify_flag
)
1685 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1686 && !NILP (Ffboundp (Qfile_truename
)))
1687 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1689 LOADHIST_ATTACH (sourcename
);
1691 continue_reading_p
= 1;
1692 while (continue_reading_p
)
1694 int count1
= SPECPDL_INDEX ();
1696 if (b
!= 0 && NILP (b
->name
))
1697 error ("Reading from killed buffer");
1701 /* Switch to the buffer we are reading from. */
1702 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1703 set_buffer_internal (b
);
1705 /* Save point in it. */
1706 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1707 /* Save ZV in it. */
1708 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1709 /* Those get unbound after we read one expression. */
1711 /* Set point and ZV around stuff to be read. */
1714 Fnarrow_to_region (make_number (BEGV
), end
);
1716 /* Just for cleanliness, convert END to a marker
1717 if it is an integer. */
1719 end
= Fpoint_max_marker ();
1722 /* On the first cycle, we can easily test here
1723 whether we are reading the whole buffer. */
1724 if (b
&& first_sexp
)
1725 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1732 while ((c
= READCHAR
) != '\n' && c
!= -1);
1737 unbind_to (count1
, Qnil
);
1741 /* Ignore whitespace here, so we can detect eof. */
1742 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1743 || c
== 0x8a0) /* NBSP */
1746 if (!NILP (Vpurify_flag
) && c
== '(')
1748 record_unwind_protect (unreadpure
, Qnil
);
1749 val
= read_list (-1, readcharfun
);
1754 read_objects
= Qnil
;
1755 if (!NILP (readfun
))
1757 val
= call1 (readfun
, readcharfun
);
1759 /* If READCHARFUN has set point to ZV, we should
1760 stop reading, even if the form read sets point
1761 to a different value when evaluated. */
1762 if (BUFFERP (readcharfun
))
1764 struct buffer
*b
= XBUFFER (readcharfun
);
1765 if (BUF_PT (b
) == BUF_ZV (b
))
1766 continue_reading_p
= 0;
1769 else if (! NILP (Vload_read_function
))
1770 val
= call1 (Vload_read_function
, readcharfun
);
1772 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1775 if (!NILP (start
) && continue_reading_p
)
1776 start
= Fpoint_marker ();
1778 /* Restore saved point and BEGV. */
1779 unbind_to (count1
, Qnil
);
1781 /* Now eval what we just read. */
1782 val
= (*evalfun
) (val
);
1786 Vvalues
= Fcons (val
, Vvalues
);
1787 if (EQ (Vstandard_output
, Qt
))
1796 build_load_history (sourcename
,
1797 stream
|| whole_buffer
);
1801 unbind_to (count
, Qnil
);
1804 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1805 doc
: /* Execute the current buffer as Lisp code.
1806 When called from a Lisp program (i.e., not interactively), this
1807 function accepts up to five optional arguments:
1808 BUFFER is the buffer to evaluate (nil means use current buffer).
1809 PRINTFLAG controls printing of output:
1810 A value of nil means discard it; anything else is stream for print.
1811 FILENAME specifies the file name to use for `load-history'.
1812 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1814 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1815 functions should work normally even if PRINTFLAG is nil.
1817 This function preserves the position of point. */)
1818 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1819 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1821 int count
= SPECPDL_INDEX ();
1822 Lisp_Object tem
, buf
;
1825 buf
= Fcurrent_buffer ();
1827 buf
= Fget_buffer (buffer
);
1829 error ("No such buffer");
1831 if (NILP (printflag
) && NILP (do_allow_print
))
1836 if (NILP (filename
))
1837 filename
= XBUFFER (buf
)->filename
;
1839 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1840 specbind (Qstandard_output
, tem
);
1841 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1842 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1843 readevalloop (buf
, 0, filename
, Feval
,
1844 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1845 unbind_to (count
, Qnil
);
1850 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1851 doc
: /* Execute the region as Lisp code.
1852 When called from programs, expects two arguments,
1853 giving starting and ending indices in the current buffer
1854 of the text to be executed.
1855 Programs can pass third argument PRINTFLAG which controls output:
1856 A value of nil means discard it; anything else is stream for printing it.
1857 Also the fourth argument READ-FUNCTION, if non-nil, is used
1858 instead of `read' to read each expression. It gets one argument
1859 which is the input stream for reading characters.
1861 This function does not move point. */)
1862 (start
, end
, printflag
, read_function
)
1863 Lisp_Object start
, end
, printflag
, read_function
;
1865 int count
= SPECPDL_INDEX ();
1866 Lisp_Object tem
, cbuf
;
1868 cbuf
= Fcurrent_buffer ();
1870 if (NILP (printflag
))
1874 specbind (Qstandard_output
, tem
);
1875 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1877 /* readevalloop calls functions which check the type of start and end. */
1878 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1879 !NILP (printflag
), Qnil
, read_function
,
1882 return unbind_to (count
, Qnil
);
1886 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1887 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1888 If STREAM is nil, use the value of `standard-input' (which see).
1889 STREAM or the value of `standard-input' may be:
1890 a buffer (read from point and advance it)
1891 a marker (read from where it points and advance it)
1892 a function (call it with no arguments for each character,
1893 call it with a char as argument to push a char back)
1894 a string (takes text from string, starting at the beginning)
1895 t (read text line using minibuffer and use it, or read from
1896 standard input in batch mode). */)
1901 stream
= Vstandard_input
;
1902 if (EQ (stream
, Qt
))
1903 stream
= Qread_char
;
1904 if (EQ (stream
, Qread_char
))
1905 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1907 return read_internal_start (stream
, Qnil
, Qnil
);
1910 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1911 doc
: /* Read one Lisp expression which is represented as text by STRING.
1912 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1913 START and END optionally delimit a substring of STRING from which to read;
1914 they default to 0 and (length STRING) respectively. */)
1915 (string
, start
, end
)
1916 Lisp_Object string
, start
, end
;
1919 CHECK_STRING (string
);
1920 /* read_internal_start sets read_from_string_index. */
1921 ret
= read_internal_start (string
, start
, end
);
1922 return Fcons (ret
, make_number (read_from_string_index
));
1925 /* Function to set up the global context we need in toplevel read
1928 read_internal_start (stream
, start
, end
)
1930 Lisp_Object start
; /* Only used when stream is a string. */
1931 Lisp_Object end
; /* Only used when stream is a string. */
1936 new_backquote_flag
= 0;
1937 read_objects
= Qnil
;
1938 if (EQ (Vread_with_symbol_positions
, Qt
)
1939 || EQ (Vread_with_symbol_positions
, stream
))
1940 Vread_symbol_positions_list
= Qnil
;
1942 if (STRINGP (stream
)
1943 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1945 int startval
, endval
;
1948 if (STRINGP (stream
))
1951 string
= XCAR (stream
);
1954 endval
= SCHARS (string
);
1958 endval
= XINT (end
);
1959 if (endval
< 0 || endval
> SCHARS (string
))
1960 args_out_of_range (string
, end
);
1967 CHECK_NUMBER (start
);
1968 startval
= XINT (start
);
1969 if (startval
< 0 || startval
> endval
)
1970 args_out_of_range (string
, start
);
1972 read_from_string_index
= startval
;
1973 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1974 read_from_string_limit
= endval
;
1977 retval
= read0 (stream
);
1978 if (EQ (Vread_with_symbol_positions
, Qt
)
1979 || EQ (Vread_with_symbol_positions
, stream
))
1980 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1985 /* Signal Qinvalid_read_syntax error.
1986 S is error string of length N (if > 0) */
1989 invalid_syntax (s
, n
)
1995 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1999 /* Use this for recursive reads, in contexts where internal tokens
2004 Lisp_Object readcharfun
;
2006 register Lisp_Object val
;
2009 val
= read1 (readcharfun
, &c
, 0);
2013 xsignal1 (Qinvalid_read_syntax
,
2014 Fmake_string (make_number (1), make_number (c
)));
2017 static int read_buffer_size
;
2018 static char *read_buffer
;
2020 /* Read a \-escape sequence, assuming we already read the `\'.
2021 If the escape sequence forces unibyte, return eight-bit char. */
2024 read_escape (readcharfun
, stringp
)
2025 Lisp_Object readcharfun
;
2028 register int c
= READCHAR
;
2029 /* \u allows up to four hex digits, \U up to eight. Default to the
2030 behavior for \u, and change this value in the case that \U is seen. */
2031 int unicode_hex_count
= 4;
2036 end_of_file_error ();
2066 error ("Invalid escape character syntax");
2069 c
= read_escape (readcharfun
, 0);
2070 return c
| meta_modifier
;
2075 error ("Invalid escape character syntax");
2078 c
= read_escape (readcharfun
, 0);
2079 return c
| shift_modifier
;
2084 error ("Invalid escape character syntax");
2087 c
= read_escape (readcharfun
, 0);
2088 return c
| hyper_modifier
;
2093 error ("Invalid escape character syntax");
2096 c
= read_escape (readcharfun
, 0);
2097 return c
| alt_modifier
;
2101 if (stringp
|| c
!= '-')
2108 c
= read_escape (readcharfun
, 0);
2109 return c
| super_modifier
;
2114 error ("Invalid escape character syntax");
2118 c
= read_escape (readcharfun
, 0);
2119 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2120 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2121 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2122 return c
| ctrl_modifier
;
2123 /* ASCII control chars are made from letters (both cases),
2124 as well as the non-letters within 0100...0137. */
2125 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2126 return (c
& (037 | ~0177));
2127 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2128 return (c
& (037 | ~0177));
2130 return c
| ctrl_modifier
;
2140 /* An octal escape, as in ANSI C. */
2142 register int i
= c
- '0';
2143 register int count
= 0;
2146 if ((c
= READCHAR
) >= '0' && c
<= '7')
2158 if (i
>= 0x80 && i
< 0x100)
2159 i
= BYTE8_TO_CHAR (i
);
2164 /* A hex escape, as in ANSI C. */
2171 if (c
>= '0' && c
<= '9')
2176 else if ((c
>= 'a' && c
<= 'f')
2177 || (c
>= 'A' && c
<= 'F'))
2180 if (c
>= 'a' && c
<= 'f')
2193 if (count
< 3 && i
>= 0x80)
2194 return BYTE8_TO_CHAR (i
);
2199 /* Post-Unicode-2.0: Up to eight hex chars. */
2200 unicode_hex_count
= 8;
2203 /* A Unicode escape. We only permit them in strings and characters,
2204 not arbitrarily in the source code, as in some other languages. */
2209 while (++count
<= unicode_hex_count
)
2212 /* isdigit and isalpha may be locale-specific, which we don't
2214 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2215 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2216 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2219 error ("Non-hex digit used for Unicode escape");
2224 error ("Non-Unicode character: 0x%x", i
);
2233 /* Read an integer in radix RADIX using READCHARFUN to read
2234 characters. RADIX must be in the interval [2..36]; if it isn't, a
2235 read error is signaled . Value is the integer read. Signals an
2236 error if encountering invalid read syntax or if RADIX is out of
2240 read_integer (readcharfun
, radix
)
2241 Lisp_Object readcharfun
;
2244 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2245 EMACS_INT number
= 0;
2247 if (radix
< 2 || radix
> 36)
2251 number
= ndigits
= invalid_p
= 0;
2267 if (c
>= '0' && c
<= '9')
2269 else if (c
>= 'a' && c
<= 'z')
2270 digit
= c
- 'a' + 10;
2271 else if (c
>= 'A' && c
<= 'Z')
2272 digit
= c
- 'A' + 10;
2279 if (digit
< 0 || digit
>= radix
)
2282 number
= radix
* number
+ digit
;
2288 if (ndigits
== 0 || invalid_p
)
2291 sprintf (buf
, "integer, radix %d", radix
);
2292 invalid_syntax (buf
, 0);
2295 return make_number (sign
* number
);
2299 /* If the next token is ')' or ']' or '.', we store that character
2300 in *PCH and the return value is not interesting. Else, we store
2301 zero in *PCH and we read and return one lisp object.
2303 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2306 read1 (readcharfun
, pch
, first_in_list
)
2307 register Lisp_Object readcharfun
;
2312 int uninterned_symbol
= 0;
2320 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2322 end_of_file_error ();
2327 return read_list (0, readcharfun
);
2330 return read_vector (readcharfun
, 0);
2347 tmp
= read_vector (readcharfun
, 0);
2348 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2349 error ("Invalid size char-table");
2350 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2361 tmp
= read_vector (readcharfun
, 0);
2362 if (!INTEGERP (AREF (tmp
, 0)))
2363 error ("Invalid depth in char-table");
2364 depth
= XINT (AREF (tmp
, 0));
2365 if (depth
< 1 || depth
> 3)
2366 error ("Invalid depth in char-table");
2367 size
= XVECTOR (tmp
)->size
- 2;
2368 if (chartab_size
[depth
] != size
)
2369 error ("Invalid size char-table");
2370 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2373 invalid_syntax ("#^^", 3);
2375 invalid_syntax ("#^", 2);
2380 length
= read1 (readcharfun
, pch
, first_in_list
);
2384 Lisp_Object tmp
, val
;
2386 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2387 / BOOL_VECTOR_BITS_PER_CHAR
);
2390 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2391 if (STRING_MULTIBYTE (tmp
)
2392 || (size_in_chars
!= SCHARS (tmp
)
2393 /* We used to print 1 char too many
2394 when the number of bits was a multiple of 8.
2395 Accept such input in case it came from an old
2397 && ! (XFASTINT (length
)
2398 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2399 invalid_syntax ("#&...", 5);
2401 val
= Fmake_bool_vector (length
, Qnil
);
2402 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2404 /* Clear the extraneous bits in the last byte. */
2405 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2406 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2407 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2410 invalid_syntax ("#&...", 5);
2414 /* Accept compiled functions at read-time so that we don't have to
2415 build them using function calls. */
2417 tmp
= read_vector (readcharfun
, 1);
2418 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2419 XVECTOR (tmp
)->contents
);
2424 struct gcpro gcpro1
;
2427 /* Read the string itself. */
2428 tmp
= read1 (readcharfun
, &ch
, 0);
2429 if (ch
!= 0 || !STRINGP (tmp
))
2430 invalid_syntax ("#", 1);
2432 /* Read the intervals and their properties. */
2435 Lisp_Object beg
, end
, plist
;
2437 beg
= read1 (readcharfun
, &ch
, 0);
2442 end
= read1 (readcharfun
, &ch
, 0);
2444 plist
= read1 (readcharfun
, &ch
, 0);
2446 invalid_syntax ("Invalid string property list", 0);
2447 Fset_text_properties (beg
, end
, plist
, tmp
);
2453 /* #@NUMBER is used to skip NUMBER following characters.
2454 That's used in .elc files to skip over doc strings
2455 and function definitions. */
2461 /* Read a decimal integer. */
2462 while ((c
= READCHAR
) >= 0
2463 && c
>= '0' && c
<= '9')
2471 if (load_force_doc_strings
2472 && (EQ (readcharfun
, Qget_file_char
)
2473 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2475 /* If we are supposed to force doc strings into core right now,
2476 record the last string that we skipped,
2477 and record where in the file it comes from. */
2479 /* But first exchange saved_doc_string
2480 with prev_saved_doc_string, so we save two strings. */
2482 char *temp
= saved_doc_string
;
2483 int temp_size
= saved_doc_string_size
;
2484 file_offset temp_pos
= saved_doc_string_position
;
2485 int temp_len
= saved_doc_string_length
;
2487 saved_doc_string
= prev_saved_doc_string
;
2488 saved_doc_string_size
= prev_saved_doc_string_size
;
2489 saved_doc_string_position
= prev_saved_doc_string_position
;
2490 saved_doc_string_length
= prev_saved_doc_string_length
;
2492 prev_saved_doc_string
= temp
;
2493 prev_saved_doc_string_size
= temp_size
;
2494 prev_saved_doc_string_position
= temp_pos
;
2495 prev_saved_doc_string_length
= temp_len
;
2498 if (saved_doc_string_size
== 0)
2500 saved_doc_string_size
= nskip
+ 100;
2501 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2503 if (nskip
> saved_doc_string_size
)
2505 saved_doc_string_size
= nskip
+ 100;
2506 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2507 saved_doc_string_size
);
2510 saved_doc_string_position
= file_tell (instream
);
2512 /* Copy that many characters into saved_doc_string. */
2513 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2514 saved_doc_string
[i
] = c
= READCHAR
;
2516 saved_doc_string_length
= i
;
2520 /* Skip that many characters. */
2521 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2530 /* #! appears at the beginning of an executable file.
2531 Skip the first line. */
2532 while (c
!= '\n' && c
>= 0)
2537 return Vload_file_name
;
2539 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2540 /* #:foo is the uninterned symbol named foo. */
2543 uninterned_symbol
= 1;
2547 /* Reader forms that can reuse previously read objects. */
2548 if (c
>= '0' && c
<= '9')
2553 /* Read a non-negative integer. */
2554 while (c
>= '0' && c
<= '9')
2560 /* #n=object returns object, but associates it with n for #n#. */
2563 /* Make a placeholder for #n# to use temporarily */
2564 Lisp_Object placeholder
;
2567 placeholder
= Fcons(Qnil
, Qnil
);
2568 cell
= Fcons (make_number (n
), placeholder
);
2569 read_objects
= Fcons (cell
, read_objects
);
2571 /* Read the object itself. */
2572 tem
= read0 (readcharfun
);
2574 /* Now put it everywhere the placeholder was... */
2575 substitute_object_in_subtree (tem
, placeholder
);
2577 /* ...and #n# will use the real value from now on. */
2578 Fsetcdr (cell
, tem
);
2582 /* #n# returns a previously read object. */
2585 tem
= Fassq (make_number (n
), read_objects
);
2588 /* Fall through to error message. */
2590 else if (c
== 'r' || c
== 'R')
2591 return read_integer (readcharfun
, n
);
2593 /* Fall through to error message. */
2595 else if (c
== 'x' || c
== 'X')
2596 return read_integer (readcharfun
, 16);
2597 else if (c
== 'o' || c
== 'O')
2598 return read_integer (readcharfun
, 8);
2599 else if (c
== 'b' || c
== 'B')
2600 return read_integer (readcharfun
, 2);
2603 invalid_syntax ("#", 1);
2606 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2611 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2617 Vold_style_backquotes
= Qt
;
2624 new_backquote_flag
++;
2625 value
= read0 (readcharfun
);
2626 new_backquote_flag
--;
2628 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2632 if (new_backquote_flag
)
2634 Lisp_Object comma_type
= Qnil
;
2639 comma_type
= Qcomma_at
;
2641 comma_type
= Qcomma_dot
;
2644 if (ch
>= 0) UNREAD (ch
);
2645 comma_type
= Qcomma
;
2648 new_backquote_flag
--;
2649 value
= read0 (readcharfun
);
2650 new_backquote_flag
++;
2651 return Fcons (comma_type
, Fcons (value
, Qnil
));
2655 Vold_style_backquotes
= Qt
;
2667 end_of_file_error ();
2669 /* Accept `single space' syntax like (list ? x) where the
2670 whitespace character is SPC or TAB.
2671 Other literal whitespace like NL, CR, and FF are not accepted,
2672 as there are well-established escape sequences for these. */
2673 if (c
== ' ' || c
== '\t')
2674 return make_number (c
);
2677 c
= read_escape (readcharfun
, 0);
2678 modifiers
= c
& CHAR_MODIFIER_MASK
;
2679 c
&= ~CHAR_MODIFIER_MASK
;
2680 if (CHAR_BYTE8_P (c
))
2681 c
= CHAR_TO_BYTE8 (c
);
2684 next_char
= READCHAR
;
2685 if (next_char
== '.')
2687 /* Only a dotted-pair dot is valid after a char constant. */
2688 int next_next_char
= READCHAR
;
2689 UNREAD (next_next_char
);
2691 ok
= (next_next_char
<= 040
2692 || (next_next_char
< 0200
2693 && (index ("\"';([#?", next_next_char
)
2694 || (!first_in_list
&& next_next_char
== '`')
2695 || (new_backquote_flag
&& next_next_char
== ','))));
2699 ok
= (next_char
<= 040
2700 || (next_char
< 0200
2701 && (index ("\"';()[]#?", next_char
)
2702 || (!first_in_list
&& next_char
== '`')
2703 || (new_backquote_flag
&& next_char
== ','))));
2707 return make_number (c
);
2709 invalid_syntax ("?", 1);
2714 char *p
= read_buffer
;
2715 char *end
= read_buffer
+ read_buffer_size
;
2717 /* Nonzero if we saw an escape sequence specifying
2718 a multibyte character. */
2719 int force_multibyte
= 0;
2720 /* Nonzero if we saw an escape sequence specifying
2721 a single-byte character. */
2722 int force_singlebyte
= 0;
2726 while ((c
= READCHAR
) >= 0
2729 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2731 int offset
= p
- read_buffer
;
2732 read_buffer
= (char *) xrealloc (read_buffer
,
2733 read_buffer_size
*= 2);
2734 p
= read_buffer
+ offset
;
2735 end
= read_buffer
+ read_buffer_size
;
2742 c
= read_escape (readcharfun
, 1);
2744 /* C is -1 if \ newline has just been seen */
2747 if (p
== read_buffer
)
2752 modifiers
= c
& CHAR_MODIFIER_MASK
;
2753 c
= c
& ~CHAR_MODIFIER_MASK
;
2755 if (CHAR_BYTE8_P (c
))
2756 force_singlebyte
= 1;
2757 else if (! ASCII_CHAR_P (c
))
2758 force_multibyte
= 1;
2759 else /* i.e. ASCII_CHAR_P (c) */
2761 /* Allow `\C- ' and `\C-?'. */
2762 if (modifiers
== CHAR_CTL
)
2765 c
= 0, modifiers
= 0;
2767 c
= 127, modifiers
= 0;
2769 if (modifiers
& CHAR_SHIFT
)
2771 /* Shift modifier is valid only with [A-Za-z]. */
2772 if (c
>= 'A' && c
<= 'Z')
2773 modifiers
&= ~CHAR_SHIFT
;
2774 else if (c
>= 'a' && c
<= 'z')
2775 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2778 if (modifiers
& CHAR_META
)
2780 /* Move the meta bit to the right place for a
2782 modifiers
&= ~CHAR_META
;
2783 c
= BYTE8_TO_CHAR (c
| 0x80);
2784 force_singlebyte
= 1;
2788 /* Any modifiers remaining are invalid. */
2790 error ("Invalid modifier in string");
2791 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2795 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2796 if (CHAR_BYTE8_P (c
))
2797 force_singlebyte
= 1;
2798 else if (! ASCII_CHAR_P (c
))
2799 force_multibyte
= 1;
2805 end_of_file_error ();
2807 /* If purifying, and string starts with \ newline,
2808 return zero instead. This is for doc strings
2809 that we are really going to find in etc/DOC.nn.nn */
2810 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2811 return make_number (0);
2813 if (force_multibyte
)
2814 /* READ_BUFFER already contains valid multibyte forms. */
2816 else if (force_singlebyte
)
2818 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2819 p
= read_buffer
+ nchars
;
2822 /* Otherwise, READ_BUFFER contains only ASCII. */
2825 /* We want readchar_count to be the number of characters, not
2826 bytes. Hence we adjust for multibyte characters in the
2827 string. ... But it doesn't seem to be necessary, because
2828 READCHAR *does* read multibyte characters from buffers. */
2829 /* readchar_count -= (p - read_buffer) - nchars; */
2831 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2833 || (p
- read_buffer
!= nchars
)));
2834 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2836 || (p
- read_buffer
!= nchars
)));
2841 int next_char
= READCHAR
;
2844 if (next_char
<= 040
2845 || (next_char
< 0200
2846 && (index ("\"';([#?", next_char
)
2847 || (!first_in_list
&& next_char
== '`')
2848 || (new_backquote_flag
&& next_char
== ','))))
2854 /* Otherwise, we fall through! Note that the atom-reading loop
2855 below will now loop at least once, assuring that we will not
2856 try to UNREAD two characters in a row. */
2860 if (c
<= 040) goto retry
;
2861 if (c
== 0x8a0) /* NBSP */
2864 char *p
= read_buffer
;
2868 char *end
= read_buffer
+ read_buffer_size
;
2871 && c
!= 0x8a0 /* NBSP */
2873 || (!index ("\"';()[]#", c
)
2874 && !(!first_in_list
&& c
== '`')
2875 && !(new_backquote_flag
&& c
== ','))))
2877 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2879 int offset
= p
- read_buffer
;
2880 read_buffer
= (char *) xrealloc (read_buffer
,
2881 read_buffer_size
*= 2);
2882 p
= read_buffer
+ offset
;
2883 end
= read_buffer
+ read_buffer_size
;
2890 end_of_file_error ();
2895 p
+= CHAR_STRING (c
, p
);
2903 int offset
= p
- read_buffer
;
2904 read_buffer
= (char *) xrealloc (read_buffer
,
2905 read_buffer_size
*= 2);
2906 p
= read_buffer
+ offset
;
2907 end
= read_buffer
+ read_buffer_size
;
2914 if (!quoted
&& !uninterned_symbol
)
2917 register Lisp_Object val
;
2919 if (*p1
== '+' || *p1
== '-') p1
++;
2920 /* Is it an integer? */
2923 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2924 /* Integers can have trailing decimal points. */
2925 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2927 /* It is an integer. */
2931 /* Fixme: if we have strtol, use that, and check
2933 if (sizeof (int) == sizeof (EMACS_INT
))
2934 XSETINT (val
, atoi (read_buffer
));
2935 else if (sizeof (long) == sizeof (EMACS_INT
))
2936 XSETINT (val
, atol (read_buffer
));
2942 if (isfloat_string (read_buffer
))
2944 /* Compute NaN and infinities using 0.0 in a variable,
2945 to cope with compilers that think they are smarter
2951 /* Negate the value ourselves. This treats 0, NaNs,
2952 and infinity properly on IEEE floating point hosts,
2953 and works around a common bug where atof ("-0.0")
2955 int negative
= read_buffer
[0] == '-';
2957 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2958 returns 1, is if the input ends in e+INF or e+NaN. */
2965 value
= zero
/ zero
;
2967 /* If that made a "negative" NaN, negate it. */
2971 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2974 u_minus_zero
.d
= - 0.0;
2975 for (i
= 0; i
< sizeof (double); i
++)
2976 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2982 /* Now VALUE is a positive NaN. */
2985 value
= atof (read_buffer
+ negative
);
2989 return make_float (negative
? - value
: value
);
2993 Lisp_Object name
, result
;
2994 EMACS_INT nbytes
= p
- read_buffer
;
2996 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
2999 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3000 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3002 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3003 result
= (uninterned_symbol
? Fmake_symbol (name
)
3004 : Fintern (name
, Qnil
));
3006 if (EQ (Vread_with_symbol_positions
, Qt
)
3007 || EQ (Vread_with_symbol_positions
, readcharfun
))
3008 Vread_symbol_positions_list
=
3009 /* Kind of a hack; this will probably fail if characters
3010 in the symbol name were escaped. Not really a big
3012 Fcons (Fcons (result
,
3013 make_number (readchar_count
3014 - XFASTINT (Flength (Fsymbol_name (result
))))),
3015 Vread_symbol_positions_list
);
3023 /* List of nodes we've seen during substitute_object_in_subtree. */
3024 static Lisp_Object seen_list
;
3027 substitute_object_in_subtree (object
, placeholder
)
3029 Lisp_Object placeholder
;
3031 Lisp_Object check_object
;
3033 /* We haven't seen any objects when we start. */
3036 /* Make all the substitutions. */
3038 = substitute_object_recurse (object
, placeholder
, object
);
3040 /* Clear seen_list because we're done with it. */
3043 /* The returned object here is expected to always eq the
3045 if (!EQ (check_object
, object
))
3046 error ("Unexpected mutation error in reader");
3049 /* Feval doesn't get called from here, so no gc protection is needed. */
3050 #define SUBSTITUTE(get_val, set_val) \
3052 Lisp_Object old_value = get_val; \
3053 Lisp_Object true_value \
3054 = substitute_object_recurse (object, placeholder, \
3057 if (!EQ (old_value, true_value)) \
3064 substitute_object_recurse (object
, placeholder
, subtree
)
3066 Lisp_Object placeholder
;
3067 Lisp_Object subtree
;
3069 /* If we find the placeholder, return the target object. */
3070 if (EQ (placeholder
, subtree
))
3073 /* If we've been to this node before, don't explore it again. */
3074 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3077 /* If this node can be the entry point to a cycle, remember that
3078 we've seen it. It can only be such an entry point if it was made
3079 by #n=, which means that we can find it as a value in
3081 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3082 seen_list
= Fcons (subtree
, seen_list
);
3084 /* Recurse according to subtree's type.
3085 Every branch must return a Lisp_Object. */
3086 switch (XTYPE (subtree
))
3088 case Lisp_Vectorlike
:
3091 if (BOOL_VECTOR_P (subtree
))
3092 return subtree
; /* No sub-objects anyway. */
3093 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3094 || COMPILEDP (subtree
))
3095 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3096 else if (VECTORP (subtree
))
3097 length
= ASIZE (subtree
);
3099 /* An unknown pseudovector may contain non-Lisp fields, so we
3100 can't just blindly traverse all its fields. We used to call
3101 `Flength' which signaled `sequencep', so I just preserved this
3103 wrong_type_argument (Qsequencep
, subtree
);
3105 for (i
= 0; i
< length
; i
++)
3106 SUBSTITUTE (AREF (subtree
, i
),
3107 ASET (subtree
, i
, true_value
));
3113 SUBSTITUTE (XCAR (subtree
),
3114 XSETCAR (subtree
, true_value
));
3115 SUBSTITUTE (XCDR (subtree
),
3116 XSETCDR (subtree
, true_value
));
3122 /* Check for text properties in each interval.
3123 substitute_in_interval contains part of the logic. */
3125 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3126 Lisp_Object arg
= Fcons (object
, placeholder
);
3128 traverse_intervals_noorder (root_interval
,
3129 &substitute_in_interval
, arg
);
3134 /* Other types don't recurse any further. */
3140 /* Helper function for substitute_object_recurse. */
3142 substitute_in_interval (interval
, arg
)
3146 Lisp_Object object
= Fcar (arg
);
3147 Lisp_Object placeholder
= Fcdr (arg
);
3149 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3168 if (*cp
== '+' || *cp
== '-')
3171 if (*cp
>= '0' && *cp
<= '9')
3174 while (*cp
>= '0' && *cp
<= '9')
3182 if (*cp
>= '0' && *cp
<= '9')
3185 while (*cp
>= '0' && *cp
<= '9')
3188 if (*cp
== 'e' || *cp
== 'E')
3192 if (*cp
== '+' || *cp
== '-')
3196 if (*cp
>= '0' && *cp
<= '9')
3199 while (*cp
>= '0' && *cp
<= '9')
3202 else if (cp
== start
)
3204 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3209 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3215 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3216 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3217 || state
== (DOT_CHAR
|TRAIL_INT
)
3218 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3219 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3220 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3225 read_vector (readcharfun
, bytecodeflag
)
3226 Lisp_Object readcharfun
;
3231 register Lisp_Object
*ptr
;
3232 register Lisp_Object tem
, item
, vector
;
3233 register struct Lisp_Cons
*otem
;
3236 tem
= read_list (1, readcharfun
);
3237 len
= Flength (tem
);
3238 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3240 size
= XVECTOR (vector
)->size
;
3241 ptr
= XVECTOR (vector
)->contents
;
3242 for (i
= 0; i
< size
; i
++)
3245 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3246 bytecode object, the docstring containing the bytecode and
3247 constants values must be treated as unibyte and passed to
3248 Fread, to get the actual bytecode string and constants vector. */
3249 if (bytecodeflag
&& load_force_doc_strings
)
3251 if (i
== COMPILED_BYTECODE
)
3253 if (!STRINGP (item
))
3254 error ("Invalid byte code");
3256 /* Delay handling the bytecode slot until we know whether
3257 it is lazily-loaded (we can tell by whether the
3258 constants slot is nil). */
3259 ptr
[COMPILED_CONSTANTS
] = item
;
3262 else if (i
== COMPILED_CONSTANTS
)
3264 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3268 /* Coerce string to unibyte (like string-as-unibyte,
3269 but without generating extra garbage and
3270 guaranteeing no change in the contents). */
3271 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3272 STRING_SET_UNIBYTE (bytestr
);
3274 item
= Fread (Fcons (bytestr
, readcharfun
));
3276 error ("Invalid byte code");
3278 otem
= XCONS (item
);
3279 bytestr
= XCAR (item
);
3284 /* Now handle the bytecode slot. */
3285 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3287 else if (i
== COMPILED_DOC_STRING
3289 && ! STRING_MULTIBYTE (item
))
3291 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3292 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3294 item
= Fstring_as_multibyte (item
);
3297 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3305 /* FLAG = 1 means check for ] to terminate rather than ) and .
3306 FLAG = -1 means check for starting with defun
3307 and make structure pure. */
3310 read_list (flag
, readcharfun
)
3312 register Lisp_Object readcharfun
;
3314 /* -1 means check next element for defun,
3315 0 means don't check,
3316 1 means already checked and found defun. */
3317 int defunflag
= flag
< 0 ? -1 : 0;
3318 Lisp_Object val
, tail
;
3319 register Lisp_Object elt
, tem
;
3320 struct gcpro gcpro1
, gcpro2
;
3321 /* 0 is the normal case.
3322 1 means this list is a doc reference; replace it with the number 0.
3323 2 means this list is a doc reference; replace it with the doc string. */
3324 int doc_reference
= 0;
3326 /* Initialize this to 1 if we are reading a list. */
3327 int first_in_list
= flag
<= 0;
3336 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3341 /* While building, if the list starts with #$, treat it specially. */
3342 if (EQ (elt
, Vload_file_name
)
3344 && !NILP (Vpurify_flag
))
3346 if (NILP (Vdoc_file_name
))
3347 /* We have not yet called Snarf-documentation, so assume
3348 this file is described in the DOC-MM.NN file
3349 and Snarf-documentation will fill in the right value later.
3350 For now, replace the whole list with 0. */
3353 /* We have already called Snarf-documentation, so make a relative
3354 file name for this file, so it can be found properly
3355 in the installed Lisp directory.
3356 We don't use Fexpand_file_name because that would make
3357 the directory absolute now. */
3358 elt
= concat2 (build_string ("../lisp/"),
3359 Ffile_name_nondirectory (elt
));
3361 else if (EQ (elt
, Vload_file_name
)
3363 && load_force_doc_strings
)
3372 invalid_syntax (") or . in a vector", 18);
3380 XSETCDR (tail
, read0 (readcharfun
));
3382 val
= read0 (readcharfun
);
3383 read1 (readcharfun
, &ch
, 0);
3387 if (doc_reference
== 1)
3388 return make_number (0);
3389 if (doc_reference
== 2)
3391 /* Get a doc string from the file we are loading.
3392 If it's in saved_doc_string, get it from there.
3394 Here, we don't know if the string is a
3395 bytecode string or a doc string. As a
3396 bytecode string must be unibyte, we always
3397 return a unibyte string. If it is actually a
3398 doc string, caller must make it
3401 int pos
= XINT (XCDR (val
));
3402 /* Position is negative for user variables. */
3403 if (pos
< 0) pos
= -pos
;
3404 if (pos
>= saved_doc_string_position
3405 && pos
< (saved_doc_string_position
3406 + saved_doc_string_length
))
3408 int start
= pos
- saved_doc_string_position
;
3411 /* Process quoting with ^A,
3412 and find the end of the string,
3413 which is marked with ^_ (037). */
3414 for (from
= start
, to
= start
;
3415 saved_doc_string
[from
] != 037;)
3417 int c
= saved_doc_string
[from
++];
3420 c
= saved_doc_string
[from
++];
3422 saved_doc_string
[to
++] = c
;
3424 saved_doc_string
[to
++] = 0;
3426 saved_doc_string
[to
++] = 037;
3429 saved_doc_string
[to
++] = c
;
3432 return make_unibyte_string (saved_doc_string
+ start
,
3435 /* Look in prev_saved_doc_string the same way. */
3436 else if (pos
>= prev_saved_doc_string_position
3437 && pos
< (prev_saved_doc_string_position
3438 + prev_saved_doc_string_length
))
3440 int start
= pos
- prev_saved_doc_string_position
;
3443 /* Process quoting with ^A,
3444 and find the end of the string,
3445 which is marked with ^_ (037). */
3446 for (from
= start
, to
= start
;
3447 prev_saved_doc_string
[from
] != 037;)
3449 int c
= prev_saved_doc_string
[from
++];
3452 c
= prev_saved_doc_string
[from
++];
3454 prev_saved_doc_string
[to
++] = c
;
3456 prev_saved_doc_string
[to
++] = 0;
3458 prev_saved_doc_string
[to
++] = 037;
3461 prev_saved_doc_string
[to
++] = c
;
3464 return make_unibyte_string (prev_saved_doc_string
3469 return get_doc_string (val
, 1, 0);
3474 invalid_syntax (". in wrong context", 18);
3476 invalid_syntax ("] in a list", 11);
3478 tem
= (read_pure
&& flag
<= 0
3479 ? pure_cons (elt
, Qnil
)
3480 : Fcons (elt
, Qnil
));
3482 XSETCDR (tail
, tem
);
3487 defunflag
= EQ (elt
, Qdefun
);
3488 else if (defunflag
> 0)
3493 Lisp_Object Vobarray
;
3494 Lisp_Object initial_obarray
;
3496 /* oblookup stores the bucket number here, for the sake of Funintern. */
3498 int oblookup_last_bucket_number
;
3500 static int hash_string ();
3502 /* Get an error if OBARRAY is not an obarray.
3503 If it is one, return it. */
3506 check_obarray (obarray
)
3507 Lisp_Object obarray
;
3509 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3511 /* If Vobarray is now invalid, force it to be valid. */
3512 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3513 wrong_type_argument (Qvectorp
, obarray
);
3518 /* Intern the C string STR: return a symbol with that name,
3519 interned in the current obarray. */
3526 int len
= strlen (str
);
3527 Lisp_Object obarray
;
3530 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3531 obarray
= check_obarray (obarray
);
3532 tem
= oblookup (obarray
, str
, len
, len
);
3535 return Fintern (make_string (str
, len
), obarray
);
3538 /* Create an uninterned symbol with name STR. */
3544 int len
= strlen (str
);
3546 return Fmake_symbol ((!NILP (Vpurify_flag
)
3547 ? make_pure_string (str
, len
, len
, 0)
3548 : make_string (str
, len
)));
3551 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3552 doc
: /* Return the canonical symbol whose name is STRING.
3553 If there is none, one is created by this function and returned.
3554 A second optional argument specifies the obarray to use;
3555 it defaults to the value of `obarray'. */)
3557 Lisp_Object string
, obarray
;
3559 register Lisp_Object tem
, sym
, *ptr
;
3561 if (NILP (obarray
)) obarray
= Vobarray
;
3562 obarray
= check_obarray (obarray
);
3564 CHECK_STRING (string
);
3566 tem
= oblookup (obarray
, SDATA (string
),
3569 if (!INTEGERP (tem
))
3572 if (!NILP (Vpurify_flag
))
3573 string
= Fpurecopy (string
);
3574 sym
= Fmake_symbol (string
);
3576 if (EQ (obarray
, initial_obarray
))
3577 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3579 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3581 if ((SREF (string
, 0) == ':')
3582 && EQ (obarray
, initial_obarray
))
3584 XSYMBOL (sym
)->constant
= 1;
3585 XSYMBOL (sym
)->value
= sym
;
3588 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3590 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3592 XSYMBOL (sym
)->next
= 0;
3597 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3598 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3599 NAME may be a string or a symbol. If it is a symbol, that exact
3600 symbol is searched for.
3601 A second optional argument specifies the obarray to use;
3602 it defaults to the value of `obarray'. */)
3604 Lisp_Object name
, obarray
;
3606 register Lisp_Object tem
, string
;
3608 if (NILP (obarray
)) obarray
= Vobarray
;
3609 obarray
= check_obarray (obarray
);
3611 if (!SYMBOLP (name
))
3613 CHECK_STRING (name
);
3617 string
= SYMBOL_NAME (name
);
3619 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3620 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3626 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3627 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3628 The value is t if a symbol was found and deleted, nil otherwise.
3629 NAME may be a string or a symbol. If it is a symbol, that symbol
3630 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3631 OBARRAY defaults to the value of the variable `obarray'. */)
3633 Lisp_Object name
, obarray
;
3635 register Lisp_Object string
, tem
;
3638 if (NILP (obarray
)) obarray
= Vobarray
;
3639 obarray
= check_obarray (obarray
);
3642 string
= SYMBOL_NAME (name
);
3645 CHECK_STRING (name
);
3649 tem
= oblookup (obarray
, SDATA (string
),
3654 /* If arg was a symbol, don't delete anything but that symbol itself. */
3655 if (SYMBOLP (name
) && !EQ (name
, tem
))
3658 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3659 XSYMBOL (tem
)->constant
= 0;
3660 XSYMBOL (tem
)->indirect_variable
= 0;
3662 hash
= oblookup_last_bucket_number
;
3664 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3666 if (XSYMBOL (tem
)->next
)
3667 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3669 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3673 Lisp_Object tail
, following
;
3675 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3676 XSYMBOL (tail
)->next
;
3679 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3680 if (EQ (following
, tem
))
3682 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3691 /* Return the symbol in OBARRAY whose names matches the string
3692 of SIZE characters (SIZE_BYTE bytes) at PTR.
3693 If there is no such symbol in OBARRAY, return nil.
3695 Also store the bucket number in oblookup_last_bucket_number. */
3698 oblookup (obarray
, ptr
, size
, size_byte
)
3699 Lisp_Object obarray
;
3700 register const char *ptr
;
3701 int size
, size_byte
;
3705 register Lisp_Object tail
;
3706 Lisp_Object bucket
, tem
;
3708 if (!VECTORP (obarray
)
3709 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3711 obarray
= check_obarray (obarray
);
3712 obsize
= XVECTOR (obarray
)->size
;
3714 /* This is sometimes needed in the middle of GC. */
3715 obsize
&= ~ARRAY_MARK_FLAG
;
3716 hash
= hash_string (ptr
, size_byte
) % obsize
;
3717 bucket
= XVECTOR (obarray
)->contents
[hash
];
3718 oblookup_last_bucket_number
= hash
;
3719 if (EQ (bucket
, make_number (0)))
3721 else if (!SYMBOLP (bucket
))
3722 error ("Bad data in guts of obarray"); /* Like CADR error message */
3724 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3726 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3727 && SCHARS (SYMBOL_NAME (tail
)) == size
3728 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3730 else if (XSYMBOL (tail
)->next
== 0)
3733 XSETINT (tem
, hash
);
3738 hash_string (ptr
, len
)
3739 const unsigned char *ptr
;
3742 register const unsigned char *p
= ptr
;
3743 register const unsigned char *end
= p
+ len
;
3744 register unsigned char c
;
3745 register int hash
= 0;
3750 if (c
>= 0140) c
-= 40;
3751 hash
= ((hash
<<3) + (hash
>>28) + c
);
3753 return hash
& 07777777777;
3757 map_obarray (obarray
, fn
, arg
)
3758 Lisp_Object obarray
;
3759 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3763 register Lisp_Object tail
;
3764 CHECK_VECTOR (obarray
);
3765 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3767 tail
= XVECTOR (obarray
)->contents
[i
];
3772 if (XSYMBOL (tail
)->next
== 0)
3774 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3780 mapatoms_1 (sym
, function
)
3781 Lisp_Object sym
, function
;
3783 call1 (function
, sym
);
3786 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3787 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3788 OBARRAY defaults to the value of `obarray'. */)
3790 Lisp_Object function
, obarray
;
3792 if (NILP (obarray
)) obarray
= Vobarray
;
3793 obarray
= check_obarray (obarray
);
3795 map_obarray (obarray
, mapatoms_1
, function
);
3799 #define OBARRAY_SIZE 1511
3804 Lisp_Object oblength
;
3808 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3810 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3811 Vobarray
= Fmake_vector (oblength
, make_number (0));
3812 initial_obarray
= Vobarray
;
3813 staticpro (&initial_obarray
);
3814 /* Intern nil in the obarray */
3815 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3816 XSYMBOL (Qnil
)->constant
= 1;
3818 /* These locals are to kludge around a pyramid compiler bug. */
3819 hash
= hash_string ("nil", 3);
3820 /* Separate statement here to avoid VAXC bug. */
3821 hash
%= OBARRAY_SIZE
;
3822 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3825 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3826 XSYMBOL (Qnil
)->function
= Qunbound
;
3827 XSYMBOL (Qunbound
)->value
= Qunbound
;
3828 XSYMBOL (Qunbound
)->function
= Qunbound
;
3831 XSYMBOL (Qnil
)->value
= Qnil
;
3832 XSYMBOL (Qnil
)->plist
= Qnil
;
3833 XSYMBOL (Qt
)->value
= Qt
;
3834 XSYMBOL (Qt
)->constant
= 1;
3836 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3839 Qvariable_documentation
= intern ("variable-documentation");
3840 staticpro (&Qvariable_documentation
);
3842 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3843 read_buffer
= (char *) xmalloc (read_buffer_size
);
3848 struct Lisp_Subr
*sname
;
3851 sym
= intern (sname
->symbol_name
);
3852 XSETPVECTYPE (sname
, PVEC_SUBR
);
3853 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3856 #ifdef NOTDEF /* use fset in subr.el now */
3858 defalias (sname
, string
)
3859 struct Lisp_Subr
*sname
;
3863 sym
= intern (string
);
3864 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3868 /* Define an "integer variable"; a symbol whose value is forwarded
3869 to a C variable of type int. Sample call:
3870 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3872 defvar_int (namestring
, address
)
3876 Lisp_Object sym
, val
;
3877 sym
= intern (namestring
);
3878 val
= allocate_misc ();
3879 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3880 XINTFWD (val
)->intvar
= address
;
3881 SET_SYMBOL_VALUE (sym
, val
);
3884 /* Similar but define a variable whose value is t if address contains 1,
3885 nil if address contains 0. */
3887 defvar_bool (namestring
, address
)
3891 Lisp_Object sym
, val
;
3892 sym
= intern (namestring
);
3893 val
= allocate_misc ();
3894 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3895 XBOOLFWD (val
)->boolvar
= address
;
3896 SET_SYMBOL_VALUE (sym
, val
);
3897 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3900 /* Similar but define a variable whose value is the Lisp Object stored
3901 at address. Two versions: with and without gc-marking of the C
3902 variable. The nopro version is used when that variable will be
3903 gc-marked for some other reason, since marking the same slot twice
3904 can cause trouble with strings. */
3906 defvar_lisp_nopro (namestring
, address
)
3908 Lisp_Object
*address
;
3910 Lisp_Object sym
, val
;
3911 sym
= intern (namestring
);
3912 val
= allocate_misc ();
3913 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3914 XOBJFWD (val
)->objvar
= address
;
3915 SET_SYMBOL_VALUE (sym
, val
);
3919 defvar_lisp (namestring
, address
)
3921 Lisp_Object
*address
;
3923 defvar_lisp_nopro (namestring
, address
);
3924 staticpro (address
);
3927 /* Similar but define a variable whose value is the Lisp Object stored
3928 at a particular offset in the current kboard object. */
3931 defvar_kboard (namestring
, offset
)
3935 Lisp_Object sym
, val
;
3936 sym
= intern (namestring
);
3937 val
= allocate_misc ();
3938 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3939 XKBOARD_OBJFWD (val
)->offset
= offset
;
3940 SET_SYMBOL_VALUE (sym
, val
);
3943 /* Record the value of load-path used at the start of dumping
3944 so we can see if the site changed it later during dumping. */
3945 static Lisp_Object dump_path
;
3951 int turn_off_warning
= 0;
3953 /* Compute the default load-path. */
3955 normal
= PATH_LOADSEARCH
;
3956 Vload_path
= decode_env_path (0, normal
);
3958 if (NILP (Vpurify_flag
))
3959 normal
= PATH_LOADSEARCH
;
3961 normal
= PATH_DUMPLOADSEARCH
;
3963 /* In a dumped Emacs, we normally have to reset the value of
3964 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3965 uses ../lisp, instead of the path of the installed elisp
3966 libraries. However, if it appears that Vload_path was changed
3967 from the default before dumping, don't override that value. */
3970 if (! NILP (Fequal (dump_path
, Vload_path
)))
3972 Vload_path
= decode_env_path (0, normal
);
3973 if (!NILP (Vinstallation_directory
))
3975 Lisp_Object tem
, tem1
, sitelisp
;
3977 /* Remove site-lisp dirs from path temporarily and store
3978 them in sitelisp, then conc them on at the end so
3979 they're always first in path. */
3983 tem
= Fcar (Vload_path
);
3984 tem1
= Fstring_match (build_string ("site-lisp"),
3988 Vload_path
= Fcdr (Vload_path
);
3989 sitelisp
= Fcons (tem
, sitelisp
);
3995 /* Add to the path the lisp subdir of the
3996 installation dir, if it exists. */
3997 tem
= Fexpand_file_name (build_string ("lisp"),
3998 Vinstallation_directory
);
3999 tem1
= Ffile_exists_p (tem
);
4002 if (NILP (Fmember (tem
, Vload_path
)))
4004 turn_off_warning
= 1;
4005 Vload_path
= Fcons (tem
, Vload_path
);
4009 /* That dir doesn't exist, so add the build-time
4010 Lisp dirs instead. */
4011 Vload_path
= nconc2 (Vload_path
, dump_path
);
4013 /* Add leim under the installation dir, if it exists. */
4014 tem
= Fexpand_file_name (build_string ("leim"),
4015 Vinstallation_directory
);
4016 tem1
= Ffile_exists_p (tem
);
4019 if (NILP (Fmember (tem
, Vload_path
)))
4020 Vload_path
= Fcons (tem
, Vload_path
);
4023 /* Add site-lisp under the installation dir, if it exists. */
4024 tem
= Fexpand_file_name (build_string ("site-lisp"),
4025 Vinstallation_directory
);
4026 tem1
= Ffile_exists_p (tem
);
4029 if (NILP (Fmember (tem
, Vload_path
)))
4030 Vload_path
= Fcons (tem
, Vload_path
);
4033 /* If Emacs was not built in the source directory,
4034 and it is run from where it was built, add to load-path
4035 the lisp, leim and site-lisp dirs under that directory. */
4037 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4041 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4042 Vinstallation_directory
);
4043 tem1
= Ffile_exists_p (tem
);
4045 /* Don't be fooled if they moved the entire source tree
4046 AFTER dumping Emacs. If the build directory is indeed
4047 different from the source dir, src/Makefile.in and
4048 src/Makefile will not be found together. */
4049 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4050 Vinstallation_directory
);
4051 tem2
= Ffile_exists_p (tem
);
4052 if (!NILP (tem1
) && NILP (tem2
))
4054 tem
= Fexpand_file_name (build_string ("lisp"),
4057 if (NILP (Fmember (tem
, Vload_path
)))
4058 Vload_path
= Fcons (tem
, Vload_path
);
4060 tem
= Fexpand_file_name (build_string ("leim"),
4063 if (NILP (Fmember (tem
, Vload_path
)))
4064 Vload_path
= Fcons (tem
, Vload_path
);
4066 tem
= Fexpand_file_name (build_string ("site-lisp"),
4069 if (NILP (Fmember (tem
, Vload_path
)))
4070 Vload_path
= Fcons (tem
, Vload_path
);
4073 if (!NILP (sitelisp
))
4074 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4080 /* NORMAL refers to the lisp dir in the source directory. */
4081 /* We used to add ../lisp at the front here, but
4082 that caused trouble because it was copied from dump_path
4083 into Vload_path, above, when Vinstallation_directory was non-nil.
4084 It should be unnecessary. */
4085 Vload_path
= decode_env_path (0, normal
);
4086 dump_path
= Vload_path
;
4090 #if (!(defined(WINDOWSNT) || (defined(HAVE_NS))))
4091 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4092 almost never correct, thereby causing a warning to be printed out that
4093 confuses users. Since PATH_LOADSEARCH is always overridden by the
4094 EMACSLOADPATH environment variable below, disable the warning on NT. */
4096 /* Warn if dirs in the *standard* path don't exist. */
4097 if (!turn_off_warning
)
4099 Lisp_Object path_tail
;
4101 for (path_tail
= Vload_path
;
4103 path_tail
= XCDR (path_tail
))
4105 Lisp_Object dirfile
;
4106 dirfile
= Fcar (path_tail
);
4107 if (STRINGP (dirfile
))
4109 dirfile
= Fdirectory_file_name (dirfile
);
4110 if (access (SDATA (dirfile
), 0) < 0)
4111 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4116 #endif /* !(WINDOWSNT || HAVE_NS) */
4118 /* If the EMACSLOADPATH environment variable is set, use its value.
4119 This doesn't apply if we're dumping. */
4121 if (NILP (Vpurify_flag
)
4122 && egetenv ("EMACSLOADPATH"))
4124 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4128 load_in_progress
= 0;
4129 Vload_file_name
= Qnil
;
4131 load_descriptor_list
= Qnil
;
4133 Vstandard_input
= Qt
;
4134 Vloads_in_progress
= Qnil
;
4137 /* Print a warning, using format string FORMAT, that directory DIRNAME
4138 does not exist. Print it on stderr and put it in *Messages*. */
4141 dir_warning (format
, dirname
)
4143 Lisp_Object dirname
;
4146 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4148 fprintf (stderr
, format
, SDATA (dirname
));
4149 sprintf (buffer
, format
, SDATA (dirname
));
4150 /* Don't log the warning before we've initialized!! */
4152 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4159 defsubr (&Sread_from_string
);
4161 defsubr (&Sintern_soft
);
4162 defsubr (&Sunintern
);
4163 defsubr (&Sget_load_suffixes
);
4165 defsubr (&Seval_buffer
);
4166 defsubr (&Seval_region
);
4167 defsubr (&Sread_char
);
4168 defsubr (&Sread_char_exclusive
);
4169 defsubr (&Sread_event
);
4170 defsubr (&Sget_file_char
);
4171 defsubr (&Smapatoms
);
4172 defsubr (&Slocate_file_internal
);
4174 DEFVAR_LISP ("obarray", &Vobarray
,
4175 doc
: /* Symbol table for use by `intern' and `read'.
4176 It is a vector whose length ought to be prime for best results.
4177 The vector's contents don't make sense if examined from Lisp programs;
4178 to find all the symbols in an obarray, use `mapatoms'. */);
4180 DEFVAR_LISP ("values", &Vvalues
,
4181 doc
: /* List of values of all expressions which were read, evaluated and printed.
4182 Order is reverse chronological. */);
4184 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4185 doc
: /* Stream for read to get input from.
4186 See documentation of `read' for possible values. */);
4187 Vstandard_input
= Qt
;
4189 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4190 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4192 If this variable is a buffer, then only forms read from that buffer
4193 will be added to `read-symbol-positions-list'.
4194 If this variable is t, then all read forms will be added.
4195 The effect of all other values other than nil are not currently
4196 defined, although they may be in the future.
4198 The positions are relative to the last call to `read' or
4199 `read-from-string'. It is probably a bad idea to set this variable at
4200 the toplevel; bind it instead. */);
4201 Vread_with_symbol_positions
= Qnil
;
4203 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4204 doc
: /* A list mapping read symbols to their positions.
4205 This variable is modified during calls to `read' or
4206 `read-from-string', but only when `read-with-symbol-positions' is
4209 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4210 CHAR-POSITION is an integer giving the offset of that occurrence of the
4211 symbol from the position where `read' or `read-from-string' started.
4213 Note that a symbol will appear multiple times in this list, if it was
4214 read multiple times. The list is in the same order as the symbols
4216 Vread_symbol_positions_list
= Qnil
;
4218 DEFVAR_LISP ("load-path", &Vload_path
,
4219 doc
: /* *List of directories to search for files to load.
4220 Each element is a string (directory name) or nil (try default directory).
4221 Initialized based on EMACSLOADPATH environment variable, if any,
4222 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4224 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4225 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4226 This list should not include the empty string.
4227 `load' and related functions try to append these suffixes, in order,
4228 to the specified file name if a Lisp suffix is allowed or required. */);
4229 Vload_suffixes
= Fcons (build_string (".elc"),
4230 Fcons (build_string (".el"), Qnil
));
4231 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4232 doc
: /* List of suffixes that indicate representations of \
4234 This list should normally start with the empty string.
4236 Enabling Auto Compression mode appends the suffixes in
4237 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4238 mode removes them again. `load' and related functions use this list to
4239 determine whether they should look for compressed versions of a file
4240 and, if so, which suffixes they should try to append to the file name
4241 in order to do so. However, if you want to customize which suffixes
4242 the loading functions recognize as compression suffixes, you should
4243 customize `jka-compr-load-suffixes' rather than the present variable. */);
4244 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4246 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4247 doc
: /* Non-nil if inside of `load'. */);
4249 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4250 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4251 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4253 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4254 a symbol \(a feature name).
4256 When `load' is run and the file-name argument matches an element's
4257 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4258 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4260 An error in FORMS does not undo the load, but does prevent execution of
4261 the rest of the FORMS. */);
4262 Vafter_load_alist
= Qnil
;
4264 DEFVAR_LISP ("load-history", &Vload_history
,
4265 doc
: /* Alist mapping file names to symbols and features.
4266 Each alist element is a list that starts with a file name,
4267 except for one element (optional) that starts with nil and describes
4268 definitions evaluated from buffers not visiting files.
4270 The file name is absolute and is the true file name (i.e. it doesn't
4271 contain symbolic links) of the loaded file.
4273 The remaining elements of each list are symbols defined as variables
4274 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4275 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4276 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4277 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
4278 this file redefined it as a function.
4280 During preloading, the file name recorded is relative to the main Lisp
4281 directory. These file names are converted to absolute at startup. */);
4282 Vload_history
= Qnil
;
4284 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4285 doc
: /* Full name of file being loaded by `load'. */);
4286 Vload_file_name
= Qnil
;
4288 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4289 doc
: /* File name, including directory, of user's initialization file.
4290 If the file loaded had extension `.elc', and the corresponding source file
4291 exists, this variable contains the name of source file, suitable for use
4292 by functions like `custom-save-all' which edit the init file.
4293 While Emacs loads and evaluates the init file, value is the real name
4294 of the file, regardless of whether or not it has the `.elc' extension. */);
4295 Vuser_init_file
= Qnil
;
4297 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4298 doc
: /* Used for internal purposes by `load'. */);
4299 Vcurrent_load_list
= Qnil
;
4301 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4302 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4303 The default is nil, which means use the function `read'. */);
4304 Vload_read_function
= Qnil
;
4306 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4307 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4308 This function is for doing code conversion before reading the source file.
4309 If nil, loading is done without any code conversion.
4310 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4311 FULLNAME is the full name of FILE.
4312 See `load' for the meaning of the remaining arguments. */);
4313 Vload_source_file_function
= Qnil
;
4315 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4316 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4317 This is useful when the file being loaded is a temporary copy. */);
4318 load_force_doc_strings
= 0;
4320 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4321 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4322 This is normally bound by `load' and `eval-buffer' to control `read',
4323 and is not meant for users to change. */);
4324 load_convert_to_unibyte
= 0;
4326 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4327 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4328 You cannot count on them to still be there! */);
4330 = Fexpand_file_name (build_string ("../"),
4331 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4333 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4334 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4335 Vpreloaded_file_list
= Qnil
;
4337 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4338 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4339 Vbyte_boolean_vars
= Qnil
;
4341 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4342 doc
: /* Non-nil means load dangerous compiled Lisp files.
4343 Some versions of XEmacs use different byte codes than Emacs. These
4344 incompatible byte codes can make Emacs crash when it tries to execute
4346 load_dangerous_libraries
= 0;
4348 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4349 doc
: /* Regular expression matching safe to load compiled Lisp files.
4350 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4351 from the file, and matches them against this regular expression.
4352 When the regular expression matches, the file is considered to be safe
4353 to load. See also `load-dangerous-libraries'. */);
4354 Vbytecomp_version_regexp
4355 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4357 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4358 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4359 Veval_buffer_list
= Qnil
;
4361 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4362 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4363 Vold_style_backquotes
= Qnil
;
4364 Qold_style_backquotes
= intern ("old-style-backquotes");
4365 staticpro (&Qold_style_backquotes
);
4367 /* Vsource_directory was initialized in init_lread. */
4369 load_descriptor_list
= Qnil
;
4370 staticpro (&load_descriptor_list
);
4372 Qcurrent_load_list
= intern ("current-load-list");
4373 staticpro (&Qcurrent_load_list
);
4375 Qstandard_input
= intern ("standard-input");
4376 staticpro (&Qstandard_input
);
4378 Qread_char
= intern ("read-char");
4379 staticpro (&Qread_char
);
4381 Qget_file_char
= intern ("get-file-char");
4382 staticpro (&Qget_file_char
);
4384 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4385 staticpro (&Qget_emacs_mule_file_char
);
4387 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4388 staticpro (&Qload_force_doc_strings
);
4390 Qbackquote
= intern ("`");
4391 staticpro (&Qbackquote
);
4392 Qcomma
= intern (",");
4393 staticpro (&Qcomma
);
4394 Qcomma_at
= intern (",@");
4395 staticpro (&Qcomma_at
);
4396 Qcomma_dot
= intern (",.");
4397 staticpro (&Qcomma_dot
);
4399 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4400 staticpro (&Qinhibit_file_name_operation
);
4402 Qascii_character
= intern ("ascii-character");
4403 staticpro (&Qascii_character
);
4405 Qfunction
= intern ("function");
4406 staticpro (&Qfunction
);
4408 Qload
= intern ("load");
4411 Qload_file_name
= intern ("load-file-name");
4412 staticpro (&Qload_file_name
);
4414 Qeval_buffer_list
= intern ("eval-buffer-list");
4415 staticpro (&Qeval_buffer_list
);
4417 Qfile_truename
= intern ("file-truename");
4418 staticpro (&Qfile_truename
) ;
4420 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4421 staticpro (&Qdo_after_load_evaluation
) ;
4423 staticpro (&dump_path
);
4425 staticpro (&read_objects
);
4426 read_objects
= Qnil
;
4427 staticpro (&seen_list
);
4430 Vloads_in_progress
= Qnil
;
4431 staticpro (&Vloads_in_progress
);
4434 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4435 (do not change this comment) */