1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2017 Free Software Foundation,
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Tell globals.h to define tables needed by init_obarray. */
22 #define DEFINE_SYMBOLS
27 #include <sys/types.h>
32 #include <stat-time.h>
34 #include "dispextern.h"
35 #include "intervals.h"
36 #include "character.h"
43 #include "termhooks.h"
44 #include "blockinput.h"
49 #if __DJGPP__ == 2 && __DJGPP_MINOR__ < 5
50 # define INFINITY __builtin_inf()
51 # define NAN __builtin_nan("")
63 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
75 /* The association list of objects read with the #n=object form.
76 Each member of the list has the form (n . object), and is used to
77 look up the object for the corresponding #n# construct.
78 It must be set to nil before all top-level calls to read0. */
79 static Lisp_Object read_objects
;
81 /* File for get_file_char to read from. Use by load. */
82 static FILE *instream
;
84 /* For use within read-from-string (this reader is non-reentrant!!) */
85 static ptrdiff_t read_from_string_index
;
86 static ptrdiff_t read_from_string_index_byte
;
87 static ptrdiff_t read_from_string_limit
;
89 /* Number of characters read in the current call to Fread or
91 static EMACS_INT readchar_count
;
93 /* This contains the last string skipped with #@. */
94 static char *saved_doc_string
;
95 /* Length of buffer allocated in saved_doc_string. */
96 static ptrdiff_t saved_doc_string_size
;
97 /* Length of actual data in saved_doc_string. */
98 static ptrdiff_t saved_doc_string_length
;
99 /* This is the file position that string came from. */
100 static file_offset saved_doc_string_position
;
102 /* This contains the previous string skipped with #@.
103 We copy it from saved_doc_string when a new string
104 is put in saved_doc_string. */
105 static char *prev_saved_doc_string
;
106 /* Length of buffer allocated in prev_saved_doc_string. */
107 static ptrdiff_t prev_saved_doc_string_size
;
108 /* Length of actual data in prev_saved_doc_string. */
109 static ptrdiff_t prev_saved_doc_string_length
;
110 /* This is the file position that string came from. */
111 static file_offset prev_saved_doc_string_position
;
113 /* True means inside a new-style backquote
114 with no surrounding parentheses.
115 Fread initializes this to false, so we need not specbind it
116 or worry about what happens to it when there is an error. */
117 static bool new_backquote_flag
;
119 /* A list of file names for files being loaded in Fload. Used to
120 check for recursive loads. */
122 static Lisp_Object Vloads_in_progress
;
124 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
127 static void readevalloop (Lisp_Object
, FILE *, Lisp_Object
, bool,
128 Lisp_Object
, Lisp_Object
,
129 Lisp_Object
, Lisp_Object
);
131 /* Functions that read one byte from the current source READCHARFUN
132 or unreads one byte. If the integer argument C is -1, it returns
133 one read byte, or -1 when there's no more byte in the source. If C
134 is 0 or positive, it unreads C, and the return value is not
137 static int readbyte_for_lambda (int, Lisp_Object
);
138 static int readbyte_from_file (int, Lisp_Object
);
139 static int readbyte_from_string (int, Lisp_Object
);
141 /* Handle unreading and rereading of characters.
142 Write READCHAR to read a character,
143 UNREAD(c) to unread c to be read again.
145 These macros correctly read/unread multibyte characters. */
147 #define READCHAR readchar (readcharfun, NULL)
148 #define UNREAD(c) unreadchar (readcharfun, c)
150 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
151 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
153 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
154 Qlambda, or a cons, we use this to keep an unread character because
155 a file stream can't handle multibyte-char unreading. The value -1
156 means that there's no unread character. */
157 static int unread_char
;
160 readchar (Lisp_Object readcharfun
, bool *multibyte
)
164 int (*readbyte
) (int, Lisp_Object
);
165 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
167 bool emacs_mule_encoding
= 0;
174 if (BUFFERP (readcharfun
))
176 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
178 ptrdiff_t pt_byte
= BUF_PT_BYTE (inbuffer
);
180 if (! BUFFER_LIVE_P (inbuffer
))
183 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
186 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
188 /* Fetch the character code from the buffer. */
189 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
190 BUF_INC_POS (inbuffer
, pt_byte
);
197 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
198 if (! ASCII_CHAR_P (c
))
199 c
= BYTE8_TO_CHAR (c
);
202 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
206 if (MARKERP (readcharfun
))
208 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
210 ptrdiff_t bytepos
= marker_byte_position (readcharfun
);
212 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
215 if (! NILP (BVAR (inbuffer
, enable_multibyte_characters
)))
217 /* Fetch the character code from the buffer. */
218 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
219 BUF_INC_POS (inbuffer
, bytepos
);
226 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
227 if (! ASCII_CHAR_P (c
))
228 c
= BYTE8_TO_CHAR (c
);
232 XMARKER (readcharfun
)->bytepos
= bytepos
;
233 XMARKER (readcharfun
)->charpos
++;
238 if (EQ (readcharfun
, Qlambda
))
240 readbyte
= readbyte_for_lambda
;
244 if (EQ (readcharfun
, Qget_file_char
))
246 readbyte
= readbyte_from_file
;
250 if (STRINGP (readcharfun
))
252 if (read_from_string_index
>= read_from_string_limit
)
254 else if (STRING_MULTIBYTE (readcharfun
))
258 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
259 read_from_string_index
,
260 read_from_string_index_byte
);
264 c
= SREF (readcharfun
, read_from_string_index_byte
);
265 read_from_string_index
++;
266 read_from_string_index_byte
++;
271 if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
273 /* This is the case that read_vector is reading from a unibyte
274 string that contains a byte sequence previously skipped
275 because of #@NUMBER. The car part of readcharfun is that
276 string, and the cdr part is a value of readcharfun given to
278 readbyte
= readbyte_from_string
;
279 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
280 emacs_mule_encoding
= 1;
284 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
286 readbyte
= readbyte_from_file
;
287 emacs_mule_encoding
= 1;
291 tem
= call0 (readcharfun
);
298 if (unread_char
>= 0)
304 c
= (*readbyte
) (-1, readcharfun
);
309 if (ASCII_CHAR_P (c
))
311 if (emacs_mule_encoding
)
312 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
315 len
= BYTES_BY_CHAR_HEAD (c
);
318 c
= (*readbyte
) (-1, readcharfun
);
319 if (c
< 0 || ! TRAILING_CODE_P (c
))
322 (*readbyte
) (buf
[i
], readcharfun
);
323 return BYTE8_TO_CHAR (buf
[0]);
327 return STRING_CHAR (buf
);
330 #define FROM_FILE_P(readcharfun) \
331 (EQ (readcharfun, Qget_file_char) \
332 || EQ (readcharfun, Qget_emacs_mule_file_char))
335 skip_dyn_bytes (Lisp_Object readcharfun
, ptrdiff_t n
)
337 if (FROM_FILE_P (readcharfun
))
339 block_input (); /* FIXME: Not sure if it's needed. */
340 fseek (instream
, n
, SEEK_CUR
);
344 { /* We're not reading directly from a file. In that case, it's difficult
345 to reliably count bytes, since these are usually meant for the file's
346 encoding, whereas we're now typically in the internal encoding.
347 But luckily, skip_dyn_bytes is used to skip over a single
348 dynamic-docstring (or dynamic byte-code) which is always quoted such
349 that \037 is the final char. */
353 } while (c
>= 0 && c
!= '\037');
358 skip_dyn_eof (Lisp_Object readcharfun
)
360 if (FROM_FILE_P (readcharfun
))
362 block_input (); /* FIXME: Not sure if it's needed. */
363 fseek (instream
, 0, SEEK_END
);
367 while (READCHAR
>= 0);
370 /* Unread the character C in the way appropriate for the stream READCHARFUN.
371 If the stream is a user function, call it with the char as argument. */
374 unreadchar (Lisp_Object readcharfun
, int c
)
378 /* Don't back up the pointer if we're unreading the end-of-input mark,
379 since readchar didn't advance it when we read it. */
381 else if (BUFFERP (readcharfun
))
383 struct buffer
*b
= XBUFFER (readcharfun
);
384 ptrdiff_t charpos
= BUF_PT (b
);
385 ptrdiff_t bytepos
= BUF_PT_BYTE (b
);
387 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
388 BUF_DEC_POS (b
, bytepos
);
392 SET_BUF_PT_BOTH (b
, charpos
- 1, bytepos
);
394 else if (MARKERP (readcharfun
))
396 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
397 ptrdiff_t bytepos
= XMARKER (readcharfun
)->bytepos
;
399 XMARKER (readcharfun
)->charpos
--;
400 if (! NILP (BVAR (b
, enable_multibyte_characters
)))
401 BUF_DEC_POS (b
, bytepos
);
405 XMARKER (readcharfun
)->bytepos
= bytepos
;
407 else if (STRINGP (readcharfun
))
409 read_from_string_index
--;
410 read_from_string_index_byte
411 = string_char_to_byte (readcharfun
, read_from_string_index
);
413 else if (CONSP (readcharfun
) && STRINGP (XCAR (readcharfun
)))
417 else if (EQ (readcharfun
, Qlambda
))
421 else if (FROM_FILE_P (readcharfun
))
426 call1 (readcharfun
, make_number (c
));
430 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
432 return read_bytecode_char (c
>= 0);
437 readbyte_from_file (int c
, Lisp_Object readcharfun
)
442 ungetc (c
, instream
);
450 /* Interrupted reads have been observed while reading over the network. */
451 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
462 return (c
== EOF
? -1 : c
);
466 readbyte_from_string (int c
, Lisp_Object readcharfun
)
468 Lisp_Object string
= XCAR (readcharfun
);
472 read_from_string_index
--;
473 read_from_string_index_byte
474 = string_char_to_byte (string
, read_from_string_index
);
477 if (read_from_string_index
>= read_from_string_limit
)
480 FETCH_STRING_CHAR_ADVANCE (c
, string
,
481 read_from_string_index
,
482 read_from_string_index_byte
);
487 /* Read one non-ASCII character from INSTREAM. The character is
488 encoded in `emacs-mule' and the first byte is already read in
492 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
494 /* Emacs-mule coding uses at most 4-byte for one character. */
495 unsigned char buf
[4];
496 int len
= emacs_mule_bytes
[c
];
497 struct charset
*charset
;
502 /* C is not a valid leading-code of `emacs-mule'. */
503 return BYTE8_TO_CHAR (c
);
509 c
= (*readbyte
) (-1, readcharfun
);
513 (*readbyte
) (buf
[i
], readcharfun
);
514 return BYTE8_TO_CHAR (buf
[0]);
521 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
522 code
= buf
[1] & 0x7F;
526 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
527 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
529 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
530 code
= buf
[2] & 0x7F;
534 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
535 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
540 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
541 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
543 c
= DECODE_CHAR (charset
, code
);
545 Fsignal (Qinvalid_read_syntax
,
546 list1 (build_string ("invalid multibyte form")));
551 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
553 static Lisp_Object
read0 (Lisp_Object
);
554 static Lisp_Object
read1 (Lisp_Object
, int *, bool);
556 static Lisp_Object
read_list (bool, Lisp_Object
);
557 static Lisp_Object
read_vector (Lisp_Object
, bool);
559 static Lisp_Object
substitute_object_recurse (Lisp_Object
, 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, switch-frame events are stashed
569 until we get a character we like, and then stuffed into
572 If ASCII_REQUIRED, 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, signal an error if the input we
577 get isn't an ASCII character with modifiers. If it's false but
578 ASCII_REQUIRED is true, just re-read until we get an ASCII
581 If INPUT_METHOD, invoke the current input method
582 if the character warrants that.
584 If SECONDS is a number, wait that many seconds for input, and
585 return Qnil if no input arrives within that time. */
588 read_filtered_event (bool no_switch_frame
, bool ascii_required
,
589 bool error_nonascii
, bool input_method
, Lisp_Object seconds
)
591 Lisp_Object val
, delayed_switch_frame
;
592 struct timespec end_time
;
594 #ifdef HAVE_WINDOW_SYSTEM
595 if (display_hourglass_p
)
599 delayed_switch_frame
= Qnil
;
601 /* Compute timeout. */
602 if (NUMBERP (seconds
))
604 double duration
= XFLOATINT (seconds
);
605 struct timespec wait_time
= dtotimespec (duration
);
606 end_time
= timespec_add (current_timespec (), wait_time
);
609 /* Read until we get an acceptable event. */
612 val
= read_char (0, Qnil
, (input_method
? Qnil
: Qt
), 0,
613 NUMBERP (seconds
) ? &end_time
: NULL
);
614 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
619 /* `switch-frame' events are put off until after the next ASCII
620 character. This is better than signaling an error just because
621 the last characters were typed to a separate minibuffer frame,
622 for example. Eventually, some code which can deal with
623 switch-frame events will read it and process it. */
625 && EVENT_HAS_PARAMETERS (val
)
626 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
628 delayed_switch_frame
= val
;
632 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
634 /* Convert certain symbols to their ASCII equivalents. */
637 Lisp_Object tem
, tem1
;
638 tem
= Fget (val
, Qevent_symbol_element_mask
);
641 tem1
= Fget (Fcar (tem
), Qascii_character
);
642 /* Merge this symbol's modifier bits
643 with the ASCII equivalent of its basic code. */
645 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
649 /* If we don't have a character now, deal with it appropriately. */
654 Vunread_command_events
= list1 (val
);
655 error ("Non-character input-event");
662 if (! NILP (delayed_switch_frame
))
663 unread_switch_frame
= delayed_switch_frame
;
667 #ifdef HAVE_WINDOW_SYSTEM
668 if (display_hourglass_p
)
677 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
678 doc
: /* Read a character from the command input (keyboard or macro).
679 It is returned as a number.
680 If the character has modifiers, they are resolved and reflected to the
681 character code if possible (e.g. C-SPC -> 0).
683 If the user generates an event which is not a character (i.e. a mouse
684 click or function key event), `read-char' signals an error. As an
685 exception, switch-frame events are put off until non-character events
687 If you want to read non-character events, or ignore them, call
688 `read-event' or `read-char-exclusive' instead.
690 If the optional argument PROMPT is non-nil, display that as a prompt.
691 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
692 input method is turned on in the current buffer, that input method
693 is used for reading a character.
694 If the optional argument SECONDS is non-nil, it should be a number
695 specifying the maximum number of seconds to wait for input. If no
696 input arrives in that time, return nil. SECONDS may be a
697 floating-point value. */)
698 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
703 message_with_string ("%s", prompt
, 0);
704 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
706 return (NILP (val
) ? Qnil
707 : make_number (char_resolve_modifier_mask (XINT (val
))));
710 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
711 doc
: /* Read an event object from the input stream.
712 If the optional argument PROMPT is non-nil, display that as a prompt.
713 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
714 input method is turned on in the current buffer, that input method
715 is used for reading a character.
716 If the optional argument SECONDS is non-nil, it should be a number
717 specifying the maximum number of seconds to wait for input. If no
718 input arrives in that time, return nil. SECONDS may be a
719 floating-point value. */)
720 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
723 message_with_string ("%s", prompt
, 0);
724 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
727 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
728 doc
: /* Read a character from the command input (keyboard or macro).
729 It is returned as a number. Non-character events are ignored.
730 If the character has modifiers, they are resolved and reflected to the
731 character code if possible (e.g. C-SPC -> 0).
733 If the optional argument PROMPT is non-nil, display that as a prompt.
734 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
735 input method is turned on in the current buffer, that input method
736 is used for reading a character.
737 If the optional argument SECONDS is non-nil, it should be a number
738 specifying the maximum number of seconds to wait for input. If no
739 input arrives in that time, return nil. SECONDS may be a
740 floating-point value. */)
741 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
746 message_with_string ("%s", prompt
, 0);
748 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
750 return (NILP (val
) ? Qnil
751 : make_number (char_resolve_modifier_mask (XINT (val
))));
754 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
755 doc
: /* Don't use this yourself. */)
758 register Lisp_Object val
;
760 XSETINT (val
, getc (instream
));
768 /* Return true if the lisp code read using READCHARFUN defines a non-nil
769 `lexical-binding' file variable. After returning, the stream is
770 positioned following the first line, if it is a comment or #! line,
771 otherwise nothing is read. */
774 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
787 while (ch
!= '\n' && ch
!= EOF
)
789 if (ch
== '\n') ch
= READCHAR
;
790 /* It is OK to leave the position after a #! line, since
791 that is what read1 does. */
795 /* The first line isn't a comment, just give up. */
801 /* Look for an appropriate file-variable in the first line. */
805 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
806 } beg_end_state
= NOMINAL
;
807 bool in_file_vars
= 0;
809 #define UPDATE_BEG_END_STATE(ch) \
810 if (beg_end_state == NOMINAL) \
811 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
812 else if (beg_end_state == AFTER_FIRST_DASH) \
813 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
814 else if (beg_end_state == AFTER_ASTERIX) \
817 in_file_vars = !in_file_vars; \
818 beg_end_state = NOMINAL; \
821 /* Skip until we get to the file vars, if any. */
825 UPDATE_BEG_END_STATE (ch
);
827 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
831 char var
[100], val
[100];
836 /* Read a variable name. */
837 while (ch
== ' ' || ch
== '\t')
841 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
843 if (i
< sizeof var
- 1)
845 UPDATE_BEG_END_STATE (ch
);
849 /* Stop scanning if no colon was found before end marker. */
850 if (!in_file_vars
|| ch
== '\n' || ch
== EOF
)
853 while (i
> 0 && (var
[i
- 1] == ' ' || var
[i
- 1] == '\t'))
859 /* Read a variable value. */
862 while (ch
== ' ' || ch
== '\t')
866 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
868 if (i
< sizeof val
- 1)
870 UPDATE_BEG_END_STATE (ch
);
874 /* The value was terminated by an end-marker, which remove. */
876 while (i
> 0 && (val
[i
- 1] == ' ' || val
[i
- 1] == '\t'))
880 if (strcmp (var
, "lexical-binding") == 0)
883 rv
= (strcmp (val
, "nil") != 0);
889 while (ch
!= '\n' && ch
!= EOF
)
896 /* Value is a version number of byte compiled code if the file
897 associated with file descriptor FD is a compiled Lisp file that's
898 safe to load. Only files compiled with Emacs are safe to load.
899 Files compiled with XEmacs can lead to a crash in Fbyte_code
900 because of an incompatible change in the byte compiler. */
903 safe_to_load_version (int fd
)
909 /* Read the first few bytes from the file, and look for a line
910 specifying the byte compiler version used. */
911 nbytes
= emacs_read_quit (fd
, buf
, sizeof buf
);
914 /* Skip to the next newline, skipping over the initial `ELC'
915 with NUL bytes following it, but note the version. */
916 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
921 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
922 buf
+ i
, nbytes
- i
) < 0)
926 lseek (fd
, 0, SEEK_SET
);
931 /* Callback for record_unwind_protect. Restore the old load list OLD,
932 after loading a file successfully. */
935 record_load_unwind (Lisp_Object old
)
937 Vloads_in_progress
= old
;
940 /* This handler function is used via internal_condition_case_1. */
943 load_error_handler (Lisp_Object data
)
949 load_warn_old_style_backquotes (Lisp_Object file
)
951 if (!NILP (Vold_style_backquotes
))
953 AUTO_STRING (format
, "Loading `%s': old-style backquotes detected!");
954 CALLN (Fmessage
, format
, file
);
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 /* Returns true if STRING ends with SUFFIX */
982 suffix_p (Lisp_Object string
, const char *suffix
)
984 ptrdiff_t suffix_len
= strlen (suffix
);
985 ptrdiff_t string_len
= SBYTES (string
);
987 return string_len
>= suffix_len
&& !strcmp (SSDATA (string
) + string_len
- suffix_len
, suffix
);
990 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
991 doc
: /* Execute a file of Lisp code named FILE.
992 First try FILE with `.elc' appended, then try with `.el', then try
993 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
994 then try FILE unmodified (the exact suffixes in the exact order are
995 determined by `load-suffixes'). Environment variable references in
996 FILE are replaced with their values by calling `substitute-in-file-name'.
997 This function searches the directories in `load-path'.
999 If optional second arg NOERROR is non-nil,
1000 report no error if FILE doesn't exist.
1001 Print messages at start and end of loading unless
1002 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1004 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1005 suffixes to the specified name FILE.
1006 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1007 the suffix `.elc' or `.el' or the module suffix; don't accept just
1008 FILE unless it ends in one of those suffixes or includes a directory name.
1010 If NOSUFFIX is nil, then if a file could not be found, try looking for
1011 a different representation of the file by adding non-empty suffixes to
1012 its name, before trying another file. Emacs uses this feature to find
1013 compressed versions of files when Auto Compression mode is enabled.
1014 If NOSUFFIX is non-nil, disable this feature.
1016 The suffixes that this function tries out, when NOSUFFIX is nil, are
1017 given by the return value of `get-load-suffixes' and the values listed
1018 in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the
1019 return value of `get-load-suffixes' is used, i.e. the file name is
1020 required to have a non-empty suffix.
1022 When searching suffixes, this function normally stops at the first
1023 one that exists. If the option `load-prefer-newer' is non-nil,
1024 however, it tries all suffixes, and uses whichever file is the newest.
1026 Loading a file records its definitions, and its `provide' and
1027 `require' calls, in an element of `load-history' whose
1028 car is the file name loaded. See `load-history'.
1030 While the file is in the process of being loaded, the variable
1031 `load-in-progress' is non-nil and the variable `load-file-name'
1032 is bound to the file's name.
1034 Return t if the file exists and loads successfully. */)
1035 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
,
1036 Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1040 int fd_index UNINIT
;
1041 ptrdiff_t count
= SPECPDL_INDEX ();
1042 Lisp_Object found
, efound
, hist_file_name
;
1043 /* True means we printed the ".el is newer" message. */
1045 /* True means we are loading a compiled file. */
1047 Lisp_Object handler
;
1049 const char *fmode
= "r" FOPEN_TEXT
;
1052 CHECK_STRING (file
);
1054 /* If file name is magic, call the handler. */
1055 /* This shouldn't be necessary any more now that `openp' handles it right.
1056 handler = Ffind_file_name_handler (file, Qload);
1057 if (!NILP (handler))
1058 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1060 /* The presence of this call is the result of a historical accident:
1061 it used to be in every file-operation and when it got removed
1062 everywhere, it accidentally stayed here. Since then, enough people
1063 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1064 that it seemed risky to remove. */
1065 if (! NILP (noerror
))
1067 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1068 Qt
, load_error_handler
);
1073 file
= Fsubstitute_in_file_name (file
);
1075 /* Avoid weird lossage with null string as arg,
1076 since it would try to load a directory as a Lisp file. */
1077 if (SCHARS (file
) == 0)
1084 Lisp_Object suffixes
;
1087 if (! NILP (must_suffix
))
1089 /* Don't insist on adding a suffix if FILE already ends with one. */
1090 if (suffix_p (file
, ".el")
1091 || suffix_p (file
, ".elc")
1093 || suffix_p (file
, MODULES_SUFFIX
)
1097 /* Don't insist on adding a suffix
1098 if the argument includes a directory name. */
1099 else if (! NILP (Ffile_name_directory (file
)))
1103 if (!NILP (nosuffix
))
1107 suffixes
= Fget_load_suffixes ();
1108 if (NILP (must_suffix
))
1109 suffixes
= CALLN (Fappend
, suffixes
, Vload_file_rep_suffixes
);
1112 fd
= openp (Vload_path
, file
, suffixes
, &found
, Qnil
, load_prefer_newer
);
1118 report_file_error ("Cannot open load file", file
);
1122 /* Tell startup.el whether or not we found the user's init file. */
1123 if (EQ (Qt
, Vuser_init_file
))
1124 Vuser_init_file
= found
;
1126 /* If FD is -2, that means openp found a magic file. */
1129 if (NILP (Fequal (found
, file
)))
1130 /* If FOUND is a different file name from FILE,
1131 find its handler even if we have already inhibited
1132 the `load' operation on FILE. */
1133 handler
= Ffind_file_name_handler (found
, Qt
);
1135 handler
= Ffind_file_name_handler (found
, Qload
);
1136 if (! NILP (handler
))
1137 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1139 /* Tramp has to deal with semi-broken packages that prepend
1140 drive letters to remote files. For that reason, Tramp
1141 catches file operations that test for file existence, which
1142 makes openp think X:/foo.elc files are remote. However,
1143 Tramp does not catch `load' operations for such files, so we
1144 end up with a nil as the `load' handler above. If we would
1145 continue with fd = -2, we will behave wrongly, and in
1146 particular try reading a .elc file in the "rt" mode instead
1147 of "rb". See bug #9311 for the results. To work around
1148 this, we try to open the file locally, and go with that if it
1150 fd
= emacs_open (SSDATA (ENCODE_FILE (found
)), O_RDONLY
, 0);
1158 fd_index
= SPECPDL_INDEX ();
1159 record_unwind_protect_int (close_file_unwind
, fd
);
1163 if (suffix_p (found
, MODULES_SUFFIX
))
1164 return unbind_to (count
, Fmodule_load (found
));
1167 /* Check if we're stuck in a recursive load cycle.
1169 2000-09-21: It's not possible to just check for the file loaded
1170 being a member of Vloads_in_progress. This fails because of the
1171 way the byte compiler currently works; `provide's are not
1172 evaluated, see font-lock.el/jit-lock.el as an example. This
1173 leads to a certain amount of ``normal'' recursion.
1175 Also, just loading a file recursively is not always an error in
1176 the general case; the second load may do something different. */
1180 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1181 if (!NILP (Fequal (found
, XCAR (tem
))) && (++load_count
> 3))
1182 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1183 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1184 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1187 /* All loads are by default dynamic, unless the file itself specifies
1188 otherwise using a file-variable in the first line. This is bound here
1189 so that it takes effect whether or not we use
1190 Vload_source_file_function. */
1191 specbind (Qlexical_binding
, Qnil
);
1193 /* Get the name for load-history. */
1194 hist_file_name
= (! NILP (Vpurify_flag
)
1195 ? concat2 (Ffile_name_directory (file
),
1196 Ffile_name_nondirectory (found
))
1201 /* Check for the presence of old-style quotes and warn about them. */
1202 specbind (Qold_style_backquotes
, Qnil
);
1203 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1206 if ((is_elc
= suffix_p (found
, ".elc")) != 0
1207 /* version = 1 means the file is empty, in which case we can
1208 treat it as not byte-compiled. */
1209 || (fd
>= 0 && (version
= safe_to_load_version (fd
)) > 1))
1210 /* Load .elc files directly, but not when they are
1211 remote and have no handler! */
1219 && ! (version
= safe_to_load_version (fd
)))
1222 if (!load_dangerous_libraries
)
1223 error ("File `%s' was not compiled in Emacs", SDATA (found
));
1224 else if (!NILP (nomessage
) && !force_load_messages
)
1225 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1230 efound
= ENCODE_FILE (found
);
1231 fmode
= "r" FOPEN_BINARY
;
1233 /* openp already checked for newness, no point doing it again.
1234 FIXME would be nice to get a message when openp
1235 ignores suffix order due to load_prefer_newer. */
1236 if (!load_prefer_newer
&& is_elc
)
1238 result
= stat (SSDATA (efound
), &s1
);
1241 SSET (efound
, SBYTES (efound
) - 1, 0);
1242 result
= stat (SSDATA (efound
), &s2
);
1243 SSET (efound
, SBYTES (efound
) - 1, 'c');
1247 && timespec_cmp (get_stat_mtime (&s1
), get_stat_mtime (&s2
)) < 0)
1249 /* Make the progress messages mention that source is newer. */
1252 /* If we won't print another message, mention this anyway. */
1253 if (!NILP (nomessage
) && !force_load_messages
)
1255 Lisp_Object msg_file
;
1256 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1257 message_with_string ("Source file `%s' newer than byte-compiled file",
1261 } /* !load_prefer_newer */
1266 /* We are loading a source file (*.el). */
1267 if (!NILP (Vload_source_file_function
))
1274 clear_unwind_protect (fd_index
);
1276 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1277 NILP (noerror
) ? Qnil
: Qt
,
1278 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1279 return unbind_to (count
, val
);
1285 /* We somehow got here with fd == -2, meaning the file is deemed
1286 to be remote. Don't even try to reopen the file locally;
1287 just force a failure. */
1295 clear_unwind_protect (fd_index
);
1296 efound
= ENCODE_FILE (found
);
1297 stream
= emacs_fopen (SSDATA (efound
), fmode
);
1299 stream
= fdopen (fd
, fmode
);
1303 report_file_error ("Opening stdio stream", file
);
1304 set_unwind_protect_ptr (fd_index
, fclose_unwind
, stream
);
1306 if (! NILP (Vpurify_flag
))
1307 Vpreloaded_file_list
= Fcons (Fpurecopy (file
), Vpreloaded_file_list
);
1309 if (NILP (nomessage
) || force_load_messages
)
1312 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1315 message_with_string ("Loading %s (source)...", file
, 1);
1317 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1319 else /* The typical case; compiled file newer than source file. */
1320 message_with_string ("Loading %s...", file
, 1);
1323 specbind (Qload_file_name
, found
);
1324 specbind (Qinhibit_file_name_operation
, Qnil
);
1325 specbind (Qload_in_progress
, Qt
);
1328 if (lisp_file_lexically_bound_p (Qget_file_char
))
1329 Fset (Qlexical_binding
, Qt
);
1331 if (! version
|| version
>= 22)
1332 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1333 0, Qnil
, Qnil
, Qnil
, Qnil
);
1336 /* We can't handle a file which was compiled with
1337 byte-compile-dynamic by older version of Emacs. */
1338 specbind (Qload_force_doc_strings
, Qt
);
1339 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1340 0, Qnil
, Qnil
, Qnil
, Qnil
);
1342 unbind_to (count
, Qnil
);
1344 /* Run any eval-after-load forms for this file. */
1345 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1346 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1348 xfree (saved_doc_string
);
1349 saved_doc_string
= 0;
1350 saved_doc_string_size
= 0;
1352 xfree (prev_saved_doc_string
);
1353 prev_saved_doc_string
= 0;
1354 prev_saved_doc_string_size
= 0;
1356 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1359 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1362 message_with_string ("Loading %s (source)...done", file
, 1);
1364 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1366 else /* The typical case; compiled file newer than source file. */
1367 message_with_string ("Loading %s...done", file
, 1);
1374 complete_filename_p (Lisp_Object pathname
)
1376 const unsigned char *s
= SDATA (pathname
);
1377 return (IS_DIRECTORY_SEP (s
[0])
1378 || (SCHARS (pathname
) > 2
1379 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1382 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1383 doc
: /* Search for FILENAME through PATH.
1384 Returns the file's name in absolute form, or nil if not found.
1385 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1386 file name when searching.
1387 If non-nil, PREDICATE is used instead of `file-readable-p'.
1388 PREDICATE can also be an integer to pass to the faccessat(2) function,
1389 in which case file-name-handlers are ignored.
1390 This function will normally skip directories, so if you want it to find
1391 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1392 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1395 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
, false);
1396 if (NILP (predicate
) && fd
>= 0)
1401 /* Search for a file whose name is STR, looking in directories
1402 in the Lisp list PATH, and trying suffixes from SUFFIX.
1403 On success, return a file descriptor (or 1 or -2 as described below).
1404 On failure, return -1 and set errno.
1406 SUFFIXES is a list of strings containing possible suffixes.
1407 The empty suffix is automatically added if the list is empty.
1409 PREDICATE t means the files are binary.
1410 PREDICATE non-nil and non-t means don't open the files,
1411 just look for one that satisfies the predicate. In this case,
1412 return -2 on success. The predicate can be a lisp function or
1413 an integer to pass to `access' (in which case file-name-handlers
1416 If STOREPTR is nonzero, it points to a slot where the name of
1417 the file actually found should be stored as a Lisp string.
1418 nil is stored there on failure.
1420 If the file we find is remote, return -2
1421 but store the found remote file name in *STOREPTR.
1423 If NEWER is true, try all SUFFIXes and return the result for the
1424 newest file that exists. Does not apply to remote files,
1425 or if a non-nil and non-t PREDICATE is specified. */
1428 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
,
1429 Lisp_Object
*storeptr
, Lisp_Object predicate
, bool newer
)
1431 ptrdiff_t fn_size
= 100;
1435 ptrdiff_t want_length
;
1436 Lisp_Object filename
;
1437 Lisp_Object string
, tail
, encoded_fn
, save_string
;
1438 ptrdiff_t max_suffix_len
= 0;
1439 int last_errno
= ENOENT
;
1443 /* The last-modified time of the newest matching file found.
1444 Initialize it to something less than all valid timestamps. */
1445 struct timespec save_mtime
= make_timespec (TYPE_MINIMUM (time_t), -1);
1449 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1451 CHECK_STRING_CAR (tail
);
1452 max_suffix_len
= max (max_suffix_len
,
1453 SBYTES (XCAR (tail
)));
1456 string
= filename
= encoded_fn
= save_string
= Qnil
;
1461 absolute
= complete_filename_p (str
);
1463 for (; CONSP (path
); path
= XCDR (path
))
1465 ptrdiff_t baselen
, prefixlen
;
1467 filename
= Fexpand_file_name (str
, XCAR (path
));
1468 if (!complete_filename_p (filename
))
1469 /* If there are non-absolute elts in PATH (eg "."). */
1470 /* Of course, this could conceivably lose if luser sets
1471 default-directory to be something non-absolute... */
1473 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1474 if (!complete_filename_p (filename
))
1475 /* Give up on this path element! */
1479 /* Calculate maximum length of any filename made from
1480 this path element/specified file name and any possible suffix. */
1481 want_length
= max_suffix_len
+ SBYTES (filename
);
1482 if (fn_size
<= want_length
)
1484 fn_size
= 100 + want_length
;
1485 fn
= SAFE_ALLOCA (fn_size
);
1488 /* Copy FILENAME's data to FN but remove starting /: if any. */
1489 prefixlen
= ((SCHARS (filename
) > 2
1490 && SREF (filename
, 0) == '/'
1491 && SREF (filename
, 1) == ':')
1493 baselen
= SBYTES (filename
) - prefixlen
;
1494 memcpy (fn
, SDATA (filename
) + prefixlen
, baselen
);
1496 /* Loop over suffixes. */
1497 for (tail
= NILP (suffixes
) ? list1 (empty_unibyte_string
) : suffixes
;
1498 CONSP (tail
); tail
= XCDR (tail
))
1500 Lisp_Object suffix
= XCAR (tail
);
1501 ptrdiff_t fnlen
, lsuffix
= SBYTES (suffix
);
1502 Lisp_Object handler
;
1504 /* Make complete filename by appending SUFFIX. */
1505 memcpy (fn
+ baselen
, SDATA (suffix
), lsuffix
+ 1);
1506 fnlen
= baselen
+ lsuffix
;
1508 /* Check that the file exists and is not a directory. */
1509 /* We used to only check for handlers on non-absolute file names:
1513 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1514 It's not clear why that was the case and it breaks things like
1515 (load "/bar.el") where the file is actually "/bar.el.gz". */
1516 /* make_string has its own ideas on when to return a unibyte
1517 string and when a multibyte string, but we know better.
1518 We must have a unibyte string when dumping, since
1519 file-name encoding is shaky at best at that time, and in
1520 particular default-file-name-coding-system is reset
1521 several times during loadup. We therefore don't want to
1522 encode the file before passing it to file I/O library
1524 if (!STRING_MULTIBYTE (filename
) && !STRING_MULTIBYTE (suffix
))
1525 string
= make_unibyte_string (fn
, fnlen
);
1527 string
= make_string (fn
, fnlen
);
1528 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1529 if ((!NILP (handler
) || (!NILP (predicate
) && !EQ (predicate
, Qt
)))
1530 && !NATNUMP (predicate
))
1533 if (NILP (predicate
) || EQ (predicate
, Qt
))
1534 exists
= !NILP (Ffile_readable_p (string
));
1537 Lisp_Object tmp
= call1 (predicate
, string
);
1540 else if (EQ (tmp
, Qdir_ok
)
1541 || NILP (Ffile_directory_p (string
)))
1546 last_errno
= EISDIR
;
1552 /* We succeeded; return this descriptor and filename. */
1565 encoded_fn
= ENCODE_FILE (string
);
1566 pfn
= SSDATA (encoded_fn
);
1568 /* Check that we can access or open it. */
1569 if (NATNUMP (predicate
))
1572 if (INT_MAX
< XFASTINT (predicate
))
1573 last_errno
= EINVAL
;
1574 else if (faccessat (AT_FDCWD
, pfn
, XFASTINT (predicate
),
1578 if (file_directory_p (pfn
))
1579 last_errno
= EISDIR
;
1586 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1589 if (errno
!= ENOENT
)
1594 int err
= (fstat (fd
, &st
) != 0 ? errno
1595 : S_ISDIR (st
.st_mode
) ? EISDIR
: 0);
1607 if (newer
&& !NATNUMP (predicate
))
1609 struct timespec mtime
= get_stat_mtime (&st
);
1611 if (timespec_cmp (mtime
, save_mtime
) <= 0)
1616 emacs_close (save_fd
);
1619 save_string
= string
;
1624 /* We succeeded; return this descriptor and filename. */
1632 /* No more suffixes. Return the newest. */
1633 if (0 <= save_fd
&& ! CONSP (XCDR (tail
)))
1636 *storeptr
= save_string
;
1652 /* Merge the list we've accumulated of globals from the current input source
1653 into the load_history variable. The details depend on whether
1654 the source has an associated file name or not.
1656 FILENAME is the file name that we are loading from.
1658 ENTIRE is true if loading that entire file, false if evaluating
1662 build_load_history (Lisp_Object filename
, bool entire
)
1664 Lisp_Object tail
, prev
, newelt
;
1665 Lisp_Object tem
, tem2
;
1668 tail
= Vload_history
;
1671 while (CONSP (tail
))
1675 /* Find the feature's previous assoc list... */
1676 if (!NILP (Fequal (filename
, Fcar (tem
))))
1680 /* If we're loading the entire file, remove old data. */
1684 Vload_history
= XCDR (tail
);
1686 Fsetcdr (prev
, XCDR (tail
));
1689 /* Otherwise, cons on new symbols that are not already members. */
1692 tem2
= Vcurrent_load_list
;
1694 while (CONSP (tem2
))
1696 newelt
= XCAR (tem2
);
1698 if (NILP (Fmember (newelt
, tem
)))
1699 Fsetcar (tail
, Fcons (XCAR (tem
),
1700 Fcons (newelt
, XCDR (tem
))));
1713 /* If we're loading an entire file, cons the new assoc onto the
1714 front of load-history, the most-recently-loaded position. Also
1715 do this if we didn't find an existing member for the file. */
1716 if (entire
|| !foundit
)
1717 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1722 readevalloop_1 (int old
)
1724 load_convert_to_unibyte
= old
;
1727 /* Signal an `end-of-file' error, if possible with file name
1730 static _Noreturn
void
1731 end_of_file_error (void)
1733 if (STRINGP (Vload_file_name
))
1734 xsignal1 (Qend_of_file
, Vload_file_name
);
1736 xsignal0 (Qend_of_file
);
1740 readevalloop_eager_expand_eval (Lisp_Object val
, Lisp_Object macroexpand
)
1742 /* If we macroexpand the toplevel form non-recursively and it ends
1743 up being a `progn' (or if it was a progn to start), treat each
1744 form in the progn as a top-level form. This way, if one form in
1745 the progn defines a macro, that macro is in effect when we expand
1746 the remaining forms. See similar code in bytecomp.el. */
1747 val
= call2 (macroexpand
, val
, Qnil
);
1748 if (EQ (CAR_SAFE (val
), Qprogn
))
1750 Lisp_Object subforms
= XCDR (val
);
1752 for (val
= Qnil
; CONSP (subforms
); subforms
= XCDR (subforms
))
1753 val
= readevalloop_eager_expand_eval (XCAR (subforms
),
1757 val
= eval_sub (call2 (macroexpand
, val
, Qt
));
1761 /* UNIBYTE specifies how to set load_convert_to_unibyte
1762 for this invocation.
1763 READFUN, if non-nil, is used instead of `read'.
1765 START, END specify region to read in current buffer (from eval-region).
1766 If the input is not from a buffer, they must be nil. */
1769 readevalloop (Lisp_Object readcharfun
,
1771 Lisp_Object sourcename
,
1773 Lisp_Object unibyte
, Lisp_Object readfun
,
1774 Lisp_Object start
, Lisp_Object end
)
1778 ptrdiff_t count
= SPECPDL_INDEX ();
1779 struct buffer
*b
= 0;
1780 bool continue_reading_p
;
1781 Lisp_Object lex_bound
;
1782 /* True if reading an entire buffer. */
1783 bool whole_buffer
= 0;
1784 /* True on the first time around. */
1785 bool first_sexp
= 1;
1786 Lisp_Object macroexpand
= intern ("internal-macroexpand-for-load");
1788 if (NILP (Ffboundp (macroexpand
))
1789 /* Don't macroexpand in .elc files, since it should have been done
1790 already. We actually don't know whether we're in a .elc file or not,
1791 so we use circumstantial evidence: .el files normally go through
1792 Vload_source_file_function -> load-with-code-conversion
1794 || EQ (readcharfun
, Qget_file_char
)
1795 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
1798 if (MARKERP (readcharfun
))
1801 start
= readcharfun
;
1804 if (BUFFERP (readcharfun
))
1805 b
= XBUFFER (readcharfun
);
1806 else if (MARKERP (readcharfun
))
1807 b
= XMARKER (readcharfun
)->buffer
;
1809 /* We assume START is nil when input is not from a buffer. */
1810 if (! NILP (start
) && !b
)
1813 specbind (Qstandard_input
, readcharfun
);
1814 specbind (Qcurrent_load_list
, Qnil
);
1815 record_unwind_protect_int (readevalloop_1
, load_convert_to_unibyte
);
1816 load_convert_to_unibyte
= !NILP (unibyte
);
1818 /* If lexical binding is active (either because it was specified in
1819 the file's header, or via a buffer-local variable), create an empty
1820 lexical environment, otherwise, turn off lexical binding. */
1821 lex_bound
= find_symbol_value (Qlexical_binding
);
1822 specbind (Qinternal_interpreter_environment
,
1823 (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1824 ? Qnil
: list1 (Qt
)));
1826 /* Try to ensure sourcename is a truename, except whilst preloading. */
1827 if (NILP (Vpurify_flag
)
1828 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1829 && !NILP (Ffboundp (Qfile_truename
)))
1830 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1832 LOADHIST_ATTACH (sourcename
);
1834 continue_reading_p
= 1;
1835 while (continue_reading_p
)
1837 ptrdiff_t count1
= SPECPDL_INDEX ();
1839 if (b
!= 0 && !BUFFER_LIVE_P (b
))
1840 error ("Reading from killed buffer");
1844 /* Switch to the buffer we are reading from. */
1845 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1846 set_buffer_internal (b
);
1848 /* Save point in it. */
1849 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1850 /* Save ZV in it. */
1851 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1852 /* Those get unbound after we read one expression. */
1854 /* Set point and ZV around stuff to be read. */
1857 Fnarrow_to_region (make_number (BEGV
), end
);
1859 /* Just for cleanliness, convert END to a marker
1860 if it is an integer. */
1862 end
= Fpoint_max_marker ();
1865 /* On the first cycle, we can easily test here
1866 whether we are reading the whole buffer. */
1867 if (b
&& first_sexp
)
1868 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1875 while ((c
= READCHAR
) != '\n' && c
!= -1);
1880 unbind_to (count1
, Qnil
);
1884 /* Ignore whitespace here, so we can detect eof. */
1885 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1886 || c
== NO_BREAK_SPACE
)
1889 if (!NILP (Vpurify_flag
) && c
== '(')
1891 val
= read_list (0, readcharfun
);
1896 read_objects
= Qnil
;
1897 if (!NILP (readfun
))
1899 val
= call1 (readfun
, readcharfun
);
1901 /* If READCHARFUN has set point to ZV, we should
1902 stop reading, even if the form read sets point
1903 to a different value when evaluated. */
1904 if (BUFFERP (readcharfun
))
1906 struct buffer
*buf
= XBUFFER (readcharfun
);
1907 if (BUF_PT (buf
) == BUF_ZV (buf
))
1908 continue_reading_p
= 0;
1911 else if (! NILP (Vload_read_function
))
1912 val
= call1 (Vload_read_function
, readcharfun
);
1914 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1917 if (!NILP (start
) && continue_reading_p
)
1918 start
= Fpoint_marker ();
1920 /* Restore saved point and BEGV. */
1921 unbind_to (count1
, Qnil
);
1923 /* Now eval what we just read. */
1924 if (!NILP (macroexpand
))
1925 val
= readevalloop_eager_expand_eval (val
, macroexpand
);
1927 val
= eval_sub (val
);
1931 Vvalues
= Fcons (val
, Vvalues
);
1932 if (EQ (Vstandard_output
, Qt
))
1941 build_load_history (sourcename
,
1942 stream
|| whole_buffer
);
1944 unbind_to (count
, Qnil
);
1947 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1948 doc
: /* Execute the accessible portion of current buffer as Lisp code.
1949 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1950 When called from a Lisp program (i.e., not interactively), this
1951 function accepts up to five optional arguments:
1952 BUFFER is the buffer to evaluate (nil means use current buffer),
1953 or a name of a buffer (a string).
1954 PRINTFLAG controls printing of output by any output functions in the
1955 evaluated code, such as `print', `princ', and `prin1':
1956 a value of nil means discard it; anything else is the stream to print to.
1957 See Info node `(elisp)Output Streams' for details on streams.
1958 FILENAME specifies the file name to use for `load-history'.
1959 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1961 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1962 evaluated code should work normally even if PRINTFLAG is nil, in
1963 which case the output is displayed in the echo area.
1965 This function preserves the position of point. */)
1966 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1968 ptrdiff_t count
= SPECPDL_INDEX ();
1969 Lisp_Object tem
, buf
;
1972 buf
= Fcurrent_buffer ();
1974 buf
= Fget_buffer (buffer
);
1976 error ("No such buffer");
1978 if (NILP (printflag
) && NILP (do_allow_print
))
1983 if (NILP (filename
))
1984 filename
= BVAR (XBUFFER (buf
), filename
);
1986 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1987 specbind (Qstandard_output
, tem
);
1988 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1989 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1990 specbind (Qlexical_binding
, lisp_file_lexically_bound_p (buf
) ? Qt
: Qnil
);
1991 readevalloop (buf
, 0, filename
,
1992 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1993 unbind_to (count
, Qnil
);
1998 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1999 doc
: /* Execute the region as Lisp code.
2000 When called from programs, expects two arguments,
2001 giving starting and ending indices in the current buffer
2002 of the text to be executed.
2003 Programs can pass third argument PRINTFLAG which controls output:
2004 a value of nil means discard it; anything else is stream for printing it.
2005 See Info node `(elisp)Output Streams' for details on streams.
2006 Also the fourth argument READ-FUNCTION, if non-nil, is used
2007 instead of `read' to read each expression. It gets one argument
2008 which is the input stream for reading characters.
2010 This function does not move point. */)
2011 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
2013 /* FIXME: Do the eval-sexp-add-defvars dance! */
2014 ptrdiff_t count
= SPECPDL_INDEX ();
2015 Lisp_Object tem
, cbuf
;
2017 cbuf
= Fcurrent_buffer ();
2019 if (NILP (printflag
))
2023 specbind (Qstandard_output
, tem
);
2024 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2026 /* `readevalloop' calls functions which check the type of start and end. */
2027 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
),
2028 !NILP (printflag
), Qnil
, read_function
,
2031 return unbind_to (count
, Qnil
);
2035 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2036 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2037 If STREAM is nil, use the value of `standard-input' (which see).
2038 STREAM or the value of `standard-input' may be:
2039 a buffer (read from point and advance it)
2040 a marker (read from where it points and advance it)
2041 a function (call it with no arguments for each character,
2042 call it with a char as argument to push a char back)
2043 a string (takes text from string, starting at the beginning)
2044 t (read text line using minibuffer and use it, or read from
2045 standard input in batch mode). */)
2046 (Lisp_Object stream
)
2049 stream
= Vstandard_input
;
2050 if (EQ (stream
, Qt
))
2051 stream
= Qread_char
;
2052 if (EQ (stream
, Qread_char
))
2053 /* FIXME: ?! When is this used !? */
2054 return call1 (intern ("read-minibuffer"),
2055 build_string ("Lisp expression: "));
2057 return read_internal_start (stream
, Qnil
, Qnil
);
2060 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2061 doc
: /* Read one Lisp expression which is represented as text by STRING.
2062 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2063 FINAL-STRING-INDEX is an integer giving the position of the next
2064 remaining character in STRING. START and END optionally delimit
2065 a substring of STRING from which to read; they default to 0 and
2066 \(length STRING) respectively. Negative values are counted from
2067 the end of STRING. */)
2068 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2071 CHECK_STRING (string
);
2072 /* `read_internal_start' sets `read_from_string_index'. */
2073 ret
= read_internal_start (string
, start
, end
);
2074 return Fcons (ret
, make_number (read_from_string_index
));
2077 /* Function to set up the global context we need in toplevel read
2078 calls. START and END only used when STREAM is a string. */
2080 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2085 new_backquote_flag
= 0;
2086 read_objects
= Qnil
;
2087 if (EQ (Vread_with_symbol_positions
, Qt
)
2088 || EQ (Vread_with_symbol_positions
, stream
))
2089 Vread_symbol_positions_list
= Qnil
;
2091 if (STRINGP (stream
)
2092 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2094 ptrdiff_t startval
, endval
;
2097 if (STRINGP (stream
))
2100 string
= XCAR (stream
);
2102 validate_subarray (string
, start
, end
, SCHARS (string
),
2103 &startval
, &endval
);
2105 read_from_string_index
= startval
;
2106 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2107 read_from_string_limit
= endval
;
2110 retval
= read0 (stream
);
2111 if (EQ (Vread_with_symbol_positions
, Qt
)
2112 || EQ (Vread_with_symbol_positions
, stream
))
2113 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2118 /* Signal Qinvalid_read_syntax error.
2119 S is error string of length N (if > 0) */
2121 static _Noreturn
void
2122 invalid_syntax (const char *s
)
2124 xsignal1 (Qinvalid_read_syntax
, build_string (s
));
2128 /* Use this for recursive reads, in contexts where internal tokens
2132 read0 (Lisp_Object readcharfun
)
2134 register Lisp_Object val
;
2137 val
= read1 (readcharfun
, &c
, 0);
2141 xsignal1 (Qinvalid_read_syntax
,
2142 Fmake_string (make_number (1), make_number (c
)));
2145 /* Grow a read buffer BUF that contains OFFSET useful bytes of data,
2146 by at least MAX_MULTIBYTE_LENGTH bytes. Update *BUF_ADDR and
2147 *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE. If *BUF_ADDR is
2148 initially null, BUF is on the stack: copy its data to the new heap
2149 buffer. Otherwise, BUF must equal *BUF_ADDR and can simply be
2150 reallocated. Either way, remember the heap allocation (which is at
2151 pdl slot COUNT) so that it can be freed when unwinding the stack.*/
2154 grow_read_buffer (char *buf
, ptrdiff_t offset
,
2155 char **buf_addr
, ptrdiff_t *buf_size
, ptrdiff_t count
)
2157 char *p
= xpalloc (*buf_addr
, buf_size
, MAX_MULTIBYTE_LENGTH
, -1, 1);
2160 memcpy (p
, buf
, offset
);
2161 record_unwind_protect_ptr (xfree
, p
);
2164 set_unwind_protect_ptr (count
, xfree
, p
);
2169 /* Return the scalar value that has the Unicode character name NAME.
2170 Raise 'invalid-read-syntax' if there is no such character. */
2172 character_name_to_code (char const *name
, ptrdiff_t name_len
)
2174 /* For "U+XXXX", pass the leading '+' to string_to_number to reject
2175 monstrosities like "U+-0000". */
2177 = (name
[0] == 'U' && name
[1] == '+'
2178 ? string_to_number (name
+ 1, 16, false)
2179 : call2 (Qchar_from_name
, make_unibyte_string (name
, name_len
), Qt
));
2181 if (! RANGED_INTEGERP (0, code
, MAX_UNICODE_CHAR
)
2182 || char_surrogate_p (XINT (code
)))
2184 AUTO_STRING (format
, "\\N{%s}");
2185 AUTO_STRING_WITH_LEN (namestr
, name
, name_len
);
2186 xsignal1 (Qinvalid_read_syntax
, CALLN (Fformat
, format
, namestr
));
2192 /* Bound on the length of a Unicode character name. As of
2193 Unicode 9.0.0 the maximum is 83, so this should be safe. */
2194 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND
= 200 };
2196 /* Read a \-escape sequence, assuming we already read the `\'.
2197 If the escape sequence forces unibyte, return eight-bit char. */
2200 read_escape (Lisp_Object readcharfun
, bool stringp
)
2203 /* \u allows up to four hex digits, \U up to eight. Default to the
2204 behavior for \u, and change this value in the case that \U is seen. */
2205 int unicode_hex_count
= 4;
2210 end_of_file_error ();
2240 error ("Invalid escape character syntax");
2243 c
= read_escape (readcharfun
, 0);
2244 return c
| meta_modifier
;
2249 error ("Invalid escape character syntax");
2252 c
= read_escape (readcharfun
, 0);
2253 return c
| shift_modifier
;
2258 error ("Invalid escape character syntax");
2261 c
= read_escape (readcharfun
, 0);
2262 return c
| hyper_modifier
;
2267 error ("Invalid escape character syntax");
2270 c
= read_escape (readcharfun
, 0);
2271 return c
| alt_modifier
;
2275 if (stringp
|| c
!= '-')
2282 c
= read_escape (readcharfun
, 0);
2283 return c
| super_modifier
;
2288 error ("Invalid escape character syntax");
2292 c
= read_escape (readcharfun
, 0);
2293 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2294 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2295 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2296 return c
| ctrl_modifier
;
2297 /* ASCII control chars are made from letters (both cases),
2298 as well as the non-letters within 0100...0137. */
2299 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2300 return (c
& (037 | ~0177));
2301 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2302 return (c
& (037 | ~0177));
2304 return c
| ctrl_modifier
;
2314 /* An octal escape, as in ANSI C. */
2316 register int i
= c
- '0';
2317 register int count
= 0;
2320 if ((c
= READCHAR
) >= '0' && c
<= '7')
2332 if (i
>= 0x80 && i
< 0x100)
2333 i
= BYTE8_TO_CHAR (i
);
2338 /* A hex escape, as in ANSI C. */
2345 if (c
>= '0' && c
<= '9')
2350 else if ((c
>= 'a' && c
<= 'f')
2351 || (c
>= 'A' && c
<= 'F'))
2354 if (c
>= 'a' && c
<= 'f')
2364 /* Allow hex escapes as large as ?\xfffffff, because some
2365 packages use them to denote characters with modifiers. */
2366 if ((CHAR_META
| (CHAR_META
- 1)) < i
)
2367 error ("Hex character out of range: \\x%x...", i
);
2371 if (count
< 3 && i
>= 0x80)
2372 return BYTE8_TO_CHAR (i
);
2377 /* Post-Unicode-2.0: Up to eight hex chars. */
2378 unicode_hex_count
= 8;
2381 /* A Unicode escape. We only permit them in strings and characters,
2382 not arbitrarily in the source code, as in some other languages. */
2387 while (++count
<= unicode_hex_count
)
2390 /* `isdigit' and `isalpha' may be locale-specific, which we don't
2392 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2393 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2394 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2396 error ("Non-hex digit used for Unicode escape");
2399 error ("Non-Unicode character: 0x%x", i
);
2404 /* Named character. */
2408 invalid_syntax ("Expected opening brace after \\N");
2409 char name
[UNICODE_CHARACTER_NAME_LENGTH_BOUND
+ 1];
2410 bool whitespace
= false;
2411 ptrdiff_t length
= 0;
2416 end_of_file_error ();
2419 if (! (0 < c
&& c
< 0x80))
2421 AUTO_STRING (format
,
2422 "Invalid character U+%04X in character name");
2423 xsignal1 (Qinvalid_read_syntax
,
2424 CALLN (Fformat
, format
, make_natnum (c
)));
2426 /* Treat multiple adjacent whitespace characters as a
2427 single space character. This makes it easier to use
2428 character names in e.g. multi-line strings. */
2439 if (length
>= sizeof name
)
2440 invalid_syntax ("Character name too long");
2443 invalid_syntax ("Empty character name");
2444 name
[length
] = '\0';
2446 /* character_name_to_code can invoke read1, recursively.
2447 This is why read1's buffer is not static. */
2448 return character_name_to_code (name
, length
);
2456 /* Return the digit that CHARACTER stands for in the given BASE.
2457 Return -1 if CHARACTER is out of range for BASE,
2458 and -2 if CHARACTER is not valid for any supported BASE. */
2460 digit_to_number (int character
, int base
)
2464 if ('0' <= character
&& character
<= '9')
2465 digit
= character
- '0';
2466 else if ('a' <= character
&& character
<= 'z')
2467 digit
= character
- 'a' + 10;
2468 else if ('A' <= character
&& character
<= 'Z')
2469 digit
= character
- 'A' + 10;
2473 return digit
< base
? digit
: -1;
2476 /* Read an integer in radix RADIX using READCHARFUN to read
2477 characters. RADIX must be in the interval [2..36]; if it isn't, a
2478 read error is signaled . Value is the integer read. Signals an
2479 error if encountering invalid read syntax or if RADIX is out of
2483 read_integer (Lisp_Object readcharfun
, EMACS_INT radix
)
2485 /* Room for sign, leading 0, other digits, trailing null byte.
2486 Also, room for invalid syntax diagnostic. */
2487 char buf
[max (1 + 1 + UINTMAX_WIDTH
+ 1,
2488 sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT
))];
2490 int valid
= -1; /* 1 if valid, 0 if not, -1 if incomplete. */
2492 if (radix
< 2 || radix
> 36)
2500 if (c
== '-' || c
== '+')
2511 /* Ignore redundant leading zeros, so the buffer doesn't
2512 fill up with them. */
2518 while ((digit
= digit_to_number (c
, radix
)) >= -1)
2525 if (p
< buf
+ sizeof buf
- 1)
2539 sprintf (buf
, "integer, radix %"pI
"d", radix
);
2540 invalid_syntax (buf
);
2543 return string_to_number (buf
, radix
, 0);
2547 /* If the next token is ')' or ']' or '.', we store that character
2548 in *PCH and the return value is not interesting. Else, we store
2549 zero in *PCH and we read and return one lisp object.
2551 FIRST_IN_LIST is true if this is the first element of a list. */
2554 read1 (Lisp_Object readcharfun
, int *pch
, bool first_in_list
)
2557 bool uninterned_symbol
= false;
2559 char stackbuf
[MAX_ALLOCA
];
2565 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2567 end_of_file_error ();
2572 return read_list (0, readcharfun
);
2575 return read_vector (readcharfun
, 0);
2591 /* Accept extended format for hash tables (extensible to
2593 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2594 Lisp_Object tmp
= read_list (0, readcharfun
);
2595 Lisp_Object head
= CAR_SAFE (tmp
);
2596 Lisp_Object data
= Qnil
;
2597 Lisp_Object val
= Qnil
;
2598 /* The size is 2 * number of allowed keywords to
2600 Lisp_Object params
[12];
2602 Lisp_Object key
= Qnil
;
2603 int param_count
= 0;
2605 if (!EQ (head
, Qhash_table
))
2607 ptrdiff_t size
= XINT (Flength (tmp
));
2608 Lisp_Object record
= Fmake_record (CAR_SAFE (tmp
),
2609 make_number (size
- 1),
2611 for (int i
= 1; i
< size
; i
++)
2614 ASET (record
, i
, Fcar (tmp
));
2619 tmp
= CDR_SAFE (tmp
);
2621 /* This is repetitive but fast and simple. */
2622 params
[param_count
] = QCsize
;
2623 params
[param_count
+ 1] = Fplist_get (tmp
, Qsize
);
2624 if (!NILP (params
[param_count
+ 1]))
2627 params
[param_count
] = QCtest
;
2628 params
[param_count
+ 1] = Fplist_get (tmp
, Qtest
);
2629 if (!NILP (params
[param_count
+ 1]))
2632 params
[param_count
] = QCweakness
;
2633 params
[param_count
+ 1] = Fplist_get (tmp
, Qweakness
);
2634 if (!NILP (params
[param_count
+ 1]))
2637 params
[param_count
] = QCrehash_size
;
2638 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_size
);
2639 if (!NILP (params
[param_count
+ 1]))
2642 params
[param_count
] = QCrehash_threshold
;
2643 params
[param_count
+ 1] = Fplist_get (tmp
, Qrehash_threshold
);
2644 if (!NILP (params
[param_count
+ 1]))
2647 params
[param_count
] = QCpurecopy
;
2648 params
[param_count
+ 1] = Fplist_get (tmp
, Qpurecopy
);
2649 if (!NILP (params
[param_count
+ 1]))
2652 /* This is the hash table data. */
2653 data
= Fplist_get (tmp
, Qdata
);
2655 /* Now use params to make a new hash table and fill it. */
2656 ht
= Fmake_hash_table (param_count
, params
);
2658 while (CONSP (data
))
2663 error ("Odd number of elements in hash table data");
2666 Fputhash (key
, val
, ht
);
2672 invalid_syntax ("#");
2680 tmp
= read_vector (readcharfun
, 0);
2681 if (ASIZE (tmp
) < CHAR_TABLE_STANDARD_SLOTS
)
2682 error ("Invalid size char-table");
2683 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2691 /* Sub char-table can't be read as a regular
2692 vector because of a two C integer fields. */
2693 Lisp_Object tbl
, tmp
= read_list (1, readcharfun
);
2694 ptrdiff_t size
= XINT (Flength (tmp
));
2695 int i
, depth
, min_char
;
2696 struct Lisp_Cons
*cell
;
2699 error ("Zero-sized sub char-table");
2701 if (! RANGED_INTEGERP (1, XCAR (tmp
), 3))
2702 error ("Invalid depth in sub char-table");
2703 depth
= XINT (XCAR (tmp
));
2704 if (chartab_size
[depth
] != size
- 2)
2705 error ("Invalid size in sub char-table");
2706 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2709 if (! RANGED_INTEGERP (0, XCAR (tmp
), MAX_CHAR
))
2710 error ("Invalid minimum character in sub-char-table");
2711 min_char
= XINT (XCAR (tmp
));
2712 cell
= XCONS (tmp
), tmp
= XCDR (tmp
), size
--;
2715 tbl
= make_uninit_sub_char_table (depth
, min_char
);
2716 for (i
= 0; i
< size
; i
++)
2718 XSUB_CHAR_TABLE (tbl
)->contents
[i
] = XCAR (tmp
);
2719 cell
= XCONS (tmp
), tmp
= XCDR (tmp
);
2724 invalid_syntax ("#^^");
2726 invalid_syntax ("#^");
2731 length
= read1 (readcharfun
, pch
, first_in_list
);
2735 Lisp_Object tmp
, val
;
2736 EMACS_INT size_in_chars
= bool_vector_bytes (XFASTINT (length
));
2737 unsigned char *data
;
2740 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2741 if (STRING_MULTIBYTE (tmp
)
2742 || (size_in_chars
!= SCHARS (tmp
)
2743 /* We used to print 1 char too many
2744 when the number of bits was a multiple of 8.
2745 Accept such input in case it came from an old
2747 && ! (XFASTINT (length
)
2748 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2749 invalid_syntax ("#&...");
2751 val
= make_uninit_bool_vector (XFASTINT (length
));
2752 data
= bool_vector_uchar_data (val
);
2753 memcpy (data
, SDATA (tmp
), size_in_chars
);
2754 /* Clear the extraneous bits in the last byte. */
2755 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2756 data
[size_in_chars
- 1]
2757 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2760 invalid_syntax ("#&...");
2764 /* Accept compiled functions at read-time so that we don't have to
2765 build them using function calls. */
2767 struct Lisp_Vector
*vec
;
2768 tmp
= read_vector (readcharfun
, 1);
2769 vec
= XVECTOR (tmp
);
2770 if (vec
->header
.size
== 0)
2771 invalid_syntax ("Empty byte-code object");
2772 make_byte_code (vec
);
2780 /* Read the string itself. */
2781 tmp
= read1 (readcharfun
, &ch
, 0);
2782 if (ch
!= 0 || !STRINGP (tmp
))
2783 invalid_syntax ("#");
2784 /* Read the intervals and their properties. */
2787 Lisp_Object beg
, end
, plist
;
2789 beg
= read1 (readcharfun
, &ch
, 0);
2794 end
= read1 (readcharfun
, &ch
, 0);
2796 plist
= read1 (readcharfun
, &ch
, 0);
2798 invalid_syntax ("Invalid string property list");
2799 Fset_text_properties (beg
, end
, plist
, tmp
);
2805 /* #@NUMBER is used to skip NUMBER following bytes.
2806 That's used in .elc files to skip over doc strings
2807 and function definitions. */
2810 enum { extra
= 100 };
2811 ptrdiff_t i
, nskip
= 0, digits
= 0;
2813 /* Read a decimal integer. */
2814 while ((c
= READCHAR
) >= 0
2815 && c
>= '0' && c
<= '9')
2817 if ((STRING_BYTES_BOUND
- extra
) / 10 <= nskip
)
2822 if (digits
== 2 && nskip
== 0)
2823 { /* We've just seen #@00, which means "skip to end". */
2824 skip_dyn_eof (readcharfun
);
2829 /* We can't use UNREAD here, because in the code below we side-step
2830 READCHAR. Instead, assume the first char after #@NNN occupies
2831 a single byte, which is the case normally since it's just
2837 if (load_force_doc_strings
2838 && (FROM_FILE_P (readcharfun
)))
2840 /* If we are supposed to force doc strings into core right now,
2841 record the last string that we skipped,
2842 and record where in the file it comes from. */
2844 /* But first exchange saved_doc_string
2845 with prev_saved_doc_string, so we save two strings. */
2847 char *temp
= saved_doc_string
;
2848 ptrdiff_t temp_size
= saved_doc_string_size
;
2849 file_offset temp_pos
= saved_doc_string_position
;
2850 ptrdiff_t temp_len
= saved_doc_string_length
;
2852 saved_doc_string
= prev_saved_doc_string
;
2853 saved_doc_string_size
= prev_saved_doc_string_size
;
2854 saved_doc_string_position
= prev_saved_doc_string_position
;
2855 saved_doc_string_length
= prev_saved_doc_string_length
;
2857 prev_saved_doc_string
= temp
;
2858 prev_saved_doc_string_size
= temp_size
;
2859 prev_saved_doc_string_position
= temp_pos
;
2860 prev_saved_doc_string_length
= temp_len
;
2863 if (saved_doc_string_size
== 0)
2865 saved_doc_string
= xmalloc (nskip
+ extra
);
2866 saved_doc_string_size
= nskip
+ extra
;
2868 if (nskip
> saved_doc_string_size
)
2870 saved_doc_string
= xrealloc (saved_doc_string
, nskip
+ extra
);
2871 saved_doc_string_size
= nskip
+ extra
;
2874 saved_doc_string_position
= file_tell (instream
);
2876 /* Copy that many characters into saved_doc_string. */
2878 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2879 saved_doc_string
[i
] = c
= getc (instream
);
2882 saved_doc_string_length
= i
;
2885 /* Skip that many bytes. */
2886 skip_dyn_bytes (readcharfun
, nskip
);
2892 /* #! appears at the beginning of an executable file.
2893 Skip the first line. */
2894 while (c
!= '\n' && c
>= 0)
2899 return Vload_file_name
;
2901 return list2 (Qfunction
, read0 (readcharfun
));
2902 /* #:foo is the uninterned symbol named foo. */
2905 uninterned_symbol
= true;
2908 && c
!= NO_BREAK_SPACE
2910 || strchr ("\"';()[]#`,", c
) == NULL
)))
2912 /* No symbol character follows, this is the empty
2915 return Fmake_symbol (empty_unibyte_string
);
2919 /* ## is the empty symbol. */
2921 return Fintern (empty_unibyte_string
, Qnil
);
2922 /* Reader forms that can reuse previously read objects. */
2923 if (c
>= '0' && c
<= '9')
2927 bool overflow
= false;
2929 /* Read a non-negative integer. */
2930 while (c
>= '0' && c
<= '9')
2932 overflow
|= INT_MULTIPLY_WRAPV (n
, 10, &n
);
2933 overflow
|= INT_ADD_WRAPV (n
, c
- '0', &n
);
2937 if (!overflow
&& n
<= MOST_POSITIVE_FIXNUM
)
2939 if (c
== 'r' || c
== 'R')
2940 return read_integer (readcharfun
, n
);
2942 if (! NILP (Vread_circle
))
2944 /* #n=object returns object, but associates it with
2948 /* Make a placeholder for #n# to use temporarily. */
2949 /* Note: We used to use AUTO_CONS to allocate
2950 placeholder, but that is a bad idea, since it
2951 will place a stack-allocated cons cell into
2952 the list in read_objects, which is a
2953 staticpro'd global variable, and thus each of
2954 its elements is marked during each GC. A
2955 stack-allocated object will become garbled
2956 when its stack slot goes out of scope, and
2957 some other function reuses it for entirely
2958 different purposes, which will cause crashes
2960 Lisp_Object placeholder
= Fcons (Qnil
, Qnil
);
2961 Lisp_Object cell
= Fcons (make_number (n
), placeholder
);
2962 read_objects
= Fcons (cell
, read_objects
);
2964 /* Read the object itself. */
2965 tem
= read0 (readcharfun
);
2967 /* Now put it everywhere the placeholder was... */
2968 Fsubstitute_object_in_subtree (tem
, placeholder
);
2970 /* ...and #n# will use the real value from now on. */
2971 Fsetcdr (cell
, tem
);
2976 /* #n# returns a previously read object. */
2979 tem
= Fassq (make_number (n
), read_objects
);
2985 /* Fall through to error message. */
2987 else if (c
== 'x' || c
== 'X')
2988 return read_integer (readcharfun
, 16);
2989 else if (c
== 'o' || c
== 'O')
2990 return read_integer (readcharfun
, 8);
2991 else if (c
== 'b' || c
== 'B')
2992 return read_integer (readcharfun
, 2);
2995 invalid_syntax ("#");
2998 while ((c
= READCHAR
) >= 0 && c
!= '\n');
3002 return list2 (Qquote
, read0 (readcharfun
));
3006 int next_char
= READCHAR
;
3008 /* Transition from old-style to new-style:
3009 If we see "(`" it used to mean old-style, which usually works
3010 fine because ` should almost never appear in such a position
3011 for new-style. But occasionally we need "(`" to mean new
3012 style, so we try to distinguish the two by the fact that we
3013 can either write "( `foo" or "(` foo", where the first
3014 intends to use new-style whereas the second intends to use
3015 old-style. For Emacs-25, we should completely remove this
3016 first_in_list exception (old-style can still be obtained via
3018 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
3020 Vold_style_backquotes
= Qt
;
3026 bool saved_new_backquote_flag
= new_backquote_flag
;
3028 new_backquote_flag
= 1;
3029 value
= read0 (readcharfun
);
3030 new_backquote_flag
= saved_new_backquote_flag
;
3032 return list2 (Qbackquote
, value
);
3037 int next_char
= READCHAR
;
3039 /* Transition from old-style to new-style:
3040 It used to be impossible to have a new-style , other than within
3041 a new-style `. This is sufficient when ` and , are used in the
3042 normal way, but ` and , can also appear in args to macros that
3043 will not interpret them in the usual way, in which case , may be
3044 used without any ` anywhere near.
3045 So we now use the same heuristic as for backquote: old-style
3046 unquotes are only recognized when first on a list, and when
3047 followed by a space.
3048 Because it's more difficult to peek 2 chars ahead, a new-style
3049 ,@ can still not be used outside of a `, unless it's in the middle
3051 if (new_backquote_flag
3053 || (next_char
!= ' ' && next_char
!= '@'))
3055 Lisp_Object comma_type
= Qnil
;
3060 comma_type
= Qcomma_at
;
3062 comma_type
= Qcomma_dot
;
3065 if (ch
>= 0) UNREAD (ch
);
3066 comma_type
= Qcomma
;
3069 value
= read0 (readcharfun
);
3070 return list2 (comma_type
, value
);
3074 Vold_style_backquotes
= Qt
;
3086 end_of_file_error ();
3088 /* Accept `single space' syntax like (list ? x) where the
3089 whitespace character is SPC or TAB.
3090 Other literal whitespace like NL, CR, and FF are not accepted,
3091 as there are well-established escape sequences for these. */
3092 if (c
== ' ' || c
== '\t')
3093 return make_number (c
);
3096 c
= read_escape (readcharfun
, 0);
3097 modifiers
= c
& CHAR_MODIFIER_MASK
;
3098 c
&= ~CHAR_MODIFIER_MASK
;
3099 if (CHAR_BYTE8_P (c
))
3100 c
= CHAR_TO_BYTE8 (c
);
3103 next_char
= READCHAR
;
3104 ok
= (next_char
<= 040
3105 || (next_char
< 0200
3106 && strchr ("\"';()[]#?`,.", next_char
) != NULL
));
3109 return make_number (c
);
3111 invalid_syntax ("?");
3116 ptrdiff_t count
= SPECPDL_INDEX ();
3117 char *read_buffer
= stackbuf
;
3118 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3119 char *heapbuf
= NULL
;
3120 char *p
= read_buffer
;
3121 char *end
= read_buffer
+ read_buffer_size
;
3123 /* True if we saw an escape sequence specifying
3124 a multibyte character. */
3125 bool force_multibyte
= false;
3126 /* True if we saw an escape sequence specifying
3127 a single-byte character. */
3128 bool force_singlebyte
= false;
3129 bool cancel
= false;
3130 ptrdiff_t nchars
= 0;
3132 while ((ch
= READCHAR
) >= 0
3135 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3137 ptrdiff_t offset
= p
- read_buffer
;
3138 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3139 &heapbuf
, &read_buffer_size
,
3141 p
= read_buffer
+ offset
;
3142 end
= read_buffer
+ read_buffer_size
;
3149 ch
= read_escape (readcharfun
, 1);
3151 /* CH is -1 if \ newline or \ space has just been seen. */
3154 if (p
== read_buffer
)
3159 modifiers
= ch
& CHAR_MODIFIER_MASK
;
3160 ch
= ch
& ~CHAR_MODIFIER_MASK
;
3162 if (CHAR_BYTE8_P (ch
))
3163 force_singlebyte
= true;
3164 else if (! ASCII_CHAR_P (ch
))
3165 force_multibyte
= true;
3166 else /* I.e. ASCII_CHAR_P (ch). */
3168 /* Allow `\C- ' and `\C-?'. */
3169 if (modifiers
== CHAR_CTL
)
3172 ch
= 0, modifiers
= 0;
3174 ch
= 127, modifiers
= 0;
3176 if (modifiers
& CHAR_SHIFT
)
3178 /* Shift modifier is valid only with [A-Za-z]. */
3179 if (ch
>= 'A' && ch
<= 'Z')
3180 modifiers
&= ~CHAR_SHIFT
;
3181 else if (ch
>= 'a' && ch
<= 'z')
3182 ch
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
3185 if (modifiers
& CHAR_META
)
3187 /* Move the meta bit to the right place for a
3189 modifiers
&= ~CHAR_META
;
3190 ch
= BYTE8_TO_CHAR (ch
| 0x80);
3191 force_singlebyte
= true;
3195 /* Any modifiers remaining are invalid. */
3197 error ("Invalid modifier in string");
3198 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3202 p
+= CHAR_STRING (ch
, (unsigned char *) p
);
3203 if (CHAR_BYTE8_P (ch
))
3204 force_singlebyte
= true;
3205 else if (! ASCII_CHAR_P (ch
))
3206 force_multibyte
= true;
3212 end_of_file_error ();
3214 /* If purifying, and string starts with \ newline,
3215 return zero instead. This is for doc strings
3216 that we are really going to find in etc/DOC.nn.nn. */
3217 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3218 return unbind_to (count
, make_number (0));
3220 if (! force_multibyte
&& force_singlebyte
)
3222 /* READ_BUFFER contains raw 8-bit bytes and no multibyte
3223 forms. Convert it to unibyte. */
3224 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
3226 p
= read_buffer
+ nchars
;
3230 = make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3232 || (p
- read_buffer
!= nchars
)));
3233 return unbind_to (count
, result
);
3238 int next_char
= READCHAR
;
3241 if (next_char
<= 040
3242 || (next_char
< 0200
3243 && strchr ("\"';([#?`,", next_char
) != NULL
))
3249 /* Otherwise, we fall through! Note that the atom-reading loop
3250 below will now loop at least once, assuring that we will not
3251 try to UNREAD two characters in a row. */
3255 if (c
<= 040) goto retry
;
3256 if (c
== NO_BREAK_SPACE
)
3261 ptrdiff_t count
= SPECPDL_INDEX ();
3262 char *read_buffer
= stackbuf
;
3263 ptrdiff_t read_buffer_size
= sizeof stackbuf
;
3264 char *heapbuf
= NULL
;
3265 char *p
= read_buffer
;
3266 char *end
= read_buffer
+ read_buffer_size
;
3267 bool quoted
= false;
3268 EMACS_INT start_position
= readchar_count
- 1;
3272 if (end
- p
< MAX_MULTIBYTE_LENGTH
+ 1)
3274 ptrdiff_t offset
= p
- read_buffer
;
3275 read_buffer
= grow_read_buffer (read_buffer
, offset
,
3276 &heapbuf
, &read_buffer_size
,
3278 p
= read_buffer
+ offset
;
3279 end
= read_buffer
+ read_buffer_size
;
3286 end_of_file_error ();
3291 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3297 && c
!= NO_BREAK_SPACE
3299 || strchr ("\"';()[]#`,", c
) == NULL
));
3304 if (!quoted
&& !uninterned_symbol
)
3306 Lisp_Object result
= string_to_number (read_buffer
, 10, 0);
3307 if (! NILP (result
))
3308 return unbind_to (count
, result
);
3311 ptrdiff_t nbytes
= p
- read_buffer
;
3314 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
3317 Lisp_Object name
= ((uninterned_symbol
&& ! NILP (Vpurify_flag
)
3318 ? make_pure_string
: make_specified_string
)
3319 (read_buffer
, nchars
, nbytes
, multibyte
));
3320 Lisp_Object result
= (uninterned_symbol
? Fmake_symbol (name
)
3321 : Fintern (name
, Qnil
));
3323 if (EQ (Vread_with_symbol_positions
, Qt
)
3324 || EQ (Vread_with_symbol_positions
, readcharfun
))
3325 Vread_symbol_positions_list
3326 = Fcons (Fcons (result
, make_number (start_position
)),
3327 Vread_symbol_positions_list
);
3328 return unbind_to (count
, result
);
3334 /* List of nodes we've seen during substitute_object_in_subtree. */
3335 static Lisp_Object seen_list
;
3337 DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree
,
3338 Ssubstitute_object_in_subtree
, 2, 2, 0,
3339 doc
: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT. */)
3340 (Lisp_Object object
, Lisp_Object placeholder
)
3342 Lisp_Object check_object
;
3344 /* We haven't seen any objects when we start. */
3347 /* Make all the substitutions. */
3349 = substitute_object_recurse (object
, placeholder
, object
);
3351 /* Clear seen_list because we're done with it. */
3354 /* The returned object here is expected to always eq the
3356 if (!EQ (check_object
, object
))
3357 error ("Unexpected mutation error in reader");
3361 /* Feval doesn't get called from here, so no gc protection is needed. */
3362 #define SUBSTITUTE(get_val, set_val) \
3364 Lisp_Object old_value = get_val; \
3365 Lisp_Object true_value \
3366 = substitute_object_recurse (object, placeholder, \
3369 if (!EQ (old_value, true_value)) \
3376 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3378 /* If we find the placeholder, return the target object. */
3379 if (EQ (placeholder
, subtree
))
3382 /* If we've been to this node before, don't explore it again. */
3383 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3386 /* If this node can be the entry point to a cycle, remember that
3387 we've seen it. It can only be such an entry point if it was made
3388 by #n=, which means that we can find it as a value in
3390 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3391 seen_list
= Fcons (subtree
, seen_list
);
3393 /* Recurse according to subtree's type.
3394 Every branch must return a Lisp_Object. */
3395 switch (XTYPE (subtree
))
3397 case Lisp_Vectorlike
:
3399 ptrdiff_t i
= 0, length
= 0;
3400 if (BOOL_VECTOR_P (subtree
))
3401 return subtree
; /* No sub-objects anyway. */
3402 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3403 || COMPILEDP (subtree
) || HASH_TABLE_P (subtree
))
3404 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3405 else if (VECTORP (subtree
))
3406 length
= ASIZE (subtree
);
3408 /* An unknown pseudovector may contain non-Lisp fields, so we
3409 can't just blindly traverse all its fields. We used to call
3410 `Flength' which signaled `sequencep', so I just preserved this
3412 wrong_type_argument (Qsequencep
, subtree
);
3414 if (SUB_CHAR_TABLE_P (subtree
))
3416 for ( ; i
< length
; i
++)
3417 SUBSTITUTE (AREF (subtree
, i
),
3418 ASET (subtree
, i
, true_value
));
3424 SUBSTITUTE (XCAR (subtree
),
3425 XSETCAR (subtree
, true_value
));
3426 SUBSTITUTE (XCDR (subtree
),
3427 XSETCDR (subtree
, true_value
));
3433 /* Check for text properties in each interval.
3434 substitute_in_interval contains part of the logic. */
3436 INTERVAL root_interval
= string_intervals (subtree
);
3437 AUTO_CONS (arg
, object
, placeholder
);
3439 traverse_intervals_noorder (root_interval
,
3440 &substitute_in_interval
, arg
);
3445 /* Other types don't recurse any further. */
3451 /* Helper function for substitute_object_recurse. */
3453 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3455 Lisp_Object object
= Fcar (arg
);
3456 Lisp_Object placeholder
= Fcdr (arg
);
3458 SUBSTITUTE (interval
->plist
, set_interval_plist (interval
, true_value
));
3468 /* Convert STRING to a number, assuming base BASE. Return a fixnum if CP has
3469 integer syntax and fits in a fixnum, else return the nearest float if CP has
3470 either floating point or integer syntax and BASE is 10, else return nil. If
3471 IGNORE_TRAILING, consider just the longest prefix of CP that has
3472 valid floating point syntax. Signal an overflow if BASE is not 10 and the
3473 number has integer syntax but does not fit. */
3476 string_to_number (char const *string
, int base
, bool ignore_trailing
)
3479 char const *cp
= string
;
3481 bool float_syntax
= 0;
3484 /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
3485 IEEE floating point hosts, and works around a formerly-common bug where
3486 atof ("-0.0") drops the sign. */
3487 bool negative
= *cp
== '-';
3489 bool signedp
= negative
|| *cp
== '+';
3494 leading_digit
= digit_to_number (*cp
, base
);
3495 if (leading_digit
>= 0)
3500 while (digit_to_number (*cp
, base
) >= 0);
3510 if ('0' <= *cp
&& *cp
<= '9')
3515 while ('0' <= *cp
&& *cp
<= '9');
3517 if (*cp
== 'e' || *cp
== 'E')
3519 char const *ecp
= cp
;
3521 if (*cp
== '+' || *cp
== '-')
3523 if ('0' <= *cp
&& *cp
<= '9')
3528 while ('0' <= *cp
&& *cp
<= '9');
3530 else if (cp
[-1] == '+'
3531 && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3537 else if (cp
[-1] == '+'
3538 && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3542 /* NAN is a "positive" NaN on all known Emacs hosts. */
3549 float_syntax
= ((state
& (DOT_CHAR
|TRAIL_INT
)) == (DOT_CHAR
|TRAIL_INT
)
3550 || state
== (LEAD_INT
|E_EXP
));
3553 /* Return nil if the number uses invalid syntax. If IGNORE_TRAILING, accept
3554 any prefix that matches. Otherwise, the entire string must match. */
3555 if (! (ignore_trailing
3556 ? ((state
& LEAD_INT
) != 0 || float_syntax
)
3557 : (!*cp
&& ((state
& ~DOT_CHAR
) == LEAD_INT
|| float_syntax
))))
3560 /* If the number uses integer and not float syntax, and is in C-language
3561 range, use its value, preferably as a fixnum. */
3562 if (leading_digit
>= 0 && ! float_syntax
)
3566 /* Fast special case for single-digit integers. This also avoids a
3567 glitch when BASE is 16 and IGNORE_TRAILING, because in that
3568 case some versions of strtoumax accept numbers like "0x1" that Emacs
3570 if (digit_to_number (string
[signedp
+ 1], base
) < 0)
3571 return make_number (negative
? -leading_digit
: leading_digit
);
3574 n
= strtoumax (string
+ signedp
, NULL
, base
);
3575 if (errno
== ERANGE
)
3577 /* Unfortunately there's no simple and accurate way to convert
3578 non-base-10 numbers that are out of C-language range. */
3580 xsignal1 (Qoverflow_error
, build_string (string
));
3582 else if (n
<= (negative
? -MOST_NEGATIVE_FIXNUM
: MOST_POSITIVE_FIXNUM
))
3584 EMACS_INT signed_n
= n
;
3585 return make_number (negative
? -signed_n
: signed_n
);
3591 /* Either the number uses float syntax, or it does not fit into a fixnum.
3592 Convert it from string to floating point, unless the value is already
3593 known because it is an infinity, a NAN, or its absolute value fits in
3596 value
= atof (string
+ signedp
);
3598 return make_float (negative
? -value
: value
);
3603 read_vector (Lisp_Object readcharfun
, bool bytecodeflag
)
3607 Lisp_Object tem
, item
, vector
;
3608 struct Lisp_Cons
*otem
;
3611 tem
= read_list (1, readcharfun
);
3612 len
= Flength (tem
);
3613 vector
= Fmake_vector (len
, Qnil
);
3615 size
= ASIZE (vector
);
3616 ptr
= XVECTOR (vector
)->contents
;
3617 for (i
= 0; i
< size
; i
++)
3620 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3621 bytecode object, the docstring containing the bytecode and
3622 constants values must be treated as unibyte and passed to
3623 Fread, to get the actual bytecode string and constants vector. */
3624 if (bytecodeflag
&& load_force_doc_strings
)
3626 if (i
== COMPILED_BYTECODE
)
3628 if (!STRINGP (item
))
3629 error ("Invalid byte code");
3631 /* Delay handling the bytecode slot until we know whether
3632 it is lazily-loaded (we can tell by whether the
3633 constants slot is nil). */
3634 ASET (vector
, COMPILED_CONSTANTS
, item
);
3637 else if (i
== COMPILED_CONSTANTS
)
3639 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3643 /* Coerce string to unibyte (like string-as-unibyte,
3644 but without generating extra garbage and
3645 guaranteeing no change in the contents). */
3646 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3647 STRING_SET_UNIBYTE (bytestr
);
3649 item
= Fread (Fcons (bytestr
, readcharfun
));
3651 error ("Invalid byte code");
3653 otem
= XCONS (item
);
3654 bytestr
= XCAR (item
);
3659 /* Now handle the bytecode slot. */
3660 ASET (vector
, COMPILED_BYTECODE
, bytestr
);
3662 else if (i
== COMPILED_DOC_STRING
3664 && ! STRING_MULTIBYTE (item
))
3666 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3667 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3669 item
= Fstring_as_multibyte (item
);
3672 ASET (vector
, i
, item
);
3680 /* FLAG means check for ']' to terminate rather than ')' and '.'. */
3683 read_list (bool flag
, Lisp_Object readcharfun
)
3685 Lisp_Object val
, tail
;
3686 Lisp_Object elt
, tem
;
3687 /* 0 is the normal case.
3688 1 means this list is a doc reference; replace it with the number 0.
3689 2 means this list is a doc reference; replace it with the doc string. */
3690 int doc_reference
= 0;
3692 /* Initialize this to 1 if we are reading a list. */
3693 bool first_in_list
= flag
<= 0;
3701 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3705 /* While building, if the list starts with #$, treat it specially. */
3706 if (EQ (elt
, Vload_file_name
)
3708 && !NILP (Vpurify_flag
))
3710 if (NILP (Vdoc_file_name
))
3711 /* We have not yet called Snarf-documentation, so assume
3712 this file is described in the DOC file
3713 and Snarf-documentation will fill in the right value later.
3714 For now, replace the whole list with 0. */
3717 /* We have already called Snarf-documentation, so make a relative
3718 file name for this file, so it can be found properly
3719 in the installed Lisp directory.
3720 We don't use Fexpand_file_name because that would make
3721 the directory absolute now. */
3723 AUTO_STRING (dot_dot_lisp
, "../lisp/");
3724 elt
= concat2 (dot_dot_lisp
, Ffile_name_nondirectory (elt
));
3727 else if (EQ (elt
, Vload_file_name
)
3729 && load_force_doc_strings
)
3738 invalid_syntax (") or . in a vector");
3745 XSETCDR (tail
, read0 (readcharfun
));
3747 val
= read0 (readcharfun
);
3748 read1 (readcharfun
, &ch
, 0);
3752 if (doc_reference
== 1)
3753 return make_number (0);
3754 if (doc_reference
== 2 && INTEGERP (XCDR (val
)))
3757 file_offset saved_position
;
3758 /* Get a doc string from the file we are loading.
3759 If it's in saved_doc_string, get it from there.
3761 Here, we don't know if the string is a
3762 bytecode string or a doc string. As a
3763 bytecode string must be unibyte, we always
3764 return a unibyte string. If it is actually a
3765 doc string, caller must make it
3768 /* Position is negative for user variables. */
3769 EMACS_INT pos
= eabs (XINT (XCDR (val
)));
3770 if (pos
>= saved_doc_string_position
3771 && pos
< (saved_doc_string_position
3772 + saved_doc_string_length
))
3774 saved
= saved_doc_string
;
3775 saved_position
= saved_doc_string_position
;
3777 /* Look in prev_saved_doc_string the same way. */
3778 else if (pos
>= prev_saved_doc_string_position
3779 && pos
< (prev_saved_doc_string_position
3780 + prev_saved_doc_string_length
))
3782 saved
= prev_saved_doc_string
;
3783 saved_position
= prev_saved_doc_string_position
;
3787 ptrdiff_t start
= pos
- saved_position
;
3790 /* Process quoting with ^A,
3791 and find the end of the string,
3792 which is marked with ^_ (037). */
3793 for (from
= start
, to
= start
;
3794 saved
[from
] != 037;)
3796 int c
= saved
[from
++];
3800 saved
[to
++] = (c
== 1 ? c
3809 return make_unibyte_string (saved
+ start
,
3813 return get_doc_string (val
, 1, 0);
3818 invalid_syntax (". in wrong context");
3820 invalid_syntax ("] in a list");
3824 XSETCDR (tail
, tem
);
3831 static Lisp_Object initial_obarray
;
3833 /* `oblookup' stores the bucket number here, for the sake of Funintern. */
3835 static size_t oblookup_last_bucket_number
;
3837 /* Get an error if OBARRAY is not an obarray.
3838 If it is one, return it. */
3841 check_obarray (Lisp_Object obarray
)
3843 /* We don't want to signal a wrong-type-argument error when we are
3844 shutting down due to a fatal error, and we don't want to hit
3845 assertions in VECTORP and ASIZE if the fatal error was during GC. */
3846 if (!fatal_error_in_progress
3847 && (!VECTORP (obarray
) || ASIZE (obarray
) == 0))
3849 /* If Vobarray is now invalid, force it to be valid. */
3850 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3851 wrong_type_argument (Qvectorp
, obarray
);
3856 /* Intern symbol SYM in OBARRAY using bucket INDEX. */
3859 intern_sym (Lisp_Object sym
, Lisp_Object obarray
, Lisp_Object index
)
3863 XSYMBOL (sym
)->interned
= (EQ (obarray
, initial_obarray
)
3864 ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
3867 if (SREF (SYMBOL_NAME (sym
), 0) == ':' && EQ (obarray
, initial_obarray
))
3869 make_symbol_constant (sym
);
3870 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3871 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3874 ptr
= aref_addr (obarray
, XINT (index
));
3875 set_symbol_next (sym
, SYMBOLP (*ptr
) ? XSYMBOL (*ptr
) : NULL
);
3880 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
3883 intern_driver (Lisp_Object string
, Lisp_Object obarray
, Lisp_Object index
)
3885 return intern_sym (Fmake_symbol (string
), obarray
, index
);
3888 /* Intern the C string STR: return a symbol with that name,
3889 interned in the current obarray. */
3892 intern_1 (const char *str
, ptrdiff_t len
)
3894 Lisp_Object obarray
= check_obarray (Vobarray
);
3895 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3897 return (SYMBOLP (tem
) ? tem
3898 /* The above `oblookup' was done on the basis of nchars==nbytes, so
3899 the string has to be unibyte. */
3900 : intern_driver (make_unibyte_string (str
, len
),
3905 intern_c_string_1 (const char *str
, ptrdiff_t len
)
3907 Lisp_Object obarray
= check_obarray (Vobarray
);
3908 Lisp_Object tem
= oblookup (obarray
, str
, len
, len
);
3912 /* Creating a non-pure string from a string literal not implemented yet.
3913 We could just use make_string here and live with the extra copy. */
3914 eassert (!NILP (Vpurify_flag
));
3915 tem
= intern_driver (make_pure_c_string (str
, len
), obarray
, tem
);
3921 define_symbol (Lisp_Object sym
, char const *str
)
3923 ptrdiff_t len
= strlen (str
);
3924 Lisp_Object string
= make_pure_c_string (str
, len
);
3925 init_symbol (sym
, string
);
3927 /* Qunbound is uninterned, so that it's not confused with any symbol
3928 'unbound' created by a Lisp program. */
3929 if (! EQ (sym
, Qunbound
))
3931 Lisp_Object bucket
= oblookup (initial_obarray
, str
, len
, len
);
3932 eassert (INTEGERP (bucket
));
3933 intern_sym (sym
, initial_obarray
, bucket
);
3937 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3938 doc
: /* Return the canonical symbol whose name is STRING.
3939 If there is none, one is created by this function and returned.
3940 A second optional argument specifies the obarray to use;
3941 it defaults to the value of `obarray'. */)
3942 (Lisp_Object string
, Lisp_Object obarray
)
3946 obarray
= check_obarray (NILP (obarray
) ? Vobarray
: obarray
);
3947 CHECK_STRING (string
);
3949 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3951 tem
= intern_driver (NILP (Vpurify_flag
) ? string
: Fpurecopy (string
),
3956 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3957 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3958 NAME may be a string or a symbol. If it is a symbol, that exact
3959 symbol is searched for.
3960 A second optional argument specifies the obarray to use;
3961 it defaults to the value of `obarray'. */)
3962 (Lisp_Object name
, Lisp_Object obarray
)
3964 register Lisp_Object tem
, string
;
3966 if (NILP (obarray
)) obarray
= Vobarray
;
3967 obarray
= check_obarray (obarray
);
3969 if (!SYMBOLP (name
))
3971 CHECK_STRING (name
);
3975 string
= SYMBOL_NAME (name
);
3977 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3978 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3984 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3985 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3986 The value is t if a symbol was found and deleted, nil otherwise.
3987 NAME may be a string or a symbol. If it is a symbol, that symbol
3988 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3989 OBARRAY, if nil, defaults to the value of the variable `obarray'.
3990 usage: (unintern NAME OBARRAY) */)
3991 (Lisp_Object name
, Lisp_Object obarray
)
3993 register Lisp_Object string
, tem
;
3996 if (NILP (obarray
)) obarray
= Vobarray
;
3997 obarray
= check_obarray (obarray
);
4000 string
= SYMBOL_NAME (name
);
4003 CHECK_STRING (name
);
4007 tem
= oblookup (obarray
, SSDATA (string
),
4012 /* If arg was a symbol, don't delete anything but that symbol itself. */
4013 if (SYMBOLP (name
) && !EQ (name
, tem
))
4016 /* There are plenty of other symbols which will screw up the Emacs
4017 session if we unintern them, as well as even more ways to use
4018 `setq' or `fset' or whatnot to make the Emacs session
4019 unusable. Let's not go down this silly road. --Stef */
4020 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
4021 error ("Attempt to unintern t or nil"); */
4023 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
4025 hash
= oblookup_last_bucket_number
;
4027 if (EQ (AREF (obarray
, hash
), tem
))
4029 if (XSYMBOL (tem
)->next
)
4032 XSETSYMBOL (sym
, XSYMBOL (tem
)->next
);
4033 ASET (obarray
, hash
, sym
);
4036 ASET (obarray
, hash
, make_number (0));
4040 Lisp_Object tail
, following
;
4042 for (tail
= AREF (obarray
, hash
);
4043 XSYMBOL (tail
)->next
;
4046 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
4047 if (EQ (following
, tem
))
4049 set_symbol_next (tail
, XSYMBOL (following
)->next
);
4058 /* Return the symbol in OBARRAY whose names matches the string
4059 of SIZE characters (SIZE_BYTE bytes) at PTR.
4060 If there is no such symbol, return the integer bucket number of
4061 where the symbol would be if it were present.
4063 Also store the bucket number in oblookup_last_bucket_number. */
4066 oblookup (Lisp_Object obarray
, register const char *ptr
, ptrdiff_t size
, ptrdiff_t size_byte
)
4070 register Lisp_Object tail
;
4071 Lisp_Object bucket
, tem
;
4073 obarray
= check_obarray (obarray
);
4074 /* This is sometimes needed in the middle of GC. */
4075 obsize
= gc_asize (obarray
);
4076 hash
= hash_string (ptr
, size_byte
) % obsize
;
4077 bucket
= AREF (obarray
, hash
);
4078 oblookup_last_bucket_number
= hash
;
4079 if (EQ (bucket
, make_number (0)))
4081 else if (!SYMBOLP (bucket
))
4082 error ("Bad data in guts of obarray"); /* Like CADR error message. */
4084 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
4086 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
4087 && SCHARS (SYMBOL_NAME (tail
)) == size
4088 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
4090 else if (XSYMBOL (tail
)->next
== 0)
4093 XSETINT (tem
, hash
);
4098 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
4101 register Lisp_Object tail
;
4102 CHECK_VECTOR (obarray
);
4103 for (i
= ASIZE (obarray
) - 1; i
>= 0; i
--)
4105 tail
= AREF (obarray
, i
);
4110 if (XSYMBOL (tail
)->next
== 0)
4112 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4118 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
4120 call1 (function
, sym
);
4123 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4124 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4125 OBARRAY defaults to the value of `obarray'. */)
4126 (Lisp_Object function
, Lisp_Object obarray
)
4128 if (NILP (obarray
)) obarray
= Vobarray
;
4129 obarray
= check_obarray (obarray
);
4131 map_obarray (obarray
, mapatoms_1
, function
);
4135 #define OBARRAY_SIZE 15121
4140 Vobarray
= Fmake_vector (make_number (OBARRAY_SIZE
), make_number (0));
4141 initial_obarray
= Vobarray
;
4142 staticpro (&initial_obarray
);
4144 for (int i
= 0; i
< ARRAYELTS (lispsym
); i
++)
4145 define_symbol (builtin_lisp_symbol (i
), defsym_name
[i
]);
4147 DEFSYM (Qunbound
, "unbound");
4149 DEFSYM (Qnil
, "nil");
4150 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4151 make_symbol_constant (Qnil
);
4152 XSYMBOL (Qnil
)->declared_special
= true;
4155 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4156 make_symbol_constant (Qt
);
4157 XSYMBOL (Qt
)->declared_special
= true;
4159 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4162 DEFSYM (Qvariable_documentation
, "variable-documentation");
4166 defsubr (struct Lisp_Subr
*sname
)
4168 Lisp_Object sym
, tem
;
4169 sym
= intern_c_string (sname
->symbol_name
);
4170 XSETPVECTYPE (sname
, PVEC_SUBR
);
4171 XSETSUBR (tem
, sname
);
4172 set_symbol_function (sym
, tem
);
4175 #ifdef NOTDEF /* Use fset in subr.el now! */
4177 defalias (struct Lisp_Subr
*sname
, char *string
)
4180 sym
= intern (string
);
4181 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4185 /* Define an "integer variable"; a symbol whose value is forwarded to a
4186 C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
4187 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4189 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4190 const char *namestring
, EMACS_INT
*address
)
4193 sym
= intern_c_string (namestring
);
4194 i_fwd
->type
= Lisp_Fwd_Int
;
4195 i_fwd
->intvar
= address
;
4196 XSYMBOL (sym
)->declared_special
= 1;
4197 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4198 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4201 /* Similar but define a variable whose value is t if address contains 1,
4202 nil if address contains 0. */
4204 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4205 const char *namestring
, bool *address
)
4208 sym
= intern_c_string (namestring
);
4209 b_fwd
->type
= Lisp_Fwd_Bool
;
4210 b_fwd
->boolvar
= address
;
4211 XSYMBOL (sym
)->declared_special
= 1;
4212 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4213 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4214 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4217 /* Similar but define a variable whose value is the Lisp Object stored
4218 at address. Two versions: with and without gc-marking of the C
4219 variable. The nopro version is used when that variable will be
4220 gc-marked for some other reason, since marking the same slot twice
4221 can cause trouble with strings. */
4223 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4224 const char *namestring
, Lisp_Object
*address
)
4227 sym
= intern_c_string (namestring
);
4228 o_fwd
->type
= Lisp_Fwd_Obj
;
4229 o_fwd
->objvar
= address
;
4230 XSYMBOL (sym
)->declared_special
= 1;
4231 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4232 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4236 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4237 const char *namestring
, Lisp_Object
*address
)
4239 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4240 staticpro (address
);
4243 /* Similar but define a variable whose value is the Lisp Object stored
4244 at a particular offset in the current kboard object. */
4247 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4248 const char *namestring
, int offset
)
4251 sym
= intern_c_string (namestring
);
4252 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4253 ko_fwd
->offset
= offset
;
4254 XSYMBOL (sym
)->declared_special
= 1;
4255 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4256 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4259 /* Check that the elements of lpath exist. */
4262 load_path_check (Lisp_Object lpath
)
4264 Lisp_Object path_tail
;
4266 /* The only elements that might not exist are those from
4267 PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
4269 for (path_tail
= lpath
; !NILP (path_tail
); path_tail
= XCDR (path_tail
))
4271 Lisp_Object dirfile
;
4272 dirfile
= Fcar (path_tail
);
4273 if (STRINGP (dirfile
))
4275 dirfile
= Fdirectory_file_name (dirfile
);
4276 if (! file_accessible_directory_p (dirfile
))
4277 dir_warning ("Lisp directory", XCAR (path_tail
));
4282 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
4283 This does not include the standard site-lisp directories
4284 under the installation prefix (i.e., PATH_SITELOADSEARCH),
4285 but it does (unless no_site_lisp is set) include site-lisp
4286 directories in the source/build directories if those exist and we
4287 are running uninstalled.
4289 Uses the following logic:
4291 If Vinstallation_directory is not nil (ie, running uninstalled),
4292 use PATH_DUMPLOADSEARCH (ie, build path). Else use PATH_LOADSEARCH.
4293 The remainder is what happens when dumping works:
4294 If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
4295 Otherwise use PATH_LOADSEARCH.
4297 If !initialized, then just return PATH_DUMPLOADSEARCH.
4299 If Vinstallation_directory is not nil (ie, running uninstalled):
4300 If installation-dir/lisp exists and not already a member,
4301 we must be running uninstalled. Reset the load-path
4302 to just installation-dir/lisp. (The default PATH_LOADSEARCH
4303 refers to the eventual installation directories. Since we
4304 are not yet installed, we should not use them, even if they exist.)
4305 If installation-dir/lisp does not exist, just add
4306 PATH_DUMPLOADSEARCH at the end instead.
4307 Add installation-dir/site-lisp (if !no_site_lisp, and exists
4308 and not already a member) at the front.
4309 If installation-dir != source-dir (ie running an uninstalled,
4310 out-of-tree build) AND install-dir/src/Makefile exists BUT
4311 install-dir/src/Makefile.in does NOT exist (this is a sanity
4312 check), then repeat the above steps for source-dir/lisp, site-lisp. */
4315 load_path_default (void)
4317 Lisp_Object lpath
= Qnil
;
4322 const char *loadpath
= ns_load_path ();
4325 normal
= PATH_LOADSEARCH
;
4326 if (!NILP (Vinstallation_directory
)) normal
= PATH_DUMPLOADSEARCH
;
4329 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4331 lpath
= decode_env_path (0, normal
, 0);
4334 #else /* !CANNOT_DUMP */
4336 normal
= NILP (Vpurify_flag
) ? PATH_LOADSEARCH
: PATH_DUMPLOADSEARCH
;
4341 const char *loadpath
= ns_load_path ();
4342 lpath
= decode_env_path (0, loadpath
? loadpath
: normal
, 0);
4344 lpath
= decode_env_path (0, normal
, 0);
4346 if (!NILP (Vinstallation_directory
))
4348 Lisp_Object tem
, tem1
;
4350 /* Add to the path the lisp subdir of the installation
4351 dir, if it is accessible. Note: in out-of-tree builds,
4352 this directory is empty save for Makefile. */
4353 tem
= Fexpand_file_name (build_string ("lisp"),
4354 Vinstallation_directory
);
4355 tem1
= Ffile_accessible_directory_p (tem
);
4358 if (NILP (Fmember (tem
, lpath
)))
4360 /* We are running uninstalled. The default load-path
4361 points to the eventual installed lisp directories.
4362 We should not use those now, even if they exist,
4363 so start over from a clean slate. */
4364 lpath
= list1 (tem
);
4368 /* That dir doesn't exist, so add the build-time
4369 Lisp dirs instead. */
4371 Lisp_Object dump_path
=
4372 decode_env_path (0, PATH_DUMPLOADSEARCH
, 0);
4373 lpath
= nconc2 (lpath
, dump_path
);
4376 /* Add site-lisp under the installation dir, if it exists. */
4379 tem
= Fexpand_file_name (build_string ("site-lisp"),
4380 Vinstallation_directory
);
4381 tem1
= Ffile_accessible_directory_p (tem
);
4384 if (NILP (Fmember (tem
, lpath
)))
4385 lpath
= Fcons (tem
, lpath
);
4389 /* If Emacs was not built in the source directory,
4390 and it is run from where it was built, add to load-path
4391 the lisp and site-lisp dirs under that directory. */
4393 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4397 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4398 Vinstallation_directory
);
4399 tem1
= Ffile_exists_p (tem
);
4401 /* Don't be fooled if they moved the entire source tree
4402 AFTER dumping Emacs. If the build directory is indeed
4403 different from the source dir, src/Makefile.in and
4404 src/Makefile will not be found together. */
4405 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4406 Vinstallation_directory
);
4407 tem2
= Ffile_exists_p (tem
);
4408 if (!NILP (tem1
) && NILP (tem2
))
4410 tem
= Fexpand_file_name (build_string ("lisp"),
4413 if (NILP (Fmember (tem
, lpath
)))
4414 lpath
= Fcons (tem
, lpath
);
4418 tem
= Fexpand_file_name (build_string ("site-lisp"),
4420 tem1
= Ffile_accessible_directory_p (tem
);
4423 if (NILP (Fmember (tem
, lpath
)))
4424 lpath
= Fcons (tem
, lpath
);
4428 } /* Vinstallation_directory != Vsource_directory */
4430 } /* if Vinstallation_directory */
4432 else /* !initialized */
4434 /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
4435 source directory. We used to add ../lisp (ie the lisp dir in
4436 the build directory) at the front here, but that should not
4437 be necessary, since in out of tree builds lisp/ is empty, save
4439 lpath
= decode_env_path (0, normal
, 0);
4441 #endif /* !CANNOT_DUMP */
4449 /* First, set Vload_path. */
4451 /* Ignore EMACSLOADPATH when dumping. */
4453 bool use_loadpath
= true;
4455 bool use_loadpath
= NILP (Vpurify_flag
);
4458 if (use_loadpath
&& egetenv ("EMACSLOADPATH"))
4460 Vload_path
= decode_env_path ("EMACSLOADPATH", 0, 1);
4462 /* Check (non-nil) user-supplied elements. */
4463 load_path_check (Vload_path
);
4465 /* If no nils in the environment variable, use as-is.
4466 Otherwise, replace any nils with the default. */
4467 if (! NILP (Fmemq (Qnil
, Vload_path
)))
4469 Lisp_Object elem
, elpath
= Vload_path
;
4470 Lisp_Object default_lpath
= load_path_default ();
4472 /* Check defaults, before adding site-lisp. */
4473 load_path_check (default_lpath
);
4475 /* Add the site-lisp directories to the front of the default. */
4476 if (!no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4478 Lisp_Object sitelisp
;
4479 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4480 if (! NILP (sitelisp
))
4481 default_lpath
= nconc2 (sitelisp
, default_lpath
);
4486 /* Replace nils from EMACSLOADPATH by default. */
4487 while (CONSP (elpath
))
4489 elem
= XCAR (elpath
);
4490 elpath
= XCDR (elpath
);
4491 Vload_path
= CALLN (Fappend
, Vload_path
,
4492 NILP (elem
) ? default_lpath
: list1 (elem
));
4494 } /* Fmemq (Qnil, Vload_path) */
4498 Vload_path
= load_path_default ();
4500 /* Check before adding site-lisp directories.
4501 The install should have created them, but they are not
4502 required, so no need to warn if they are absent.
4503 Or we might be running before installation. */
4504 load_path_check (Vload_path
);
4506 /* Add the site-lisp directories at the front. */
4507 if (initialized
&& !no_site_lisp
&& PATH_SITELOADSEARCH
[0] != '\0')
4509 Lisp_Object sitelisp
;
4510 sitelisp
= decode_env_path (0, PATH_SITELOADSEARCH
, 0);
4511 if (! NILP (sitelisp
)) Vload_path
= nconc2 (sitelisp
, Vload_path
);
4517 load_in_progress
= 0;
4518 Vload_file_name
= Qnil
;
4519 Vstandard_input
= Qt
;
4520 Vloads_in_progress
= Qnil
;
4523 /* Print a warning that directory intended for use USE and with name
4524 DIRNAME cannot be accessed. On entry, errno should correspond to
4525 the access failure. Print the warning on stderr and put it in
4529 dir_warning (char const *use
, Lisp_Object dirname
)
4531 static char const format
[] = "Warning: %s '%s': %s\n";
4532 char *diagnostic
= emacs_strerror (errno
);
4533 fprintf (stderr
, format
, use
, SSDATA (ENCODE_SYSTEM (dirname
)), diagnostic
);
4535 /* Don't log the warning before we've initialized!! */
4538 ptrdiff_t diaglen
= strlen (diagnostic
);
4539 AUTO_STRING_WITH_LEN (diag
, diagnostic
, diaglen
);
4540 if (! NILP (Vlocale_coding_system
))
4543 = code_convert_string_norecord (diag
, Vlocale_coding_system
, false);
4544 diagnostic
= SSDATA (s
);
4545 diaglen
= SBYTES (s
);
4548 char *buffer
= SAFE_ALLOCA (sizeof format
- 3 * (sizeof "%s" - 1)
4549 + strlen (use
) + SBYTES (dirname
) + diaglen
);
4550 ptrdiff_t message_len
= esprintf (buffer
, format
, use
, SSDATA (dirname
),
4552 message_dolog (buffer
, message_len
, 0, STRING_MULTIBYTE (dirname
));
4558 syms_of_lread (void)
4561 defsubr (&Sread_from_string
);
4562 defsubr (&Ssubstitute_object_in_subtree
);
4564 defsubr (&Sintern_soft
);
4565 defsubr (&Sunintern
);
4566 defsubr (&Sget_load_suffixes
);
4568 defsubr (&Seval_buffer
);
4569 defsubr (&Seval_region
);
4570 defsubr (&Sread_char
);
4571 defsubr (&Sread_char_exclusive
);
4572 defsubr (&Sread_event
);
4573 defsubr (&Sget_file_char
);
4574 defsubr (&Smapatoms
);
4575 defsubr (&Slocate_file_internal
);
4577 DEFVAR_LISP ("obarray", Vobarray
,
4578 doc
: /* Symbol table for use by `intern' and `read'.
4579 It is a vector whose length ought to be prime for best results.
4580 The vector's contents don't make sense if examined from Lisp programs;
4581 to find all the symbols in an obarray, use `mapatoms'. */);
4583 DEFVAR_LISP ("values", Vvalues
,
4584 doc
: /* List of values of all expressions which were read, evaluated and printed.
4585 Order is reverse chronological. */);
4586 XSYMBOL (intern ("values"))->declared_special
= 0;
4588 DEFVAR_LISP ("standard-input", Vstandard_input
,
4589 doc
: /* Stream for read to get input from.
4590 See documentation of `read' for possible values. */);
4591 Vstandard_input
= Qt
;
4593 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4594 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4596 If this variable is a buffer, then only forms read from that buffer
4597 will be added to `read-symbol-positions-list'.
4598 If this variable is t, then all read forms will be added.
4599 The effect of all other values other than nil are not currently
4600 defined, although they may be in the future.
4602 The positions are relative to the last call to `read' or
4603 `read-from-string'. It is probably a bad idea to set this variable at
4604 the toplevel; bind it instead. */);
4605 Vread_with_symbol_positions
= Qnil
;
4607 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4608 doc
: /* A list mapping read symbols to their positions.
4609 This variable is modified during calls to `read' or
4610 `read-from-string', but only when `read-with-symbol-positions' is
4613 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4614 CHAR-POSITION is an integer giving the offset of that occurrence of the
4615 symbol from the position where `read' or `read-from-string' started.
4617 Note that a symbol will appear multiple times in this list, if it was
4618 read multiple times. The list is in the same order as the symbols
4620 Vread_symbol_positions_list
= Qnil
;
4622 DEFVAR_LISP ("read-circle", Vread_circle
,
4623 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4626 DEFVAR_LISP ("load-path", Vload_path
,
4627 doc
: /* List of directories to search for files to load.
4628 Each element is a string (directory file name) or nil (meaning
4629 `default-directory').
4630 This list is consulted by the `require' function.
4631 Initialized during startup as described in Info node `(elisp)Library Search'.
4632 Use `directory-file-name' when adding items to this path. However, Lisp
4633 programs that process this list should tolerate directories both with
4634 and without trailing slashes. */);
4636 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4637 doc
: /* List of suffixes for Emacs Lisp files and dynamic modules.
4638 This list includes suffixes for both compiled and source Emacs Lisp files.
4639 This list should not include the empty string.
4640 `load' and related functions try to append these suffixes, in order,
4641 to the specified file name if a suffix is allowed or required. */);
4643 Vload_suffixes
= list3 (build_pure_c_string (".elc"),
4644 build_pure_c_string (".el"),
4645 build_pure_c_string (MODULES_SUFFIX
));
4647 Vload_suffixes
= list2 (build_pure_c_string (".elc"),
4648 build_pure_c_string (".el"));
4650 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix
,
4651 doc
: /* Suffix of loadable module file, or nil of modules are not supported. */);
4653 Vmodule_file_suffix
= build_pure_c_string (MODULES_SUFFIX
);
4655 Vmodule_file_suffix
= Qnil
;
4657 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4658 doc
: /* List of suffixes that indicate representations of \
4660 This list should normally start with the empty string.
4662 Enabling Auto Compression mode appends the suffixes in
4663 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4664 mode removes them again. `load' and related functions use this list to
4665 determine whether they should look for compressed versions of a file
4666 and, if so, which suffixes they should try to append to the file name
4667 in order to do so. However, if you want to customize which suffixes
4668 the loading functions recognize as compression suffixes, you should
4669 customize `jka-compr-load-suffixes' rather than the present variable. */);
4670 Vload_file_rep_suffixes
= list1 (empty_unibyte_string
);
4672 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4673 doc
: /* Non-nil if inside of `load'. */);
4674 DEFSYM (Qload_in_progress
, "load-in-progress");
4676 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4677 doc
: /* An alist of functions to be evalled when particular files are loaded.
4678 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
4680 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4681 a symbol (a feature name).
4683 When `load' is run and the file-name argument matches an element's
4684 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4685 REGEXP-OR-FEATURE, the FUNCS in the element are called.
4687 An error in FORMS does not undo the load, but does prevent execution of
4688 the rest of the FORMS. */);
4689 Vafter_load_alist
= Qnil
;
4691 DEFVAR_LISP ("load-history", Vload_history
,
4692 doc
: /* Alist mapping loaded file names to symbols and features.
4693 Each alist element should be a list (FILE-NAME ENTRIES...), where
4694 FILE-NAME is the name of a file that has been loaded into Emacs.
4695 The file name is absolute and true (i.e. it doesn't contain symlinks).
4696 As an exception, one of the alist elements may have FILE-NAME nil,
4697 for symbols and features not associated with any file.
4699 The remaining ENTRIES in the alist element describe the functions and
4700 variables defined in that file, the features provided, and the
4701 features required. Each entry has the form `(provide . FEATURE)',
4702 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4703 `(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
4704 may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
4705 autoload before this file redefined it as a function. In addition,
4706 entries may also be single symbols, which means that SYMBOL was
4707 defined by `defvar' or `defconst'.
4709 During preloading, the file name recorded is relative to the main Lisp
4710 directory. These file names are converted to absolute at startup. */);
4711 Vload_history
= Qnil
;
4713 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4714 doc
: /* Full name of file being loaded by `load'. */);
4715 Vload_file_name
= Qnil
;
4717 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4718 doc
: /* File name, including directory, of user's initialization file.
4719 If the file loaded had extension `.elc', and the corresponding source file
4720 exists, this variable contains the name of source file, suitable for use
4721 by functions like `custom-save-all' which edit the init file.
4722 While Emacs loads and evaluates the init file, value is the real name
4723 of the file, regardless of whether or not it has the `.elc' extension. */);
4724 Vuser_init_file
= Qnil
;
4726 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4727 doc
: /* Used for internal purposes by `load'. */);
4728 Vcurrent_load_list
= Qnil
;
4730 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4731 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4732 Called with a single argument (the stream from which to read).
4733 The default is to use the function `read'. */);
4734 DEFSYM (Qread
, "read");
4735 Vload_read_function
= Qread
;
4737 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4738 doc
: /* Function called in `load' to load an Emacs Lisp source file.
4739 The value should be a function for doing code conversion before
4740 reading a source file. It can also be nil, in which case loading is
4741 done without any code conversion.
4743 If the value is a function, it is called with four arguments,
4744 FULLNAME, FILE, NOERROR, NOMESSAGE. FULLNAME is the absolute name of
4745 the file to load, FILE is the non-absolute name (for messages etc.),
4746 and NOERROR and NOMESSAGE are the corresponding arguments passed to
4747 `load'. The function should return t if the file was loaded. */);
4748 Vload_source_file_function
= Qnil
;
4750 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4751 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4752 This is useful when the file being loaded is a temporary copy. */);
4753 load_force_doc_strings
= 0;
4755 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4756 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4757 This is normally bound by `load' and `eval-buffer' to control `read',
4758 and is not meant for users to change. */);
4759 load_convert_to_unibyte
= 0;
4761 DEFVAR_LISP ("source-directory", Vsource_directory
,
4762 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4763 You cannot count on them to still be there! */);
4765 = Fexpand_file_name (build_string ("../"),
4766 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
, 0)));
4768 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4769 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4770 Vpreloaded_file_list
= Qnil
;
4772 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4773 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4774 Vbyte_boolean_vars
= Qnil
;
4776 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4777 doc
: /* Non-nil means load dangerous compiled Lisp files.
4778 Some versions of XEmacs use different byte codes than Emacs. These
4779 incompatible byte codes can make Emacs crash when it tries to execute
4781 load_dangerous_libraries
= 0;
4783 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4784 doc
: /* Non-nil means force printing messages when loading Lisp files.
4785 This overrides the value of the NOMESSAGE argument to `load'. */);
4786 force_load_messages
= 0;
4788 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4789 doc
: /* Regular expression matching safe to load compiled Lisp files.
4790 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4791 from the file, and matches them against this regular expression.
4792 When the regular expression matches, the file is considered to be safe
4793 to load. See also `load-dangerous-libraries'. */);
4794 Vbytecomp_version_regexp
4795 = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4797 DEFSYM (Qlexical_binding
, "lexical-binding");
4798 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4799 doc
: /* Whether to use lexical binding when evaluating code.
4800 Non-nil means that the code in the current buffer should be evaluated
4801 with lexical binding.
4802 This variable is automatically set from the file variables of an
4803 interpreted Lisp file read using `load'. Unlike other file local
4804 variables, this must be set in the first line of a file. */);
4805 Vlexical_binding
= Qnil
;
4806 Fmake_variable_buffer_local (Qlexical_binding
);
4808 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4809 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4810 Veval_buffer_list
= Qnil
;
4812 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4813 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4814 Vold_style_backquotes
= Qnil
;
4815 DEFSYM (Qold_style_backquotes
, "old-style-backquotes");
4817 DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer
,
4818 doc
: /* Non-nil means `load' prefers the newest version of a file.
4819 This applies when a filename suffix is not explicitly specified and
4820 `load' is trying various possible suffixes (see `load-suffixes' and
4821 `load-file-rep-suffixes'). Normally, it stops at the first file
4822 that exists unless you explicitly specify one or the other. If this
4823 option is non-nil, it checks all suffixes and uses whichever file is
4825 Note that if you customize this, obviously it will not affect files
4826 that are loaded before your customizations are read! */);
4827 load_prefer_newer
= 0;
4829 /* Vsource_directory was initialized in init_lread. */
4831 DEFSYM (Qcurrent_load_list
, "current-load-list");
4832 DEFSYM (Qstandard_input
, "standard-input");
4833 DEFSYM (Qread_char
, "read-char");
4834 DEFSYM (Qget_file_char
, "get-file-char");
4836 /* Used instead of Qget_file_char while loading *.elc files compiled
4837 by Emacs 21 or older. */
4838 DEFSYM (Qget_emacs_mule_file_char
, "get-emacs-mule-file-char");
4840 DEFSYM (Qload_force_doc_strings
, "load-force-doc-strings");
4842 DEFSYM (Qbackquote
, "`");
4843 DEFSYM (Qcomma
, ",");
4844 DEFSYM (Qcomma_at
, ",@");
4845 DEFSYM (Qcomma_dot
, ",.");
4847 DEFSYM (Qinhibit_file_name_operation
, "inhibit-file-name-operation");
4848 DEFSYM (Qascii_character
, "ascii-character");
4849 DEFSYM (Qfunction
, "function");
4850 DEFSYM (Qload
, "load");
4851 DEFSYM (Qload_file_name
, "load-file-name");
4852 DEFSYM (Qeval_buffer_list
, "eval-buffer-list");
4853 DEFSYM (Qfile_truename
, "file-truename");
4854 DEFSYM (Qdir_ok
, "dir-ok");
4855 DEFSYM (Qdo_after_load_evaluation
, "do-after-load-evaluation");
4857 staticpro (&read_objects
);
4858 read_objects
= Qnil
;
4859 staticpro (&seen_list
);
4862 Vloads_in_progress
= Qnil
;
4863 staticpro (&Vloads_in_progress
);
4865 DEFSYM (Qhash_table
, "hash-table");
4866 DEFSYM (Qdata
, "data");
4867 DEFSYM (Qtest
, "test");
4868 DEFSYM (Qsize
, "size");
4869 DEFSYM (Qpurecopy
, "purecopy");
4870 DEFSYM (Qweakness
, "weakness");
4871 DEFSYM (Qrehash_size
, "rehash-size");
4872 DEFSYM (Qrehash_threshold
, "rehash-threshold");
4874 DEFSYM (Qchar_from_name
, "char-from-name");