1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
65 #define file_offset off_t
66 #define file_tell ftello
68 #define file_offset long
69 #define file_tell ftell
72 /* hash table read constants */
73 Lisp_Object Qhash_table
, Qdata
;
74 Lisp_Object Qtest
, Qsize
;
75 Lisp_Object Qweakness
;
76 Lisp_Object Qrehash_size
;
77 Lisp_Object Qrehash_threshold
;
78 extern Lisp_Object QCtest
, QCsize
, QCrehash_size
, QCrehash_threshold
, QCweakness
;
80 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
81 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
82 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
83 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
84 Lisp_Object Qinhibit_file_name_operation
;
85 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
86 Lisp_Object Qlexical_binding
;
87 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
89 /* Used instead of Qget_file_char while loading *.elc files compiled
90 by Emacs 21 or older. */
91 static Lisp_Object Qget_emacs_mule_file_char
;
93 static Lisp_Object Qload_force_doc_strings
;
95 extern Lisp_Object Qevent_symbol_element_mask
;
96 extern Lisp_Object Qfile_exists_p
;
97 extern Lisp_Object Qinternal_interpreter_environment
;
99 /* non-zero if inside `load' */
100 int load_in_progress
;
101 static Lisp_Object Qload_in_progress
;
103 /* Directory in which the sources were found. */
104 Lisp_Object Vsource_directory
;
106 /* Search path and suffixes for files to be loaded. */
107 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
109 /* File name of user's init file. */
110 Lisp_Object Vuser_init_file
;
112 /* This is the user-visible association list that maps features to
113 lists of defs in their load files. */
114 Lisp_Object Vload_history
;
116 /* This is used to build the load history. */
117 Lisp_Object Vcurrent_load_list
;
119 /* List of files that were preloaded. */
120 Lisp_Object Vpreloaded_file_list
;
122 /* Name of file actually being read by `load'. */
123 Lisp_Object Vload_file_name
;
125 /* Function to use for reading, in `load' and friends. */
126 Lisp_Object Vload_read_function
;
128 /* Non-nil means read recursive structures using #n= and #n# syntax. */
129 Lisp_Object Vread_circle
;
131 /* The association list of objects read with the #n=object form.
132 Each member of the list has the form (n . object), and is used to
133 look up the object for the corresponding #n# construct.
134 It must be set to nil before all top-level calls to read0. */
135 Lisp_Object read_objects
;
137 /* Nonzero means load should forcibly load all dynamic doc strings. */
138 static int load_force_doc_strings
;
140 /* Nonzero means read should convert strings to unibyte. */
141 static int load_convert_to_unibyte
;
143 /* Nonzero means READCHAR should read bytes one by one (not character)
144 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
145 This is set to 1 by read1 temporarily while handling #@NUMBER. */
146 static int load_each_byte
;
148 /* Function to use for loading an Emacs Lisp source file (not
149 compiled) instead of readevalloop. */
150 Lisp_Object Vload_source_file_function
;
152 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
153 Lisp_Object Vbyte_boolean_vars
;
155 /* Whether or not to add a `read-positions' property to symbols
157 Lisp_Object Vread_with_symbol_positions
;
159 /* List of (SYMBOL . POSITION) accumulated so far. */
160 Lisp_Object Vread_symbol_positions_list
;
162 /* If non-nil `readevalloop' evaluates code in a lexical environment. */
163 Lisp_Object Vlexical_binding
;
165 /* List of descriptors now open for Fload. */
166 static Lisp_Object load_descriptor_list
;
168 /* File for get_file_char to read from. Use by load. */
169 static FILE *instream
;
171 /* When nonzero, read conses in pure space */
172 static int read_pure
;
174 /* For use within read-from-string (this reader is non-reentrant!!) */
175 static int read_from_string_index
;
176 static int read_from_string_index_byte
;
177 static int read_from_string_limit
;
179 /* Number of characters read in the current call to Fread or
180 Fread_from_string. */
181 static int readchar_count
;
183 /* This contains the last string skipped with #@. */
184 static char *saved_doc_string
;
185 /* Length of buffer allocated in saved_doc_string. */
186 static int saved_doc_string_size
;
187 /* Length of actual data in saved_doc_string. */
188 static int saved_doc_string_length
;
189 /* This is the file position that string came from. */
190 static file_offset saved_doc_string_position
;
192 /* This contains the previous string skipped with #@.
193 We copy it from saved_doc_string when a new string
194 is put in saved_doc_string. */
195 static char *prev_saved_doc_string
;
196 /* Length of buffer allocated in prev_saved_doc_string. */
197 static int prev_saved_doc_string_size
;
198 /* Length of actual data in prev_saved_doc_string. */
199 static int prev_saved_doc_string_length
;
200 /* This is the file position that string came from. */
201 static file_offset prev_saved_doc_string_position
;
203 /* Nonzero means inside a new-style backquote
204 with no surrounding parentheses.
205 Fread initializes this to zero, so we need not specbind it
206 or worry about what happens to it when there is an error. */
207 static int new_backquote_flag
;
208 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
210 /* A list of file names for files being loaded in Fload. Used to
211 check for recursive loads. */
213 static Lisp_Object Vloads_in_progress
;
215 /* Non-zero means load dangerous compiled Lisp files. */
217 int load_dangerous_libraries
;
219 /* Non-zero means force printing messages when loading Lisp files. */
221 int force_load_messages
;
223 /* A regular expression used to detect files compiled with Emacs. */
225 static Lisp_Object Vbytecomp_version_regexp
;
227 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
230 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
,
231 Lisp_Object (*) (Lisp_Object
), int,
232 Lisp_Object
, Lisp_Object
,
233 Lisp_Object
, Lisp_Object
);
234 static Lisp_Object
load_unwind (Lisp_Object
);
235 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
237 static void invalid_syntax (const char *, int) NO_RETURN
;
238 static void end_of_file_error (void) NO_RETURN
;
241 /* Functions that read one byte from the current source READCHARFUN
242 or unreads one byte. If the integer argument C is -1, it returns
243 one read byte, or -1 when there's no more byte in the source. If C
244 is 0 or positive, it unreads C, and the return value is not
247 static int readbyte_for_lambda (int, Lisp_Object
);
248 static int readbyte_from_file (int, Lisp_Object
);
249 static int readbyte_from_string (int, Lisp_Object
);
251 /* Handle unreading and rereading of characters.
252 Write READCHAR to read a character,
253 UNREAD(c) to unread c to be read again.
255 These macros correctly read/unread multibyte characters. */
257 #define READCHAR readchar (readcharfun, NULL)
258 #define UNREAD(c) unreadchar (readcharfun, c)
260 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
261 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
263 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
264 Qlambda, or a cons, we use this to keep an unread character because
265 a file stream can't handle multibyte-char unreading. The value -1
266 means that there's no unread character. */
267 static int unread_char
;
270 readchar (Lisp_Object readcharfun
, int *multibyte
)
274 int (*readbyte
) (int, Lisp_Object
);
275 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
277 int emacs_mule_encoding
= 0;
284 if (BUFFERP (readcharfun
))
286 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
288 int pt_byte
= BUF_PT_BYTE (inbuffer
);
290 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
293 if (! NILP (inbuffer
->enable_multibyte_characters
))
295 /* Fetch the character code from the buffer. */
296 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
297 BUF_INC_POS (inbuffer
, pt_byte
);
304 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
305 if (! ASCII_BYTE_P (c
))
306 c
= BYTE8_TO_CHAR (c
);
309 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
313 if (MARKERP (readcharfun
))
315 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
317 int bytepos
= marker_byte_position (readcharfun
);
319 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
322 if (! NILP (inbuffer
->enable_multibyte_characters
))
324 /* Fetch the character code from the buffer. */
325 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
326 BUF_INC_POS (inbuffer
, bytepos
);
333 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
334 if (! ASCII_BYTE_P (c
))
335 c
= BYTE8_TO_CHAR (c
);
339 XMARKER (readcharfun
)->bytepos
= bytepos
;
340 XMARKER (readcharfun
)->charpos
++;
345 if (EQ (readcharfun
, Qlambda
))
347 readbyte
= readbyte_for_lambda
;
351 if (EQ (readcharfun
, Qget_file_char
))
353 readbyte
= readbyte_from_file
;
357 if (STRINGP (readcharfun
))
359 if (read_from_string_index
>= read_from_string_limit
)
361 else if (STRING_MULTIBYTE (readcharfun
))
365 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
366 read_from_string_index
,
367 read_from_string_index_byte
);
371 c
= SREF (readcharfun
, read_from_string_index_byte
);
372 read_from_string_index
++;
373 read_from_string_index_byte
++;
378 if (CONSP (readcharfun
))
380 /* This is the case that read_vector is reading from a unibyte
381 string that contains a byte sequence previously skipped
382 because of #@NUMBER. The car part of readcharfun is that
383 string, and the cdr part is a value of readcharfun given to
385 readbyte
= readbyte_from_string
;
386 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
387 emacs_mule_encoding
= 1;
391 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
393 readbyte
= readbyte_from_file
;
394 emacs_mule_encoding
= 1;
398 tem
= call0 (readcharfun
);
405 if (unread_char
>= 0)
411 c
= (*readbyte
) (-1, readcharfun
);
412 if (c
< 0 || load_each_byte
)
416 if (ASCII_BYTE_P (c
))
418 if (emacs_mule_encoding
)
419 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
422 len
= BYTES_BY_CHAR_HEAD (c
);
425 c
= (*readbyte
) (-1, readcharfun
);
426 if (c
< 0 || ! TRAILING_CODE_P (c
))
429 (*readbyte
) (buf
[i
], readcharfun
);
430 return BYTE8_TO_CHAR (buf
[0]);
434 return STRING_CHAR (buf
);
437 /* Unread the character C in the way appropriate for the stream READCHARFUN.
438 If the stream is a user function, call it with the char as argument. */
441 unreadchar (Lisp_Object readcharfun
, int c
)
445 /* Don't back up the pointer if we're unreading the end-of-input mark,
446 since readchar didn't advance it when we read it. */
448 else if (BUFFERP (readcharfun
))
450 struct buffer
*b
= XBUFFER (readcharfun
);
451 int bytepos
= BUF_PT_BYTE (b
);
454 if (! NILP (b
->enable_multibyte_characters
))
455 BUF_DEC_POS (b
, bytepos
);
459 BUF_PT_BYTE (b
) = bytepos
;
461 else if (MARKERP (readcharfun
))
463 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
464 int bytepos
= XMARKER (readcharfun
)->bytepos
;
466 XMARKER (readcharfun
)->charpos
--;
467 if (! NILP (b
->enable_multibyte_characters
))
468 BUF_DEC_POS (b
, bytepos
);
472 XMARKER (readcharfun
)->bytepos
= bytepos
;
474 else if (STRINGP (readcharfun
))
476 read_from_string_index
--;
477 read_from_string_index_byte
478 = string_char_to_byte (readcharfun
, read_from_string_index
);
480 else if (CONSP (readcharfun
))
484 else if (EQ (readcharfun
, Qlambda
))
488 else if (EQ (readcharfun
, Qget_file_char
)
489 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
494 ungetc (c
, instream
);
501 call1 (readcharfun
, make_number (c
));
505 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
507 return read_bytecode_char (c
>= 0);
512 readbyte_from_file (int c
, Lisp_Object readcharfun
)
517 ungetc (c
, instream
);
526 /* Interrupted reads have been observed while reading over the network */
527 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
539 return (c
== EOF
? -1 : c
);
543 readbyte_from_string (int c
, Lisp_Object readcharfun
)
545 Lisp_Object string
= XCAR (readcharfun
);
549 read_from_string_index
--;
550 read_from_string_index_byte
551 = string_char_to_byte (string
, read_from_string_index
);
554 if (read_from_string_index
>= read_from_string_limit
)
557 FETCH_STRING_CHAR_ADVANCE (c
, string
,
558 read_from_string_index
,
559 read_from_string_index_byte
);
564 /* Read one non-ASCII character from INSTREAM. The character is
565 encoded in `emacs-mule' and the first byte is already read in
568 extern char emacs_mule_bytes
[256];
571 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
573 /* Emacs-mule coding uses at most 4-byte for one character. */
574 unsigned char buf
[4];
575 int len
= emacs_mule_bytes
[c
];
576 struct charset
*charset
;
581 /* C is not a valid leading-code of `emacs-mule'. */
582 return BYTE8_TO_CHAR (c
);
588 c
= (*readbyte
) (-1, readcharfun
);
592 (*readbyte
) (buf
[i
], readcharfun
);
593 return BYTE8_TO_CHAR (buf
[0]);
600 charset
= emacs_mule_charset
[buf
[0]];
601 code
= buf
[1] & 0x7F;
605 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
606 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
608 charset
= emacs_mule_charset
[buf
[1]];
609 code
= buf
[2] & 0x7F;
613 charset
= emacs_mule_charset
[buf
[0]];
614 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
619 charset
= emacs_mule_charset
[buf
[1]];
620 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
622 c
= DECODE_CHAR (charset
, code
);
624 Fsignal (Qinvalid_read_syntax
,
625 Fcons (build_string ("invalid multibyte form"), Qnil
));
630 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
632 static Lisp_Object
read0 (Lisp_Object
);
633 static Lisp_Object
read1 (Lisp_Object
, int *, int);
635 static Lisp_Object
read_list (int, Lisp_Object
);
636 static Lisp_Object
read_vector (Lisp_Object
, int);
638 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
640 static void substitute_object_in_subtree (Lisp_Object
,
642 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
645 /* Get a character from the tty. */
647 /* Read input events until we get one that's acceptable for our purposes.
649 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
650 until we get a character we like, and then stuffed into
653 If ASCII_REQUIRED is non-zero, we check function key events to see
654 if the unmodified version of the symbol has a Qascii_character
655 property, and use that character, if present.
657 If ERROR_NONASCII is non-zero, we signal an error if the input we
658 get isn't an ASCII character with modifiers. If it's zero but
659 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
662 If INPUT_METHOD is nonzero, we invoke the current input method
663 if the character warrants that.
665 If SECONDS is a number, we wait that many seconds for input, and
666 return Qnil if no input arrives within that time. */
669 read_filtered_event (int no_switch_frame
, int ascii_required
,
670 int error_nonascii
, int input_method
, Lisp_Object seconds
)
672 Lisp_Object val
, delayed_switch_frame
;
675 #ifdef HAVE_WINDOW_SYSTEM
676 if (display_hourglass_p
)
680 delayed_switch_frame
= Qnil
;
682 /* Compute timeout. */
683 if (NUMBERP (seconds
))
685 EMACS_TIME wait_time
;
687 double duration
= extract_float (seconds
);
689 sec
= (int) duration
;
690 usec
= (duration
- sec
) * 1000000;
691 EMACS_GET_TIME (end_time
);
692 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
693 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
696 /* Read until we get an acceptable event. */
699 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
700 NUMBERP (seconds
) ? &end_time
: NULL
);
701 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
706 /* switch-frame events are put off until after the next ASCII
707 character. This is better than signaling an error just because
708 the last characters were typed to a separate minibuffer frame,
709 for example. Eventually, some code which can deal with
710 switch-frame events will read it and process it. */
712 && EVENT_HAS_PARAMETERS (val
)
713 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
715 delayed_switch_frame
= val
;
719 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
721 /* Convert certain symbols to their ASCII equivalents. */
724 Lisp_Object tem
, tem1
;
725 tem
= Fget (val
, Qevent_symbol_element_mask
);
728 tem1
= Fget (Fcar (tem
), Qascii_character
);
729 /* Merge this symbol's modifier bits
730 with the ASCII equivalent of its basic code. */
732 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
736 /* If we don't have a character now, deal with it appropriately. */
741 Vunread_command_events
= Fcons (val
, Qnil
);
742 error ("Non-character input-event");
749 if (! NILP (delayed_switch_frame
))
750 unread_switch_frame
= delayed_switch_frame
;
754 #ifdef HAVE_WINDOW_SYSTEM
755 if (display_hourglass_p
)
764 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
765 doc
: /* Read a character from the command input (keyboard or macro).
766 It is returned as a number.
767 If the character has modifiers, they are resolved and reflected to the
768 character code if possible (e.g. C-SPC -> 0).
770 If the user generates an event which is not a character (i.e. a mouse
771 click or function key event), `read-char' signals an error. As an
772 exception, switch-frame events are put off until non-character events
774 If you want to read non-character events, or ignore them, call
775 `read-event' or `read-char-exclusive' instead.
777 If the optional argument PROMPT is non-nil, display that as a prompt.
778 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
779 input method is turned on in the current buffer, that input method
780 is used for reading a character.
781 If the optional argument SECONDS is non-nil, it should be a number
782 specifying the maximum number of seconds to wait for input. If no
783 input arrives in that time, return nil. SECONDS may be a
784 floating-point value. */)
785 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
790 message_with_string ("%s", prompt
, 0);
791 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
793 return (NILP (val
) ? Qnil
794 : make_number (char_resolve_modifier_mask (XINT (val
))));
797 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
798 doc
: /* Read an event object from the input stream.
799 If the optional argument PROMPT is non-nil, display that as a prompt.
800 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
801 input method is turned on in the current buffer, that input method
802 is used for reading a character.
803 If the optional argument SECONDS is non-nil, it should be a number
804 specifying the maximum number of seconds to wait for input. If no
805 input arrives in that time, return nil. SECONDS may be a
806 floating-point value. */)
807 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
810 message_with_string ("%s", prompt
, 0);
811 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
814 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
815 doc
: /* Read a character from the command input (keyboard or macro).
816 It is returned as a number. Non-character events are ignored.
817 If the character has modifiers, they are resolved and reflected to the
818 character code if possible (e.g. C-SPC -> 0).
820 If the optional argument PROMPT is non-nil, display that as a prompt.
821 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
822 input method is turned on in the current buffer, that input method
823 is used for reading a character.
824 If the optional argument SECONDS is non-nil, it should be a number
825 specifying the maximum number of seconds to wait for input. If no
826 input arrives in that time, return nil. SECONDS may be a
827 floating-point value. */)
828 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
833 message_with_string ("%s", prompt
, 0);
835 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
837 return (NILP (val
) ? Qnil
838 : make_number (char_resolve_modifier_mask (XINT (val
))));
841 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
842 doc
: /* Don't use this yourself. */)
845 register Lisp_Object val
;
847 XSETINT (val
, getc (instream
));
855 /* Return true if the lisp code read using READCHARFUN defines a non-nil
856 `lexical-binding' file variable. After returning, the stream is
857 positioned following the first line, if it is a comment, otherwise
861 lisp_file_lexically_bound_p (readcharfun
)
862 Lisp_Object readcharfun
;
866 /* The first line isn't a comment, just give up. */
872 /* Look for an appropriate file-variable in the first line. */
876 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
877 } beg_end_state
= NOMINAL
;
878 int in_file_vars
= 0;
880 #define UPDATE_BEG_END_STATE(ch) \
881 if (beg_end_state == NOMINAL) \
882 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
883 else if (beg_end_state == AFTER_FIRST_DASH) \
884 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
885 else if (beg_end_state == AFTER_ASTERIX) \
888 in_file_vars = !in_file_vars; \
889 beg_end_state = NOMINAL; \
892 /* Skip until we get to the file vars, if any. */
896 UPDATE_BEG_END_STATE (ch
);
898 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
902 char var
[100], *var_end
, val
[100], *val_end
;
906 /* Read a variable name. */
907 while (ch
== ' ' || ch
== '\t')
911 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
913 if (var_end
< var
+ sizeof var
- 1)
915 UPDATE_BEG_END_STATE (ch
);
920 && (var_end
[-1] == ' ' || var_end
[-1] == '\t'))
926 /* Read a variable value. */
929 while (ch
== ' ' || ch
== '\t')
933 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
935 if (val_end
< val
+ sizeof val
- 1)
937 UPDATE_BEG_END_STATE (ch
);
941 /* The value was terminated by an end-marker, which
945 && (val_end
[-1] == ' ' || val_end
[-1] == '\t'))
949 if (strcmp (var
, "lexical-binding") == 0)
952 rv
= (strcmp (val
, "nil") != 0);
958 while (ch
!= '\n' && ch
!= EOF
)
966 /* Value is a version number of byte compiled code if the file
967 associated with file descriptor FD is a compiled Lisp file that's
968 safe to load. Only files compiled with Emacs are safe to load.
969 Files compiled with XEmacs can lead to a crash in Fbyte_code
970 because of an incompatible change in the byte compiler. */
973 safe_to_load_p (int fd
)
980 /* Read the first few bytes from the file, and look for a line
981 specifying the byte compiler version used. */
982 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
987 /* Skip to the next newline, skipping over the initial `ELC'
988 with NUL bytes following it, but note the version. */
989 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
994 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
1001 lseek (fd
, 0, SEEK_SET
);
1006 /* Callback for record_unwind_protect. Restore the old load list OLD,
1007 after loading a file successfully. */
1010 record_load_unwind (Lisp_Object old
)
1012 return Vloads_in_progress
= old
;
1015 /* This handler function is used via internal_condition_case_1. */
1018 load_error_handler (Lisp_Object data
)
1024 load_warn_old_style_backquotes (Lisp_Object file
)
1026 if (!NILP (Vold_style_backquotes
))
1028 Lisp_Object args
[2];
1029 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
1036 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1037 doc
: /* Return the suffixes that `load' should try if a suffix is \
1039 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1042 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1043 while (CONSP (suffixes
))
1045 Lisp_Object exts
= Vload_file_rep_suffixes
;
1046 suffix
= XCAR (suffixes
);
1047 suffixes
= XCDR (suffixes
);
1048 while (CONSP (exts
))
1052 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1055 return Fnreverse (lst
);
1058 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1059 doc
: /* Execute a file of Lisp code named FILE.
1060 First try FILE with `.elc' appended, then try with `.el',
1061 then try FILE unmodified (the exact suffixes in the exact order are
1062 determined by `load-suffixes'). Environment variable references in
1063 FILE are replaced with their values by calling `substitute-in-file-name'.
1064 This function searches the directories in `load-path'.
1066 If optional second arg NOERROR is non-nil,
1067 report no error if FILE doesn't exist.
1068 Print messages at start and end of loading unless
1069 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1071 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1072 suffixes `.elc' or `.el' to the specified name FILE.
1073 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1074 the suffix `.elc' or `.el'; don't accept just FILE unless
1075 it ends in one of those suffixes or includes a directory name.
1077 If this function fails to find a file, it may look for different
1078 representations of that file before trying another file.
1079 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1080 to the file name. Emacs uses this feature mainly to find compressed
1081 versions of files when Auto Compression mode is enabled.
1083 The exact suffixes that this function tries out, in the exact order,
1084 are given by the value of the variable `load-file-rep-suffixes' if
1085 NOSUFFIX is non-nil and by the return value of the function
1086 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1087 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1088 and then the former.
1090 Loading a file records its definitions, and its `provide' and
1091 `require' calls, in an element of `load-history' whose
1092 car is the file name loaded. See `load-history'.
1094 Return t if the file exists and loads successfully. */)
1095 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1097 register FILE *stream
;
1098 register int fd
= -1;
1099 int count
= SPECPDL_INDEX ();
1100 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1101 Lisp_Object found
, efound
, hist_file_name
;
1102 /* 1 means we printed the ".el is newer" message. */
1104 /* 1 means we are loading a compiled file. */
1106 Lisp_Object handler
;
1116 CHECK_STRING (file
);
1118 /* If file name is magic, call the handler. */
1119 /* This shouldn't be necessary any more now that `openp' handles it right.
1120 handler = Ffind_file_name_handler (file, Qload);
1121 if (!NILP (handler))
1122 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1124 /* Do this after the handler to avoid
1125 the need to gcpro noerror, nomessage and nosuffix.
1126 (Below here, we care only whether they are nil or not.)
1127 The presence of this call is the result of a historical accident:
1128 it used to be in every file-operation and when it got removed
1129 everywhere, it accidentally stayed here. Since then, enough people
1130 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1131 that it seemed risky to remove. */
1132 if (! NILP (noerror
))
1134 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1135 Qt
, load_error_handler
);
1140 file
= Fsubstitute_in_file_name (file
);
1143 /* Avoid weird lossage with null string as arg,
1144 since it would try to load a directory as a Lisp file */
1145 if (SCHARS (file
) > 0)
1147 int size
= SBYTES (file
);
1150 GCPRO2 (file
, found
);
1152 if (! NILP (must_suffix
))
1154 /* Don't insist on adding a suffix if FILE already ends with one. */
1156 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1159 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1161 /* Don't insist on adding a suffix
1162 if the argument includes a directory name. */
1163 else if (! NILP (Ffile_name_directory (file
)))
1167 fd
= openp (Vload_path
, file
,
1168 (!NILP (nosuffix
) ? Qnil
1169 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1170 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1171 tmp
[1] = Vload_file_rep_suffixes
,
1180 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1184 /* Tell startup.el whether or not we found the user's init file. */
1185 if (EQ (Qt
, Vuser_init_file
))
1186 Vuser_init_file
= found
;
1188 /* If FD is -2, that means openp found a magic file. */
1191 if (NILP (Fequal (found
, file
)))
1192 /* If FOUND is a different file name from FILE,
1193 find its handler even if we have already inhibited
1194 the `load' operation on FILE. */
1195 handler
= Ffind_file_name_handler (found
, Qt
);
1197 handler
= Ffind_file_name_handler (found
, Qload
);
1198 if (! NILP (handler
))
1199 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1202 /* Check if we're stuck in a recursive load cycle.
1204 2000-09-21: It's not possible to just check for the file loaded
1205 being a member of Vloads_in_progress. This fails because of the
1206 way the byte compiler currently works; `provide's are not
1207 evaluated, see font-lock.el/jit-lock.el as an example. This
1208 leads to a certain amount of ``normal'' recursion.
1210 Also, just loading a file recursively is not always an error in
1211 the general case; the second load may do something different. */
1215 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1216 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1220 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1222 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1223 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1226 /* All loads are by default dynamic, unless the file itself specifies
1227 otherwise using a file-variable in the first line. This is bound here
1228 so that it takes effect whether or not we use
1229 Vload_source_file_function. */
1230 specbind (Qlexical_binding
, Qnil
);
1232 /* Get the name for load-history. */
1233 hist_file_name
= (! NILP (Vpurify_flag
)
1234 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1235 tmp
[1] = Ffile_name_nondirectory (found
),
1241 /* Check for the presence of old-style quotes and warn about them. */
1242 specbind (Qold_style_backquotes
, Qnil
);
1243 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1245 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1246 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1247 /* Load .elc files directly, but not when they are
1248 remote and have no handler! */
1255 GCPRO3 (file
, found
, hist_file_name
);
1258 && ! (version
= safe_to_load_p (fd
)))
1261 if (!load_dangerous_libraries
)
1265 error ("File `%s' was not compiled in Emacs",
1268 else if (!NILP (nomessage
) && !force_load_messages
)
1269 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1274 efound
= ENCODE_FILE (found
);
1279 stat ((char *)SDATA (efound
), &s1
);
1280 SSET (efound
, SBYTES (efound
) - 1, 0);
1281 result
= stat ((char *)SDATA (efound
), &s2
);
1282 SSET (efound
, SBYTES (efound
) - 1, 'c');
1284 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1286 /* Make the progress messages mention that source is newer. */
1289 /* If we won't print another message, mention this anyway. */
1290 if (!NILP (nomessage
) && !force_load_messages
)
1292 Lisp_Object msg_file
;
1293 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1294 message_with_string ("Source file `%s' newer than byte-compiled file",
1303 /* We are loading a source file (*.el). */
1304 if (!NILP (Vload_source_file_function
))
1310 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1311 NILP (noerror
) ? Qnil
: Qt
,
1312 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1313 return unbind_to (count
, val
);
1317 GCPRO3 (file
, found
, hist_file_name
);
1321 efound
= ENCODE_FILE (found
);
1322 stream
= fopen ((char *) SDATA (efound
), fmode
);
1323 #else /* not WINDOWSNT */
1324 stream
= fdopen (fd
, fmode
);
1325 #endif /* not WINDOWSNT */
1329 error ("Failure to create stdio stream for %s", SDATA (file
));
1332 if (! NILP (Vpurify_flag
))
1333 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1335 if (NILP (nomessage
) || force_load_messages
)
1338 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1341 message_with_string ("Loading %s (source)...", file
, 1);
1343 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1345 else /* The typical case; compiled file newer than source file. */
1346 message_with_string ("Loading %s...", file
, 1);
1349 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1350 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1351 specbind (Qload_file_name
, found
);
1352 specbind (Qinhibit_file_name_operation
, Qnil
);
1353 load_descriptor_list
1354 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1356 specbind (Qload_in_progress
, Qt
);
1359 if (lisp_file_lexically_bound_p (Qget_file_char
))
1360 Fset (Qlexical_binding
, Qt
);
1362 if (! version
|| version
>= 22)
1363 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1364 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1367 /* We can't handle a file which was compiled with
1368 byte-compile-dynamic by older version of Emacs. */
1369 specbind (Qload_force_doc_strings
, Qt
);
1370 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1371 0, Qnil
, Qnil
, Qnil
, Qnil
);
1373 unbind_to (count
, Qnil
);
1375 /* Run any eval-after-load forms for this file */
1376 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1377 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1381 xfree (saved_doc_string
);
1382 saved_doc_string
= 0;
1383 saved_doc_string_size
= 0;
1385 xfree (prev_saved_doc_string
);
1386 prev_saved_doc_string
= 0;
1387 prev_saved_doc_string_size
= 0;
1389 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1392 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1395 message_with_string ("Loading %s (source)...done", file
, 1);
1397 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1399 else /* The typical case; compiled file newer than source file. */
1400 message_with_string ("Loading %s...done", file
, 1);
1407 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1410 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1421 load_descriptor_unwind (Lisp_Object oldlist
)
1423 load_descriptor_list
= oldlist
;
1427 /* Close all descriptors in use for Floads.
1428 This is used when starting a subprocess. */
1431 close_load_descs (void)
1435 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1436 emacs_close (XFASTINT (XCAR (tail
)));
1441 complete_filename_p (Lisp_Object pathname
)
1443 register const unsigned char *s
= SDATA (pathname
);
1444 return (IS_DIRECTORY_SEP (s
[0])
1445 || (SCHARS (pathname
) > 2
1446 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1449 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1450 doc
: /* Search for FILENAME through PATH.
1451 Returns the file's name in absolute form, or nil if not found.
1452 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1453 file name when searching.
1454 If non-nil, PREDICATE is used instead of `file-readable-p'.
1455 PREDICATE can also be an integer to pass to the access(2) function,
1456 in which case file-name-handlers are ignored. */)
1457 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1460 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1461 if (NILP (predicate
) && fd
> 0)
1467 /* Search for a file whose name is STR, looking in directories
1468 in the Lisp list PATH, and trying suffixes from SUFFIX.
1469 On success, returns a file descriptor. On failure, returns -1.
1471 SUFFIXES is a list of strings containing possible suffixes.
1472 The empty suffix is automatically added if the list is empty.
1474 PREDICATE non-nil means don't open the files,
1475 just look for one that satisfies the predicate. In this case,
1476 returns 1 on success. The predicate can be a lisp function or
1477 an integer to pass to `access' (in which case file-name-handlers
1480 If STOREPTR is nonzero, it points to a slot where the name of
1481 the file actually found should be stored as a Lisp string.
1482 nil is stored there on failure.
1484 If the file we find is remote, return -2
1485 but store the found remote file name in *STOREPTR. */
1488 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1493 register char *fn
= buf
;
1496 Lisp_Object filename
;
1498 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1499 Lisp_Object string
, tail
, encoded_fn
;
1500 int max_suffix_len
= 0;
1504 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1506 CHECK_STRING_CAR (tail
);
1507 max_suffix_len
= max (max_suffix_len
,
1508 SBYTES (XCAR (tail
)));
1511 string
= filename
= encoded_fn
= Qnil
;
1512 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1517 if (complete_filename_p (str
))
1520 for (; CONSP (path
); path
= XCDR (path
))
1522 filename
= Fexpand_file_name (str
, XCAR (path
));
1523 if (!complete_filename_p (filename
))
1524 /* If there are non-absolute elts in PATH (eg ".") */
1525 /* Of course, this could conceivably lose if luser sets
1526 default-directory to be something non-absolute... */
1528 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1529 if (!complete_filename_p (filename
))
1530 /* Give up on this path element! */
1534 /* Calculate maximum size of any filename made from
1535 this path element/specified file name and any possible suffix. */
1536 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1537 if (fn_size
< want_size
)
1538 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1540 /* Loop over suffixes. */
1541 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1542 CONSP (tail
); tail
= XCDR (tail
))
1544 int lsuffix
= SBYTES (XCAR (tail
));
1545 Lisp_Object handler
;
1548 /* Concatenate path element/specified name with the suffix.
1549 If the directory starts with /:, remove that. */
1550 if (SCHARS (filename
) > 2
1551 && SREF (filename
, 0) == '/'
1552 && SREF (filename
, 1) == ':')
1554 strncpy (fn
, SDATA (filename
) + 2,
1555 SBYTES (filename
) - 2);
1556 fn
[SBYTES (filename
) - 2] = 0;
1560 strncpy (fn
, SDATA (filename
),
1562 fn
[SBYTES (filename
)] = 0;
1565 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1566 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1568 /* Check that the file exists and is not a directory. */
1569 /* We used to only check for handlers on non-absolute file names:
1573 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1574 It's not clear why that was the case and it breaks things like
1575 (load "/bar.el") where the file is actually "/bar.el.gz". */
1576 string
= build_string (fn
);
1577 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1578 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1580 if (NILP (predicate
))
1581 exists
= !NILP (Ffile_readable_p (string
));
1583 exists
= !NILP (call1 (predicate
, string
));
1584 if (exists
&& !NILP (Ffile_directory_p (string
)))
1589 /* We succeeded; return this descriptor and filename. */
1600 encoded_fn
= ENCODE_FILE (string
);
1601 pfn
= SDATA (encoded_fn
);
1602 exists
= (stat (pfn
, &st
) >= 0
1603 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1606 /* Check that we can access or open it. */
1607 if (NATNUMP (predicate
))
1608 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1610 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1614 /* We succeeded; return this descriptor and filename. */
1632 /* Merge the list we've accumulated of globals from the current input source
1633 into the load_history variable. The details depend on whether
1634 the source has an associated file name or not.
1636 FILENAME is the file name that we are loading from.
1637 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1640 build_load_history (Lisp_Object filename
, int entire
)
1642 register Lisp_Object tail
, prev
, newelt
;
1643 register Lisp_Object tem
, tem2
;
1644 register int foundit
= 0;
1646 tail
= Vload_history
;
1649 while (CONSP (tail
))
1653 /* Find the feature's previous assoc list... */
1654 if (!NILP (Fequal (filename
, Fcar (tem
))))
1658 /* If we're loading the entire file, remove old data. */
1662 Vload_history
= XCDR (tail
);
1664 Fsetcdr (prev
, XCDR (tail
));
1667 /* Otherwise, cons on new symbols that are not already members. */
1670 tem2
= Vcurrent_load_list
;
1672 while (CONSP (tem2
))
1674 newelt
= XCAR (tem2
);
1676 if (NILP (Fmember (newelt
, tem
)))
1677 Fsetcar (tail
, Fcons (XCAR (tem
),
1678 Fcons (newelt
, XCDR (tem
))));
1691 /* If we're loading an entire file, cons the new assoc onto the
1692 front of load-history, the most-recently-loaded position. Also
1693 do this if we didn't find an existing member for the file. */
1694 if (entire
|| !foundit
)
1695 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1700 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1708 readevalloop_1 (Lisp_Object old
)
1710 load_convert_to_unibyte
= ! NILP (old
);
1714 /* Signal an `end-of-file' error, if possible with file name
1718 end_of_file_error (void)
1720 if (STRINGP (Vload_file_name
))
1721 xsignal1 (Qend_of_file
, Vload_file_name
);
1723 xsignal0 (Qend_of_file
);
1726 /* UNIBYTE specifies how to set load_convert_to_unibyte
1727 for this invocation.
1728 READFUN, if non-nil, is used instead of `read'.
1730 START, END specify region to read in current buffer (from eval-region).
1731 If the input is not from a buffer, they must be nil. */
1734 readevalloop (Lisp_Object readcharfun
,
1736 Lisp_Object sourcename
,
1737 Lisp_Object (*evalfun
) (Lisp_Object
),
1739 Lisp_Object unibyte
, Lisp_Object readfun
,
1740 Lisp_Object start
, Lisp_Object end
)
1743 register Lisp_Object val
;
1744 int count
= SPECPDL_INDEX ();
1745 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1746 struct buffer
*b
= 0;
1747 int continue_reading_p
;
1748 Lisp_Object lex_bound
;
1749 /* Nonzero if reading an entire buffer. */
1750 int whole_buffer
= 0;
1751 /* 1 on the first time around. */
1754 if (MARKERP (readcharfun
))
1757 start
= readcharfun
;
1760 if (BUFFERP (readcharfun
))
1761 b
= XBUFFER (readcharfun
);
1762 else if (MARKERP (readcharfun
))
1763 b
= XMARKER (readcharfun
)->buffer
;
1765 /* We assume START is nil when input is not from a buffer. */
1766 if (! NILP (start
) && !b
)
1769 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1770 specbind (Qcurrent_load_list
, Qnil
);
1771 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1772 load_convert_to_unibyte
= !NILP (unibyte
);
1774 /* If lexical binding is active (either because it was specified in
1775 the file's header, or via a buffer-local variable), create an empty
1776 lexical environment, otherwise, turn off lexical binding. */
1777 lex_bound
= find_symbol_value (Qlexical_binding
);
1778 if (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
))
1779 specbind (Qinternal_interpreter_environment
, Qnil
);
1781 specbind (Qinternal_interpreter_environment
, Fcons (Qt
, Qnil
));
1783 GCPRO4 (sourcename
, readfun
, start
, end
);
1785 /* Try to ensure sourcename is a truename, except whilst preloading. */
1786 if (NILP (Vpurify_flag
)
1787 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1788 && !NILP (Ffboundp (Qfile_truename
)))
1789 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1791 LOADHIST_ATTACH (sourcename
);
1793 continue_reading_p
= 1;
1794 while (continue_reading_p
)
1796 int count1
= SPECPDL_INDEX ();
1798 if (b
!= 0 && NILP (b
->name
))
1799 error ("Reading from killed buffer");
1803 /* Switch to the buffer we are reading from. */
1804 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1805 set_buffer_internal (b
);
1807 /* Save point in it. */
1808 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1809 /* Save ZV in it. */
1810 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1811 /* Those get unbound after we read one expression. */
1813 /* Set point and ZV around stuff to be read. */
1816 Fnarrow_to_region (make_number (BEGV
), end
);
1818 /* Just for cleanliness, convert END to a marker
1819 if it is an integer. */
1821 end
= Fpoint_max_marker ();
1824 /* On the first cycle, we can easily test here
1825 whether we are reading the whole buffer. */
1826 if (b
&& first_sexp
)
1827 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1834 while ((c
= READCHAR
) != '\n' && c
!= -1);
1839 unbind_to (count1
, Qnil
);
1843 /* Ignore whitespace here, so we can detect eof. */
1844 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1845 || c
== 0x8a0) /* NBSP */
1848 if (!NILP (Vpurify_flag
) && c
== '(')
1850 record_unwind_protect (unreadpure
, Qnil
);
1851 val
= read_list (-1, readcharfun
);
1856 read_objects
= Qnil
;
1857 if (!NILP (readfun
))
1859 val
= call1 (readfun
, readcharfun
);
1861 /* If READCHARFUN has set point to ZV, we should
1862 stop reading, even if the form read sets point
1863 to a different value when evaluated. */
1864 if (BUFFERP (readcharfun
))
1866 struct buffer
*b
= XBUFFER (readcharfun
);
1867 if (BUF_PT (b
) == BUF_ZV (b
))
1868 continue_reading_p
= 0;
1871 else if (! NILP (Vload_read_function
))
1872 val
= call1 (Vload_read_function
, readcharfun
);
1874 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1877 if (!NILP (start
) && continue_reading_p
)
1878 start
= Fpoint_marker ();
1880 /* Restore saved point and BEGV. */
1881 unbind_to (count1
, Qnil
);
1883 /* Now eval what we just read. */
1884 val
= (*evalfun
) (val
);
1888 Vvalues
= Fcons (val
, Vvalues
);
1889 if (EQ (Vstandard_output
, Qt
))
1898 build_load_history (sourcename
,
1899 stream
|| whole_buffer
);
1903 unbind_to (count
, Qnil
);
1906 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1907 doc
: /* Execute the current buffer as Lisp code.
1908 When called from a Lisp program (i.e., not interactively), this
1909 function accepts up to five optional arguments:
1910 BUFFER is the buffer to evaluate (nil means use current buffer).
1911 PRINTFLAG controls printing of output:
1912 A value of nil means discard it; anything else is stream for print.
1913 FILENAME specifies the file name to use for `load-history'.
1914 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1916 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1917 functions should work normally even if PRINTFLAG is nil.
1919 This function preserves the position of point. */)
1920 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1922 int count
= SPECPDL_INDEX ();
1923 Lisp_Object tem
, buf
;
1926 buf
= Fcurrent_buffer ();
1928 buf
= Fget_buffer (buffer
);
1930 error ("No such buffer");
1932 if (NILP (printflag
) && NILP (do_allow_print
))
1937 if (NILP (filename
))
1938 filename
= XBUFFER (buf
)->filename
;
1940 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1941 specbind (Qstandard_output
, tem
);
1942 specbind (Qlexical_binding
, Qnil
);
1943 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1944 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1945 if (lisp_file_lexically_bound_p (buf
))
1946 Fset (Qlexical_binding
, Qt
);
1947 readevalloop (buf
, 0, filename
, Feval
,
1948 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1949 unbind_to (count
, Qnil
);
1954 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1955 doc
: /* Execute the region as Lisp code.
1956 When called from programs, expects two arguments,
1957 giving starting and ending indices in the current buffer
1958 of the text to be executed.
1959 Programs can pass third argument PRINTFLAG which controls output:
1960 A value of nil means discard it; anything else is stream for printing it.
1961 Also the fourth argument READ-FUNCTION, if non-nil, is used
1962 instead of `read' to read each expression. It gets one argument
1963 which is the input stream for reading characters.
1965 This function does not move point. */)
1966 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1968 int count
= SPECPDL_INDEX ();
1969 Lisp_Object tem
, cbuf
;
1971 cbuf
= Fcurrent_buffer ();
1973 if (NILP (printflag
))
1977 specbind (Qstandard_output
, tem
);
1978 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1980 /* readevalloop calls functions which check the type of start and end. */
1981 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1982 !NILP (printflag
), Qnil
, read_function
,
1985 return unbind_to (count
, Qnil
);
1989 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1990 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1991 If STREAM is nil, use the value of `standard-input' (which see).
1992 STREAM or the value of `standard-input' may be:
1993 a buffer (read from point and advance it)
1994 a marker (read from where it points and advance it)
1995 a function (call it with no arguments for each character,
1996 call it with a char as argument to push a char back)
1997 a string (takes text from string, starting at the beginning)
1998 t (read text line using minibuffer and use it, or read from
1999 standard input in batch mode). */)
2000 (Lisp_Object stream
)
2003 stream
= Vstandard_input
;
2004 if (EQ (stream
, Qt
))
2005 stream
= Qread_char
;
2006 if (EQ (stream
, Qread_char
))
2007 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
2009 return read_internal_start (stream
, Qnil
, Qnil
);
2012 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2013 doc
: /* Read one Lisp expression which is represented as text by STRING.
2014 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2015 START and END optionally delimit a substring of STRING from which to read;
2016 they default to 0 and (length STRING) respectively. */)
2017 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2020 CHECK_STRING (string
);
2021 /* read_internal_start sets read_from_string_index. */
2022 ret
= read_internal_start (string
, start
, end
);
2023 return Fcons (ret
, make_number (read_from_string_index
));
2026 /* Function to set up the global context we need in toplevel read
2029 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2030 /* start, end only used when stream is a string. */
2035 new_backquote_flag
= 0;
2036 read_objects
= Qnil
;
2037 if (EQ (Vread_with_symbol_positions
, Qt
)
2038 || EQ (Vread_with_symbol_positions
, stream
))
2039 Vread_symbol_positions_list
= Qnil
;
2041 if (STRINGP (stream
)
2042 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2044 int startval
, endval
;
2047 if (STRINGP (stream
))
2050 string
= XCAR (stream
);
2053 endval
= SCHARS (string
);
2057 endval
= XINT (end
);
2058 if (endval
< 0 || endval
> SCHARS (string
))
2059 args_out_of_range (string
, end
);
2066 CHECK_NUMBER (start
);
2067 startval
= XINT (start
);
2068 if (startval
< 0 || startval
> endval
)
2069 args_out_of_range (string
, start
);
2071 read_from_string_index
= startval
;
2072 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2073 read_from_string_limit
= endval
;
2076 retval
= read0 (stream
);
2077 if (EQ (Vread_with_symbol_positions
, Qt
)
2078 || EQ (Vread_with_symbol_positions
, stream
))
2079 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2084 /* Signal Qinvalid_read_syntax error.
2085 S is error string of length N (if > 0) */
2088 invalid_syntax (const char *s
, int n
)
2092 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2096 /* Use this for recursive reads, in contexts where internal tokens
2100 read0 (Lisp_Object readcharfun
)
2102 register Lisp_Object val
;
2105 val
= read1 (readcharfun
, &c
, 0);
2109 xsignal1 (Qinvalid_read_syntax
,
2110 Fmake_string (make_number (1), make_number (c
)));
2113 static int read_buffer_size
;
2114 static char *read_buffer
;
2116 /* Read a \-escape sequence, assuming we already read the `\'.
2117 If the escape sequence forces unibyte, return eight-bit char. */
2120 read_escape (Lisp_Object readcharfun
, int stringp
)
2122 register int c
= READCHAR
;
2123 /* \u allows up to four hex digits, \U up to eight. Default to the
2124 behavior for \u, and change this value in the case that \U is seen. */
2125 int unicode_hex_count
= 4;
2130 end_of_file_error ();
2160 error ("Invalid escape character syntax");
2163 c
= read_escape (readcharfun
, 0);
2164 return c
| meta_modifier
;
2169 error ("Invalid escape character syntax");
2172 c
= read_escape (readcharfun
, 0);
2173 return c
| shift_modifier
;
2178 error ("Invalid escape character syntax");
2181 c
= read_escape (readcharfun
, 0);
2182 return c
| hyper_modifier
;
2187 error ("Invalid escape character syntax");
2190 c
= read_escape (readcharfun
, 0);
2191 return c
| alt_modifier
;
2195 if (stringp
|| c
!= '-')
2202 c
= read_escape (readcharfun
, 0);
2203 return c
| super_modifier
;
2208 error ("Invalid escape character syntax");
2212 c
= read_escape (readcharfun
, 0);
2213 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2214 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2215 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2216 return c
| ctrl_modifier
;
2217 /* ASCII control chars are made from letters (both cases),
2218 as well as the non-letters within 0100...0137. */
2219 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2220 return (c
& (037 | ~0177));
2221 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2222 return (c
& (037 | ~0177));
2224 return c
| ctrl_modifier
;
2234 /* An octal escape, as in ANSI C. */
2236 register int i
= c
- '0';
2237 register int count
= 0;
2240 if ((c
= READCHAR
) >= '0' && c
<= '7')
2252 if (i
>= 0x80 && i
< 0x100)
2253 i
= BYTE8_TO_CHAR (i
);
2258 /* A hex escape, as in ANSI C. */
2265 if (c
>= '0' && c
<= '9')
2270 else if ((c
>= 'a' && c
<= 'f')
2271 || (c
>= 'A' && c
<= 'F'))
2274 if (c
>= 'a' && c
<= 'f')
2287 if (count
< 3 && i
>= 0x80)
2288 return BYTE8_TO_CHAR (i
);
2293 /* Post-Unicode-2.0: Up to eight hex chars. */
2294 unicode_hex_count
= 8;
2297 /* A Unicode escape. We only permit them in strings and characters,
2298 not arbitrarily in the source code, as in some other languages. */
2303 while (++count
<= unicode_hex_count
)
2306 /* isdigit and isalpha may be locale-specific, which we don't
2308 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2309 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2310 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2313 error ("Non-hex digit used for Unicode escape");
2318 error ("Non-Unicode character: 0x%x", i
);
2327 /* Read an integer in radix RADIX using READCHARFUN to read
2328 characters. RADIX must be in the interval [2..36]; if it isn't, a
2329 read error is signaled . Value is the integer read. Signals an
2330 error if encountering invalid read syntax or if RADIX is out of
2334 read_integer (Lisp_Object readcharfun
, int radix
)
2336 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2337 /* We use a floating point number because */
2340 if (radix
< 2 || radix
> 36)
2344 number
= ndigits
= invalid_p
= 0;
2360 if (c
>= '0' && c
<= '9')
2362 else if (c
>= 'a' && c
<= 'z')
2363 digit
= c
- 'a' + 10;
2364 else if (c
>= 'A' && c
<= 'Z')
2365 digit
= c
- 'A' + 10;
2372 if (digit
< 0 || digit
>= radix
)
2375 number
= radix
* number
+ digit
;
2381 if (ndigits
== 0 || invalid_p
)
2384 sprintf (buf
, "integer, radix %d", radix
);
2385 invalid_syntax (buf
, 0);
2388 return make_fixnum_or_float (sign
* number
);
2392 /* If the next token is ')' or ']' or '.', we store that character
2393 in *PCH and the return value is not interesting. Else, we store
2394 zero in *PCH and we read and return one lisp object.
2396 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2399 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2402 int uninterned_symbol
= 0;
2410 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2412 end_of_file_error ();
2417 return read_list (0, readcharfun
);
2420 return read_vector (readcharfun
, 0);
2436 /* Accept extended format for hashtables (extensible to
2438 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2439 Lisp_Object tmp
= read_list (0, readcharfun
);
2440 Lisp_Object head
= CAR_SAFE (tmp
);
2441 Lisp_Object data
= Qnil
;
2442 Lisp_Object val
= Qnil
;
2443 /* The size is 2 * number of allowed keywords to
2445 Lisp_Object params
[10];
2447 Lisp_Object key
= Qnil
;
2448 int param_count
= 0;
2450 if (!EQ (head
, Qhash_table
))
2451 error ("Invalid extended read marker at head of #s list "
2452 "(only hash-table allowed)");
2454 tmp
= CDR_SAFE (tmp
);
2456 /* This is repetitive but fast and simple. */
2457 params
[param_count
] = QCsize
;
2458 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2459 if (!NILP (params
[param_count
+ 1]))
2462 params
[param_count
] = QCtest
;
2463 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2464 if (!NILP (params
[param_count
+ 1]))
2467 params
[param_count
] = QCweakness
;
2468 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2469 if (!NILP (params
[param_count
+ 1]))
2472 params
[param_count
] = QCrehash_size
;
2473 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2474 if (!NILP (params
[param_count
+ 1]))
2477 params
[param_count
] = QCrehash_threshold
;
2478 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2479 if (!NILP (params
[param_count
+ 1]))
2482 /* This is the hashtable data. */
2483 data
= Fplist_get (tmp
, Qdata
);
2485 /* Now use params to make a new hashtable and fill it. */
2486 ht
= Fmake_hash_table (param_count
, params
);
2488 while (CONSP (data
))
2493 error ("Odd number of elements in hashtable data");
2496 Fputhash (key
, val
, ht
);
2502 invalid_syntax ("#", 1);
2510 tmp
= read_vector (readcharfun
, 0);
2511 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2512 error ("Invalid size char-table");
2513 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2524 tmp
= read_vector (readcharfun
, 0);
2525 if (!INTEGERP (AREF (tmp
, 0)))
2526 error ("Invalid depth in char-table");
2527 depth
= XINT (AREF (tmp
, 0));
2528 if (depth
< 1 || depth
> 3)
2529 error ("Invalid depth in char-table");
2530 size
= XVECTOR (tmp
)->size
- 2;
2531 if (chartab_size
[depth
] != size
)
2532 error ("Invalid size char-table");
2533 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2536 invalid_syntax ("#^^", 3);
2538 invalid_syntax ("#^", 2);
2543 length
= read1 (readcharfun
, pch
, first_in_list
);
2547 Lisp_Object tmp
, val
;
2549 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2550 / BOOL_VECTOR_BITS_PER_CHAR
);
2553 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2554 if (STRING_MULTIBYTE (tmp
)
2555 || (size_in_chars
!= SCHARS (tmp
)
2556 /* We used to print 1 char too many
2557 when the number of bits was a multiple of 8.
2558 Accept such input in case it came from an old
2560 && ! (XFASTINT (length
)
2561 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2562 invalid_syntax ("#&...", 5);
2564 val
= Fmake_bool_vector (length
, Qnil
);
2565 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2566 /* Clear the extraneous bits in the last byte. */
2567 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2568 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2569 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2572 invalid_syntax ("#&...", 5);
2575 /* `function vector' objects, including byte-compiled functions. */
2576 return read_vector (readcharfun
, 1);
2580 struct gcpro gcpro1
;
2583 /* Read the string itself. */
2584 tmp
= read1 (readcharfun
, &ch
, 0);
2585 if (ch
!= 0 || !STRINGP (tmp
))
2586 invalid_syntax ("#", 1);
2588 /* Read the intervals and their properties. */
2591 Lisp_Object beg
, end
, plist
;
2593 beg
= read1 (readcharfun
, &ch
, 0);
2598 end
= read1 (readcharfun
, &ch
, 0);
2600 plist
= read1 (readcharfun
, &ch
, 0);
2602 invalid_syntax ("Invalid string property list", 0);
2603 Fset_text_properties (beg
, end
, plist
, tmp
);
2609 /* #@NUMBER is used to skip NUMBER following characters.
2610 That's used in .elc files to skip over doc strings
2611 and function definitions. */
2617 /* Read a decimal integer. */
2618 while ((c
= READCHAR
) >= 0
2619 && c
>= '0' && c
<= '9')
2627 if (load_force_doc_strings
2628 && (EQ (readcharfun
, Qget_file_char
)
2629 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2631 /* If we are supposed to force doc strings into core right now,
2632 record the last string that we skipped,
2633 and record where in the file it comes from. */
2635 /* But first exchange saved_doc_string
2636 with prev_saved_doc_string, so we save two strings. */
2638 char *temp
= saved_doc_string
;
2639 int temp_size
= saved_doc_string_size
;
2640 file_offset temp_pos
= saved_doc_string_position
;
2641 int temp_len
= saved_doc_string_length
;
2643 saved_doc_string
= prev_saved_doc_string
;
2644 saved_doc_string_size
= prev_saved_doc_string_size
;
2645 saved_doc_string_position
= prev_saved_doc_string_position
;
2646 saved_doc_string_length
= prev_saved_doc_string_length
;
2648 prev_saved_doc_string
= temp
;
2649 prev_saved_doc_string_size
= temp_size
;
2650 prev_saved_doc_string_position
= temp_pos
;
2651 prev_saved_doc_string_length
= temp_len
;
2654 if (saved_doc_string_size
== 0)
2656 saved_doc_string_size
= nskip
+ 100;
2657 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2659 if (nskip
> saved_doc_string_size
)
2661 saved_doc_string_size
= nskip
+ 100;
2662 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2663 saved_doc_string_size
);
2666 saved_doc_string_position
= file_tell (instream
);
2668 /* Copy that many characters into saved_doc_string. */
2669 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2670 saved_doc_string
[i
] = c
= READCHAR
;
2672 saved_doc_string_length
= i
;
2676 /* Skip that many characters. */
2677 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2686 /* #! appears at the beginning of an executable file.
2687 Skip the first line. */
2688 while (c
!= '\n' && c
>= 0)
2693 return Vload_file_name
;
2695 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2696 /* #:foo is the uninterned symbol named foo. */
2699 uninterned_symbol
= 1;
2703 /* Reader forms that can reuse previously read objects. */
2704 if (c
>= '0' && c
<= '9')
2709 /* Read a non-negative integer. */
2710 while (c
>= '0' && c
<= '9')
2716 /* #n=object returns object, but associates it with n for #n#. */
2717 if (c
== '=' && !NILP (Vread_circle
))
2719 /* Make a placeholder for #n# to use temporarily */
2720 Lisp_Object placeholder
;
2723 placeholder
= Fcons (Qnil
, Qnil
);
2724 cell
= Fcons (make_number (n
), placeholder
);
2725 read_objects
= Fcons (cell
, read_objects
);
2727 /* Read the object itself. */
2728 tem
= read0 (readcharfun
);
2730 /* Now put it everywhere the placeholder was... */
2731 substitute_object_in_subtree (tem
, placeholder
);
2733 /* ...and #n# will use the real value from now on. */
2734 Fsetcdr (cell
, tem
);
2738 /* #n# returns a previously read object. */
2739 if (c
== '#' && !NILP (Vread_circle
))
2741 tem
= Fassq (make_number (n
), read_objects
);
2744 /* Fall through to error message. */
2746 else if (c
== 'r' || c
== 'R')
2747 return read_integer (readcharfun
, n
);
2749 /* Fall through to error message. */
2751 else if (c
== 'x' || c
== 'X')
2752 return read_integer (readcharfun
, 16);
2753 else if (c
== 'o' || c
== 'O')
2754 return read_integer (readcharfun
, 8);
2755 else if (c
== 'b' || c
== 'B')
2756 return read_integer (readcharfun
, 2);
2759 invalid_syntax ("#", 1);
2762 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2767 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2772 int next_char
= READCHAR
;
2774 /* Transition from old-style to new-style:
2775 If we see "(`" it used to mean old-style, which usually works
2776 fine because ` should almost never appear in such a position
2777 for new-style. But occasionally we need "(`" to mean new
2778 style, so we try to distinguish the two by the fact that we
2779 can either write "( `foo" or "(` foo", where the first
2780 intends to use new-style whereas the second intends to use
2781 old-style. For Emacs-25, we should completely remove this
2782 first_in_list exception (old-style can still be obtained via
2784 if (first_in_list
&& next_char
== ' ')
2786 Vold_style_backquotes
= Qt
;
2793 new_backquote_flag
++;
2794 value
= read0 (readcharfun
);
2795 new_backquote_flag
--;
2797 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2801 if (new_backquote_flag
)
2803 Lisp_Object comma_type
= Qnil
;
2808 comma_type
= Qcomma_at
;
2810 comma_type
= Qcomma_dot
;
2813 if (ch
>= 0) UNREAD (ch
);
2814 comma_type
= Qcomma
;
2817 new_backquote_flag
--;
2818 value
= read0 (readcharfun
);
2819 new_backquote_flag
++;
2820 return Fcons (comma_type
, Fcons (value
, Qnil
));
2824 Vold_style_backquotes
= Qt
;
2836 end_of_file_error ();
2838 /* Accept `single space' syntax like (list ? x) where the
2839 whitespace character is SPC or TAB.
2840 Other literal whitespace like NL, CR, and FF are not accepted,
2841 as there are well-established escape sequences for these. */
2842 if (c
== ' ' || c
== '\t')
2843 return make_number (c
);
2846 c
= read_escape (readcharfun
, 0);
2847 modifiers
= c
& CHAR_MODIFIER_MASK
;
2848 c
&= ~CHAR_MODIFIER_MASK
;
2849 if (CHAR_BYTE8_P (c
))
2850 c
= CHAR_TO_BYTE8 (c
);
2853 next_char
= READCHAR
;
2854 if (next_char
== '.')
2856 /* Only a dotted-pair dot is valid after a char constant. */
2857 int next_next_char
= READCHAR
;
2858 UNREAD (next_next_char
);
2860 ok
= (next_next_char
<= 040
2861 || (next_next_char
< 0200
2862 && (strchr ("\"';([#?", next_next_char
)
2863 || (!first_in_list
&& next_next_char
== '`')
2864 || (new_backquote_flag
&& next_next_char
== ','))));
2868 ok
= (next_char
<= 040
2869 || (next_char
< 0200
2870 && (strchr ("\"';()[]#?", next_char
)
2871 || (!first_in_list
&& next_char
== '`')
2872 || (new_backquote_flag
&& next_char
== ','))));
2876 return make_number (c
);
2878 invalid_syntax ("?", 1);
2883 char *p
= read_buffer
;
2884 char *end
= read_buffer
+ read_buffer_size
;
2886 /* Nonzero if we saw an escape sequence specifying
2887 a multibyte character. */
2888 int force_multibyte
= 0;
2889 /* Nonzero if we saw an escape sequence specifying
2890 a single-byte character. */
2891 int force_singlebyte
= 0;
2895 while ((c
= READCHAR
) >= 0
2898 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2900 int offset
= p
- read_buffer
;
2901 read_buffer
= (char *) xrealloc (read_buffer
,
2902 read_buffer_size
*= 2);
2903 p
= read_buffer
+ offset
;
2904 end
= read_buffer
+ read_buffer_size
;
2911 c
= read_escape (readcharfun
, 1);
2913 /* C is -1 if \ newline has just been seen */
2916 if (p
== read_buffer
)
2921 modifiers
= c
& CHAR_MODIFIER_MASK
;
2922 c
= c
& ~CHAR_MODIFIER_MASK
;
2924 if (CHAR_BYTE8_P (c
))
2925 force_singlebyte
= 1;
2926 else if (! ASCII_CHAR_P (c
))
2927 force_multibyte
= 1;
2928 else /* i.e. ASCII_CHAR_P (c) */
2930 /* Allow `\C- ' and `\C-?'. */
2931 if (modifiers
== CHAR_CTL
)
2934 c
= 0, modifiers
= 0;
2936 c
= 127, modifiers
= 0;
2938 if (modifiers
& CHAR_SHIFT
)
2940 /* Shift modifier is valid only with [A-Za-z]. */
2941 if (c
>= 'A' && c
<= 'Z')
2942 modifiers
&= ~CHAR_SHIFT
;
2943 else if (c
>= 'a' && c
<= 'z')
2944 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2947 if (modifiers
& CHAR_META
)
2949 /* Move the meta bit to the right place for a
2951 modifiers
&= ~CHAR_META
;
2952 c
= BYTE8_TO_CHAR (c
| 0x80);
2953 force_singlebyte
= 1;
2957 /* Any modifiers remaining are invalid. */
2959 error ("Invalid modifier in string");
2960 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2964 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2965 if (CHAR_BYTE8_P (c
))
2966 force_singlebyte
= 1;
2967 else if (! ASCII_CHAR_P (c
))
2968 force_multibyte
= 1;
2974 end_of_file_error ();
2976 /* If purifying, and string starts with \ newline,
2977 return zero instead. This is for doc strings
2978 that we are really going to find in etc/DOC.nn.nn */
2979 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2980 return make_number (0);
2982 if (force_multibyte
)
2983 /* READ_BUFFER already contains valid multibyte forms. */
2985 else if (force_singlebyte
)
2987 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2988 p
= read_buffer
+ nchars
;
2991 /* Otherwise, READ_BUFFER contains only ASCII. */
2994 /* We want readchar_count to be the number of characters, not
2995 bytes. Hence we adjust for multibyte characters in the
2996 string. ... But it doesn't seem to be necessary, because
2997 READCHAR *does* read multibyte characters from buffers. */
2998 /* readchar_count -= (p - read_buffer) - nchars; */
3000 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
3002 || (p
- read_buffer
!= nchars
)));
3003 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3005 || (p
- read_buffer
!= nchars
)));
3010 int next_char
= READCHAR
;
3013 if (next_char
<= 040
3014 || (next_char
< 0200
3015 && (strchr ("\"';([#?", next_char
)
3016 || (!first_in_list
&& next_char
== '`')
3017 || (new_backquote_flag
&& next_char
== ','))))
3023 /* Otherwise, we fall through! Note that the atom-reading loop
3024 below will now loop at least once, assuring that we will not
3025 try to UNREAD two characters in a row. */
3029 if (c
<= 040) goto retry
;
3030 if (c
== 0x8a0) /* NBSP */
3033 char *p
= read_buffer
;
3037 char *end
= read_buffer
+ read_buffer_size
;
3040 && c
!= 0x8a0 /* NBSP */
3042 || (!strchr ("\"';()[]#", c
)
3043 && !(!first_in_list
&& c
== '`')
3044 && !(new_backquote_flag
&& c
== ','))))
3046 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3048 int offset
= p
- read_buffer
;
3049 read_buffer
= (char *) xrealloc (read_buffer
,
3050 read_buffer_size
*= 2);
3051 p
= read_buffer
+ offset
;
3052 end
= read_buffer
+ read_buffer_size
;
3059 end_of_file_error ();
3064 p
+= CHAR_STRING (c
, p
);
3072 int offset
= p
- read_buffer
;
3073 read_buffer
= (char *) xrealloc (read_buffer
,
3074 read_buffer_size
*= 2);
3075 p
= read_buffer
+ offset
;
3076 end
= read_buffer
+ read_buffer_size
;
3083 if (!quoted
&& !uninterned_symbol
)
3087 if (*p1
== '+' || *p1
== '-') p1
++;
3088 /* Is it an integer? */
3091 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3092 /* Integers can have trailing decimal points. */
3093 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3095 /* It is an integer. */
3100 /* EMACS_INT n = atol (read_buffer); */
3101 char *endptr
= NULL
;
3102 EMACS_INT n
= (errno
= 0,
3103 strtol (read_buffer
, &endptr
, 10));
3104 if (errno
== ERANGE
&& endptr
)
3107 = Fcons (make_string (read_buffer
,
3108 endptr
- read_buffer
),
3110 xsignal (Qoverflow_error
, args
);
3112 return make_fixnum_or_float (n
);
3116 if (isfloat_string (read_buffer
, 0))
3118 /* Compute NaN and infinities using 0.0 in a variable,
3119 to cope with compilers that think they are smarter
3125 /* Negate the value ourselves. This treats 0, NaNs,
3126 and infinity properly on IEEE floating point hosts,
3127 and works around a common bug where atof ("-0.0")
3129 int negative
= read_buffer
[0] == '-';
3131 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3132 returns 1, is if the input ends in e+INF or e+NaN. */
3139 value
= zero
/ zero
;
3141 /* If that made a "negative" NaN, negate it. */
3145 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3148 u_minus_zero
.d
= - 0.0;
3149 for (i
= 0; i
< sizeof (double); i
++)
3150 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3156 /* Now VALUE is a positive NaN. */
3159 value
= atof (read_buffer
+ negative
);
3163 return make_float (negative
? - value
: value
);
3167 Lisp_Object name
, result
;
3168 EMACS_INT nbytes
= p
- read_buffer
;
3170 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3173 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3174 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3176 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3177 result
= (uninterned_symbol
? Fmake_symbol (name
)
3178 : Fintern (name
, Qnil
));
3180 if (EQ (Vread_with_symbol_positions
, Qt
)
3181 || EQ (Vread_with_symbol_positions
, readcharfun
))
3182 Vread_symbol_positions_list
=
3183 /* Kind of a hack; this will probably fail if characters
3184 in the symbol name were escaped. Not really a big
3186 Fcons (Fcons (result
,
3187 make_number (readchar_count
3188 - XFASTINT (Flength (Fsymbol_name (result
))))),
3189 Vread_symbol_positions_list
);
3197 /* List of nodes we've seen during substitute_object_in_subtree. */
3198 static Lisp_Object seen_list
;
3201 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3203 Lisp_Object check_object
;
3205 /* We haven't seen any objects when we start. */
3208 /* Make all the substitutions. */
3210 = substitute_object_recurse (object
, placeholder
, object
);
3212 /* Clear seen_list because we're done with it. */
3215 /* The returned object here is expected to always eq the
3217 if (!EQ (check_object
, object
))
3218 error ("Unexpected mutation error in reader");
3221 /* Feval doesn't get called from here, so no gc protection is needed. */
3222 #define SUBSTITUTE(get_val, set_val) \
3224 Lisp_Object old_value = get_val; \
3225 Lisp_Object true_value \
3226 = substitute_object_recurse (object, placeholder, \
3229 if (!EQ (old_value, true_value)) \
3236 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3238 /* If we find the placeholder, return the target object. */
3239 if (EQ (placeholder
, subtree
))
3242 /* If we've been to this node before, don't explore it again. */
3243 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3246 /* If this node can be the entry point to a cycle, remember that
3247 we've seen it. It can only be such an entry point if it was made
3248 by #n=, which means that we can find it as a value in
3250 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3251 seen_list
= Fcons (subtree
, seen_list
);
3253 /* Recurse according to subtree's type.
3254 Every branch must return a Lisp_Object. */
3255 switch (XTYPE (subtree
))
3257 case Lisp_Vectorlike
:
3260 if (BOOL_VECTOR_P (subtree
))
3261 return subtree
; /* No sub-objects anyway. */
3262 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3263 || COMPILEDP (subtree
))
3264 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3265 else if (VECTORP (subtree
))
3266 length
= ASIZE (subtree
);
3268 /* An unknown pseudovector may contain non-Lisp fields, so we
3269 can't just blindly traverse all its fields. We used to call
3270 `Flength' which signaled `sequencep', so I just preserved this
3272 wrong_type_argument (Qsequencep
, subtree
);
3274 for (i
= 0; i
< length
; i
++)
3275 SUBSTITUTE (AREF (subtree
, i
),
3276 ASET (subtree
, i
, true_value
));
3282 SUBSTITUTE (XCAR (subtree
),
3283 XSETCAR (subtree
, true_value
));
3284 SUBSTITUTE (XCDR (subtree
),
3285 XSETCDR (subtree
, true_value
));
3291 /* Check for text properties in each interval.
3292 substitute_in_interval contains part of the logic. */
3294 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3295 Lisp_Object arg
= Fcons (object
, placeholder
);
3297 traverse_intervals_noorder (root_interval
,
3298 &substitute_in_interval
, arg
);
3303 /* Other types don't recurse any further. */
3309 /* Helper function for substitute_object_recurse. */
3311 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3313 Lisp_Object object
= Fcar (arg
);
3314 Lisp_Object placeholder
= Fcdr (arg
);
3316 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3327 isfloat_string (const char *cp
, int ignore_trailing
)
3330 const char *start
= cp
;
3333 if (*cp
== '+' || *cp
== '-')
3336 if (*cp
>= '0' && *cp
<= '9')
3339 while (*cp
>= '0' && *cp
<= '9')
3347 if (*cp
>= '0' && *cp
<= '9')
3350 while (*cp
>= '0' && *cp
<= '9')
3353 if (*cp
== 'e' || *cp
== 'E')
3357 if (*cp
== '+' || *cp
== '-')
3361 if (*cp
>= '0' && *cp
<= '9')
3364 while (*cp
>= '0' && *cp
<= '9')
3367 else if (cp
== start
)
3369 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3374 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3380 return ((ignore_trailing
3381 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3382 || *cp
== '\r' || *cp
== '\f')
3383 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3384 || state
== (DOT_CHAR
|TRAIL_INT
)
3385 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3386 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3387 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3392 read_vector (Lisp_Object readcharfun
, int read_funvec
)
3396 register Lisp_Object
*ptr
;
3397 register Lisp_Object tem
, item
, vector
;
3398 register struct Lisp_Cons
*otem
;
3400 /* If we're reading a funvec object we start out assuming it's also a
3401 byte-code object (a subset of funvecs), so we can do any special
3402 processing needed. If it's just an ordinary funvec object, we'll
3403 realize that as soon as we've read the first element. */
3404 int read_bytecode
= read_funvec
;
3406 tem
= read_list (1, readcharfun
);
3407 len
= Flength (tem
);
3408 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3410 size
= XVECTOR (vector
)->size
;
3411 ptr
= XVECTOR (vector
)->contents
;
3412 for (i
= 0; i
< size
; i
++)
3416 /* If READ_BYTECODE is set, check whether this is really a byte-code
3417 object, or just an ordinary `funvec' object -- non-byte-code
3418 funvec objects use the same reader syntax. We can tell from the
3419 first element which one it is. */
3420 if (read_bytecode
&& i
== 0 && ! FUNVEC_COMPILED_TAG_P (item
))
3421 read_bytecode
= 0; /* Nope. */
3423 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3424 bytecode object, the docstring containing the bytecode and
3425 constants values must be treated as unibyte and passed to
3426 Fread, to get the actual bytecode string and constants vector. */
3427 if (read_bytecode
&& load_force_doc_strings
)
3429 if (i
== COMPILED_BYTECODE
)
3431 if (!STRINGP (item
))
3432 error ("Invalid byte code");
3434 /* Delay handling the bytecode slot until we know whether
3435 it is lazily-loaded (we can tell by whether the
3436 constants slot is nil). */
3437 ptr
[COMPILED_CONSTANTS
] = item
;
3440 else if (i
== COMPILED_CONSTANTS
)
3442 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3446 /* Coerce string to unibyte (like string-as-unibyte,
3447 but without generating extra garbage and
3448 guaranteeing no change in the contents). */
3449 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3450 STRING_SET_UNIBYTE (bytestr
);
3452 item
= Fread (Fcons (bytestr
, readcharfun
));
3454 error ("Invalid byte code");
3456 otem
= XCONS (item
);
3457 bytestr
= XCAR (item
);
3462 /* Now handle the bytecode slot. */
3463 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3465 else if (i
== COMPILED_DOC_STRING
3467 && ! STRING_MULTIBYTE (item
))
3469 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3470 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3472 item
= Fstring_as_multibyte (item
);
3475 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3481 if (read_bytecode
&& size
>= 4)
3482 /* Convert this vector to a bytecode object. */
3483 vector
= Fmake_byte_code (size
, XVECTOR (vector
)->contents
);
3484 else if (read_funvec
&& size
>= 1)
3485 /* Convert this vector to an ordinary funvec object. */
3486 XSETFUNVEC (vector
, XVECTOR (vector
));
3491 /* FLAG = 1 means check for ] to terminate rather than ) and .
3492 FLAG = -1 means check for starting with defun
3493 and make structure pure. */
3496 read_list (int flag
, register Lisp_Object readcharfun
)
3498 /* -1 means check next element for defun,
3499 0 means don't check,
3500 1 means already checked and found defun. */
3501 int defunflag
= flag
< 0 ? -1 : 0;
3502 Lisp_Object val
, tail
;
3503 register Lisp_Object elt
, tem
;
3504 struct gcpro gcpro1
, gcpro2
;
3505 /* 0 is the normal case.
3506 1 means this list is a doc reference; replace it with the number 0.
3507 2 means this list is a doc reference; replace it with the doc string. */
3508 int doc_reference
= 0;
3510 /* Initialize this to 1 if we are reading a list. */
3511 int first_in_list
= flag
<= 0;
3520 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3525 /* While building, if the list starts with #$, treat it specially. */
3526 if (EQ (elt
, Vload_file_name
)
3528 && !NILP (Vpurify_flag
))
3530 if (NILP (Vdoc_file_name
))
3531 /* We have not yet called Snarf-documentation, so assume
3532 this file is described in the DOC-MM.NN file
3533 and Snarf-documentation will fill in the right value later.
3534 For now, replace the whole list with 0. */
3537 /* We have already called Snarf-documentation, so make a relative
3538 file name for this file, so it can be found properly
3539 in the installed Lisp directory.
3540 We don't use Fexpand_file_name because that would make
3541 the directory absolute now. */
3542 elt
= concat2 (build_string ("../lisp/"),
3543 Ffile_name_nondirectory (elt
));
3545 else if (EQ (elt
, Vload_file_name
)
3547 && load_force_doc_strings
)
3556 invalid_syntax (") or . in a vector", 18);
3564 XSETCDR (tail
, read0 (readcharfun
));
3566 val
= read0 (readcharfun
);
3567 read1 (readcharfun
, &ch
, 0);
3571 if (doc_reference
== 1)
3572 return make_number (0);
3573 if (doc_reference
== 2)
3575 /* Get a doc string from the file we are loading.
3576 If it's in saved_doc_string, get it from there.
3578 Here, we don't know if the string is a
3579 bytecode string or a doc string. As a
3580 bytecode string must be unibyte, we always
3581 return a unibyte string. If it is actually a
3582 doc string, caller must make it
3585 int pos
= XINT (XCDR (val
));
3586 /* Position is negative for user variables. */
3587 if (pos
< 0) pos
= -pos
;
3588 if (pos
>= saved_doc_string_position
3589 && pos
< (saved_doc_string_position
3590 + saved_doc_string_length
))
3592 int start
= pos
- saved_doc_string_position
;
3595 /* Process quoting with ^A,
3596 and find the end of the string,
3597 which is marked with ^_ (037). */
3598 for (from
= start
, to
= start
;
3599 saved_doc_string
[from
] != 037;)
3601 int c
= saved_doc_string
[from
++];
3604 c
= saved_doc_string
[from
++];
3606 saved_doc_string
[to
++] = c
;
3608 saved_doc_string
[to
++] = 0;
3610 saved_doc_string
[to
++] = 037;
3613 saved_doc_string
[to
++] = c
;
3616 return make_unibyte_string (saved_doc_string
+ start
,
3619 /* Look in prev_saved_doc_string the same way. */
3620 else if (pos
>= prev_saved_doc_string_position
3621 && pos
< (prev_saved_doc_string_position
3622 + prev_saved_doc_string_length
))
3624 int start
= pos
- prev_saved_doc_string_position
;
3627 /* Process quoting with ^A,
3628 and find the end of the string,
3629 which is marked with ^_ (037). */
3630 for (from
= start
, to
= start
;
3631 prev_saved_doc_string
[from
] != 037;)
3633 int c
= prev_saved_doc_string
[from
++];
3636 c
= prev_saved_doc_string
[from
++];
3638 prev_saved_doc_string
[to
++] = c
;
3640 prev_saved_doc_string
[to
++] = 0;
3642 prev_saved_doc_string
[to
++] = 037;
3645 prev_saved_doc_string
[to
++] = c
;
3648 return make_unibyte_string (prev_saved_doc_string
3653 return get_doc_string (val
, 1, 0);
3658 invalid_syntax (". in wrong context", 18);
3660 invalid_syntax ("] in a list", 11);
3662 tem
= (read_pure
&& flag
<= 0
3663 ? pure_cons (elt
, Qnil
)
3664 : Fcons (elt
, Qnil
));
3666 XSETCDR (tail
, tem
);
3671 defunflag
= EQ (elt
, Qdefun
);
3672 else if (defunflag
> 0)
3677 Lisp_Object Vobarray
;
3678 Lisp_Object initial_obarray
;
3680 /* oblookup stores the bucket number here, for the sake of Funintern. */
3682 int oblookup_last_bucket_number
;
3684 static int hash_string (const unsigned char *ptr
, int len
);
3686 /* Get an error if OBARRAY is not an obarray.
3687 If it is one, return it. */
3690 check_obarray (Lisp_Object obarray
)
3692 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3694 /* If Vobarray is now invalid, force it to be valid. */
3695 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3696 wrong_type_argument (Qvectorp
, obarray
);
3701 /* Intern the C string STR: return a symbol with that name,
3702 interned in the current obarray. */
3705 intern (const char *str
)
3708 int len
= strlen (str
);
3709 Lisp_Object obarray
;
3712 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3713 obarray
= check_obarray (obarray
);
3714 tem
= oblookup (obarray
, str
, len
, len
);
3717 return Fintern (make_string (str
, len
), obarray
);
3721 intern_c_string (const char *str
)
3724 int len
= strlen (str
);
3725 Lisp_Object obarray
;
3728 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3729 obarray
= check_obarray (obarray
);
3730 tem
= oblookup (obarray
, str
, len
, len
);
3734 if (NILP (Vpurify_flag
))
3735 /* Creating a non-pure string from a string literal not
3736 implemented yet. We could just use make_string here and live
3737 with the extra copy. */
3740 return Fintern (make_pure_c_string (str
), obarray
);
3743 /* Create an uninterned symbol with name STR. */
3746 make_symbol (const char *str
)
3748 int len
= strlen (str
);
3750 return Fmake_symbol (!NILP (Vpurify_flag
)
3751 ? make_pure_string (str
, len
, len
, 0)
3752 : make_string (str
, len
));
3755 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3756 doc
: /* Return the canonical symbol whose name is STRING.
3757 If there is none, one is created by this function and returned.
3758 A second optional argument specifies the obarray to use;
3759 it defaults to the value of `obarray'. */)
3760 (Lisp_Object string
, Lisp_Object obarray
)
3762 register Lisp_Object tem
, sym
, *ptr
;
3764 if (NILP (obarray
)) obarray
= Vobarray
;
3765 obarray
= check_obarray (obarray
);
3767 CHECK_STRING (string
);
3769 tem
= oblookup (obarray
, SDATA (string
),
3772 if (!INTEGERP (tem
))
3775 if (!NILP (Vpurify_flag
))
3776 string
= Fpurecopy (string
);
3777 sym
= Fmake_symbol (string
);
3779 if (EQ (obarray
, initial_obarray
))
3780 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3782 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3784 if ((SREF (string
, 0) == ':')
3785 && EQ (obarray
, initial_obarray
))
3787 XSYMBOL (sym
)->constant
= 1;
3788 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3789 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3792 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3794 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3796 XSYMBOL (sym
)->next
= 0;
3801 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3802 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3803 NAME may be a string or a symbol. If it is a symbol, that exact
3804 symbol is searched for.
3805 A second optional argument specifies the obarray to use;
3806 it defaults to the value of `obarray'. */)
3807 (Lisp_Object name
, Lisp_Object obarray
)
3809 register Lisp_Object tem
, string
;
3811 if (NILP (obarray
)) obarray
= Vobarray
;
3812 obarray
= check_obarray (obarray
);
3814 if (!SYMBOLP (name
))
3816 CHECK_STRING (name
);
3820 string
= SYMBOL_NAME (name
);
3822 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3823 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3829 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3830 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3831 The value is t if a symbol was found and deleted, nil otherwise.
3832 NAME may be a string or a symbol. If it is a symbol, that symbol
3833 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3834 OBARRAY defaults to the value of the variable `obarray'. */)
3835 (Lisp_Object name
, Lisp_Object obarray
)
3837 register Lisp_Object string
, tem
;
3840 if (NILP (obarray
)) obarray
= Vobarray
;
3841 obarray
= check_obarray (obarray
);
3844 string
= SYMBOL_NAME (name
);
3847 CHECK_STRING (name
);
3851 tem
= oblookup (obarray
, SDATA (string
),
3856 /* If arg was a symbol, don't delete anything but that symbol itself. */
3857 if (SYMBOLP (name
) && !EQ (name
, tem
))
3860 /* There are plenty of other symbols which will screw up the Emacs
3861 session if we unintern them, as well as even more ways to use
3862 `setq' or `fset' or whatnot to make the Emacs session
3863 unusable. Let's not go down this silly road. --Stef */
3864 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3865 error ("Attempt to unintern t or nil"); */
3867 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3869 hash
= oblookup_last_bucket_number
;
3871 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3873 if (XSYMBOL (tem
)->next
)
3874 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3876 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3880 Lisp_Object tail
, following
;
3882 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3883 XSYMBOL (tail
)->next
;
3886 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3887 if (EQ (following
, tem
))
3889 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3898 /* Return the symbol in OBARRAY whose names matches the string
3899 of SIZE characters (SIZE_BYTE bytes) at PTR.
3900 If there is no such symbol in OBARRAY, return nil.
3902 Also store the bucket number in oblookup_last_bucket_number. */
3905 oblookup (Lisp_Object obarray
, register const char *ptr
, int size
, int size_byte
)
3909 register Lisp_Object tail
;
3910 Lisp_Object bucket
, tem
;
3912 if (!VECTORP (obarray
)
3913 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3915 obarray
= check_obarray (obarray
);
3916 obsize
= XVECTOR (obarray
)->size
;
3918 /* This is sometimes needed in the middle of GC. */
3919 obsize
&= ~ARRAY_MARK_FLAG
;
3920 hash
= hash_string (ptr
, size_byte
) % obsize
;
3921 bucket
= XVECTOR (obarray
)->contents
[hash
];
3922 oblookup_last_bucket_number
= hash
;
3923 if (EQ (bucket
, make_number (0)))
3925 else if (!SYMBOLP (bucket
))
3926 error ("Bad data in guts of obarray"); /* Like CADR error message */
3928 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3930 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3931 && SCHARS (SYMBOL_NAME (tail
)) == size
3932 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3934 else if (XSYMBOL (tail
)->next
== 0)
3937 XSETINT (tem
, hash
);
3942 hash_string (const unsigned char *ptr
, int len
)
3944 register const unsigned char *p
= ptr
;
3945 register const unsigned char *end
= p
+ len
;
3946 register unsigned char c
;
3947 register int hash
= 0;
3952 if (c
>= 0140) c
-= 40;
3953 hash
= ((hash
<<3) + (hash
>>28) + c
);
3955 return hash
& 07777777777;
3959 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3962 register Lisp_Object tail
;
3963 CHECK_VECTOR (obarray
);
3964 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3966 tail
= XVECTOR (obarray
)->contents
[i
];
3971 if (XSYMBOL (tail
)->next
== 0)
3973 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3979 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3981 call1 (function
, sym
);
3984 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3985 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3986 OBARRAY defaults to the value of `obarray'. */)
3987 (Lisp_Object function
, Lisp_Object obarray
)
3989 if (NILP (obarray
)) obarray
= Vobarray
;
3990 obarray
= check_obarray (obarray
);
3992 map_obarray (obarray
, mapatoms_1
, function
);
3996 #define OBARRAY_SIZE 1511
4001 Lisp_Object oblength
;
4003 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4005 Vobarray
= Fmake_vector (oblength
, make_number (0));
4006 initial_obarray
= Vobarray
;
4007 staticpro (&initial_obarray
);
4009 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
4010 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4011 NILP (Vpurify_flag) check in intern_c_string. */
4012 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4013 Qnil
= intern_c_string ("nil");
4015 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4016 so those two need to be fixed manally. */
4017 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4018 XSYMBOL (Qunbound
)->function
= Qunbound
;
4019 XSYMBOL (Qunbound
)->plist
= Qnil
;
4020 /* XSYMBOL (Qnil)->function = Qunbound; */
4021 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4022 XSYMBOL (Qnil
)->constant
= 1;
4023 XSYMBOL (Qnil
)->plist
= Qnil
;
4025 Qt
= intern_c_string ("t");
4026 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4027 XSYMBOL (Qt
)->constant
= 1;
4029 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4032 Qvariable_documentation
= intern_c_string ("variable-documentation");
4033 staticpro (&Qvariable_documentation
);
4035 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
4036 read_buffer
= (char *) xmalloc (read_buffer_size
);
4040 defsubr (struct Lisp_Subr
*sname
)
4043 sym
= intern_c_string (sname
->symbol_name
);
4044 XSETPVECTYPE (sname
, PVEC_SUBR
);
4045 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4048 #ifdef NOTDEF /* use fset in subr.el now */
4050 defalias (sname
, string
)
4051 struct Lisp_Subr
*sname
;
4055 sym
= intern (string
);
4056 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4060 /* Define an "integer variable"; a symbol whose value is forwarded
4061 to a C variable of type int. Sample call:
4062 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4064 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4065 const char *namestring
, EMACS_INT
*address
)
4068 sym
= intern_c_string (namestring
);
4069 i_fwd
->type
= Lisp_Fwd_Int
;
4070 i_fwd
->intvar
= address
;
4071 XSYMBOL (sym
)->declared_special
= 1;
4072 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4073 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4076 /* Similar but define a variable whose value is t if address contains 1,
4077 nil if address contains 0. */
4079 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4080 const char *namestring
, int *address
)
4083 sym
= intern_c_string (namestring
);
4084 b_fwd
->type
= Lisp_Fwd_Bool
;
4085 b_fwd
->boolvar
= address
;
4086 XSYMBOL (sym
)->declared_special
= 1;
4087 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4088 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4089 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4092 /* Similar but define a variable whose value is the Lisp Object stored
4093 at address. Two versions: with and without gc-marking of the C
4094 variable. The nopro version is used when that variable will be
4095 gc-marked for some other reason, since marking the same slot twice
4096 can cause trouble with strings. */
4098 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4099 const char *namestring
, Lisp_Object
*address
)
4102 sym
= intern_c_string (namestring
);
4103 o_fwd
->type
= Lisp_Fwd_Obj
;
4104 o_fwd
->objvar
= address
;
4105 XSYMBOL (sym
)->declared_special
= 1;
4106 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4107 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4111 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4112 const char *namestring
, Lisp_Object
*address
)
4114 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4115 staticpro (address
);
4119 /* Similar but define a variable whose value is the Lisp Object stored
4120 at a particular offset in the current kboard object. */
4123 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4124 const char *namestring
, int offset
)
4127 sym
= intern_c_string (namestring
);
4128 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4129 ko_fwd
->offset
= offset
;
4130 XSYMBOL (sym
)->declared_special
= 1;
4131 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4132 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4135 /* Record the value of load-path used at the start of dumping
4136 so we can see if the site changed it later during dumping. */
4137 static Lisp_Object dump_path
;
4143 int turn_off_warning
= 0;
4145 /* Compute the default load-path. */
4147 normal
= PATH_LOADSEARCH
;
4148 Vload_path
= decode_env_path (0, normal
);
4150 if (NILP (Vpurify_flag
))
4151 normal
= PATH_LOADSEARCH
;
4153 normal
= PATH_DUMPLOADSEARCH
;
4155 /* In a dumped Emacs, we normally have to reset the value of
4156 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4157 uses ../lisp, instead of the path of the installed elisp
4158 libraries. However, if it appears that Vload_path was changed
4159 from the default before dumping, don't override that value. */
4162 if (! NILP (Fequal (dump_path
, Vload_path
)))
4164 Vload_path
= decode_env_path (0, normal
);
4165 if (!NILP (Vinstallation_directory
))
4167 Lisp_Object tem
, tem1
, sitelisp
;
4169 /* Remove site-lisp dirs from path temporarily and store
4170 them in sitelisp, then conc them on at the end so
4171 they're always first in path. */
4175 tem
= Fcar (Vload_path
);
4176 tem1
= Fstring_match (build_string ("site-lisp"),
4180 Vload_path
= Fcdr (Vload_path
);
4181 sitelisp
= Fcons (tem
, sitelisp
);
4187 /* Add to the path the lisp subdir of the
4188 installation dir, if it exists. */
4189 tem
= Fexpand_file_name (build_string ("lisp"),
4190 Vinstallation_directory
);
4191 tem1
= Ffile_exists_p (tem
);
4194 if (NILP (Fmember (tem
, Vload_path
)))
4196 turn_off_warning
= 1;
4197 Vload_path
= Fcons (tem
, Vload_path
);
4201 /* That dir doesn't exist, so add the build-time
4202 Lisp dirs instead. */
4203 Vload_path
= nconc2 (Vload_path
, dump_path
);
4205 /* Add leim under the installation dir, if it exists. */
4206 tem
= Fexpand_file_name (build_string ("leim"),
4207 Vinstallation_directory
);
4208 tem1
= Ffile_exists_p (tem
);
4211 if (NILP (Fmember (tem
, Vload_path
)))
4212 Vload_path
= Fcons (tem
, Vload_path
);
4215 /* Add site-lisp under the installation dir, if it exists. */
4216 tem
= Fexpand_file_name (build_string ("site-lisp"),
4217 Vinstallation_directory
);
4218 tem1
= Ffile_exists_p (tem
);
4221 if (NILP (Fmember (tem
, Vload_path
)))
4222 Vload_path
= Fcons (tem
, Vload_path
);
4225 /* If Emacs was not built in the source directory,
4226 and it is run from where it was built, add to load-path
4227 the lisp, leim and site-lisp dirs under that directory. */
4229 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4233 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4234 Vinstallation_directory
);
4235 tem1
= Ffile_exists_p (tem
);
4237 /* Don't be fooled if they moved the entire source tree
4238 AFTER dumping Emacs. If the build directory is indeed
4239 different from the source dir, src/Makefile.in and
4240 src/Makefile will not be found together. */
4241 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4242 Vinstallation_directory
);
4243 tem2
= Ffile_exists_p (tem
);
4244 if (!NILP (tem1
) && NILP (tem2
))
4246 tem
= Fexpand_file_name (build_string ("lisp"),
4249 if (NILP (Fmember (tem
, Vload_path
)))
4250 Vload_path
= Fcons (tem
, Vload_path
);
4252 tem
= Fexpand_file_name (build_string ("leim"),
4255 if (NILP (Fmember (tem
, Vload_path
)))
4256 Vload_path
= Fcons (tem
, Vload_path
);
4258 tem
= Fexpand_file_name (build_string ("site-lisp"),
4261 if (NILP (Fmember (tem
, Vload_path
)))
4262 Vload_path
= Fcons (tem
, Vload_path
);
4265 if (!NILP (sitelisp
))
4266 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4272 /* NORMAL refers to the lisp dir in the source directory. */
4273 /* We used to add ../lisp at the front here, but
4274 that caused trouble because it was copied from dump_path
4275 into Vload_path, above, when Vinstallation_directory was non-nil.
4276 It should be unnecessary. */
4277 Vload_path
= decode_env_path (0, normal
);
4278 dump_path
= Vload_path
;
4282 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4283 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4284 almost never correct, thereby causing a warning to be printed out that
4285 confuses users. Since PATH_LOADSEARCH is always overridden by the
4286 EMACSLOADPATH environment variable below, disable the warning on NT. */
4288 /* Warn if dirs in the *standard* path don't exist. */
4289 if (!turn_off_warning
)
4291 Lisp_Object path_tail
;
4293 for (path_tail
= Vload_path
;
4295 path_tail
= XCDR (path_tail
))
4297 Lisp_Object dirfile
;
4298 dirfile
= Fcar (path_tail
);
4299 if (STRINGP (dirfile
))
4301 dirfile
= Fdirectory_file_name (dirfile
);
4302 if (access (SDATA (dirfile
), 0) < 0)
4303 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4308 #endif /* !(WINDOWSNT || HAVE_NS) */
4310 /* If the EMACSLOADPATH environment variable is set, use its value.
4311 This doesn't apply if we're dumping. */
4313 if (NILP (Vpurify_flag
)
4314 && egetenv ("EMACSLOADPATH"))
4316 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4320 load_in_progress
= 0;
4321 Vload_file_name
= Qnil
;
4323 load_descriptor_list
= Qnil
;
4325 Vstandard_input
= Qt
;
4326 Vloads_in_progress
= Qnil
;
4329 /* Print a warning, using format string FORMAT, that directory DIRNAME
4330 does not exist. Print it on stderr and put it in *Messages*. */
4333 dir_warning (const char *format
, Lisp_Object dirname
)
4336 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4338 fprintf (stderr
, format
, SDATA (dirname
));
4339 sprintf (buffer
, format
, SDATA (dirname
));
4340 /* Don't log the warning before we've initialized!! */
4342 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4346 syms_of_lread (void)
4349 defsubr (&Sread_from_string
);
4351 defsubr (&Sintern_soft
);
4352 defsubr (&Sunintern
);
4353 defsubr (&Sget_load_suffixes
);
4355 defsubr (&Seval_buffer
);
4356 defsubr (&Seval_region
);
4357 defsubr (&Sread_char
);
4358 defsubr (&Sread_char_exclusive
);
4359 defsubr (&Sread_event
);
4360 defsubr (&Sget_file_char
);
4361 defsubr (&Smapatoms
);
4362 defsubr (&Slocate_file_internal
);
4364 DEFVAR_LISP ("obarray", &Vobarray
,
4365 doc
: /* Symbol table for use by `intern' and `read'.
4366 It is a vector whose length ought to be prime for best results.
4367 The vector's contents don't make sense if examined from Lisp programs;
4368 to find all the symbols in an obarray, use `mapatoms'. */);
4370 DEFVAR_LISP ("values", &Vvalues
,
4371 doc
: /* List of values of all expressions which were read, evaluated and printed.
4372 Order is reverse chronological. */);
4374 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4375 doc
: /* Stream for read to get input from.
4376 See documentation of `read' for possible values. */);
4377 Vstandard_input
= Qt
;
4379 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4380 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4382 If this variable is a buffer, then only forms read from that buffer
4383 will be added to `read-symbol-positions-list'.
4384 If this variable is t, then all read forms will be added.
4385 The effect of all other values other than nil are not currently
4386 defined, although they may be in the future.
4388 The positions are relative to the last call to `read' or
4389 `read-from-string'. It is probably a bad idea to set this variable at
4390 the toplevel; bind it instead. */);
4391 Vread_with_symbol_positions
= Qnil
;
4393 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4394 doc
: /* A list mapping read symbols to their positions.
4395 This variable is modified during calls to `read' or
4396 `read-from-string', but only when `read-with-symbol-positions' is
4399 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4400 CHAR-POSITION is an integer giving the offset of that occurrence of the
4401 symbol from the position where `read' or `read-from-string' started.
4403 Note that a symbol will appear multiple times in this list, if it was
4404 read multiple times. The list is in the same order as the symbols
4406 Vread_symbol_positions_list
= Qnil
;
4408 DEFVAR_LISP ("read-circle", &Vread_circle
,
4409 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4412 DEFVAR_LISP ("load-path", &Vload_path
,
4413 doc
: /* *List of directories to search for files to load.
4414 Each element is a string (directory name) or nil (try default directory).
4415 Initialized based on EMACSLOADPATH environment variable, if any,
4416 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4418 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4419 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4420 This list should not include the empty string.
4421 `load' and related functions try to append these suffixes, in order,
4422 to the specified file name if a Lisp suffix is allowed or required. */);
4423 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4424 Fcons (make_pure_c_string (".el"), Qnil
));
4425 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4426 doc
: /* List of suffixes that indicate representations of \
4428 This list should normally start with the empty string.
4430 Enabling Auto Compression mode appends the suffixes in
4431 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4432 mode removes them again. `load' and related functions use this list to
4433 determine whether they should look for compressed versions of a file
4434 and, if so, which suffixes they should try to append to the file name
4435 in order to do so. However, if you want to customize which suffixes
4436 the loading functions recognize as compression suffixes, you should
4437 customize `jka-compr-load-suffixes' rather than the present variable. */);
4438 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4440 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4441 doc
: /* Non-nil if inside of `load'. */);
4442 Qload_in_progress
= intern_c_string ("load-in-progress");
4443 staticpro (&Qload_in_progress
);
4445 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4446 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4447 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4449 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4450 a symbol \(a feature name).
4452 When `load' is run and the file-name argument matches an element's
4453 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4454 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4456 An error in FORMS does not undo the load, but does prevent execution of
4457 the rest of the FORMS. */);
4458 Vafter_load_alist
= Qnil
;
4460 DEFVAR_LISP ("load-history", &Vload_history
,
4461 doc
: /* Alist mapping loaded file names to symbols and features.
4462 Each alist element should be a list (FILE-NAME ENTRIES...), where
4463 FILE-NAME is the name of a file that has been loaded into Emacs.
4464 The file name is absolute and true (i.e. it doesn't contain symlinks).
4465 As an exception, one of the alist elements may have FILE-NAME nil,
4466 for symbols and features not associated with any file.
4468 The remaining ENTRIES in the alist element describe the functions and
4469 variables defined in that file, the features provided, and the
4470 features required. Each entry has the form `(provide . FEATURE)',
4471 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4472 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4473 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4474 SYMBOL was an autoload before this file redefined it as a function.
4476 During preloading, the file name recorded is relative to the main Lisp
4477 directory. These file names are converted to absolute at startup. */);
4478 Vload_history
= Qnil
;
4480 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4481 doc
: /* Full name of file being loaded by `load'. */);
4482 Vload_file_name
= Qnil
;
4484 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4485 doc
: /* File name, including directory, of user's initialization file.
4486 If the file loaded had extension `.elc', and the corresponding source file
4487 exists, this variable contains the name of source file, suitable for use
4488 by functions like `custom-save-all' which edit the init file.
4489 While Emacs loads and evaluates the init file, value is the real name
4490 of the file, regardless of whether or not it has the `.elc' extension. */);
4491 Vuser_init_file
= Qnil
;
4493 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4494 doc
: /* Used for internal purposes by `load'. */);
4495 Vcurrent_load_list
= Qnil
;
4497 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4498 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4499 The default is nil, which means use the function `read'. */);
4500 Vload_read_function
= Qnil
;
4502 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4503 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4504 This function is for doing code conversion before reading the source file.
4505 If nil, loading is done without any code conversion.
4506 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4507 FULLNAME is the full name of FILE.
4508 See `load' for the meaning of the remaining arguments. */);
4509 Vload_source_file_function
= Qnil
;
4511 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4512 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4513 This is useful when the file being loaded is a temporary copy. */);
4514 load_force_doc_strings
= 0;
4516 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4517 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4518 This is normally bound by `load' and `eval-buffer' to control `read',
4519 and is not meant for users to change. */);
4520 load_convert_to_unibyte
= 0;
4522 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4523 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4524 You cannot count on them to still be there! */);
4526 = Fexpand_file_name (build_string ("../"),
4527 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4529 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4530 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4531 Vpreloaded_file_list
= Qnil
;
4533 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4534 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4535 Vbyte_boolean_vars
= Qnil
;
4537 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4538 doc
: /* Non-nil means load dangerous compiled Lisp files.
4539 Some versions of XEmacs use different byte codes than Emacs. These
4540 incompatible byte codes can make Emacs crash when it tries to execute
4542 load_dangerous_libraries
= 0;
4544 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4545 doc
: /* Non-nil means force printing messages when loading Lisp files.
4546 This overrides the value of the NOMESSAGE argument to `load'. */);
4547 force_load_messages
= 0;
4549 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4550 doc
: /* Regular expression matching safe to load compiled Lisp files.
4551 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4552 from the file, and matches them against this regular expression.
4553 When the regular expression matches, the file is considered to be safe
4554 to load. See also `load-dangerous-libraries'. */);
4555 Vbytecomp_version_regexp
4556 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4558 Qlexical_binding
= intern ("lexical-binding");
4559 staticpro (&Qlexical_binding
);
4560 DEFVAR_LISP ("lexical-binding", &Vlexical_binding
,
4561 doc
: /* If non-nil, use lexical binding when evaluating code.
4562 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4563 This variable is automatically set from the file variables of an interpreted
4564 lisp file read using `load'.
4565 This variable automatically becomes buffer-local when set. */);
4566 Fmake_variable_buffer_local (Qlexical_binding
);
4568 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4569 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4570 Veval_buffer_list
= Qnil
;
4572 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4573 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4574 Vold_style_backquotes
= Qnil
;
4575 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4576 staticpro (&Qold_style_backquotes
);
4578 /* Vsource_directory was initialized in init_lread. */
4580 load_descriptor_list
= Qnil
;
4581 staticpro (&load_descriptor_list
);
4583 Qcurrent_load_list
= intern_c_string ("current-load-list");
4584 staticpro (&Qcurrent_load_list
);
4586 Qstandard_input
= intern_c_string ("standard-input");
4587 staticpro (&Qstandard_input
);
4589 Qread_char
= intern_c_string ("read-char");
4590 staticpro (&Qread_char
);
4592 Qget_file_char
= intern_c_string ("get-file-char");
4593 staticpro (&Qget_file_char
);
4595 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4596 staticpro (&Qget_emacs_mule_file_char
);
4598 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4599 staticpro (&Qload_force_doc_strings
);
4601 Qbackquote
= intern_c_string ("`");
4602 staticpro (&Qbackquote
);
4603 Qcomma
= intern_c_string (",");
4604 staticpro (&Qcomma
);
4605 Qcomma_at
= intern_c_string (",@");
4606 staticpro (&Qcomma_at
);
4607 Qcomma_dot
= intern_c_string (",.");
4608 staticpro (&Qcomma_dot
);
4610 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4611 staticpro (&Qinhibit_file_name_operation
);
4613 Qascii_character
= intern_c_string ("ascii-character");
4614 staticpro (&Qascii_character
);
4616 Qfunction
= intern_c_string ("function");
4617 staticpro (&Qfunction
);
4619 Qload
= intern_c_string ("load");
4622 Qload_file_name
= intern_c_string ("load-file-name");
4623 staticpro (&Qload_file_name
);
4625 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4626 staticpro (&Qeval_buffer_list
);
4628 Qfile_truename
= intern_c_string ("file-truename");
4629 staticpro (&Qfile_truename
) ;
4631 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4632 staticpro (&Qdo_after_load_evaluation
) ;
4634 staticpro (&dump_path
);
4636 staticpro (&read_objects
);
4637 read_objects
= Qnil
;
4638 staticpro (&seen_list
);
4641 Vloads_in_progress
= Qnil
;
4642 staticpro (&Vloads_in_progress
);
4644 Qhash_table
= intern_c_string ("hash-table");
4645 staticpro (&Qhash_table
);
4646 Qdata
= intern_c_string ("data");
4648 Qtest
= intern_c_string ("test");
4650 Qsize
= intern_c_string ("size");
4652 Qweakness
= intern_c_string ("weakness");
4653 staticpro (&Qweakness
);
4654 Qrehash_size
= intern_c_string ("rehash-size");
4655 staticpro (&Qrehash_size
);
4656 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4657 staticpro (&Qrehash_threshold
);
4660 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4661 (do not change this comment) */