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
, int,
224 Lisp_Object
, Lisp_Object
,
225 Lisp_Object
, Lisp_Object
);
226 static Lisp_Object
load_unwind (Lisp_Object
);
227 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
229 static void invalid_syntax (const char *, int) NO_RETURN
;
230 static void end_of_file_error (void) NO_RETURN
;
233 /* Functions that read one byte from the current source READCHARFUN
234 or unreads one byte. If the integer argument C is -1, it returns
235 one read byte, or -1 when there's no more byte in the source. If C
236 is 0 or positive, it unreads C, and the return value is not
239 static int readbyte_for_lambda (int, Lisp_Object
);
240 static int readbyte_from_file (int, Lisp_Object
);
241 static int readbyte_from_string (int, Lisp_Object
);
243 /* Handle unreading and rereading of characters.
244 Write READCHAR to read a character,
245 UNREAD(c) to unread c to be read again.
247 These macros correctly read/unread multibyte characters. */
249 #define READCHAR readchar (readcharfun, NULL)
250 #define UNREAD(c) unreadchar (readcharfun, c)
252 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
253 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
255 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
256 Qlambda, or a cons, we use this to keep an unread character because
257 a file stream can't handle multibyte-char unreading. The value -1
258 means that there's no unread character. */
259 static int unread_char
;
262 readchar (Lisp_Object readcharfun
, int *multibyte
)
266 int (*readbyte
) (int, Lisp_Object
);
267 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
269 int emacs_mule_encoding
= 0;
276 if (BUFFERP (readcharfun
))
278 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
280 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
282 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
285 if (! NILP (inbuffer
->enable_multibyte_characters
))
287 /* Fetch the character code from the buffer. */
288 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
289 BUF_INC_POS (inbuffer
, pt_byte
);
296 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
297 if (! ASCII_BYTE_P (c
))
298 c
= BYTE8_TO_CHAR (c
);
301 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
305 if (MARKERP (readcharfun
))
307 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
309 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
311 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
314 if (! NILP (inbuffer
->enable_multibyte_characters
))
316 /* Fetch the character code from the buffer. */
317 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
318 BUF_INC_POS (inbuffer
, bytepos
);
325 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
326 if (! ASCII_BYTE_P (c
))
327 c
= BYTE8_TO_CHAR (c
);
331 XMARKER (readcharfun
)->bytepos
= bytepos
;
332 XMARKER (readcharfun
)->charpos
++;
337 if (EQ (readcharfun
, Qlambda
))
339 readbyte
= readbyte_for_lambda
;
343 if (EQ (readcharfun
, Qget_file_char
))
345 readbyte
= readbyte_from_file
;
349 if (STRINGP (readcharfun
))
351 if (read_from_string_index
>= read_from_string_limit
)
353 else if (STRING_MULTIBYTE (readcharfun
))
357 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
358 read_from_string_index
,
359 read_from_string_index_byte
);
363 c
= SREF (readcharfun
, read_from_string_index_byte
);
364 read_from_string_index
++;
365 read_from_string_index_byte
++;
370 if (CONSP (readcharfun
))
372 /* This is the case that read_vector is reading from a unibyte
373 string that contains a byte sequence previously skipped
374 because of #@NUMBER. The car part of readcharfun is that
375 string, and the cdr part is a value of readcharfun given to
377 readbyte
= readbyte_from_string
;
378 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
379 emacs_mule_encoding
= 1;
383 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
385 readbyte
= readbyte_from_file
;
386 emacs_mule_encoding
= 1;
390 tem
= call0 (readcharfun
);
397 if (unread_char
>= 0)
403 c
= (*readbyte
) (-1, readcharfun
);
404 if (c
< 0 || load_each_byte
)
408 if (ASCII_BYTE_P (c
))
410 if (emacs_mule_encoding
)
411 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
414 len
= BYTES_BY_CHAR_HEAD (c
);
417 c
= (*readbyte
) (-1, readcharfun
);
418 if (c
< 0 || ! TRAILING_CODE_P (c
))
421 (*readbyte
) (buf
[i
], readcharfun
);
422 return BYTE8_TO_CHAR (buf
[0]);
426 return STRING_CHAR (buf
);
429 /* Unread the character C in the way appropriate for the stream READCHARFUN.
430 If the stream is a user function, call it with the char as argument. */
433 unreadchar (Lisp_Object readcharfun
, int c
)
437 /* Don't back up the pointer if we're unreading the end-of-input mark,
438 since readchar didn't advance it when we read it. */
440 else if (BUFFERP (readcharfun
))
442 struct buffer
*b
= XBUFFER (readcharfun
);
443 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
446 if (! NILP (b
->enable_multibyte_characters
))
447 BUF_DEC_POS (b
, bytepos
);
451 BUF_PT_BYTE (b
) = bytepos
;
453 else if (MARKERP (readcharfun
))
455 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
456 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
458 XMARKER (readcharfun
)->charpos
--;
459 if (! NILP (b
->enable_multibyte_characters
))
460 BUF_DEC_POS (b
, bytepos
);
464 XMARKER (readcharfun
)->bytepos
= bytepos
;
466 else if (STRINGP (readcharfun
))
468 read_from_string_index
--;
469 read_from_string_index_byte
470 = string_char_to_byte (readcharfun
, read_from_string_index
);
472 else if (CONSP (readcharfun
))
476 else if (EQ (readcharfun
, Qlambda
))
480 else if (EQ (readcharfun
, Qget_file_char
)
481 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
486 ungetc (c
, instream
);
493 call1 (readcharfun
, make_number (c
));
497 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
499 return read_bytecode_char (c
>= 0);
504 readbyte_from_file (int c
, Lisp_Object readcharfun
)
509 ungetc (c
, instream
);
518 /* Interrupted reads have been observed while reading over the network */
519 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
531 return (c
== EOF
? -1 : c
);
535 readbyte_from_string (int c
, Lisp_Object readcharfun
)
537 Lisp_Object string
= XCAR (readcharfun
);
541 read_from_string_index
--;
542 read_from_string_index_byte
543 = string_char_to_byte (string
, read_from_string_index
);
546 if (read_from_string_index
>= read_from_string_limit
)
549 FETCH_STRING_CHAR_ADVANCE (c
, string
,
550 read_from_string_index
,
551 read_from_string_index_byte
);
556 /* Read one non-ASCII character from INSTREAM. The character is
557 encoded in `emacs-mule' and the first byte is already read in
561 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
563 /* Emacs-mule coding uses at most 4-byte for one character. */
564 unsigned char buf
[4];
565 int len
= emacs_mule_bytes
[c
];
566 struct charset
*charset
;
571 /* C is not a valid leading-code of `emacs-mule'. */
572 return BYTE8_TO_CHAR (c
);
578 c
= (*readbyte
) (-1, readcharfun
);
582 (*readbyte
) (buf
[i
], readcharfun
);
583 return BYTE8_TO_CHAR (buf
[0]);
590 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
591 code
= buf
[1] & 0x7F;
595 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
596 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
598 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
599 code
= buf
[2] & 0x7F;
603 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
604 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
609 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
610 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
612 c
= DECODE_CHAR (charset
, code
);
614 Fsignal (Qinvalid_read_syntax
,
615 Fcons (build_string ("invalid multibyte form"), Qnil
));
620 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
622 static Lisp_Object
read0 (Lisp_Object
);
623 static Lisp_Object
read1 (Lisp_Object
, int *, int);
625 static Lisp_Object
read_list (int, Lisp_Object
);
626 static Lisp_Object
read_vector (Lisp_Object
, int);
628 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
630 static void substitute_object_in_subtree (Lisp_Object
,
632 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
635 /* Get a character from the tty. */
637 /* Read input events until we get one that's acceptable for our purposes.
639 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
640 until we get a character we like, and then stuffed into
643 If ASCII_REQUIRED is non-zero, we check function key events to see
644 if the unmodified version of the symbol has a Qascii_character
645 property, and use that character, if present.
647 If ERROR_NONASCII is non-zero, we signal an error if the input we
648 get isn't an ASCII character with modifiers. If it's zero but
649 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
652 If INPUT_METHOD is nonzero, we invoke the current input method
653 if the character warrants that.
655 If SECONDS is a number, we wait that many seconds for input, and
656 return Qnil if no input arrives within that time. */
659 read_filtered_event (int no_switch_frame
, int ascii_required
,
660 int error_nonascii
, int input_method
, Lisp_Object seconds
)
662 Lisp_Object val
, delayed_switch_frame
;
665 #ifdef HAVE_WINDOW_SYSTEM
666 if (display_hourglass_p
)
670 delayed_switch_frame
= Qnil
;
672 /* Compute timeout. */
673 if (NUMBERP (seconds
))
675 EMACS_TIME wait_time
;
677 double duration
= extract_float (seconds
);
679 sec
= (int) duration
;
680 usec
= (duration
- sec
) * 1000000;
681 EMACS_GET_TIME (end_time
);
682 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
683 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
686 /* Read until we get an acceptable event. */
689 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
690 NUMBERP (seconds
) ? &end_time
: NULL
);
691 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
696 /* switch-frame events are put off until after the next ASCII
697 character. This is better than signaling an error just because
698 the last characters were typed to a separate minibuffer frame,
699 for example. Eventually, some code which can deal with
700 switch-frame events will read it and process it. */
702 && EVENT_HAS_PARAMETERS (val
)
703 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
705 delayed_switch_frame
= val
;
709 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
711 /* Convert certain symbols to their ASCII equivalents. */
714 Lisp_Object tem
, tem1
;
715 tem
= Fget (val
, Qevent_symbol_element_mask
);
718 tem1
= Fget (Fcar (tem
), Qascii_character
);
719 /* Merge this symbol's modifier bits
720 with the ASCII equivalent of its basic code. */
722 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
726 /* If we don't have a character now, deal with it appropriately. */
731 Vunread_command_events
= Fcons (val
, Qnil
);
732 error ("Non-character input-event");
739 if (! NILP (delayed_switch_frame
))
740 unread_switch_frame
= delayed_switch_frame
;
744 #ifdef HAVE_WINDOW_SYSTEM
745 if (display_hourglass_p
)
754 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
755 doc
: /* Read a character from the command input (keyboard or macro).
756 It is returned as a number.
757 If the character has modifiers, they are resolved and reflected to the
758 character code if possible (e.g. C-SPC -> 0).
760 If the user generates an event which is not a character (i.e. a mouse
761 click or function key event), `read-char' signals an error. As an
762 exception, switch-frame events are put off until non-character events
764 If you want to read non-character events, or ignore them, call
765 `read-event' or `read-char-exclusive' instead.
767 If the optional argument PROMPT is non-nil, display that as a prompt.
768 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
769 input method is turned on in the current buffer, that input method
770 is used for reading a character.
771 If the optional argument SECONDS is non-nil, it should be a number
772 specifying the maximum number of seconds to wait for input. If no
773 input arrives in that time, return nil. SECONDS may be a
774 floating-point value. */)
775 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
780 message_with_string ("%s", prompt
, 0);
781 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
783 return (NILP (val
) ? Qnil
784 : make_number (char_resolve_modifier_mask (XINT (val
))));
787 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
788 doc
: /* Read an event object from the input stream.
789 If the optional argument PROMPT is non-nil, display that as a prompt.
790 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
791 input method is turned on in the current buffer, that input method
792 is used for reading a character.
793 If the optional argument SECONDS is non-nil, it should be a number
794 specifying the maximum number of seconds to wait for input. If no
795 input arrives in that time, return nil. SECONDS may be a
796 floating-point value. */)
797 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
800 message_with_string ("%s", prompt
, 0);
801 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
804 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
805 doc
: /* Read a character from the command input (keyboard or macro).
806 It is returned as a number. Non-character events are ignored.
807 If the character has modifiers, they are resolved and reflected to the
808 character code if possible (e.g. C-SPC -> 0).
810 If the optional argument PROMPT is non-nil, display that as a prompt.
811 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
812 input method is turned on in the current buffer, that input method
813 is used for reading a character.
814 If the optional argument SECONDS is non-nil, it should be a number
815 specifying the maximum number of seconds to wait for input. If no
816 input arrives in that time, return nil. SECONDS may be a
817 floating-point value. */)
818 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
823 message_with_string ("%s", prompt
, 0);
825 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
827 return (NILP (val
) ? Qnil
828 : make_number (char_resolve_modifier_mask (XINT (val
))));
831 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
832 doc
: /* Don't use this yourself. */)
835 register Lisp_Object val
;
837 XSETINT (val
, getc (instream
));
845 /* Return true if the lisp code read using READCHARFUN defines a non-nil
846 `lexical-binding' file variable. After returning, the stream is
847 positioned following the first line, if it is a comment, otherwise
851 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
855 /* The first line isn't a comment, just give up. */
861 /* Look for an appropriate file-variable in the first line. */
865 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
866 } beg_end_state
= NOMINAL
;
867 int in_file_vars
= 0;
869 #define UPDATE_BEG_END_STATE(ch) \
870 if (beg_end_state == NOMINAL) \
871 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
872 else if (beg_end_state == AFTER_FIRST_DASH) \
873 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
874 else if (beg_end_state == AFTER_ASTERIX) \
877 in_file_vars = !in_file_vars; \
878 beg_end_state = NOMINAL; \
881 /* Skip until we get to the file vars, if any. */
885 UPDATE_BEG_END_STATE (ch
);
887 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
891 char var
[100], *var_end
, val
[100], *val_end
;
895 /* Read a variable name. */
896 while (ch
== ' ' || ch
== '\t')
900 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
902 if (var_end
< var
+ sizeof var
- 1)
904 UPDATE_BEG_END_STATE (ch
);
909 && (var_end
[-1] == ' ' || var_end
[-1] == '\t'))
915 /* Read a variable value. */
918 while (ch
== ' ' || ch
== '\t')
922 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
924 if (val_end
< val
+ sizeof val
- 1)
926 UPDATE_BEG_END_STATE (ch
);
930 /* The value was terminated by an end-marker, which
934 && (val_end
[-1] == ' ' || val_end
[-1] == '\t'))
938 if (strcmp (var
, "lexical-binding") == 0)
941 rv
= (strcmp (val
, "nil") != 0);
947 while (ch
!= '\n' && ch
!= EOF
)
955 /* Value is a version number of byte compiled code if the file
956 associated with file descriptor FD is a compiled Lisp file that's
957 safe to load. Only files compiled with Emacs are safe to load.
958 Files compiled with XEmacs can lead to a crash in Fbyte_code
959 because of an incompatible change in the byte compiler. */
962 safe_to_load_p (int fd
)
969 /* Read the first few bytes from the file, and look for a line
970 specifying the byte compiler version used. */
971 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
976 /* Skip to the next newline, skipping over the initial `ELC'
977 with NUL bytes following it, but note the version. */
978 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
983 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
990 lseek (fd
, 0, SEEK_SET
);
995 /* Callback for record_unwind_protect. Restore the old load list OLD,
996 after loading a file successfully. */
999 record_load_unwind (Lisp_Object old
)
1001 return Vloads_in_progress
= old
;
1004 /* This handler function is used via internal_condition_case_1. */
1007 load_error_handler (Lisp_Object data
)
1013 load_warn_old_style_backquotes (Lisp_Object file
)
1015 if (!NILP (Vold_style_backquotes
))
1017 Lisp_Object args
[2];
1018 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
1025 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1026 doc
: /* Return the suffixes that `load' should try if a suffix is \
1028 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1031 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1032 while (CONSP (suffixes
))
1034 Lisp_Object exts
= Vload_file_rep_suffixes
;
1035 suffix
= XCAR (suffixes
);
1036 suffixes
= XCDR (suffixes
);
1037 while (CONSP (exts
))
1041 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1044 return Fnreverse (lst
);
1047 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1048 doc
: /* Execute a file of Lisp code named FILE.
1049 First try FILE with `.elc' appended, then try with `.el',
1050 then try FILE unmodified (the exact suffixes in the exact order are
1051 determined by `load-suffixes'). Environment variable references in
1052 FILE are replaced with their values by calling `substitute-in-file-name'.
1053 This function searches the directories in `load-path'.
1055 If optional second arg NOERROR is non-nil,
1056 report no error if FILE doesn't exist.
1057 Print messages at start and end of loading unless
1058 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1060 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1061 suffixes `.elc' or `.el' to the specified name FILE.
1062 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1063 the suffix `.elc' or `.el'; don't accept just FILE unless
1064 it ends in one of those suffixes or includes a directory name.
1066 If this function fails to find a file, it may look for different
1067 representations of that file before trying another file.
1068 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1069 to the file name. Emacs uses this feature mainly to find compressed
1070 versions of files when Auto Compression mode is enabled.
1072 The exact suffixes that this function tries out, in the exact order,
1073 are given by the value of the variable `load-file-rep-suffixes' if
1074 NOSUFFIX is non-nil and by the return value of the function
1075 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1076 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1077 and then the former.
1079 Loading a file records its definitions, and its `provide' and
1080 `require' calls, in an element of `load-history' whose
1081 car is the file name loaded. See `load-history'.
1083 While the file is in the process of being loaded, the variable
1084 `load-in-progress' is non-nil and the variable `load-file-name'
1085 is bound to the file's name.
1087 Return t if the file exists and loads successfully. */)
1088 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1090 register FILE *stream
;
1091 register int fd
= -1;
1092 int count
= SPECPDL_INDEX ();
1093 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1094 Lisp_Object found
, efound
, hist_file_name
;
1095 /* 1 means we printed the ".el is newer" message. */
1097 /* 1 means we are loading a compiled file. */
1099 Lisp_Object handler
;
1101 const char *fmode
= "r";
1109 CHECK_STRING (file
);
1111 /* If file name is magic, call the handler. */
1112 /* This shouldn't be necessary any more now that `openp' handles it right.
1113 handler = Ffind_file_name_handler (file, Qload);
1114 if (!NILP (handler))
1115 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1117 /* Do this after the handler to avoid
1118 the need to gcpro noerror, nomessage and nosuffix.
1119 (Below here, we care only whether they are nil or not.)
1120 The presence of this call is the result of a historical accident:
1121 it used to be in every file-operation and when it got removed
1122 everywhere, it accidentally stayed here. Since then, enough people
1123 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1124 that it seemed risky to remove. */
1125 if (! NILP (noerror
))
1127 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1128 Qt
, load_error_handler
);
1133 file
= Fsubstitute_in_file_name (file
);
1136 /* Avoid weird lossage with null string as arg,
1137 since it would try to load a directory as a Lisp file */
1138 if (SCHARS (file
) > 0)
1140 int size
= SBYTES (file
);
1143 GCPRO2 (file
, found
);
1145 if (! NILP (must_suffix
))
1147 /* Don't insist on adding a suffix if FILE already ends with one. */
1149 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1152 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1154 /* Don't insist on adding a suffix
1155 if the argument includes a directory name. */
1156 else if (! NILP (Ffile_name_directory (file
)))
1160 fd
= openp (Vload_path
, file
,
1161 (!NILP (nosuffix
) ? Qnil
1162 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1163 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1164 tmp
[1] = Vload_file_rep_suffixes
,
1173 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1177 /* Tell startup.el whether or not we found the user's init file. */
1178 if (EQ (Qt
, Vuser_init_file
))
1179 Vuser_init_file
= found
;
1181 /* If FD is -2, that means openp found a magic file. */
1184 if (NILP (Fequal (found
, file
)))
1185 /* If FOUND is a different file name from FILE,
1186 find its handler even if we have already inhibited
1187 the `load' operation on FILE. */
1188 handler
= Ffind_file_name_handler (found
, Qt
);
1190 handler
= Ffind_file_name_handler (found
, Qload
);
1191 if (! NILP (handler
))
1192 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1195 /* Check if we're stuck in a recursive load cycle.
1197 2000-09-21: It's not possible to just check for the file loaded
1198 being a member of Vloads_in_progress. This fails because of the
1199 way the byte compiler currently works; `provide's are not
1200 evaluated, see font-lock.el/jit-lock.el as an example. This
1201 leads to a certain amount of ``normal'' recursion.
1203 Also, just loading a file recursively is not always an error in
1204 the general case; the second load may do something different. */
1208 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1209 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1213 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1215 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1216 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1219 /* All loads are by default dynamic, unless the file itself specifies
1220 otherwise using a file-variable in the first line. This is bound here
1221 so that it takes effect whether or not we use
1222 Vload_source_file_function. */
1223 specbind (Qlexical_binding
, Qnil
);
1225 /* Get the name for load-history. */
1226 hist_file_name
= (! NILP (Vpurify_flag
)
1227 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1228 tmp
[1] = Ffile_name_nondirectory (found
),
1234 /* Check for the presence of old-style quotes and warn about them. */
1235 specbind (Qold_style_backquotes
, Qnil
);
1236 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1238 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1239 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1240 /* Load .elc files directly, but not when they are
1241 remote and have no handler! */
1248 GCPRO3 (file
, found
, hist_file_name
);
1251 && ! (version
= safe_to_load_p (fd
)))
1254 if (!load_dangerous_libraries
)
1258 error ("File `%s' was not compiled in Emacs",
1261 else if (!NILP (nomessage
) && !force_load_messages
)
1262 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1267 efound
= ENCODE_FILE (found
);
1272 stat ((char *)SDATA (efound
), &s1
);
1273 SSET (efound
, SBYTES (efound
) - 1, 0);
1274 result
= stat ((char *)SDATA (efound
), &s2
);
1275 SSET (efound
, SBYTES (efound
) - 1, 'c');
1277 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1279 /* Make the progress messages mention that source is newer. */
1282 /* If we won't print another message, mention this anyway. */
1283 if (!NILP (nomessage
) && !force_load_messages
)
1285 Lisp_Object msg_file
;
1286 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1287 message_with_string ("Source file `%s' newer than byte-compiled file",
1296 /* We are loading a source file (*.el). */
1297 if (!NILP (Vload_source_file_function
))
1303 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1304 NILP (noerror
) ? Qnil
: Qt
,
1305 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1306 return unbind_to (count
, val
);
1310 GCPRO3 (file
, found
, hist_file_name
);
1314 efound
= ENCODE_FILE (found
);
1315 stream
= fopen ((char *) SDATA (efound
), fmode
);
1316 #else /* not WINDOWSNT */
1317 stream
= fdopen (fd
, fmode
);
1318 #endif /* not WINDOWSNT */
1322 error ("Failure to create stdio stream for %s", SDATA (file
));
1325 if (! NILP (Vpurify_flag
))
1326 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1328 if (NILP (nomessage
) || force_load_messages
)
1331 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1334 message_with_string ("Loading %s (source)...", file
, 1);
1336 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1338 else /* The typical case; compiled file newer than source file. */
1339 message_with_string ("Loading %s...", file
, 1);
1342 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1343 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1344 specbind (Qload_file_name
, found
);
1345 specbind (Qinhibit_file_name_operation
, Qnil
);
1346 load_descriptor_list
1347 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1349 specbind (Qload_in_progress
, Qt
);
1352 if (lisp_file_lexically_bound_p (Qget_file_char
))
1353 Fset (Qlexical_binding
, Qt
);
1355 if (! version
|| version
>= 22)
1356 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1357 0, Qnil
, Qnil
, Qnil
, Qnil
);
1360 /* We can't handle a file which was compiled with
1361 byte-compile-dynamic by older version of Emacs. */
1362 specbind (Qload_force_doc_strings
, Qt
);
1363 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1364 0, Qnil
, Qnil
, Qnil
, Qnil
);
1366 unbind_to (count
, Qnil
);
1368 /* Run any eval-after-load forms for this file */
1369 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1370 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1374 xfree (saved_doc_string
);
1375 saved_doc_string
= 0;
1376 saved_doc_string_size
= 0;
1378 xfree (prev_saved_doc_string
);
1379 prev_saved_doc_string
= 0;
1380 prev_saved_doc_string_size
= 0;
1382 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1385 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1388 message_with_string ("Loading %s (source)...done", file
, 1);
1390 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1392 else /* The typical case; compiled file newer than source file. */
1393 message_with_string ("Loading %s...done", file
, 1);
1400 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1402 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1413 load_descriptor_unwind (Lisp_Object oldlist
)
1415 load_descriptor_list
= oldlist
;
1419 /* Close all descriptors in use for Floads.
1420 This is used when starting a subprocess. */
1423 close_load_descs (void)
1427 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1428 emacs_close (XFASTINT (XCAR (tail
)));
1433 complete_filename_p (Lisp_Object pathname
)
1435 register const unsigned char *s
= SDATA (pathname
);
1436 return (IS_DIRECTORY_SEP (s
[0])
1437 || (SCHARS (pathname
) > 2
1438 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1441 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1442 doc
: /* Search for FILENAME through PATH.
1443 Returns the file's name in absolute form, or nil if not found.
1444 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1445 file name when searching.
1446 If non-nil, PREDICATE is used instead of `file-readable-p'.
1447 PREDICATE can also be an integer to pass to the access(2) function,
1448 in which case file-name-handlers are ignored. */)
1449 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1452 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1453 if (NILP (predicate
) && fd
> 0)
1459 /* Search for a file whose name is STR, looking in directories
1460 in the Lisp list PATH, and trying suffixes from SUFFIX.
1461 On success, returns a file descriptor. On failure, returns -1.
1463 SUFFIXES is a list of strings containing possible suffixes.
1464 The empty suffix is automatically added if the list is empty.
1466 PREDICATE non-nil means don't open the files,
1467 just look for one that satisfies the predicate. In this case,
1468 returns 1 on success. The predicate can be a lisp function or
1469 an integer to pass to `access' (in which case file-name-handlers
1472 If STOREPTR is nonzero, it points to a slot where the name of
1473 the file actually found should be stored as a Lisp string.
1474 nil is stored there on failure.
1476 If the file we find is remote, return -2
1477 but store the found remote file name in *STOREPTR. */
1480 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1485 register char *fn
= buf
;
1488 Lisp_Object filename
;
1490 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1491 Lisp_Object string
, tail
, encoded_fn
;
1492 int max_suffix_len
= 0;
1496 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1498 CHECK_STRING_CAR (tail
);
1499 max_suffix_len
= max (max_suffix_len
,
1500 SBYTES (XCAR (tail
)));
1503 string
= filename
= encoded_fn
= Qnil
;
1504 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1509 if (complete_filename_p (str
))
1512 for (; CONSP (path
); path
= XCDR (path
))
1514 filename
= Fexpand_file_name (str
, XCAR (path
));
1515 if (!complete_filename_p (filename
))
1516 /* If there are non-absolute elts in PATH (eg ".") */
1517 /* Of course, this could conceivably lose if luser sets
1518 default-directory to be something non-absolute... */
1520 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1521 if (!complete_filename_p (filename
))
1522 /* Give up on this path element! */
1526 /* Calculate maximum size of any filename made from
1527 this path element/specified file name and any possible suffix. */
1528 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1529 if (fn_size
< want_size
)
1530 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1532 /* Loop over suffixes. */
1533 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1534 CONSP (tail
); tail
= XCDR (tail
))
1536 int lsuffix
= SBYTES (XCAR (tail
));
1537 Lisp_Object handler
;
1540 /* Concatenate path element/specified name with the suffix.
1541 If the directory starts with /:, remove that. */
1542 if (SCHARS (filename
) > 2
1543 && SREF (filename
, 0) == '/'
1544 && SREF (filename
, 1) == ':')
1546 strncpy (fn
, SDATA (filename
) + 2,
1547 SBYTES (filename
) - 2);
1548 fn
[SBYTES (filename
) - 2] = 0;
1552 strncpy (fn
, SDATA (filename
),
1554 fn
[SBYTES (filename
)] = 0;
1557 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1558 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1560 /* Check that the file exists and is not a directory. */
1561 /* We used to only check for handlers on non-absolute file names:
1565 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1566 It's not clear why that was the case and it breaks things like
1567 (load "/bar.el") where the file is actually "/bar.el.gz". */
1568 string
= build_string (fn
);
1569 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1570 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1572 if (NILP (predicate
))
1573 exists
= !NILP (Ffile_readable_p (string
));
1575 exists
= !NILP (call1 (predicate
, string
));
1576 if (exists
&& !NILP (Ffile_directory_p (string
)))
1581 /* We succeeded; return this descriptor and filename. */
1592 encoded_fn
= ENCODE_FILE (string
);
1593 pfn
= SDATA (encoded_fn
);
1594 exists
= (stat (pfn
, &st
) >= 0
1595 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1598 /* Check that we can access or open it. */
1599 if (NATNUMP (predicate
))
1600 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1602 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1606 /* We succeeded; return this descriptor and filename. */
1624 /* Merge the list we've accumulated of globals from the current input source
1625 into the load_history variable. The details depend on whether
1626 the source has an associated file name or not.
1628 FILENAME is the file name that we are loading from.
1629 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1632 build_load_history (Lisp_Object filename
, int entire
)
1634 register Lisp_Object tail
, prev
, newelt
;
1635 register Lisp_Object tem
, tem2
;
1636 register int foundit
= 0;
1638 tail
= Vload_history
;
1641 while (CONSP (tail
))
1645 /* Find the feature's previous assoc list... */
1646 if (!NILP (Fequal (filename
, Fcar (tem
))))
1650 /* If we're loading the entire file, remove old data. */
1654 Vload_history
= XCDR (tail
);
1656 Fsetcdr (prev
, XCDR (tail
));
1659 /* Otherwise, cons on new symbols that are not already members. */
1662 tem2
= Vcurrent_load_list
;
1664 while (CONSP (tem2
))
1666 newelt
= XCAR (tem2
);
1668 if (NILP (Fmember (newelt
, tem
)))
1669 Fsetcar (tail
, Fcons (XCAR (tem
),
1670 Fcons (newelt
, XCDR (tem
))));
1683 /* If we're loading an entire file, cons the new assoc onto the
1684 front of load-history, the most-recently-loaded position. Also
1685 do this if we didn't find an existing member for the file. */
1686 if (entire
|| !foundit
)
1687 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1692 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1699 readevalloop_1 (Lisp_Object old
)
1701 load_convert_to_unibyte
= ! NILP (old
);
1705 /* Signal an `end-of-file' error, if possible with file name
1709 end_of_file_error (void)
1711 if (STRINGP (Vload_file_name
))
1712 xsignal1 (Qend_of_file
, Vload_file_name
);
1714 xsignal0 (Qend_of_file
);
1717 /* UNIBYTE specifies how to set load_convert_to_unibyte
1718 for this invocation.
1719 READFUN, if non-nil, is used instead of `read'.
1721 START, END specify region to read in current buffer (from eval-region).
1722 If the input is not from a buffer, they must be nil. */
1725 readevalloop (Lisp_Object readcharfun
,
1727 Lisp_Object sourcename
,
1729 Lisp_Object unibyte
, Lisp_Object readfun
,
1730 Lisp_Object start
, Lisp_Object end
)
1733 register Lisp_Object val
;
1734 int count
= SPECPDL_INDEX ();
1735 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1736 struct buffer
*b
= 0;
1737 int continue_reading_p
;
1738 Lisp_Object lex_bound
;
1739 /* Nonzero if reading an entire buffer. */
1740 int whole_buffer
= 0;
1741 /* 1 on the first time around. */
1744 if (MARKERP (readcharfun
))
1747 start
= readcharfun
;
1750 if (BUFFERP (readcharfun
))
1751 b
= XBUFFER (readcharfun
);
1752 else if (MARKERP (readcharfun
))
1753 b
= XMARKER (readcharfun
)->buffer
;
1755 /* We assume START is nil when input is not from a buffer. */
1756 if (! NILP (start
) && !b
)
1759 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1760 specbind (Qcurrent_load_list
, Qnil
);
1761 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1762 load_convert_to_unibyte
= !NILP (unibyte
);
1764 /* If lexical binding is active (either because it was specified in
1765 the file's header, or via a buffer-local variable), create an empty
1766 lexical environment, otherwise, turn off lexical binding. */
1767 lex_bound
= find_symbol_value (Qlexical_binding
);
1768 specbind (Qinternal_interpreter_environment
,
1769 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1770 ? Qnil
: Fcons (Qt
, Qnil
));
1772 GCPRO4 (sourcename
, readfun
, start
, end
);
1774 /* Try to ensure sourcename is a truename, except whilst preloading. */
1775 if (NILP (Vpurify_flag
)
1776 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1777 && !NILP (Ffboundp (Qfile_truename
)))
1778 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1780 LOADHIST_ATTACH (sourcename
);
1782 continue_reading_p
= 1;
1783 while (continue_reading_p
)
1785 int count1
= SPECPDL_INDEX ();
1787 if (b
!= 0 && NILP (b
->name
))
1788 error ("Reading from killed buffer");
1792 /* Switch to the buffer we are reading from. */
1793 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1794 set_buffer_internal (b
);
1796 /* Save point in it. */
1797 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1798 /* Save ZV in it. */
1799 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1800 /* Those get unbound after we read one expression. */
1802 /* Set point and ZV around stuff to be read. */
1805 Fnarrow_to_region (make_number (BEGV
), end
);
1807 /* Just for cleanliness, convert END to a marker
1808 if it is an integer. */
1810 end
= Fpoint_max_marker ();
1813 /* On the first cycle, we can easily test here
1814 whether we are reading the whole buffer. */
1815 if (b
&& first_sexp
)
1816 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1823 while ((c
= READCHAR
) != '\n' && c
!= -1);
1828 unbind_to (count1
, Qnil
);
1832 /* Ignore whitespace here, so we can detect eof. */
1833 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1834 || c
== 0x8a0) /* NBSP */
1837 if (!NILP (Vpurify_flag
) && c
== '(')
1839 record_unwind_protect (unreadpure
, Qnil
);
1840 val
= read_list (-1, readcharfun
);
1845 read_objects
= Qnil
;
1846 if (!NILP (readfun
))
1848 val
= call1 (readfun
, readcharfun
);
1850 /* If READCHARFUN has set point to ZV, we should
1851 stop reading, even if the form read sets point
1852 to a different value when evaluated. */
1853 if (BUFFERP (readcharfun
))
1855 struct buffer
*b
= XBUFFER (readcharfun
);
1856 if (BUF_PT (b
) == BUF_ZV (b
))
1857 continue_reading_p
= 0;
1860 else if (! NILP (Vload_read_function
))
1861 val
= call1 (Vload_read_function
, readcharfun
);
1863 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1866 if (!NILP (start
) && continue_reading_p
)
1867 start
= Fpoint_marker ();
1869 /* Restore saved point and BEGV. */
1870 unbind_to (count1
, Qnil
);
1872 /* Now eval what we just read. */
1873 val
= eval_sub (val
);
1877 Vvalues
= Fcons (val
, Vvalues
);
1878 if (EQ (Vstandard_output
, Qt
))
1887 build_load_history (sourcename
,
1888 stream
|| whole_buffer
);
1892 unbind_to (count
, Qnil
);
1895 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1896 doc
: /* Execute the current buffer as Lisp code.
1897 When called from a Lisp program (i.e., not interactively), this
1898 function accepts up to five optional arguments:
1899 BUFFER is the buffer to evaluate (nil means use current buffer).
1900 PRINTFLAG controls printing of output:
1901 A value of nil means discard it; anything else is stream for print.
1902 FILENAME specifies the file name to use for `load-history'.
1903 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1905 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1906 functions should work normally even if PRINTFLAG is nil.
1908 This function preserves the position of point. */)
1909 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1911 int count
= SPECPDL_INDEX ();
1912 Lisp_Object tem
, buf
;
1915 buf
= Fcurrent_buffer ();
1917 buf
= Fget_buffer (buffer
);
1919 error ("No such buffer");
1921 if (NILP (printflag
) && NILP (do_allow_print
))
1926 if (NILP (filename
))
1927 filename
= XBUFFER (buf
)->filename
;
1929 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1930 specbind (Qstandard_output
, tem
);
1931 specbind (Qlexical_binding
, Qnil
);
1932 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1933 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1934 if (lisp_file_lexically_bound_p (buf
))
1935 Fset (Qlexical_binding
, Qt
);
1936 readevalloop (buf
, 0, filename
,
1937 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1938 unbind_to (count
, Qnil
);
1943 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1944 doc
: /* Execute the region as Lisp code.
1945 When called from programs, expects two arguments,
1946 giving starting and ending indices in the current buffer
1947 of the text to be executed.
1948 Programs can pass third argument PRINTFLAG which controls output:
1949 A value of nil means discard it; anything else is stream for printing it.
1950 Also the fourth argument READ-FUNCTION, if non-nil, is used
1951 instead of `read' to read each expression. It gets one argument
1952 which is the input stream for reading characters.
1954 This function does not move point. */)
1955 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1957 int count
= SPECPDL_INDEX ();
1958 Lisp_Object tem
, cbuf
;
1960 cbuf
= Fcurrent_buffer ();
1962 if (NILP (printflag
))
1966 specbind (Qstandard_output
, tem
);
1967 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1969 /* readevalloop calls functions which check the type of start and end. */
1970 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
,
1971 !NILP (printflag
), Qnil
, read_function
,
1974 return unbind_to (count
, Qnil
);
1978 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1979 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1980 If STREAM is nil, use the value of `standard-input' (which see).
1981 STREAM or the value of `standard-input' may be:
1982 a buffer (read from point and advance it)
1983 a marker (read from where it points and advance it)
1984 a function (call it with no arguments for each character,
1985 call it with a char as argument to push a char back)
1986 a string (takes text from string, starting at the beginning)
1987 t (read text line using minibuffer and use it, or read from
1988 standard input in batch mode). */)
1989 (Lisp_Object stream
)
1992 stream
= Vstandard_input
;
1993 if (EQ (stream
, Qt
))
1994 stream
= Qread_char
;
1995 if (EQ (stream
, Qread_char
))
1996 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1998 return read_internal_start (stream
, Qnil
, Qnil
);
2001 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2002 doc
: /* Read one Lisp expression which is represented as text by STRING.
2003 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2004 START and END optionally delimit a substring of STRING from which to read;
2005 they default to 0 and (length STRING) respectively. */)
2006 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2009 CHECK_STRING (string
);
2010 /* read_internal_start sets read_from_string_index. */
2011 ret
= read_internal_start (string
, start
, end
);
2012 return Fcons (ret
, make_number (read_from_string_index
));
2015 /* Function to set up the global context we need in toplevel read
2018 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2019 /* start, end only used when stream is a string. */
2024 new_backquote_flag
= 0;
2025 read_objects
= Qnil
;
2026 if (EQ (Vread_with_symbol_positions
, Qt
)
2027 || EQ (Vread_with_symbol_positions
, stream
))
2028 Vread_symbol_positions_list
= Qnil
;
2030 if (STRINGP (stream
)
2031 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2033 EMACS_INT startval
, endval
;
2036 if (STRINGP (stream
))
2039 string
= XCAR (stream
);
2042 endval
= SCHARS (string
);
2046 endval
= XINT (end
);
2047 if (endval
< 0 || endval
> SCHARS (string
))
2048 args_out_of_range (string
, end
);
2055 CHECK_NUMBER (start
);
2056 startval
= XINT (start
);
2057 if (startval
< 0 || startval
> endval
)
2058 args_out_of_range (string
, start
);
2060 read_from_string_index
= startval
;
2061 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2062 read_from_string_limit
= endval
;
2065 retval
= read0 (stream
);
2066 if (EQ (Vread_with_symbol_positions
, Qt
)
2067 || EQ (Vread_with_symbol_positions
, stream
))
2068 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2073 /* Signal Qinvalid_read_syntax error.
2074 S is error string of length N (if > 0) */
2077 invalid_syntax (const char *s
, int n
)
2081 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2085 /* Use this for recursive reads, in contexts where internal tokens
2089 read0 (Lisp_Object readcharfun
)
2091 register Lisp_Object val
;
2094 val
= read1 (readcharfun
, &c
, 0);
2098 xsignal1 (Qinvalid_read_syntax
,
2099 Fmake_string (make_number (1), make_number (c
)));
2102 static int read_buffer_size
;
2103 static char *read_buffer
;
2105 /* Read a \-escape sequence, assuming we already read the `\'.
2106 If the escape sequence forces unibyte, return eight-bit char. */
2109 read_escape (Lisp_Object readcharfun
, int stringp
)
2111 register int c
= READCHAR
;
2112 /* \u allows up to four hex digits, \U up to eight. Default to the
2113 behavior for \u, and change this value in the case that \U is seen. */
2114 int unicode_hex_count
= 4;
2119 end_of_file_error ();
2149 error ("Invalid escape character syntax");
2152 c
= read_escape (readcharfun
, 0);
2153 return c
| meta_modifier
;
2158 error ("Invalid escape character syntax");
2161 c
= read_escape (readcharfun
, 0);
2162 return c
| shift_modifier
;
2167 error ("Invalid escape character syntax");
2170 c
= read_escape (readcharfun
, 0);
2171 return c
| hyper_modifier
;
2176 error ("Invalid escape character syntax");
2179 c
= read_escape (readcharfun
, 0);
2180 return c
| alt_modifier
;
2184 if (stringp
|| c
!= '-')
2191 c
= read_escape (readcharfun
, 0);
2192 return c
| super_modifier
;
2197 error ("Invalid escape character syntax");
2201 c
= read_escape (readcharfun
, 0);
2202 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2203 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2204 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2205 return c
| ctrl_modifier
;
2206 /* ASCII control chars are made from letters (both cases),
2207 as well as the non-letters within 0100...0137. */
2208 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2209 return (c
& (037 | ~0177));
2210 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2211 return (c
& (037 | ~0177));
2213 return c
| ctrl_modifier
;
2223 /* An octal escape, as in ANSI C. */
2225 register int i
= c
- '0';
2226 register int count
= 0;
2229 if ((c
= READCHAR
) >= '0' && c
<= '7')
2241 if (i
>= 0x80 && i
< 0x100)
2242 i
= BYTE8_TO_CHAR (i
);
2247 /* A hex escape, as in ANSI C. */
2254 if (c
>= '0' && c
<= '9')
2259 else if ((c
>= 'a' && c
<= 'f')
2260 || (c
>= 'A' && c
<= 'F'))
2263 if (c
>= 'a' && c
<= 'f')
2276 if (count
< 3 && i
>= 0x80)
2277 return BYTE8_TO_CHAR (i
);
2282 /* Post-Unicode-2.0: Up to eight hex chars. */
2283 unicode_hex_count
= 8;
2286 /* A Unicode escape. We only permit them in strings and characters,
2287 not arbitrarily in the source code, as in some other languages. */
2292 while (++count
<= unicode_hex_count
)
2295 /* isdigit and isalpha may be locale-specific, which we don't
2297 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2298 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2299 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2302 error ("Non-hex digit used for Unicode escape");
2307 error ("Non-Unicode character: 0x%x", i
);
2316 /* Read an integer in radix RADIX using READCHARFUN to read
2317 characters. RADIX must be in the interval [2..36]; if it isn't, a
2318 read error is signaled . Value is the integer read. Signals an
2319 error if encountering invalid read syntax or if RADIX is out of
2323 read_integer (Lisp_Object readcharfun
, int radix
)
2325 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2326 /* We use a floating point number because */
2329 if (radix
< 2 || radix
> 36)
2333 number
= ndigits
= invalid_p
= 0;
2349 if (c
>= '0' && c
<= '9')
2351 else if (c
>= 'a' && c
<= 'z')
2352 digit
= c
- 'a' + 10;
2353 else if (c
>= 'A' && c
<= 'Z')
2354 digit
= c
- 'A' + 10;
2361 if (digit
< 0 || digit
>= radix
)
2364 number
= radix
* number
+ digit
;
2370 if (ndigits
== 0 || invalid_p
)
2373 sprintf (buf
, "integer, radix %d", radix
);
2374 invalid_syntax (buf
, 0);
2377 return make_fixnum_or_float (sign
* number
);
2381 /* If the next token is ')' or ']' or '.', we store that character
2382 in *PCH and the return value is not interesting. Else, we store
2383 zero in *PCH and we read and return one lisp object.
2385 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2388 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2391 int uninterned_symbol
= 0;
2399 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2401 end_of_file_error ();
2406 return read_list (0, readcharfun
);
2409 return read_vector (readcharfun
, 0);
2425 /* Accept extended format for hashtables (extensible to
2427 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2428 Lisp_Object tmp
= read_list (0, readcharfun
);
2429 Lisp_Object head
= CAR_SAFE (tmp
);
2430 Lisp_Object data
= Qnil
;
2431 Lisp_Object val
= Qnil
;
2432 /* The size is 2 * number of allowed keywords to
2434 Lisp_Object params
[10];
2436 Lisp_Object key
= Qnil
;
2437 int param_count
= 0;
2439 if (!EQ (head
, Qhash_table
))
2440 error ("Invalid extended read marker at head of #s list "
2441 "(only hash-table allowed)");
2443 tmp
= CDR_SAFE (tmp
);
2445 /* This is repetitive but fast and simple. */
2446 params
[param_count
] = QCsize
;
2447 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2448 if (!NILP (params
[param_count
+ 1]))
2451 params
[param_count
] = QCtest
;
2452 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2453 if (!NILP (params
[param_count
+ 1]))
2456 params
[param_count
] = QCweakness
;
2457 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2458 if (!NILP (params
[param_count
+ 1]))
2461 params
[param_count
] = QCrehash_size
;
2462 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2463 if (!NILP (params
[param_count
+ 1]))
2466 params
[param_count
] = QCrehash_threshold
;
2467 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2468 if (!NILP (params
[param_count
+ 1]))
2471 /* This is the hashtable data. */
2472 data
= Fplist_get (tmp
, Qdata
);
2474 /* Now use params to make a new hashtable and fill it. */
2475 ht
= Fmake_hash_table (param_count
, params
);
2477 while (CONSP (data
))
2482 error ("Odd number of elements in hashtable data");
2485 Fputhash (key
, val
, ht
);
2491 invalid_syntax ("#", 1);
2499 tmp
= read_vector (readcharfun
, 0);
2500 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2501 error ("Invalid size char-table");
2502 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2513 tmp
= read_vector (readcharfun
, 0);
2514 if (!INTEGERP (AREF (tmp
, 0)))
2515 error ("Invalid depth in char-table");
2516 depth
= XINT (AREF (tmp
, 0));
2517 if (depth
< 1 || depth
> 3)
2518 error ("Invalid depth in char-table");
2519 size
= XVECTOR (tmp
)->size
- 2;
2520 if (chartab_size
[depth
] != size
)
2521 error ("Invalid size char-table");
2522 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2525 invalid_syntax ("#^^", 3);
2527 invalid_syntax ("#^", 2);
2532 length
= read1 (readcharfun
, pch
, first_in_list
);
2536 Lisp_Object tmp
, val
;
2538 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2539 / BOOL_VECTOR_BITS_PER_CHAR
);
2542 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2543 if (STRING_MULTIBYTE (tmp
)
2544 || (size_in_chars
!= SCHARS (tmp
)
2545 /* We used to print 1 char too many
2546 when the number of bits was a multiple of 8.
2547 Accept such input in case it came from an old
2549 && ! (XFASTINT (length
)
2550 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2551 invalid_syntax ("#&...", 5);
2553 val
= Fmake_bool_vector (length
, Qnil
);
2554 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2555 /* Clear the extraneous bits in the last byte. */
2556 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2557 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2558 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2561 invalid_syntax ("#&...", 5);
2564 /* `function vector' objects, including byte-compiled functions. */
2565 return read_vector (readcharfun
, 1);
2569 struct gcpro gcpro1
;
2572 /* Read the string itself. */
2573 tmp
= read1 (readcharfun
, &ch
, 0);
2574 if (ch
!= 0 || !STRINGP (tmp
))
2575 invalid_syntax ("#", 1);
2577 /* Read the intervals and their properties. */
2580 Lisp_Object beg
, end
, plist
;
2582 beg
= read1 (readcharfun
, &ch
, 0);
2587 end
= read1 (readcharfun
, &ch
, 0);
2589 plist
= read1 (readcharfun
, &ch
, 0);
2591 invalid_syntax ("Invalid string property list", 0);
2592 Fset_text_properties (beg
, end
, plist
, tmp
);
2598 /* #@NUMBER is used to skip NUMBER following characters.
2599 That's used in .elc files to skip over doc strings
2600 and function definitions. */
2606 /* Read a decimal integer. */
2607 while ((c
= READCHAR
) >= 0
2608 && c
>= '0' && c
<= '9')
2616 if (load_force_doc_strings
2617 && (EQ (readcharfun
, Qget_file_char
)
2618 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2620 /* If we are supposed to force doc strings into core right now,
2621 record the last string that we skipped,
2622 and record where in the file it comes from. */
2624 /* But first exchange saved_doc_string
2625 with prev_saved_doc_string, so we save two strings. */
2627 char *temp
= saved_doc_string
;
2628 int temp_size
= saved_doc_string_size
;
2629 file_offset temp_pos
= saved_doc_string_position
;
2630 int temp_len
= saved_doc_string_length
;
2632 saved_doc_string
= prev_saved_doc_string
;
2633 saved_doc_string_size
= prev_saved_doc_string_size
;
2634 saved_doc_string_position
= prev_saved_doc_string_position
;
2635 saved_doc_string_length
= prev_saved_doc_string_length
;
2637 prev_saved_doc_string
= temp
;
2638 prev_saved_doc_string_size
= temp_size
;
2639 prev_saved_doc_string_position
= temp_pos
;
2640 prev_saved_doc_string_length
= temp_len
;
2643 if (saved_doc_string_size
== 0)
2645 saved_doc_string_size
= nskip
+ 100;
2646 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2648 if (nskip
> saved_doc_string_size
)
2650 saved_doc_string_size
= nskip
+ 100;
2651 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2652 saved_doc_string_size
);
2655 saved_doc_string_position
= file_tell (instream
);
2657 /* Copy that many characters into saved_doc_string. */
2658 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2659 saved_doc_string
[i
] = c
= READCHAR
;
2661 saved_doc_string_length
= i
;
2665 /* Skip that many characters. */
2666 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2675 /* #! appears at the beginning of an executable file.
2676 Skip the first line. */
2677 while (c
!= '\n' && c
>= 0)
2682 return Vload_file_name
;
2684 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2685 /* #:foo is the uninterned symbol named foo. */
2688 uninterned_symbol
= 1;
2692 /* Reader forms that can reuse previously read objects. */
2693 if (c
>= '0' && c
<= '9')
2698 /* Read a non-negative integer. */
2699 while (c
>= '0' && c
<= '9')
2705 /* #n=object returns object, but associates it with n for #n#. */
2706 if (c
== '=' && !NILP (Vread_circle
))
2708 /* Make a placeholder for #n# to use temporarily */
2709 Lisp_Object placeholder
;
2712 placeholder
= Fcons (Qnil
, Qnil
);
2713 cell
= Fcons (make_number (n
), placeholder
);
2714 read_objects
= Fcons (cell
, read_objects
);
2716 /* Read the object itself. */
2717 tem
= read0 (readcharfun
);
2719 /* Now put it everywhere the placeholder was... */
2720 substitute_object_in_subtree (tem
, placeholder
);
2722 /* ...and #n# will use the real value from now on. */
2723 Fsetcdr (cell
, tem
);
2727 /* #n# returns a previously read object. */
2728 if (c
== '#' && !NILP (Vread_circle
))
2730 tem
= Fassq (make_number (n
), read_objects
);
2733 /* Fall through to error message. */
2735 else if (c
== 'r' || c
== 'R')
2736 return read_integer (readcharfun
, n
);
2738 /* Fall through to error message. */
2740 else if (c
== 'x' || c
== 'X')
2741 return read_integer (readcharfun
, 16);
2742 else if (c
== 'o' || c
== 'O')
2743 return read_integer (readcharfun
, 8);
2744 else if (c
== 'b' || c
== 'B')
2745 return read_integer (readcharfun
, 2);
2748 invalid_syntax ("#", 1);
2751 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2756 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2761 int next_char
= READCHAR
;
2763 /* Transition from old-style to new-style:
2764 If we see "(`" it used to mean old-style, which usually works
2765 fine because ` should almost never appear in such a position
2766 for new-style. But occasionally we need "(`" to mean new
2767 style, so we try to distinguish the two by the fact that we
2768 can either write "( `foo" or "(` foo", where the first
2769 intends to use new-style whereas the second intends to use
2770 old-style. For Emacs-25, we should completely remove this
2771 first_in_list exception (old-style can still be obtained via
2773 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2775 Vold_style_backquotes
= Qt
;
2782 new_backquote_flag
++;
2783 value
= read0 (readcharfun
);
2784 new_backquote_flag
--;
2786 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2791 int next_char
= READCHAR
;
2793 /* Transition from old-style to new-style:
2794 It used to be impossible to have a new-style , other than within
2795 a new-style `. This is sufficient when ` and , are used in the
2796 normal way, but ` and , can also appear in args to macros that
2797 will not interpret them in the usual way, in which case , may be
2798 used without any ` anywhere near.
2799 So we now use the same heuristic as for backquote: old-style
2800 unquotes are only recognized when first on a list, and when
2801 followed by a space.
2802 Because it's more difficult to peak 2 chars ahead, a new-style
2803 ,@ can still not be used outside of a `, unless it's in the middle
2805 if (new_backquote_flag
2807 || (next_char
!= ' ' && next_char
!= '@'))
2809 Lisp_Object comma_type
= Qnil
;
2814 comma_type
= Qcomma_at
;
2816 comma_type
= Qcomma_dot
;
2819 if (ch
>= 0) UNREAD (ch
);
2820 comma_type
= Qcomma
;
2823 value
= read0 (readcharfun
);
2824 return Fcons (comma_type
, Fcons (value
, Qnil
));
2828 Vold_style_backquotes
= Qt
;
2840 end_of_file_error ();
2842 /* Accept `single space' syntax like (list ? x) where the
2843 whitespace character is SPC or TAB.
2844 Other literal whitespace like NL, CR, and FF are not accepted,
2845 as there are well-established escape sequences for these. */
2846 if (c
== ' ' || c
== '\t')
2847 return make_number (c
);
2850 c
= read_escape (readcharfun
, 0);
2851 modifiers
= c
& CHAR_MODIFIER_MASK
;
2852 c
&= ~CHAR_MODIFIER_MASK
;
2853 if (CHAR_BYTE8_P (c
))
2854 c
= CHAR_TO_BYTE8 (c
);
2857 next_char
= READCHAR
;
2858 ok
= (next_char
<= 040
2859 || (next_char
< 0200
2860 && (strchr ("\"';()[]#?`,.", next_char
))));
2863 return make_number (c
);
2865 invalid_syntax ("?", 1);
2870 char *p
= read_buffer
;
2871 char *end
= read_buffer
+ read_buffer_size
;
2873 /* Nonzero if we saw an escape sequence specifying
2874 a multibyte character. */
2875 int force_multibyte
= 0;
2876 /* Nonzero if we saw an escape sequence specifying
2877 a single-byte character. */
2878 int force_singlebyte
= 0;
2882 while ((c
= READCHAR
) >= 0
2885 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2887 int offset
= p
- read_buffer
;
2888 read_buffer
= (char *) xrealloc (read_buffer
,
2889 read_buffer_size
*= 2);
2890 p
= read_buffer
+ offset
;
2891 end
= read_buffer
+ read_buffer_size
;
2898 c
= read_escape (readcharfun
, 1);
2900 /* C is -1 if \ newline has just been seen */
2903 if (p
== read_buffer
)
2908 modifiers
= c
& CHAR_MODIFIER_MASK
;
2909 c
= c
& ~CHAR_MODIFIER_MASK
;
2911 if (CHAR_BYTE8_P (c
))
2912 force_singlebyte
= 1;
2913 else if (! ASCII_CHAR_P (c
))
2914 force_multibyte
= 1;
2915 else /* i.e. ASCII_CHAR_P (c) */
2917 /* Allow `\C- ' and `\C-?'. */
2918 if (modifiers
== CHAR_CTL
)
2921 c
= 0, modifiers
= 0;
2923 c
= 127, modifiers
= 0;
2925 if (modifiers
& CHAR_SHIFT
)
2927 /* Shift modifier is valid only with [A-Za-z]. */
2928 if (c
>= 'A' && c
<= 'Z')
2929 modifiers
&= ~CHAR_SHIFT
;
2930 else if (c
>= 'a' && c
<= 'z')
2931 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2934 if (modifiers
& CHAR_META
)
2936 /* Move the meta bit to the right place for a
2938 modifiers
&= ~CHAR_META
;
2939 c
= BYTE8_TO_CHAR (c
| 0x80);
2940 force_singlebyte
= 1;
2944 /* Any modifiers remaining are invalid. */
2946 error ("Invalid modifier in string");
2947 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2951 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2952 if (CHAR_BYTE8_P (c
))
2953 force_singlebyte
= 1;
2954 else if (! ASCII_CHAR_P (c
))
2955 force_multibyte
= 1;
2961 end_of_file_error ();
2963 /* If purifying, and string starts with \ newline,
2964 return zero instead. This is for doc strings
2965 that we are really going to find in etc/DOC.nn.nn */
2966 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2967 return make_number (0);
2969 if (force_multibyte
)
2970 /* READ_BUFFER already contains valid multibyte forms. */
2972 else if (force_singlebyte
)
2974 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2975 p
= read_buffer
+ nchars
;
2978 /* Otherwise, READ_BUFFER contains only ASCII. */
2981 /* We want readchar_count to be the number of characters, not
2982 bytes. Hence we adjust for multibyte characters in the
2983 string. ... But it doesn't seem to be necessary, because
2984 READCHAR *does* read multibyte characters from buffers. */
2985 /* readchar_count -= (p - read_buffer) - nchars; */
2987 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2989 || (p
- read_buffer
!= nchars
)));
2990 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2992 || (p
- read_buffer
!= nchars
)));
2997 int next_char
= READCHAR
;
3000 if (next_char
<= 040
3001 || (next_char
< 0200
3002 && (strchr ("\"';([#?`,", next_char
))))
3008 /* Otherwise, we fall through! Note that the atom-reading loop
3009 below will now loop at least once, assuring that we will not
3010 try to UNREAD two characters in a row. */
3014 if (c
<= 040) goto retry
;
3015 if (c
== 0x8a0) /* NBSP */
3018 char *p
= read_buffer
;
3022 char *end
= read_buffer
+ read_buffer_size
;
3025 && c
!= 0x8a0 /* NBSP */
3027 || !(strchr ("\"';()[]#`,", c
))))
3029 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3031 int offset
= p
- read_buffer
;
3032 read_buffer
= (char *) xrealloc (read_buffer
,
3033 read_buffer_size
*= 2);
3034 p
= read_buffer
+ offset
;
3035 end
= read_buffer
+ read_buffer_size
;
3042 end_of_file_error ();
3047 p
+= CHAR_STRING (c
, p
);
3055 int offset
= p
- read_buffer
;
3056 read_buffer
= (char *) xrealloc (read_buffer
,
3057 read_buffer_size
*= 2);
3058 p
= read_buffer
+ offset
;
3059 end
= read_buffer
+ read_buffer_size
;
3066 if (!quoted
&& !uninterned_symbol
)
3070 if (*p1
== '+' || *p1
== '-') p1
++;
3071 /* Is it an integer? */
3074 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3075 /* Integers can have trailing decimal points. */
3076 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3078 /* It is an integer. */
3083 /* EMACS_INT n = atol (read_buffer); */
3084 char *endptr
= NULL
;
3085 EMACS_INT n
= (errno
= 0,
3086 strtol (read_buffer
, &endptr
, 10));
3087 if (errno
== ERANGE
&& endptr
)
3090 = Fcons (make_string (read_buffer
,
3091 endptr
- read_buffer
),
3093 xsignal (Qoverflow_error
, args
);
3095 return make_fixnum_or_float (n
);
3099 if (isfloat_string (read_buffer
, 0))
3101 /* Compute NaN and infinities using 0.0 in a variable,
3102 to cope with compilers that think they are smarter
3108 /* Negate the value ourselves. This treats 0, NaNs,
3109 and infinity properly on IEEE floating point hosts,
3110 and works around a common bug where atof ("-0.0")
3112 int negative
= read_buffer
[0] == '-';
3114 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3115 returns 1, is if the input ends in e+INF or e+NaN. */
3122 value
= zero
/ zero
;
3124 /* If that made a "negative" NaN, negate it. */
3128 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3131 u_minus_zero
.d
= - 0.0;
3132 for (i
= 0; i
< sizeof (double); i
++)
3133 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3139 /* Now VALUE is a positive NaN. */
3142 value
= atof (read_buffer
+ negative
);
3146 return make_float (negative
? - value
: value
);
3150 Lisp_Object name
, result
;
3151 EMACS_INT nbytes
= p
- read_buffer
;
3153 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3156 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3157 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3159 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3160 result
= (uninterned_symbol
? Fmake_symbol (name
)
3161 : Fintern (name
, Qnil
));
3163 if (EQ (Vread_with_symbol_positions
, Qt
)
3164 || EQ (Vread_with_symbol_positions
, readcharfun
))
3165 Vread_symbol_positions_list
=
3166 /* Kind of a hack; this will probably fail if characters
3167 in the symbol name were escaped. Not really a big
3169 Fcons (Fcons (result
,
3170 make_number (readchar_count
3171 - XFASTINT (Flength (Fsymbol_name (result
))))),
3172 Vread_symbol_positions_list
);
3180 /* List of nodes we've seen during substitute_object_in_subtree. */
3181 static Lisp_Object seen_list
;
3184 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3186 Lisp_Object check_object
;
3188 /* We haven't seen any objects when we start. */
3191 /* Make all the substitutions. */
3193 = substitute_object_recurse (object
, placeholder
, object
);
3195 /* Clear seen_list because we're done with it. */
3198 /* The returned object here is expected to always eq the
3200 if (!EQ (check_object
, object
))
3201 error ("Unexpected mutation error in reader");
3204 /* Feval doesn't get called from here, so no gc protection is needed. */
3205 #define SUBSTITUTE(get_val, set_val) \
3207 Lisp_Object old_value = get_val; \
3208 Lisp_Object true_value \
3209 = substitute_object_recurse (object, placeholder, \
3212 if (!EQ (old_value, true_value)) \
3219 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3221 /* If we find the placeholder, return the target object. */
3222 if (EQ (placeholder
, subtree
))
3225 /* If we've been to this node before, don't explore it again. */
3226 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3229 /* If this node can be the entry point to a cycle, remember that
3230 we've seen it. It can only be such an entry point if it was made
3231 by #n=, which means that we can find it as a value in
3233 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3234 seen_list
= Fcons (subtree
, seen_list
);
3236 /* Recurse according to subtree's type.
3237 Every branch must return a Lisp_Object. */
3238 switch (XTYPE (subtree
))
3240 case Lisp_Vectorlike
:
3243 if (BOOL_VECTOR_P (subtree
))
3244 return subtree
; /* No sub-objects anyway. */
3245 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3246 || COMPILEDP (subtree
))
3247 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3248 else if (VECTORP (subtree
))
3249 length
= ASIZE (subtree
);
3251 /* An unknown pseudovector may contain non-Lisp fields, so we
3252 can't just blindly traverse all its fields. We used to call
3253 `Flength' which signaled `sequencep', so I just preserved this
3255 wrong_type_argument (Qsequencep
, subtree
);
3257 for (i
= 0; i
< length
; i
++)
3258 SUBSTITUTE (AREF (subtree
, i
),
3259 ASET (subtree
, i
, true_value
));
3265 SUBSTITUTE (XCAR (subtree
),
3266 XSETCAR (subtree
, true_value
));
3267 SUBSTITUTE (XCDR (subtree
),
3268 XSETCDR (subtree
, true_value
));
3274 /* Check for text properties in each interval.
3275 substitute_in_interval contains part of the logic. */
3277 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3278 Lisp_Object arg
= Fcons (object
, placeholder
);
3280 traverse_intervals_noorder (root_interval
,
3281 &substitute_in_interval
, arg
);
3286 /* Other types don't recurse any further. */
3292 /* Helper function for substitute_object_recurse. */
3294 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3296 Lisp_Object object
= Fcar (arg
);
3297 Lisp_Object placeholder
= Fcdr (arg
);
3299 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3310 isfloat_string (const char *cp
, int ignore_trailing
)
3313 const char *start
= cp
;
3316 if (*cp
== '+' || *cp
== '-')
3319 if (*cp
>= '0' && *cp
<= '9')
3322 while (*cp
>= '0' && *cp
<= '9')
3330 if (*cp
>= '0' && *cp
<= '9')
3333 while (*cp
>= '0' && *cp
<= '9')
3336 if (*cp
== 'e' || *cp
== 'E')
3340 if (*cp
== '+' || *cp
== '-')
3344 if (*cp
>= '0' && *cp
<= '9')
3347 while (*cp
>= '0' && *cp
<= '9')
3350 else if (cp
== start
)
3352 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3357 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3363 return ((ignore_trailing
3364 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3365 || *cp
== '\r' || *cp
== '\f')
3366 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3367 || state
== (DOT_CHAR
|TRAIL_INT
)
3368 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3369 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3370 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3375 read_vector (Lisp_Object readcharfun
, int read_funvec
)
3379 register Lisp_Object
*ptr
;
3380 register Lisp_Object tem
, item
, vector
;
3381 register struct Lisp_Cons
*otem
;
3383 /* If we're reading a funvec object we start out assuming it's also a
3384 byte-code object (a subset of funvecs), so we can do any special
3385 processing needed. If it's just an ordinary funvec object, we'll
3386 realize that as soon as we've read the first element. */
3387 int read_bytecode
= read_funvec
;
3389 tem
= read_list (1, readcharfun
);
3390 len
= Flength (tem
);
3391 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3393 size
= XVECTOR (vector
)->size
;
3394 ptr
= XVECTOR (vector
)->contents
;
3395 for (i
= 0; i
< size
; i
++)
3399 /* If READ_BYTECODE is set, check whether this is really a byte-code
3400 object, or just an ordinary `funvec' object -- non-byte-code
3401 funvec objects use the same reader syntax. We can tell from the
3402 first element which one it is. */
3403 if (read_bytecode
&& i
== 0 && ! FUNVEC_COMPILED_TAG_P (item
))
3404 read_bytecode
= 0; /* Nope. */
3406 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3407 bytecode object, the docstring containing the bytecode and
3408 constants values must be treated as unibyte and passed to
3409 Fread, to get the actual bytecode string and constants vector. */
3410 if (read_bytecode
&& load_force_doc_strings
)
3412 if (i
== COMPILED_BYTECODE
)
3414 if (!STRINGP (item
))
3415 error ("Invalid byte code");
3417 /* Delay handling the bytecode slot until we know whether
3418 it is lazily-loaded (we can tell by whether the
3419 constants slot is nil). */
3420 ptr
[COMPILED_CONSTANTS
] = item
;
3423 else if (i
== COMPILED_CONSTANTS
)
3425 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3429 /* Coerce string to unibyte (like string-as-unibyte,
3430 but without generating extra garbage and
3431 guaranteeing no change in the contents). */
3432 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3433 STRING_SET_UNIBYTE (bytestr
);
3435 item
= Fread (Fcons (bytestr
, readcharfun
));
3437 error ("Invalid byte code");
3439 otem
= XCONS (item
);
3440 bytestr
= XCAR (item
);
3445 /* Now handle the bytecode slot. */
3446 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3448 else if (i
== COMPILED_DOC_STRING
3450 && ! STRING_MULTIBYTE (item
))
3452 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3453 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3455 item
= Fstring_as_multibyte (item
);
3458 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3464 if (read_bytecode
&& size
>= 4)
3465 /* Convert this vector to a bytecode object. */
3466 vector
= Fmake_byte_code (size
, XVECTOR (vector
)->contents
);
3467 else if (read_funvec
&& size
>= 1)
3468 /* Convert this vector to an ordinary funvec object. */
3469 XSETFUNVEC (vector
, XVECTOR (vector
));
3474 /* FLAG = 1 means check for ] to terminate rather than ) and .
3475 FLAG = -1 means check for starting with defun
3476 and make structure pure. */
3479 read_list (int flag
, register Lisp_Object readcharfun
)
3481 /* -1 means check next element for defun,
3482 0 means don't check,
3483 1 means already checked and found defun. */
3484 int defunflag
= flag
< 0 ? -1 : 0;
3485 Lisp_Object val
, tail
;
3486 register Lisp_Object elt
, tem
;
3487 struct gcpro gcpro1
, gcpro2
;
3488 /* 0 is the normal case.
3489 1 means this list is a doc reference; replace it with the number 0.
3490 2 means this list is a doc reference; replace it with the doc string. */
3491 int doc_reference
= 0;
3493 /* Initialize this to 1 if we are reading a list. */
3494 int first_in_list
= flag
<= 0;
3503 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3508 /* While building, if the list starts with #$, treat it specially. */
3509 if (EQ (elt
, Vload_file_name
)
3511 && !NILP (Vpurify_flag
))
3513 if (NILP (Vdoc_file_name
))
3514 /* We have not yet called Snarf-documentation, so assume
3515 this file is described in the DOC-MM.NN file
3516 and Snarf-documentation will fill in the right value later.
3517 For now, replace the whole list with 0. */
3520 /* We have already called Snarf-documentation, so make a relative
3521 file name for this file, so it can be found properly
3522 in the installed Lisp directory.
3523 We don't use Fexpand_file_name because that would make
3524 the directory absolute now. */
3525 elt
= concat2 (build_string ("../lisp/"),
3526 Ffile_name_nondirectory (elt
));
3528 else if (EQ (elt
, Vload_file_name
)
3530 && load_force_doc_strings
)
3539 invalid_syntax (") or . in a vector", 18);
3547 XSETCDR (tail
, read0 (readcharfun
));
3549 val
= read0 (readcharfun
);
3550 read1 (readcharfun
, &ch
, 0);
3554 if (doc_reference
== 1)
3555 return make_number (0);
3556 if (doc_reference
== 2)
3558 /* Get a doc string from the file we are loading.
3559 If it's in saved_doc_string, get it from there.
3561 Here, we don't know if the string is a
3562 bytecode string or a doc string. As a
3563 bytecode string must be unibyte, we always
3564 return a unibyte string. If it is actually a
3565 doc string, caller must make it
3568 int pos
= XINT (XCDR (val
));
3569 /* Position is negative for user variables. */
3570 if (pos
< 0) pos
= -pos
;
3571 if (pos
>= saved_doc_string_position
3572 && pos
< (saved_doc_string_position
3573 + saved_doc_string_length
))
3575 int start
= pos
- saved_doc_string_position
;
3578 /* Process quoting with ^A,
3579 and find the end of the string,
3580 which is marked with ^_ (037). */
3581 for (from
= start
, to
= start
;
3582 saved_doc_string
[from
] != 037;)
3584 int c
= saved_doc_string
[from
++];
3587 c
= saved_doc_string
[from
++];
3589 saved_doc_string
[to
++] = c
;
3591 saved_doc_string
[to
++] = 0;
3593 saved_doc_string
[to
++] = 037;
3596 saved_doc_string
[to
++] = c
;
3599 return make_unibyte_string (saved_doc_string
+ start
,
3602 /* Look in prev_saved_doc_string the same way. */
3603 else if (pos
>= prev_saved_doc_string_position
3604 && pos
< (prev_saved_doc_string_position
3605 + prev_saved_doc_string_length
))
3607 int start
= pos
- prev_saved_doc_string_position
;
3610 /* Process quoting with ^A,
3611 and find the end of the string,
3612 which is marked with ^_ (037). */
3613 for (from
= start
, to
= start
;
3614 prev_saved_doc_string
[from
] != 037;)
3616 int c
= prev_saved_doc_string
[from
++];
3619 c
= prev_saved_doc_string
[from
++];
3621 prev_saved_doc_string
[to
++] = c
;
3623 prev_saved_doc_string
[to
++] = 0;
3625 prev_saved_doc_string
[to
++] = 037;
3628 prev_saved_doc_string
[to
++] = c
;
3631 return make_unibyte_string (prev_saved_doc_string
3636 return get_doc_string (val
, 1, 0);
3641 invalid_syntax (". in wrong context", 18);
3643 invalid_syntax ("] in a list", 11);
3645 tem
= (read_pure
&& flag
<= 0
3646 ? pure_cons (elt
, Qnil
)
3647 : Fcons (elt
, Qnil
));
3649 XSETCDR (tail
, tem
);
3654 defunflag
= EQ (elt
, Qdefun
);
3655 else if (defunflag
> 0)
3660 Lisp_Object Vobarray
;
3661 Lisp_Object initial_obarray
;
3663 /* oblookup stores the bucket number here, for the sake of Funintern. */
3665 int oblookup_last_bucket_number
;
3667 static int hash_string (const unsigned char *ptr
, int len
);
3669 /* Get an error if OBARRAY is not an obarray.
3670 If it is one, return it. */
3673 check_obarray (Lisp_Object obarray
)
3675 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3677 /* If Vobarray is now invalid, force it to be valid. */
3678 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3679 wrong_type_argument (Qvectorp
, obarray
);
3684 /* Intern the C string STR: return a symbol with that name,
3685 interned in the current obarray. */
3688 intern (const char *str
)
3691 int len
= strlen (str
);
3692 Lisp_Object obarray
;
3695 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3696 obarray
= check_obarray (obarray
);
3697 tem
= oblookup (obarray
, str
, len
, len
);
3700 return Fintern (make_string (str
, len
), obarray
);
3704 intern_c_string (const char *str
)
3707 int len
= strlen (str
);
3708 Lisp_Object obarray
;
3711 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3712 obarray
= check_obarray (obarray
);
3713 tem
= oblookup (obarray
, str
, len
, len
);
3717 if (NILP (Vpurify_flag
))
3718 /* Creating a non-pure string from a string literal not
3719 implemented yet. We could just use make_string here and live
3720 with the extra copy. */
3723 return Fintern (make_pure_c_string (str
), obarray
);
3726 /* Create an uninterned symbol with name STR. */
3729 make_symbol (const char *str
)
3731 int len
= strlen (str
);
3733 return Fmake_symbol (!NILP (Vpurify_flag
)
3734 ? make_pure_string (str
, len
, len
, 0)
3735 : make_string (str
, len
));
3738 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3739 doc
: /* Return the canonical symbol whose name is STRING.
3740 If there is none, one is created by this function and returned.
3741 A second optional argument specifies the obarray to use;
3742 it defaults to the value of `obarray'. */)
3743 (Lisp_Object string
, Lisp_Object obarray
)
3745 register Lisp_Object tem
, sym
, *ptr
;
3747 if (NILP (obarray
)) obarray
= Vobarray
;
3748 obarray
= check_obarray (obarray
);
3750 CHECK_STRING (string
);
3752 tem
= oblookup (obarray
, SDATA (string
),
3755 if (!INTEGERP (tem
))
3758 if (!NILP (Vpurify_flag
))
3759 string
= Fpurecopy (string
);
3760 sym
= Fmake_symbol (string
);
3762 if (EQ (obarray
, initial_obarray
))
3763 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3765 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3767 if ((SREF (string
, 0) == ':')
3768 && EQ (obarray
, initial_obarray
))
3770 XSYMBOL (sym
)->constant
= 1;
3771 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3772 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3775 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3777 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3779 XSYMBOL (sym
)->next
= 0;
3784 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3785 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3786 NAME may be a string or a symbol. If it is a symbol, that exact
3787 symbol is searched for.
3788 A second optional argument specifies the obarray to use;
3789 it defaults to the value of `obarray'. */)
3790 (Lisp_Object name
, Lisp_Object obarray
)
3792 register Lisp_Object tem
, string
;
3794 if (NILP (obarray
)) obarray
= Vobarray
;
3795 obarray
= check_obarray (obarray
);
3797 if (!SYMBOLP (name
))
3799 CHECK_STRING (name
);
3803 string
= SYMBOL_NAME (name
);
3805 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3806 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3812 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3813 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3814 The value is t if a symbol was found and deleted, nil otherwise.
3815 NAME may be a string or a symbol. If it is a symbol, that symbol
3816 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3817 OBARRAY defaults to the value of the variable `obarray'. */)
3818 (Lisp_Object name
, Lisp_Object obarray
)
3820 register Lisp_Object string
, tem
;
3823 if (NILP (obarray
)) obarray
= Vobarray
;
3824 obarray
= check_obarray (obarray
);
3827 string
= SYMBOL_NAME (name
);
3830 CHECK_STRING (name
);
3834 tem
= oblookup (obarray
, SDATA (string
),
3839 /* If arg was a symbol, don't delete anything but that symbol itself. */
3840 if (SYMBOLP (name
) && !EQ (name
, tem
))
3843 /* There are plenty of other symbols which will screw up the Emacs
3844 session if we unintern them, as well as even more ways to use
3845 `setq' or `fset' or whatnot to make the Emacs session
3846 unusable. Let's not go down this silly road. --Stef */
3847 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3848 error ("Attempt to unintern t or nil"); */
3850 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3852 hash
= oblookup_last_bucket_number
;
3854 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3856 if (XSYMBOL (tem
)->next
)
3857 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3859 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3863 Lisp_Object tail
, following
;
3865 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3866 XSYMBOL (tail
)->next
;
3869 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3870 if (EQ (following
, tem
))
3872 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3881 /* Return the symbol in OBARRAY whose names matches the string
3882 of SIZE characters (SIZE_BYTE bytes) at PTR.
3883 If there is no such symbol in OBARRAY, return nil.
3885 Also store the bucket number in oblookup_last_bucket_number. */
3888 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3892 register Lisp_Object tail
;
3893 Lisp_Object bucket
, tem
;
3895 if (!VECTORP (obarray
)
3896 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3898 obarray
= check_obarray (obarray
);
3899 obsize
= XVECTOR (obarray
)->size
;
3901 /* This is sometimes needed in the middle of GC. */
3902 obsize
&= ~ARRAY_MARK_FLAG
;
3903 hash
= hash_string (ptr
, size_byte
) % obsize
;
3904 bucket
= XVECTOR (obarray
)->contents
[hash
];
3905 oblookup_last_bucket_number
= hash
;
3906 if (EQ (bucket
, make_number (0)))
3908 else if (!SYMBOLP (bucket
))
3909 error ("Bad data in guts of obarray"); /* Like CADR error message */
3911 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3913 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3914 && SCHARS (SYMBOL_NAME (tail
)) == size
3915 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3917 else if (XSYMBOL (tail
)->next
== 0)
3920 XSETINT (tem
, hash
);
3925 hash_string (const unsigned char *ptr
, int len
)
3927 register const unsigned char *p
= ptr
;
3928 register const unsigned char *end
= p
+ len
;
3929 register unsigned char c
;
3930 register int hash
= 0;
3935 if (c
>= 0140) c
-= 40;
3936 hash
= ((hash
<<3) + (hash
>>28) + c
);
3938 return hash
& 07777777777;
3942 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3945 register Lisp_Object tail
;
3946 CHECK_VECTOR (obarray
);
3947 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3949 tail
= XVECTOR (obarray
)->contents
[i
];
3954 if (XSYMBOL (tail
)->next
== 0)
3956 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3962 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3964 call1 (function
, sym
);
3967 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3968 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3969 OBARRAY defaults to the value of `obarray'. */)
3970 (Lisp_Object function
, Lisp_Object obarray
)
3972 if (NILP (obarray
)) obarray
= Vobarray
;
3973 obarray
= check_obarray (obarray
);
3975 map_obarray (obarray
, mapatoms_1
, function
);
3979 #define OBARRAY_SIZE 1511
3984 Lisp_Object oblength
;
3986 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3988 Vobarray
= Fmake_vector (oblength
, make_number (0));
3989 initial_obarray
= Vobarray
;
3990 staticpro (&initial_obarray
);
3992 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3993 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3994 NILP (Vpurify_flag) check in intern_c_string. */
3995 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3996 Qnil
= intern_c_string ("nil");
3998 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3999 so those two need to be fixed manally. */
4000 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4001 XSYMBOL (Qunbound
)->function
= Qunbound
;
4002 XSYMBOL (Qunbound
)->plist
= Qnil
;
4003 /* XSYMBOL (Qnil)->function = Qunbound; */
4004 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4005 XSYMBOL (Qnil
)->constant
= 1;
4006 XSYMBOL (Qnil
)->plist
= Qnil
;
4008 Qt
= intern_c_string ("t");
4009 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4010 XSYMBOL (Qt
)->constant
= 1;
4012 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4015 Qvariable_documentation
= intern_c_string ("variable-documentation");
4016 staticpro (&Qvariable_documentation
);
4018 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
4019 read_buffer
= (char *) xmalloc (read_buffer_size
);
4023 defsubr (struct Lisp_Subr
*sname
)
4026 sym
= intern_c_string (sname
->symbol_name
);
4027 XSETPVECTYPE (sname
, PVEC_SUBR
);
4028 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4031 #ifdef NOTDEF /* use fset in subr.el now */
4033 defalias (sname
, string
)
4034 struct Lisp_Subr
*sname
;
4038 sym
= intern (string
);
4039 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4043 /* Define an "integer variable"; a symbol whose value is forwarded to a
4044 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
4045 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4047 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4048 const char *namestring
, EMACS_INT
*address
)
4051 sym
= intern_c_string (namestring
);
4052 i_fwd
->type
= Lisp_Fwd_Int
;
4053 i_fwd
->intvar
= address
;
4054 XSYMBOL (sym
)->declared_special
= 1;
4055 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4056 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4059 /* Similar but define a variable whose value is t if address contains 1,
4060 nil if address contains 0. */
4062 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4063 const char *namestring
, int *address
)
4066 sym
= intern_c_string (namestring
);
4067 b_fwd
->type
= Lisp_Fwd_Bool
;
4068 b_fwd
->boolvar
= address
;
4069 XSYMBOL (sym
)->declared_special
= 1;
4070 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4071 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4072 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4075 /* Similar but define a variable whose value is the Lisp Object stored
4076 at address. Two versions: with and without gc-marking of the C
4077 variable. The nopro version is used when that variable will be
4078 gc-marked for some other reason, since marking the same slot twice
4079 can cause trouble with strings. */
4081 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4082 const char *namestring
, Lisp_Object
*address
)
4085 sym
= intern_c_string (namestring
);
4086 o_fwd
->type
= Lisp_Fwd_Obj
;
4087 o_fwd
->objvar
= address
;
4088 XSYMBOL (sym
)->declared_special
= 1;
4089 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4090 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4094 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4095 const char *namestring
, Lisp_Object
*address
)
4097 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4098 staticpro (address
);
4102 /* Similar but define a variable whose value is the Lisp Object stored
4103 at a particular offset in the current kboard object. */
4106 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4107 const char *namestring
, int offset
)
4110 sym
= intern_c_string (namestring
);
4111 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4112 ko_fwd
->offset
= offset
;
4113 XSYMBOL (sym
)->declared_special
= 1;
4114 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4115 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4118 /* Record the value of load-path used at the start of dumping
4119 so we can see if the site changed it later during dumping. */
4120 static Lisp_Object dump_path
;
4126 int turn_off_warning
= 0;
4128 /* Compute the default load-path. */
4130 normal
= PATH_LOADSEARCH
;
4131 Vload_path
= decode_env_path (0, normal
);
4133 if (NILP (Vpurify_flag
))
4134 normal
= PATH_LOADSEARCH
;
4136 normal
= PATH_DUMPLOADSEARCH
;
4138 /* In a dumped Emacs, we normally have to reset the value of
4139 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4140 uses ../lisp, instead of the path of the installed elisp
4141 libraries. However, if it appears that Vload_path was changed
4142 from the default before dumping, don't override that value. */
4145 if (! NILP (Fequal (dump_path
, Vload_path
)))
4147 Vload_path
= decode_env_path (0, normal
);
4148 if (!NILP (Vinstallation_directory
))
4150 Lisp_Object tem
, tem1
, sitelisp
;
4152 /* Remove site-lisp dirs from path temporarily and store
4153 them in sitelisp, then conc them on at the end so
4154 they're always first in path. */
4158 tem
= Fcar (Vload_path
);
4159 tem1
= Fstring_match (build_string ("site-lisp"),
4163 Vload_path
= Fcdr (Vload_path
);
4164 sitelisp
= Fcons (tem
, sitelisp
);
4170 /* Add to the path the lisp subdir of the
4171 installation dir, if it exists. */
4172 tem
= Fexpand_file_name (build_string ("lisp"),
4173 Vinstallation_directory
);
4174 tem1
= Ffile_exists_p (tem
);
4177 if (NILP (Fmember (tem
, Vload_path
)))
4179 turn_off_warning
= 1;
4180 Vload_path
= Fcons (tem
, Vload_path
);
4184 /* That dir doesn't exist, so add the build-time
4185 Lisp dirs instead. */
4186 Vload_path
= nconc2 (Vload_path
, dump_path
);
4188 /* Add leim under the installation dir, if it exists. */
4189 tem
= Fexpand_file_name (build_string ("leim"),
4190 Vinstallation_directory
);
4191 tem1
= Ffile_exists_p (tem
);
4194 if (NILP (Fmember (tem
, Vload_path
)))
4195 Vload_path
= Fcons (tem
, Vload_path
);
4198 /* Add site-lisp under the installation dir, if it exists. */
4199 tem
= Fexpand_file_name (build_string ("site-lisp"),
4200 Vinstallation_directory
);
4201 tem1
= Ffile_exists_p (tem
);
4204 if (NILP (Fmember (tem
, Vload_path
)))
4205 Vload_path
= Fcons (tem
, Vload_path
);
4208 /* If Emacs was not built in the source directory,
4209 and it is run from where it was built, add to load-path
4210 the lisp, leim and site-lisp dirs under that directory. */
4212 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4216 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4217 Vinstallation_directory
);
4218 tem1
= Ffile_exists_p (tem
);
4220 /* Don't be fooled if they moved the entire source tree
4221 AFTER dumping Emacs. If the build directory is indeed
4222 different from the source dir, src/Makefile.in and
4223 src/Makefile will not be found together. */
4224 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4225 Vinstallation_directory
);
4226 tem2
= Ffile_exists_p (tem
);
4227 if (!NILP (tem1
) && NILP (tem2
))
4229 tem
= Fexpand_file_name (build_string ("lisp"),
4232 if (NILP (Fmember (tem
, Vload_path
)))
4233 Vload_path
= Fcons (tem
, Vload_path
);
4235 tem
= Fexpand_file_name (build_string ("leim"),
4238 if (NILP (Fmember (tem
, Vload_path
)))
4239 Vload_path
= Fcons (tem
, Vload_path
);
4241 tem
= Fexpand_file_name (build_string ("site-lisp"),
4244 if (NILP (Fmember (tem
, Vload_path
)))
4245 Vload_path
= Fcons (tem
, Vload_path
);
4248 if (!NILP (sitelisp
))
4249 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4255 /* NORMAL refers to the lisp dir in the source directory. */
4256 /* We used to add ../lisp at the front here, but
4257 that caused trouble because it was copied from dump_path
4258 into Vload_path, above, when Vinstallation_directory was non-nil.
4259 It should be unnecessary. */
4260 Vload_path
= decode_env_path (0, normal
);
4261 dump_path
= Vload_path
;
4265 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4266 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4267 almost never correct, thereby causing a warning to be printed out that
4268 confuses users. Since PATH_LOADSEARCH is always overridden by the
4269 EMACSLOADPATH environment variable below, disable the warning on NT. */
4271 /* Warn if dirs in the *standard* path don't exist. */
4272 if (!turn_off_warning
)
4274 Lisp_Object path_tail
;
4276 for (path_tail
= Vload_path
;
4278 path_tail
= XCDR (path_tail
))
4280 Lisp_Object dirfile
;
4281 dirfile
= Fcar (path_tail
);
4282 if (STRINGP (dirfile
))
4284 dirfile
= Fdirectory_file_name (dirfile
);
4285 if (access (SDATA (dirfile
), 0) < 0)
4286 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4291 #endif /* !(WINDOWSNT || HAVE_NS) */
4293 /* If the EMACSLOADPATH environment variable is set, use its value.
4294 This doesn't apply if we're dumping. */
4296 if (NILP (Vpurify_flag
)
4297 && egetenv ("EMACSLOADPATH"))
4299 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4303 load_in_progress
= 0;
4304 Vload_file_name
= Qnil
;
4306 load_descriptor_list
= Qnil
;
4308 Vstandard_input
= Qt
;
4309 Vloads_in_progress
= Qnil
;
4312 /* Print a warning, using format string FORMAT, that directory DIRNAME
4313 does not exist. Print it on stderr and put it in *Messages*. */
4316 dir_warning (const char *format
, Lisp_Object dirname
)
4319 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4321 fprintf (stderr
, format
, SDATA (dirname
));
4322 sprintf (buffer
, format
, SDATA (dirname
));
4323 /* Don't log the warning before we've initialized!! */
4325 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4329 syms_of_lread (void)
4332 defsubr (&Sread_from_string
);
4334 defsubr (&Sintern_soft
);
4335 defsubr (&Sunintern
);
4336 defsubr (&Sget_load_suffixes
);
4338 defsubr (&Seval_buffer
);
4339 defsubr (&Seval_region
);
4340 defsubr (&Sread_char
);
4341 defsubr (&Sread_char_exclusive
);
4342 defsubr (&Sread_event
);
4343 defsubr (&Sget_file_char
);
4344 defsubr (&Smapatoms
);
4345 defsubr (&Slocate_file_internal
);
4347 DEFVAR_LISP ("obarray", &Vobarray
,
4348 doc
: /* Symbol table for use by `intern' and `read'.
4349 It is a vector whose length ought to be prime for best results.
4350 The vector's contents don't make sense if examined from Lisp programs;
4351 to find all the symbols in an obarray, use `mapatoms'. */);
4353 DEFVAR_LISP ("values", &Vvalues
,
4354 doc
: /* List of values of all expressions which were read, evaluated and printed.
4355 Order is reverse chronological. */);
4357 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4358 doc
: /* Stream for read to get input from.
4359 See documentation of `read' for possible values. */);
4360 Vstandard_input
= Qt
;
4362 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4363 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4365 If this variable is a buffer, then only forms read from that buffer
4366 will be added to `read-symbol-positions-list'.
4367 If this variable is t, then all read forms will be added.
4368 The effect of all other values other than nil are not currently
4369 defined, although they may be in the future.
4371 The positions are relative to the last call to `read' or
4372 `read-from-string'. It is probably a bad idea to set this variable at
4373 the toplevel; bind it instead. */);
4374 Vread_with_symbol_positions
= Qnil
;
4376 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4377 doc
: /* A list mapping read symbols to their positions.
4378 This variable is modified during calls to `read' or
4379 `read-from-string', but only when `read-with-symbol-positions' is
4382 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4383 CHAR-POSITION is an integer giving the offset of that occurrence of the
4384 symbol from the position where `read' or `read-from-string' started.
4386 Note that a symbol will appear multiple times in this list, if it was
4387 read multiple times. The list is in the same order as the symbols
4389 Vread_symbol_positions_list
= Qnil
;
4391 DEFVAR_LISP ("read-circle", &Vread_circle
,
4392 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4395 DEFVAR_LISP ("load-path", &Vload_path
,
4396 doc
: /* *List of directories to search for files to load.
4397 Each element is a string (directory name) or nil (try default directory).
4398 Initialized based on EMACSLOADPATH environment variable, if any,
4399 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4401 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4402 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4403 This list should not include the empty string.
4404 `load' and related functions try to append these suffixes, in order,
4405 to the specified file name if a Lisp suffix is allowed or required. */);
4406 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4407 Fcons (make_pure_c_string (".el"), Qnil
));
4408 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4409 doc
: /* List of suffixes that indicate representations of \
4411 This list should normally start with the empty string.
4413 Enabling Auto Compression mode appends the suffixes in
4414 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4415 mode removes them again. `load' and related functions use this list to
4416 determine whether they should look for compressed versions of a file
4417 and, if so, which suffixes they should try to append to the file name
4418 in order to do so. However, if you want to customize which suffixes
4419 the loading functions recognize as compression suffixes, you should
4420 customize `jka-compr-load-suffixes' rather than the present variable. */);
4421 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4423 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4424 doc
: /* Non-nil if inside of `load'. */);
4425 Qload_in_progress
= intern_c_string ("load-in-progress");
4426 staticpro (&Qload_in_progress
);
4428 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4429 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4430 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4432 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4433 a symbol \(a feature name).
4435 When `load' is run and the file-name argument matches an element's
4436 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4437 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4439 An error in FORMS does not undo the load, but does prevent execution of
4440 the rest of the FORMS. */);
4441 Vafter_load_alist
= Qnil
;
4443 DEFVAR_LISP ("load-history", &Vload_history
,
4444 doc
: /* Alist mapping loaded file names to symbols and features.
4445 Each alist element should be a list (FILE-NAME ENTRIES...), where
4446 FILE-NAME is the name of a file that has been loaded into Emacs.
4447 The file name is absolute and true (i.e. it doesn't contain symlinks).
4448 As an exception, one of the alist elements may have FILE-NAME nil,
4449 for symbols and features not associated with any file.
4451 The remaining ENTRIES in the alist element describe the functions and
4452 variables defined in that file, the features provided, and the
4453 features required. Each entry has the form `(provide . FEATURE)',
4454 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4455 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4456 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4457 SYMBOL was an autoload before this file redefined it as a function.
4459 During preloading, the file name recorded is relative to the main Lisp
4460 directory. These file names are converted to absolute at startup. */);
4461 Vload_history
= Qnil
;
4463 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4464 doc
: /* Full name of file being loaded by `load'. */);
4465 Vload_file_name
= Qnil
;
4467 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4468 doc
: /* File name, including directory, of user's initialization file.
4469 If the file loaded had extension `.elc', and the corresponding source file
4470 exists, this variable contains the name of source file, suitable for use
4471 by functions like `custom-save-all' which edit the init file.
4472 While Emacs loads and evaluates the init file, value is the real name
4473 of the file, regardless of whether or not it has the `.elc' extension. */);
4474 Vuser_init_file
= Qnil
;
4476 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4477 doc
: /* Used for internal purposes by `load'. */);
4478 Vcurrent_load_list
= Qnil
;
4480 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4481 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4482 The default is nil, which means use the function `read'. */);
4483 Vload_read_function
= Qnil
;
4485 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4486 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4487 This function is for doing code conversion before reading the source file.
4488 If nil, loading is done without any code conversion.
4489 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4490 FULLNAME is the full name of FILE.
4491 See `load' for the meaning of the remaining arguments. */);
4492 Vload_source_file_function
= Qnil
;
4494 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4495 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4496 This is useful when the file being loaded is a temporary copy. */);
4497 load_force_doc_strings
= 0;
4499 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4500 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4501 This is normally bound by `load' and `eval-buffer' to control `read',
4502 and is not meant for users to change. */);
4503 load_convert_to_unibyte
= 0;
4505 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4506 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4507 You cannot count on them to still be there! */);
4509 = Fexpand_file_name (build_string ("../"),
4510 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4512 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4513 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4514 Vpreloaded_file_list
= Qnil
;
4516 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4517 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4518 Vbyte_boolean_vars
= Qnil
;
4520 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4521 doc
: /* Non-nil means load dangerous compiled Lisp files.
4522 Some versions of XEmacs use different byte codes than Emacs. These
4523 incompatible byte codes can make Emacs crash when it tries to execute
4525 load_dangerous_libraries
= 0;
4527 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4528 doc
: /* Non-nil means force printing messages when loading Lisp files.
4529 This overrides the value of the NOMESSAGE argument to `load'. */);
4530 force_load_messages
= 0;
4532 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4533 doc
: /* Regular expression matching safe to load compiled Lisp files.
4534 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4535 from the file, and matches them against this regular expression.
4536 When the regular expression matches, the file is considered to be safe
4537 to load. See also `load-dangerous-libraries'. */);
4538 Vbytecomp_version_regexp
4539 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4541 Qlexical_binding
= intern ("lexical-binding");
4542 staticpro (&Qlexical_binding
);
4543 DEFVAR_LISP ("lexical-binding", &Vlexical_binding
,
4544 doc
: /* If non-nil, use lexical binding when evaluating code.
4545 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4546 This variable is automatically set from the file variables of an interpreted
4547 lisp file read using `load'. */);
4548 Fmake_variable_buffer_local (Qlexical_binding
);
4550 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4551 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4552 Veval_buffer_list
= Qnil
;
4554 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4555 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4556 Vold_style_backquotes
= Qnil
;
4557 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4558 staticpro (&Qold_style_backquotes
);
4560 /* Vsource_directory was initialized in init_lread. */
4562 load_descriptor_list
= Qnil
;
4563 staticpro (&load_descriptor_list
);
4565 Qcurrent_load_list
= intern_c_string ("current-load-list");
4566 staticpro (&Qcurrent_load_list
);
4568 Qstandard_input
= intern_c_string ("standard-input");
4569 staticpro (&Qstandard_input
);
4571 Qread_char
= intern_c_string ("read-char");
4572 staticpro (&Qread_char
);
4574 Qget_file_char
= intern_c_string ("get-file-char");
4575 staticpro (&Qget_file_char
);
4577 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4578 staticpro (&Qget_emacs_mule_file_char
);
4580 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4581 staticpro (&Qload_force_doc_strings
);
4583 Qbackquote
= intern_c_string ("`");
4584 staticpro (&Qbackquote
);
4585 Qcomma
= intern_c_string (",");
4586 staticpro (&Qcomma
);
4587 Qcomma_at
= intern_c_string (",@");
4588 staticpro (&Qcomma_at
);
4589 Qcomma_dot
= intern_c_string (",.");
4590 staticpro (&Qcomma_dot
);
4592 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4593 staticpro (&Qinhibit_file_name_operation
);
4595 Qascii_character
= intern_c_string ("ascii-character");
4596 staticpro (&Qascii_character
);
4598 Qfunction
= intern_c_string ("function");
4599 staticpro (&Qfunction
);
4601 Qload
= intern_c_string ("load");
4604 Qload_file_name
= intern_c_string ("load-file-name");
4605 staticpro (&Qload_file_name
);
4607 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4608 staticpro (&Qeval_buffer_list
);
4610 Qfile_truename
= intern_c_string ("file-truename");
4611 staticpro (&Qfile_truename
) ;
4613 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4614 staticpro (&Qdo_after_load_evaluation
) ;
4616 staticpro (&dump_path
);
4618 staticpro (&read_objects
);
4619 read_objects
= Qnil
;
4620 staticpro (&seen_list
);
4623 Vloads_in_progress
= Qnil
;
4624 staticpro (&Vloads_in_progress
);
4626 Qhash_table
= intern_c_string ("hash-table");
4627 staticpro (&Qhash_table
);
4628 Qdata
= intern_c_string ("data");
4630 Qtest
= intern_c_string ("test");
4632 Qsize
= intern_c_string ("size");
4634 Qweakness
= intern_c_string ("weakness");
4635 staticpro (&Qweakness
);
4636 Qrehash_size
= intern_c_string ("rehash-size");
4637 staticpro (&Qrehash_size
);
4638 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4639 staticpro (&Qrehash_threshold
);