1 /* Lisp parsing and input streams.
3 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997,
4 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 2009, 2010 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include <sys/types.h>
31 #include "intervals.h"
33 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
56 #endif /* HAVE_SETLOCALE */
61 #define file_offset off_t
62 #define file_tell ftello
64 #define file_offset long
65 #define file_tell ftell
68 /* hash table read constants */
69 Lisp_Object Qhash_table
, Qdata
;
70 Lisp_Object Qtest
, Qsize
;
71 Lisp_Object Qweakness
;
72 Lisp_Object Qrehash_size
;
73 Lisp_Object Qrehash_threshold
;
75 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
76 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
77 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
78 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
79 Lisp_Object Qinhibit_file_name_operation
;
80 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
81 Lisp_Object Qlexical_binding
;
82 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
84 /* Used instead of Qget_file_char while loading *.elc files compiled
85 by Emacs 21 or older. */
86 static Lisp_Object Qget_emacs_mule_file_char
;
88 static Lisp_Object Qload_force_doc_strings
;
90 extern Lisp_Object Qinternal_interpreter_environment
;
92 /* non-zero if inside `load' */
94 static Lisp_Object Qload_in_progress
;
96 /* Directory in which the sources were found. */
97 Lisp_Object Vsource_directory
;
99 /* Search path and suffixes for files to be loaded. */
100 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
102 /* File name of user's init file. */
103 Lisp_Object Vuser_init_file
;
105 /* This is the user-visible association list that maps features to
106 lists of defs in their load files. */
107 Lisp_Object Vload_history
;
109 /* This is used to build the load history. */
110 Lisp_Object Vcurrent_load_list
;
112 /* List of files that were preloaded. */
113 Lisp_Object Vpreloaded_file_list
;
115 /* Name of file actually being read by `load'. */
116 Lisp_Object Vload_file_name
;
118 /* Function to use for reading, in `load' and friends. */
119 Lisp_Object Vload_read_function
;
121 /* Non-nil means read recursive structures using #n= and #n# syntax. */
122 Lisp_Object Vread_circle
;
124 /* The association list of objects read with the #n=object form.
125 Each member of the list has the form (n . object), and is used to
126 look up the object for the corresponding #n# construct.
127 It must be set to nil before all top-level calls to read0. */
128 Lisp_Object read_objects
;
130 /* Nonzero means load should forcibly load all dynamic doc strings. */
131 static int load_force_doc_strings
;
133 /* Nonzero means read should convert strings to unibyte. */
134 static int load_convert_to_unibyte
;
136 /* Nonzero means READCHAR should read bytes one by one (not character)
137 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
138 This is set to 1 by read1 temporarily while handling #@NUMBER. */
139 static int load_each_byte
;
141 /* Function to use for loading an Emacs Lisp source file (not
142 compiled) instead of readevalloop. */
143 Lisp_Object Vload_source_file_function
;
145 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
146 Lisp_Object Vbyte_boolean_vars
;
148 /* Whether or not to add a `read-positions' property to symbols
150 Lisp_Object Vread_with_symbol_positions
;
152 /* List of (SYMBOL . POSITION) accumulated so far. */
153 Lisp_Object Vread_symbol_positions_list
;
155 /* If non-nil `readevalloop' evaluates code in a lexical environment. */
156 Lisp_Object Vlexical_binding
;
158 /* List of descriptors now open for Fload. */
159 static Lisp_Object load_descriptor_list
;
161 /* File for get_file_char to read from. Use by load. */
162 static FILE *instream
;
164 /* When nonzero, read conses in pure space */
165 static int read_pure
;
167 /* For use within read-from-string (this reader is non-reentrant!!) */
168 static EMACS_INT read_from_string_index
;
169 static EMACS_INT read_from_string_index_byte
;
170 static EMACS_INT read_from_string_limit
;
172 /* Number of characters read in the current call to Fread or
173 Fread_from_string. */
174 static EMACS_INT readchar_count
;
176 /* This contains the last string skipped with #@. */
177 static char *saved_doc_string
;
178 /* Length of buffer allocated in saved_doc_string. */
179 static int saved_doc_string_size
;
180 /* Length of actual data in saved_doc_string. */
181 static int saved_doc_string_length
;
182 /* This is the file position that string came from. */
183 static file_offset saved_doc_string_position
;
185 /* This contains the previous string skipped with #@.
186 We copy it from saved_doc_string when a new string
187 is put in saved_doc_string. */
188 static char *prev_saved_doc_string
;
189 /* Length of buffer allocated in prev_saved_doc_string. */
190 static int prev_saved_doc_string_size
;
191 /* Length of actual data in prev_saved_doc_string. */
192 static int prev_saved_doc_string_length
;
193 /* This is the file position that string came from. */
194 static file_offset prev_saved_doc_string_position
;
196 /* Nonzero means inside a new-style backquote
197 with no surrounding parentheses.
198 Fread initializes this to zero, so we need not specbind it
199 or worry about what happens to it when there is an error. */
200 static int new_backquote_flag
;
201 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
203 /* A list of file names for files being loaded in Fload. Used to
204 check for recursive loads. */
206 static Lisp_Object Vloads_in_progress
;
208 /* Non-zero means load dangerous compiled Lisp files. */
210 int load_dangerous_libraries
;
212 /* Non-zero means force printing messages when loading Lisp files. */
214 int force_load_messages
;
216 /* A regular expression used to detect files compiled with Emacs. */
218 static Lisp_Object Vbytecomp_version_regexp
;
220 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
223 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
,
224 Lisp_Object (*) (Lisp_Object
), int,
225 Lisp_Object
, Lisp_Object
,
226 Lisp_Object
, Lisp_Object
);
227 static Lisp_Object
load_unwind (Lisp_Object
);
228 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
230 static void invalid_syntax (const char *, int) NO_RETURN
;
231 static void end_of_file_error (void) NO_RETURN
;
234 /* Functions that read one byte from the current source READCHARFUN
235 or unreads one byte. If the integer argument C is -1, it returns
236 one read byte, or -1 when there's no more byte in the source. If C
237 is 0 or positive, it unreads C, and the return value is not
240 static int readbyte_for_lambda (int, Lisp_Object
);
241 static int readbyte_from_file (int, Lisp_Object
);
242 static int readbyte_from_string (int, Lisp_Object
);
244 /* Handle unreading and rereading of characters.
245 Write READCHAR to read a character,
246 UNREAD(c) to unread c to be read again.
248 These macros correctly read/unread multibyte characters. */
250 #define READCHAR readchar (readcharfun, NULL)
251 #define UNREAD(c) unreadchar (readcharfun, c)
253 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
254 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
256 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
257 Qlambda, or a cons, we use this to keep an unread character because
258 a file stream can't handle multibyte-char unreading. The value -1
259 means that there's no unread character. */
260 static int unread_char
;
263 readchar (Lisp_Object readcharfun
, int *multibyte
)
267 int (*readbyte
) (int, Lisp_Object
);
268 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
270 int emacs_mule_encoding
= 0;
277 if (BUFFERP (readcharfun
))
279 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
281 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
283 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
286 if (! NILP (inbuffer
->enable_multibyte_characters
))
288 /* Fetch the character code from the buffer. */
289 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
290 BUF_INC_POS (inbuffer
, pt_byte
);
297 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
298 if (! ASCII_BYTE_P (c
))
299 c
= BYTE8_TO_CHAR (c
);
302 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
306 if (MARKERP (readcharfun
))
308 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
310 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
312 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
315 if (! NILP (inbuffer
->enable_multibyte_characters
))
317 /* Fetch the character code from the buffer. */
318 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
319 BUF_INC_POS (inbuffer
, bytepos
);
326 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
327 if (! ASCII_BYTE_P (c
))
328 c
= BYTE8_TO_CHAR (c
);
332 XMARKER (readcharfun
)->bytepos
= bytepos
;
333 XMARKER (readcharfun
)->charpos
++;
338 if (EQ (readcharfun
, Qlambda
))
340 readbyte
= readbyte_for_lambda
;
344 if (EQ (readcharfun
, Qget_file_char
))
346 readbyte
= readbyte_from_file
;
350 if (STRINGP (readcharfun
))
352 if (read_from_string_index
>= read_from_string_limit
)
354 else if (STRING_MULTIBYTE (readcharfun
))
358 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
359 read_from_string_index
,
360 read_from_string_index_byte
);
364 c
= SREF (readcharfun
, read_from_string_index_byte
);
365 read_from_string_index
++;
366 read_from_string_index_byte
++;
371 if (CONSP (readcharfun
))
373 /* This is the case that read_vector is reading from a unibyte
374 string that contains a byte sequence previously skipped
375 because of #@NUMBER. The car part of readcharfun is that
376 string, and the cdr part is a value of readcharfun given to
378 readbyte
= readbyte_from_string
;
379 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
380 emacs_mule_encoding
= 1;
384 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
386 readbyte
= readbyte_from_file
;
387 emacs_mule_encoding
= 1;
391 tem
= call0 (readcharfun
);
398 if (unread_char
>= 0)
404 c
= (*readbyte
) (-1, readcharfun
);
405 if (c
< 0 || load_each_byte
)
409 if (ASCII_BYTE_P (c
))
411 if (emacs_mule_encoding
)
412 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
415 len
= BYTES_BY_CHAR_HEAD (c
);
418 c
= (*readbyte
) (-1, readcharfun
);
419 if (c
< 0 || ! TRAILING_CODE_P (c
))
422 (*readbyte
) (buf
[i
], readcharfun
);
423 return BYTE8_TO_CHAR (buf
[0]);
427 return STRING_CHAR (buf
);
430 /* Unread the character C in the way appropriate for the stream READCHARFUN.
431 If the stream is a user function, call it with the char as argument. */
434 unreadchar (Lisp_Object readcharfun
, int c
)
438 /* Don't back up the pointer if we're unreading the end-of-input mark,
439 since readchar didn't advance it when we read it. */
441 else if (BUFFERP (readcharfun
))
443 struct buffer
*b
= XBUFFER (readcharfun
);
444 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
447 if (! NILP (b
->enable_multibyte_characters
))
448 BUF_DEC_POS (b
, bytepos
);
452 BUF_PT_BYTE (b
) = bytepos
;
454 else if (MARKERP (readcharfun
))
456 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
457 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
459 XMARKER (readcharfun
)->charpos
--;
460 if (! NILP (b
->enable_multibyte_characters
))
461 BUF_DEC_POS (b
, bytepos
);
465 XMARKER (readcharfun
)->bytepos
= bytepos
;
467 else if (STRINGP (readcharfun
))
469 read_from_string_index
--;
470 read_from_string_index_byte
471 = string_char_to_byte (readcharfun
, read_from_string_index
);
473 else if (CONSP (readcharfun
))
477 else if (EQ (readcharfun
, Qlambda
))
481 else if (EQ (readcharfun
, Qget_file_char
)
482 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
487 ungetc (c
, instream
);
494 call1 (readcharfun
, make_number (c
));
498 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
500 return read_bytecode_char (c
>= 0);
505 readbyte_from_file (int c
, Lisp_Object readcharfun
)
510 ungetc (c
, instream
);
519 /* Interrupted reads have been observed while reading over the network */
520 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
532 return (c
== EOF
? -1 : c
);
536 readbyte_from_string (int c
, Lisp_Object readcharfun
)
538 Lisp_Object string
= XCAR (readcharfun
);
542 read_from_string_index
--;
543 read_from_string_index_byte
544 = string_char_to_byte (string
, read_from_string_index
);
547 if (read_from_string_index
>= read_from_string_limit
)
550 FETCH_STRING_CHAR_ADVANCE (c
, string
,
551 read_from_string_index
,
552 read_from_string_index_byte
);
557 /* Read one non-ASCII character from INSTREAM. The character is
558 encoded in `emacs-mule' and the first byte is already read in
562 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
564 /* Emacs-mule coding uses at most 4-byte for one character. */
565 unsigned char buf
[4];
566 int len
= emacs_mule_bytes
[c
];
567 struct charset
*charset
;
572 /* C is not a valid leading-code of `emacs-mule'. */
573 return BYTE8_TO_CHAR (c
);
579 c
= (*readbyte
) (-1, readcharfun
);
583 (*readbyte
) (buf
[i
], readcharfun
);
584 return BYTE8_TO_CHAR (buf
[0]);
591 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
592 code
= buf
[1] & 0x7F;
596 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
597 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
599 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
600 code
= buf
[2] & 0x7F;
604 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
605 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
610 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
611 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
613 c
= DECODE_CHAR (charset
, code
);
615 Fsignal (Qinvalid_read_syntax
,
616 Fcons (build_string ("invalid multibyte form"), Qnil
));
621 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
623 static Lisp_Object
read0 (Lisp_Object
);
624 static Lisp_Object
read1 (Lisp_Object
, int *, int);
626 static Lisp_Object
read_list (int, Lisp_Object
);
627 static Lisp_Object
read_vector (Lisp_Object
, int);
629 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
631 static void substitute_object_in_subtree (Lisp_Object
,
633 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
636 /* Get a character from the tty. */
638 /* Read input events until we get one that's acceptable for our purposes.
640 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
641 until we get a character we like, and then stuffed into
644 If ASCII_REQUIRED is non-zero, we check function key events to see
645 if the unmodified version of the symbol has a Qascii_character
646 property, and use that character, if present.
648 If ERROR_NONASCII is non-zero, we signal an error if the input we
649 get isn't an ASCII character with modifiers. If it's zero but
650 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
653 If INPUT_METHOD is nonzero, we invoke the current input method
654 if the character warrants that.
656 If SECONDS is a number, we wait that many seconds for input, and
657 return Qnil if no input arrives within that time. */
660 read_filtered_event (int no_switch_frame
, int ascii_required
,
661 int error_nonascii
, int input_method
, Lisp_Object seconds
)
663 Lisp_Object val
, delayed_switch_frame
;
666 #ifdef HAVE_WINDOW_SYSTEM
667 if (display_hourglass_p
)
671 delayed_switch_frame
= Qnil
;
673 /* Compute timeout. */
674 if (NUMBERP (seconds
))
676 EMACS_TIME wait_time
;
678 double duration
= extract_float (seconds
);
680 sec
= (int) duration
;
681 usec
= (duration
- sec
) * 1000000;
682 EMACS_GET_TIME (end_time
);
683 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
684 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
687 /* Read until we get an acceptable event. */
690 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
691 NUMBERP (seconds
) ? &end_time
: NULL
);
692 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
697 /* switch-frame events are put off until after the next ASCII
698 character. This is better than signaling an error just because
699 the last characters were typed to a separate minibuffer frame,
700 for example. Eventually, some code which can deal with
701 switch-frame events will read it and process it. */
703 && EVENT_HAS_PARAMETERS (val
)
704 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
706 delayed_switch_frame
= val
;
710 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
712 /* Convert certain symbols to their ASCII equivalents. */
715 Lisp_Object tem
, tem1
;
716 tem
= Fget (val
, Qevent_symbol_element_mask
);
719 tem1
= Fget (Fcar (tem
), Qascii_character
);
720 /* Merge this symbol's modifier bits
721 with the ASCII equivalent of its basic code. */
723 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
727 /* If we don't have a character now, deal with it appropriately. */
732 Vunread_command_events
= Fcons (val
, Qnil
);
733 error ("Non-character input-event");
740 if (! NILP (delayed_switch_frame
))
741 unread_switch_frame
= delayed_switch_frame
;
745 #ifdef HAVE_WINDOW_SYSTEM
746 if (display_hourglass_p
)
755 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
756 doc
: /* Read a character from the command input (keyboard or macro).
757 It is returned as a number.
758 If the character has modifiers, they are resolved and reflected to the
759 character code if possible (e.g. C-SPC -> 0).
761 If the user generates an event which is not a character (i.e. a mouse
762 click or function key event), `read-char' signals an error. As an
763 exception, switch-frame events are put off until non-character events
765 If you want to read non-character events, or ignore them, call
766 `read-event' or `read-char-exclusive' instead.
768 If the optional argument PROMPT is non-nil, display that as a prompt.
769 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
770 input method is turned on in the current buffer, that input method
771 is used for reading a character.
772 If the optional argument SECONDS is non-nil, it should be a number
773 specifying the maximum number of seconds to wait for input. If no
774 input arrives in that time, return nil. SECONDS may be a
775 floating-point value. */)
776 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
781 message_with_string ("%s", prompt
, 0);
782 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
784 return (NILP (val
) ? Qnil
785 : make_number (char_resolve_modifier_mask (XINT (val
))));
788 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
789 doc
: /* Read an event object from the input stream.
790 If the optional argument PROMPT is non-nil, display that as a prompt.
791 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
792 input method is turned on in the current buffer, that input method
793 is used for reading a character.
794 If the optional argument SECONDS is non-nil, it should be a number
795 specifying the maximum number of seconds to wait for input. If no
796 input arrives in that time, return nil. SECONDS may be a
797 floating-point value. */)
798 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
801 message_with_string ("%s", prompt
, 0);
802 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
805 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
806 doc
: /* Read a character from the command input (keyboard or macro).
807 It is returned as a number. Non-character events are ignored.
808 If the character has modifiers, they are resolved and reflected to the
809 character code if possible (e.g. C-SPC -> 0).
811 If the optional argument PROMPT is non-nil, display that as a prompt.
812 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
813 input method is turned on in the current buffer, that input method
814 is used for reading a character.
815 If the optional argument SECONDS is non-nil, it should be a number
816 specifying the maximum number of seconds to wait for input. If no
817 input arrives in that time, return nil. SECONDS may be a
818 floating-point value. */)
819 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
824 message_with_string ("%s", prompt
, 0);
826 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
828 return (NILP (val
) ? Qnil
829 : make_number (char_resolve_modifier_mask (XINT (val
))));
832 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
833 doc
: /* Don't use this yourself. */)
836 register Lisp_Object val
;
838 XSETINT (val
, getc (instream
));
846 /* Return true if the lisp code read using READCHARFUN defines a non-nil
847 `lexical-binding' file variable. After returning, the stream is
848 positioned following the first line, if it is a comment, otherwise
852 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
856 /* The first line isn't a comment, just give up. */
862 /* Look for an appropriate file-variable in the first line. */
866 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
867 } beg_end_state
= NOMINAL
;
868 int in_file_vars
= 0;
870 #define UPDATE_BEG_END_STATE(ch) \
871 if (beg_end_state == NOMINAL) \
872 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
873 else if (beg_end_state == AFTER_FIRST_DASH) \
874 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
875 else if (beg_end_state == AFTER_ASTERIX) \
878 in_file_vars = !in_file_vars; \
879 beg_end_state = NOMINAL; \
882 /* Skip until we get to the file vars, if any. */
886 UPDATE_BEG_END_STATE (ch
);
888 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
892 char var
[100], *var_end
, val
[100], *val_end
;
896 /* Read a variable name. */
897 while (ch
== ' ' || ch
== '\t')
901 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
903 if (var_end
< var
+ sizeof var
- 1)
905 UPDATE_BEG_END_STATE (ch
);
910 && (var_end
[-1] == ' ' || var_end
[-1] == '\t'))
916 /* Read a variable value. */
919 while (ch
== ' ' || ch
== '\t')
923 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
925 if (val_end
< val
+ sizeof val
- 1)
927 UPDATE_BEG_END_STATE (ch
);
931 /* The value was terminated by an end-marker, which
935 && (val_end
[-1] == ' ' || val_end
[-1] == '\t'))
939 if (strcmp (var
, "lexical-binding") == 0)
942 rv
= (strcmp (val
, "nil") != 0);
948 while (ch
!= '\n' && ch
!= EOF
)
956 /* Value is a version number of byte compiled code if the file
957 associated with file descriptor FD is a compiled Lisp file that's
958 safe to load. Only files compiled with Emacs are safe to load.
959 Files compiled with XEmacs can lead to a crash in Fbyte_code
960 because of an incompatible change in the byte compiler. */
963 safe_to_load_p (int fd
)
970 /* Read the first few bytes from the file, and look for a line
971 specifying the byte compiler version used. */
972 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
977 /* Skip to the next newline, skipping over the initial `ELC'
978 with NUL bytes following it, but note the version. */
979 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
984 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
991 lseek (fd
, 0, SEEK_SET
);
996 /* Callback for record_unwind_protect. Restore the old load list OLD,
997 after loading a file successfully. */
1000 record_load_unwind (Lisp_Object old
)
1002 return Vloads_in_progress
= old
;
1005 /* This handler function is used via internal_condition_case_1. */
1008 load_error_handler (Lisp_Object data
)
1014 load_warn_old_style_backquotes (Lisp_Object file
)
1016 if (!NILP (Vold_style_backquotes
))
1018 Lisp_Object args
[2];
1019 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
1026 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1027 doc
: /* Return the suffixes that `load' should try if a suffix is \
1029 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1032 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1033 while (CONSP (suffixes
))
1035 Lisp_Object exts
= Vload_file_rep_suffixes
;
1036 suffix
= XCAR (suffixes
);
1037 suffixes
= XCDR (suffixes
);
1038 while (CONSP (exts
))
1042 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1045 return Fnreverse (lst
);
1048 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1049 doc
: /* Execute a file of Lisp code named FILE.
1050 First try FILE with `.elc' appended, then try with `.el',
1051 then try FILE unmodified (the exact suffixes in the exact order are
1052 determined by `load-suffixes'). Environment variable references in
1053 FILE are replaced with their values by calling `substitute-in-file-name'.
1054 This function searches the directories in `load-path'.
1056 If optional second arg NOERROR is non-nil,
1057 report no error if FILE doesn't exist.
1058 Print messages at start and end of loading unless
1059 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1061 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1062 suffixes `.elc' or `.el' to the specified name FILE.
1063 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1064 the suffix `.elc' or `.el'; don't accept just FILE unless
1065 it ends in one of those suffixes or includes a directory name.
1067 If this function fails to find a file, it may look for different
1068 representations of that file before trying another file.
1069 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1070 to the file name. Emacs uses this feature mainly to find compressed
1071 versions of files when Auto Compression mode is enabled.
1073 The exact suffixes that this function tries out, in the exact order,
1074 are given by the value of the variable `load-file-rep-suffixes' if
1075 NOSUFFIX is non-nil and by the return value of the function
1076 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1077 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1078 and then the former.
1080 Loading a file records its definitions, and its `provide' and
1081 `require' calls, in an element of `load-history' whose
1082 car is the file name loaded. See `load-history'.
1084 While the file is in the process of being loaded, the variable
1085 `load-in-progress' is non-nil and the variable `load-file-name'
1086 is bound to the file's name.
1088 Return t if the file exists and loads successfully. */)
1089 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1091 register FILE *stream
;
1092 register int fd
= -1;
1093 int count
= SPECPDL_INDEX ();
1094 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1095 Lisp_Object found
, efound
, hist_file_name
;
1096 /* 1 means we printed the ".el is newer" message. */
1098 /* 1 means we are loading a compiled file. */
1100 Lisp_Object handler
;
1102 const char *fmode
= "r";
1110 CHECK_STRING (file
);
1112 /* If file name is magic, call the handler. */
1113 /* This shouldn't be necessary any more now that `openp' handles it right.
1114 handler = Ffind_file_name_handler (file, Qload);
1115 if (!NILP (handler))
1116 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1118 /* Do this after the handler to avoid
1119 the need to gcpro noerror, nomessage and nosuffix.
1120 (Below here, we care only whether they are nil or not.)
1121 The presence of this call is the result of a historical accident:
1122 it used to be in every file-operation and when it got removed
1123 everywhere, it accidentally stayed here. Since then, enough people
1124 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1125 that it seemed risky to remove. */
1126 if (! NILP (noerror
))
1128 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1129 Qt
, load_error_handler
);
1134 file
= Fsubstitute_in_file_name (file
);
1137 /* Avoid weird lossage with null string as arg,
1138 since it would try to load a directory as a Lisp file */
1139 if (SCHARS (file
) > 0)
1141 int size
= SBYTES (file
);
1144 GCPRO2 (file
, found
);
1146 if (! NILP (must_suffix
))
1148 /* Don't insist on adding a suffix if FILE already ends with one. */
1150 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1153 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1155 /* Don't insist on adding a suffix
1156 if the argument includes a directory name. */
1157 else if (! NILP (Ffile_name_directory (file
)))
1161 fd
= openp (Vload_path
, file
,
1162 (!NILP (nosuffix
) ? Qnil
1163 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1164 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1165 tmp
[1] = Vload_file_rep_suffixes
,
1174 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1178 /* Tell startup.el whether or not we found the user's init file. */
1179 if (EQ (Qt
, Vuser_init_file
))
1180 Vuser_init_file
= found
;
1182 /* If FD is -2, that means openp found a magic file. */
1185 if (NILP (Fequal (found
, file
)))
1186 /* If FOUND is a different file name from FILE,
1187 find its handler even if we have already inhibited
1188 the `load' operation on FILE. */
1189 handler
= Ffind_file_name_handler (found
, Qt
);
1191 handler
= Ffind_file_name_handler (found
, Qload
);
1192 if (! NILP (handler
))
1193 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1196 /* Check if we're stuck in a recursive load cycle.
1198 2000-09-21: It's not possible to just check for the file loaded
1199 being a member of Vloads_in_progress. This fails because of the
1200 way the byte compiler currently works; `provide's are not
1201 evaluated, see font-lock.el/jit-lock.el as an example. This
1202 leads to a certain amount of ``normal'' recursion.
1204 Also, just loading a file recursively is not always an error in
1205 the general case; the second load may do something different. */
1209 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1210 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1214 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1216 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1217 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1220 /* All loads are by default dynamic, unless the file itself specifies
1221 otherwise using a file-variable in the first line. This is bound here
1222 so that it takes effect whether or not we use
1223 Vload_source_file_function. */
1224 specbind (Qlexical_binding
, Qnil
);
1226 /* Get the name for load-history. */
1227 hist_file_name
= (! NILP (Vpurify_flag
)
1228 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1229 tmp
[1] = Ffile_name_nondirectory (found
),
1235 /* Check for the presence of old-style quotes and warn about them. */
1236 specbind (Qold_style_backquotes
, Qnil
);
1237 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1239 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1240 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1241 /* Load .elc files directly, but not when they are
1242 remote and have no handler! */
1249 GCPRO3 (file
, found
, hist_file_name
);
1252 && ! (version
= safe_to_load_p (fd
)))
1255 if (!load_dangerous_libraries
)
1259 error ("File `%s' was not compiled in Emacs",
1262 else if (!NILP (nomessage
) && !force_load_messages
)
1263 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1268 efound
= ENCODE_FILE (found
);
1273 stat ((char *)SDATA (efound
), &s1
);
1274 SSET (efound
, SBYTES (efound
) - 1, 0);
1275 result
= stat ((char *)SDATA (efound
), &s2
);
1276 SSET (efound
, SBYTES (efound
) - 1, 'c');
1278 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1280 /* Make the progress messages mention that source is newer. */
1283 /* If we won't print another message, mention this anyway. */
1284 if (!NILP (nomessage
) && !force_load_messages
)
1286 Lisp_Object msg_file
;
1287 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1288 message_with_string ("Source file `%s' newer than byte-compiled file",
1297 /* We are loading a source file (*.el). */
1298 if (!NILP (Vload_source_file_function
))
1304 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1305 NILP (noerror
) ? Qnil
: Qt
,
1306 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1307 return unbind_to (count
, val
);
1311 GCPRO3 (file
, found
, hist_file_name
);
1315 efound
= ENCODE_FILE (found
);
1316 stream
= fopen ((char *) SDATA (efound
), fmode
);
1317 #else /* not WINDOWSNT */
1318 stream
= fdopen (fd
, fmode
);
1319 #endif /* not WINDOWSNT */
1323 error ("Failure to create stdio stream for %s", SDATA (file
));
1326 if (! NILP (Vpurify_flag
))
1327 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1329 if (NILP (nomessage
) || force_load_messages
)
1332 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1335 message_with_string ("Loading %s (source)...", file
, 1);
1337 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1339 else /* The typical case; compiled file newer than source file. */
1340 message_with_string ("Loading %s...", file
, 1);
1343 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1344 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1345 specbind (Qload_file_name
, found
);
1346 specbind (Qinhibit_file_name_operation
, Qnil
);
1347 load_descriptor_list
1348 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1350 specbind (Qload_in_progress
, Qt
);
1353 if (lisp_file_lexically_bound_p (Qget_file_char
))
1354 Fset (Qlexical_binding
, Qt
);
1356 if (! version
|| version
>= 22)
1357 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1358 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1361 /* We can't handle a file which was compiled with
1362 byte-compile-dynamic by older version of Emacs. */
1363 specbind (Qload_force_doc_strings
, Qt
);
1364 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1365 0, Qnil
, Qnil
, Qnil
, Qnil
);
1367 unbind_to (count
, Qnil
);
1369 /* Run any eval-after-load forms for this file */
1370 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1371 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1375 xfree (saved_doc_string
);
1376 saved_doc_string
= 0;
1377 saved_doc_string_size
= 0;
1379 xfree (prev_saved_doc_string
);
1380 prev_saved_doc_string
= 0;
1381 prev_saved_doc_string_size
= 0;
1383 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1386 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1389 message_with_string ("Loading %s (source)...done", file
, 1);
1391 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1393 else /* The typical case; compiled file newer than source file. */
1394 message_with_string ("Loading %s...done", file
, 1);
1401 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1403 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1414 load_descriptor_unwind (Lisp_Object oldlist
)
1416 load_descriptor_list
= oldlist
;
1420 /* Close all descriptors in use for Floads.
1421 This is used when starting a subprocess. */
1424 close_load_descs (void)
1428 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1429 emacs_close (XFASTINT (XCAR (tail
)));
1434 complete_filename_p (Lisp_Object pathname
)
1436 register const unsigned char *s
= SDATA (pathname
);
1437 return (IS_DIRECTORY_SEP (s
[0])
1438 || (SCHARS (pathname
) > 2
1439 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1442 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1443 doc
: /* Search for FILENAME through PATH.
1444 Returns the file's name in absolute form, or nil if not found.
1445 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1446 file name when searching.
1447 If non-nil, PREDICATE is used instead of `file-readable-p'.
1448 PREDICATE can also be an integer to pass to the access(2) function,
1449 in which case file-name-handlers are ignored. */)
1450 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1453 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1454 if (NILP (predicate
) && fd
> 0)
1460 /* Search for a file whose name is STR, looking in directories
1461 in the Lisp list PATH, and trying suffixes from SUFFIX.
1462 On success, returns a file descriptor. On failure, returns -1.
1464 SUFFIXES is a list of strings containing possible suffixes.
1465 The empty suffix is automatically added if the list is empty.
1467 PREDICATE non-nil means don't open the files,
1468 just look for one that satisfies the predicate. In this case,
1469 returns 1 on success. The predicate can be a lisp function or
1470 an integer to pass to `access' (in which case file-name-handlers
1473 If STOREPTR is nonzero, it points to a slot where the name of
1474 the file actually found should be stored as a Lisp string.
1475 nil is stored there on failure.
1477 If the file we find is remote, return -2
1478 but store the found remote file name in *STOREPTR. */
1481 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1486 register char *fn
= buf
;
1489 Lisp_Object filename
;
1491 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1492 Lisp_Object string
, tail
, encoded_fn
;
1493 int max_suffix_len
= 0;
1497 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1499 CHECK_STRING_CAR (tail
);
1500 max_suffix_len
= max (max_suffix_len
,
1501 SBYTES (XCAR (tail
)));
1504 string
= filename
= encoded_fn
= Qnil
;
1505 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1510 if (complete_filename_p (str
))
1513 for (; CONSP (path
); path
= XCDR (path
))
1515 filename
= Fexpand_file_name (str
, XCAR (path
));
1516 if (!complete_filename_p (filename
))
1517 /* If there are non-absolute elts in PATH (eg ".") */
1518 /* Of course, this could conceivably lose if luser sets
1519 default-directory to be something non-absolute... */
1521 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1522 if (!complete_filename_p (filename
))
1523 /* Give up on this path element! */
1527 /* Calculate maximum size of any filename made from
1528 this path element/specified file name and any possible suffix. */
1529 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1530 if (fn_size
< want_size
)
1531 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1533 /* Loop over suffixes. */
1534 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1535 CONSP (tail
); tail
= XCDR (tail
))
1537 int lsuffix
= SBYTES (XCAR (tail
));
1538 Lisp_Object handler
;
1541 /* Concatenate path element/specified name with the suffix.
1542 If the directory starts with /:, remove that. */
1543 if (SCHARS (filename
) > 2
1544 && SREF (filename
, 0) == '/'
1545 && SREF (filename
, 1) == ':')
1547 strncpy (fn
, SDATA (filename
) + 2,
1548 SBYTES (filename
) - 2);
1549 fn
[SBYTES (filename
) - 2] = 0;
1553 strncpy (fn
, SDATA (filename
),
1555 fn
[SBYTES (filename
)] = 0;
1558 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1559 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1561 /* Check that the file exists and is not a directory. */
1562 /* We used to only check for handlers on non-absolute file names:
1566 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1567 It's not clear why that was the case and it breaks things like
1568 (load "/bar.el") where the file is actually "/bar.el.gz". */
1569 string
= build_string (fn
);
1570 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1571 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1573 if (NILP (predicate
))
1574 exists
= !NILP (Ffile_readable_p (string
));
1576 exists
= !NILP (call1 (predicate
, string
));
1577 if (exists
&& !NILP (Ffile_directory_p (string
)))
1582 /* We succeeded; return this descriptor and filename. */
1593 encoded_fn
= ENCODE_FILE (string
);
1594 pfn
= SDATA (encoded_fn
);
1595 exists
= (stat (pfn
, &st
) >= 0
1596 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1599 /* Check that we can access or open it. */
1600 if (NATNUMP (predicate
))
1601 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1603 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1607 /* We succeeded; return this descriptor and filename. */
1625 /* Merge the list we've accumulated of globals from the current input source
1626 into the load_history variable. The details depend on whether
1627 the source has an associated file name or not.
1629 FILENAME is the file name that we are loading from.
1630 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1633 build_load_history (Lisp_Object filename
, int entire
)
1635 register Lisp_Object tail
, prev
, newelt
;
1636 register Lisp_Object tem
, tem2
;
1637 register int foundit
= 0;
1639 tail
= Vload_history
;
1642 while (CONSP (tail
))
1646 /* Find the feature's previous assoc list... */
1647 if (!NILP (Fequal (filename
, Fcar (tem
))))
1651 /* If we're loading the entire file, remove old data. */
1655 Vload_history
= XCDR (tail
);
1657 Fsetcdr (prev
, XCDR (tail
));
1660 /* Otherwise, cons on new symbols that are not already members. */
1663 tem2
= Vcurrent_load_list
;
1665 while (CONSP (tem2
))
1667 newelt
= XCAR (tem2
);
1669 if (NILP (Fmember (newelt
, tem
)))
1670 Fsetcar (tail
, Fcons (XCAR (tem
),
1671 Fcons (newelt
, XCDR (tem
))));
1684 /* If we're loading an entire file, cons the new assoc onto the
1685 front of load-history, the most-recently-loaded position. Also
1686 do this if we didn't find an existing member for the file. */
1687 if (entire
|| !foundit
)
1688 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1693 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1700 readevalloop_1 (Lisp_Object old
)
1702 load_convert_to_unibyte
= ! NILP (old
);
1706 /* Signal an `end-of-file' error, if possible with file name
1710 end_of_file_error (void)
1712 if (STRINGP (Vload_file_name
))
1713 xsignal1 (Qend_of_file
, Vload_file_name
);
1715 xsignal0 (Qend_of_file
);
1718 /* UNIBYTE specifies how to set load_convert_to_unibyte
1719 for this invocation.
1720 READFUN, if non-nil, is used instead of `read'.
1722 START, END specify region to read in current buffer (from eval-region).
1723 If the input is not from a buffer, they must be nil. */
1726 readevalloop (Lisp_Object readcharfun
,
1728 Lisp_Object sourcename
,
1729 Lisp_Object (*evalfun
) (Lisp_Object
),
1731 Lisp_Object unibyte
, Lisp_Object readfun
,
1732 Lisp_Object start
, Lisp_Object end
)
1735 register Lisp_Object val
;
1736 int count
= SPECPDL_INDEX ();
1737 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1738 struct buffer
*b
= 0;
1739 int continue_reading_p
;
1740 Lisp_Object lex_bound
;
1741 /* Nonzero if reading an entire buffer. */
1742 int whole_buffer
= 0;
1743 /* 1 on the first time around. */
1746 if (MARKERP (readcharfun
))
1749 start
= readcharfun
;
1752 if (BUFFERP (readcharfun
))
1753 b
= XBUFFER (readcharfun
);
1754 else if (MARKERP (readcharfun
))
1755 b
= XMARKER (readcharfun
)->buffer
;
1757 /* We assume START is nil when input is not from a buffer. */
1758 if (! NILP (start
) && !b
)
1761 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1762 specbind (Qcurrent_load_list
, Qnil
);
1763 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1764 load_convert_to_unibyte
= !NILP (unibyte
);
1766 /* If lexical binding is active (either because it was specified in
1767 the file's header, or via a buffer-local variable), create an empty
1768 lexical environment, otherwise, turn off lexical binding. */
1769 lex_bound
= find_symbol_value (Qlexical_binding
);
1770 specbind (Qinternal_interpreter_environment
,
1771 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1772 ? Qnil
: Fcons (Qt
, Qnil
));
1774 GCPRO4 (sourcename
, readfun
, start
, end
);
1776 /* Try to ensure sourcename is a truename, except whilst preloading. */
1777 if (NILP (Vpurify_flag
)
1778 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1779 && !NILP (Ffboundp (Qfile_truename
)))
1780 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1782 LOADHIST_ATTACH (sourcename
);
1784 continue_reading_p
= 1;
1785 while (continue_reading_p
)
1787 int count1
= SPECPDL_INDEX ();
1789 if (b
!= 0 && NILP (b
->name
))
1790 error ("Reading from killed buffer");
1794 /* Switch to the buffer we are reading from. */
1795 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1796 set_buffer_internal (b
);
1798 /* Save point in it. */
1799 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1800 /* Save ZV in it. */
1801 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1802 /* Those get unbound after we read one expression. */
1804 /* Set point and ZV around stuff to be read. */
1807 Fnarrow_to_region (make_number (BEGV
), end
);
1809 /* Just for cleanliness, convert END to a marker
1810 if it is an integer. */
1812 end
= Fpoint_max_marker ();
1815 /* On the first cycle, we can easily test here
1816 whether we are reading the whole buffer. */
1817 if (b
&& first_sexp
)
1818 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1825 while ((c
= READCHAR
) != '\n' && c
!= -1);
1830 unbind_to (count1
, Qnil
);
1834 /* Ignore whitespace here, so we can detect eof. */
1835 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1836 || c
== 0x8a0) /* NBSP */
1839 if (!NILP (Vpurify_flag
) && c
== '(')
1841 record_unwind_protect (unreadpure
, Qnil
);
1842 val
= read_list (-1, readcharfun
);
1847 read_objects
= Qnil
;
1848 if (!NILP (readfun
))
1850 val
= call1 (readfun
, readcharfun
);
1852 /* If READCHARFUN has set point to ZV, we should
1853 stop reading, even if the form read sets point
1854 to a different value when evaluated. */
1855 if (BUFFERP (readcharfun
))
1857 struct buffer
*b
= XBUFFER (readcharfun
);
1858 if (BUF_PT (b
) == BUF_ZV (b
))
1859 continue_reading_p
= 0;
1862 else if (! NILP (Vload_read_function
))
1863 val
= call1 (Vload_read_function
, readcharfun
);
1865 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1868 if (!NILP (start
) && continue_reading_p
)
1869 start
= Fpoint_marker ();
1871 /* Restore saved point and BEGV. */
1872 unbind_to (count1
, Qnil
);
1874 /* Now eval what we just read. */
1875 val
= (*evalfun
) (val
);
1879 Vvalues
= Fcons (val
, Vvalues
);
1880 if (EQ (Vstandard_output
, Qt
))
1889 build_load_history (sourcename
,
1890 stream
|| whole_buffer
);
1894 unbind_to (count
, Qnil
);
1897 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1898 doc
: /* Execute the current buffer as Lisp code.
1899 When called from a Lisp program (i.e., not interactively), this
1900 function accepts up to five optional arguments:
1901 BUFFER is the buffer to evaluate (nil means use current buffer).
1902 PRINTFLAG controls printing of output:
1903 A value of nil means discard it; anything else is stream for print.
1904 FILENAME specifies the file name to use for `load-history'.
1905 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1907 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1908 functions should work normally even if PRINTFLAG is nil.
1910 This function preserves the position of point. */)
1911 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1913 int count
= SPECPDL_INDEX ();
1914 Lisp_Object tem
, buf
;
1917 buf
= Fcurrent_buffer ();
1919 buf
= Fget_buffer (buffer
);
1921 error ("No such buffer");
1923 if (NILP (printflag
) && NILP (do_allow_print
))
1928 if (NILP (filename
))
1929 filename
= XBUFFER (buf
)->filename
;
1931 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1932 specbind (Qstandard_output
, tem
);
1933 specbind (Qlexical_binding
, Qnil
);
1934 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1935 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1936 if (lisp_file_lexically_bound_p (buf
))
1937 Fset (Qlexical_binding
, Qt
);
1938 readevalloop (buf
, 0, filename
, Feval
,
1939 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1940 unbind_to (count
, Qnil
);
1945 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1946 doc
: /* Execute the region as Lisp code.
1947 When called from programs, expects two arguments,
1948 giving starting and ending indices in the current buffer
1949 of the text to be executed.
1950 Programs can pass third argument PRINTFLAG which controls output:
1951 A value of nil means discard it; anything else is stream for printing it.
1952 Also the fourth argument READ-FUNCTION, if non-nil, is used
1953 instead of `read' to read each expression. It gets one argument
1954 which is the input stream for reading characters.
1956 This function does not move point. */)
1957 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1959 int count
= SPECPDL_INDEX ();
1960 Lisp_Object tem
, cbuf
;
1962 cbuf
= Fcurrent_buffer ();
1964 if (NILP (printflag
))
1968 specbind (Qstandard_output
, tem
);
1969 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1971 /* readevalloop calls functions which check the type of start and end. */
1972 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1973 !NILP (printflag
), Qnil
, read_function
,
1976 return unbind_to (count
, Qnil
);
1980 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1981 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1982 If STREAM is nil, use the value of `standard-input' (which see).
1983 STREAM or the value of `standard-input' may be:
1984 a buffer (read from point and advance it)
1985 a marker (read from where it points and advance it)
1986 a function (call it with no arguments for each character,
1987 call it with a char as argument to push a char back)
1988 a string (takes text from string, starting at the beginning)
1989 t (read text line using minibuffer and use it, or read from
1990 standard input in batch mode). */)
1991 (Lisp_Object stream
)
1994 stream
= Vstandard_input
;
1995 if (EQ (stream
, Qt
))
1996 stream
= Qread_char
;
1997 if (EQ (stream
, Qread_char
))
1998 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
2000 return read_internal_start (stream
, Qnil
, Qnil
);
2003 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2004 doc
: /* Read one Lisp expression which is represented as text by STRING.
2005 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2006 START and END optionally delimit a substring of STRING from which to read;
2007 they default to 0 and (length STRING) respectively. */)
2008 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2011 CHECK_STRING (string
);
2012 /* read_internal_start sets read_from_string_index. */
2013 ret
= read_internal_start (string
, start
, end
);
2014 return Fcons (ret
, make_number (read_from_string_index
));
2017 /* Function to set up the global context we need in toplevel read
2020 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2021 /* start, end only used when stream is a string. */
2026 new_backquote_flag
= 0;
2027 read_objects
= Qnil
;
2028 if (EQ (Vread_with_symbol_positions
, Qt
)
2029 || EQ (Vread_with_symbol_positions
, stream
))
2030 Vread_symbol_positions_list
= Qnil
;
2032 if (STRINGP (stream
)
2033 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2035 EMACS_INT startval
, endval
;
2038 if (STRINGP (stream
))
2041 string
= XCAR (stream
);
2044 endval
= SCHARS (string
);
2048 endval
= XINT (end
);
2049 if (endval
< 0 || endval
> SCHARS (string
))
2050 args_out_of_range (string
, end
);
2057 CHECK_NUMBER (start
);
2058 startval
= XINT (start
);
2059 if (startval
< 0 || startval
> endval
)
2060 args_out_of_range (string
, start
);
2062 read_from_string_index
= startval
;
2063 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2064 read_from_string_limit
= endval
;
2067 retval
= read0 (stream
);
2068 if (EQ (Vread_with_symbol_positions
, Qt
)
2069 || EQ (Vread_with_symbol_positions
, stream
))
2070 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2075 /* Signal Qinvalid_read_syntax error.
2076 S is error string of length N (if > 0) */
2079 invalid_syntax (const char *s
, int n
)
2083 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2087 /* Use this for recursive reads, in contexts where internal tokens
2091 read0 (Lisp_Object readcharfun
)
2093 register Lisp_Object val
;
2096 val
= read1 (readcharfun
, &c
, 0);
2100 xsignal1 (Qinvalid_read_syntax
,
2101 Fmake_string (make_number (1), make_number (c
)));
2104 static int read_buffer_size
;
2105 static char *read_buffer
;
2107 /* Read a \-escape sequence, assuming we already read the `\'.
2108 If the escape sequence forces unibyte, return eight-bit char. */
2111 read_escape (Lisp_Object readcharfun
, int stringp
)
2113 register int c
= READCHAR
;
2114 /* \u allows up to four hex digits, \U up to eight. Default to the
2115 behavior for \u, and change this value in the case that \U is seen. */
2116 int unicode_hex_count
= 4;
2121 end_of_file_error ();
2151 error ("Invalid escape character syntax");
2154 c
= read_escape (readcharfun
, 0);
2155 return c
| meta_modifier
;
2160 error ("Invalid escape character syntax");
2163 c
= read_escape (readcharfun
, 0);
2164 return c
| shift_modifier
;
2169 error ("Invalid escape character syntax");
2172 c
= read_escape (readcharfun
, 0);
2173 return c
| hyper_modifier
;
2178 error ("Invalid escape character syntax");
2181 c
= read_escape (readcharfun
, 0);
2182 return c
| alt_modifier
;
2186 if (stringp
|| c
!= '-')
2193 c
= read_escape (readcharfun
, 0);
2194 return c
| super_modifier
;
2199 error ("Invalid escape character syntax");
2203 c
= read_escape (readcharfun
, 0);
2204 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2205 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2206 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2207 return c
| ctrl_modifier
;
2208 /* ASCII control chars are made from letters (both cases),
2209 as well as the non-letters within 0100...0137. */
2210 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2211 return (c
& (037 | ~0177));
2212 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2213 return (c
& (037 | ~0177));
2215 return c
| ctrl_modifier
;
2225 /* An octal escape, as in ANSI C. */
2227 register int i
= c
- '0';
2228 register int count
= 0;
2231 if ((c
= READCHAR
) >= '0' && c
<= '7')
2243 if (i
>= 0x80 && i
< 0x100)
2244 i
= BYTE8_TO_CHAR (i
);
2249 /* A hex escape, as in ANSI C. */
2256 if (c
>= '0' && c
<= '9')
2261 else if ((c
>= 'a' && c
<= 'f')
2262 || (c
>= 'A' && c
<= 'F'))
2265 if (c
>= 'a' && c
<= 'f')
2278 if (count
< 3 && i
>= 0x80)
2279 return BYTE8_TO_CHAR (i
);
2284 /* Post-Unicode-2.0: Up to eight hex chars. */
2285 unicode_hex_count
= 8;
2288 /* A Unicode escape. We only permit them in strings and characters,
2289 not arbitrarily in the source code, as in some other languages. */
2294 while (++count
<= unicode_hex_count
)
2297 /* isdigit and isalpha may be locale-specific, which we don't
2299 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2300 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2301 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2304 error ("Non-hex digit used for Unicode escape");
2309 error ("Non-Unicode character: 0x%x", i
);
2318 /* Read an integer in radix RADIX using READCHARFUN to read
2319 characters. RADIX must be in the interval [2..36]; if it isn't, a
2320 read error is signaled . Value is the integer read. Signals an
2321 error if encountering invalid read syntax or if RADIX is out of
2325 read_integer (Lisp_Object readcharfun
, int radix
)
2327 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2328 /* We use a floating point number because */
2331 if (radix
< 2 || radix
> 36)
2335 number
= ndigits
= invalid_p
= 0;
2351 if (c
>= '0' && c
<= '9')
2353 else if (c
>= 'a' && c
<= 'z')
2354 digit
= c
- 'a' + 10;
2355 else if (c
>= 'A' && c
<= 'Z')
2356 digit
= c
- 'A' + 10;
2363 if (digit
< 0 || digit
>= radix
)
2366 number
= radix
* number
+ digit
;
2372 if (ndigits
== 0 || invalid_p
)
2375 sprintf (buf
, "integer, radix %d", radix
);
2376 invalid_syntax (buf
, 0);
2379 return make_fixnum_or_float (sign
* number
);
2383 /* If the next token is ')' or ']' or '.', we store that character
2384 in *PCH and the return value is not interesting. Else, we store
2385 zero in *PCH and we read and return one lisp object.
2387 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2390 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2393 int uninterned_symbol
= 0;
2401 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2403 end_of_file_error ();
2408 return read_list (0, readcharfun
);
2411 return read_vector (readcharfun
, 0);
2427 /* Accept extended format for hashtables (extensible to
2429 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2430 Lisp_Object tmp
= read_list (0, readcharfun
);
2431 Lisp_Object head
= CAR_SAFE (tmp
);
2432 Lisp_Object data
= Qnil
;
2433 Lisp_Object val
= Qnil
;
2434 /* The size is 2 * number of allowed keywords to
2436 Lisp_Object params
[10];
2438 Lisp_Object key
= Qnil
;
2439 int param_count
= 0;
2441 if (!EQ (head
, Qhash_table
))
2442 error ("Invalid extended read marker at head of #s list "
2443 "(only hash-table allowed)");
2445 tmp
= CDR_SAFE (tmp
);
2447 /* This is repetitive but fast and simple. */
2448 params
[param_count
] = QCsize
;
2449 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2450 if (!NILP (params
[param_count
+ 1]))
2453 params
[param_count
] = QCtest
;
2454 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2455 if (!NILP (params
[param_count
+ 1]))
2458 params
[param_count
] = QCweakness
;
2459 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2460 if (!NILP (params
[param_count
+ 1]))
2463 params
[param_count
] = QCrehash_size
;
2464 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2465 if (!NILP (params
[param_count
+ 1]))
2468 params
[param_count
] = QCrehash_threshold
;
2469 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2470 if (!NILP (params
[param_count
+ 1]))
2473 /* This is the hashtable data. */
2474 data
= Fplist_get (tmp
, Qdata
);
2476 /* Now use params to make a new hashtable and fill it. */
2477 ht
= Fmake_hash_table (param_count
, params
);
2479 while (CONSP (data
))
2484 error ("Odd number of elements in hashtable data");
2487 Fputhash (key
, val
, ht
);
2493 invalid_syntax ("#", 1);
2501 tmp
= read_vector (readcharfun
, 0);
2502 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2503 error ("Invalid size char-table");
2504 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2515 tmp
= read_vector (readcharfun
, 0);
2516 if (!INTEGERP (AREF (tmp
, 0)))
2517 error ("Invalid depth in char-table");
2518 depth
= XINT (AREF (tmp
, 0));
2519 if (depth
< 1 || depth
> 3)
2520 error ("Invalid depth in char-table");
2521 size
= XVECTOR (tmp
)->size
- 2;
2522 if (chartab_size
[depth
] != size
)
2523 error ("Invalid size char-table");
2524 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2527 invalid_syntax ("#^^", 3);
2529 invalid_syntax ("#^", 2);
2534 length
= read1 (readcharfun
, pch
, first_in_list
);
2538 Lisp_Object tmp
, val
;
2540 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2541 / BOOL_VECTOR_BITS_PER_CHAR
);
2544 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2545 if (STRING_MULTIBYTE (tmp
)
2546 || (size_in_chars
!= SCHARS (tmp
)
2547 /* We used to print 1 char too many
2548 when the number of bits was a multiple of 8.
2549 Accept such input in case it came from an old
2551 && ! (XFASTINT (length
)
2552 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2553 invalid_syntax ("#&...", 5);
2555 val
= Fmake_bool_vector (length
, Qnil
);
2556 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2557 /* Clear the extraneous bits in the last byte. */
2558 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2559 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2560 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2563 invalid_syntax ("#&...", 5);
2566 /* `function vector' objects, including byte-compiled functions. */
2567 return read_vector (readcharfun
, 1);
2571 struct gcpro gcpro1
;
2574 /* Read the string itself. */
2575 tmp
= read1 (readcharfun
, &ch
, 0);
2576 if (ch
!= 0 || !STRINGP (tmp
))
2577 invalid_syntax ("#", 1);
2579 /* Read the intervals and their properties. */
2582 Lisp_Object beg
, end
, plist
;
2584 beg
= read1 (readcharfun
, &ch
, 0);
2589 end
= read1 (readcharfun
, &ch
, 0);
2591 plist
= read1 (readcharfun
, &ch
, 0);
2593 invalid_syntax ("Invalid string property list", 0);
2594 Fset_text_properties (beg
, end
, plist
, tmp
);
2600 /* #@NUMBER is used to skip NUMBER following characters.
2601 That's used in .elc files to skip over doc strings
2602 and function definitions. */
2608 /* Read a decimal integer. */
2609 while ((c
= READCHAR
) >= 0
2610 && c
>= '0' && c
<= '9')
2618 if (load_force_doc_strings
2619 && (EQ (readcharfun
, Qget_file_char
)
2620 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2622 /* If we are supposed to force doc strings into core right now,
2623 record the last string that we skipped,
2624 and record where in the file it comes from. */
2626 /* But first exchange saved_doc_string
2627 with prev_saved_doc_string, so we save two strings. */
2629 char *temp
= saved_doc_string
;
2630 int temp_size
= saved_doc_string_size
;
2631 file_offset temp_pos
= saved_doc_string_position
;
2632 int temp_len
= saved_doc_string_length
;
2634 saved_doc_string
= prev_saved_doc_string
;
2635 saved_doc_string_size
= prev_saved_doc_string_size
;
2636 saved_doc_string_position
= prev_saved_doc_string_position
;
2637 saved_doc_string_length
= prev_saved_doc_string_length
;
2639 prev_saved_doc_string
= temp
;
2640 prev_saved_doc_string_size
= temp_size
;
2641 prev_saved_doc_string_position
= temp_pos
;
2642 prev_saved_doc_string_length
= temp_len
;
2645 if (saved_doc_string_size
== 0)
2647 saved_doc_string_size
= nskip
+ 100;
2648 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2650 if (nskip
> saved_doc_string_size
)
2652 saved_doc_string_size
= nskip
+ 100;
2653 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2654 saved_doc_string_size
);
2657 saved_doc_string_position
= file_tell (instream
);
2659 /* Copy that many characters into saved_doc_string. */
2660 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2661 saved_doc_string
[i
] = c
= READCHAR
;
2663 saved_doc_string_length
= i
;
2667 /* Skip that many characters. */
2668 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2677 /* #! appears at the beginning of an executable file.
2678 Skip the first line. */
2679 while (c
!= '\n' && c
>= 0)
2684 return Vload_file_name
;
2686 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2687 /* #:foo is the uninterned symbol named foo. */
2690 uninterned_symbol
= 1;
2694 /* Reader forms that can reuse previously read objects. */
2695 if (c
>= '0' && c
<= '9')
2700 /* Read a non-negative integer. */
2701 while (c
>= '0' && c
<= '9')
2707 /* #n=object returns object, but associates it with n for #n#. */
2708 if (c
== '=' && !NILP (Vread_circle
))
2710 /* Make a placeholder for #n# to use temporarily */
2711 Lisp_Object placeholder
;
2714 placeholder
= Fcons (Qnil
, Qnil
);
2715 cell
= Fcons (make_number (n
), placeholder
);
2716 read_objects
= Fcons (cell
, read_objects
);
2718 /* Read the object itself. */
2719 tem
= read0 (readcharfun
);
2721 /* Now put it everywhere the placeholder was... */
2722 substitute_object_in_subtree (tem
, placeholder
);
2724 /* ...and #n# will use the real value from now on. */
2725 Fsetcdr (cell
, tem
);
2729 /* #n# returns a previously read object. */
2730 if (c
== '#' && !NILP (Vread_circle
))
2732 tem
= Fassq (make_number (n
), read_objects
);
2735 /* Fall through to error message. */
2737 else if (c
== 'r' || c
== 'R')
2738 return read_integer (readcharfun
, n
);
2740 /* Fall through to error message. */
2742 else if (c
== 'x' || c
== 'X')
2743 return read_integer (readcharfun
, 16);
2744 else if (c
== 'o' || c
== 'O')
2745 return read_integer (readcharfun
, 8);
2746 else if (c
== 'b' || c
== 'B')
2747 return read_integer (readcharfun
, 2);
2750 invalid_syntax ("#", 1);
2753 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2758 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2763 int next_char
= READCHAR
;
2765 /* Transition from old-style to new-style:
2766 If we see "(`" it used to mean old-style, which usually works
2767 fine because ` should almost never appear in such a position
2768 for new-style. But occasionally we need "(`" to mean new
2769 style, so we try to distinguish the two by the fact that we
2770 can either write "( `foo" or "(` foo", where the first
2771 intends to use new-style whereas the second intends to use
2772 old-style. For Emacs-25, we should completely remove this
2773 first_in_list exception (old-style can still be obtained via
2775 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2777 Vold_style_backquotes
= Qt
;
2784 new_backquote_flag
++;
2785 value
= read0 (readcharfun
);
2786 new_backquote_flag
--;
2788 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2793 int next_char
= READCHAR
;
2795 /* Transition from old-style to new-style:
2796 It used to be impossible to have a new-style , other than within
2797 a new-style `. This is sufficient when ` and , are used in the
2798 normal way, but ` and , can also appear in args to macros that
2799 will not interpret them in the usual way, in which case , may be
2800 used without any ` anywhere near.
2801 So we now use the same heuristic as for backquote: old-style
2802 unquotes are only recognized when first on a list, and when
2803 followed by a space.
2804 Because it's more difficult to peak 2 chars ahead, a new-style
2805 ,@ can still not be used outside of a `, unless it's in the middle
2807 if (new_backquote_flag
2809 || (next_char
!= ' ' && next_char
!= '@'))
2811 Lisp_Object comma_type
= Qnil
;
2816 comma_type
= Qcomma_at
;
2818 comma_type
= Qcomma_dot
;
2821 if (ch
>= 0) UNREAD (ch
);
2822 comma_type
= Qcomma
;
2825 value
= read0 (readcharfun
);
2826 return Fcons (comma_type
, Fcons (value
, Qnil
));
2830 Vold_style_backquotes
= Qt
;
2842 end_of_file_error ();
2844 /* Accept `single space' syntax like (list ? x) where the
2845 whitespace character is SPC or TAB.
2846 Other literal whitespace like NL, CR, and FF are not accepted,
2847 as there are well-established escape sequences for these. */
2848 if (c
== ' ' || c
== '\t')
2849 return make_number (c
);
2852 c
= read_escape (readcharfun
, 0);
2853 modifiers
= c
& CHAR_MODIFIER_MASK
;
2854 c
&= ~CHAR_MODIFIER_MASK
;
2855 if (CHAR_BYTE8_P (c
))
2856 c
= CHAR_TO_BYTE8 (c
);
2859 next_char
= READCHAR
;
2860 ok
= (next_char
<= 040
2861 || (next_char
< 0200
2862 && (strchr ("\"';()[]#?`,.", next_char
))));
2865 return make_number (c
);
2867 invalid_syntax ("?", 1);
2872 char *p
= read_buffer
;
2873 char *end
= read_buffer
+ read_buffer_size
;
2875 /* Nonzero if we saw an escape sequence specifying
2876 a multibyte character. */
2877 int force_multibyte
= 0;
2878 /* Nonzero if we saw an escape sequence specifying
2879 a single-byte character. */
2880 int force_singlebyte
= 0;
2884 while ((c
= READCHAR
) >= 0
2887 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2889 int offset
= p
- read_buffer
;
2890 read_buffer
= (char *) xrealloc (read_buffer
,
2891 read_buffer_size
*= 2);
2892 p
= read_buffer
+ offset
;
2893 end
= read_buffer
+ read_buffer_size
;
2900 c
= read_escape (readcharfun
, 1);
2902 /* C is -1 if \ newline has just been seen */
2905 if (p
== read_buffer
)
2910 modifiers
= c
& CHAR_MODIFIER_MASK
;
2911 c
= c
& ~CHAR_MODIFIER_MASK
;
2913 if (CHAR_BYTE8_P (c
))
2914 force_singlebyte
= 1;
2915 else if (! ASCII_CHAR_P (c
))
2916 force_multibyte
= 1;
2917 else /* i.e. ASCII_CHAR_P (c) */
2919 /* Allow `\C- ' and `\C-?'. */
2920 if (modifiers
== CHAR_CTL
)
2923 c
= 0, modifiers
= 0;
2925 c
= 127, modifiers
= 0;
2927 if (modifiers
& CHAR_SHIFT
)
2929 /* Shift modifier is valid only with [A-Za-z]. */
2930 if (c
>= 'A' && c
<= 'Z')
2931 modifiers
&= ~CHAR_SHIFT
;
2932 else if (c
>= 'a' && c
<= 'z')
2933 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2936 if (modifiers
& CHAR_META
)
2938 /* Move the meta bit to the right place for a
2940 modifiers
&= ~CHAR_META
;
2941 c
= BYTE8_TO_CHAR (c
| 0x80);
2942 force_singlebyte
= 1;
2946 /* Any modifiers remaining are invalid. */
2948 error ("Invalid modifier in string");
2949 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2953 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2954 if (CHAR_BYTE8_P (c
))
2955 force_singlebyte
= 1;
2956 else if (! ASCII_CHAR_P (c
))
2957 force_multibyte
= 1;
2963 end_of_file_error ();
2965 /* If purifying, and string starts with \ newline,
2966 return zero instead. This is for doc strings
2967 that we are really going to find in etc/DOC.nn.nn */
2968 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2969 return make_number (0);
2971 if (force_multibyte
)
2972 /* READ_BUFFER already contains valid multibyte forms. */
2974 else if (force_singlebyte
)
2976 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2977 p
= read_buffer
+ nchars
;
2980 /* Otherwise, READ_BUFFER contains only ASCII. */
2983 /* We want readchar_count to be the number of characters, not
2984 bytes. Hence we adjust for multibyte characters in the
2985 string. ... But it doesn't seem to be necessary, because
2986 READCHAR *does* read multibyte characters from buffers. */
2987 /* readchar_count -= (p - read_buffer) - nchars; */
2989 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2991 || (p
- read_buffer
!= nchars
)));
2992 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2994 || (p
- read_buffer
!= nchars
)));
2999 int next_char
= READCHAR
;
3002 if (next_char
<= 040
3003 || (next_char
< 0200
3004 && (strchr ("\"';([#?`,", next_char
))))
3010 /* Otherwise, we fall through! Note that the atom-reading loop
3011 below will now loop at least once, assuring that we will not
3012 try to UNREAD two characters in a row. */
3016 if (c
<= 040) goto retry
;
3017 if (c
== 0x8a0) /* NBSP */
3020 char *p
= read_buffer
;
3024 char *end
= read_buffer
+ read_buffer_size
;
3027 && c
!= 0x8a0 /* NBSP */
3029 || !(strchr ("\"';()[]#`,", c
))))
3031 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3033 int offset
= p
- read_buffer
;
3034 read_buffer
= (char *) xrealloc (read_buffer
,
3035 read_buffer_size
*= 2);
3036 p
= read_buffer
+ offset
;
3037 end
= read_buffer
+ read_buffer_size
;
3044 end_of_file_error ();
3049 p
+= CHAR_STRING (c
, p
);
3057 int offset
= p
- read_buffer
;
3058 read_buffer
= (char *) xrealloc (read_buffer
,
3059 read_buffer_size
*= 2);
3060 p
= read_buffer
+ offset
;
3061 end
= read_buffer
+ read_buffer_size
;
3068 if (!quoted
&& !uninterned_symbol
)
3072 if (*p1
== '+' || *p1
== '-') p1
++;
3073 /* Is it an integer? */
3076 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3077 /* Integers can have trailing decimal points. */
3078 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3080 /* It is an integer. */
3085 /* EMACS_INT n = atol (read_buffer); */
3086 char *endptr
= NULL
;
3087 EMACS_INT n
= (errno
= 0,
3088 strtol (read_buffer
, &endptr
, 10));
3089 if (errno
== ERANGE
&& endptr
)
3092 = Fcons (make_string (read_buffer
,
3093 endptr
- read_buffer
),
3095 xsignal (Qoverflow_error
, args
);
3097 return make_fixnum_or_float (n
);
3101 if (isfloat_string (read_buffer
, 0))
3103 /* Compute NaN and infinities using 0.0 in a variable,
3104 to cope with compilers that think they are smarter
3110 /* Negate the value ourselves. This treats 0, NaNs,
3111 and infinity properly on IEEE floating point hosts,
3112 and works around a common bug where atof ("-0.0")
3114 int negative
= read_buffer
[0] == '-';
3116 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3117 returns 1, is if the input ends in e+INF or e+NaN. */
3124 value
= zero
/ zero
;
3126 /* If that made a "negative" NaN, negate it. */
3130 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3133 u_minus_zero
.d
= - 0.0;
3134 for (i
= 0; i
< sizeof (double); i
++)
3135 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3141 /* Now VALUE is a positive NaN. */
3144 value
= atof (read_buffer
+ negative
);
3148 return make_float (negative
? - value
: value
);
3152 Lisp_Object name
, result
;
3153 EMACS_INT nbytes
= p
- read_buffer
;
3155 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3158 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3159 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3161 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3162 result
= (uninterned_symbol
? Fmake_symbol (name
)
3163 : Fintern (name
, Qnil
));
3165 if (EQ (Vread_with_symbol_positions
, Qt
)
3166 || EQ (Vread_with_symbol_positions
, readcharfun
))
3167 Vread_symbol_positions_list
=
3168 /* Kind of a hack; this will probably fail if characters
3169 in the symbol name were escaped. Not really a big
3171 Fcons (Fcons (result
,
3172 make_number (readchar_count
3173 - XFASTINT (Flength (Fsymbol_name (result
))))),
3174 Vread_symbol_positions_list
);
3182 /* List of nodes we've seen during substitute_object_in_subtree. */
3183 static Lisp_Object seen_list
;
3186 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3188 Lisp_Object check_object
;
3190 /* We haven't seen any objects when we start. */
3193 /* Make all the substitutions. */
3195 = substitute_object_recurse (object
, placeholder
, object
);
3197 /* Clear seen_list because we're done with it. */
3200 /* The returned object here is expected to always eq the
3202 if (!EQ (check_object
, object
))
3203 error ("Unexpected mutation error in reader");
3206 /* Feval doesn't get called from here, so no gc protection is needed. */
3207 #define SUBSTITUTE(get_val, set_val) \
3209 Lisp_Object old_value = get_val; \
3210 Lisp_Object true_value \
3211 = substitute_object_recurse (object, placeholder, \
3214 if (!EQ (old_value, true_value)) \
3221 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3223 /* If we find the placeholder, return the target object. */
3224 if (EQ (placeholder
, subtree
))
3227 /* If we've been to this node before, don't explore it again. */
3228 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3231 /* If this node can be the entry point to a cycle, remember that
3232 we've seen it. It can only be such an entry point if it was made
3233 by #n=, which means that we can find it as a value in
3235 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3236 seen_list
= Fcons (subtree
, seen_list
);
3238 /* Recurse according to subtree's type.
3239 Every branch must return a Lisp_Object. */
3240 switch (XTYPE (subtree
))
3242 case Lisp_Vectorlike
:
3245 if (BOOL_VECTOR_P (subtree
))
3246 return subtree
; /* No sub-objects anyway. */
3247 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3248 || COMPILEDP (subtree
))
3249 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3250 else if (VECTORP (subtree
))
3251 length
= ASIZE (subtree
);
3253 /* An unknown pseudovector may contain non-Lisp fields, so we
3254 can't just blindly traverse all its fields. We used to call
3255 `Flength' which signaled `sequencep', so I just preserved this
3257 wrong_type_argument (Qsequencep
, subtree
);
3259 for (i
= 0; i
< length
; i
++)
3260 SUBSTITUTE (AREF (subtree
, i
),
3261 ASET (subtree
, i
, true_value
));
3267 SUBSTITUTE (XCAR (subtree
),
3268 XSETCAR (subtree
, true_value
));
3269 SUBSTITUTE (XCDR (subtree
),
3270 XSETCDR (subtree
, true_value
));
3276 /* Check for text properties in each interval.
3277 substitute_in_interval contains part of the logic. */
3279 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3280 Lisp_Object arg
= Fcons (object
, placeholder
);
3282 traverse_intervals_noorder (root_interval
,
3283 &substitute_in_interval
, arg
);
3288 /* Other types don't recurse any further. */
3294 /* Helper function for substitute_object_recurse. */
3296 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3298 Lisp_Object object
= Fcar (arg
);
3299 Lisp_Object placeholder
= Fcdr (arg
);
3301 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3312 isfloat_string (const char *cp
, int ignore_trailing
)
3315 const char *start
= cp
;
3318 if (*cp
== '+' || *cp
== '-')
3321 if (*cp
>= '0' && *cp
<= '9')
3324 while (*cp
>= '0' && *cp
<= '9')
3332 if (*cp
>= '0' && *cp
<= '9')
3335 while (*cp
>= '0' && *cp
<= '9')
3338 if (*cp
== 'e' || *cp
== 'E')
3342 if (*cp
== '+' || *cp
== '-')
3346 if (*cp
>= '0' && *cp
<= '9')
3349 while (*cp
>= '0' && *cp
<= '9')
3352 else if (cp
== start
)
3354 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3359 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3365 return ((ignore_trailing
3366 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3367 || *cp
== '\r' || *cp
== '\f')
3368 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3369 || state
== (DOT_CHAR
|TRAIL_INT
)
3370 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3371 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3372 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3377 read_vector (Lisp_Object readcharfun
, int read_funvec
)
3381 register Lisp_Object
*ptr
;
3382 register Lisp_Object tem
, item
, vector
;
3383 register struct Lisp_Cons
*otem
;
3385 /* If we're reading a funvec object we start out assuming it's also a
3386 byte-code object (a subset of funvecs), so we can do any special
3387 processing needed. If it's just an ordinary funvec object, we'll
3388 realize that as soon as we've read the first element. */
3389 int read_bytecode
= read_funvec
;
3391 tem
= read_list (1, readcharfun
);
3392 len
= Flength (tem
);
3393 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3395 size
= XVECTOR (vector
)->size
;
3396 ptr
= XVECTOR (vector
)->contents
;
3397 for (i
= 0; i
< size
; i
++)
3401 /* If READ_BYTECODE is set, check whether this is really a byte-code
3402 object, or just an ordinary `funvec' object -- non-byte-code
3403 funvec objects use the same reader syntax. We can tell from the
3404 first element which one it is. */
3405 if (read_bytecode
&& i
== 0 && ! FUNVEC_COMPILED_TAG_P (item
))
3406 read_bytecode
= 0; /* Nope. */
3408 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3409 bytecode object, the docstring containing the bytecode and
3410 constants values must be treated as unibyte and passed to
3411 Fread, to get the actual bytecode string and constants vector. */
3412 if (read_bytecode
&& load_force_doc_strings
)
3414 if (i
== COMPILED_BYTECODE
)
3416 if (!STRINGP (item
))
3417 error ("Invalid byte code");
3419 /* Delay handling the bytecode slot until we know whether
3420 it is lazily-loaded (we can tell by whether the
3421 constants slot is nil). */
3422 ptr
[COMPILED_CONSTANTS
] = item
;
3425 else if (i
== COMPILED_CONSTANTS
)
3427 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3431 /* Coerce string to unibyte (like string-as-unibyte,
3432 but without generating extra garbage and
3433 guaranteeing no change in the contents). */
3434 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3435 STRING_SET_UNIBYTE (bytestr
);
3437 item
= Fread (Fcons (bytestr
, readcharfun
));
3439 error ("Invalid byte code");
3441 otem
= XCONS (item
);
3442 bytestr
= XCAR (item
);
3447 /* Now handle the bytecode slot. */
3448 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3450 else if (i
== COMPILED_DOC_STRING
3452 && ! STRING_MULTIBYTE (item
))
3454 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3455 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3457 item
= Fstring_as_multibyte (item
);
3460 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3466 if (read_bytecode
&& size
>= 4)
3467 /* Convert this vector to a bytecode object. */
3468 vector
= Fmake_byte_code (size
, XVECTOR (vector
)->contents
);
3469 else if (read_funvec
&& size
>= 1)
3470 /* Convert this vector to an ordinary funvec object. */
3471 XSETFUNVEC (vector
, XVECTOR (vector
));
3476 /* FLAG = 1 means check for ] to terminate rather than ) and .
3477 FLAG = -1 means check for starting with defun
3478 and make structure pure. */
3481 read_list (int flag
, register Lisp_Object readcharfun
)
3483 /* -1 means check next element for defun,
3484 0 means don't check,
3485 1 means already checked and found defun. */
3486 int defunflag
= flag
< 0 ? -1 : 0;
3487 Lisp_Object val
, tail
;
3488 register Lisp_Object elt
, tem
;
3489 struct gcpro gcpro1
, gcpro2
;
3490 /* 0 is the normal case.
3491 1 means this list is a doc reference; replace it with the number 0.
3492 2 means this list is a doc reference; replace it with the doc string. */
3493 int doc_reference
= 0;
3495 /* Initialize this to 1 if we are reading a list. */
3496 int first_in_list
= flag
<= 0;
3505 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3510 /* While building, if the list starts with #$, treat it specially. */
3511 if (EQ (elt
, Vload_file_name
)
3513 && !NILP (Vpurify_flag
))
3515 if (NILP (Vdoc_file_name
))
3516 /* We have not yet called Snarf-documentation, so assume
3517 this file is described in the DOC-MM.NN file
3518 and Snarf-documentation will fill in the right value later.
3519 For now, replace the whole list with 0. */
3522 /* We have already called Snarf-documentation, so make a relative
3523 file name for this file, so it can be found properly
3524 in the installed Lisp directory.
3525 We don't use Fexpand_file_name because that would make
3526 the directory absolute now. */
3527 elt
= concat2 (build_string ("../lisp/"),
3528 Ffile_name_nondirectory (elt
));
3530 else if (EQ (elt
, Vload_file_name
)
3532 && load_force_doc_strings
)
3541 invalid_syntax (") or . in a vector", 18);
3549 XSETCDR (tail
, read0 (readcharfun
));
3551 val
= read0 (readcharfun
);
3552 read1 (readcharfun
, &ch
, 0);
3556 if (doc_reference
== 1)
3557 return make_number (0);
3558 if (doc_reference
== 2)
3560 /* Get a doc string from the file we are loading.
3561 If it's in saved_doc_string, get it from there.
3563 Here, we don't know if the string is a
3564 bytecode string or a doc string. As a
3565 bytecode string must be unibyte, we always
3566 return a unibyte string. If it is actually a
3567 doc string, caller must make it
3570 int pos
= XINT (XCDR (val
));
3571 /* Position is negative for user variables. */
3572 if (pos
< 0) pos
= -pos
;
3573 if (pos
>= saved_doc_string_position
3574 && pos
< (saved_doc_string_position
3575 + saved_doc_string_length
))
3577 int start
= pos
- saved_doc_string_position
;
3580 /* Process quoting with ^A,
3581 and find the end of the string,
3582 which is marked with ^_ (037). */
3583 for (from
= start
, to
= start
;
3584 saved_doc_string
[from
] != 037;)
3586 int c
= saved_doc_string
[from
++];
3589 c
= saved_doc_string
[from
++];
3591 saved_doc_string
[to
++] = c
;
3593 saved_doc_string
[to
++] = 0;
3595 saved_doc_string
[to
++] = 037;
3598 saved_doc_string
[to
++] = c
;
3601 return make_unibyte_string (saved_doc_string
+ start
,
3604 /* Look in prev_saved_doc_string the same way. */
3605 else if (pos
>= prev_saved_doc_string_position
3606 && pos
< (prev_saved_doc_string_position
3607 + prev_saved_doc_string_length
))
3609 int start
= pos
- prev_saved_doc_string_position
;
3612 /* Process quoting with ^A,
3613 and find the end of the string,
3614 which is marked with ^_ (037). */
3615 for (from
= start
, to
= start
;
3616 prev_saved_doc_string
[from
] != 037;)
3618 int c
= prev_saved_doc_string
[from
++];
3621 c
= prev_saved_doc_string
[from
++];
3623 prev_saved_doc_string
[to
++] = c
;
3625 prev_saved_doc_string
[to
++] = 0;
3627 prev_saved_doc_string
[to
++] = 037;
3630 prev_saved_doc_string
[to
++] = c
;
3633 return make_unibyte_string (prev_saved_doc_string
3638 return get_doc_string (val
, 1, 0);
3643 invalid_syntax (". in wrong context", 18);
3645 invalid_syntax ("] in a list", 11);
3647 tem
= (read_pure
&& flag
<= 0
3648 ? pure_cons (elt
, Qnil
)
3649 : Fcons (elt
, Qnil
));
3651 XSETCDR (tail
, tem
);
3656 defunflag
= EQ (elt
, Qdefun
);
3657 else if (defunflag
> 0)
3662 Lisp_Object Vobarray
;
3663 Lisp_Object initial_obarray
;
3665 /* oblookup stores the bucket number here, for the sake of Funintern. */
3667 int oblookup_last_bucket_number
;
3669 static int hash_string (const unsigned char *ptr
, int len
);
3671 /* Get an error if OBARRAY is not an obarray.
3672 If it is one, return it. */
3675 check_obarray (Lisp_Object obarray
)
3677 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3679 /* If Vobarray is now invalid, force it to be valid. */
3680 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3681 wrong_type_argument (Qvectorp
, obarray
);
3686 /* Intern the C string STR: return a symbol with that name,
3687 interned in the current obarray. */
3690 intern (const char *str
)
3693 int len
= strlen (str
);
3694 Lisp_Object obarray
;
3697 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3698 obarray
= check_obarray (obarray
);
3699 tem
= oblookup (obarray
, str
, len
, len
);
3702 return Fintern (make_string (str
, len
), obarray
);
3706 intern_c_string (const char *str
)
3709 int len
= strlen (str
);
3710 Lisp_Object obarray
;
3713 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3714 obarray
= check_obarray (obarray
);
3715 tem
= oblookup (obarray
, str
, len
, len
);
3719 if (NILP (Vpurify_flag
))
3720 /* Creating a non-pure string from a string literal not
3721 implemented yet. We could just use make_string here and live
3722 with the extra copy. */
3725 return Fintern (make_pure_c_string (str
), obarray
);
3728 /* Create an uninterned symbol with name STR. */
3731 make_symbol (const char *str
)
3733 int len
= strlen (str
);
3735 return Fmake_symbol (!NILP (Vpurify_flag
)
3736 ? make_pure_string (str
, len
, len
, 0)
3737 : make_string (str
, len
));
3740 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3741 doc
: /* Return the canonical symbol whose name is STRING.
3742 If there is none, one is created by this function and returned.
3743 A second optional argument specifies the obarray to use;
3744 it defaults to the value of `obarray'. */)
3745 (Lisp_Object string
, Lisp_Object obarray
)
3747 register Lisp_Object tem
, sym
, *ptr
;
3749 if (NILP (obarray
)) obarray
= Vobarray
;
3750 obarray
= check_obarray (obarray
);
3752 CHECK_STRING (string
);
3754 tem
= oblookup (obarray
, SDATA (string
),
3757 if (!INTEGERP (tem
))
3760 if (!NILP (Vpurify_flag
))
3761 string
= Fpurecopy (string
);
3762 sym
= Fmake_symbol (string
);
3764 if (EQ (obarray
, initial_obarray
))
3765 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3767 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3769 if ((SREF (string
, 0) == ':')
3770 && EQ (obarray
, initial_obarray
))
3772 XSYMBOL (sym
)->constant
= 1;
3773 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3774 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3777 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3779 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3781 XSYMBOL (sym
)->next
= 0;
3786 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3787 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3788 NAME may be a string or a symbol. If it is a symbol, that exact
3789 symbol is searched for.
3790 A second optional argument specifies the obarray to use;
3791 it defaults to the value of `obarray'. */)
3792 (Lisp_Object name
, Lisp_Object obarray
)
3794 register Lisp_Object tem
, string
;
3796 if (NILP (obarray
)) obarray
= Vobarray
;
3797 obarray
= check_obarray (obarray
);
3799 if (!SYMBOLP (name
))
3801 CHECK_STRING (name
);
3805 string
= SYMBOL_NAME (name
);
3807 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3808 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3814 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3815 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3816 The value is t if a symbol was found and deleted, nil otherwise.
3817 NAME may be a string or a symbol. If it is a symbol, that symbol
3818 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3819 OBARRAY defaults to the value of the variable `obarray'. */)
3820 (Lisp_Object name
, Lisp_Object obarray
)
3822 register Lisp_Object string
, tem
;
3825 if (NILP (obarray
)) obarray
= Vobarray
;
3826 obarray
= check_obarray (obarray
);
3829 string
= SYMBOL_NAME (name
);
3832 CHECK_STRING (name
);
3836 tem
= oblookup (obarray
, SDATA (string
),
3841 /* If arg was a symbol, don't delete anything but that symbol itself. */
3842 if (SYMBOLP (name
) && !EQ (name
, tem
))
3845 /* There are plenty of other symbols which will screw up the Emacs
3846 session if we unintern them, as well as even more ways to use
3847 `setq' or `fset' or whatnot to make the Emacs session
3848 unusable. Let's not go down this silly road. --Stef */
3849 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3850 error ("Attempt to unintern t or nil"); */
3852 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3854 hash
= oblookup_last_bucket_number
;
3856 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3858 if (XSYMBOL (tem
)->next
)
3859 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3861 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3865 Lisp_Object tail
, following
;
3867 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3868 XSYMBOL (tail
)->next
;
3871 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3872 if (EQ (following
, tem
))
3874 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3883 /* Return the symbol in OBARRAY whose names matches the string
3884 of SIZE characters (SIZE_BYTE bytes) at PTR.
3885 If there is no such symbol in OBARRAY, return nil.
3887 Also store the bucket number in oblookup_last_bucket_number. */
3890 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3894 register Lisp_Object tail
;
3895 Lisp_Object bucket
, tem
;
3897 if (!VECTORP (obarray
)
3898 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3900 obarray
= check_obarray (obarray
);
3901 obsize
= XVECTOR (obarray
)->size
;
3903 /* This is sometimes needed in the middle of GC. */
3904 obsize
&= ~ARRAY_MARK_FLAG
;
3905 hash
= hash_string (ptr
, size_byte
) % obsize
;
3906 bucket
= XVECTOR (obarray
)->contents
[hash
];
3907 oblookup_last_bucket_number
= hash
;
3908 if (EQ (bucket
, make_number (0)))
3910 else if (!SYMBOLP (bucket
))
3911 error ("Bad data in guts of obarray"); /* Like CADR error message */
3913 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3915 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3916 && SCHARS (SYMBOL_NAME (tail
)) == size
3917 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3919 else if (XSYMBOL (tail
)->next
== 0)
3922 XSETINT (tem
, hash
);
3927 hash_string (const unsigned char *ptr
, int len
)
3929 register const unsigned char *p
= ptr
;
3930 register const unsigned char *end
= p
+ len
;
3931 register unsigned char c
;
3932 register int hash
= 0;
3937 if (c
>= 0140) c
-= 40;
3938 hash
= ((hash
<<3) + (hash
>>28) + c
);
3940 return hash
& 07777777777;
3944 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3947 register Lisp_Object tail
;
3948 CHECK_VECTOR (obarray
);
3949 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3951 tail
= XVECTOR (obarray
)->contents
[i
];
3956 if (XSYMBOL (tail
)->next
== 0)
3958 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3964 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3966 call1 (function
, sym
);
3969 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3970 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3971 OBARRAY defaults to the value of `obarray'. */)
3972 (Lisp_Object function
, Lisp_Object obarray
)
3974 if (NILP (obarray
)) obarray
= Vobarray
;
3975 obarray
= check_obarray (obarray
);
3977 map_obarray (obarray
, mapatoms_1
, function
);
3981 #define OBARRAY_SIZE 1511
3986 Lisp_Object oblength
;
3988 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3990 Vobarray
= Fmake_vector (oblength
, make_number (0));
3991 initial_obarray
= Vobarray
;
3992 staticpro (&initial_obarray
);
3994 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3995 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3996 NILP (Vpurify_flag) check in intern_c_string. */
3997 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3998 Qnil
= intern_c_string ("nil");
4000 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4001 so those two need to be fixed manally. */
4002 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4003 XSYMBOL (Qunbound
)->function
= Qunbound
;
4004 XSYMBOL (Qunbound
)->plist
= Qnil
;
4005 /* XSYMBOL (Qnil)->function = Qunbound; */
4006 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4007 XSYMBOL (Qnil
)->constant
= 1;
4008 XSYMBOL (Qnil
)->plist
= Qnil
;
4010 Qt
= intern_c_string ("t");
4011 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4012 XSYMBOL (Qt
)->constant
= 1;
4014 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4017 Qvariable_documentation
= intern_c_string ("variable-documentation");
4018 staticpro (&Qvariable_documentation
);
4020 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
4021 read_buffer
= (char *) xmalloc (read_buffer_size
);
4025 defsubr (struct Lisp_Subr
*sname
)
4028 sym
= intern_c_string (sname
->symbol_name
);
4029 XSETPVECTYPE (sname
, PVEC_SUBR
);
4030 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4033 #ifdef NOTDEF /* use fset in subr.el now */
4035 defalias (sname
, string
)
4036 struct Lisp_Subr
*sname
;
4040 sym
= intern (string
);
4041 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4045 /* Define an "integer variable"; a symbol whose value is forwarded to a
4046 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
4047 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4049 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4050 const char *namestring
, EMACS_INT
*address
)
4053 sym
= intern_c_string (namestring
);
4054 i_fwd
->type
= Lisp_Fwd_Int
;
4055 i_fwd
->intvar
= address
;
4056 XSYMBOL (sym
)->declared_special
= 1;
4057 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4058 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4061 /* Similar but define a variable whose value is t if address contains 1,
4062 nil if address contains 0. */
4064 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4065 const char *namestring
, int *address
)
4068 sym
= intern_c_string (namestring
);
4069 b_fwd
->type
= Lisp_Fwd_Bool
;
4070 b_fwd
->boolvar
= address
;
4071 XSYMBOL (sym
)->declared_special
= 1;
4072 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4073 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4074 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4077 /* Similar but define a variable whose value is the Lisp Object stored
4078 at address. Two versions: with and without gc-marking of the C
4079 variable. The nopro version is used when that variable will be
4080 gc-marked for some other reason, since marking the same slot twice
4081 can cause trouble with strings. */
4083 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4084 const char *namestring
, Lisp_Object
*address
)
4087 sym
= intern_c_string (namestring
);
4088 o_fwd
->type
= Lisp_Fwd_Obj
;
4089 o_fwd
->objvar
= address
;
4090 XSYMBOL (sym
)->declared_special
= 1;
4091 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4092 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4096 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4097 const char *namestring
, Lisp_Object
*address
)
4099 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4100 staticpro (address
);
4104 /* Similar but define a variable whose value is the Lisp Object stored
4105 at a particular offset in the current kboard object. */
4108 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4109 const char *namestring
, int offset
)
4112 sym
= intern_c_string (namestring
);
4113 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4114 ko_fwd
->offset
= offset
;
4115 XSYMBOL (sym
)->declared_special
= 1;
4116 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4117 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4120 /* Record the value of load-path used at the start of dumping
4121 so we can see if the site changed it later during dumping. */
4122 static Lisp_Object dump_path
;
4128 int turn_off_warning
= 0;
4130 /* Compute the default load-path. */
4132 normal
= PATH_LOADSEARCH
;
4133 Vload_path
= decode_env_path (0, normal
);
4135 if (NILP (Vpurify_flag
))
4136 normal
= PATH_LOADSEARCH
;
4138 normal
= PATH_DUMPLOADSEARCH
;
4140 /* In a dumped Emacs, we normally have to reset the value of
4141 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4142 uses ../lisp, instead of the path of the installed elisp
4143 libraries. However, if it appears that Vload_path was changed
4144 from the default before dumping, don't override that value. */
4147 if (! NILP (Fequal (dump_path
, Vload_path
)))
4149 Vload_path
= decode_env_path (0, normal
);
4150 if (!NILP (Vinstallation_directory
))
4152 Lisp_Object tem
, tem1
, sitelisp
;
4154 /* Remove site-lisp dirs from path temporarily and store
4155 them in sitelisp, then conc them on at the end so
4156 they're always first in path. */
4160 tem
= Fcar (Vload_path
);
4161 tem1
= Fstring_match (build_string ("site-lisp"),
4165 Vload_path
= Fcdr (Vload_path
);
4166 sitelisp
= Fcons (tem
, sitelisp
);
4172 /* Add to the path the lisp subdir of the
4173 installation dir, if it exists. */
4174 tem
= Fexpand_file_name (build_string ("lisp"),
4175 Vinstallation_directory
);
4176 tem1
= Ffile_exists_p (tem
);
4179 if (NILP (Fmember (tem
, Vload_path
)))
4181 turn_off_warning
= 1;
4182 Vload_path
= Fcons (tem
, Vload_path
);
4186 /* That dir doesn't exist, so add the build-time
4187 Lisp dirs instead. */
4188 Vload_path
= nconc2 (Vload_path
, dump_path
);
4190 /* Add leim under the installation dir, if it exists. */
4191 tem
= Fexpand_file_name (build_string ("leim"),
4192 Vinstallation_directory
);
4193 tem1
= Ffile_exists_p (tem
);
4196 if (NILP (Fmember (tem
, Vload_path
)))
4197 Vload_path
= Fcons (tem
, Vload_path
);
4200 /* Add site-lisp under the installation dir, if it exists. */
4201 tem
= Fexpand_file_name (build_string ("site-lisp"),
4202 Vinstallation_directory
);
4203 tem1
= Ffile_exists_p (tem
);
4206 if (NILP (Fmember (tem
, Vload_path
)))
4207 Vload_path
= Fcons (tem
, Vload_path
);
4210 /* If Emacs was not built in the source directory,
4211 and it is run from where it was built, add to load-path
4212 the lisp, leim and site-lisp dirs under that directory. */
4214 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4218 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4219 Vinstallation_directory
);
4220 tem1
= Ffile_exists_p (tem
);
4222 /* Don't be fooled if they moved the entire source tree
4223 AFTER dumping Emacs. If the build directory is indeed
4224 different from the source dir, src/Makefile.in and
4225 src/Makefile will not be found together. */
4226 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4227 Vinstallation_directory
);
4228 tem2
= Ffile_exists_p (tem
);
4229 if (!NILP (tem1
) && NILP (tem2
))
4231 tem
= Fexpand_file_name (build_string ("lisp"),
4234 if (NILP (Fmember (tem
, Vload_path
)))
4235 Vload_path
= Fcons (tem
, Vload_path
);
4237 tem
= Fexpand_file_name (build_string ("leim"),
4240 if (NILP (Fmember (tem
, Vload_path
)))
4241 Vload_path
= Fcons (tem
, Vload_path
);
4243 tem
= Fexpand_file_name (build_string ("site-lisp"),
4246 if (NILP (Fmember (tem
, Vload_path
)))
4247 Vload_path
= Fcons (tem
, Vload_path
);
4250 if (!NILP (sitelisp
))
4251 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4257 /* NORMAL refers to the lisp dir in the source directory. */
4258 /* We used to add ../lisp at the front here, but
4259 that caused trouble because it was copied from dump_path
4260 into Vload_path, above, when Vinstallation_directory was non-nil.
4261 It should be unnecessary. */
4262 Vload_path
= decode_env_path (0, normal
);
4263 dump_path
= Vload_path
;
4267 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4268 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4269 almost never correct, thereby causing a warning to be printed out that
4270 confuses users. Since PATH_LOADSEARCH is always overridden by the
4271 EMACSLOADPATH environment variable below, disable the warning on NT. */
4273 /* Warn if dirs in the *standard* path don't exist. */
4274 if (!turn_off_warning
)
4276 Lisp_Object path_tail
;
4278 for (path_tail
= Vload_path
;
4280 path_tail
= XCDR (path_tail
))
4282 Lisp_Object dirfile
;
4283 dirfile
= Fcar (path_tail
);
4284 if (STRINGP (dirfile
))
4286 dirfile
= Fdirectory_file_name (dirfile
);
4287 if (access (SDATA (dirfile
), 0) < 0)
4288 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4293 #endif /* !(WINDOWSNT || HAVE_NS) */
4295 /* If the EMACSLOADPATH environment variable is set, use its value.
4296 This doesn't apply if we're dumping. */
4298 if (NILP (Vpurify_flag
)
4299 && egetenv ("EMACSLOADPATH"))
4301 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4305 load_in_progress
= 0;
4306 Vload_file_name
= Qnil
;
4308 load_descriptor_list
= Qnil
;
4310 Vstandard_input
= Qt
;
4311 Vloads_in_progress
= Qnil
;
4314 /* Print a warning, using format string FORMAT, that directory DIRNAME
4315 does not exist. Print it on stderr and put it in *Messages*. */
4318 dir_warning (const char *format
, Lisp_Object dirname
)
4321 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4323 fprintf (stderr
, format
, SDATA (dirname
));
4324 sprintf (buffer
, format
, SDATA (dirname
));
4325 /* Don't log the warning before we've initialized!! */
4327 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4331 syms_of_lread (void)
4334 defsubr (&Sread_from_string
);
4336 defsubr (&Sintern_soft
);
4337 defsubr (&Sunintern
);
4338 defsubr (&Sget_load_suffixes
);
4340 defsubr (&Seval_buffer
);
4341 defsubr (&Seval_region
);
4342 defsubr (&Sread_char
);
4343 defsubr (&Sread_char_exclusive
);
4344 defsubr (&Sread_event
);
4345 defsubr (&Sget_file_char
);
4346 defsubr (&Smapatoms
);
4347 defsubr (&Slocate_file_internal
);
4349 DEFVAR_LISP ("obarray", &Vobarray
,
4350 doc
: /* Symbol table for use by `intern' and `read'.
4351 It is a vector whose length ought to be prime for best results.
4352 The vector's contents don't make sense if examined from Lisp programs;
4353 to find all the symbols in an obarray, use `mapatoms'. */);
4355 DEFVAR_LISP ("values", &Vvalues
,
4356 doc
: /* List of values of all expressions which were read, evaluated and printed.
4357 Order is reverse chronological. */);
4359 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4360 doc
: /* Stream for read to get input from.
4361 See documentation of `read' for possible values. */);
4362 Vstandard_input
= Qt
;
4364 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4365 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4367 If this variable is a buffer, then only forms read from that buffer
4368 will be added to `read-symbol-positions-list'.
4369 If this variable is t, then all read forms will be added.
4370 The effect of all other values other than nil are not currently
4371 defined, although they may be in the future.
4373 The positions are relative to the last call to `read' or
4374 `read-from-string'. It is probably a bad idea to set this variable at
4375 the toplevel; bind it instead. */);
4376 Vread_with_symbol_positions
= Qnil
;
4378 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4379 doc
: /* A list mapping read symbols to their positions.
4380 This variable is modified during calls to `read' or
4381 `read-from-string', but only when `read-with-symbol-positions' is
4384 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4385 CHAR-POSITION is an integer giving the offset of that occurrence of the
4386 symbol from the position where `read' or `read-from-string' started.
4388 Note that a symbol will appear multiple times in this list, if it was
4389 read multiple times. The list is in the same order as the symbols
4391 Vread_symbol_positions_list
= Qnil
;
4393 DEFVAR_LISP ("read-circle", &Vread_circle
,
4394 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4397 DEFVAR_LISP ("load-path", &Vload_path
,
4398 doc
: /* *List of directories to search for files to load.
4399 Each element is a string (directory name) or nil (try default directory).
4400 Initialized based on EMACSLOADPATH environment variable, if any,
4401 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4403 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4404 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4405 This list should not include the empty string.
4406 `load' and related functions try to append these suffixes, in order,
4407 to the specified file name if a Lisp suffix is allowed or required. */);
4408 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4409 Fcons (make_pure_c_string (".el"), Qnil
));
4410 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4411 doc
: /* List of suffixes that indicate representations of \
4413 This list should normally start with the empty string.
4415 Enabling Auto Compression mode appends the suffixes in
4416 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4417 mode removes them again. `load' and related functions use this list to
4418 determine whether they should look for compressed versions of a file
4419 and, if so, which suffixes they should try to append to the file name
4420 in order to do so. However, if you want to customize which suffixes
4421 the loading functions recognize as compression suffixes, you should
4422 customize `jka-compr-load-suffixes' rather than the present variable. */);
4423 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4425 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4426 doc
: /* Non-nil if inside of `load'. */);
4427 Qload_in_progress
= intern_c_string ("load-in-progress");
4428 staticpro (&Qload_in_progress
);
4430 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4431 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4432 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4434 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4435 a symbol \(a feature name).
4437 When `load' is run and the file-name argument matches an element's
4438 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4439 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4441 An error in FORMS does not undo the load, but does prevent execution of
4442 the rest of the FORMS. */);
4443 Vafter_load_alist
= Qnil
;
4445 DEFVAR_LISP ("load-history", &Vload_history
,
4446 doc
: /* Alist mapping loaded file names to symbols and features.
4447 Each alist element should be a list (FILE-NAME ENTRIES...), where
4448 FILE-NAME is the name of a file that has been loaded into Emacs.
4449 The file name is absolute and true (i.e. it doesn't contain symlinks).
4450 As an exception, one of the alist elements may have FILE-NAME nil,
4451 for symbols and features not associated with any file.
4453 The remaining ENTRIES in the alist element describe the functions and
4454 variables defined in that file, the features provided, and the
4455 features required. Each entry has the form `(provide . FEATURE)',
4456 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4457 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4458 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4459 SYMBOL was an autoload before this file redefined it as a function.
4461 During preloading, the file name recorded is relative to the main Lisp
4462 directory. These file names are converted to absolute at startup. */);
4463 Vload_history
= Qnil
;
4465 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4466 doc
: /* Full name of file being loaded by `load'. */);
4467 Vload_file_name
= Qnil
;
4469 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4470 doc
: /* File name, including directory, of user's initialization file.
4471 If the file loaded had extension `.elc', and the corresponding source file
4472 exists, this variable contains the name of source file, suitable for use
4473 by functions like `custom-save-all' which edit the init file.
4474 While Emacs loads and evaluates the init file, value is the real name
4475 of the file, regardless of whether or not it has the `.elc' extension. */);
4476 Vuser_init_file
= Qnil
;
4478 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4479 doc
: /* Used for internal purposes by `load'. */);
4480 Vcurrent_load_list
= Qnil
;
4482 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4483 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4484 The default is nil, which means use the function `read'. */);
4485 Vload_read_function
= Qnil
;
4487 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4488 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4489 This function is for doing code conversion before reading the source file.
4490 If nil, loading is done without any code conversion.
4491 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4492 FULLNAME is the full name of FILE.
4493 See `load' for the meaning of the remaining arguments. */);
4494 Vload_source_file_function
= Qnil
;
4496 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4497 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4498 This is useful when the file being loaded is a temporary copy. */);
4499 load_force_doc_strings
= 0;
4501 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4502 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4503 This is normally bound by `load' and `eval-buffer' to control `read',
4504 and is not meant for users to change. */);
4505 load_convert_to_unibyte
= 0;
4507 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4508 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4509 You cannot count on them to still be there! */);
4511 = Fexpand_file_name (build_string ("../"),
4512 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4514 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4515 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4516 Vpreloaded_file_list
= Qnil
;
4518 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4519 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4520 Vbyte_boolean_vars
= Qnil
;
4522 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4523 doc
: /* Non-nil means load dangerous compiled Lisp files.
4524 Some versions of XEmacs use different byte codes than Emacs. These
4525 incompatible byte codes can make Emacs crash when it tries to execute
4527 load_dangerous_libraries
= 0;
4529 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4530 doc
: /* Non-nil means force printing messages when loading Lisp files.
4531 This overrides the value of the NOMESSAGE argument to `load'. */);
4532 force_load_messages
= 0;
4534 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4535 doc
: /* Regular expression matching safe to load compiled Lisp files.
4536 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4537 from the file, and matches them against this regular expression.
4538 When the regular expression matches, the file is considered to be safe
4539 to load. See also `load-dangerous-libraries'. */);
4540 Vbytecomp_version_regexp
4541 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4543 Qlexical_binding
= intern ("lexical-binding");
4544 staticpro (&Qlexical_binding
);
4545 DEFVAR_LISP ("lexical-binding", &Vlexical_binding
,
4546 doc
: /* If non-nil, use lexical binding when evaluating code.
4547 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4548 This variable is automatically set from the file variables of an interpreted
4549 lisp file read using `load'. */);
4550 Fmake_variable_buffer_local (Qlexical_binding
);
4552 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4553 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4554 Veval_buffer_list
= Qnil
;
4556 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4557 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4558 Vold_style_backquotes
= Qnil
;
4559 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4560 staticpro (&Qold_style_backquotes
);
4562 /* Vsource_directory was initialized in init_lread. */
4564 load_descriptor_list
= Qnil
;
4565 staticpro (&load_descriptor_list
);
4567 Qcurrent_load_list
= intern_c_string ("current-load-list");
4568 staticpro (&Qcurrent_load_list
);
4570 Qstandard_input
= intern_c_string ("standard-input");
4571 staticpro (&Qstandard_input
);
4573 Qread_char
= intern_c_string ("read-char");
4574 staticpro (&Qread_char
);
4576 Qget_file_char
= intern_c_string ("get-file-char");
4577 staticpro (&Qget_file_char
);
4579 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4580 staticpro (&Qget_emacs_mule_file_char
);
4582 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4583 staticpro (&Qload_force_doc_strings
);
4585 Qbackquote
= intern_c_string ("`");
4586 staticpro (&Qbackquote
);
4587 Qcomma
= intern_c_string (",");
4588 staticpro (&Qcomma
);
4589 Qcomma_at
= intern_c_string (",@");
4590 staticpro (&Qcomma_at
);
4591 Qcomma_dot
= intern_c_string (",.");
4592 staticpro (&Qcomma_dot
);
4594 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4595 staticpro (&Qinhibit_file_name_operation
);
4597 Qascii_character
= intern_c_string ("ascii-character");
4598 staticpro (&Qascii_character
);
4600 Qfunction
= intern_c_string ("function");
4601 staticpro (&Qfunction
);
4603 Qload
= intern_c_string ("load");
4606 Qload_file_name
= intern_c_string ("load-file-name");
4607 staticpro (&Qload_file_name
);
4609 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4610 staticpro (&Qeval_buffer_list
);
4612 Qfile_truename
= intern_c_string ("file-truename");
4613 staticpro (&Qfile_truename
) ;
4615 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4616 staticpro (&Qdo_after_load_evaluation
) ;
4618 staticpro (&dump_path
);
4620 staticpro (&read_objects
);
4621 read_objects
= Qnil
;
4622 staticpro (&seen_list
);
4625 Vloads_in_progress
= Qnil
;
4626 staticpro (&Vloads_in_progress
);
4628 Qhash_table
= intern_c_string ("hash-table");
4629 staticpro (&Qhash_table
);
4630 Qdata
= intern_c_string ("data");
4632 Qtest
= intern_c_string ("test");
4634 Qsize
= intern_c_string ("size");
4636 Qweakness
= intern_c_string ("weakness");
4637 staticpro (&Qweakness
);
4638 Qrehash_size
= intern_c_string ("rehash-size");
4639 staticpro (&Qrehash_size
);
4640 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4641 staticpro (&Qrehash_threshold
);