1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
29 #include "intervals.h"
31 #include "character.h"
38 #include "termhooks.h"
40 #include "blockinput.h"
51 #endif /* HAVE_SETLOCALE */
56 #define file_offset off_t
57 #define file_tell ftello
59 #define file_offset long
60 #define file_tell ftell
63 /* hash table read constants */
64 Lisp_Object Qhash_table
, Qdata
;
65 Lisp_Object Qtest
, Qsize
;
66 Lisp_Object Qweakness
;
67 Lisp_Object Qrehash_size
;
68 Lisp_Object Qrehash_threshold
;
70 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
71 Lisp_Object Qvariable_documentation
;
72 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
73 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
74 Lisp_Object Qinhibit_file_name_operation
;
75 Lisp_Object Qeval_buffer_list
;
76 Lisp_Object Qlexical_binding
;
77 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
79 /* Used instead of Qget_file_char while loading *.elc files compiled
80 by Emacs 21 or older. */
81 static Lisp_Object Qget_emacs_mule_file_char
;
83 static Lisp_Object Qload_force_doc_strings
;
85 extern Lisp_Object Qinternal_interpreter_environment
;
87 static Lisp_Object Qload_in_progress
;
89 /* The association list of objects read with the #n=object form.
90 Each member of the list has the form (n . object), and is used to
91 look up the object for the corresponding #n# construct.
92 It must be set to nil before all top-level calls to read0. */
93 Lisp_Object read_objects
;
95 /* Nonzero means READCHAR should read bytes one by one (not character)
96 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
97 This is set to 1 by read1 temporarily while handling #@NUMBER. */
98 static int load_each_byte
;
100 /* If non-nil `readevalloop' evaluates code in a lexical environment. */
101 Lisp_Object Vlexical_binding
;
103 /* List of descriptors now open for Fload. */
104 static Lisp_Object load_descriptor_list
;
106 /* File for get_file_char to read from. Use by load. */
107 static FILE *instream
;
109 /* When nonzero, read conses in pure space */
110 static int read_pure
;
112 /* For use within read-from-string (this reader is non-reentrant!!) */
113 static EMACS_INT read_from_string_index
;
114 static EMACS_INT read_from_string_index_byte
;
115 static EMACS_INT read_from_string_limit
;
117 /* Number of characters read in the current call to Fread or
118 Fread_from_string. */
119 static EMACS_INT readchar_count
;
121 /* This contains the last string skipped with #@. */
122 static char *saved_doc_string
;
123 /* Length of buffer allocated in saved_doc_string. */
124 static int saved_doc_string_size
;
125 /* Length of actual data in saved_doc_string. */
126 static int saved_doc_string_length
;
127 /* This is the file position that string came from. */
128 static file_offset saved_doc_string_position
;
130 /* This contains the previous string skipped with #@.
131 We copy it from saved_doc_string when a new string
132 is put in saved_doc_string. */
133 static char *prev_saved_doc_string
;
134 /* Length of buffer allocated in prev_saved_doc_string. */
135 static int prev_saved_doc_string_size
;
136 /* Length of actual data in prev_saved_doc_string. */
137 static int prev_saved_doc_string_length
;
138 /* This is the file position that string came from. */
139 static file_offset prev_saved_doc_string_position
;
141 /* Nonzero means inside a new-style backquote
142 with no surrounding parentheses.
143 Fread initializes this to zero, so we need not specbind it
144 or worry about what happens to it when there is an error. */
145 static int new_backquote_flag
;
146 static Lisp_Object Qold_style_backquotes
;
148 /* A list of file names for files being loaded in Fload. Used to
149 check for recursive loads. */
151 static Lisp_Object Vloads_in_progress
;
153 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
156 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
, int,
157 Lisp_Object
, Lisp_Object
,
158 Lisp_Object
, Lisp_Object
);
159 static Lisp_Object
load_unwind (Lisp_Object
);
160 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
162 static void invalid_syntax (const char *, int) NO_RETURN
;
163 static void end_of_file_error (void) NO_RETURN
;
166 /* Functions that read one byte from the current source READCHARFUN
167 or unreads one byte. If the integer argument C is -1, it returns
168 one read byte, or -1 when there's no more byte in the source. If C
169 is 0 or positive, it unreads C, and the return value is not
172 static int readbyte_for_lambda (int, Lisp_Object
);
173 static int readbyte_from_file (int, Lisp_Object
);
174 static int readbyte_from_string (int, Lisp_Object
);
176 /* Handle unreading and rereading of characters.
177 Write READCHAR to read a character,
178 UNREAD(c) to unread c to be read again.
180 These macros correctly read/unread multibyte characters. */
182 #define READCHAR readchar (readcharfun, NULL)
183 #define UNREAD(c) unreadchar (readcharfun, c)
185 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
186 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
188 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
189 Qlambda, or a cons, we use this to keep an unread character because
190 a file stream can't handle multibyte-char unreading. The value -1
191 means that there's no unread character. */
192 static int unread_char
;
195 readchar (Lisp_Object readcharfun
, int *multibyte
)
199 int (*readbyte
) (int, Lisp_Object
);
200 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
202 int emacs_mule_encoding
= 0;
209 if (BUFFERP (readcharfun
))
211 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
213 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
215 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
218 if (! NILP (inbuffer
->enable_multibyte_characters
))
220 /* Fetch the character code from the buffer. */
221 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
222 BUF_INC_POS (inbuffer
, pt_byte
);
229 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
230 if (! ASCII_BYTE_P (c
))
231 c
= BYTE8_TO_CHAR (c
);
234 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
238 if (MARKERP (readcharfun
))
240 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
242 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
244 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
247 if (! NILP (inbuffer
->enable_multibyte_characters
))
249 /* Fetch the character code from the buffer. */
250 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
251 BUF_INC_POS (inbuffer
, bytepos
);
258 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
259 if (! ASCII_BYTE_P (c
))
260 c
= BYTE8_TO_CHAR (c
);
264 XMARKER (readcharfun
)->bytepos
= bytepos
;
265 XMARKER (readcharfun
)->charpos
++;
270 if (EQ (readcharfun
, Qlambda
))
272 readbyte
= readbyte_for_lambda
;
276 if (EQ (readcharfun
, Qget_file_char
))
278 readbyte
= readbyte_from_file
;
282 if (STRINGP (readcharfun
))
284 if (read_from_string_index
>= read_from_string_limit
)
286 else if (STRING_MULTIBYTE (readcharfun
))
290 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
291 read_from_string_index
,
292 read_from_string_index_byte
);
296 c
= SREF (readcharfun
, read_from_string_index_byte
);
297 read_from_string_index
++;
298 read_from_string_index_byte
++;
303 if (CONSP (readcharfun
))
305 /* This is the case that read_vector is reading from a unibyte
306 string that contains a byte sequence previously skipped
307 because of #@NUMBER. The car part of readcharfun is that
308 string, and the cdr part is a value of readcharfun given to
310 readbyte
= readbyte_from_string
;
311 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
312 emacs_mule_encoding
= 1;
316 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
318 readbyte
= readbyte_from_file
;
319 emacs_mule_encoding
= 1;
323 tem
= call0 (readcharfun
);
330 if (unread_char
>= 0)
336 c
= (*readbyte
) (-1, readcharfun
);
337 if (c
< 0 || load_each_byte
)
341 if (ASCII_BYTE_P (c
))
343 if (emacs_mule_encoding
)
344 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
347 len
= BYTES_BY_CHAR_HEAD (c
);
350 c
= (*readbyte
) (-1, readcharfun
);
351 if (c
< 0 || ! TRAILING_CODE_P (c
))
354 (*readbyte
) (buf
[i
], readcharfun
);
355 return BYTE8_TO_CHAR (buf
[0]);
359 return STRING_CHAR (buf
);
362 /* Unread the character C in the way appropriate for the stream READCHARFUN.
363 If the stream is a user function, call it with the char as argument. */
366 unreadchar (Lisp_Object readcharfun
, int c
)
370 /* Don't back up the pointer if we're unreading the end-of-input mark,
371 since readchar didn't advance it when we read it. */
373 else if (BUFFERP (readcharfun
))
375 struct buffer
*b
= XBUFFER (readcharfun
);
376 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
379 if (! NILP (b
->enable_multibyte_characters
))
380 BUF_DEC_POS (b
, bytepos
);
384 BUF_PT_BYTE (b
) = bytepos
;
386 else if (MARKERP (readcharfun
))
388 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
389 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
391 XMARKER (readcharfun
)->charpos
--;
392 if (! NILP (b
->enable_multibyte_characters
))
393 BUF_DEC_POS (b
, bytepos
);
397 XMARKER (readcharfun
)->bytepos
= bytepos
;
399 else if (STRINGP (readcharfun
))
401 read_from_string_index
--;
402 read_from_string_index_byte
403 = string_char_to_byte (readcharfun
, read_from_string_index
);
405 else if (CONSP (readcharfun
))
409 else if (EQ (readcharfun
, Qlambda
))
413 else if (EQ (readcharfun
, Qget_file_char
)
414 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
419 ungetc (c
, instream
);
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
);
451 /* Interrupted reads have been observed while reading over the network */
452 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
464 return (c
== EOF
? -1 : c
);
468 readbyte_from_string (int c
, Lisp_Object readcharfun
)
470 Lisp_Object string
= XCAR (readcharfun
);
474 read_from_string_index
--;
475 read_from_string_index_byte
476 = string_char_to_byte (string
, read_from_string_index
);
479 if (read_from_string_index
>= read_from_string_limit
)
482 FETCH_STRING_CHAR_ADVANCE (c
, string
,
483 read_from_string_index
,
484 read_from_string_index_byte
);
489 /* Read one non-ASCII character from INSTREAM. The character is
490 encoded in `emacs-mule' and the first byte is already read in
494 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
496 /* Emacs-mule coding uses at most 4-byte for one character. */
497 unsigned char buf
[4];
498 int len
= emacs_mule_bytes
[c
];
499 struct charset
*charset
;
504 /* C is not a valid leading-code of `emacs-mule'. */
505 return BYTE8_TO_CHAR (c
);
511 c
= (*readbyte
) (-1, readcharfun
);
515 (*readbyte
) (buf
[i
], readcharfun
);
516 return BYTE8_TO_CHAR (buf
[0]);
523 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
524 code
= buf
[1] & 0x7F;
528 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
529 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
531 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
532 code
= buf
[2] & 0x7F;
536 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
537 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
542 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
543 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
545 c
= DECODE_CHAR (charset
, code
);
547 Fsignal (Qinvalid_read_syntax
,
548 Fcons (build_string ("invalid multibyte form"), Qnil
));
553 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
555 static Lisp_Object
read0 (Lisp_Object
);
556 static Lisp_Object
read1 (Lisp_Object
, int *, int);
558 static Lisp_Object
read_list (int, Lisp_Object
);
559 static Lisp_Object
read_vector (Lisp_Object
, int);
561 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
563 static void substitute_object_in_subtree (Lisp_Object
,
565 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
568 /* Get a character from the tty. */
570 /* Read input events until we get one that's acceptable for our purposes.
572 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
573 until we get a character we like, and then stuffed into
576 If ASCII_REQUIRED is non-zero, we check function key events to see
577 if the unmodified version of the symbol has a Qascii_character
578 property, and use that character, if present.
580 If ERROR_NONASCII is non-zero, we signal an error if the input we
581 get isn't an ASCII character with modifiers. If it's zero but
582 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
585 If INPUT_METHOD is nonzero, we invoke the current input method
586 if the character warrants that.
588 If SECONDS is a number, we wait that many seconds for input, and
589 return Qnil if no input arrives within that time. */
592 read_filtered_event (int no_switch_frame
, int ascii_required
,
593 int error_nonascii
, int input_method
, Lisp_Object seconds
)
595 Lisp_Object val
, delayed_switch_frame
;
598 #ifdef HAVE_WINDOW_SYSTEM
599 if (display_hourglass_p
)
603 delayed_switch_frame
= Qnil
;
605 /* Compute timeout. */
606 if (NUMBERP (seconds
))
608 EMACS_TIME wait_time
;
610 double duration
= extract_float (seconds
);
612 sec
= (int) duration
;
613 usec
= (duration
- sec
) * 1000000;
614 EMACS_GET_TIME (end_time
);
615 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
616 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
619 /* Read until we get an acceptable event. */
622 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
623 NUMBERP (seconds
) ? &end_time
: NULL
);
624 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
629 /* switch-frame events are put off until after the next ASCII
630 character. This is better than signaling an error just because
631 the last characters were typed to a separate minibuffer frame,
632 for example. Eventually, some code which can deal with
633 switch-frame events will read it and process it. */
635 && EVENT_HAS_PARAMETERS (val
)
636 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
638 delayed_switch_frame
= val
;
642 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
644 /* Convert certain symbols to their ASCII equivalents. */
647 Lisp_Object tem
, tem1
;
648 tem
= Fget (val
, Qevent_symbol_element_mask
);
651 tem1
= Fget (Fcar (tem
), Qascii_character
);
652 /* Merge this symbol's modifier bits
653 with the ASCII equivalent of its basic code. */
655 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
659 /* If we don't have a character now, deal with it appropriately. */
664 Vunread_command_events
= Fcons (val
, Qnil
);
665 error ("Non-character input-event");
672 if (! NILP (delayed_switch_frame
))
673 unread_switch_frame
= delayed_switch_frame
;
677 #ifdef HAVE_WINDOW_SYSTEM
678 if (display_hourglass_p
)
687 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
688 doc
: /* Read a character from the command input (keyboard or macro).
689 It is returned as a number.
690 If the character has modifiers, they are resolved and reflected to the
691 character code if possible (e.g. C-SPC -> 0).
693 If the user generates an event which is not a character (i.e. a mouse
694 click or function key event), `read-char' signals an error. As an
695 exception, switch-frame events are put off until non-character events
697 If you want to read non-character events, or ignore them, call
698 `read-event' or `read-char-exclusive' instead.
700 If the optional argument PROMPT is non-nil, display that as a prompt.
701 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
702 input method is turned on in the current buffer, that input method
703 is used for reading a character.
704 If the optional argument SECONDS is non-nil, it should be a number
705 specifying the maximum number of seconds to wait for input. If no
706 input arrives in that time, return nil. SECONDS may be a
707 floating-point value. */)
708 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
713 message_with_string ("%s", prompt
, 0);
714 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
716 return (NILP (val
) ? Qnil
717 : make_number (char_resolve_modifier_mask (XINT (val
))));
720 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
721 doc
: /* Read an event object from the input stream.
722 If the optional argument PROMPT is non-nil, display that as a prompt.
723 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
724 input method is turned on in the current buffer, that input method
725 is used for reading a character.
726 If the optional argument SECONDS is non-nil, it should be a number
727 specifying the maximum number of seconds to wait for input. If no
728 input arrives in that time, return nil. SECONDS may be a
729 floating-point value. */)
730 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
733 message_with_string ("%s", prompt
, 0);
734 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
737 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
738 doc
: /* Read a character from the command input (keyboard or macro).
739 It is returned as a number. Non-character events are ignored.
740 If the character has modifiers, they are resolved and reflected to the
741 character code if possible (e.g. C-SPC -> 0).
743 If the optional argument PROMPT is non-nil, display that as a prompt.
744 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
745 input method is turned on in the current buffer, that input method
746 is used for reading a character.
747 If the optional argument SECONDS is non-nil, it should be a number
748 specifying the maximum number of seconds to wait for input. If no
749 input arrives in that time, return nil. SECONDS may be a
750 floating-point value. */)
751 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
756 message_with_string ("%s", prompt
, 0);
758 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
760 return (NILP (val
) ? Qnil
761 : make_number (char_resolve_modifier_mask (XINT (val
))));
764 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
765 doc
: /* Don't use this yourself. */)
768 register Lisp_Object val
;
770 XSETINT (val
, getc (instream
));
778 /* Return true if the lisp code read using READCHARFUN defines a non-nil
779 `lexical-binding' file variable. After returning, the stream is
780 positioned following the first line, if it is a comment, otherwise
784 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
788 /* The first line isn't a comment, just give up. */
794 /* Look for an appropriate file-variable in the first line. */
798 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
799 } beg_end_state
= NOMINAL
;
800 int in_file_vars
= 0;
802 #define UPDATE_BEG_END_STATE(ch) \
803 if (beg_end_state == NOMINAL) \
804 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
805 else if (beg_end_state == AFTER_FIRST_DASH) \
806 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
807 else if (beg_end_state == AFTER_ASTERIX) \
810 in_file_vars = !in_file_vars; \
811 beg_end_state = NOMINAL; \
814 /* Skip until we get to the file vars, if any. */
818 UPDATE_BEG_END_STATE (ch
);
820 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
824 char var
[100], *var_end
, val
[100], *val_end
;
828 /* Read a variable name. */
829 while (ch
== ' ' || ch
== '\t')
833 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
835 if (var_end
< var
+ sizeof var
- 1)
837 UPDATE_BEG_END_STATE (ch
);
842 && (var_end
[-1] == ' ' || var_end
[-1] == '\t'))
848 /* Read a variable value. */
851 while (ch
== ' ' || ch
== '\t')
855 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
857 if (val_end
< val
+ sizeof val
- 1)
859 UPDATE_BEG_END_STATE (ch
);
863 /* The value was terminated by an end-marker, which
867 && (val_end
[-1] == ' ' || val_end
[-1] == '\t'))
871 if (strcmp (var
, "lexical-binding") == 0)
874 rv
= (strcmp (val
, "nil") != 0);
880 while (ch
!= '\n' && ch
!= EOF
)
888 /* Value is a version number of byte compiled code if the file
889 associated with file descriptor FD is a compiled Lisp file that's
890 safe to load. Only files compiled with Emacs are safe to load.
891 Files compiled with XEmacs can lead to a crash in Fbyte_code
892 because of an incompatible change in the byte compiler. */
895 safe_to_load_p (int fd
)
902 /* Read the first few bytes from the file, and look for a line
903 specifying the byte compiler version used. */
904 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
909 /* Skip to the next newline, skipping over the initial `ELC'
910 with NUL bytes following it, but note the version. */
911 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
916 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
923 lseek (fd
, 0, SEEK_SET
);
928 /* Callback for record_unwind_protect. Restore the old load list OLD,
929 after loading a file successfully. */
932 record_load_unwind (Lisp_Object old
)
934 return Vloads_in_progress
= old
;
937 /* This handler function is used via internal_condition_case_1. */
940 load_error_handler (Lisp_Object data
)
946 load_warn_old_style_backquotes (Lisp_Object file
)
948 if (!NILP (Vold_style_backquotes
))
951 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
958 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
959 doc
: /* Return the suffixes that `load' should try if a suffix is \
961 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
964 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
965 while (CONSP (suffixes
))
967 Lisp_Object exts
= Vload_file_rep_suffixes
;
968 suffix
= XCAR (suffixes
);
969 suffixes
= XCDR (suffixes
);
974 lst
= Fcons (concat2 (suffix
, ext
), lst
);
977 return Fnreverse (lst
);
980 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
981 doc
: /* Execute a file of Lisp code named FILE.
982 First try FILE with `.elc' appended, then try with `.el',
983 then try FILE unmodified (the exact suffixes in the exact order are
984 determined by `load-suffixes'). Environment variable references in
985 FILE are replaced with their values by calling `substitute-in-file-name'.
986 This function searches the directories in `load-path'.
988 If optional second arg NOERROR is non-nil,
989 report no error if FILE doesn't exist.
990 Print messages at start and end of loading unless
991 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
993 If optional fourth arg NOSUFFIX is non-nil, don't try adding
994 suffixes `.elc' or `.el' to the specified name FILE.
995 If optional fifth arg MUST-SUFFIX is non-nil, insist on
996 the suffix `.elc' or `.el'; don't accept just FILE unless
997 it ends in one of those suffixes or includes a directory name.
999 If this function fails to find a file, it may look for different
1000 representations of that file before trying another file.
1001 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1002 to the file name. Emacs uses this feature mainly to find compressed
1003 versions of files when Auto Compression mode is enabled.
1005 The exact suffixes that this function tries out, in the exact order,
1006 are given by the value of the variable `load-file-rep-suffixes' if
1007 NOSUFFIX is non-nil and by the return value of the function
1008 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1009 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1010 and then the former.
1012 Loading a file records its definitions, and its `provide' and
1013 `require' calls, in an element of `load-history' whose
1014 car is the file name loaded. See `load-history'.
1016 While the file is in the process of being loaded, the variable
1017 `load-in-progress' is non-nil and the variable `load-file-name'
1018 is bound to the file's name.
1020 Return t if the file exists and loads successfully. */)
1021 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1023 register FILE *stream
;
1024 register int fd
= -1;
1025 int count
= SPECPDL_INDEX ();
1026 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1027 Lisp_Object found
, efound
, hist_file_name
;
1028 /* 1 means we printed the ".el is newer" message. */
1030 /* 1 means we are loading a compiled file. */
1032 Lisp_Object handler
;
1034 const char *fmode
= "r";
1042 CHECK_STRING (file
);
1044 /* If file name is magic, call the handler. */
1045 /* This shouldn't be necessary any more now that `openp' handles it right.
1046 handler = Ffind_file_name_handler (file, Qload);
1047 if (!NILP (handler))
1048 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1050 /* Do this after the handler to avoid
1051 the need to gcpro noerror, nomessage and nosuffix.
1052 (Below here, we care only whether they are nil or not.)
1053 The presence of this call is the result of a historical accident:
1054 it used to be in every file-operation and when it got removed
1055 everywhere, it accidentally stayed here. Since then, enough people
1056 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1057 that it seemed risky to remove. */
1058 if (! NILP (noerror
))
1060 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1061 Qt
, load_error_handler
);
1066 file
= Fsubstitute_in_file_name (file
);
1069 /* Avoid weird lossage with null string as arg,
1070 since it would try to load a directory as a Lisp file */
1071 if (SCHARS (file
) > 0)
1073 int size
= SBYTES (file
);
1076 GCPRO2 (file
, found
);
1078 if (! NILP (must_suffix
))
1080 /* Don't insist on adding a suffix if FILE already ends with one. */
1082 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
1085 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
1087 /* Don't insist on adding a suffix
1088 if the argument includes a directory name. */
1089 else if (! NILP (Ffile_name_directory (file
)))
1093 fd
= openp (Vload_path
, file
,
1094 (!NILP (nosuffix
) ? Qnil
1095 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1096 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1097 tmp
[1] = Vload_file_rep_suffixes
,
1106 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1110 /* Tell startup.el whether or not we found the user's init file. */
1111 if (EQ (Qt
, Vuser_init_file
))
1112 Vuser_init_file
= found
;
1114 /* If FD is -2, that means openp found a magic file. */
1117 if (NILP (Fequal (found
, file
)))
1118 /* If FOUND is a different file name from FILE,
1119 find its handler even if we have already inhibited
1120 the `load' operation on FILE. */
1121 handler
= Ffind_file_name_handler (found
, Qt
);
1123 handler
= Ffind_file_name_handler (found
, Qload
);
1124 if (! NILP (handler
))
1125 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1128 /* Check if we're stuck in a recursive load cycle.
1130 2000-09-21: It's not possible to just check for the file loaded
1131 being a member of Vloads_in_progress. This fails because of the
1132 way the byte compiler currently works; `provide's are not
1133 evaluated, see font-lock.el/jit-lock.el as an example. This
1134 leads to a certain amount of ``normal'' recursion.
1136 Also, just loading a file recursively is not always an error in
1137 the general case; the second load may do something different. */
1141 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1142 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1146 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1148 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1149 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1152 /* All loads are by default dynamic, unless the file itself specifies
1153 otherwise using a file-variable in the first line. This is bound here
1154 so that it takes effect whether or not we use
1155 Vload_source_file_function. */
1156 specbind (Qlexical_binding
, Qnil
);
1158 /* Get the name for load-history. */
1159 hist_file_name
= (! NILP (Vpurify_flag
)
1160 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1161 tmp
[1] = Ffile_name_nondirectory (found
),
1167 /* Check for the presence of old-style quotes and warn about them. */
1168 specbind (Qold_style_backquotes
, Qnil
);
1169 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1171 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1172 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1173 /* Load .elc files directly, but not when they are
1174 remote and have no handler! */
1181 GCPRO3 (file
, found
, hist_file_name
);
1184 && ! (version
= safe_to_load_p (fd
)))
1187 if (!load_dangerous_libraries
)
1191 error ("File `%s' was not compiled in Emacs",
1194 else if (!NILP (nomessage
) && !force_load_messages
)
1195 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1200 efound
= ENCODE_FILE (found
);
1205 stat (SSDATA (efound
), &s1
);
1206 SSET (efound
, SBYTES (efound
) - 1, 0);
1207 result
= stat (SSDATA (efound
), &s2
);
1208 SSET (efound
, SBYTES (efound
) - 1, 'c');
1210 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1212 /* Make the progress messages mention that source is newer. */
1215 /* If we won't print another message, mention this anyway. */
1216 if (!NILP (nomessage
) && !force_load_messages
)
1218 Lisp_Object msg_file
;
1219 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1220 message_with_string ("Source file `%s' newer than byte-compiled file",
1229 /* We are loading a source file (*.el). */
1230 if (!NILP (Vload_source_file_function
))
1236 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1237 NILP (noerror
) ? Qnil
: Qt
,
1238 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1239 return unbind_to (count
, val
);
1243 GCPRO3 (file
, found
, hist_file_name
);
1247 efound
= ENCODE_FILE (found
);
1248 stream
= fopen (SSDATA (efound
), fmode
);
1249 #else /* not WINDOWSNT */
1250 stream
= fdopen (fd
, fmode
);
1251 #endif /* not WINDOWSNT */
1255 error ("Failure to create stdio stream for %s", SDATA (file
));
1258 if (! NILP (Vpurify_flag
))
1259 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1261 if (NILP (nomessage
) || force_load_messages
)
1264 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1267 message_with_string ("Loading %s (source)...", file
, 1);
1269 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1271 else /* The typical case; compiled file newer than source file. */
1272 message_with_string ("Loading %s...", file
, 1);
1275 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1276 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1277 specbind (Qload_file_name
, found
);
1278 specbind (Qinhibit_file_name_operation
, Qnil
);
1279 load_descriptor_list
1280 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1282 specbind (Qload_in_progress
, Qt
);
1285 if (lisp_file_lexically_bound_p (Qget_file_char
))
1286 Fset (Qlexical_binding
, Qt
);
1288 if (! version
|| version
>= 22)
1289 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1290 0, Qnil
, Qnil
, Qnil
, Qnil
);
1293 /* We can't handle a file which was compiled with
1294 byte-compile-dynamic by older version of Emacs. */
1295 specbind (Qload_force_doc_strings
, Qt
);
1296 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
,
1297 0, Qnil
, Qnil
, Qnil
, Qnil
);
1299 unbind_to (count
, Qnil
);
1301 /* Run any eval-after-load forms for this file */
1302 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1303 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1307 xfree (saved_doc_string
);
1308 saved_doc_string
= 0;
1309 saved_doc_string_size
= 0;
1311 xfree (prev_saved_doc_string
);
1312 prev_saved_doc_string
= 0;
1313 prev_saved_doc_string_size
= 0;
1315 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1318 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1321 message_with_string ("Loading %s (source)...done", file
, 1);
1323 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1325 else /* The typical case; compiled file newer than source file. */
1326 message_with_string ("Loading %s...done", file
, 1);
1333 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1335 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1346 load_descriptor_unwind (Lisp_Object oldlist
)
1348 load_descriptor_list
= oldlist
;
1352 /* Close all descriptors in use for Floads.
1353 This is used when starting a subprocess. */
1356 close_load_descs (void)
1360 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1361 emacs_close (XFASTINT (XCAR (tail
)));
1366 complete_filename_p (Lisp_Object pathname
)
1368 register const unsigned char *s
= SDATA (pathname
);
1369 return (IS_DIRECTORY_SEP (s
[0])
1370 || (SCHARS (pathname
) > 2
1371 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1374 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1375 doc
: /* Search for FILENAME through PATH.
1376 Returns the file's name in absolute form, or nil if not found.
1377 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1378 file name when searching.
1379 If non-nil, PREDICATE is used instead of `file-readable-p'.
1380 PREDICATE can also be an integer to pass to the access(2) function,
1381 in which case file-name-handlers are ignored. */)
1382 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1385 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1386 if (NILP (predicate
) && fd
> 0)
1392 /* Search for a file whose name is STR, looking in directories
1393 in the Lisp list PATH, and trying suffixes from SUFFIX.
1394 On success, returns a file descriptor. On failure, returns -1.
1396 SUFFIXES is a list of strings containing possible suffixes.
1397 The empty suffix is automatically added if the list is empty.
1399 PREDICATE non-nil means don't open the files,
1400 just look for one that satisfies the predicate. In this case,
1401 returns 1 on success. The predicate can be a lisp function or
1402 an integer to pass to `access' (in which case file-name-handlers
1405 If STOREPTR is nonzero, it points to a slot where the name of
1406 the file actually found should be stored as a Lisp string.
1407 nil is stored there on failure.
1409 If the file we find is remote, return -2
1410 but store the found remote file name in *STOREPTR. */
1413 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1418 register char *fn
= buf
;
1421 Lisp_Object filename
;
1423 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1424 Lisp_Object string
, tail
, encoded_fn
;
1425 int max_suffix_len
= 0;
1429 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1431 CHECK_STRING_CAR (tail
);
1432 max_suffix_len
= max (max_suffix_len
,
1433 SBYTES (XCAR (tail
)));
1436 string
= filename
= encoded_fn
= Qnil
;
1437 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1442 if (complete_filename_p (str
))
1445 for (; CONSP (path
); path
= XCDR (path
))
1447 filename
= Fexpand_file_name (str
, XCAR (path
));
1448 if (!complete_filename_p (filename
))
1449 /* If there are non-absolute elts in PATH (eg ".") */
1450 /* Of course, this could conceivably lose if luser sets
1451 default-directory to be something non-absolute... */
1453 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1454 if (!complete_filename_p (filename
))
1455 /* Give up on this path element! */
1459 /* Calculate maximum size of any filename made from
1460 this path element/specified file name and any possible suffix. */
1461 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1462 if (fn_size
< want_size
)
1463 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1465 /* Loop over suffixes. */
1466 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1467 CONSP (tail
); tail
= XCDR (tail
))
1469 int lsuffix
= SBYTES (XCAR (tail
));
1470 Lisp_Object handler
;
1473 /* Concatenate path element/specified name with the suffix.
1474 If the directory starts with /:, remove that. */
1475 if (SCHARS (filename
) > 2
1476 && SREF (filename
, 0) == '/'
1477 && SREF (filename
, 1) == ':')
1479 strncpy (fn
, SSDATA (filename
) + 2,
1480 SBYTES (filename
) - 2);
1481 fn
[SBYTES (filename
) - 2] = 0;
1485 strncpy (fn
, SSDATA (filename
),
1487 fn
[SBYTES (filename
)] = 0;
1490 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1491 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1493 /* Check that the file exists and is not a directory. */
1494 /* We used to only check for handlers on non-absolute file names:
1498 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1499 It's not clear why that was the case and it breaks things like
1500 (load "/bar.el") where the file is actually "/bar.el.gz". */
1501 string
= build_string (fn
);
1502 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1503 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1505 if (NILP (predicate
))
1506 exists
= !NILP (Ffile_readable_p (string
));
1508 exists
= !NILP (call1 (predicate
, string
));
1509 if (exists
&& !NILP (Ffile_directory_p (string
)))
1514 /* We succeeded; return this descriptor and filename. */
1525 encoded_fn
= ENCODE_FILE (string
);
1526 pfn
= SSDATA (encoded_fn
);
1527 exists
= (stat (pfn
, &st
) >= 0
1528 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1531 /* Check that we can access or open it. */
1532 if (NATNUMP (predicate
))
1533 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1535 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1539 /* We succeeded; return this descriptor and filename. */
1557 /* Merge the list we've accumulated of globals from the current input source
1558 into the load_history variable. The details depend on whether
1559 the source has an associated file name or not.
1561 FILENAME is the file name that we are loading from.
1562 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1565 build_load_history (Lisp_Object filename
, int entire
)
1567 register Lisp_Object tail
, prev
, newelt
;
1568 register Lisp_Object tem
, tem2
;
1569 register int foundit
= 0;
1571 tail
= Vload_history
;
1574 while (CONSP (tail
))
1578 /* Find the feature's previous assoc list... */
1579 if (!NILP (Fequal (filename
, Fcar (tem
))))
1583 /* If we're loading the entire file, remove old data. */
1587 Vload_history
= XCDR (tail
);
1589 Fsetcdr (prev
, XCDR (tail
));
1592 /* Otherwise, cons on new symbols that are not already members. */
1595 tem2
= Vcurrent_load_list
;
1597 while (CONSP (tem2
))
1599 newelt
= XCAR (tem2
);
1601 if (NILP (Fmember (newelt
, tem
)))
1602 Fsetcar (tail
, Fcons (XCAR (tem
),
1603 Fcons (newelt
, XCDR (tem
))));
1616 /* If we're loading an entire file, cons the new assoc onto the
1617 front of load-history, the most-recently-loaded position. Also
1618 do this if we didn't find an existing member for the file. */
1619 if (entire
|| !foundit
)
1620 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1625 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1632 readevalloop_1 (Lisp_Object old
)
1634 load_convert_to_unibyte
= ! NILP (old
);
1638 /* Signal an `end-of-file' error, if possible with file name
1642 end_of_file_error (void)
1644 if (STRINGP (Vload_file_name
))
1645 xsignal1 (Qend_of_file
, Vload_file_name
);
1647 xsignal0 (Qend_of_file
);
1650 /* UNIBYTE specifies how to set load_convert_to_unibyte
1651 for this invocation.
1652 READFUN, if non-nil, is used instead of `read'.
1654 START, END specify region to read in current buffer (from eval-region).
1655 If the input is not from a buffer, they must be nil. */
1658 readevalloop (Lisp_Object readcharfun
,
1660 Lisp_Object sourcename
,
1662 Lisp_Object unibyte
, Lisp_Object readfun
,
1663 Lisp_Object start
, Lisp_Object end
)
1666 register Lisp_Object val
;
1667 int count
= SPECPDL_INDEX ();
1668 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1669 struct buffer
*b
= 0;
1670 int continue_reading_p
;
1671 Lisp_Object lex_bound
;
1672 /* Nonzero if reading an entire buffer. */
1673 int whole_buffer
= 0;
1674 /* 1 on the first time around. */
1677 if (MARKERP (readcharfun
))
1680 start
= readcharfun
;
1683 if (BUFFERP (readcharfun
))
1684 b
= XBUFFER (readcharfun
);
1685 else if (MARKERP (readcharfun
))
1686 b
= XMARKER (readcharfun
)->buffer
;
1688 /* We assume START is nil when input is not from a buffer. */
1689 if (! NILP (start
) && !b
)
1692 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1693 specbind (Qcurrent_load_list
, Qnil
);
1694 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1695 load_convert_to_unibyte
= !NILP (unibyte
);
1697 /* If lexical binding is active (either because it was specified in
1698 the file's header, or via a buffer-local variable), create an empty
1699 lexical environment, otherwise, turn off lexical binding. */
1700 lex_bound
= find_symbol_value (Qlexical_binding
);
1701 specbind (Qinternal_interpreter_environment
,
1702 NILP (lex_bound
) || EQ (lex_bound
, Qunbound
)
1703 ? Qnil
: Fcons (Qt
, Qnil
));
1705 GCPRO4 (sourcename
, readfun
, start
, end
);
1707 /* Try to ensure sourcename is a truename, except whilst preloading. */
1708 if (NILP (Vpurify_flag
)
1709 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1710 && !NILP (Ffboundp (Qfile_truename
)))
1711 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1713 LOADHIST_ATTACH (sourcename
);
1715 continue_reading_p
= 1;
1716 while (continue_reading_p
)
1718 int count1
= SPECPDL_INDEX ();
1720 if (b
!= 0 && NILP (b
->name
))
1721 error ("Reading from killed buffer");
1725 /* Switch to the buffer we are reading from. */
1726 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1727 set_buffer_internal (b
);
1729 /* Save point in it. */
1730 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1731 /* Save ZV in it. */
1732 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1733 /* Those get unbound after we read one expression. */
1735 /* Set point and ZV around stuff to be read. */
1738 Fnarrow_to_region (make_number (BEGV
), end
);
1740 /* Just for cleanliness, convert END to a marker
1741 if it is an integer. */
1743 end
= Fpoint_max_marker ();
1746 /* On the first cycle, we can easily test here
1747 whether we are reading the whole buffer. */
1748 if (b
&& first_sexp
)
1749 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1756 while ((c
= READCHAR
) != '\n' && c
!= -1);
1761 unbind_to (count1
, Qnil
);
1765 /* Ignore whitespace here, so we can detect eof. */
1766 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1767 || c
== 0x8a0) /* NBSP */
1770 if (!NILP (Vpurify_flag
) && c
== '(')
1772 record_unwind_protect (unreadpure
, Qnil
);
1773 val
= read_list (-1, readcharfun
);
1778 read_objects
= Qnil
;
1779 if (!NILP (readfun
))
1781 val
= call1 (readfun
, readcharfun
);
1783 /* If READCHARFUN has set point to ZV, we should
1784 stop reading, even if the form read sets point
1785 to a different value when evaluated. */
1786 if (BUFFERP (readcharfun
))
1788 struct buffer
*b
= XBUFFER (readcharfun
);
1789 if (BUF_PT (b
) == BUF_ZV (b
))
1790 continue_reading_p
= 0;
1793 else if (! NILP (Vload_read_function
))
1794 val
= call1 (Vload_read_function
, readcharfun
);
1796 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1799 if (!NILP (start
) && continue_reading_p
)
1800 start
= Fpoint_marker ();
1802 /* Restore saved point and BEGV. */
1803 unbind_to (count1
, Qnil
);
1805 /* Now eval what we just read. */
1806 val
= eval_sub (val
);
1810 Vvalues
= Fcons (val
, Vvalues
);
1811 if (EQ (Vstandard_output
, Qt
))
1820 build_load_history (sourcename
,
1821 stream
|| whole_buffer
);
1825 unbind_to (count
, Qnil
);
1828 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1829 doc
: /* Execute the current buffer as Lisp code.
1830 When called from a Lisp program (i.e., not interactively), this
1831 function accepts up to five optional arguments:
1832 BUFFER is the buffer to evaluate (nil means use current buffer).
1833 PRINTFLAG controls printing of output:
1834 A value of nil means discard it; anything else is stream for print.
1835 FILENAME specifies the file name to use for `load-history'.
1836 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1838 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1839 functions should work normally even if PRINTFLAG is nil.
1841 This function preserves the position of point. */)
1842 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1844 int count
= SPECPDL_INDEX ();
1845 Lisp_Object tem
, buf
;
1848 buf
= Fcurrent_buffer ();
1850 buf
= Fget_buffer (buffer
);
1852 error ("No such buffer");
1854 if (NILP (printflag
) && NILP (do_allow_print
))
1859 if (NILP (filename
))
1860 filename
= XBUFFER (buf
)->filename
;
1862 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1863 specbind (Qstandard_output
, tem
);
1864 specbind (Qlexical_binding
, Qnil
);
1865 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1866 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1867 if (lisp_file_lexically_bound_p (buf
))
1868 Fset (Qlexical_binding
, Qt
);
1869 readevalloop (buf
, 0, filename
,
1870 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1871 unbind_to (count
, Qnil
);
1876 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1877 doc
: /* Execute the region as Lisp code.
1878 When called from programs, expects two arguments,
1879 giving starting and ending indices in the current buffer
1880 of the text to be executed.
1881 Programs can pass third argument PRINTFLAG which controls output:
1882 A value of nil means discard it; anything else is stream for printing it.
1883 Also the fourth argument READ-FUNCTION, if non-nil, is used
1884 instead of `read' to read each expression. It gets one argument
1885 which is the input stream for reading characters.
1887 This function does not move point. */)
1888 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1890 int count
= SPECPDL_INDEX ();
1891 Lisp_Object tem
, cbuf
;
1893 cbuf
= Fcurrent_buffer ();
1895 if (NILP (printflag
))
1899 specbind (Qstandard_output
, tem
);
1900 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1902 /* readevalloop calls functions which check the type of start and end. */
1903 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
,
1904 !NILP (printflag
), Qnil
, read_function
,
1907 return unbind_to (count
, Qnil
);
1911 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1912 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1913 If STREAM is nil, use the value of `standard-input' (which see).
1914 STREAM or the value of `standard-input' may be:
1915 a buffer (read from point and advance it)
1916 a marker (read from where it points and advance it)
1917 a function (call it with no arguments for each character,
1918 call it with a char as argument to push a char back)
1919 a string (takes text from string, starting at the beginning)
1920 t (read text line using minibuffer and use it, or read from
1921 standard input in batch mode). */)
1922 (Lisp_Object stream
)
1925 stream
= Vstandard_input
;
1926 if (EQ (stream
, Qt
))
1927 stream
= Qread_char
;
1928 if (EQ (stream
, Qread_char
))
1929 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1931 return read_internal_start (stream
, Qnil
, Qnil
);
1934 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1935 doc
: /* Read one Lisp expression which is represented as text by STRING.
1936 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1937 START and END optionally delimit a substring of STRING from which to read;
1938 they default to 0 and (length STRING) respectively. */)
1939 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1942 CHECK_STRING (string
);
1943 /* read_internal_start sets read_from_string_index. */
1944 ret
= read_internal_start (string
, start
, end
);
1945 return Fcons (ret
, make_number (read_from_string_index
));
1948 /* Function to set up the global context we need in toplevel read
1951 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1952 /* start, end only used when stream is a string. */
1957 new_backquote_flag
= 0;
1958 read_objects
= Qnil
;
1959 if (EQ (Vread_with_symbol_positions
, Qt
)
1960 || EQ (Vread_with_symbol_positions
, stream
))
1961 Vread_symbol_positions_list
= Qnil
;
1963 if (STRINGP (stream
)
1964 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1966 EMACS_INT startval
, endval
;
1969 if (STRINGP (stream
))
1972 string
= XCAR (stream
);
1975 endval
= SCHARS (string
);
1979 endval
= XINT (end
);
1980 if (endval
< 0 || endval
> SCHARS (string
))
1981 args_out_of_range (string
, end
);
1988 CHECK_NUMBER (start
);
1989 startval
= XINT (start
);
1990 if (startval
< 0 || startval
> endval
)
1991 args_out_of_range (string
, start
);
1993 read_from_string_index
= startval
;
1994 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1995 read_from_string_limit
= endval
;
1998 retval
= read0 (stream
);
1999 if (EQ (Vread_with_symbol_positions
, Qt
)
2000 || EQ (Vread_with_symbol_positions
, stream
))
2001 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2006 /* Signal Qinvalid_read_syntax error.
2007 S is error string of length N (if > 0) */
2010 invalid_syntax (const char *s
, int n
)
2014 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2018 /* Use this for recursive reads, in contexts where internal tokens
2022 read0 (Lisp_Object readcharfun
)
2024 register Lisp_Object val
;
2027 val
= read1 (readcharfun
, &c
, 0);
2031 xsignal1 (Qinvalid_read_syntax
,
2032 Fmake_string (make_number (1), make_number (c
)));
2035 static int read_buffer_size
;
2036 static char *read_buffer
;
2038 /* Read a \-escape sequence, assuming we already read the `\'.
2039 If the escape sequence forces unibyte, return eight-bit char. */
2042 read_escape (Lisp_Object readcharfun
, int stringp
)
2044 register int c
= READCHAR
;
2045 /* \u allows up to four hex digits, \U up to eight. Default to the
2046 behavior for \u, and change this value in the case that \U is seen. */
2047 int unicode_hex_count
= 4;
2052 end_of_file_error ();
2082 error ("Invalid escape character syntax");
2085 c
= read_escape (readcharfun
, 0);
2086 return c
| meta_modifier
;
2091 error ("Invalid escape character syntax");
2094 c
= read_escape (readcharfun
, 0);
2095 return c
| shift_modifier
;
2100 error ("Invalid escape character syntax");
2103 c
= read_escape (readcharfun
, 0);
2104 return c
| hyper_modifier
;
2109 error ("Invalid escape character syntax");
2112 c
= read_escape (readcharfun
, 0);
2113 return c
| alt_modifier
;
2117 if (stringp
|| c
!= '-')
2124 c
= read_escape (readcharfun
, 0);
2125 return c
| super_modifier
;
2130 error ("Invalid escape character syntax");
2134 c
= read_escape (readcharfun
, 0);
2135 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2136 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2137 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2138 return c
| ctrl_modifier
;
2139 /* ASCII control chars are made from letters (both cases),
2140 as well as the non-letters within 0100...0137. */
2141 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2142 return (c
& (037 | ~0177));
2143 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2144 return (c
& (037 | ~0177));
2146 return c
| ctrl_modifier
;
2156 /* An octal escape, as in ANSI C. */
2158 register int i
= c
- '0';
2159 register int count
= 0;
2162 if ((c
= READCHAR
) >= '0' && c
<= '7')
2174 if (i
>= 0x80 && i
< 0x100)
2175 i
= BYTE8_TO_CHAR (i
);
2180 /* A hex escape, as in ANSI C. */
2187 if (c
>= '0' && c
<= '9')
2192 else if ((c
>= 'a' && c
<= 'f')
2193 || (c
>= 'A' && c
<= 'F'))
2196 if (c
>= 'a' && c
<= 'f')
2209 if (count
< 3 && i
>= 0x80)
2210 return BYTE8_TO_CHAR (i
);
2215 /* Post-Unicode-2.0: Up to eight hex chars. */
2216 unicode_hex_count
= 8;
2219 /* A Unicode escape. We only permit them in strings and characters,
2220 not arbitrarily in the source code, as in some other languages. */
2225 while (++count
<= unicode_hex_count
)
2228 /* isdigit and isalpha may be locale-specific, which we don't
2230 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2231 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2232 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2235 error ("Non-hex digit used for Unicode escape");
2240 error ("Non-Unicode character: 0x%x", i
);
2249 /* Read an integer in radix RADIX using READCHARFUN to read
2250 characters. RADIX must be in the interval [2..36]; if it isn't, a
2251 read error is signaled . Value is the integer read. Signals an
2252 error if encountering invalid read syntax or if RADIX is out of
2256 read_integer (Lisp_Object readcharfun
, int radix
)
2258 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2259 /* We use a floating point number because */
2262 if (radix
< 2 || radix
> 36)
2266 number
= ndigits
= invalid_p
= 0;
2282 if (c
>= '0' && c
<= '9')
2284 else if (c
>= 'a' && c
<= 'z')
2285 digit
= c
- 'a' + 10;
2286 else if (c
>= 'A' && c
<= 'Z')
2287 digit
= c
- 'A' + 10;
2294 if (digit
< 0 || digit
>= radix
)
2297 number
= radix
* number
+ digit
;
2303 if (ndigits
== 0 || invalid_p
)
2306 sprintf (buf
, "integer, radix %d", radix
);
2307 invalid_syntax (buf
, 0);
2310 return make_fixnum_or_float (sign
* number
);
2314 /* If the next token is ')' or ']' or '.', we store that character
2315 in *PCH and the return value is not interesting. Else, we store
2316 zero in *PCH and we read and return one lisp object.
2318 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2321 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2324 int uninterned_symbol
= 0;
2332 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2334 end_of_file_error ();
2339 return read_list (0, readcharfun
);
2342 return read_vector (readcharfun
, 0);
2358 /* Accept extended format for hashtables (extensible to
2360 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2361 Lisp_Object tmp
= read_list (0, readcharfun
);
2362 Lisp_Object head
= CAR_SAFE (tmp
);
2363 Lisp_Object data
= Qnil
;
2364 Lisp_Object val
= Qnil
;
2365 /* The size is 2 * number of allowed keywords to
2367 Lisp_Object params
[10];
2369 Lisp_Object key
= Qnil
;
2370 int param_count
= 0;
2372 if (!EQ (head
, Qhash_table
))
2373 error ("Invalid extended read marker at head of #s list "
2374 "(only hash-table allowed)");
2376 tmp
= CDR_SAFE (tmp
);
2378 /* This is repetitive but fast and simple. */
2379 params
[param_count
] = QCsize
;
2380 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2381 if (!NILP (params
[param_count
+ 1]))
2384 params
[param_count
] = QCtest
;
2385 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2386 if (!NILP (params
[param_count
+ 1]))
2389 params
[param_count
] = QCweakness
;
2390 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2391 if (!NILP (params
[param_count
+ 1]))
2394 params
[param_count
] = QCrehash_size
;
2395 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2396 if (!NILP (params
[param_count
+ 1]))
2399 params
[param_count
] = QCrehash_threshold
;
2400 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2401 if (!NILP (params
[param_count
+ 1]))
2404 /* This is the hashtable data. */
2405 data
= Fplist_get (tmp
, Qdata
);
2407 /* Now use params to make a new hashtable and fill it. */
2408 ht
= Fmake_hash_table (param_count
, params
);
2410 while (CONSP (data
))
2415 error ("Odd number of elements in hashtable data");
2418 Fputhash (key
, val
, ht
);
2424 invalid_syntax ("#", 1);
2432 tmp
= read_vector (readcharfun
, 0);
2433 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2434 error ("Invalid size char-table");
2435 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2446 tmp
= read_vector (readcharfun
, 0);
2447 if (!INTEGERP (AREF (tmp
, 0)))
2448 error ("Invalid depth in char-table");
2449 depth
= XINT (AREF (tmp
, 0));
2450 if (depth
< 1 || depth
> 3)
2451 error ("Invalid depth in char-table");
2452 size
= XVECTOR (tmp
)->size
- 2;
2453 if (chartab_size
[depth
] != size
)
2454 error ("Invalid size char-table");
2455 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2458 invalid_syntax ("#^^", 3);
2460 invalid_syntax ("#^", 2);
2465 length
= read1 (readcharfun
, pch
, first_in_list
);
2469 Lisp_Object tmp
, val
;
2471 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2472 / BOOL_VECTOR_BITS_PER_CHAR
);
2475 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2476 if (STRING_MULTIBYTE (tmp
)
2477 || (size_in_chars
!= SCHARS (tmp
)
2478 /* We used to print 1 char too many
2479 when the number of bits was a multiple of 8.
2480 Accept such input in case it came from an old
2482 && ! (XFASTINT (length
)
2483 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2484 invalid_syntax ("#&...", 5);
2486 val
= Fmake_bool_vector (length
, Qnil
);
2487 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2488 /* Clear the extraneous bits in the last byte. */
2489 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2490 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2491 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2494 invalid_syntax ("#&...", 5);
2497 /* `function vector' objects, including byte-compiled functions. */
2498 return read_vector (readcharfun
, 1);
2502 struct gcpro gcpro1
;
2505 /* Read the string itself. */
2506 tmp
= read1 (readcharfun
, &ch
, 0);
2507 if (ch
!= 0 || !STRINGP (tmp
))
2508 invalid_syntax ("#", 1);
2510 /* Read the intervals and their properties. */
2513 Lisp_Object beg
, end
, plist
;
2515 beg
= read1 (readcharfun
, &ch
, 0);
2520 end
= read1 (readcharfun
, &ch
, 0);
2522 plist
= read1 (readcharfun
, &ch
, 0);
2524 invalid_syntax ("Invalid string property list", 0);
2525 Fset_text_properties (beg
, end
, plist
, tmp
);
2531 /* #@NUMBER is used to skip NUMBER following characters.
2532 That's used in .elc files to skip over doc strings
2533 and function definitions. */
2539 /* Read a decimal integer. */
2540 while ((c
= READCHAR
) >= 0
2541 && c
>= '0' && c
<= '9')
2549 if (load_force_doc_strings
2550 && (EQ (readcharfun
, Qget_file_char
)
2551 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2553 /* If we are supposed to force doc strings into core right now,
2554 record the last string that we skipped,
2555 and record where in the file it comes from. */
2557 /* But first exchange saved_doc_string
2558 with prev_saved_doc_string, so we save two strings. */
2560 char *temp
= saved_doc_string
;
2561 int temp_size
= saved_doc_string_size
;
2562 file_offset temp_pos
= saved_doc_string_position
;
2563 int temp_len
= saved_doc_string_length
;
2565 saved_doc_string
= prev_saved_doc_string
;
2566 saved_doc_string_size
= prev_saved_doc_string_size
;
2567 saved_doc_string_position
= prev_saved_doc_string_position
;
2568 saved_doc_string_length
= prev_saved_doc_string_length
;
2570 prev_saved_doc_string
= temp
;
2571 prev_saved_doc_string_size
= temp_size
;
2572 prev_saved_doc_string_position
= temp_pos
;
2573 prev_saved_doc_string_length
= temp_len
;
2576 if (saved_doc_string_size
== 0)
2578 saved_doc_string_size
= nskip
+ 100;
2579 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2581 if (nskip
> saved_doc_string_size
)
2583 saved_doc_string_size
= nskip
+ 100;
2584 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2585 saved_doc_string_size
);
2588 saved_doc_string_position
= file_tell (instream
);
2590 /* Copy that many characters into saved_doc_string. */
2591 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2592 saved_doc_string
[i
] = c
= READCHAR
;
2594 saved_doc_string_length
= i
;
2598 /* Skip that many characters. */
2599 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2608 /* #! appears at the beginning of an executable file.
2609 Skip the first line. */
2610 while (c
!= '\n' && c
>= 0)
2615 return Vload_file_name
;
2617 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2618 /* #:foo is the uninterned symbol named foo. */
2621 uninterned_symbol
= 1;
2625 /* Reader forms that can reuse previously read objects. */
2626 if (c
>= '0' && c
<= '9')
2631 /* Read a non-negative integer. */
2632 while (c
>= '0' && c
<= '9')
2638 /* #n=object returns object, but associates it with n for #n#. */
2639 if (c
== '=' && !NILP (Vread_circle
))
2641 /* Make a placeholder for #n# to use temporarily */
2642 Lisp_Object placeholder
;
2645 placeholder
= Fcons (Qnil
, Qnil
);
2646 cell
= Fcons (make_number (n
), placeholder
);
2647 read_objects
= Fcons (cell
, read_objects
);
2649 /* Read the object itself. */
2650 tem
= read0 (readcharfun
);
2652 /* Now put it everywhere the placeholder was... */
2653 substitute_object_in_subtree (tem
, placeholder
);
2655 /* ...and #n# will use the real value from now on. */
2656 Fsetcdr (cell
, tem
);
2660 /* #n# returns a previously read object. */
2661 if (c
== '#' && !NILP (Vread_circle
))
2663 tem
= Fassq (make_number (n
), read_objects
);
2666 /* Fall through to error message. */
2668 else if (c
== 'r' || c
== 'R')
2669 return read_integer (readcharfun
, n
);
2671 /* Fall through to error message. */
2673 else if (c
== 'x' || c
== 'X')
2674 return read_integer (readcharfun
, 16);
2675 else if (c
== 'o' || c
== 'O')
2676 return read_integer (readcharfun
, 8);
2677 else if (c
== 'b' || c
== 'B')
2678 return read_integer (readcharfun
, 2);
2681 invalid_syntax ("#", 1);
2684 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2689 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2694 int next_char
= READCHAR
;
2696 /* Transition from old-style to new-style:
2697 If we see "(`" it used to mean old-style, which usually works
2698 fine because ` should almost never appear in such a position
2699 for new-style. But occasionally we need "(`" to mean new
2700 style, so we try to distinguish the two by the fact that we
2701 can either write "( `foo" or "(` foo", where the first
2702 intends to use new-style whereas the second intends to use
2703 old-style. For Emacs-25, we should completely remove this
2704 first_in_list exception (old-style can still be obtained via
2706 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2708 Vold_style_backquotes
= Qt
;
2715 new_backquote_flag
++;
2716 value
= read0 (readcharfun
);
2717 new_backquote_flag
--;
2719 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2724 int next_char
= READCHAR
;
2726 /* Transition from old-style to new-style:
2727 It used to be impossible to have a new-style , other than within
2728 a new-style `. This is sufficient when ` and , are used in the
2729 normal way, but ` and , can also appear in args to macros that
2730 will not interpret them in the usual way, in which case , may be
2731 used without any ` anywhere near.
2732 So we now use the same heuristic as for backquote: old-style
2733 unquotes are only recognized when first on a list, and when
2734 followed by a space.
2735 Because it's more difficult to peak 2 chars ahead, a new-style
2736 ,@ can still not be used outside of a `, unless it's in the middle
2738 if (new_backquote_flag
2740 || (next_char
!= ' ' && next_char
!= '@'))
2742 Lisp_Object comma_type
= Qnil
;
2747 comma_type
= Qcomma_at
;
2749 comma_type
= Qcomma_dot
;
2752 if (ch
>= 0) UNREAD (ch
);
2753 comma_type
= Qcomma
;
2756 value
= read0 (readcharfun
);
2757 return Fcons (comma_type
, Fcons (value
, Qnil
));
2761 Vold_style_backquotes
= Qt
;
2773 end_of_file_error ();
2775 /* Accept `single space' syntax like (list ? x) where the
2776 whitespace character is SPC or TAB.
2777 Other literal whitespace like NL, CR, and FF are not accepted,
2778 as there are well-established escape sequences for these. */
2779 if (c
== ' ' || c
== '\t')
2780 return make_number (c
);
2783 c
= read_escape (readcharfun
, 0);
2784 modifiers
= c
& CHAR_MODIFIER_MASK
;
2785 c
&= ~CHAR_MODIFIER_MASK
;
2786 if (CHAR_BYTE8_P (c
))
2787 c
= CHAR_TO_BYTE8 (c
);
2790 next_char
= READCHAR
;
2791 ok
= (next_char
<= 040
2792 || (next_char
< 0200
2793 && (strchr ("\"';()[]#?`,.", next_char
))));
2796 return make_number (c
);
2798 invalid_syntax ("?", 1);
2803 char *p
= read_buffer
;
2804 char *end
= read_buffer
+ read_buffer_size
;
2806 /* Nonzero if we saw an escape sequence specifying
2807 a multibyte character. */
2808 int force_multibyte
= 0;
2809 /* Nonzero if we saw an escape sequence specifying
2810 a single-byte character. */
2811 int force_singlebyte
= 0;
2815 while ((c
= READCHAR
) >= 0
2818 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2820 int offset
= p
- read_buffer
;
2821 read_buffer
= (char *) xrealloc (read_buffer
,
2822 read_buffer_size
*= 2);
2823 p
= read_buffer
+ offset
;
2824 end
= read_buffer
+ read_buffer_size
;
2831 c
= read_escape (readcharfun
, 1);
2833 /* C is -1 if \ newline has just been seen */
2836 if (p
== read_buffer
)
2841 modifiers
= c
& CHAR_MODIFIER_MASK
;
2842 c
= c
& ~CHAR_MODIFIER_MASK
;
2844 if (CHAR_BYTE8_P (c
))
2845 force_singlebyte
= 1;
2846 else if (! ASCII_CHAR_P (c
))
2847 force_multibyte
= 1;
2848 else /* i.e. ASCII_CHAR_P (c) */
2850 /* Allow `\C- ' and `\C-?'. */
2851 if (modifiers
== CHAR_CTL
)
2854 c
= 0, modifiers
= 0;
2856 c
= 127, modifiers
= 0;
2858 if (modifiers
& CHAR_SHIFT
)
2860 /* Shift modifier is valid only with [A-Za-z]. */
2861 if (c
>= 'A' && c
<= 'Z')
2862 modifiers
&= ~CHAR_SHIFT
;
2863 else if (c
>= 'a' && c
<= 'z')
2864 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2867 if (modifiers
& CHAR_META
)
2869 /* Move the meta bit to the right place for a
2871 modifiers
&= ~CHAR_META
;
2872 c
= BYTE8_TO_CHAR (c
| 0x80);
2873 force_singlebyte
= 1;
2877 /* Any modifiers remaining are invalid. */
2879 error ("Invalid modifier in string");
2880 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2884 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2885 if (CHAR_BYTE8_P (c
))
2886 force_singlebyte
= 1;
2887 else if (! ASCII_CHAR_P (c
))
2888 force_multibyte
= 1;
2894 end_of_file_error ();
2896 /* If purifying, and string starts with \ newline,
2897 return zero instead. This is for doc strings
2898 that we are really going to find in etc/DOC.nn.nn */
2899 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2900 return make_number (0);
2902 if (force_multibyte
)
2903 /* READ_BUFFER already contains valid multibyte forms. */
2905 else if (force_singlebyte
)
2907 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2908 p
= read_buffer
+ nchars
;
2911 /* Otherwise, READ_BUFFER contains only ASCII. */
2914 /* We want readchar_count to be the number of characters, not
2915 bytes. Hence we adjust for multibyte characters in the
2916 string. ... But it doesn't seem to be necessary, because
2917 READCHAR *does* read multibyte characters from buffers. */
2918 /* readchar_count -= (p - read_buffer) - nchars; */
2920 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2922 || (p
- read_buffer
!= nchars
)));
2923 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2925 || (p
- read_buffer
!= nchars
)));
2930 int next_char
= READCHAR
;
2933 if (next_char
<= 040
2934 || (next_char
< 0200
2935 && (strchr ("\"';([#?`,", next_char
))))
2941 /* Otherwise, we fall through! Note that the atom-reading loop
2942 below will now loop at least once, assuring that we will not
2943 try to UNREAD two characters in a row. */
2947 if (c
<= 040) goto retry
;
2948 if (c
== 0x8a0) /* NBSP */
2951 char *p
= read_buffer
;
2955 char *end
= read_buffer
+ read_buffer_size
;
2959 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2961 int offset
= p
- read_buffer
;
2962 read_buffer
= (char *) xrealloc (read_buffer
,
2963 read_buffer_size
*= 2);
2964 p
= read_buffer
+ offset
;
2965 end
= read_buffer
+ read_buffer_size
;
2972 end_of_file_error ();
2977 p
+= CHAR_STRING (c
, p
);
2982 && c
!= 0x8a0 /* NBSP */
2984 || !(strchr ("\"';()[]#`,", c
))));
2988 int offset
= p
- read_buffer
;
2989 read_buffer
= (char *) xrealloc (read_buffer
,
2990 read_buffer_size
*= 2);
2991 p
= read_buffer
+ offset
;
2992 end
= read_buffer
+ read_buffer_size
;
2999 if (!quoted
&& !uninterned_symbol
)
3003 if (*p1
== '+' || *p1
== '-') p1
++;
3004 /* Is it an integer? */
3007 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3008 /* Integers can have trailing decimal points. */
3009 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3011 /* It is an integer. */
3016 /* EMACS_INT n = atol (read_buffer); */
3017 char *endptr
= NULL
;
3018 EMACS_INT n
= (errno
= 0,
3019 strtol (read_buffer
, &endptr
, 10));
3020 if (errno
== ERANGE
&& endptr
)
3023 = Fcons (make_string (read_buffer
,
3024 endptr
- read_buffer
),
3026 xsignal (Qoverflow_error
, args
);
3028 return make_fixnum_or_float (n
);
3032 if (isfloat_string (read_buffer
, 0))
3034 /* Compute NaN and infinities using 0.0 in a variable,
3035 to cope with compilers that think they are smarter
3041 /* Negate the value ourselves. This treats 0, NaNs,
3042 and infinity properly on IEEE floating point hosts,
3043 and works around a common bug where atof ("-0.0")
3045 int negative
= read_buffer
[0] == '-';
3047 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3048 returns 1, is if the input ends in e+INF or e+NaN. */
3055 value
= zero
/ zero
;
3057 /* If that made a "negative" NaN, negate it. */
3061 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3064 u_minus_zero
.d
= - 0.0;
3065 for (i
= 0; i
< sizeof (double); i
++)
3066 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3072 /* Now VALUE is a positive NaN. */
3075 value
= atof (read_buffer
+ negative
);
3079 return make_float (negative
? - value
: value
);
3083 Lisp_Object name
, result
;
3084 EMACS_INT nbytes
= p
- read_buffer
;
3086 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3089 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3090 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3092 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3093 result
= (uninterned_symbol
? Fmake_symbol (name
)
3094 : Fintern (name
, Qnil
));
3096 if (EQ (Vread_with_symbol_positions
, Qt
)
3097 || EQ (Vread_with_symbol_positions
, readcharfun
))
3098 Vread_symbol_positions_list
=
3099 /* Kind of a hack; this will probably fail if characters
3100 in the symbol name were escaped. Not really a big
3102 Fcons (Fcons (result
,
3103 make_number (readchar_count
3104 - XFASTINT (Flength (Fsymbol_name (result
))))),
3105 Vread_symbol_positions_list
);
3113 /* List of nodes we've seen during substitute_object_in_subtree. */
3114 static Lisp_Object seen_list
;
3117 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3119 Lisp_Object check_object
;
3121 /* We haven't seen any objects when we start. */
3124 /* Make all the substitutions. */
3126 = substitute_object_recurse (object
, placeholder
, object
);
3128 /* Clear seen_list because we're done with it. */
3131 /* The returned object here is expected to always eq the
3133 if (!EQ (check_object
, object
))
3134 error ("Unexpected mutation error in reader");
3137 /* Feval doesn't get called from here, so no gc protection is needed. */
3138 #define SUBSTITUTE(get_val, set_val) \
3140 Lisp_Object old_value = get_val; \
3141 Lisp_Object true_value \
3142 = substitute_object_recurse (object, placeholder, \
3145 if (!EQ (old_value, true_value)) \
3152 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3154 /* If we find the placeholder, return the target object. */
3155 if (EQ (placeholder
, subtree
))
3158 /* If we've been to this node before, don't explore it again. */
3159 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3162 /* If this node can be the entry point to a cycle, remember that
3163 we've seen it. It can only be such an entry point if it was made
3164 by #n=, which means that we can find it as a value in
3166 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3167 seen_list
= Fcons (subtree
, seen_list
);
3169 /* Recurse according to subtree's type.
3170 Every branch must return a Lisp_Object. */
3171 switch (XTYPE (subtree
))
3173 case Lisp_Vectorlike
:
3176 if (BOOL_VECTOR_P (subtree
))
3177 return subtree
; /* No sub-objects anyway. */
3178 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3179 || COMPILEDP (subtree
))
3180 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3181 else if (VECTORP (subtree
))
3182 length
= ASIZE (subtree
);
3184 /* An unknown pseudovector may contain non-Lisp fields, so we
3185 can't just blindly traverse all its fields. We used to call
3186 `Flength' which signaled `sequencep', so I just preserved this
3188 wrong_type_argument (Qsequencep
, subtree
);
3190 for (i
= 0; i
< length
; i
++)
3191 SUBSTITUTE (AREF (subtree
, i
),
3192 ASET (subtree
, i
, true_value
));
3198 SUBSTITUTE (XCAR (subtree
),
3199 XSETCAR (subtree
, true_value
));
3200 SUBSTITUTE (XCDR (subtree
),
3201 XSETCDR (subtree
, true_value
));
3207 /* Check for text properties in each interval.
3208 substitute_in_interval contains part of the logic. */
3210 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3211 Lisp_Object arg
= Fcons (object
, placeholder
);
3213 traverse_intervals_noorder (root_interval
,
3214 &substitute_in_interval
, arg
);
3219 /* Other types don't recurse any further. */
3225 /* Helper function for substitute_object_recurse. */
3227 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3229 Lisp_Object object
= Fcar (arg
);
3230 Lisp_Object placeholder
= Fcdr (arg
);
3232 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3243 isfloat_string (const char *cp
, int ignore_trailing
)
3246 const char *start
= cp
;
3249 if (*cp
== '+' || *cp
== '-')
3252 if (*cp
>= '0' && *cp
<= '9')
3255 while (*cp
>= '0' && *cp
<= '9')
3263 if (*cp
>= '0' && *cp
<= '9')
3266 while (*cp
>= '0' && *cp
<= '9')
3269 if (*cp
== 'e' || *cp
== 'E')
3273 if (*cp
== '+' || *cp
== '-')
3277 if (*cp
>= '0' && *cp
<= '9')
3280 while (*cp
>= '0' && *cp
<= '9')
3283 else if (cp
== start
)
3285 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3290 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3296 return ((ignore_trailing
3297 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3298 || *cp
== '\r' || *cp
== '\f')
3299 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3300 || state
== (DOT_CHAR
|TRAIL_INT
)
3301 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3302 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3303 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3308 read_vector (Lisp_Object readcharfun
, int read_funvec
)
3312 register Lisp_Object
*ptr
;
3313 register Lisp_Object tem
, item
, vector
;
3314 register struct Lisp_Cons
*otem
;
3316 /* If we're reading a funvec object we start out assuming it's also a
3317 byte-code object (a subset of funvecs), so we can do any special
3318 processing needed. If it's just an ordinary funvec object, we'll
3319 realize that as soon as we've read the first element. */
3320 int read_bytecode
= read_funvec
;
3322 tem
= read_list (1, readcharfun
);
3323 len
= Flength (tem
);
3324 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3326 size
= XVECTOR (vector
)->size
;
3327 ptr
= XVECTOR (vector
)->contents
;
3328 for (i
= 0; i
< size
; i
++)
3332 /* If READ_BYTECODE is set, check whether this is really a byte-code
3333 object, or just an ordinary `funvec' object -- non-byte-code
3334 funvec objects use the same reader syntax. We can tell from the
3335 first element which one it is. */
3336 if (read_bytecode
&& i
== 0 && ! FUNVEC_COMPILED_TAG_P (item
))
3337 read_bytecode
= 0; /* Nope. */
3339 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3340 bytecode object, the docstring containing the bytecode and
3341 constants values must be treated as unibyte and passed to
3342 Fread, to get the actual bytecode string and constants vector. */
3343 if (read_bytecode
&& load_force_doc_strings
)
3345 if (i
== COMPILED_BYTECODE
)
3347 if (!STRINGP (item
))
3348 error ("Invalid byte code");
3350 /* Delay handling the bytecode slot until we know whether
3351 it is lazily-loaded (we can tell by whether the
3352 constants slot is nil). */
3353 ptr
[COMPILED_CONSTANTS
] = item
;
3356 else if (i
== COMPILED_CONSTANTS
)
3358 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3362 /* Coerce string to unibyte (like string-as-unibyte,
3363 but without generating extra garbage and
3364 guaranteeing no change in the contents). */
3365 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3366 STRING_SET_UNIBYTE (bytestr
);
3368 item
= Fread (Fcons (bytestr
, readcharfun
));
3370 error ("Invalid byte code");
3372 otem
= XCONS (item
);
3373 bytestr
= XCAR (item
);
3378 /* Now handle the bytecode slot. */
3379 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3381 else if (i
== COMPILED_DOC_STRING
3383 && ! STRING_MULTIBYTE (item
))
3385 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3386 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3388 item
= Fstring_as_multibyte (item
);
3391 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3397 if (read_bytecode
&& size
>= 4)
3398 /* Convert this vector to a bytecode object. */
3399 vector
= Fmake_byte_code (size
, XVECTOR (vector
)->contents
);
3400 else if (read_funvec
&& size
>= 1)
3401 /* Convert this vector to an ordinary funvec object. */
3402 XSETFUNVEC (vector
, XVECTOR (vector
));
3407 /* FLAG = 1 means check for ] to terminate rather than ) and .
3408 FLAG = -1 means check for starting with defun
3409 and make structure pure. */
3412 read_list (int flag
, register Lisp_Object readcharfun
)
3414 /* -1 means check next element for defun,
3415 0 means don't check,
3416 1 means already checked and found defun. */
3417 int defunflag
= flag
< 0 ? -1 : 0;
3418 Lisp_Object val
, tail
;
3419 register Lisp_Object elt
, tem
;
3420 struct gcpro gcpro1
, gcpro2
;
3421 /* 0 is the normal case.
3422 1 means this list is a doc reference; replace it with the number 0.
3423 2 means this list is a doc reference; replace it with the doc string. */
3424 int doc_reference
= 0;
3426 /* Initialize this to 1 if we are reading a list. */
3427 int first_in_list
= flag
<= 0;
3436 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3441 /* While building, if the list starts with #$, treat it specially. */
3442 if (EQ (elt
, Vload_file_name
)
3444 && !NILP (Vpurify_flag
))
3446 if (NILP (Vdoc_file_name
))
3447 /* We have not yet called Snarf-documentation, so assume
3448 this file is described in the DOC-MM.NN file
3449 and Snarf-documentation will fill in the right value later.
3450 For now, replace the whole list with 0. */
3453 /* We have already called Snarf-documentation, so make a relative
3454 file name for this file, so it can be found properly
3455 in the installed Lisp directory.
3456 We don't use Fexpand_file_name because that would make
3457 the directory absolute now. */
3458 elt
= concat2 (build_string ("../lisp/"),
3459 Ffile_name_nondirectory (elt
));
3461 else if (EQ (elt
, Vload_file_name
)
3463 && load_force_doc_strings
)
3472 invalid_syntax (") or . in a vector", 18);
3480 XSETCDR (tail
, read0 (readcharfun
));
3482 val
= read0 (readcharfun
);
3483 read1 (readcharfun
, &ch
, 0);
3487 if (doc_reference
== 1)
3488 return make_number (0);
3489 if (doc_reference
== 2)
3491 /* Get a doc string from the file we are loading.
3492 If it's in saved_doc_string, get it from there.
3494 Here, we don't know if the string is a
3495 bytecode string or a doc string. As a
3496 bytecode string must be unibyte, we always
3497 return a unibyte string. If it is actually a
3498 doc string, caller must make it
3501 int pos
= XINT (XCDR (val
));
3502 /* Position is negative for user variables. */
3503 if (pos
< 0) pos
= -pos
;
3504 if (pos
>= saved_doc_string_position
3505 && pos
< (saved_doc_string_position
3506 + saved_doc_string_length
))
3508 int start
= pos
- saved_doc_string_position
;
3511 /* Process quoting with ^A,
3512 and find the end of the string,
3513 which is marked with ^_ (037). */
3514 for (from
= start
, to
= start
;
3515 saved_doc_string
[from
] != 037;)
3517 int c
= saved_doc_string
[from
++];
3520 c
= saved_doc_string
[from
++];
3522 saved_doc_string
[to
++] = c
;
3524 saved_doc_string
[to
++] = 0;
3526 saved_doc_string
[to
++] = 037;
3529 saved_doc_string
[to
++] = c
;
3532 return make_unibyte_string (saved_doc_string
+ start
,
3535 /* Look in prev_saved_doc_string the same way. */
3536 else if (pos
>= prev_saved_doc_string_position
3537 && pos
< (prev_saved_doc_string_position
3538 + prev_saved_doc_string_length
))
3540 int start
= pos
- prev_saved_doc_string_position
;
3543 /* Process quoting with ^A,
3544 and find the end of the string,
3545 which is marked with ^_ (037). */
3546 for (from
= start
, to
= start
;
3547 prev_saved_doc_string
[from
] != 037;)
3549 int c
= prev_saved_doc_string
[from
++];
3552 c
= prev_saved_doc_string
[from
++];
3554 prev_saved_doc_string
[to
++] = c
;
3556 prev_saved_doc_string
[to
++] = 0;
3558 prev_saved_doc_string
[to
++] = 037;
3561 prev_saved_doc_string
[to
++] = c
;
3564 return make_unibyte_string (prev_saved_doc_string
3569 return get_doc_string (val
, 1, 0);
3574 invalid_syntax (". in wrong context", 18);
3576 invalid_syntax ("] in a list", 11);
3578 tem
= (read_pure
&& flag
<= 0
3579 ? pure_cons (elt
, Qnil
)
3580 : Fcons (elt
, Qnil
));
3582 XSETCDR (tail
, tem
);
3587 defunflag
= EQ (elt
, Qdefun
);
3588 else if (defunflag
> 0)
3593 Lisp_Object initial_obarray
;
3595 /* oblookup stores the bucket number here, for the sake of Funintern. */
3597 int oblookup_last_bucket_number
;
3599 static int hash_string (const unsigned char *ptr
, int len
);
3601 /* Get an error if OBARRAY is not an obarray.
3602 If it is one, return it. */
3605 check_obarray (Lisp_Object obarray
)
3607 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3609 /* If Vobarray is now invalid, force it to be valid. */
3610 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3611 wrong_type_argument (Qvectorp
, obarray
);
3616 /* Intern the C string STR: return a symbol with that name,
3617 interned in the current obarray. */
3620 intern (const char *str
)
3623 int len
= strlen (str
);
3624 Lisp_Object obarray
;
3627 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3628 obarray
= check_obarray (obarray
);
3629 tem
= oblookup (obarray
, str
, len
, len
);
3632 return Fintern (make_string (str
, len
), obarray
);
3636 intern_c_string (const char *str
)
3639 int len
= strlen (str
);
3640 Lisp_Object obarray
;
3643 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3644 obarray
= check_obarray (obarray
);
3645 tem
= oblookup (obarray
, str
, len
, len
);
3649 if (NILP (Vpurify_flag
))
3650 /* Creating a non-pure string from a string literal not
3651 implemented yet. We could just use make_string here and live
3652 with the extra copy. */
3655 return Fintern (make_pure_c_string (str
), obarray
);
3658 /* Create an uninterned symbol with name STR. */
3661 make_symbol (const char *str
)
3663 int len
= strlen (str
);
3665 return Fmake_symbol (!NILP (Vpurify_flag
)
3666 ? make_pure_string (str
, len
, len
, 0)
3667 : make_string (str
, len
));
3670 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3671 doc
: /* Return the canonical symbol whose name is STRING.
3672 If there is none, one is created by this function and returned.
3673 A second optional argument specifies the obarray to use;
3674 it defaults to the value of `obarray'. */)
3675 (Lisp_Object string
, Lisp_Object obarray
)
3677 register Lisp_Object tem
, sym
, *ptr
;
3679 if (NILP (obarray
)) obarray
= Vobarray
;
3680 obarray
= check_obarray (obarray
);
3682 CHECK_STRING (string
);
3684 tem
= oblookup (obarray
, SSDATA (string
),
3687 if (!INTEGERP (tem
))
3690 if (!NILP (Vpurify_flag
))
3691 string
= Fpurecopy (string
);
3692 sym
= Fmake_symbol (string
);
3694 if (EQ (obarray
, initial_obarray
))
3695 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3697 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3699 if ((SREF (string
, 0) == ':')
3700 && EQ (obarray
, initial_obarray
))
3702 XSYMBOL (sym
)->constant
= 1;
3703 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3704 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3707 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3709 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3711 XSYMBOL (sym
)->next
= 0;
3716 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3717 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3718 NAME may be a string or a symbol. If it is a symbol, that exact
3719 symbol is searched for.
3720 A second optional argument specifies the obarray to use;
3721 it defaults to the value of `obarray'. */)
3722 (Lisp_Object name
, Lisp_Object obarray
)
3724 register Lisp_Object tem
, string
;
3726 if (NILP (obarray
)) obarray
= Vobarray
;
3727 obarray
= check_obarray (obarray
);
3729 if (!SYMBOLP (name
))
3731 CHECK_STRING (name
);
3735 string
= SYMBOL_NAME (name
);
3737 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3738 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3744 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3745 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3746 The value is t if a symbol was found and deleted, nil otherwise.
3747 NAME may be a string or a symbol. If it is a symbol, that symbol
3748 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3749 OBARRAY defaults to the value of the variable `obarray'. */)
3750 (Lisp_Object name
, Lisp_Object obarray
)
3752 register Lisp_Object string
, tem
;
3755 if (NILP (obarray
)) obarray
= Vobarray
;
3756 obarray
= check_obarray (obarray
);
3759 string
= SYMBOL_NAME (name
);
3762 CHECK_STRING (name
);
3766 tem
= oblookup (obarray
, SSDATA (string
),
3771 /* If arg was a symbol, don't delete anything but that symbol itself. */
3772 if (SYMBOLP (name
) && !EQ (name
, tem
))
3775 /* There are plenty of other symbols which will screw up the Emacs
3776 session if we unintern them, as well as even more ways to use
3777 `setq' or `fset' or whatnot to make the Emacs session
3778 unusable. Let's not go down this silly road. --Stef */
3779 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3780 error ("Attempt to unintern t or nil"); */
3782 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3784 hash
= oblookup_last_bucket_number
;
3786 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3788 if (XSYMBOL (tem
)->next
)
3789 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3791 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3795 Lisp_Object tail
, following
;
3797 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3798 XSYMBOL (tail
)->next
;
3801 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3802 if (EQ (following
, tem
))
3804 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3813 /* Return the symbol in OBARRAY whose names matches the string
3814 of SIZE characters (SIZE_BYTE bytes) at PTR.
3815 If there is no such symbol in OBARRAY, return nil.
3817 Also store the bucket number in oblookup_last_bucket_number. */
3820 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3824 register Lisp_Object tail
;
3825 Lisp_Object bucket
, tem
;
3827 if (!VECTORP (obarray
)
3828 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3830 obarray
= check_obarray (obarray
);
3831 obsize
= XVECTOR (obarray
)->size
;
3833 /* This is sometimes needed in the middle of GC. */
3834 obsize
&= ~ARRAY_MARK_FLAG
;
3835 hash
= hash_string (ptr
, size_byte
) % obsize
;
3836 bucket
= XVECTOR (obarray
)->contents
[hash
];
3837 oblookup_last_bucket_number
= hash
;
3838 if (EQ (bucket
, make_number (0)))
3840 else if (!SYMBOLP (bucket
))
3841 error ("Bad data in guts of obarray"); /* Like CADR error message */
3843 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3845 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3846 && SCHARS (SYMBOL_NAME (tail
)) == size
3847 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3849 else if (XSYMBOL (tail
)->next
== 0)
3852 XSETINT (tem
, hash
);
3857 hash_string (const unsigned char *ptr
, int len
)
3859 register const unsigned char *p
= ptr
;
3860 register const unsigned char *end
= p
+ len
;
3861 register unsigned char c
;
3862 register int hash
= 0;
3867 if (c
>= 0140) c
-= 40;
3868 hash
= ((hash
<<3) + (hash
>>28) + c
);
3870 return hash
& 07777777777;
3874 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3877 register Lisp_Object tail
;
3878 CHECK_VECTOR (obarray
);
3879 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3881 tail
= XVECTOR (obarray
)->contents
[i
];
3886 if (XSYMBOL (tail
)->next
== 0)
3888 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3894 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3896 call1 (function
, sym
);
3899 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3900 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3901 OBARRAY defaults to the value of `obarray'. */)
3902 (Lisp_Object function
, Lisp_Object obarray
)
3904 if (NILP (obarray
)) obarray
= Vobarray
;
3905 obarray
= check_obarray (obarray
);
3907 map_obarray (obarray
, mapatoms_1
, function
);
3911 #define OBARRAY_SIZE 1511
3916 Lisp_Object oblength
;
3918 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3920 Vobarray
= Fmake_vector (oblength
, make_number (0));
3921 initial_obarray
= Vobarray
;
3922 staticpro (&initial_obarray
);
3924 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3925 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3926 NILP (Vpurify_flag) check in intern_c_string. */
3927 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3928 Qnil
= intern_c_string ("nil");
3930 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3931 so those two need to be fixed manally. */
3932 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3933 XSYMBOL (Qunbound
)->function
= Qunbound
;
3934 XSYMBOL (Qunbound
)->plist
= Qnil
;
3935 /* XSYMBOL (Qnil)->function = Qunbound; */
3936 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3937 XSYMBOL (Qnil
)->constant
= 1;
3938 XSYMBOL (Qnil
)->plist
= Qnil
;
3940 Qt
= intern_c_string ("t");
3941 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3942 XSYMBOL (Qt
)->constant
= 1;
3944 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3947 Qvariable_documentation
= intern_c_string ("variable-documentation");
3948 staticpro (&Qvariable_documentation
);
3950 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3951 read_buffer
= (char *) xmalloc (read_buffer_size
);
3955 defsubr (struct Lisp_Subr
*sname
)
3958 sym
= intern_c_string (sname
->symbol_name
);
3959 XSETPVECTYPE (sname
, PVEC_SUBR
);
3960 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3963 #ifdef NOTDEF /* use fset in subr.el now */
3965 defalias (sname
, string
)
3966 struct Lisp_Subr
*sname
;
3970 sym
= intern (string
);
3971 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3975 /* Define an "integer variable"; a symbol whose value is forwarded to a
3976 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3977 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3979 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3980 const char *namestring
, EMACS_INT
*address
)
3983 sym
= intern_c_string (namestring
);
3984 i_fwd
->type
= Lisp_Fwd_Int
;
3985 i_fwd
->intvar
= address
;
3986 XSYMBOL (sym
)->declared_special
= 1;
3987 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3988 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3991 /* Similar but define a variable whose value is t if address contains 1,
3992 nil if address contains 0. */
3994 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3995 const char *namestring
, int *address
)
3998 sym
= intern_c_string (namestring
);
3999 b_fwd
->type
= Lisp_Fwd_Bool
;
4000 b_fwd
->boolvar
= address
;
4001 XSYMBOL (sym
)->declared_special
= 1;
4002 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4003 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4004 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4007 /* Similar but define a variable whose value is the Lisp Object stored
4008 at address. Two versions: with and without gc-marking of the C
4009 variable. The nopro version is used when that variable will be
4010 gc-marked for some other reason, since marking the same slot twice
4011 can cause trouble with strings. */
4013 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4014 const char *namestring
, Lisp_Object
*address
)
4017 sym
= intern_c_string (namestring
);
4018 o_fwd
->type
= Lisp_Fwd_Obj
;
4019 o_fwd
->objvar
= address
;
4020 XSYMBOL (sym
)->declared_special
= 1;
4021 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4022 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4026 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4027 const char *namestring
, Lisp_Object
*address
)
4029 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4030 staticpro (address
);
4034 /* Similar but define a variable whose value is the Lisp Object stored
4035 at a particular offset in the current kboard object. */
4038 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4039 const char *namestring
, int offset
)
4042 sym
= intern_c_string (namestring
);
4043 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4044 ko_fwd
->offset
= offset
;
4045 XSYMBOL (sym
)->declared_special
= 1;
4046 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4047 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4050 /* Record the value of load-path used at the start of dumping
4051 so we can see if the site changed it later during dumping. */
4052 static Lisp_Object dump_path
;
4058 int turn_off_warning
= 0;
4060 /* Compute the default load-path. */
4062 normal
= PATH_LOADSEARCH
;
4063 Vload_path
= decode_env_path (0, normal
);
4065 if (NILP (Vpurify_flag
))
4066 normal
= PATH_LOADSEARCH
;
4068 normal
= PATH_DUMPLOADSEARCH
;
4070 /* In a dumped Emacs, we normally have to reset the value of
4071 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4072 uses ../lisp, instead of the path of the installed elisp
4073 libraries. However, if it appears that Vload_path was changed
4074 from the default before dumping, don't override that value. */
4077 if (! NILP (Fequal (dump_path
, Vload_path
)))
4079 Vload_path
= decode_env_path (0, normal
);
4080 if (!NILP (Vinstallation_directory
))
4082 Lisp_Object tem
, tem1
, sitelisp
;
4084 /* Remove site-lisp dirs from path temporarily and store
4085 them in sitelisp, then conc them on at the end so
4086 they're always first in path. */
4090 tem
= Fcar (Vload_path
);
4091 tem1
= Fstring_match (build_string ("site-lisp"),
4095 Vload_path
= Fcdr (Vload_path
);
4096 sitelisp
= Fcons (tem
, sitelisp
);
4102 /* Add to the path the lisp subdir of the
4103 installation dir, if it exists. */
4104 tem
= Fexpand_file_name (build_string ("lisp"),
4105 Vinstallation_directory
);
4106 tem1
= Ffile_exists_p (tem
);
4109 if (NILP (Fmember (tem
, Vload_path
)))
4111 turn_off_warning
= 1;
4112 Vload_path
= Fcons (tem
, Vload_path
);
4116 /* That dir doesn't exist, so add the build-time
4117 Lisp dirs instead. */
4118 Vload_path
= nconc2 (Vload_path
, dump_path
);
4120 /* Add leim under the installation dir, if it exists. */
4121 tem
= Fexpand_file_name (build_string ("leim"),
4122 Vinstallation_directory
);
4123 tem1
= Ffile_exists_p (tem
);
4126 if (NILP (Fmember (tem
, Vload_path
)))
4127 Vload_path
= Fcons (tem
, Vload_path
);
4130 /* Add site-lisp under the installation dir, if it exists. */
4131 tem
= Fexpand_file_name (build_string ("site-lisp"),
4132 Vinstallation_directory
);
4133 tem1
= Ffile_exists_p (tem
);
4136 if (NILP (Fmember (tem
, Vload_path
)))
4137 Vload_path
= Fcons (tem
, Vload_path
);
4140 /* If Emacs was not built in the source directory,
4141 and it is run from where it was built, add to load-path
4142 the lisp, leim and site-lisp dirs under that directory. */
4144 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4148 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4149 Vinstallation_directory
);
4150 tem1
= Ffile_exists_p (tem
);
4152 /* Don't be fooled if they moved the entire source tree
4153 AFTER dumping Emacs. If the build directory is indeed
4154 different from the source dir, src/Makefile.in and
4155 src/Makefile will not be found together. */
4156 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4157 Vinstallation_directory
);
4158 tem2
= Ffile_exists_p (tem
);
4159 if (!NILP (tem1
) && NILP (tem2
))
4161 tem
= Fexpand_file_name (build_string ("lisp"),
4164 if (NILP (Fmember (tem
, Vload_path
)))
4165 Vload_path
= Fcons (tem
, Vload_path
);
4167 tem
= Fexpand_file_name (build_string ("leim"),
4170 if (NILP (Fmember (tem
, Vload_path
)))
4171 Vload_path
= Fcons (tem
, Vload_path
);
4173 tem
= Fexpand_file_name (build_string ("site-lisp"),
4176 if (NILP (Fmember (tem
, Vload_path
)))
4177 Vload_path
= Fcons (tem
, Vload_path
);
4180 if (!NILP (sitelisp
) && !no_site_lisp
)
4181 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4187 /* NORMAL refers to the lisp dir in the source directory. */
4188 /* We used to add ../lisp at the front here, but
4189 that caused trouble because it was copied from dump_path
4190 into Vload_path, above, when Vinstallation_directory was non-nil.
4191 It should be unnecessary. */
4192 Vload_path
= decode_env_path (0, normal
);
4193 dump_path
= Vload_path
;
4197 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4198 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4199 almost never correct, thereby causing a warning to be printed out that
4200 confuses users. Since PATH_LOADSEARCH is always overridden by the
4201 EMACSLOADPATH environment variable below, disable the warning on NT. */
4203 /* Warn if dirs in the *standard* path don't exist. */
4204 if (!turn_off_warning
)
4206 Lisp_Object path_tail
;
4208 for (path_tail
= Vload_path
;
4210 path_tail
= XCDR (path_tail
))
4212 Lisp_Object dirfile
;
4213 dirfile
= Fcar (path_tail
);
4214 if (STRINGP (dirfile
))
4216 dirfile
= Fdirectory_file_name (dirfile
);
4217 if (access (SSDATA (dirfile
), 0) < 0)
4218 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4223 #endif /* !(WINDOWSNT || HAVE_NS) */
4225 /* If the EMACSLOADPATH environment variable is set, use its value.
4226 This doesn't apply if we're dumping. */
4228 if (NILP (Vpurify_flag
)
4229 && egetenv ("EMACSLOADPATH"))
4231 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4235 load_in_progress
= 0;
4236 Vload_file_name
= Qnil
;
4238 load_descriptor_list
= Qnil
;
4240 Vstandard_input
= Qt
;
4241 Vloads_in_progress
= Qnil
;
4244 /* Print a warning, using format string FORMAT, that directory DIRNAME
4245 does not exist. Print it on stderr and put it in *Messages*. */
4248 dir_warning (const char *format
, Lisp_Object dirname
)
4251 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4253 fprintf (stderr
, format
, SDATA (dirname
));
4254 sprintf (buffer
, format
, SDATA (dirname
));
4255 /* Don't log the warning before we've initialized!! */
4257 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4261 syms_of_lread (void)
4264 defsubr (&Sread_from_string
);
4266 defsubr (&Sintern_soft
);
4267 defsubr (&Sunintern
);
4268 defsubr (&Sget_load_suffixes
);
4270 defsubr (&Seval_buffer
);
4271 defsubr (&Seval_region
);
4272 defsubr (&Sread_char
);
4273 defsubr (&Sread_char_exclusive
);
4274 defsubr (&Sread_event
);
4275 defsubr (&Sget_file_char
);
4276 defsubr (&Smapatoms
);
4277 defsubr (&Slocate_file_internal
);
4279 DEFVAR_LISP ("obarray", Vobarray
,
4280 doc
: /* Symbol table for use by `intern' and `read'.
4281 It is a vector whose length ought to be prime for best results.
4282 The vector's contents don't make sense if examined from Lisp programs;
4283 to find all the symbols in an obarray, use `mapatoms'. */);
4285 DEFVAR_LISP ("values", Vvalues
,
4286 doc
: /* List of values of all expressions which were read, evaluated and printed.
4287 Order is reverse chronological. */);
4289 DEFVAR_LISP ("standard-input", Vstandard_input
,
4290 doc
: /* Stream for read to get input from.
4291 See documentation of `read' for possible values. */);
4292 Vstandard_input
= Qt
;
4294 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4295 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4297 If this variable is a buffer, then only forms read from that buffer
4298 will be added to `read-symbol-positions-list'.
4299 If this variable is t, then all read forms will be added.
4300 The effect of all other values other than nil are not currently
4301 defined, although they may be in the future.
4303 The positions are relative to the last call to `read' or
4304 `read-from-string'. It is probably a bad idea to set this variable at
4305 the toplevel; bind it instead. */);
4306 Vread_with_symbol_positions
= Qnil
;
4308 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4309 doc
: /* A list mapping read symbols to their positions.
4310 This variable is modified during calls to `read' or
4311 `read-from-string', but only when `read-with-symbol-positions' is
4314 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4315 CHAR-POSITION is an integer giving the offset of that occurrence of the
4316 symbol from the position where `read' or `read-from-string' started.
4318 Note that a symbol will appear multiple times in this list, if it was
4319 read multiple times. The list is in the same order as the symbols
4321 Vread_symbol_positions_list
= Qnil
;
4323 DEFVAR_LISP ("read-circle", Vread_circle
,
4324 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4327 DEFVAR_LISP ("load-path", Vload_path
,
4328 doc
: /* *List of directories to search for files to load.
4329 Each element is a string (directory name) or nil (try default directory).
4330 Initialized based on EMACSLOADPATH environment variable, if any,
4331 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4333 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4334 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4335 This list should not include the empty string.
4336 `load' and related functions try to append these suffixes, in order,
4337 to the specified file name if a Lisp suffix is allowed or required. */);
4338 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4339 Fcons (make_pure_c_string (".el"), Qnil
));
4340 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4341 doc
: /* List of suffixes that indicate representations of \
4343 This list should normally start with the empty string.
4345 Enabling Auto Compression mode appends the suffixes in
4346 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4347 mode removes them again. `load' and related functions use this list to
4348 determine whether they should look for compressed versions of a file
4349 and, if so, which suffixes they should try to append to the file name
4350 in order to do so. However, if you want to customize which suffixes
4351 the loading functions recognize as compression suffixes, you should
4352 customize `jka-compr-load-suffixes' rather than the present variable. */);
4353 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4355 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4356 doc
: /* Non-nil if inside of `load'. */);
4357 Qload_in_progress
= intern_c_string ("load-in-progress");
4358 staticpro (&Qload_in_progress
);
4360 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4361 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4362 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4364 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4365 a symbol \(a feature name).
4367 When `load' is run and the file-name argument matches an element's
4368 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4369 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4371 An error in FORMS does not undo the load, but does prevent execution of
4372 the rest of the FORMS. */);
4373 Vafter_load_alist
= Qnil
;
4375 DEFVAR_LISP ("load-history", Vload_history
,
4376 doc
: /* Alist mapping loaded file names to symbols and features.
4377 Each alist element should be a list (FILE-NAME ENTRIES...), where
4378 FILE-NAME is the name of a file that has been loaded into Emacs.
4379 The file name is absolute and true (i.e. it doesn't contain symlinks).
4380 As an exception, one of the alist elements may have FILE-NAME nil,
4381 for symbols and features not associated with any file.
4383 The remaining ENTRIES in the alist element describe the functions and
4384 variables defined in that file, the features provided, and the
4385 features required. Each entry has the form `(provide . FEATURE)',
4386 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4387 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4388 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4389 SYMBOL was an autoload before this file redefined it as a function.
4391 During preloading, the file name recorded is relative to the main Lisp
4392 directory. These file names are converted to absolute at startup. */);
4393 Vload_history
= Qnil
;
4395 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4396 doc
: /* Full name of file being loaded by `load'. */);
4397 Vload_file_name
= Qnil
;
4399 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4400 doc
: /* File name, including directory, of user's initialization file.
4401 If the file loaded had extension `.elc', and the corresponding source file
4402 exists, this variable contains the name of source file, suitable for use
4403 by functions like `custom-save-all' which edit the init file.
4404 While Emacs loads and evaluates the init file, value is the real name
4405 of the file, regardless of whether or not it has the `.elc' extension. */);
4406 Vuser_init_file
= Qnil
;
4408 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4409 doc
: /* Used for internal purposes by `load'. */);
4410 Vcurrent_load_list
= Qnil
;
4412 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4413 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4414 The default is nil, which means use the function `read'. */);
4415 Vload_read_function
= Qnil
;
4417 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4418 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4419 This function is for doing code conversion before reading the source file.
4420 If nil, loading is done without any code conversion.
4421 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4422 FULLNAME is the full name of FILE.
4423 See `load' for the meaning of the remaining arguments. */);
4424 Vload_source_file_function
= Qnil
;
4426 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4427 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4428 This is useful when the file being loaded is a temporary copy. */);
4429 load_force_doc_strings
= 0;
4431 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4432 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4433 This is normally bound by `load' and `eval-buffer' to control `read',
4434 and is not meant for users to change. */);
4435 load_convert_to_unibyte
= 0;
4437 DEFVAR_LISP ("source-directory", Vsource_directory
,
4438 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4439 You cannot count on them to still be there! */);
4441 = Fexpand_file_name (build_string ("../"),
4442 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4444 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4445 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4446 Vpreloaded_file_list
= Qnil
;
4448 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4449 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4450 Vbyte_boolean_vars
= Qnil
;
4452 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4453 doc
: /* Non-nil means load dangerous compiled Lisp files.
4454 Some versions of XEmacs use different byte codes than Emacs. These
4455 incompatible byte codes can make Emacs crash when it tries to execute
4457 load_dangerous_libraries
= 0;
4459 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4460 doc
: /* Non-nil means force printing messages when loading Lisp files.
4461 This overrides the value of the NOMESSAGE argument to `load'. */);
4462 force_load_messages
= 0;
4464 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4465 doc
: /* Regular expression matching safe to load compiled Lisp files.
4466 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4467 from the file, and matches them against this regular expression.
4468 When the regular expression matches, the file is considered to be safe
4469 to load. See also `load-dangerous-libraries'. */);
4470 Vbytecomp_version_regexp
4471 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4473 Qlexical_binding
= intern ("lexical-binding");
4474 staticpro (&Qlexical_binding
);
4475 DEFVAR_LISP ("lexical-binding", Vlexical_binding
,
4476 doc
: /* If non-nil, use lexical binding when evaluating code.
4477 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4478 This variable is automatically set from the file variables of an interpreted
4479 lisp file read using `load'. */);
4480 Fmake_variable_buffer_local (Qlexical_binding
);
4482 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4483 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4484 Veval_buffer_list
= Qnil
;
4486 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4487 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4488 Vold_style_backquotes
= Qnil
;
4489 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4490 staticpro (&Qold_style_backquotes
);
4492 /* Vsource_directory was initialized in init_lread. */
4494 load_descriptor_list
= Qnil
;
4495 staticpro (&load_descriptor_list
);
4497 Qcurrent_load_list
= intern_c_string ("current-load-list");
4498 staticpro (&Qcurrent_load_list
);
4500 Qstandard_input
= intern_c_string ("standard-input");
4501 staticpro (&Qstandard_input
);
4503 Qread_char
= intern_c_string ("read-char");
4504 staticpro (&Qread_char
);
4506 Qget_file_char
= intern_c_string ("get-file-char");
4507 staticpro (&Qget_file_char
);
4509 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4510 staticpro (&Qget_emacs_mule_file_char
);
4512 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4513 staticpro (&Qload_force_doc_strings
);
4515 Qbackquote
= intern_c_string ("`");
4516 staticpro (&Qbackquote
);
4517 Qcomma
= intern_c_string (",");
4518 staticpro (&Qcomma
);
4519 Qcomma_at
= intern_c_string (",@");
4520 staticpro (&Qcomma_at
);
4521 Qcomma_dot
= intern_c_string (",.");
4522 staticpro (&Qcomma_dot
);
4524 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4525 staticpro (&Qinhibit_file_name_operation
);
4527 Qascii_character
= intern_c_string ("ascii-character");
4528 staticpro (&Qascii_character
);
4530 Qfunction
= intern_c_string ("function");
4531 staticpro (&Qfunction
);
4533 Qload
= intern_c_string ("load");
4536 Qload_file_name
= intern_c_string ("load-file-name");
4537 staticpro (&Qload_file_name
);
4539 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4540 staticpro (&Qeval_buffer_list
);
4542 Qfile_truename
= intern_c_string ("file-truename");
4543 staticpro (&Qfile_truename
) ;
4545 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4546 staticpro (&Qdo_after_load_evaluation
) ;
4548 staticpro (&dump_path
);
4550 staticpro (&read_objects
);
4551 read_objects
= Qnil
;
4552 staticpro (&seen_list
);
4555 Vloads_in_progress
= Qnil
;
4556 staticpro (&Vloads_in_progress
);
4558 Qhash_table
= intern_c_string ("hash-table");
4559 staticpro (&Qhash_table
);
4560 Qdata
= intern_c_string ("data");
4562 Qtest
= intern_c_string ("test");
4564 Qsize
= intern_c_string ("size");
4566 Qweakness
= intern_c_string ("weakness");
4567 staticpro (&Qweakness
);
4568 Qrehash_size
= intern_c_string ("rehash-size");
4569 staticpro (&Qrehash_size
);
4570 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4571 staticpro (&Qrehash_threshold
);