1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
27 #include <limits.h> /* For CHAR_BIT. */
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
52 #endif /* HAVE_SETLOCALE */
57 #define file_offset off_t
58 #define file_tell ftello
60 #define file_offset long
61 #define file_tell ftell
64 /* Hash table read constants. */
65 static Lisp_Object Qhash_table
, Qdata
;
66 static Lisp_Object Qtest
, Qsize
;
67 static Lisp_Object Qweakness
;
68 static Lisp_Object Qrehash_size
;
69 static Lisp_Object Qrehash_threshold
;
71 static Lisp_Object Qread_char
, Qget_file_char
, Qcurrent_load_list
;
72 Lisp_Object Qstandard_input
;
73 Lisp_Object Qvariable_documentation
;
74 static Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
75 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
76 static Lisp_Object Qinhibit_file_name_operation
;
77 static Lisp_Object Qeval_buffer_list
;
78 static Lisp_Object Qlexical_binding
;
79 static Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
81 /* Used instead of Qget_file_char while loading *.elc files compiled
82 by Emacs 21 or older. */
83 static Lisp_Object Qget_emacs_mule_file_char
;
85 static Lisp_Object Qload_force_doc_strings
;
87 extern Lisp_Object Qinternal_interpreter_environment
;
89 static Lisp_Object Qload_in_progress
;
91 /* The association list of objects read with the #n=object form.
92 Each member of the list has the form (n . object), and is used to
93 look up the object for the corresponding #n# construct.
94 It must be set to nil before all top-level calls to read0. */
95 static Lisp_Object read_objects
;
97 /* Nonzero means READCHAR should read bytes one by one (not character)
98 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
99 This is set to 1 by read1 temporarily while handling #@NUMBER. */
100 static int load_each_byte
;
102 /* List of descriptors now open for Fload. */
103 static Lisp_Object load_descriptor_list
;
105 /* File for get_file_char to read from. Use by load. */
106 static FILE *instream
;
108 /* For use within read-from-string (this reader is non-reentrant!!) */
109 static ptrdiff_t read_from_string_index
;
110 static ptrdiff_t read_from_string_index_byte
;
111 static ptrdiff_t read_from_string_limit
;
113 /* Number of characters read in the current call to Fread or
114 Fread_from_string. */
115 static EMACS_INT readchar_count
;
117 /* This contains the last string skipped with #@. */
118 static char *saved_doc_string
;
119 /* Length of buffer allocated in saved_doc_string. */
120 static ptrdiff_t saved_doc_string_size
;
121 /* Length of actual data in saved_doc_string. */
122 static ptrdiff_t saved_doc_string_length
;
123 /* This is the file position that string came from. */
124 static file_offset saved_doc_string_position
;
126 /* This contains the previous string skipped with #@.
127 We copy it from saved_doc_string when a new string
128 is put in saved_doc_string. */
129 static char *prev_saved_doc_string
;
130 /* Length of buffer allocated in prev_saved_doc_string. */
131 static ptrdiff_t prev_saved_doc_string_size
;
132 /* Length of actual data in prev_saved_doc_string. */
133 static ptrdiff_t prev_saved_doc_string_length
;
134 /* This is the file position that string came from. */
135 static file_offset prev_saved_doc_string_position
;
137 /* Nonzero means inside a new-style backquote
138 with no surrounding parentheses.
139 Fread initializes this to zero, so we need not specbind it
140 or worry about what happens to it when there is an error. */
141 static int new_backquote_flag
;
142 static Lisp_Object Qold_style_backquotes
;
144 /* A list of file names for files being loaded in Fload. Used to
145 check for recursive loads. */
147 static Lisp_Object Vloads_in_progress
;
149 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
152 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
153 Lisp_Object
, Lisp_Object
,
154 Lisp_Object
, Lisp_Object
);
155 static Lisp_Object
load_unwind (Lisp_Object
);
156 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
158 static void invalid_syntax (const char *) NO_RETURN
;
159 static void end_of_file_error (void) NO_RETURN
;
162 /* Functions that read one byte from the current source READCHARFUN
163 or unreads one byte. If the integer argument C is -1, it returns
164 one read byte, or -1 when there's no more byte in the source. If C
165 is 0 or positive, it unreads C, and the return value is not
168 static int readbyte_for_lambda (int, Lisp_Object
);
169 static int readbyte_from_file (int, Lisp_Object
);
170 static int readbyte_from_string (int, Lisp_Object
);
172 /* Handle unreading and rereading of characters.
173 Write READCHAR to read a character,
174 UNREAD(c) to unread c to be read again.
176 These macros correctly read/unread multibyte characters. */
178 #define READCHAR readchar (readcharfun, NULL)
179 #define UNREAD(c) unreadchar (readcharfun, c)
181 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
182 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
184 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
185 Qlambda, or a cons, we use this to keep an unread character because
186 a file stream can't handle multibyte-char unreading. The value -1
187 means that there's no unread character. */
188 static int unread_char
;
191 readchar (Lisp_Object readcharfun
, int *multibyte
)
195 int (*readbyte
) (int, Lisp_Object
);
196 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
198 int emacs_mule_encoding
= 0;
205 if (BUFFERP (readcharfun
))
207 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
209 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
211 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
214 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
216 /* Fetch the character code from the buffer. */
217 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
218 BUF_INC_POS (inbuffer
, pt_byte
);
225 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
226 if (! ASCII_BYTE_P (c
))
227 c
= BYTE8_TO_CHAR (c
);
230 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
234 if (MARKERP (readcharfun
))
236 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
238 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
240 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
243 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
245 /* Fetch the character code from the buffer. */
246 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
247 BUF_INC_POS (inbuffer
, bytepos
);
254 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
255 if (! ASCII_BYTE_P (c
))
256 c
= BYTE8_TO_CHAR (c
);
260 XMARKER (readcharfun
)->bytepos
= bytepos
;
261 XMARKER (readcharfun
)->charpos
++;
266 if (EQ (readcharfun
, Qlambda
))
268 readbyte
= readbyte_for_lambda
;
272 if (EQ (readcharfun
, Qget_file_char
))
274 readbyte
= readbyte_from_file
;
278 if (STRINGP (readcharfun
))
280 if (read_from_string_index
>= read_from_string_limit
)
282 else if (STRING_MULTIBYTE (readcharfun
))
286 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
287 read_from_string_index
,
288 read_from_string_index_byte
);
292 c
= SREF (readcharfun
, read_from_string_index_byte
);
293 read_from_string_index
++;
294 read_from_string_index_byte
++;
299 if (CONSP (readcharfun
))
301 /* This is the case that read_vector is reading from a unibyte
302 string that contains a byte sequence previously skipped
303 because of #@NUMBER. The car part of readcharfun is that
304 string, and the cdr part is a value of readcharfun given to
306 readbyte
= readbyte_from_string
;
307 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
308 emacs_mule_encoding
= 1;
312 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
314 readbyte
= readbyte_from_file
;
315 emacs_mule_encoding
= 1;
319 tem
= call0 (readcharfun
);
326 if (unread_char
>= 0)
332 c
= (*readbyte
) (-1, readcharfun
);
333 if (c
< 0 || load_each_byte
)
337 if (ASCII_BYTE_P (c
))
339 if (emacs_mule_encoding
)
340 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
343 len
= BYTES_BY_CHAR_HEAD (c
);
346 c
= (*readbyte
) (-1, readcharfun
);
347 if (c
< 0 || ! TRAILING_CODE_P (c
))
350 (*readbyte
) (buf
[i
], readcharfun
);
351 return BYTE8_TO_CHAR (buf
[0]);
355 return STRING_CHAR (buf
);
358 /* Unread the character C in the way appropriate for the stream READCHARFUN.
359 If the stream is a user function, call it with the char as argument. */
362 unreadchar (Lisp_Object readcharfun
, int c
)
366 /* Don't back up the pointer if we're unreading the end-of-input mark,
367 since readchar didn't advance it when we read it. */
369 else if (BUFFERP (readcharfun
))
371 struct buffer
*b
= XBUFFER (readcharfun
);
372 ptrdiff_t charpos
= BUF_PT (b
);
373 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
375 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
376 BUF_DEC_POS (b
, bytepos
);
380 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
382 else if (MARKERP (readcharfun
))
384 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
385 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
387 XMARKER (readcharfun
)->charpos
--;
388 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
389 BUF_DEC_POS (b
, bytepos
);
393 XMARKER (readcharfun
)->bytepos
= bytepos
;
395 else if (STRINGP (readcharfun
))
397 read_from_string_index
--;
398 read_from_string_index_byte
399 = string_char_to_byte (readcharfun
, read_from_string_index
);
401 else if (CONSP (readcharfun
))
405 else if (EQ (readcharfun
, Qlambda
))
409 else if (EQ (readcharfun
, Qget_file_char
)
410 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
415 ungetc (c
, instream
);
422 call1 (readcharfun
, make_number (c
));
426 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
428 return read_bytecode_char (c
>= 0);
433 readbyte_from_file (int c
, Lisp_Object readcharfun
)
438 ungetc (c
, instream
);
447 /* Interrupted reads have been observed while reading over the network. */
448 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
460 return (c
== EOF
? -1 : c
);
464 readbyte_from_string (int c
, Lisp_Object readcharfun
)
466 Lisp_Object string
= XCAR (readcharfun
);
470 read_from_string_index
--;
471 read_from_string_index_byte
472 = string_char_to_byte (string
, read_from_string_index
);
475 if (read_from_string_index
>= read_from_string_limit
)
478 FETCH_STRING_CHAR_ADVANCE (c
, string
,
479 read_from_string_index
,
480 read_from_string_index_byte
);
485 /* Read one non-ASCII character from INSTREAM. The character is
486 encoded in `emacs-mule' and the first byte is already read in
490 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
492 /* Emacs-mule coding uses at most 4-byte for one character. */
493 unsigned char buf
[4];
494 int len
= emacs_mule_bytes
[c
];
495 struct charset
*charset
;
500 /* C is not a valid leading-code of `emacs-mule'. */
501 return BYTE8_TO_CHAR (c
);
507 c
= (*readbyte
) (-1, readcharfun
);
511 (*readbyte
) (buf
[i
], readcharfun
);
512 return BYTE8_TO_CHAR (buf
[0]);
519 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
520 code
= buf
[1] & 0x7F;
524 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
525 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
527 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
528 code
= buf
[2] & 0x7F;
532 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
533 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
538 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
539 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
541 c
= DECODE_CHAR (charset
, code
);
543 Fsignal (Qinvalid_read_syntax
,
544 Fcons (build_string ("invalid multibyte form"), Qnil
));
549 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
551 static Lisp_Object
read0 (Lisp_Object
);
552 static Lisp_Object
read1 (Lisp_Object
, int *, int);
554 static Lisp_Object
read_list (int, Lisp_Object
);
555 static Lisp_Object
read_vector (Lisp_Object
, int);
557 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
559 static void substitute_object_in_subtree (Lisp_Object
,
561 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
564 /* Get a character from the tty. */
566 /* Read input events until we get one that's acceptable for our purposes.
568 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
569 until we get a character we like, and then stuffed into
572 If ASCII_REQUIRED is non-zero, we check function key events to see
573 if the unmodified version of the symbol has a Qascii_character
574 property, and use that character, if present.
576 If ERROR_NONASCII is non-zero, we signal an error if the input we
577 get isn't an ASCII character with modifiers. If it's zero but
578 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
581 If INPUT_METHOD is nonzero, we invoke the current input method
582 if the character warrants that.
584 If SECONDS is a number, we wait that many seconds for input, and
585 return Qnil if no input arrives within that time. */
588 read_filtered_event (int no_switch_frame
, int ascii_required
,
589 int error_nonascii
, int input_method
, Lisp_Object seconds
)
591 Lisp_Object val
, delayed_switch_frame
;
594 #ifdef HAVE_WINDOW_SYSTEM
595 if (display_hourglass_p
)
599 delayed_switch_frame
= Qnil
;
601 /* Compute timeout. */
602 if (NUMBERP (seconds
))
604 EMACS_TIME wait_time
;
606 double duration
= extract_float (seconds
);
609 duration_to_sec_usec (duration
, &sec
, &usec
);
613 EMACS_GET_TIME (end_time
);
614 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
615 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
618 /* Read until we get an acceptable event. */
621 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
622 NUMBERP (seconds
) ? &end_time
: NULL
);
623 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
628 /* switch-frame events are put off until after the next ASCII
629 character. This is better than signaling an error just because
630 the last characters were typed to a separate minibuffer frame,
631 for example. Eventually, some code which can deal with
632 switch-frame events will read it and process it. */
634 && EVENT_HAS_PARAMETERS (val
)
635 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
637 delayed_switch_frame
= val
;
641 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
643 /* Convert certain symbols to their ASCII equivalents. */
646 Lisp_Object tem
, tem1
;
647 tem
= Fget (val
, Qevent_symbol_element_mask
);
650 tem1
= Fget (Fcar (tem
), Qascii_character
);
651 /* Merge this symbol's modifier bits
652 with the ASCII equivalent of its basic code. */
654 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
658 /* If we don't have a character now, deal with it appropriately. */
663 Vunread_command_events
= Fcons (val
, Qnil
);
664 error ("Non-character input-event");
671 if (! NILP (delayed_switch_frame
))
672 unread_switch_frame
= delayed_switch_frame
;
676 #ifdef HAVE_WINDOW_SYSTEM
677 if (display_hourglass_p
)
686 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
687 doc
: /* Read a character from the command input (keyboard or macro).
688 It is returned as a number.
689 If the character has modifiers, they are resolved and reflected to the
690 character code if possible (e.g. C-SPC -> 0).
692 If the user generates an event which is not a character (i.e. a mouse
693 click or function key event), `read-char' signals an error. As an
694 exception, switch-frame events are put off until non-character events
696 If you want to read non-character events, or ignore them, call
697 `read-event' or `read-char-exclusive' instead.
699 If the optional argument PROMPT is non-nil, display that as a prompt.
700 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
701 input method is turned on in the current buffer, that input method
702 is used for reading a character.
703 If the optional argument SECONDS is non-nil, it should be a number
704 specifying the maximum number of seconds to wait for input. If no
705 input arrives in that time, return nil. SECONDS may be a
706 floating-point value. */)
707 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
712 message_with_string ("%s", prompt
, 0);
713 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
715 return (NILP (val
) ? Qnil
716 : make_number (char_resolve_modifier_mask (XINT (val
))));
719 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
720 doc
: /* Read an event object from the input stream.
721 If the optional argument PROMPT is non-nil, display that as a prompt.
722 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
723 input method is turned on in the current buffer, that input method
724 is used for reading a character.
725 If the optional argument SECONDS is non-nil, it should be a number
726 specifying the maximum number of seconds to wait for input. If no
727 input arrives in that time, return nil. SECONDS may be a
728 floating-point value. */)
729 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
732 message_with_string ("%s", prompt
, 0);
733 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
736 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
737 doc
: /* Read a character from the command input (keyboard or macro).
738 It is returned as a number. Non-character events are ignored.
739 If the character has modifiers, they are resolved and reflected to the
740 character code if possible (e.g. C-SPC -> 0).
742 If the optional argument PROMPT is non-nil, display that as a prompt.
743 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
744 input method is turned on in the current buffer, that input method
745 is used for reading a character.
746 If the optional argument SECONDS is non-nil, it should be a number
747 specifying the maximum number of seconds to wait for input. If no
748 input arrives in that time, return nil. SECONDS may be a
749 floating-point value. */)
750 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
755 message_with_string ("%s", prompt
, 0);
757 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
759 return (NILP (val
) ? Qnil
760 : make_number (char_resolve_modifier_mask (XINT (val
))));
763 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
764 doc
: /* Don't use this yourself. */)
767 register Lisp_Object val
;
769 XSETINT (val
, getc (instream
));
777 /* Return true if the lisp code read using READCHARFUN defines a non-nil
778 `lexical-binding' file variable. After returning, the stream is
779 positioned following the first line, if it is a comment, otherwise
783 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
787 /* The first line isn't a comment, just give up. */
793 /* Look for an appropriate file-variable in the first line. */
797 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
798 } beg_end_state
= NOMINAL
;
799 int in_file_vars
= 0;
801 #define UPDATE_BEG_END_STATE(ch) \
802 if (beg_end_state == NOMINAL) \
803 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
804 else if (beg_end_state == AFTER_FIRST_DASH) \
805 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
806 else if (beg_end_state == AFTER_ASTERIX) \
809 in_file_vars = !in_file_vars; \
810 beg_end_state = NOMINAL; \
813 /* Skip until we get to the file vars, if any. */
817 UPDATE_BEG_END_STATE (ch
);
819 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
823 char var
[100], val
[100];
828 /* Read a variable name. */
829 while (ch
== ' ' || ch
== '\t')
833 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
835 if (i
< sizeof var
- 1)
837 UPDATE_BEG_END_STATE (ch
);
841 /* Stop scanning if no colon was found before end marker. */
842 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
845 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
851 /* Read a variable value. */
854 while (ch
== ' ' || ch
== '\t')
858 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
860 if (i
< sizeof val
- 1)
862 UPDATE_BEG_END_STATE (ch
);
866 /* The value was terminated by an end-marker, which remove. */
868 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
872 if (strcmp (var
, "lexical-binding") == 0)
875 rv
= (strcmp (val
, "nil") != 0);
881 while (ch
!= '\n' && ch
!= EOF
)
888 /* Value is a version number of byte compiled code if the file
889 associated with file descriptor FD is a compiled Lisp file that's
890 safe to load. Only files compiled with Emacs are safe to load.
891 Files compiled with XEmacs can lead to a crash in Fbyte_code
892 because of an incompatible change in the byte compiler. */
895 safe_to_load_p (int fd
)
902 /* Read the first few bytes from the file, and look for a line
903 specifying the byte compiler version used. */
904 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
909 /* Skip to the next newline, skipping over the initial `ELC'
910 with NUL bytes following it, but note the version. */
911 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
916 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
923 lseek (fd
, 0, SEEK_SET
);
928 /* Callback for record_unwind_protect. Restore the old load list OLD,
929 after loading a file successfully. */
932 record_load_unwind (Lisp_Object old
)
934 return Vloads_in_progress
= old
;
937 /* This handler function is used via internal_condition_case_1. */
940 load_error_handler (Lisp_Object data
)
946 load_warn_old_style_backquotes (Lisp_Object file
)
948 if (!NILP (Vold_style_backquotes
))
951 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
958 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
959 doc
: /* Return the suffixes that `load' should try if a suffix is \
961 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
964 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
965 while (CONSP (suffixes
))
967 Lisp_Object exts
= Vload_file_rep_suffixes
;
968 suffix
= XCAR (suffixes
);
969 suffixes
= XCDR (suffixes
);
974 lst
= Fcons (concat2 (suffix
, ext
), lst
);
977 return Fnreverse (lst
);
980 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
981 doc
: /* Execute a file of Lisp code named FILE.
982 First try FILE with `.elc' appended, then try with `.el',
983 then try FILE unmodified (the exact suffixes in the exact order are
984 determined by `load-suffixes'). Environment variable references in
985 FILE are replaced with their values by calling `substitute-in-file-name'.
986 This function searches the directories in `load-path'.
988 If optional second arg NOERROR is non-nil,
989 report no error if FILE doesn't exist.
990 Print messages at start and end of loading unless
991 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
993 If optional fourth arg NOSUFFIX is non-nil, don't try adding
994 suffixes `.elc' or `.el' to the specified name FILE.
995 If optional fifth arg MUST-SUFFIX is non-nil, insist on
996 the suffix `.elc' or `.el'; don't accept just FILE unless
997 it ends in one of those suffixes or includes a directory name.
999 If this function fails to find a file, it may look for different
1000 representations of that file before trying another file.
1001 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1002 to the file name. Emacs uses this feature mainly to find compressed
1003 versions of files when Auto Compression mode is enabled.
1005 The exact suffixes that this function tries out, in the exact order,
1006 are given by the value of the variable `load-file-rep-suffixes' if
1007 NOSUFFIX is non-nil and by the return value of the function
1008 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1009 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1010 and then the former.
1012 Loading a file records its definitions, and its `provide' and
1013 `require' calls, in an element of `load-history' whose
1014 car is the file name loaded. See `load-history'.
1016 While the file is in the process of being loaded, the variable
1017 `load-in-progress' is non-nil and the variable `load-file-name'
1018 is bound to the file's name.
1020 Return t if the file exists and loads successfully. */)
1021 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1023 register FILE *stream
;
1024 register int fd
= -1;
1025 ptrdiff_t count
= SPECPDL_INDEX ();
1026 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1027 Lisp_Object found
, efound
, hist_file_name
;
1028 /* 1 means we printed the ".el is newer" message. */
1030 /* 1 means we are loading a compiled file. */
1032 Lisp_Object handler
;
1034 const char *fmode
= "r";
1042 CHECK_STRING (file
);
1044 /* If file name is magic, call the handler. */
1045 /* This shouldn't be necessary any more now that `openp' handles it right.
1046 handler = Ffind_file_name_handler (file, Qload);
1047 if (!NILP (handler))
1048 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1050 /* Do this after the handler to avoid
1051 the need to gcpro noerror, nomessage and nosuffix.
1052 (Below here, we care only whether they are nil or not.)
1053 The presence of this call is the result of a historical accident:
1054 it used to be in every file-operation and when it got removed
1055 everywhere, it accidentally stayed here. Since then, enough people
1056 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1057 that it seemed risky to remove. */
1058 if (! NILP (noerror
))
1060 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1061 Qt
, load_error_handler
);
1066 file
= Fsubstitute_in_file_name (file
);
1069 /* Avoid weird lossage with null string as arg,
1070 since it would try to load a directory as a Lisp file. */
1071 if (SBYTES (file
) > 0)
1073 ptrdiff_t size
= SBYTES (file
);
1076 GCPRO2 (file
, found
);
1078 if (! NILP (must_suffix
))
1080 /* Don't insist on adding a suffix if FILE already ends with one. */
1082 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1085 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1087 /* Don't insist on adding a suffix
1088 if the argument includes a directory name. */
1089 else if (! NILP (Ffile_name_directory (file
)))
1093 fd
= openp (Vload_path
, file
,
1094 (!NILP (nosuffix
) ? Qnil
1095 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1096 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1097 tmp
[1] = Vload_file_rep_suffixes
,
1106 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1110 /* Tell startup.el whether or not we found the user's init file. */
1111 if (EQ (Qt
, Vuser_init_file
))
1112 Vuser_init_file
= found
;
1114 /* If FD is -2, that means openp found a magic file. */
1117 if (NILP (Fequal (found
, file
)))
1118 /* If FOUND is a different file name from FILE,
1119 find its handler even if we have already inhibited
1120 the `load' operation on FILE. */
1121 handler
= Ffind_file_name_handler (found
, Qt
);
1123 handler
= Ffind_file_name_handler (found
, Qload
);
1124 if (! NILP (handler
))
1125 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1127 /* Tramp has to deal with semi-broken packages that prepend
1128 drive letters to remote files. For that reason, Tramp
1129 catches file operations that test for file existence, which
1130 makes openp think X:/foo.elc files are remote. However,
1131 Tramp does not catch `load' operations for such files, so we
1132 end up with a nil as the `load' handler above. If we would
1133 continue with fd = -2, we will behave wrongly, and in
1134 particular try reading a .elc file in the "rt" mode instead
1135 of "rb". See bug #9311 for the results. To work around
1136 this, we try to open the file locally, and go with that if it
1138 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1144 /* Check if we're stuck in a recursive load cycle.
1146 2000-09-21: It's not possible to just check for the file loaded
1147 being a member of Vloads_in_progress. This fails because of the
1148 way the byte compiler currently works; `provide's are not
1149 evaluated, see font-lock.el/jit-lock.el as an example. This
1150 leads to a certain amount of ``normal'' recursion.
1152 Also, just loading a file recursively is not always an error in
1153 the general case; the second load may do something different. */
1157 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1158 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1162 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1164 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1165 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1168 /* All loads are by default dynamic, unless the file itself specifies
1169 otherwise using a file-variable in the first line. This is bound here
1170 so that it takes effect whether or not we use
1171 Vload_source_file_function. */
1172 specbind (Qlexical_binding
, Qnil
);
1174 /* Get the name for load-history. */
1175 hist_file_name
= (! NILP (Vpurify_flag
)
1176 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1177 tmp
[1] = Ffile_name_nondirectory (found
),
1183 /* Check for the presence of old-style quotes and warn about them. */
1184 specbind (Qold_style_backquotes
, Qnil
);
1185 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1187 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1188 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1189 /* Load .elc files directly, but not when they are
1190 remote and have no handler! */
1197 GCPRO3 (file
, found
, hist_file_name
);
1200 && ! (version
= safe_to_load_p (fd
)))
1203 if (!load_dangerous_libraries
)
1207 error ("File `%s' was not compiled in Emacs",
1210 else if (!NILP (nomessage
) && !force_load_messages
)
1211 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1216 efound
= ENCODE_FILE (found
);
1221 result
= stat (SSDATA (efound
), &s1
);
1224 SSET (efound
, SBYTES (efound
) - 1, 0);
1225 result
= stat (SSDATA (efound
), &s2
);
1226 SSET (efound
, SBYTES (efound
) - 1, 'c');
1229 if (result
== 0 && s1
.st_mtime
< s2
.st_mtime
)
1231 /* Make the progress messages mention that source is newer. */
1234 /* If we won't print another message, mention this anyway. */
1235 if (!NILP (nomessage
) && !force_load_messages
)
1237 Lisp_Object msg_file
;
1238 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1239 message_with_string ("Source file `%s' newer than byte-compiled file",
1248 /* We are loading a source file (*.el). */
1249 if (!NILP (Vload_source_file_function
))
1255 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1256 NILP (noerror
) ? Qnil
: Qt
,
1257 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1258 return unbind_to (count
, val
);
1262 GCPRO3 (file
, found
, hist_file_name
);
1265 efound
= ENCODE_FILE (found
);
1266 /* If we somehow got here with fd == -2, meaning the file is deemed
1267 to be remote, don't even try to reopen the file locally; just
1268 force a failure instead. */
1272 stream
= fopen (SSDATA (efound
), fmode
);
1276 #else /* not WINDOWSNT */
1277 stream
= fdopen (fd
, fmode
);
1278 #endif /* not WINDOWSNT */
1282 error ("Failure to create stdio stream for %s", SDATA (file
));
1285 if (! NILP (Vpurify_flag
))
1286 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1288 if (NILP (nomessage
) || force_load_messages
)
1291 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1294 message_with_string ("Loading %s (source)...", file
, 1);
1296 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1298 else /* The typical case; compiled file newer than source file. */
1299 message_with_string ("Loading %s...", file
, 1);
1302 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1303 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1304 specbind (Qload_file_name
, found
);
1305 specbind (Qinhibit_file_name_operation
, Qnil
);
1306 load_descriptor_list
1307 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1308 specbind (Qload_in_progress
, Qt
);
1311 if (lisp_file_lexically_bound_p (Qget_file_char
))
1312 Fset (Qlexical_binding
, Qt
);
1314 if (! version
|| version
>= 22)
1315 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1316 0, Qnil
, Qnil
, Qnil
, Qnil
);
1319 /* We can't handle a file which was compiled with
1320 byte-compile-dynamic by older version of Emacs. */
1321 specbind (Qload_force_doc_strings
, Qt
);
1322 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1323 0, Qnil
, Qnil
, Qnil
, Qnil
);
1325 unbind_to (count
, Qnil
);
1327 /* Run any eval-after-load forms for this file. */
1328 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1329 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1333 xfree (saved_doc_string
);
1334 saved_doc_string
= 0;
1335 saved_doc_string_size
= 0;
1337 xfree (prev_saved_doc_string
);
1338 prev_saved_doc_string
= 0;
1339 prev_saved_doc_string_size
= 0;
1341 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1344 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1347 message_with_string ("Loading %s (source)...done", file
, 1);
1349 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1351 else /* The typical case; compiled file newer than source file. */
1352 message_with_string ("Loading %s...done", file
, 1);
1359 load_unwind (Lisp_Object arg
) /* Used as unwind-protect function in load. */
1361 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1372 load_descriptor_unwind (Lisp_Object oldlist
)
1374 load_descriptor_list
= oldlist
;
1378 /* Close all descriptors in use for Floads.
1379 This is used when starting a subprocess. */
1382 close_load_descs (void)
1386 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1387 emacs_close (XFASTINT (XCAR (tail
)));
1392 complete_filename_p (Lisp_Object pathname
)
1394 register const unsigned char *s
= SDATA (pathname
);
1395 return (IS_DIRECTORY_SEP (s
[0])
1396 || (SCHARS (pathname
) > 2
1397 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1400 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1401 doc
: /* Search for FILENAME through PATH.
1402 Returns the file's name in absolute form, or nil if not found.
1403 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1404 file name when searching.
1405 If non-nil, PREDICATE is used instead of `file-readable-p'.
1406 PREDICATE can also be an integer to pass to the access(2) function,
1407 in which case file-name-handlers are ignored.
1408 This function will normally skip directories, so if you want it to find
1409 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1410 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1413 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1414 if (NILP (predicate
) && fd
> 0)
1419 static Lisp_Object Qdir_ok
;
1421 /* Search for a file whose name is STR, looking in directories
1422 in the Lisp list PATH, and trying suffixes from SUFFIX.
1423 On success, returns a file descriptor. On failure, returns -1.
1425 SUFFIXES is a list of strings containing possible suffixes.
1426 The empty suffix is automatically added if the list is empty.
1428 PREDICATE non-nil means don't open the files,
1429 just look for one that satisfies the predicate. In this case,
1430 returns 1 on success. The predicate can be a lisp function or
1431 an integer to pass to `access' (in which case file-name-handlers
1434 If STOREPTR is nonzero, it points to a slot where the name of
1435 the file actually found should be stored as a Lisp string.
1436 nil is stored there on failure.
1438 If the file we find is remote, return -2
1439 but store the found remote file name in *STOREPTR. */
1442 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1445 ptrdiff_t fn_size
= 100;
1447 register char *fn
= buf
;
1449 ptrdiff_t want_length
;
1450 Lisp_Object filename
;
1452 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1453 Lisp_Object string
, tail
, encoded_fn
;
1454 ptrdiff_t max_suffix_len
= 0;
1458 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1460 CHECK_STRING_CAR (tail
);
1461 max_suffix_len
= max (max_suffix_len
,
1462 SBYTES (XCAR (tail
)));
1465 string
= filename
= encoded_fn
= Qnil
;
1466 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1471 if (complete_filename_p (str
))
1474 for (; CONSP (path
); path
= XCDR (path
))
1476 filename
= Fexpand_file_name (str
, XCAR (path
));
1477 if (!complete_filename_p (filename
))
1478 /* If there are non-absolute elts in PATH (eg "."). */
1479 /* Of course, this could conceivably lose if luser sets
1480 default-directory to be something non-absolute... */
1482 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1483 if (!complete_filename_p (filename
))
1484 /* Give up on this path element! */
1488 /* Calculate maximum length of any filename made from
1489 this path element/specified file name and any possible suffix. */
1490 want_length
= max_suffix_len
+ SBYTES (filename
);
1491 if (fn_size
<= want_length
)
1492 fn
= (char *) alloca (fn_size
= 100 + want_length
);
1494 /* Loop over suffixes. */
1495 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1496 CONSP (tail
); tail
= XCDR (tail
))
1498 ptrdiff_t lsuffix
= SBYTES (XCAR (tail
));
1499 Lisp_Object handler
;
1502 /* Concatenate path element/specified name with the suffix.
1503 If the directory starts with /:, remove that. */
1504 if (SCHARS (filename
) > 2
1505 && SREF (filename
, 0) == '/'
1506 && SREF (filename
, 1) == ':')
1508 strncpy (fn
, SSDATA (filename
) + 2,
1509 SBYTES (filename
) - 2);
1510 fn
[SBYTES (filename
) - 2] = 0;
1514 strncpy (fn
, SSDATA (filename
),
1516 fn
[SBYTES (filename
)] = 0;
1519 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1520 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1522 /* Check that the file exists and is not a directory. */
1523 /* We used to only check for handlers on non-absolute file names:
1527 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1528 It's not clear why that was the case and it breaks things like
1529 (load "/bar.el") where the file is actually "/bar.el.gz". */
1530 string
= build_string (fn
);
1531 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1532 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1534 if (NILP (predicate
))
1535 exists
= !NILP (Ffile_readable_p (string
));
1538 Lisp_Object tmp
= call1 (predicate
, string
);
1539 exists
= !NILP (tmp
)
1540 && (EQ (tmp
, Qdir_ok
)
1541 || NILP (Ffile_directory_p (string
)));
1546 /* We succeeded; return this descriptor and filename. */
1557 encoded_fn
= ENCODE_FILE (string
);
1558 pfn
= SSDATA (encoded_fn
);
1559 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1562 /* Check that we can access or open it. */
1563 if (NATNUMP (predicate
))
1564 fd
= (((XFASTINT (predicate
) & ~INT_MAX
) == 0
1565 && access (pfn
, XFASTINT (predicate
)) == 0)
1568 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1572 /* We succeeded; return this descriptor and filename. */
1590 /* Merge the list we've accumulated of globals from the current input source
1591 into the load_history variable. The details depend on whether
1592 the source has an associated file name or not.
1594 FILENAME is the file name that we are loading from.
1595 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1598 build_load_history (Lisp_Object filename
, int entire
)
1600 register Lisp_Object tail
, prev
, newelt
;
1601 register Lisp_Object tem
, tem2
;
1602 register int foundit
= 0;
1604 tail
= Vload_history
;
1607 while (CONSP (tail
))
1611 /* Find the feature's previous assoc list... */
1612 if (!NILP (Fequal (filename
, Fcar (tem
))))
1616 /* If we're loading the entire file, remove old data. */
1620 Vload_history
= XCDR (tail
);
1622 Fsetcdr (prev
, XCDR (tail
));
1625 /* Otherwise, cons on new symbols that are not already members. */
1628 tem2
= Vcurrent_load_list
;
1630 while (CONSP (tem2
))
1632 newelt
= XCAR (tem2
);
1634 if (NILP (Fmember (newelt
, tem
)))
1635 Fsetcar (tail
, Fcons (XCAR (tem
),
1636 Fcons (newelt
, XCDR (tem
))));
1649 /* If we're loading an entire file, cons the new assoc onto the
1650 front of load-history, the most-recently-loaded position. Also
1651 do this if we didn't find an existing member for the file. */
1652 if (entire
|| !foundit
)
1653 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1658 readevalloop_1 (Lisp_Object old
)
1660 load_convert_to_unibyte
= ! NILP (old
);
1664 /* Signal an `end-of-file' error, if possible with file name
1668 end_of_file_error (void)
1670 if (STRINGP (Vload_file_name
))
1671 xsignal1 (Qend_of_file
, Vload_file_name
);
1673 xsignal0 (Qend_of_file
);
1676 /* UNIBYTE specifies how to set load_convert_to_unibyte
1677 for this invocation.
1678 READFUN, if non-nil, is used instead of `read'.
1680 START, END specify region to read in current buffer (from eval-region).
1681 If the input is not from a buffer, they must be nil. */
1684 readevalloop (Lisp_Object readcharfun
,
1686 Lisp_Object sourcename
,
1688 Lisp_Object unibyte
, Lisp_Object readfun
,
1689 Lisp_Object start
, Lisp_Object end
)
1692 register Lisp_Object val
;
1693 ptrdiff_t count
= SPECPDL_INDEX ();
1694 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1695 struct buffer
*b
= 0;
1696 int continue_reading_p
;
1697 Lisp_Object lex_bound
;
1698 /* Nonzero if reading an entire buffer. */
1699 int whole_buffer
= 0;
1700 /* 1 on the first time around. */
1703 if (MARKERP (readcharfun
))
1706 start
= readcharfun
;
1709 if (BUFFERP (readcharfun
))
1710 b
= XBUFFER (readcharfun
);
1711 else if (MARKERP (readcharfun
))
1712 b
= XMARKER (readcharfun
)->buffer
;
1714 /* We assume START is nil when input is not from a buffer. */
1715 if (! NILP (start
) && !b
)
1718 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1719 specbind (Qcurrent_load_list
, Qnil
);
1720 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1721 load_convert_to_unibyte
= !NILP (unibyte
);
1723 /* If lexical binding is active (either because it was specified in
1724 the file's header, or via a buffer-local variable), create an empty
1725 lexical environment, otherwise, turn off lexical binding. */
1726 lex_bound
= find_symbol_value (Qlexical_binding
);
1727 specbind (Qinternal_interpreter_environment
,
1728 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1729 ? Qnil
: Fcons (Qt
, Qnil
));
1731 GCPRO4 (sourcename
, readfun
, start
, end
);
1733 /* Try to ensure sourcename is a truename, except whilst preloading. */
1734 if (NILP (Vpurify_flag
)
1735 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1736 && !NILP (Ffboundp (Qfile_truename
)))
1737 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1739 LOADHIST_ATTACH (sourcename
);
1741 continue_reading_p
= 1;
1742 while (continue_reading_p
)
1744 ptrdiff_t count1
= SPECPDL_INDEX ();
1746 if (b
!= 0 && NILP (BVAR (b
, name
)))
1747 error ("Reading from killed buffer");
1751 /* Switch to the buffer we are reading from. */
1752 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1753 set_buffer_internal (b
);
1755 /* Save point in it. */
1756 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1757 /* Save ZV in it. */
1758 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1759 /* Those get unbound after we read one expression. */
1761 /* Set point and ZV around stuff to be read. */
1764 Fnarrow_to_region (make_number (BEGV
), end
);
1766 /* Just for cleanliness, convert END to a marker
1767 if it is an integer. */
1769 end
= Fpoint_max_marker ();
1772 /* On the first cycle, we can easily test here
1773 whether we are reading the whole buffer. */
1774 if (b
&& first_sexp
)
1775 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1782 while ((c
= READCHAR
) != '\n' && c
!= -1);
1787 unbind_to (count1
, Qnil
);
1791 /* Ignore whitespace here, so we can detect eof. */
1792 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1793 || c
== 0xa0) /* NBSP */
1796 if (!NILP (Vpurify_flag
) && c
== '(')
1798 val
= read_list (0, readcharfun
);
1803 read_objects
= Qnil
;
1804 if (!NILP (readfun
))
1806 val
= call1 (readfun
, readcharfun
);
1808 /* If READCHARFUN has set point to ZV, we should
1809 stop reading, even if the form read sets point
1810 to a different value when evaluated. */
1811 if (BUFFERP (readcharfun
))
1813 struct buffer
*buf
= XBUFFER (readcharfun
);
1814 if (BUF_PT (buf
) == BUF_ZV (buf
))
1815 continue_reading_p
= 0;
1818 else if (! NILP (Vload_read_function
))
1819 val
= call1 (Vload_read_function
, readcharfun
);
1821 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1824 if (!NILP (start
) && continue_reading_p
)
1825 start
= Fpoint_marker ();
1827 /* Restore saved point and BEGV. */
1828 unbind_to (count1
, Qnil
);
1830 /* Now eval what we just read. */
1831 val
= eval_sub (val
);
1835 Vvalues
= Fcons (val
, Vvalues
);
1836 if (EQ (Vstandard_output
, Qt
))
1845 build_load_history (sourcename
,
1846 stream
|| whole_buffer
);
1850 unbind_to (count
, Qnil
);
1853 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1854 doc
: /* Execute the current buffer as Lisp code.
1855 When called from a Lisp program (i.e., not interactively), this
1856 function accepts up to five optional arguments:
1857 BUFFER is the buffer to evaluate (nil means use current buffer).
1858 PRINTFLAG controls printing of output:
1859 A value of nil means discard it; anything else is stream for print.
1860 FILENAME specifies the file name to use for `load-history'.
1861 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1863 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1864 functions should work normally even if PRINTFLAG is nil.
1866 This function preserves the position of point. */)
1867 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1869 ptrdiff_t count
= SPECPDL_INDEX ();
1870 Lisp_Object tem
, buf
;
1873 buf
= Fcurrent_buffer ();
1875 buf
= Fget_buffer (buffer
);
1877 error ("No such buffer");
1879 if (NILP (printflag
) && NILP (do_allow_print
))
1884 if (NILP (filename
))
1885 filename
= BVAR (XBUFFER (buf
), filename
);
1887 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1888 specbind (Qstandard_output
, tem
);
1889 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1890 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1891 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1892 readevalloop (buf
, 0, filename
,
1893 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1894 unbind_to (count
, Qnil
);
1899 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1900 doc
: /* Execute the region as Lisp code.
1901 When called from programs, expects two arguments,
1902 giving starting and ending indices in the current buffer
1903 of the text to be executed.
1904 Programs can pass third argument PRINTFLAG which controls output:
1905 A value of nil means discard it; anything else is stream for printing it.
1906 Also the fourth argument READ-FUNCTION, if non-nil, is used
1907 instead of `read' to read each expression. It gets one argument
1908 which is the input stream for reading characters.
1910 This function does not move point. */)
1911 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1913 /* FIXME: Do the eval-sexp-add-defvars dance! */
1914 ptrdiff_t count
= SPECPDL_INDEX ();
1915 Lisp_Object tem
, cbuf
;
1917 cbuf
= Fcurrent_buffer ();
1919 if (NILP (printflag
))
1923 specbind (Qstandard_output
, tem
);
1924 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1926 /* `readevalloop' calls functions which check the type of start and end. */
1927 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
1928 !NILP (printflag
), Qnil
, read_function
,
1931 return unbind_to (count
, Qnil
);
1935 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1936 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1937 If STREAM is nil, use the value of `standard-input' (which see).
1938 STREAM or the value of `standard-input' may be:
1939 a buffer (read from point and advance it)
1940 a marker (read from where it points and advance it)
1941 a function (call it with no arguments for each character,
1942 call it with a char as argument to push a char back)
1943 a string (takes text from string, starting at the beginning)
1944 t (read text line using minibuffer and use it, or read from
1945 standard input in batch mode). */)
1946 (Lisp_Object stream
)
1949 stream
= Vstandard_input
;
1950 if (EQ (stream
, Qt
))
1951 stream
= Qread_char
;
1952 if (EQ (stream
, Qread_char
))
1953 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1955 return read_internal_start (stream
, Qnil
, Qnil
);
1958 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1959 doc
: /* Read one Lisp expression which is represented as text by STRING.
1960 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1961 FINAL-STRING-INDEX is an integer giving the position of the next
1962 remaining character in STRING.
1963 START and END optionally delimit a substring of STRING from which to read;
1964 they default to 0 and (length STRING) respectively. */)
1965 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1968 CHECK_STRING (string
);
1969 /* `read_internal_start' sets `read_from_string_index'. */
1970 ret
= read_internal_start (string
, start
, end
);
1971 return Fcons (ret
, make_number (read_from_string_index
));
1974 /* Function to set up the global context we need in toplevel read
1977 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1978 /* `start', `end' only used when stream is a string. */
1983 new_backquote_flag
= 0;
1984 read_objects
= Qnil
;
1985 if (EQ (Vread_with_symbol_positions
, Qt
)
1986 || EQ (Vread_with_symbol_positions
, stream
))
1987 Vread_symbol_positions_list
= Qnil
;
1989 if (STRINGP (stream
)
1990 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1992 ptrdiff_t startval
, endval
;
1995 if (STRINGP (stream
))
1998 string
= XCAR (stream
);
2001 endval
= SCHARS (string
);
2005 if (! (0 <= XINT (end
) && XINT (end
) <= SCHARS (string
)))
2006 args_out_of_range (string
, end
);
2007 endval
= XINT (end
);
2014 CHECK_NUMBER (start
);
2015 if (! (0 <= XINT (start
) && XINT (start
) <= endval
))
2016 args_out_of_range (string
, start
);
2017 startval
= XINT (start
);
2019 read_from_string_index
= startval
;
2020 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2021 read_from_string_limit
= endval
;
2024 retval
= read0 (stream
);
2025 if (EQ (Vread_with_symbol_positions
, Qt
)
2026 || EQ (Vread_with_symbol_positions
, stream
))
2027 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2032 /* Signal Qinvalid_read_syntax error.
2033 S is error string of length N (if > 0) */
2036 invalid_syntax (const char *s
)
2038 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2042 /* Use this for recursive reads, in contexts where internal tokens
2046 read0 (Lisp_Object readcharfun
)
2048 register Lisp_Object val
;
2051 val
= read1 (readcharfun
, &c
, 0);
2055 xsignal1 (Qinvalid_read_syntax
,
2056 Fmake_string (make_number (1), make_number (c
)));
2059 static ptrdiff_t read_buffer_size
;
2060 static char *read_buffer
;
2062 /* Read a \-escape sequence, assuming we already read the `\'.
2063 If the escape sequence forces unibyte, return eight-bit char. */
2066 read_escape (Lisp_Object readcharfun
, int stringp
)
2068 register int c
= READCHAR
;
2069 /* \u allows up to four hex digits, \U up to eight. Default to the
2070 behavior for \u, and change this value in the case that \U is seen. */
2071 int unicode_hex_count
= 4;
2076 end_of_file_error ();
2106 error ("Invalid escape character syntax");
2109 c
= read_escape (readcharfun
, 0);
2110 return c
| meta_modifier
;
2115 error ("Invalid escape character syntax");
2118 c
= read_escape (readcharfun
, 0);
2119 return c
| shift_modifier
;
2124 error ("Invalid escape character syntax");
2127 c
= read_escape (readcharfun
, 0);
2128 return c
| hyper_modifier
;
2133 error ("Invalid escape character syntax");
2136 c
= read_escape (readcharfun
, 0);
2137 return c
| alt_modifier
;
2141 if (stringp
|| c
!= '-')
2148 c
= read_escape (readcharfun
, 0);
2149 return c
| super_modifier
;
2154 error ("Invalid escape character syntax");
2158 c
= read_escape (readcharfun
, 0);
2159 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2160 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2161 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2162 return c
| ctrl_modifier
;
2163 /* ASCII control chars are made from letters (both cases),
2164 as well as the non-letters within 0100...0137. */
2165 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2166 return (c
& (037 | ~0177));
2167 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2168 return (c
& (037 | ~0177));
2170 return c
| ctrl_modifier
;
2180 /* An octal escape, as in ANSI C. */
2182 register int i
= c
- '0';
2183 register int count
= 0;
2186 if ((c
= READCHAR
) >= '0' && c
<= '7')
2198 if (i
>= 0x80 && i
< 0x100)
2199 i
= BYTE8_TO_CHAR (i
);
2204 /* A hex escape, as in ANSI C. */
2211 if (c
>= '0' && c
<= '9')
2216 else if ((c
>= 'a' && c
<= 'f')
2217 || (c
>= 'A' && c
<= 'F'))
2220 if (c
>= 'a' && c
<= 'f')
2230 /* Allow hex escapes as large as ?\xfffffff, because some
2231 packages use them to denote characters with modifiers. */
2232 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2233 error ("Hex character out of range: \\x%x...", i
);
2237 if (count
< 3 && i
>= 0x80)
2238 return BYTE8_TO_CHAR (i
);
2243 /* Post-Unicode-2.0: Up to eight hex chars. */
2244 unicode_hex_count
= 8;
2247 /* A Unicode escape. We only permit them in strings and characters,
2248 not arbitrarily in the source code, as in some other languages. */
2253 while (++count
<= unicode_hex_count
)
2256 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2258 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2259 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2260 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2262 error ("Non-hex digit used for Unicode escape");
2265 error ("Non-Unicode character: 0x%x", i
);
2274 /* Return the digit that CHARACTER stands for in the given BASE.
2275 Return -1 if CHARACTER is out of range for BASE,
2276 and -2 if CHARACTER is not valid for any supported BASE. */
2278 digit_to_number (int character
, int base
)
2282 if ('0' <= character
&& character
<= '9')
2283 digit
= character
- '0';
2284 else if ('a' <= character
&& character
<= 'z')
2285 digit
= character
- 'a' + 10;
2286 else if ('A' <= character
&& character
<= 'Z')
2287 digit
= character
- 'A' + 10;
2291 return digit
< base
? digit
: -1;
2294 /* Read an integer in radix RADIX using READCHARFUN to read
2295 characters. RADIX must be in the interval [2..36]; if it isn't, a
2296 read error is signaled . Value is the integer read. Signals an
2297 error if encountering invalid read syntax or if RADIX is out of
2301 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2303 /* Room for sign, leading 0, other digits, trailing null byte.
2304 Also, room for invalid syntax diagnostic. */
2305 char buf
[max (1 + 1 + sizeof (uintmax_t) * CHAR_BIT
+ 1,
2306 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2308 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2310 if (radix
< 2 || radix
> 36)
2318 if (c
== '-' || c
== '+')
2329 /* Ignore redundant leading zeros, so the buffer doesn't
2330 fill up with them. */
2336 while (-1 <= (digit
= digit_to_number (c
, radix
)))
2343 if (p
< buf
+ sizeof buf
- 1)
2357 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2358 invalid_syntax (buf
);
2361 return string_to_number (buf
, radix
, 0);
2365 /* If the next token is ')' or ']' or '.', we store that character
2366 in *PCH and the return value is not interesting. Else, we store
2367 zero in *PCH and we read and return one lisp object.
2369 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2372 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2375 unsigned uninterned_symbol
= 0;
2383 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2385 end_of_file_error ();
2390 return read_list (0, readcharfun
);
2393 return read_vector (readcharfun
, 0);
2409 /* Accept extended format for hashtables (extensible to
2411 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2412 Lisp_Object tmp
= read_list (0, readcharfun
);
2413 Lisp_Object head
= CAR_SAFE (tmp
);
2414 Lisp_Object data
= Qnil
;
2415 Lisp_Object val
= Qnil
;
2416 /* The size is 2 * number of allowed keywords to
2418 Lisp_Object params
[10];
2420 Lisp_Object key
= Qnil
;
2421 int param_count
= 0;
2423 if (!EQ (head
, Qhash_table
))
2424 error ("Invalid extended read marker at head of #s list "
2425 "(only hash-table allowed)");
2427 tmp
= CDR_SAFE (tmp
);
2429 /* This is repetitive but fast and simple. */
2430 params
[param_count
] = QCsize
;
2431 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2432 if (!NILP (params
[param_count
+ 1]))
2435 params
[param_count
] = QCtest
;
2436 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2437 if (!NILP (params
[param_count
+ 1]))
2440 params
[param_count
] = QCweakness
;
2441 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2442 if (!NILP (params
[param_count
+ 1]))
2445 params
[param_count
] = QCrehash_size
;
2446 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2447 if (!NILP (params
[param_count
+ 1]))
2450 params
[param_count
] = QCrehash_threshold
;
2451 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2452 if (!NILP (params
[param_count
+ 1]))
2455 /* This is the hashtable data. */
2456 data
= Fplist_get (tmp
, Qdata
);
2458 /* Now use params to make a new hashtable and fill it. */
2459 ht
= Fmake_hash_table (param_count
, params
);
2461 while (CONSP (data
))
2466 error ("Odd number of elements in hashtable data");
2469 Fputhash (key
, val
, ht
);
2475 invalid_syntax ("#");
2483 tmp
= read_vector (readcharfun
, 0);
2484 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2485 error ("Invalid size char-table");
2486 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2498 tmp
= read_vector (readcharfun
, 0);
2501 error ("Invalid size char-table");
2502 if (! RANGED_INTEGERP (1, AREF (tmp
, 0), 3))
2503 error ("Invalid depth in char-table");
2504 depth
= XINT (AREF (tmp
, 0));
2505 if (chartab_size
[depth
] != size
- 2)
2506 error ("Invalid size char-table");
2507 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2510 invalid_syntax ("#^^");
2512 invalid_syntax ("#^");
2517 length
= read1 (readcharfun
, pch
, first_in_list
);
2521 Lisp_Object tmp
, val
;
2522 EMACS_INT size_in_chars
2523 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2524 / BOOL_VECTOR_BITS_PER_CHAR
);
2527 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2528 if (STRING_MULTIBYTE (tmp
)
2529 || (size_in_chars
!= SCHARS (tmp
)
2530 /* We used to print 1 char too many
2531 when the number of bits was a multiple of 8.
2532 Accept such input in case it came from an old
2534 && ! (XFASTINT (length
)
2535 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2536 invalid_syntax ("#&...");
2538 val
= Fmake_bool_vector (length
, Qnil
);
2539 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2540 /* Clear the extraneous bits in the last byte. */
2541 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2542 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2543 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2546 invalid_syntax ("#&...");
2550 /* Accept compiled functions at read-time so that we don't have to
2551 build them using function calls. */
2553 tmp
= read_vector (readcharfun
, 1);
2554 return Fmake_byte_code (ASIZE (tmp
),
2555 XVECTOR (tmp
)->contents
);
2560 struct gcpro gcpro1
;
2563 /* Read the string itself. */
2564 tmp
= read1 (readcharfun
, &ch
, 0);
2565 if (ch
!= 0 || !STRINGP (tmp
))
2566 invalid_syntax ("#");
2568 /* Read the intervals and their properties. */
2571 Lisp_Object beg
, end
, plist
;
2573 beg
= read1 (readcharfun
, &ch
, 0);
2578 end
= read1 (readcharfun
, &ch
, 0);
2580 plist
= read1 (readcharfun
, &ch
, 0);
2582 invalid_syntax ("Invalid string property list");
2583 Fset_text_properties (beg
, end
, plist
, tmp
);
2589 /* #@NUMBER is used to skip NUMBER following characters.
2590 That's used in .elc files to skip over doc strings
2591 and function definitions. */
2594 enum { extra
= 100 };
2595 ptrdiff_t i
, nskip
= 0;
2598 /* Read a decimal integer. */
2599 while ((c
= READCHAR
) >= 0
2600 && c
>= '0' && c
<= '9')
2602 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2609 if (load_force_doc_strings
2610 && (EQ (readcharfun
, Qget_file_char
)
2611 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2613 /* If we are supposed to force doc strings into core right now,
2614 record the last string that we skipped,
2615 and record where in the file it comes from. */
2617 /* But first exchange saved_doc_string
2618 with prev_saved_doc_string, so we save two strings. */
2620 char *temp
= saved_doc_string
;
2621 ptrdiff_t temp_size
= saved_doc_string_size
;
2622 file_offset temp_pos
= saved_doc_string_position
;
2623 ptrdiff_t temp_len
= saved_doc_string_length
;
2625 saved_doc_string
= prev_saved_doc_string
;
2626 saved_doc_string_size
= prev_saved_doc_string_size
;
2627 saved_doc_string_position
= prev_saved_doc_string_position
;
2628 saved_doc_string_length
= prev_saved_doc_string_length
;
2630 prev_saved_doc_string
= temp
;
2631 prev_saved_doc_string_size
= temp_size
;
2632 prev_saved_doc_string_position
= temp_pos
;
2633 prev_saved_doc_string_length
= temp_len
;
2636 if (saved_doc_string_size
== 0)
2638 saved_doc_string
= (char *) xmalloc (nskip
+ extra
);
2639 saved_doc_string_size
= nskip
+ extra
;
2641 if (nskip
> saved_doc_string_size
)
2643 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2645 saved_doc_string_size
= nskip
+ extra
;
2648 saved_doc_string_position
= file_tell (instream
);
2650 /* Copy that many characters into saved_doc_string. */
2651 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2652 saved_doc_string
[i
] = c
= READCHAR
;
2654 saved_doc_string_length
= i
;
2658 /* Skip that many characters. */
2659 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2668 /* #! appears at the beginning of an executable file.
2669 Skip the first line. */
2670 while (c
!= '\n' && c
>= 0)
2675 return Vload_file_name
;
2677 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2678 /* #:foo is the uninterned symbol named foo. */
2681 uninterned_symbol
= 1;
2684 && c
!= 0xa0 /* NBSP */
2686 || strchr ("\"';()[]#`,", c
) == NULL
)))
2688 /* No symbol character follows, this is the empty
2691 return Fmake_symbol (build_string (""));
2695 /* ## is the empty symbol. */
2697 return Fintern (build_string (""), Qnil
);
2698 /* Reader forms that can reuse previously read objects. */
2699 if (c
>= '0' && c
<= '9')
2704 /* Read a non-negative integer. */
2705 while (c
>= '0' && c
<= '9')
2707 if (MOST_POSITIVE_FIXNUM
/ 10 < n
2708 || MOST_POSITIVE_FIXNUM
< n
* 10 + c
- '0')
2709 n
= MOST_POSITIVE_FIXNUM
+ 1;
2711 n
= n
* 10 + c
- '0';
2715 if (n
<= MOST_POSITIVE_FIXNUM
)
2717 if (c
== 'r' || c
== 'R')
2718 return read_integer (readcharfun
, n
);
2720 if (! NILP (Vread_circle
))
2722 /* #n=object returns object, but associates it with
2726 /* Make a placeholder for #n# to use temporarily. */
2727 Lisp_Object placeholder
;
2730 placeholder
= Fcons (Qnil
, Qnil
);
2731 cell
= Fcons (make_number (n
), placeholder
);
2732 read_objects
= Fcons (cell
, read_objects
);
2734 /* Read the object itself. */
2735 tem
= read0 (readcharfun
);
2737 /* Now put it everywhere the placeholder was... */
2738 substitute_object_in_subtree (tem
, placeholder
);
2740 /* ...and #n# will use the real value from now on. */
2741 Fsetcdr (cell
, tem
);
2746 /* #n# returns a previously read object. */
2749 tem
= Fassq (make_number (n
), read_objects
);
2755 /* Fall through to error message. */
2757 else if (c
== 'x' || c
== 'X')
2758 return read_integer (readcharfun
, 16);
2759 else if (c
== 'o' || c
== 'O')
2760 return read_integer (readcharfun
, 8);
2761 else if (c
== 'b' || c
== 'B')
2762 return read_integer (readcharfun
, 2);
2765 invalid_syntax ("#");
2768 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2773 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2778 int next_char
= READCHAR
;
2780 /* Transition from old-style to new-style:
2781 If we see "(`" it used to mean old-style, which usually works
2782 fine because ` should almost never appear in such a position
2783 for new-style. But occasionally we need "(`" to mean new
2784 style, so we try to distinguish the two by the fact that we
2785 can either write "( `foo" or "(` foo", where the first
2786 intends to use new-style whereas the second intends to use
2787 old-style. For Emacs-25, we should completely remove this
2788 first_in_list exception (old-style can still be obtained via
2790 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2792 Vold_style_backquotes
= Qt
;
2799 new_backquote_flag
++;
2800 value
= read0 (readcharfun
);
2801 new_backquote_flag
--;
2803 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2808 int next_char
= READCHAR
;
2810 /* Transition from old-style to new-style:
2811 It used to be impossible to have a new-style , other than within
2812 a new-style `. This is sufficient when ` and , are used in the
2813 normal way, but ` and , can also appear in args to macros that
2814 will not interpret them in the usual way, in which case , may be
2815 used without any ` anywhere near.
2816 So we now use the same heuristic as for backquote: old-style
2817 unquotes are only recognized when first on a list, and when
2818 followed by a space.
2819 Because it's more difficult to peek 2 chars ahead, a new-style
2820 ,@ can still not be used outside of a `, unless it's in the middle
2822 if (new_backquote_flag
2824 || (next_char
!= ' ' && next_char
!= '@'))
2826 Lisp_Object comma_type
= Qnil
;
2831 comma_type
= Qcomma_at
;
2833 comma_type
= Qcomma_dot
;
2836 if (ch
>= 0) UNREAD (ch
);
2837 comma_type
= Qcomma
;
2840 value
= read0 (readcharfun
);
2841 return Fcons (comma_type
, Fcons (value
, Qnil
));
2845 Vold_style_backquotes
= Qt
;
2857 end_of_file_error ();
2859 /* Accept `single space' syntax like (list ? x) where the
2860 whitespace character is SPC or TAB.
2861 Other literal whitespace like NL, CR, and FF are not accepted,
2862 as there are well-established escape sequences for these. */
2863 if (c
== ' ' || c
== '\t')
2864 return make_number (c
);
2867 c
= read_escape (readcharfun
, 0);
2868 modifiers
= c
& CHAR_MODIFIER_MASK
;
2869 c
&= ~CHAR_MODIFIER_MASK
;
2870 if (CHAR_BYTE8_P (c
))
2871 c
= CHAR_TO_BYTE8 (c
);
2874 next_char
= READCHAR
;
2875 ok
= (next_char
<= 040
2876 || (next_char
< 0200
2877 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
2880 return make_number (c
);
2882 invalid_syntax ("?");
2887 char *p
= read_buffer
;
2888 char *end
= read_buffer
+ read_buffer_size
;
2890 /* Nonzero if we saw an escape sequence specifying
2891 a multibyte character. */
2892 int force_multibyte
= 0;
2893 /* Nonzero if we saw an escape sequence specifying
2894 a single-byte character. */
2895 int force_singlebyte
= 0;
2897 ptrdiff_t nchars
= 0;
2899 while ((ch
= READCHAR
) >= 0
2902 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2904 ptrdiff_t offset
= p
- read_buffer
;
2905 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
2906 memory_full (SIZE_MAX
);
2907 read_buffer
= (char *) xrealloc (read_buffer
,
2908 read_buffer_size
* 2);
2909 read_buffer_size
*= 2;
2910 p
= read_buffer
+ offset
;
2911 end
= read_buffer
+ read_buffer_size
;
2918 ch
= read_escape (readcharfun
, 1);
2920 /* CH is -1 if \ newline has just been seen. */
2923 if (p
== read_buffer
)
2928 modifiers
= ch
& CHAR_MODIFIER_MASK
;
2929 ch
= ch
& ~CHAR_MODIFIER_MASK
;
2931 if (CHAR_BYTE8_P (ch
))
2932 force_singlebyte
= 1;
2933 else if (! ASCII_CHAR_P (ch
))
2934 force_multibyte
= 1;
2935 else /* I.e. ASCII_CHAR_P (ch). */
2937 /* Allow `\C- ' and `\C-?'. */
2938 if (modifiers
== CHAR_CTL
)
2941 ch
= 0, modifiers
= 0;
2943 ch
= 127, modifiers
= 0;
2945 if (modifiers
& CHAR_SHIFT
)
2947 /* Shift modifier is valid only with [A-Za-z]. */
2948 if (ch
>= 'A' && ch
<= 'Z')
2949 modifiers
&= ~CHAR_SHIFT
;
2950 else if (ch
>= 'a' && ch
<= 'z')
2951 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2954 if (modifiers
& CHAR_META
)
2956 /* Move the meta bit to the right place for a
2958 modifiers
&= ~CHAR_META
;
2959 ch
= BYTE8_TO_CHAR (ch
| 0x80);
2960 force_singlebyte
= 1;
2964 /* Any modifiers remaining are invalid. */
2966 error ("Invalid modifier in string");
2967 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2971 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
2972 if (CHAR_BYTE8_P (ch
))
2973 force_singlebyte
= 1;
2974 else if (! ASCII_CHAR_P (ch
))
2975 force_multibyte
= 1;
2981 end_of_file_error ();
2983 /* If purifying, and string starts with \ newline,
2984 return zero instead. This is for doc strings
2985 that we are really going to find in etc/DOC.nn.nn */
2986 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2987 return make_number (0);
2989 if (force_multibyte
)
2990 /* READ_BUFFER already contains valid multibyte forms. */
2992 else if (force_singlebyte
)
2994 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2996 p
= read_buffer
+ nchars
;
3000 /* Otherwise, READ_BUFFER contains only ASCII. */
3003 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3005 || (p
- read_buffer
!= nchars
)));
3010 int next_char
= READCHAR
;
3013 if (next_char
<= 040
3014 || (next_char
< 0200
3015 && strchr ("\"';([#?`,", next_char
) != NULL
))
3021 /* Otherwise, we fall through! Note that the atom-reading loop
3022 below will now loop at least once, assuring that we will not
3023 try to UNREAD two characters in a row. */
3027 if (c
<= 040) goto retry
;
3028 if (c
== 0xa0) /* NBSP */
3033 char *p
= read_buffer
;
3035 EMACS_INT start_position
= readchar_count
- 1;
3038 char *end
= read_buffer
+ read_buffer_size
;
3042 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3044 ptrdiff_t offset
= p
- read_buffer
;
3045 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3046 memory_full (SIZE_MAX
);
3047 read_buffer
= (char *) xrealloc (read_buffer
,
3048 read_buffer_size
* 2);
3049 read_buffer_size
*= 2;
3050 p
= read_buffer
+ offset
;
3051 end
= read_buffer
+ read_buffer_size
;
3058 end_of_file_error ();
3063 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3069 && c
!= 0xa0 /* NBSP */
3071 || strchr ("\"';()[]#`,", c
) == NULL
));
3075 ptrdiff_t offset
= p
- read_buffer
;
3076 if (min (PTRDIFF_MAX
, SIZE_MAX
) / 2 < read_buffer_size
)
3077 memory_full (SIZE_MAX
);
3078 read_buffer
= (char *) xrealloc (read_buffer
,
3079 read_buffer_size
* 2);
3080 read_buffer_size
*= 2;
3081 p
= read_buffer
+ offset
;
3082 end
= read_buffer
+ read_buffer_size
;
3088 if (!quoted
&& !uninterned_symbol
)
3090 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3091 if (! NILP (result
))
3095 Lisp_Object name
, result
;
3096 ptrdiff_t nbytes
= p
- read_buffer
;
3099 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3103 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3104 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3106 name
= make_specified_string (read_buffer
, nchars
, nbytes
, multibyte
);
3107 result
= (uninterned_symbol
? Fmake_symbol (name
)
3108 : Fintern (name
, Qnil
));
3110 if (EQ (Vread_with_symbol_positions
, Qt
)
3111 || EQ (Vread_with_symbol_positions
, readcharfun
))
3112 Vread_symbol_positions_list
=
3113 Fcons (Fcons (result
, make_number (start_position
)),
3114 Vread_symbol_positions_list
);
3122 /* List of nodes we've seen during substitute_object_in_subtree. */
3123 static Lisp_Object seen_list
;
3126 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3128 Lisp_Object check_object
;
3130 /* We haven't seen any objects when we start. */
3133 /* Make all the substitutions. */
3135 = substitute_object_recurse (object
, placeholder
, object
);
3137 /* Clear seen_list because we're done with it. */
3140 /* The returned object here is expected to always eq the
3142 if (!EQ (check_object
, object
))
3143 error ("Unexpected mutation error in reader");
3146 /* Feval doesn't get called from here, so no gc protection is needed. */
3147 #define SUBSTITUTE(get_val, set_val) \
3149 Lisp_Object old_value = get_val; \
3150 Lisp_Object true_value \
3151 = substitute_object_recurse (object, placeholder, \
3154 if (!EQ (old_value, true_value)) \
3161 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3163 /* If we find the placeholder, return the target object. */
3164 if (EQ (placeholder
, subtree
))
3167 /* If we've been to this node before, don't explore it again. */
3168 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3171 /* If this node can be the entry point to a cycle, remember that
3172 we've seen it. It can only be such an entry point if it was made
3173 by #n=, which means that we can find it as a value in
3175 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3176 seen_list
= Fcons (subtree
, seen_list
);
3178 /* Recurse according to subtree's type.
3179 Every branch must return a Lisp_Object. */
3180 switch (XTYPE (subtree
))
3182 case Lisp_Vectorlike
:
3184 ptrdiff_t i
, length
= 0;
3185 if (BOOL_VECTOR_P (subtree
))
3186 return subtree
; /* No sub-objects anyway. */
3187 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3188 || COMPILEDP (subtree
))
3189 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3190 else if (VECTORP (subtree
))
3191 length
= ASIZE (subtree
);
3193 /* An unknown pseudovector may contain non-Lisp fields, so we
3194 can't just blindly traverse all its fields. We used to call
3195 `Flength' which signaled `sequencep', so I just preserved this
3197 wrong_type_argument (Qsequencep
, subtree
);
3199 for (i
= 0; i
< length
; i
++)
3200 SUBSTITUTE (AREF (subtree
, i
),
3201 ASET (subtree
, i
, true_value
));
3207 SUBSTITUTE (XCAR (subtree
),
3208 XSETCAR (subtree
, true_value
));
3209 SUBSTITUTE (XCDR (subtree
),
3210 XSETCDR (subtree
, true_value
));
3216 /* Check for text properties in each interval.
3217 substitute_in_interval contains part of the logic. */
3219 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3220 Lisp_Object arg
= Fcons (object
, placeholder
);
3222 traverse_intervals_noorder (root_interval
,
3223 &substitute_in_interval
, arg
);
3228 /* Other types don't recurse any further. */
3234 /* Helper function for substitute_object_recurse. */
3236 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3238 Lisp_Object object
= Fcar (arg
);
3239 Lisp_Object placeholder
= Fcdr (arg
);
3241 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3251 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3252 integer syntax and fits in a fixnum, else return the nearest float if CP has
3253 either floating point or integer syntax and BASE is 10, else return nil. If
3254 IGNORE_TRAILING is nonzero, consider just the longest prefix of CP that has
3255 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3256 number has integer syntax but does not fit. */
3259 string_to_number (char const *string
, int base
, int ignore_trailing
)
3262 char const *cp
= string
;
3264 int float_syntax
= 0;
3267 /* Compute NaN and infinities using a variable, to cope with compilers that
3268 think they are smarter than we are. */
3271 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3272 IEEE floating point hosts, and works around a formerly-common bug where
3273 atof ("-0.0") drops the sign. */
3274 int negative
= *cp
== '-';
3276 int signedp
= negative
|| *cp
== '+';
3281 leading_digit
= digit_to_number (*cp
, base
);
3282 if (0 <= leading_digit
)
3287 while (0 <= digit_to_number (*cp
, base
));
3297 if ('0' <= *cp
&& *cp
<= '9')
3302 while ('0' <= *cp
&& *cp
<= '9');
3304 if (*cp
== 'e' || *cp
== 'E')
3306 char const *ecp
= cp
;
3308 if (*cp
== '+' || *cp
== '-')
3310 if ('0' <= *cp
&& *cp
<= '9')
3315 while ('0' <= *cp
&& *cp
<= '9');
3317 else if (cp
[-1] == '+'
3318 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3324 else if (cp
[-1] == '+'
3325 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3329 value
= zero
/ zero
;
3331 /* If that made a "negative" NaN, negate it. */
3334 union { double d
; char c
[sizeof (double)]; }
3335 u_data
, u_minus_zero
;
3337 u_minus_zero
.d
= -0.0;
3338 for (i
= 0; i
< sizeof (double); i
++)
3339 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3345 /* Now VALUE is a positive NaN. */
3351 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3352 || state
== (LEAD_INT
|E_EXP
));
3355 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3356 any prefix that matches. Otherwise, the entire string must match. */
3357 if (! (ignore_trailing
3358 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3359 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3362 /* If the number uses integer and not float syntax, and is in C-language
3363 range, use its value, preferably as a fixnum. */
3364 if (0 <= leading_digit
&& ! float_syntax
)
3368 /* Fast special case for single-digit integers. This also avoids a
3369 glitch when BASE is 16 and IGNORE_TRAILING is nonzero, because in that
3370 case some versions of strtoumax accept numbers like "0x1" that Emacs
3372 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3373 return make_number (negative
? -leading_digit
: leading_digit
);
3376 n
= strtoumax (string
+ signedp
, NULL
, base
);
3377 if (errno
== ERANGE
)
3379 /* Unfortunately there's no simple and accurate way to convert
3380 non-base-10 numbers that are out of C-language range. */
3382 xsignal1 (Qoverflow_error
, build_string (string
));
3384 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3386 EMACS_INT signed_n
= n
;
3387 return make_number (negative
? -signed_n
: signed_n
);
3393 /* Either the number uses float syntax, or it does not fit into a fixnum.
3394 Convert it from string to floating point, unless the value is already
3395 known because it is an infinity, a NAN, or its absolute value fits in
3398 value
= atof (string
+ signedp
);
3400 return make_float (negative
? -value
: value
);
3405 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3408 register Lisp_Object
*ptr
;
3409 register Lisp_Object tem
, item
, vector
;
3410 register struct Lisp_Cons
*otem
;
3413 tem
= read_list (1, readcharfun
);
3414 len
= Flength (tem
);
3415 vector
= Fmake_vector (len
, Qnil
);
3417 size
= ASIZE (vector
);
3418 ptr
= XVECTOR (vector
)->contents
;
3419 for (i
= 0; i
< size
; i
++)
3422 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3423 bytecode object, the docstring containing the bytecode and
3424 constants values must be treated as unibyte and passed to
3425 Fread, to get the actual bytecode string and constants vector. */
3426 if (bytecodeflag
&& load_force_doc_strings
)
3428 if (i
== COMPILED_BYTECODE
)
3430 if (!STRINGP (item
))
3431 error ("Invalid byte code");
3433 /* Delay handling the bytecode slot until we know whether
3434 it is lazily-loaded (we can tell by whether the
3435 constants slot is nil). */
3436 ptr
[COMPILED_CONSTANTS
] = item
;
3439 else if (i
== COMPILED_CONSTANTS
)
3441 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3445 /* Coerce string to unibyte (like string-as-unibyte,
3446 but without generating extra garbage and
3447 guaranteeing no change in the contents). */
3448 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3449 STRING_SET_UNIBYTE (bytestr
);
3451 item
= Fread (Fcons (bytestr
, readcharfun
));
3453 error ("Invalid byte code");
3455 otem
= XCONS (item
);
3456 bytestr
= XCAR (item
);
3461 /* Now handle the bytecode slot. */
3462 ptr
[COMPILED_BYTECODE
] = bytestr
;
3464 else if (i
== COMPILED_DOC_STRING
3466 && ! STRING_MULTIBYTE (item
))
3468 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3469 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3471 item
= Fstring_as_multibyte (item
);
3482 /* FLAG = 1 means check for ] to terminate rather than ) and . */
3485 read_list (int flag
, register Lisp_Object readcharfun
)
3487 Lisp_Object val
, tail
;
3488 register Lisp_Object elt
, tem
;
3489 struct gcpro gcpro1
, gcpro2
;
3490 /* 0 is the normal case.
3491 1 means this list is a doc reference; replace it with the number 0.
3492 2 means this list is a doc reference; replace it with the doc string. */
3493 int doc_reference
= 0;
3495 /* Initialize this to 1 if we are reading a list. */
3496 int first_in_list
= flag
<= 0;
3505 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3510 /* While building, if the list starts with #$, treat it specially. */
3511 if (EQ (elt
, Vload_file_name
)
3513 && !NILP (Vpurify_flag
))
3515 if (NILP (Vdoc_file_name
))
3516 /* We have not yet called Snarf-documentation, so assume
3517 this file is described in the DOC-MM.NN file
3518 and Snarf-documentation will fill in the right value later.
3519 For now, replace the whole list with 0. */
3522 /* We have already called Snarf-documentation, so make a relative
3523 file name for this file, so it can be found properly
3524 in the installed Lisp directory.
3525 We don't use Fexpand_file_name because that would make
3526 the directory absolute now. */
3527 elt
= concat2 (build_string ("../lisp/"),
3528 Ffile_name_nondirectory (elt
));
3530 else if (EQ (elt
, Vload_file_name
)
3532 && load_force_doc_strings
)
3541 invalid_syntax (") or . in a vector");
3549 XSETCDR (tail
, read0 (readcharfun
));
3551 val
= read0 (readcharfun
);
3552 read1 (readcharfun
, &ch
, 0);
3556 if (doc_reference
== 1)
3557 return make_number (0);
3558 if (doc_reference
== 2)
3560 /* Get a doc string from the file we are loading.
3561 If it's in saved_doc_string, get it from there.
3563 Here, we don't know if the string is a
3564 bytecode string or a doc string. As a
3565 bytecode string must be unibyte, we always
3566 return a unibyte string. If it is actually a
3567 doc string, caller must make it
3570 EMACS_INT pos
= XINT (XCDR (val
));
3571 /* Position is negative for user variables. */
3572 if (pos
< 0) pos
= -pos
;
3573 if (pos
>= saved_doc_string_position
3574 && pos
< (saved_doc_string_position
3575 + saved_doc_string_length
))
3577 ptrdiff_t start
= pos
- saved_doc_string_position
;
3580 /* Process quoting with ^A,
3581 and find the end of the string,
3582 which is marked with ^_ (037). */
3583 for (from
= start
, to
= start
;
3584 saved_doc_string
[from
] != 037;)
3586 int c
= saved_doc_string
[from
++];
3589 c
= saved_doc_string
[from
++];
3591 saved_doc_string
[to
++] = c
;
3593 saved_doc_string
[to
++] = 0;
3595 saved_doc_string
[to
++] = 037;
3598 saved_doc_string
[to
++] = c
;
3601 return make_unibyte_string (saved_doc_string
+ start
,
3604 /* Look in prev_saved_doc_string the same way. */
3605 else if (pos
>= prev_saved_doc_string_position
3606 && pos
< (prev_saved_doc_string_position
3607 + prev_saved_doc_string_length
))
3610 pos
- prev_saved_doc_string_position
;
3613 /* Process quoting with ^A,
3614 and find the end of the string,
3615 which is marked with ^_ (037). */
3616 for (from
= start
, to
= start
;
3617 prev_saved_doc_string
[from
] != 037;)
3619 int c
= prev_saved_doc_string
[from
++];
3622 c
= prev_saved_doc_string
[from
++];
3624 prev_saved_doc_string
[to
++] = c
;
3626 prev_saved_doc_string
[to
++] = 0;
3628 prev_saved_doc_string
[to
++] = 037;
3631 prev_saved_doc_string
[to
++] = c
;
3634 return make_unibyte_string (prev_saved_doc_string
3639 return get_doc_string (val
, 1, 0);
3644 invalid_syntax (". in wrong context");
3646 invalid_syntax ("] in a list");
3648 tem
= Fcons (elt
, Qnil
);
3650 XSETCDR (tail
, tem
);
3657 static Lisp_Object initial_obarray
;
3659 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3661 static size_t oblookup_last_bucket_number
;
3663 /* Get an error if OBARRAY is not an obarray.
3664 If it is one, return it. */
3667 check_obarray (Lisp_Object obarray
)
3669 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3671 /* If Vobarray is now invalid, force it to be valid. */
3672 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3673 wrong_type_argument (Qvectorp
, obarray
);
3678 /* Intern the C string STR: return a symbol with that name,
3679 interned in the current obarray. */
3682 intern (const char *str
)
3685 ptrdiff_t len
= strlen (str
);
3686 Lisp_Object obarray
;
3689 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3690 obarray
= check_obarray (obarray
);
3691 tem
= oblookup (obarray
, str
, len
, len
);
3694 return Fintern (make_string (str
, len
), obarray
);
3698 intern_c_string (const char *str
)
3701 ptrdiff_t len
= strlen (str
);
3702 Lisp_Object obarray
;
3705 if (!VECTORP (obarray
) || ASIZE (obarray
) == 0)
3706 obarray
= check_obarray (obarray
);
3707 tem
= oblookup (obarray
, str
, len
, len
);
3711 if (NILP (Vpurify_flag
))
3712 /* Creating a non-pure string from a string literal not
3713 implemented yet. We could just use make_string here and live
3714 with the extra copy. */
3717 return Fintern (make_pure_c_string (str
), obarray
);
3720 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3721 doc
: /* Return the canonical symbol whose name is STRING.
3722 If there is none, one is created by this function and returned.
3723 A second optional argument specifies the obarray to use;
3724 it defaults to the value of `obarray'. */)
3725 (Lisp_Object string
, Lisp_Object obarray
)
3727 register Lisp_Object tem
, sym
, *ptr
;
3729 if (NILP (obarray
)) obarray
= Vobarray
;
3730 obarray
= check_obarray (obarray
);
3732 CHECK_STRING (string
);
3734 tem
= oblookup (obarray
, SSDATA (string
),
3737 if (!INTEGERP (tem
))
3740 if (!NILP (Vpurify_flag
))
3741 string
= Fpurecopy (string
);
3742 sym
= Fmake_symbol (string
);
3744 if (EQ (obarray
, initial_obarray
))
3745 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3747 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3749 if ((SREF (string
, 0) == ':')
3750 && EQ (obarray
, initial_obarray
))
3752 XSYMBOL (sym
)->constant
= 1;
3753 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3754 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3757 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3759 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3761 XSYMBOL (sym
)->next
= 0;
3766 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3767 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3768 NAME may be a string or a symbol. If it is a symbol, that exact
3769 symbol is searched for.
3770 A second optional argument specifies the obarray to use;
3771 it defaults to the value of `obarray'. */)
3772 (Lisp_Object name
, Lisp_Object obarray
)
3774 register Lisp_Object tem
, string
;
3776 if (NILP (obarray
)) obarray
= Vobarray
;
3777 obarray
= check_obarray (obarray
);
3779 if (!SYMBOLP (name
))
3781 CHECK_STRING (name
);
3785 string
= SYMBOL_NAME (name
);
3787 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3788 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3794 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3795 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3796 The value is t if a symbol was found and deleted, nil otherwise.
3797 NAME may be a string or a symbol. If it is a symbol, that symbol
3798 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3799 OBARRAY defaults to the value of the variable `obarray'. */)
3800 (Lisp_Object name
, Lisp_Object obarray
)
3802 register Lisp_Object string
, tem
;
3805 if (NILP (obarray
)) obarray
= Vobarray
;
3806 obarray
= check_obarray (obarray
);
3809 string
= SYMBOL_NAME (name
);
3812 CHECK_STRING (name
);
3816 tem
= oblookup (obarray
, SSDATA (string
),
3821 /* If arg was a symbol, don't delete anything but that symbol itself. */
3822 if (SYMBOLP (name
) && !EQ (name
, tem
))
3825 /* There are plenty of other symbols which will screw up the Emacs
3826 session if we unintern them, as well as even more ways to use
3827 `setq' or `fset' or whatnot to make the Emacs session
3828 unusable. Let's not go down this silly road. --Stef */
3829 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3830 error ("Attempt to unintern t or nil"); */
3832 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3834 hash
= oblookup_last_bucket_number
;
3836 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3838 if (XSYMBOL (tem
)->next
)
3839 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3841 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3845 Lisp_Object tail
, following
;
3847 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3848 XSYMBOL (tail
)->next
;
3851 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3852 if (EQ (following
, tem
))
3854 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3863 /* Return the symbol in OBARRAY whose names matches the string
3864 of SIZE characters (SIZE_BYTE bytes) at PTR.
3865 If there is no such symbol in OBARRAY, return nil.
3867 Also store the bucket number in oblookup_last_bucket_number. */
3870 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
3874 register Lisp_Object tail
;
3875 Lisp_Object bucket
, tem
;
3877 if (!VECTORP (obarray
)
3878 || (obsize
= ASIZE (obarray
)) == 0)
3880 obarray
= check_obarray (obarray
);
3881 obsize
= ASIZE (obarray
);
3883 /* This is sometimes needed in the middle of GC. */
3884 obsize
&= ~ARRAY_MARK_FLAG
;
3885 hash
= hash_string (ptr
, size_byte
) % obsize
;
3886 bucket
= XVECTOR (obarray
)->contents
[hash
];
3887 oblookup_last_bucket_number
= hash
;
3888 if (EQ (bucket
, make_number (0)))
3890 else if (!SYMBOLP (bucket
))
3891 error ("Bad data in guts of obarray"); /* Like CADR error message. */
3893 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3895 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3896 && SCHARS (SYMBOL_NAME (tail
)) == size
3897 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3899 else if (XSYMBOL (tail
)->next
== 0)
3902 XSETINT (tem
, hash
);
3907 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3910 register Lisp_Object tail
;
3911 CHECK_VECTOR (obarray
);
3912 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
3914 tail
= XVECTOR (obarray
)->contents
[i
];
3919 if (XSYMBOL (tail
)->next
== 0)
3921 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3927 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3929 call1 (function
, sym
);
3932 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3933 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3934 OBARRAY defaults to the value of `obarray'. */)
3935 (Lisp_Object function
, Lisp_Object obarray
)
3937 if (NILP (obarray
)) obarray
= Vobarray
;
3938 obarray
= check_obarray (obarray
);
3940 map_obarray (obarray
, mapatoms_1
, function
);
3944 #define OBARRAY_SIZE 1511
3949 Lisp_Object oblength
;
3950 ptrdiff_t size
= 100 + MAX_MULTIBYTE_LENGTH
;
3952 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3954 Vobarray
= Fmake_vector (oblength
, make_number (0));
3955 initial_obarray
= Vobarray
;
3956 staticpro (&initial_obarray
);
3958 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3959 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3960 NILP (Vpurify_flag) check in intern_c_string. */
3961 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3962 Qnil
= intern_c_string ("nil");
3964 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3965 so those two need to be fixed manually. */
3966 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3967 XSYMBOL (Qunbound
)->function
= Qunbound
;
3968 XSYMBOL (Qunbound
)->plist
= Qnil
;
3969 /* XSYMBOL (Qnil)->function = Qunbound; */
3970 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3971 XSYMBOL (Qnil
)->constant
= 1;
3972 XSYMBOL (Qnil
)->declared_special
= 1;
3973 XSYMBOL (Qnil
)->plist
= Qnil
;
3975 Qt
= intern_c_string ("t");
3976 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3977 XSYMBOL (Qnil
)->declared_special
= 1;
3978 XSYMBOL (Qt
)->constant
= 1;
3980 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3983 DEFSYM (Qvariable_documentation
, "variable-documentation");
3985 read_buffer
= (char *) xmalloc (size
);
3986 read_buffer_size
= size
;
3990 defsubr (struct Lisp_Subr
*sname
)
3993 sym
= intern_c_string (sname
->symbol_name
);
3994 XSETTYPED_PVECTYPE (sname
, size
, PVEC_SUBR
);
3995 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3998 #ifdef NOTDEF /* Use fset in subr.el now! */
4000 defalias (struct Lisp_Subr
*sname
, char *string
)
4003 sym
= intern (string
);
4004 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4008 /* Define an "integer variable"; a symbol whose value is forwarded to a
4009 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4010 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4012 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4013 const char *namestring
, EMACS_INT
*address
)
4016 sym
= intern_c_string (namestring
);
4017 i_fwd
->type
= Lisp_Fwd_Int
;
4018 i_fwd
->intvar
= address
;
4019 XSYMBOL (sym
)->declared_special
= 1;
4020 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4021 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4024 /* Similar but define a variable whose value is t if address contains 1,
4025 nil if address contains 0. */
4027 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4028 const char *namestring
, int *address
)
4031 sym
= intern_c_string (namestring
);
4032 b_fwd
->type
= Lisp_Fwd_Bool
;
4033 b_fwd
->boolvar
= address
;
4034 XSYMBOL (sym
)->declared_special
= 1;
4035 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4036 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4037 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4040 /* Similar but define a variable whose value is the Lisp Object stored
4041 at address. Two versions: with and without gc-marking of the C
4042 variable. The nopro version is used when that variable will be
4043 gc-marked for some other reason, since marking the same slot twice
4044 can cause trouble with strings. */
4046 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4047 const char *namestring
, Lisp_Object
*address
)
4050 sym
= intern_c_string (namestring
);
4051 o_fwd
->type
= Lisp_Fwd_Obj
;
4052 o_fwd
->objvar
= address
;
4053 XSYMBOL (sym
)->declared_special
= 1;
4054 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4055 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4059 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4060 const char *namestring
, Lisp_Object
*address
)
4062 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4063 staticpro (address
);
4066 /* Similar but define a variable whose value is the Lisp Object stored
4067 at a particular offset in the current kboard object. */
4070 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4071 const char *namestring
, int offset
)
4074 sym
= intern_c_string (namestring
);
4075 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4076 ko_fwd
->offset
= offset
;
4077 XSYMBOL (sym
)->declared_special
= 1;
4078 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4079 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4082 /* Record the value of load-path used at the start of dumping
4083 so we can see if the site changed it later during dumping. */
4084 static Lisp_Object dump_path
;
4090 int turn_off_warning
= 0;
4092 /* Compute the default Vload-path, with the following logic:
4093 If CANNOT_DUMP just use PATH_LOADSEARCH.
4094 Else if purify-flag (ie dumping) start from PATH_DUMPLOADSEARCH;
4095 otherwise start from PATH_LOADSEARCH.
4096 If !initialized, then just set both Vload_path and dump_path.
4097 If initialized, then if Vload_path != dump_path, do nothing.
4098 (Presumably the load-path has already been changed by something.)
4099 Also do nothing if Vinstallation_directory is nil.
4101 Remove site-lisp directories from the front of load-path.
4102 Add installation-dir/lisp (if exists and not already a member),
4103 at the front, and turn off warnings about missing directories
4104 (because we are presumably running uninstalled).
4105 If it does not exist, add dump_path at the end instead.
4106 Add installation-dir/leim (if exists and not already a member)
4108 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4109 and not already a member) at the front.
4110 If installation-dir != source-dir (ie running an uninstalled,
4111 out-of-tree build) AND install-dir/src/Makefile exists BUT
4112 install-dir/src/Makefile.in does NOT exist (this is a sanity
4113 check), then repeat the above steps for source-dir/lisp,
4115 Finally, add the previously removed site-lisp directories back
4116 at the front (if !no_site_lisp).
4118 We then warn about any of the load-path elements that do not
4119 exist. The only ones that might not exist are those from
4120 PATH_LOADSEARCH, and perhaps dump_path.
4122 Having done all this, we then throw it all away if purify-flag is
4123 nil (ie, not dumping) and EMACSLOADPATH is set, and just
4124 unconditionally use the latter value instead.
4125 So AFAICS the only net results of all the previous steps will be
4126 possibly to issue some irrelevant warnings.
4128 FIXME? There's a case for saying that if we are running
4129 uninstalled, the eventual installation directories should not yet
4130 be included in load-path.
4133 normal
= PATH_LOADSEARCH
;
4134 Vload_path
= decode_env_path (0, normal
);
4136 if (NILP (Vpurify_flag
))
4137 normal
= PATH_LOADSEARCH
;
4139 normal
= PATH_DUMPLOADSEARCH
;
4141 /* In a dumped Emacs, we normally reset the value of Vload_path using
4142 PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
4143 the source directory, instead of the path of the installed elisp
4144 libraries. However, if it appears that Vload_path has already been
4145 changed from the default that was saved before dumping, don't
4146 change it further. */
4149 if (! NILP (Fequal (dump_path
, Vload_path
)))
4151 Vload_path
= decode_env_path (0, normal
);
4152 if (no_site_lisp
|| !NILP (Vinstallation_directory
))
4154 Lisp_Object tem
, tem1
, sitelisp
;
4156 /* Remove "site-lisp" dirs from front of path temporarily
4157 and store them in sitelisp, then conc them on at the
4158 end so they're always first in path.
4159 Note that this won't work if you used a
4160 --enable-locallisppath element that does not happen
4161 to contain "site-lisp" in its name.
4166 tem
= Fcar (Vload_path
);
4167 tem1
= Fstring_match (build_string ("site-lisp"),
4171 Vload_path
= Fcdr (Vload_path
);
4172 sitelisp
= Fcons (tem
, sitelisp
);
4178 if (!NILP (Vinstallation_directory
))
4180 /* Add to the path the lisp subdir of the
4181 installation dir, if it exists. */
4182 tem
= Fexpand_file_name (build_string ("lisp"),
4183 Vinstallation_directory
);
4184 tem1
= Ffile_exists_p (tem
);
4187 if (NILP (Fmember (tem
, Vload_path
)))
4189 turn_off_warning
= 1;
4190 Vload_path
= Fcons (tem
, Vload_path
);
4194 /* That dir doesn't exist, so add the build-time
4195 Lisp dirs instead. */
4196 Vload_path
= nconc2 (Vload_path
, dump_path
);
4198 /* Add leim under the installation dir, if it exists. */
4199 tem
= Fexpand_file_name (build_string ("leim"),
4200 Vinstallation_directory
);
4201 tem1
= Ffile_exists_p (tem
);
4204 if (NILP (Fmember (tem
, Vload_path
)))
4205 Vload_path
= Fcons (tem
, Vload_path
);
4208 /* Add site-lisp under the installation dir, if it exists. */
4211 tem
= Fexpand_file_name (build_string ("site-lisp"),
4212 Vinstallation_directory
);
4213 tem1
= Ffile_exists_p (tem
);
4216 if (NILP (Fmember (tem
, Vload_path
)))
4217 Vload_path
= Fcons (tem
, Vload_path
);
4221 /* If Emacs was not built in the source directory,
4222 and it is run from where it was built, add to load-path
4223 the lisp, leim and site-lisp dirs under that directory. */
4225 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4229 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4230 Vinstallation_directory
);
4231 tem1
= Ffile_exists_p (tem
);
4233 /* Don't be fooled if they moved the entire source tree
4234 AFTER dumping Emacs. If the build directory is indeed
4235 different from the source dir, src/Makefile.in and
4236 src/Makefile will not be found together. */
4237 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4238 Vinstallation_directory
);
4239 tem2
= Ffile_exists_p (tem
);
4240 if (!NILP (tem1
) && NILP (tem2
))
4242 tem
= Fexpand_file_name (build_string ("lisp"),
4245 if (NILP (Fmember (tem
, Vload_path
)))
4246 Vload_path
= Fcons (tem
, Vload_path
);
4248 tem
= Fexpand_file_name (build_string ("leim"),
4251 if (NILP (Fmember (tem
, Vload_path
)))
4252 Vload_path
= Fcons (tem
, Vload_path
);
4256 tem
= Fexpand_file_name (build_string ("site-lisp"),
4259 if (NILP (Fmember (tem
, Vload_path
)))
4260 Vload_path
= Fcons (tem
, Vload_path
);
4263 } /* Vinstallation_directory != Vsource_directory */
4264 } /* if Vinstallation_directory */
4265 if (!NILP (sitelisp
) && !no_site_lisp
)
4266 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4267 } /* if Vinstallation_directory || no_site_lisp */
4268 } /* if dump_path == Vload_path */
4270 else /* !initialized */
4272 /* NORMAL refers to the lisp dir in the source directory. */
4273 /* We used to add ../lisp at the front here, but
4274 that caused trouble because it was copied from dump_path
4275 into Vload_path, above, when Vinstallation_directory was non-nil.
4276 It should be unnecessary. */
4277 Vload_path
= decode_env_path (0, normal
);
4278 dump_path
= Vload_path
;
4280 #endif /* CANNOT_DUMP */
4282 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4283 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4284 almost never correct, thereby causing a warning to be printed out that
4285 confuses users. Since PATH_LOADSEARCH is always overridden by the
4286 EMACSLOADPATH environment variable below, disable the warning on NT. */
4288 /* HAVE_NS also uses EMACSLOADPATH. */
4290 /* Warn if dirs in the *standard* path don't exist. */
4291 if (!turn_off_warning
)
4293 Lisp_Object path_tail
;
4295 for (path_tail
= Vload_path
;
4297 path_tail
= XCDR (path_tail
))
4299 Lisp_Object dirfile
;
4300 dirfile
= Fcar (path_tail
);
4301 if (STRINGP (dirfile
))
4303 dirfile
= Fdirectory_file_name (dirfile
);
4304 /* Do we really need to warn about missing site-lisp dirs?
4305 It's true that the installation should have created
4306 them and added subdirs.el, but it's harmless if they
4308 if (access (SSDATA (dirfile
), 0) < 0)
4309 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4314 #endif /* !(WINDOWSNT || HAVE_NS) */
4316 /* If the EMACSLOADPATH environment variable is set, use its value.
4317 This doesn't apply if we're dumping. */
4319 if (NILP (Vpurify_flag
)
4320 && egetenv ("EMACSLOADPATH"))
4322 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4326 load_in_progress
= 0;
4327 Vload_file_name
= Qnil
;
4329 load_descriptor_list
= Qnil
;
4331 Vstandard_input
= Qt
;
4332 Vloads_in_progress
= Qnil
;
4335 /* Print a warning, using format string FORMAT, that directory DIRNAME
4336 does not exist. Print it on stderr and put it in *Messages*. */
4339 dir_warning (const char *format
, Lisp_Object dirname
)
4341 fprintf (stderr
, format
, SDATA (dirname
));
4343 /* Don't log the warning before we've initialized!! */
4347 ptrdiff_t message_len
;
4349 SAFE_ALLOCA (buffer
, char *,
4350 SBYTES (dirname
) + strlen (format
) - (sizeof "%s" - 1) + 1);
4351 message_len
= esprintf (buffer
, format
, SDATA (dirname
));
4352 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4358 syms_of_lread (void)
4361 defsubr (&Sread_from_string
);
4363 defsubr (&Sintern_soft
);
4364 defsubr (&Sunintern
);
4365 defsubr (&Sget_load_suffixes
);
4367 defsubr (&Seval_buffer
);
4368 defsubr (&Seval_region
);
4369 defsubr (&Sread_char
);
4370 defsubr (&Sread_char_exclusive
);
4371 defsubr (&Sread_event
);
4372 defsubr (&Sget_file_char
);
4373 defsubr (&Smapatoms
);
4374 defsubr (&Slocate_file_internal
);
4376 DEFVAR_LISP ("obarray", Vobarray
,
4377 doc
: /* Symbol table for use by `intern' and `read'.
4378 It is a vector whose length ought to be prime for best results.
4379 The vector's contents don't make sense if examined from Lisp programs;
4380 to find all the symbols in an obarray, use `mapatoms'. */);
4382 DEFVAR_LISP ("values", Vvalues
,
4383 doc
: /* List of values of all expressions which were read, evaluated and printed.
4384 Order is reverse chronological. */);
4386 DEFVAR_LISP ("standard-input", Vstandard_input
,
4387 doc
: /* Stream for read to get input from.
4388 See documentation of `read' for possible values. */);
4389 Vstandard_input
= Qt
;
4391 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4392 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4394 If this variable is a buffer, then only forms read from that buffer
4395 will be added to `read-symbol-positions-list'.
4396 If this variable is t, then all read forms will be added.
4397 The effect of all other values other than nil are not currently
4398 defined, although they may be in the future.
4400 The positions are relative to the last call to `read' or
4401 `read-from-string'. It is probably a bad idea to set this variable at
4402 the toplevel; bind it instead. */);
4403 Vread_with_symbol_positions
= Qnil
;
4405 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4406 doc
: /* A list mapping read symbols to their positions.
4407 This variable is modified during calls to `read' or
4408 `read-from-string', but only when `read-with-symbol-positions' is
4411 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4412 CHAR-POSITION is an integer giving the offset of that occurrence of the
4413 symbol from the position where `read' or `read-from-string' started.
4415 Note that a symbol will appear multiple times in this list, if it was
4416 read multiple times. The list is in the same order as the symbols
4418 Vread_symbol_positions_list
= Qnil
;
4420 DEFVAR_LISP ("read-circle", Vread_circle
,
4421 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4424 DEFVAR_LISP ("load-path", Vload_path
,
4425 doc
: /* List of directories to search for files to load.
4426 Each element is a string (directory name) or nil (try default directory).
4427 Initialized based on EMACSLOADPATH environment variable, if any,
4428 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4430 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4431 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4432 This list should not include the empty string.
4433 `load' and related functions try to append these suffixes, in order,
4434 to the specified file name if a Lisp suffix is allowed or required. */);
4435 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4436 Fcons (make_pure_c_string (".el"), Qnil
));
4437 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4438 doc
: /* List of suffixes that indicate representations of \
4440 This list should normally start with the empty string.
4442 Enabling Auto Compression mode appends the suffixes in
4443 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4444 mode removes them again. `load' and related functions use this list to
4445 determine whether they should look for compressed versions of a file
4446 and, if so, which suffixes they should try to append to the file name
4447 in order to do so. However, if you want to customize which suffixes
4448 the loading functions recognize as compression suffixes, you should
4449 customize `jka-compr-load-suffixes' rather than the present variable. */);
4450 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4452 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4453 doc
: /* Non-nil if inside of `load'. */);
4454 DEFSYM (Qload_in_progress
, "load-in-progress");
4456 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4457 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4458 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4460 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4461 a symbol \(a feature name).
4463 When `load' is run and the file-name argument matches an element's
4464 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4465 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4467 An error in FORMS does not undo the load, but does prevent execution of
4468 the rest of the FORMS. */);
4469 Vafter_load_alist
= Qnil
;
4471 DEFVAR_LISP ("load-history", Vload_history
,
4472 doc
: /* Alist mapping loaded file names to symbols and features.
4473 Each alist element should be a list (FILE-NAME ENTRIES...), where
4474 FILE-NAME is the name of a file that has been loaded into Emacs.
4475 The file name is absolute and true (i.e. it doesn't contain symlinks).
4476 As an exception, one of the alist elements may have FILE-NAME nil,
4477 for symbols and features not associated with any file.
4479 The remaining ENTRIES in the alist element describe the functions and
4480 variables defined in that file, the features provided, and the
4481 features required. Each entry has the form `(provide . FEATURE)',
4482 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4483 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4484 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4485 autoload before this file redefined it as a function. In addition,
4486 entries may also be single symbols, which means that SYMBOL was
4487 defined by `defvar' or `defconst'.
4489 During preloading, the file name recorded is relative to the main Lisp
4490 directory. These file names are converted to absolute at startup. */);
4491 Vload_history
= Qnil
;
4493 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4494 doc
: /* Full name of file being loaded by `load'. */);
4495 Vload_file_name
= Qnil
;
4497 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4498 doc
: /* File name, including directory, of user's initialization file.
4499 If the file loaded had extension `.elc', and the corresponding source file
4500 exists, this variable contains the name of source file, suitable for use
4501 by functions like `custom-save-all' which edit the init file.
4502 While Emacs loads and evaluates the init file, value is the real name
4503 of the file, regardless of whether or not it has the `.elc' extension. */);
4504 Vuser_init_file
= Qnil
;
4506 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4507 doc
: /* Used for internal purposes by `load'. */);
4508 Vcurrent_load_list
= Qnil
;
4510 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4511 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4512 The default is nil, which means use the function `read'. */);
4513 Vload_read_function
= Qnil
;
4515 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4516 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4517 This function is for doing code conversion before reading the source file.
4518 If nil, loading is done without any code conversion.
4519 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4520 FULLNAME is the full name of FILE.
4521 See `load' for the meaning of the remaining arguments. */);
4522 Vload_source_file_function
= Qnil
;
4524 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4525 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4526 This is useful when the file being loaded is a temporary copy. */);
4527 load_force_doc_strings
= 0;
4529 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4530 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4531 This is normally bound by `load' and `eval-buffer' to control `read',
4532 and is not meant for users to change. */);
4533 load_convert_to_unibyte
= 0;
4535 DEFVAR_LISP ("source-directory", Vsource_directory
,
4536 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4537 You cannot count on them to still be there! */);
4539 = Fexpand_file_name (build_string ("../"),
4540 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4542 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4543 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4544 Vpreloaded_file_list
= Qnil
;
4546 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4547 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4548 Vbyte_boolean_vars
= Qnil
;
4550 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4551 doc
: /* Non-nil means load dangerous compiled Lisp files.
4552 Some versions of XEmacs use different byte codes than Emacs. These
4553 incompatible byte codes can make Emacs crash when it tries to execute
4555 load_dangerous_libraries
= 0;
4557 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4558 doc
: /* Non-nil means force printing messages when loading Lisp files.
4559 This overrides the value of the NOMESSAGE argument to `load'. */);
4560 force_load_messages
= 0;
4562 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4563 doc
: /* Regular expression matching safe to load compiled Lisp files.
4564 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4565 from the file, and matches them against this regular expression.
4566 When the regular expression matches, the file is considered to be safe
4567 to load. See also `load-dangerous-libraries'. */);
4568 Vbytecomp_version_regexp
4569 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4571 Qlexical_binding
= intern ("lexical-binding");
4572 staticpro (&Qlexical_binding
);
4573 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4574 doc
: /* Whether to use lexical binding when evaluating code.
4575 Non-nil means that the code in the current buffer should be evaluated
4576 with lexical binding.
4577 This variable is automatically set from the file variables of an
4578 interpreted Lisp file read using `load'. Unlike other file local
4579 variables, this must be set in the first line of a file. */);
4580 Fmake_variable_buffer_local (Qlexical_binding
);
4582 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4583 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4584 Veval_buffer_list
= Qnil
;
4586 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4587 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4588 Vold_style_backquotes
= Qnil
;
4589 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4591 /* Vsource_directory was initialized in init_lread. */
4593 load_descriptor_list
= Qnil
;
4594 staticpro (&load_descriptor_list
);
4596 DEFSYM (Qcurrent_load_list
, "current-load-list");
4597 DEFSYM (Qstandard_input
, "standard-input");
4598 DEFSYM (Qread_char
, "read-char");
4599 DEFSYM (Qget_file_char
, "get-file-char");
4600 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4601 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4603 DEFSYM (Qbackquote
, "`");
4604 DEFSYM (Qcomma
, ",");
4605 DEFSYM (Qcomma_at
, ",@");
4606 DEFSYM (Qcomma_dot
, ",.");
4608 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4609 DEFSYM (Qascii_character
, "ascii-character");
4610 DEFSYM (Qfunction
, "function");
4611 DEFSYM (Qload
, "load");
4612 DEFSYM (Qload_file_name
, "load-file-name");
4613 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4614 DEFSYM (Qfile_truename
, "file-truename");
4615 DEFSYM (Qdir_ok
, "dir-ok");
4616 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4618 staticpro (&dump_path
);
4620 staticpro (&read_objects
);
4621 read_objects
= Qnil
;
4622 staticpro (&seen_list
);
4625 Vloads_in_progress
= Qnil
;
4626 staticpro (&Vloads_in_progress
);
4628 DEFSYM (Qhash_table
, "hash-table");
4629 DEFSYM (Qdata
, "data");
4630 DEFSYM (Qtest
, "test");
4631 DEFSYM (Qsize
, "size");
4632 DEFSYM (Qweakness
, "weakness");
4633 DEFSYM (Qrehash_size
, "rehash-size");
4634 DEFSYM (Qrehash_threshold
, "rehash-threshold");