1 /* Lisp parsing and input streams.
3 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997,
4 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 2009, 2010 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include <sys/types.h>
31 #include "intervals.h"
33 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
56 #endif /* HAVE_SETLOCALE */
61 #define file_offset off_t
62 #define file_tell ftello
64 #define file_offset long
65 #define file_tell ftell
68 /* hash table read constants */
69 Lisp_Object Qhash_table
, Qdata
;
70 Lisp_Object Qtest
, Qsize
;
71 Lisp_Object Qweakness
;
72 Lisp_Object Qrehash_size
;
73 Lisp_Object Qrehash_threshold
;
75 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
76 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
77 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
78 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
79 Lisp_Object Qinhibit_file_name_operation
;
80 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
81 Lisp_Object Qlexical_binding
;
82 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
84 /* Used instead of Qget_file_char while loading *.elc files compiled
85 by Emacs 21 or older. */
86 static Lisp_Object Qget_emacs_mule_file_char
;
88 static Lisp_Object Qload_force_doc_strings
;
90 extern Lisp_Object Qinternal_interpreter_environment
;
92 /* non-zero if inside `load' */
94 static Lisp_Object Qload_in_progress
;
96 /* Directory in which the sources were found. */
97 Lisp_Object Vsource_directory
;
99 /* Search path and suffixes for files to be loaded. */
100 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
102 /* File name of user's init file. */
103 Lisp_Object Vuser_init_file
;
105 /* This is the user-visible association list that maps features to
106 lists of defs in their load files. */
107 Lisp_Object Vload_history
;
109 /* This is used to build the load history. */
110 Lisp_Object Vcurrent_load_list
;
112 /* List of files that were preloaded. */
113 Lisp_Object Vpreloaded_file_list
;
115 /* Name of file actually being read by `load'. */
116 Lisp_Object Vload_file_name
;
118 /* Function to use for reading, in `load' and friends. */
119 Lisp_Object Vload_read_function
;
121 /* Non-nil means read recursive structures using #n= and #n# syntax. */
122 Lisp_Object Vread_circle
;
124 /* The association list of objects read with the #n=object form.
125 Each member of the list has the form (n . object), and is used to
126 look up the object for the corresponding #n# construct.
127 It must be set to nil before all top-level calls to read0. */
128 Lisp_Object read_objects
;
130 /* Nonzero means load should forcibly load all dynamic doc strings. */
131 static int load_force_doc_strings
;
133 /* Nonzero means read should convert strings to unibyte. */
134 static int load_convert_to_unibyte
;
136 /* Nonzero means READCHAR should read bytes one by one (not character)
137 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
138 This is set to 1 by read1 temporarily while handling #@NUMBER. */
139 static int load_each_byte
;
141 /* Function to use for loading an Emacs Lisp source file (not
142 compiled) instead of readevalloop. */
143 Lisp_Object Vload_source_file_function
;
145 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
146 Lisp_Object Vbyte_boolean_vars
;
148 /* Whether or not to add a `read-positions' property to symbols
150 Lisp_Object Vread_with_symbol_positions
;
152 /* List of (SYMBOL . POSITION) accumulated so far. */
153 Lisp_Object Vread_symbol_positions_list
;
155 /* If non-nil `readevalloop' evaluates code in a lexical environment. */
156 Lisp_Object Vlexical_binding
;
158 /* List of descriptors now open for Fload. */
159 static Lisp_Object load_descriptor_list
;
161 /* File for get_file_char to read from. Use by load. */
162 static FILE *instream
;
164 /* When nonzero, read conses in pure space */
165 static int read_pure
;
167 /* For use within read-from-string (this reader is non-reentrant!!) */
168 static EMACS_INT read_from_string_index
;
169 static EMACS_INT read_from_string_index_byte
;
170 static EMACS_INT read_from_string_limit
;
172 /* Number of characters read in the current call to Fread or
173 Fread_from_string. */
174 static EMACS_INT readchar_count
;
176 /* This contains the last string skipped with #@. */
177 static char *saved_doc_string
;
178 /* Length of buffer allocated in saved_doc_string. */
179 static int saved_doc_string_size
;
180 /* Length of actual data in saved_doc_string. */
181 static int saved_doc_string_length
;
182 /* This is the file position that string came from. */
183 static file_offset saved_doc_string_position
;
185 /* This contains the previous string skipped with #@.
186 We copy it from saved_doc_string when a new string
187 is put in saved_doc_string. */
188 static char *prev_saved_doc_string
;
189 /* Length of buffer allocated in prev_saved_doc_string. */
190 static int prev_saved_doc_string_size
;
191 /* Length of actual data in prev_saved_doc_string. */
192 static int prev_saved_doc_string_length
;
193 /* This is the file position that string came from. */
194 static file_offset prev_saved_doc_string_position
;
196 /* Nonzero means inside a new-style backquote
197 with no surrounding parentheses.
198 Fread initializes this to zero, so we need not specbind it
199 or worry about what happens to it when there is an error. */
200 static int new_backquote_flag
;
201 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
203 /* A list of file names for files being loaded in Fload. Used to
204 check for recursive loads. */
206 static Lisp_Object Vloads_in_progress
;
208 /* Non-zero means load dangerous compiled Lisp files. */
210 int load_dangerous_libraries
;
212 /* Non-zero means force printing messages when loading Lisp files. */
214 int force_load_messages
;
216 /* A regular expression used to detect files compiled with Emacs. */
218 static Lisp_Object Vbytecomp_version_regexp
;
220 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
223 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
,
224 Lisp_Object (*) (Lisp_Object
), int,
225 Lisp_Object
, Lisp_Object
,
226 Lisp_Object
, Lisp_Object
);
227 static Lisp_Object
load_unwind (Lisp_Object
);
228 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
230 static void invalid_syntax (const char *, int) NO_RETURN
;
231 static void end_of_file_error (void) NO_RETURN
;
234 /* Functions that read one byte from the current source READCHARFUN
235 or unreads one byte. If the integer argument C is -1, it returns
236 one read byte, or -1 when there's no more byte in the source. If C
237 is 0 or positive, it unreads C, and the return value is not
240 static int readbyte_for_lambda (int, Lisp_Object
);
241 static int readbyte_from_file (int, Lisp_Object
);
242 static int readbyte_from_string (int, Lisp_Object
);
244 /* Handle unreading and rereading of characters.
245 Write READCHAR to read a character,
246 UNREAD(c) to unread c to be read again.
248 These macros correctly read/unread multibyte characters. */
250 #define READCHAR readchar (readcharfun, NULL)
251 #define UNREAD(c) unreadchar (readcharfun, c)
253 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
254 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
256 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
257 Qlambda, or a cons, we use this to keep an unread character because
258 a file stream can't handle multibyte-char unreading. The value -1
259 means that there's no unread character. */
260 static int unread_char
;
263 readchar (Lisp_Object readcharfun
, int *multibyte
)
267 int (*readbyte
) (int, Lisp_Object
);
268 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
270 int emacs_mule_encoding
= 0;
277 if (BUFFERP (readcharfun
))
279 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
281 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
283 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
286 if (! NILP (inbuffer
->enable_multibyte_characters
))
288 /* Fetch the character code from the buffer. */
289 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
290 BUF_INC_POS (inbuffer
, pt_byte
);
297 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
298 if (! ASCII_BYTE_P (c
))
299 c
= BYTE8_TO_CHAR (c
);
302 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
306 if (MARKERP (readcharfun
))
308 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
310 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
312 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
315 if (! NILP (inbuffer
->enable_multibyte_characters
))
317 /* Fetch the character code from the buffer. */
318 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
319 BUF_INC_POS (inbuffer
, bytepos
);
326 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
327 if (! ASCII_BYTE_P (c
))
328 c
= BYTE8_TO_CHAR (c
);
332 XMARKER (readcharfun
)->bytepos
= bytepos
;
333 XMARKER (readcharfun
)->charpos
++;
338 if (EQ (readcharfun
, Qlambda
))
340 readbyte
= readbyte_for_lambda
;
344 if (EQ (readcharfun
, Qget_file_char
))
346 readbyte
= readbyte_from_file
;
350 if (STRINGP (readcharfun
))
352 if (read_from_string_index
>= read_from_string_limit
)
354 else if (STRING_MULTIBYTE (readcharfun
))
358 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
359 read_from_string_index
,
360 read_from_string_index_byte
);
364 c
= SREF (readcharfun
, read_from_string_index_byte
);
365 read_from_string_index
++;
366 read_from_string_index_byte
++;
371 if (CONSP (readcharfun
))
373 /* This is the case that read_vector is reading from a unibyte
374 string that contains a byte sequence previously skipped
375 because of #@NUMBER. The car part of readcharfun is that
376 string, and the cdr part is a value of readcharfun given to
378 readbyte
= readbyte_from_string
;
379 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
380 emacs_mule_encoding
= 1;
384 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
386 readbyte
= readbyte_from_file
;
387 emacs_mule_encoding
= 1;
391 tem
= call0 (readcharfun
);
398 if (unread_char
>= 0)
404 c
= (*readbyte
) (-1, readcharfun
);
405 if (c
< 0 || load_each_byte
)
409 if (ASCII_BYTE_P (c
))
411 if (emacs_mule_encoding
)
412 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
415 len
= BYTES_BY_CHAR_HEAD (c
);
418 c
= (*readbyte
) (-1, readcharfun
);
419 if (c
< 0 || ! TRAILING_CODE_P (c
))
422 (*readbyte
) (buf
[i
], readcharfun
);
423 return BYTE8_TO_CHAR (buf
[0]);
427 return STRING_CHAR (buf
);
430 /* Unread the character C in the way appropriate for the stream READCHARFUN.
431 If the stream is a user function, call it with the char as argument. */
434 unreadchar (Lisp_Object readcharfun
, int c
)
438 /* Don't back up the pointer if we're unreading the end-of-input mark,
439 since readchar didn't advance it when we read it. */
441 else if (BUFFERP (readcharfun
))
443 struct buffer
*b
= XBUFFER (readcharfun
);
444 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
447 if (! NILP (b
->enable_multibyte_characters
))
448 BUF_DEC_POS (b
, bytepos
);
452 BUF_PT_BYTE (b
) = bytepos
;
454 else if (MARKERP (readcharfun
))
456 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
457 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
459 XMARKER (readcharfun
)->charpos
--;
460 if (! NILP (b
->enable_multibyte_characters
))
461 BUF_DEC_POS (b
, bytepos
);
465 XMARKER (readcharfun
)->bytepos
= bytepos
;
467 else if (STRINGP (readcharfun
))
469 read_from_string_index
--;
470 read_from_string_index_byte
471 = string_char_to_byte (readcharfun
, read_from_string_index
);
473 else if (CONSP (readcharfun
))
477 else if (EQ (readcharfun
, Qlambda
))
481 else if (EQ (readcharfun
, Qget_file_char
)
482 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
487 ungetc (c
, instream
);
494 call1 (readcharfun
, make_number (c
));
498 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
500 return read_bytecode_char (c
>= 0);
505 readbyte_from_file (int c
, Lisp_Object readcharfun
)
510 ungetc (c
, instream
);
519 /* Interrupted reads have been observed while reading over the network */
520 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
532 return (c
== EOF
? -1 : c
);
536 readbyte_from_string (int c
, Lisp_Object readcharfun
)
538 Lisp_Object string
= XCAR (readcharfun
);
542 read_from_string_index
--;
543 read_from_string_index_byte
544 = string_char_to_byte (string
, read_from_string_index
);
547 if (read_from_string_index
>= read_from_string_limit
)
550 FETCH_STRING_CHAR_ADVANCE (c
, string
,
551 read_from_string_index
,
552 read_from_string_index_byte
);
557 /* Read one non-ASCII character from INSTREAM. The character is
558 encoded in `emacs-mule' and the first byte is already read in
562 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
564 /* Emacs-mule coding uses at most 4-byte for one character. */
565 unsigned char buf
[4];
566 int len
= emacs_mule_bytes
[c
];
567 struct charset
*charset
;
572 /* C is not a valid leading-code of `emacs-mule'. */
573 return BYTE8_TO_CHAR (c
);
579 c
= (*readbyte
) (-1, readcharfun
);
583 (*readbyte
) (buf
[i
], readcharfun
);
584 return BYTE8_TO_CHAR (buf
[0]);
591 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
592 code
= buf
[1] & 0x7F;
596 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
597 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
599 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
600 code
= buf
[2] & 0x7F;
604 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
605 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
610 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
611 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
613 c
= DECODE_CHAR (charset
, code
);
615 Fsignal (Qinvalid_read_syntax
,
616 Fcons (build_string ("invalid multibyte form"), Qnil
));
621 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
623 static Lisp_Object
read0 (Lisp_Object
);
624 static Lisp_Object
read1 (Lisp_Object
, int *, int);
626 static Lisp_Object
read_list (int, Lisp_Object
);
627 static Lisp_Object
read_vector (Lisp_Object
, int);
629 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
631 static void substitute_object_in_subtree (Lisp_Object
,
633 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
636 /* Get a character from the tty. */
638 /* Read input events until we get one that's acceptable for our purposes.
640 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
641 until we get a character we like, and then stuffed into
644 If ASCII_REQUIRED is non-zero, we check function key events to see
645 if the unmodified version of the symbol has a Qascii_character
646 property, and use that character, if present.
648 If ERROR_NONASCII is non-zero, we signal an error if the input we
649 get isn't an ASCII character with modifiers. If it's zero but
650 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
653 If INPUT_METHOD is nonzero, we invoke the current input method
654 if the character warrants that.
656 If SECONDS is a number, we wait that many seconds for input, and
657 return Qnil if no input arrives within that time. */
660 read_filtered_event (int no_switch_frame
, int ascii_required
,
661 int error_nonascii
, int input_method
, Lisp_Object seconds
)
663 Lisp_Object val
, delayed_switch_frame
;
666 #ifdef HAVE_WINDOW_SYSTEM
667 if (display_hourglass_p
)
671 delayed_switch_frame
= Qnil
;
673 /* Compute timeout. */
674 if (NUMBERP (seconds
))
676 EMACS_TIME wait_time
;
678 double duration
= extract_float (seconds
);
680 sec
= (int) duration
;
681 usec
= (duration
- sec
) * 1000000;
682 EMACS_GET_TIME (end_time
);
683 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
684 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
687 /* Read until we get an acceptable event. */
690 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
691 NUMBERP (seconds
) ? &end_time
: NULL
);
692 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
697 /* switch-frame events are put off until after the next ASCII
698 character. This is better than signaling an error just because
699 the last characters were typed to a separate minibuffer frame,
700 for example. Eventually, some code which can deal with
701 switch-frame events will read it and process it. */
703 && EVENT_HAS_PARAMETERS (val
)
704 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
706 delayed_switch_frame
= val
;
710 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
712 /* Convert certain symbols to their ASCII equivalents. */
715 Lisp_Object tem
, tem1
;
716 tem
= Fget (val
, Qevent_symbol_element_mask
);
719 tem1
= Fget (Fcar (tem
), Qascii_character
);
720 /* Merge this symbol's modifier bits
721 with the ASCII equivalent of its basic code. */
723 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
727 /* If we don't have a character now, deal with it appropriately. */
732 Vunread_command_events
= Fcons (val
, Qnil
);
733 error ("Non-character input-event");
740 if (! NILP (delayed_switch_frame
))
741 unread_switch_frame
= delayed_switch_frame
;
745 #ifdef HAVE_WINDOW_SYSTEM
746 if (display_hourglass_p
)
755 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
756 doc
: /* Read a character from the command input (keyboard or macro).
757 It is returned as a number.
758 If the character has modifiers, they are resolved and reflected to the
759 character code if possible (e.g. C-SPC -> 0).
761 If the user generates an event which is not a character (i.e. a mouse
762 click or function key event), `read-char' signals an error. As an
763 exception, switch-frame events are put off until non-character events
765 If you want to read non-character events, or ignore them, call
766 `read-event' or `read-char-exclusive' instead.
768 If the optional argument PROMPT is non-nil, display that as a prompt.
769 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
770 input method is turned on in the current buffer, that input method
771 is used for reading a character.
772 If the optional argument SECONDS is non-nil, it should be a number
773 specifying the maximum number of seconds to wait for input. If no
774 input arrives in that time, return nil. SECONDS may be a
775 floating-point value. */)
776 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
781 message_with_string ("%s", prompt
, 0);
782 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
784 return (NILP (val
) ? Qnil
785 : make_number (char_resolve_modifier_mask (XINT (val
))));
788 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
789 doc
: /* Read an event object from the input stream.
790 If the optional argument PROMPT is non-nil, display that as a prompt.
791 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
792 input method is turned on in the current buffer, that input method
793 is used for reading a character.
794 If the optional argument SECONDS is non-nil, it should be a number
795 specifying the maximum number of seconds to wait for input. If no
796 input arrives in that time, return nil. SECONDS may be a
797 floating-point value. */)
798 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
801 message_with_string ("%s", prompt
, 0);
802 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
805 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
806 doc
: /* Read a character from the command input (keyboard or macro).
807 It is returned as a number. Non-character events are ignored.
808 If the character has modifiers, they are resolved and reflected to the
809 character code if possible (e.g. C-SPC -> 0).
811 If the optional argument PROMPT is non-nil, display that as a prompt.
812 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
813 input method is turned on in the current buffer, that input method
814 is used for reading a character.
815 If the optional argument SECONDS is non-nil, it should be a number
816 specifying the maximum number of seconds to wait for input. If no
817 input arrives in that time, return nil. SECONDS may be a
818 floating-point value. */)
819 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
824 message_with_string ("%s", prompt
, 0);
826 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
828 return (NILP (val
) ? Qnil
829 : make_number (char_resolve_modifier_mask (XINT (val
))));
832 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
833 doc
: /* Don't use this yourself. */)
836 register Lisp_Object val
;
838 XSETINT (val
, getc (instream
));
846 /* Return true if the lisp code read using READCHARFUN defines a non-nil
847 `lexical-binding' file variable. After returning, the stream is
848 positioned following the first line, if it is a comment, otherwise
852 lisp_file_lexically_bound_p (Lisp_Object readcharfun
)
856 /* The first line isn't a comment, just give up. */
862 /* Look for an appropriate file-variable in the first line. */
866 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
867 } beg_end_state
= NOMINAL
;
868 int in_file_vars
= 0;
870 #define UPDATE_BEG_END_STATE(ch) \
871 if (beg_end_state == NOMINAL) \
872 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
873 else if (beg_end_state == AFTER_FIRST_DASH) \
874 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
875 else if (beg_end_state == AFTER_ASTERIX) \
878 in_file_vars = !in_file_vars; \
879 beg_end_state = NOMINAL; \
882 /* Skip until we get to the file vars, if any. */
886 UPDATE_BEG_END_STATE (ch
);
888 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
892 char var
[100], *var_end
, val
[100], *val_end
;
896 /* Read a variable name. */
897 while (ch
== ' ' || ch
== '\t')
901 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
903 if (var_end
< var
+ sizeof var
- 1)
905 UPDATE_BEG_END_STATE (ch
);
910 && (var_end
[-1] == ' ' || var_end
[-1] == '\t'))
916 /* Read a variable value. */
919 while (ch
== ' ' || ch
== '\t')
923 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
925 if (val_end
< val
+ sizeof val
- 1)
927 UPDATE_BEG_END_STATE (ch
);
931 /* The value was terminated by an end-marker, which
935 && (val_end
[-1] == ' ' || val_end
[-1] == '\t'))
939 if (strcmp (var
, "lexical-binding") == 0)
942 rv
= (strcmp (val
, "nil") != 0);
948 while (ch
!= '\n' && ch
!= EOF
)
956 /* Value is a version number of byte compiled code if the file
957 associated with file descriptor FD is a compiled Lisp file that's
958 safe to load. Only files compiled with Emacs are safe to load.
959 Files compiled with XEmacs can lead to a crash in Fbyte_code
960 because of an incompatible change in the byte compiler. */
963 safe_to_load_p (int fd
)
970 /* Read the first few bytes from the file, and look for a line
971 specifying the byte compiler version used. */
972 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
977 /* Skip to the next newline, skipping over the initial `ELC'
978 with NUL bytes following it, but note the version. */
979 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
984 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
991 lseek (fd
, 0, SEEK_SET
);
996 /* Callback for record_unwind_protect. Restore the old load list OLD,
997 after loading a file successfully. */
1000 record_load_unwind (Lisp_Object old
)
1002 return Vloads_in_progress
= old
;
1005 /* This handler function is used via internal_condition_case_1. */
1008 load_error_handler (Lisp_Object data
)
1014 load_warn_old_style_backquotes (Lisp_Object file
)
1016 if (!NILP (Vold_style_backquotes
))
1018 Lisp_Object args
[2];
1019 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
1026 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1027 doc
: /* Return the suffixes that `load' should try if a suffix is \
1029 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1032 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1033 while (CONSP (suffixes
))
1035 Lisp_Object exts
= Vload_file_rep_suffixes
;
1036 suffix
= XCAR (suffixes
);
1037 suffixes
= XCDR (suffixes
);
1038 while (CONSP (exts
))
1042 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1045 return Fnreverse (lst
);
1048 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1049 doc
: /* Execute a file of Lisp code named FILE.
1050 First try FILE with `.elc' appended, then try with `.el',
1051 then try FILE unmodified (the exact suffixes in the exact order are
1052 determined by `load-suffixes'). Environment variable references in
1053 FILE are replaced with their values by calling `substitute-in-file-name'.
1054 This function searches the directories in `load-path'.
1056 If optional second arg NOERROR is non-nil,
1057 report no error if FILE doesn't exist.
1058 Print messages at start and end of loading unless
1059 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1061 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1062 suffixes `.elc' or `.el' to the specified name FILE.
1063 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1064 the suffix `.elc' or `.el'; don't accept just FILE unless
1065 it ends in one of those suffixes or includes a directory name.
1067 If this function fails to find a file, it may look for different
1068 representations of that file before trying another file.
1069 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1070 to the file name. Emacs uses this feature mainly to find compressed
1071 versions of files when Auto Compression mode is enabled.
1073 The exact suffixes that this function tries out, in the exact order,
1074 are given by the value of the variable `load-file-rep-suffixes' if
1075 NOSUFFIX is non-nil and by the return value of the function
1076 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1077 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1078 and then the former.
1080 Loading a file records its definitions, and its `provide' and
1081 `require' calls, in an element of `load-history' whose
1082 car is the file name loaded. See `load-history'.
1084 While the file is in the process of being loaded, the variable
1085 `load-in-progress' is non-nil and the variable `load-file-name'
1086 is bound to the file's name.
1088 Return t if the file exists and loads successfully. */)
1089 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
1091 register FILE *stream
;
1092 register int fd
= -1;
1093 int count
= SPECPDL_INDEX ();
1094 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1095 Lisp_Object found
, efound
, hist_file_name
;
1096 /* 1 means we printed the ".el is newer" message. */
1098 /* 1 means we are loading a compiled file. */
1100 Lisp_Object handler
;
1102 const char *fmode
= "r";
1110 CHECK_STRING (file
);
1112 /* If file name is magic, call the handler. */
1113 /* This shouldn't be necessary any more now that `openp' handles it right.
1114 handler = Ffind_file_name_handler (file, Qload);
1115 if (!NILP (handler))
1116 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1118 /* Do this after the handler to avoid
1119 the need to gcpro noerror, nomessage and nosuffix.
1120 (Below here, we care only whether they are nil or not.)
1121 The presence of this call is the result of a historical accident:
1122 it used to be in every file-operation and when it got removed
1123 everywhere, it accidentally stayed here. Since then, enough people
1124 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1125 that it seemed risky to remove. */
1126 if (! NILP (noerror
))
1128 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1129 Qt
, load_error_handler
);
1134 file
= Fsubstitute_in_file_name (file
);
1137 /* Avoid weird lossage with null string as arg,
1138 since it would try to load a directory as a Lisp file */
1139 if (SCHARS (file
) > 0)
1141 int size
= SBYTES (file
);
1144 GCPRO2 (file
, found
);
1146 if (! NILP (must_suffix
))
1148 /* Don't insist on adding a suffix if FILE already ends with one. */
1150 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1153 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1155 /* Don't insist on adding a suffix
1156 if the argument includes a directory name. */
1157 else if (! NILP (Ffile_name_directory (file
)))
1161 fd
= openp (Vload_path
, file
,
1162 (!NILP (nosuffix
) ? Qnil
1163 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1164 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1165 tmp
[1] = Vload_file_rep_suffixes
,
1174 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1178 /* Tell startup.el whether or not we found the user's init file. */
1179 if (EQ (Qt
, Vuser_init_file
))
1180 Vuser_init_file
= found
;
1182 /* If FD is -2, that means openp found a magic file. */
1185 if (NILP (Fequal (found
, file
)))
1186 /* If FOUND is a different file name from FILE,
1187 find its handler even if we have already inhibited
1188 the `load' operation on FILE. */
1189 handler
= Ffind_file_name_handler (found
, Qt
);
1191 handler
= Ffind_file_name_handler (found
, Qload
);
1192 if (! NILP (handler
))
1193 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1196 /* Check if we're stuck in a recursive load cycle.
1198 2000-09-21: It's not possible to just check for the file loaded
1199 being a member of Vloads_in_progress. This fails because of the
1200 way the byte compiler currently works; `provide's are not
1201 evaluated, see font-lock.el/jit-lock.el as an example. This
1202 leads to a certain amount of ``normal'' recursion.
1204 Also, just loading a file recursively is not always an error in
1205 the general case; the second load may do something different. */
1209 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1210 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1214 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1216 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1217 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1220 /* All loads are by default dynamic, unless the file itself specifies
1221 otherwise using a file-variable in the first line. This is bound here
1222 so that it takes effect whether or not we use
1223 Vload_source_file_function. */
1224 specbind (Qlexical_binding
, Qnil
);
1226 /* Get the name for load-history. */
1227 hist_file_name
= (! NILP (Vpurify_flag
)
1228 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1229 tmp
[1] = Ffile_name_nondirectory (found
),
1235 /* Check for the presence of old-style quotes and warn about them. */
1236 specbind (Qold_style_backquotes
, Qnil
);
1237 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1239 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1240 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1241 /* Load .elc files directly, but not when they are
1242 remote and have no handler! */
1249 GCPRO3 (file
, found
, hist_file_name
);
1252 && ! (version
= safe_to_load_p (fd
)))
1255 if (!load_dangerous_libraries
)
1259 error ("File `%s' was not compiled in Emacs",
1262 else if (!NILP (nomessage
) && !force_load_messages
)
1263 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1268 efound
= ENCODE_FILE (found
);
1273 stat ((char *)SDATA (efound
), &s1
);
1274 SSET (efound
, SBYTES (efound
) - 1, 0);
1275 result
= stat ((char *)SDATA (efound
), &s2
);
1276 SSET (efound
, SBYTES (efound
) - 1, 'c');
1278 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1280 /* Make the progress messages mention that source is newer. */
1283 /* If we won't print another message, mention this anyway. */
1284 if (!NILP (nomessage
) && !force_load_messages
)
1286 Lisp_Object msg_file
;
1287 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1288 message_with_string ("Source file `%s' newer than byte-compiled file",
1297 /* We are loading a source file (*.el). */
1298 if (!NILP (Vload_source_file_function
))
1304 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1305 NILP (noerror
) ? Qnil
: Qt
,
1306 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1307 return unbind_to (count
, val
);
1311 GCPRO3 (file
, found
, hist_file_name
);
1315 efound
= ENCODE_FILE (found
);
1316 stream
= fopen ((char *) SDATA (efound
), fmode
);
1317 #else /* not WINDOWSNT */
1318 stream
= fdopen (fd
, fmode
);
1319 #endif /* not WINDOWSNT */
1323 error ("Failure to create stdio stream for %s", SDATA (file
));
1326 if (! NILP (Vpurify_flag
))
1327 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1329 if (NILP (nomessage
) || force_load_messages
)
1332 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1335 message_with_string ("Loading %s (source)...", file
, 1);
1337 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1339 else /* The typical case; compiled file newer than source file. */
1340 message_with_string ("Loading %s...", file
, 1);
1343 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1344 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1345 specbind (Qload_file_name
, found
);
1346 specbind (Qinhibit_file_name_operation
, Qnil
);
1347 load_descriptor_list
1348 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1350 specbind (Qload_in_progress
, Qt
);
1353 if (lisp_file_lexically_bound_p (Qget_file_char
))
1354 Fset (Qlexical_binding
, Qt
);
1356 if (! version
|| version
>= 22)
1357 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1358 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1361 /* We can't handle a file which was compiled with
1362 byte-compile-dynamic by older version of Emacs. */
1363 specbind (Qload_force_doc_strings
, Qt
);
1364 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1365 0, Qnil
, Qnil
, Qnil
, Qnil
);
1367 unbind_to (count
, Qnil
);
1369 /* Run any eval-after-load forms for this file */
1370 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1371 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1375 xfree (saved_doc_string
);
1376 saved_doc_string
= 0;
1377 saved_doc_string_size
= 0;
1379 xfree (prev_saved_doc_string
);
1380 prev_saved_doc_string
= 0;
1381 prev_saved_doc_string_size
= 0;
1383 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1386 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1389 message_with_string ("Loading %s (source)...done", file
, 1);
1391 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1393 else /* The typical case; compiled file newer than source file. */
1394 message_with_string ("Loading %s...done", file
, 1);
1401 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1403 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1414 load_descriptor_unwind (Lisp_Object oldlist
)
1416 load_descriptor_list
= oldlist
;
1420 /* Close all descriptors in use for Floads.
1421 This is used when starting a subprocess. */
1424 close_load_descs (void)
1428 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1429 emacs_close (XFASTINT (XCAR (tail
)));
1434 complete_filename_p (Lisp_Object pathname
)
1436 register const unsigned char *s
= SDATA (pathname
);
1437 return (IS_DIRECTORY_SEP (s
[0])
1438 || (SCHARS (pathname
) > 2
1439 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1442 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1443 doc
: /* Search for FILENAME through PATH.
1444 Returns the file's name in absolute form, or nil if not found.
1445 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1446 file name when searching.
1447 If non-nil, PREDICATE is used instead of `file-readable-p'.
1448 PREDICATE can also be an integer to pass to the access(2) function,
1449 in which case file-name-handlers are ignored. */)
1450 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1453 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1454 if (NILP (predicate
) && fd
> 0)
1460 /* Search for a file whose name is STR, looking in directories
1461 in the Lisp list PATH, and trying suffixes from SUFFIX.
1462 On success, returns a file descriptor. On failure, returns -1.
1464 SUFFIXES is a list of strings containing possible suffixes.
1465 The empty suffix is automatically added if the list is empty.
1467 PREDICATE non-nil means don't open the files,
1468 just look for one that satisfies the predicate. In this case,
1469 returns 1 on success. The predicate can be a lisp function or
1470 an integer to pass to `access' (in which case file-name-handlers
1473 If STOREPTR is nonzero, it points to a slot where the name of
1474 the file actually found should be stored as a Lisp string.
1475 nil is stored there on failure.
1477 If the file we find is remote, return -2
1478 but store the found remote file name in *STOREPTR. */
1481 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1486 register char *fn
= buf
;
1489 Lisp_Object filename
;
1491 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1492 Lisp_Object string
, tail
, encoded_fn
;
1493 int max_suffix_len
= 0;
1497 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1499 CHECK_STRING_CAR (tail
);
1500 max_suffix_len
= max (max_suffix_len
,
1501 SBYTES (XCAR (tail
)));
1504 string
= filename
= encoded_fn
= Qnil
;
1505 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1510 if (complete_filename_p (str
))
1513 for (; CONSP (path
); path
= XCDR (path
))
1515 filename
= Fexpand_file_name (str
, XCAR (path
));
1516 if (!complete_filename_p (filename
))
1517 /* If there are non-absolute elts in PATH (eg ".") */
1518 /* Of course, this could conceivably lose if luser sets
1519 default-directory to be something non-absolute... */
1521 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1522 if (!complete_filename_p (filename
))
1523 /* Give up on this path element! */
1527 /* Calculate maximum size of any filename made from
1528 this path element/specified file name and any possible suffix. */
1529 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1530 if (fn_size
< want_size
)
1531 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1533 /* Loop over suffixes. */
1534 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1535 CONSP (tail
); tail
= XCDR (tail
))
1537 int lsuffix
= SBYTES (XCAR (tail
));
1538 Lisp_Object handler
;
1541 /* Concatenate path element/specified name with the suffix.
1542 If the directory starts with /:, remove that. */
1543 if (SCHARS (filename
) > 2
1544 && SREF (filename
, 0) == '/'
1545 && SREF (filename
, 1) == ':')
1547 strncpy (fn
, SDATA (filename
) + 2,
1548 SBYTES (filename
) - 2);
1549 fn
[SBYTES (filename
) - 2] = 0;
1553 strncpy (fn
, SDATA (filename
),
1555 fn
[SBYTES (filename
)] = 0;
1558 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1559 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1561 /* Check that the file exists and is not a directory. */
1562 /* We used to only check for handlers on non-absolute file names:
1566 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1567 It's not clear why that was the case and it breaks things like
1568 (load "/bar.el") where the file is actually "/bar.el.gz". */
1569 string
= build_string (fn
);
1570 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1571 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1573 if (NILP (predicate
))
1574 exists
= !NILP (Ffile_readable_p (string
));
1576 exists
= !NILP (call1 (predicate
, string
));
1577 if (exists
&& !NILP (Ffile_directory_p (string
)))
1582 /* We succeeded; return this descriptor and filename. */
1593 encoded_fn
= ENCODE_FILE (string
);
1594 pfn
= SDATA (encoded_fn
);
1595 exists
= (stat (pfn
, &st
) >= 0
1596 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1599 /* Check that we can access or open it. */
1600 if (NATNUMP (predicate
))
1601 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1603 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1607 /* We succeeded; return this descriptor and filename. */
1625 /* Merge the list we've accumulated of globals from the current input source
1626 into the load_history variable. The details depend on whether
1627 the source has an associated file name or not.
1629 FILENAME is the file name that we are loading from.
1630 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1633 build_load_history (Lisp_Object filename
, int entire
)
1635 register Lisp_Object tail
, prev
, newelt
;
1636 register Lisp_Object tem
, tem2
;
1637 register int foundit
= 0;
1639 tail
= Vload_history
;
1642 while (CONSP (tail
))
1646 /* Find the feature's previous assoc list... */
1647 if (!NILP (Fequal (filename
, Fcar (tem
))))
1651 /* If we're loading the entire file, remove old data. */
1655 Vload_history
= XCDR (tail
);
1657 Fsetcdr (prev
, XCDR (tail
));
1660 /* Otherwise, cons on new symbols that are not already members. */
1663 tem2
= Vcurrent_load_list
;
1665 while (CONSP (tem2
))
1667 newelt
= XCAR (tem2
);
1669 if (NILP (Fmember (newelt
, tem
)))
1670 Fsetcar (tail
, Fcons (XCAR (tem
),
1671 Fcons (newelt
, XCDR (tem
))));
1684 /* If we're loading an entire file, cons the new assoc onto the
1685 front of load-history, the most-recently-loaded position. Also
1686 do this if we didn't find an existing member for the file. */
1687 if (entire
|| !foundit
)
1688 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1693 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1700 readevalloop_1 (Lisp_Object old
)
1702 load_convert_to_unibyte
= ! NILP (old
);
1706 /* Signal an `end-of-file' error, if possible with file name
1710 end_of_file_error (void)
1712 if (STRINGP (Vload_file_name
))
1713 xsignal1 (Qend_of_file
, Vload_file_name
);
1715 xsignal0 (Qend_of_file
);
1718 /* UNIBYTE specifies how to set load_convert_to_unibyte
1719 for this invocation.
1720 READFUN, if non-nil, is used instead of `read'.
1722 START, END specify region to read in current buffer (from eval-region).
1723 If the input is not from a buffer, they must be nil. */
1726 readevalloop (Lisp_Object readcharfun
,
1728 Lisp_Object sourcename
,
1729 Lisp_Object (*evalfun
) (Lisp_Object
),
1731 Lisp_Object unibyte
, Lisp_Object readfun
,
1732 Lisp_Object start
, Lisp_Object end
)
1735 register Lisp_Object val
;
1736 int count
= SPECPDL_INDEX ();
1737 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1738 struct buffer
*b
= 0;
1739 int continue_reading_p
;
1740 Lisp_Object lex_bound
;
1741 /* Nonzero if reading an entire buffer. */
1742 int whole_buffer
= 0;
1743 /* 1 on the first time around. */
1746 if (MARKERP (readcharfun
))
1749 start
= readcharfun
;
1752 if (BUFFERP (readcharfun
))
1753 b
= XBUFFER (readcharfun
);
1754 else if (MARKERP (readcharfun
))
1755 b
= XMARKER (readcharfun
)->buffer
;
1757 /* We assume START is nil when input is not from a buffer. */
1758 if (! NILP (start
) && !b
)
1761 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1762 specbind (Qcurrent_load_list
, Qnil
);
1763 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1764 load_convert_to_unibyte
= !NILP (unibyte
);
1766 /* If lexical binding is active (either because it was specified in
1767 the file's header, or via a buffer-local variable), create an empty
1768 lexical environment, otherwise, turn off lexical binding. */
1769 lex_bound
= find_symbol_value (Qlexical_binding
);
1770 if (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
))
1771 specbind (Qinternal_interpreter_environment
, Qnil
);
1773 specbind (Qinternal_interpreter_environment
, Fcons (Qt
, Qnil
));
1775 GCPRO4 (sourcename
, readfun
, start
, end
);
1777 /* Try to ensure sourcename is a truename, except whilst preloading. */
1778 if (NILP (Vpurify_flag
)
1779 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1780 && !NILP (Ffboundp (Qfile_truename
)))
1781 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1783 LOADHIST_ATTACH (sourcename
);
1785 continue_reading_p
= 1;
1786 while (continue_reading_p
)
1788 int count1
= SPECPDL_INDEX ();
1790 if (b
!= 0 && NILP (b
->name
))
1791 error ("Reading from killed buffer");
1795 /* Switch to the buffer we are reading from. */
1796 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1797 set_buffer_internal (b
);
1799 /* Save point in it. */
1800 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1801 /* Save ZV in it. */
1802 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1803 /* Those get unbound after we read one expression. */
1805 /* Set point and ZV around stuff to be read. */
1808 Fnarrow_to_region (make_number (BEGV
), end
);
1810 /* Just for cleanliness, convert END to a marker
1811 if it is an integer. */
1813 end
= Fpoint_max_marker ();
1816 /* On the first cycle, we can easily test here
1817 whether we are reading the whole buffer. */
1818 if (b
&& first_sexp
)
1819 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1826 while ((c
= READCHAR
) != '\n' && c
!= -1);
1831 unbind_to (count1
, Qnil
);
1835 /* Ignore whitespace here, so we can detect eof. */
1836 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1837 || c
== 0x8a0) /* NBSP */
1840 if (!NILP (Vpurify_flag
) && c
== '(')
1842 record_unwind_protect (unreadpure
, Qnil
);
1843 val
= read_list (-1, readcharfun
);
1848 read_objects
= Qnil
;
1849 if (!NILP (readfun
))
1851 val
= call1 (readfun
, readcharfun
);
1853 /* If READCHARFUN has set point to ZV, we should
1854 stop reading, even if the form read sets point
1855 to a different value when evaluated. */
1856 if (BUFFERP (readcharfun
))
1858 struct buffer
*b
= XBUFFER (readcharfun
);
1859 if (BUF_PT (b
) == BUF_ZV (b
))
1860 continue_reading_p
= 0;
1863 else if (! NILP (Vload_read_function
))
1864 val
= call1 (Vload_read_function
, readcharfun
);
1866 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1869 if (!NILP (start
) && continue_reading_p
)
1870 start
= Fpoint_marker ();
1872 /* Restore saved point and BEGV. */
1873 unbind_to (count1
, Qnil
);
1875 /* Now eval what we just read. */
1876 val
= (*evalfun
) (val
);
1880 Vvalues
= Fcons (val
, Vvalues
);
1881 if (EQ (Vstandard_output
, Qt
))
1890 build_load_history (sourcename
,
1891 stream
|| whole_buffer
);
1895 unbind_to (count
, Qnil
);
1898 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1899 doc
: /* Execute the current buffer as Lisp code.
1900 When called from a Lisp program (i.e., not interactively), this
1901 function accepts up to five optional arguments:
1902 BUFFER is the buffer to evaluate (nil means use current buffer).
1903 PRINTFLAG controls printing of output:
1904 A value of nil means discard it; anything else is stream for print.
1905 FILENAME specifies the file name to use for `load-history'.
1906 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1908 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1909 functions should work normally even if PRINTFLAG is nil.
1911 This function preserves the position of point. */)
1912 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1914 int count
= SPECPDL_INDEX ();
1915 Lisp_Object tem
, buf
;
1918 buf
= Fcurrent_buffer ();
1920 buf
= Fget_buffer (buffer
);
1922 error ("No such buffer");
1924 if (NILP (printflag
) && NILP (do_allow_print
))
1929 if (NILP (filename
))
1930 filename
= XBUFFER (buf
)->filename
;
1932 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1933 specbind (Qstandard_output
, tem
);
1934 specbind (Qlexical_binding
, Qnil
);
1935 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1936 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1937 if (lisp_file_lexically_bound_p (buf
))
1938 Fset (Qlexical_binding
, Qt
);
1939 readevalloop (buf
, 0, filename
, Feval
,
1940 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1941 unbind_to (count
, Qnil
);
1946 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1947 doc
: /* Execute the region as Lisp code.
1948 When called from programs, expects two arguments,
1949 giving starting and ending indices in the current buffer
1950 of the text to be executed.
1951 Programs can pass third argument PRINTFLAG which controls output:
1952 A value of nil means discard it; anything else is stream for printing it.
1953 Also the fourth argument READ-FUNCTION, if non-nil, is used
1954 instead of `read' to read each expression. It gets one argument
1955 which is the input stream for reading characters.
1957 This function does not move point. */)
1958 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1960 int count
= SPECPDL_INDEX ();
1961 Lisp_Object tem
, cbuf
;
1963 cbuf
= Fcurrent_buffer ();
1965 if (NILP (printflag
))
1969 specbind (Qstandard_output
, tem
);
1970 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1972 /* readevalloop calls functions which check the type of start and end. */
1973 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1974 !NILP (printflag
), Qnil
, read_function
,
1977 return unbind_to (count
, Qnil
);
1981 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1982 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1983 If STREAM is nil, use the value of `standard-input' (which see).
1984 STREAM or the value of `standard-input' may be:
1985 a buffer (read from point and advance it)
1986 a marker (read from where it points and advance it)
1987 a function (call it with no arguments for each character,
1988 call it with a char as argument to push a char back)
1989 a string (takes text from string, starting at the beginning)
1990 t (read text line using minibuffer and use it, or read from
1991 standard input in batch mode). */)
1992 (Lisp_Object stream
)
1995 stream
= Vstandard_input
;
1996 if (EQ (stream
, Qt
))
1997 stream
= Qread_char
;
1998 if (EQ (stream
, Qread_char
))
1999 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
2001 return read_internal_start (stream
, Qnil
, Qnil
);
2004 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2005 doc
: /* Read one Lisp expression which is represented as text by STRING.
2006 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2007 START and END optionally delimit a substring of STRING from which to read;
2008 they default to 0 and (length STRING) respectively. */)
2009 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
2012 CHECK_STRING (string
);
2013 /* read_internal_start sets read_from_string_index. */
2014 ret
= read_internal_start (string
, start
, end
);
2015 return Fcons (ret
, make_number (read_from_string_index
));
2018 /* Function to set up the global context we need in toplevel read
2021 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
2022 /* start, end only used when stream is a string. */
2027 new_backquote_flag
= 0;
2028 read_objects
= Qnil
;
2029 if (EQ (Vread_with_symbol_positions
, Qt
)
2030 || EQ (Vread_with_symbol_positions
, stream
))
2031 Vread_symbol_positions_list
= Qnil
;
2033 if (STRINGP (stream
)
2034 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2036 EMACS_INT startval
, endval
;
2039 if (STRINGP (stream
))
2042 string
= XCAR (stream
);
2045 endval
= SCHARS (string
);
2049 endval
= XINT (end
);
2050 if (endval
< 0 || endval
> SCHARS (string
))
2051 args_out_of_range (string
, end
);
2058 CHECK_NUMBER (start
);
2059 startval
= XINT (start
);
2060 if (startval
< 0 || startval
> endval
)
2061 args_out_of_range (string
, start
);
2063 read_from_string_index
= startval
;
2064 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2065 read_from_string_limit
= endval
;
2068 retval
= read0 (stream
);
2069 if (EQ (Vread_with_symbol_positions
, Qt
)
2070 || EQ (Vread_with_symbol_positions
, stream
))
2071 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2076 /* Signal Qinvalid_read_syntax error.
2077 S is error string of length N (if > 0) */
2080 invalid_syntax (const char *s
, int n
)
2084 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2088 /* Use this for recursive reads, in contexts where internal tokens
2092 read0 (Lisp_Object readcharfun
)
2094 register Lisp_Object val
;
2097 val
= read1 (readcharfun
, &c
, 0);
2101 xsignal1 (Qinvalid_read_syntax
,
2102 Fmake_string (make_number (1), make_number (c
)));
2105 static int read_buffer_size
;
2106 static char *read_buffer
;
2108 /* Read a \-escape sequence, assuming we already read the `\'.
2109 If the escape sequence forces unibyte, return eight-bit char. */
2112 read_escape (Lisp_Object readcharfun
, int stringp
)
2114 register int c
= READCHAR
;
2115 /* \u allows up to four hex digits, \U up to eight. Default to the
2116 behavior for \u, and change this value in the case that \U is seen. */
2117 int unicode_hex_count
= 4;
2122 end_of_file_error ();
2152 error ("Invalid escape character syntax");
2155 c
= read_escape (readcharfun
, 0);
2156 return c
| meta_modifier
;
2161 error ("Invalid escape character syntax");
2164 c
= read_escape (readcharfun
, 0);
2165 return c
| shift_modifier
;
2170 error ("Invalid escape character syntax");
2173 c
= read_escape (readcharfun
, 0);
2174 return c
| hyper_modifier
;
2179 error ("Invalid escape character syntax");
2182 c
= read_escape (readcharfun
, 0);
2183 return c
| alt_modifier
;
2187 if (stringp
|| c
!= '-')
2194 c
= read_escape (readcharfun
, 0);
2195 return c
| super_modifier
;
2200 error ("Invalid escape character syntax");
2204 c
= read_escape (readcharfun
, 0);
2205 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2206 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2207 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2208 return c
| ctrl_modifier
;
2209 /* ASCII control chars are made from letters (both cases),
2210 as well as the non-letters within 0100...0137. */
2211 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2212 return (c
& (037 | ~0177));
2213 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2214 return (c
& (037 | ~0177));
2216 return c
| ctrl_modifier
;
2226 /* An octal escape, as in ANSI C. */
2228 register int i
= c
- '0';
2229 register int count
= 0;
2232 if ((c
= READCHAR
) >= '0' && c
<= '7')
2244 if (i
>= 0x80 && i
< 0x100)
2245 i
= BYTE8_TO_CHAR (i
);
2250 /* A hex escape, as in ANSI C. */
2257 if (c
>= '0' && c
<= '9')
2262 else if ((c
>= 'a' && c
<= 'f')
2263 || (c
>= 'A' && c
<= 'F'))
2266 if (c
>= 'a' && c
<= 'f')
2279 if (count
< 3 && i
>= 0x80)
2280 return BYTE8_TO_CHAR (i
);
2285 /* Post-Unicode-2.0: Up to eight hex chars. */
2286 unicode_hex_count
= 8;
2289 /* A Unicode escape. We only permit them in strings and characters,
2290 not arbitrarily in the source code, as in some other languages. */
2295 while (++count
<= unicode_hex_count
)
2298 /* isdigit and isalpha may be locale-specific, which we don't
2300 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2301 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2302 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2305 error ("Non-hex digit used for Unicode escape");
2310 error ("Non-Unicode character: 0x%x", i
);
2319 /* Read an integer in radix RADIX using READCHARFUN to read
2320 characters. RADIX must be in the interval [2..36]; if it isn't, a
2321 read error is signaled . Value is the integer read. Signals an
2322 error if encountering invalid read syntax or if RADIX is out of
2326 read_integer (Lisp_Object readcharfun
, int radix
)
2328 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2329 /* We use a floating point number because */
2332 if (radix
< 2 || radix
> 36)
2336 number
= ndigits
= invalid_p
= 0;
2352 if (c
>= '0' && c
<= '9')
2354 else if (c
>= 'a' && c
<= 'z')
2355 digit
= c
- 'a' + 10;
2356 else if (c
>= 'A' && c
<= 'Z')
2357 digit
= c
- 'A' + 10;
2364 if (digit
< 0 || digit
>= radix
)
2367 number
= radix
* number
+ digit
;
2373 if (ndigits
== 0 || invalid_p
)
2376 sprintf (buf
, "integer, radix %d", radix
);
2377 invalid_syntax (buf
, 0);
2380 return make_fixnum_or_float (sign
* number
);
2384 /* If the next token is ')' or ']' or '.', we store that character
2385 in *PCH and the return value is not interesting. Else, we store
2386 zero in *PCH and we read and return one lisp object.
2388 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2391 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2394 int uninterned_symbol
= 0;
2402 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2404 end_of_file_error ();
2409 return read_list (0, readcharfun
);
2412 return read_vector (readcharfun
, 0);
2428 /* Accept extended format for hashtables (extensible to
2430 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2431 Lisp_Object tmp
= read_list (0, readcharfun
);
2432 Lisp_Object head
= CAR_SAFE (tmp
);
2433 Lisp_Object data
= Qnil
;
2434 Lisp_Object val
= Qnil
;
2435 /* The size is 2 * number of allowed keywords to
2437 Lisp_Object params
[10];
2439 Lisp_Object key
= Qnil
;
2440 int param_count
= 0;
2442 if (!EQ (head
, Qhash_table
))
2443 error ("Invalid extended read marker at head of #s list "
2444 "(only hash-table allowed)");
2446 tmp
= CDR_SAFE (tmp
);
2448 /* This is repetitive but fast and simple. */
2449 params
[param_count
] = QCsize
;
2450 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2451 if (!NILP (params
[param_count
+ 1]))
2454 params
[param_count
] = QCtest
;
2455 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2456 if (!NILP (params
[param_count
+ 1]))
2459 params
[param_count
] = QCweakness
;
2460 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2461 if (!NILP (params
[param_count
+ 1]))
2464 params
[param_count
] = QCrehash_size
;
2465 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2466 if (!NILP (params
[param_count
+ 1]))
2469 params
[param_count
] = QCrehash_threshold
;
2470 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2471 if (!NILP (params
[param_count
+ 1]))
2474 /* This is the hashtable data. */
2475 data
= Fplist_get (tmp
, Qdata
);
2477 /* Now use params to make a new hashtable and fill it. */
2478 ht
= Fmake_hash_table (param_count
, params
);
2480 while (CONSP (data
))
2485 error ("Odd number of elements in hashtable data");
2488 Fputhash (key
, val
, ht
);
2494 invalid_syntax ("#", 1);
2502 tmp
= read_vector (readcharfun
, 0);
2503 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2504 error ("Invalid size char-table");
2505 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2516 tmp
= read_vector (readcharfun
, 0);
2517 if (!INTEGERP (AREF (tmp
, 0)))
2518 error ("Invalid depth in char-table");
2519 depth
= XINT (AREF (tmp
, 0));
2520 if (depth
< 1 || depth
> 3)
2521 error ("Invalid depth in char-table");
2522 size
= XVECTOR (tmp
)->size
- 2;
2523 if (chartab_size
[depth
] != size
)
2524 error ("Invalid size char-table");
2525 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2528 invalid_syntax ("#^^", 3);
2530 invalid_syntax ("#^", 2);
2535 length
= read1 (readcharfun
, pch
, first_in_list
);
2539 Lisp_Object tmp
, val
;
2541 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2542 / BOOL_VECTOR_BITS_PER_CHAR
);
2545 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2546 if (STRING_MULTIBYTE (tmp
)
2547 || (size_in_chars
!= SCHARS (tmp
)
2548 /* We used to print 1 char too many
2549 when the number of bits was a multiple of 8.
2550 Accept such input in case it came from an old
2552 && ! (XFASTINT (length
)
2553 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2554 invalid_syntax ("#&...", 5);
2556 val
= Fmake_bool_vector (length
, Qnil
);
2557 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2558 /* Clear the extraneous bits in the last byte. */
2559 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2560 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2561 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2564 invalid_syntax ("#&...", 5);
2567 /* `function vector' objects, including byte-compiled functions. */
2568 return read_vector (readcharfun
, 1);
2572 struct gcpro gcpro1
;
2575 /* Read the string itself. */
2576 tmp
= read1 (readcharfun
, &ch
, 0);
2577 if (ch
!= 0 || !STRINGP (tmp
))
2578 invalid_syntax ("#", 1);
2580 /* Read the intervals and their properties. */
2583 Lisp_Object beg
, end
, plist
;
2585 beg
= read1 (readcharfun
, &ch
, 0);
2590 end
= read1 (readcharfun
, &ch
, 0);
2592 plist
= read1 (readcharfun
, &ch
, 0);
2594 invalid_syntax ("Invalid string property list", 0);
2595 Fset_text_properties (beg
, end
, plist
, tmp
);
2601 /* #@NUMBER is used to skip NUMBER following characters.
2602 That's used in .elc files to skip over doc strings
2603 and function definitions. */
2609 /* Read a decimal integer. */
2610 while ((c
= READCHAR
) >= 0
2611 && c
>= '0' && c
<= '9')
2619 if (load_force_doc_strings
2620 && (EQ (readcharfun
, Qget_file_char
)
2621 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2623 /* If we are supposed to force doc strings into core right now,
2624 record the last string that we skipped,
2625 and record where in the file it comes from. */
2627 /* But first exchange saved_doc_string
2628 with prev_saved_doc_string, so we save two strings. */
2630 char *temp
= saved_doc_string
;
2631 int temp_size
= saved_doc_string_size
;
2632 file_offset temp_pos
= saved_doc_string_position
;
2633 int temp_len
= saved_doc_string_length
;
2635 saved_doc_string
= prev_saved_doc_string
;
2636 saved_doc_string_size
= prev_saved_doc_string_size
;
2637 saved_doc_string_position
= prev_saved_doc_string_position
;
2638 saved_doc_string_length
= prev_saved_doc_string_length
;
2640 prev_saved_doc_string
= temp
;
2641 prev_saved_doc_string_size
= temp_size
;
2642 prev_saved_doc_string_position
= temp_pos
;
2643 prev_saved_doc_string_length
= temp_len
;
2646 if (saved_doc_string_size
== 0)
2648 saved_doc_string_size
= nskip
+ 100;
2649 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2651 if (nskip
> saved_doc_string_size
)
2653 saved_doc_string_size
= nskip
+ 100;
2654 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2655 saved_doc_string_size
);
2658 saved_doc_string_position
= file_tell (instream
);
2660 /* Copy that many characters into saved_doc_string. */
2661 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2662 saved_doc_string
[i
] = c
= READCHAR
;
2664 saved_doc_string_length
= i
;
2668 /* Skip that many characters. */
2669 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2678 /* #! appears at the beginning of an executable file.
2679 Skip the first line. */
2680 while (c
!= '\n' && c
>= 0)
2685 return Vload_file_name
;
2687 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2688 /* #:foo is the uninterned symbol named foo. */
2691 uninterned_symbol
= 1;
2695 /* Reader forms that can reuse previously read objects. */
2696 if (c
>= '0' && c
<= '9')
2701 /* Read a non-negative integer. */
2702 while (c
>= '0' && c
<= '9')
2708 /* #n=object returns object, but associates it with n for #n#. */
2709 if (c
== '=' && !NILP (Vread_circle
))
2711 /* Make a placeholder for #n# to use temporarily */
2712 Lisp_Object placeholder
;
2715 placeholder
= Fcons (Qnil
, Qnil
);
2716 cell
= Fcons (make_number (n
), placeholder
);
2717 read_objects
= Fcons (cell
, read_objects
);
2719 /* Read the object itself. */
2720 tem
= read0 (readcharfun
);
2722 /* Now put it everywhere the placeholder was... */
2723 substitute_object_in_subtree (tem
, placeholder
);
2725 /* ...and #n# will use the real value from now on. */
2726 Fsetcdr (cell
, tem
);
2730 /* #n# returns a previously read object. */
2731 if (c
== '#' && !NILP (Vread_circle
))
2733 tem
= Fassq (make_number (n
), read_objects
);
2736 /* Fall through to error message. */
2738 else if (c
== 'r' || c
== 'R')
2739 return read_integer (readcharfun
, n
);
2741 /* Fall through to error message. */
2743 else if (c
== 'x' || c
== 'X')
2744 return read_integer (readcharfun
, 16);
2745 else if (c
== 'o' || c
== 'O')
2746 return read_integer (readcharfun
, 8);
2747 else if (c
== 'b' || c
== 'B')
2748 return read_integer (readcharfun
, 2);
2751 invalid_syntax ("#", 1);
2754 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2759 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2764 int next_char
= READCHAR
;
2766 /* Transition from old-style to new-style:
2767 If we see "(`" it used to mean old-style, which usually works
2768 fine because ` should almost never appear in such a position
2769 for new-style. But occasionally we need "(`" to mean new
2770 style, so we try to distinguish the two by the fact that we
2771 can either write "( `foo" or "(` foo", where the first
2772 intends to use new-style whereas the second intends to use
2773 old-style. For Emacs-25, we should completely remove this
2774 first_in_list exception (old-style can still be obtained via
2776 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2778 Vold_style_backquotes
= Qt
;
2785 new_backquote_flag
++;
2786 value
= read0 (readcharfun
);
2787 new_backquote_flag
--;
2789 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2794 int next_char
= READCHAR
;
2796 /* Transition from old-style to new-style:
2797 It used to be impossible to have a new-style , other than within
2798 a new-style `. This is sufficient when ` and , are used in the
2799 normal way, but ` and , can also appear in args to macros that
2800 will not interpret them in the usual way, in which case , may be
2801 used without any ` anywhere near.
2802 So we now use the same heuristic as for backquote: old-style
2803 unquotes are only recognized when first on a list, and when
2804 followed by a space.
2805 Because it's more difficult to peak 2 chars ahead, a new-style
2806 ,@ can still not be used outside of a `, unless it's in the middle
2808 if (new_backquote_flag
2810 || (next_char
!= ' ' && next_char
!= '@'))
2812 Lisp_Object comma_type
= Qnil
;
2817 comma_type
= Qcomma_at
;
2819 comma_type
= Qcomma_dot
;
2822 if (ch
>= 0) UNREAD (ch
);
2823 comma_type
= Qcomma
;
2826 value
= read0 (readcharfun
);
2827 return Fcons (comma_type
, Fcons (value
, Qnil
));
2831 Vold_style_backquotes
= Qt
;
2843 end_of_file_error ();
2845 /* Accept `single space' syntax like (list ? x) where the
2846 whitespace character is SPC or TAB.
2847 Other literal whitespace like NL, CR, and FF are not accepted,
2848 as there are well-established escape sequences for these. */
2849 if (c
== ' ' || c
== '\t')
2850 return make_number (c
);
2853 c
= read_escape (readcharfun
, 0);
2854 modifiers
= c
& CHAR_MODIFIER_MASK
;
2855 c
&= ~CHAR_MODIFIER_MASK
;
2856 if (CHAR_BYTE8_P (c
))
2857 c
= CHAR_TO_BYTE8 (c
);
2860 next_char
= READCHAR
;
2861 ok
= (next_char
<= 040
2862 || (next_char
< 0200
2863 && (strchr ("\"';()[]#?`,.", next_char
))));
2866 return make_number (c
);
2868 invalid_syntax ("?", 1);
2873 char *p
= read_buffer
;
2874 char *end
= read_buffer
+ read_buffer_size
;
2876 /* Nonzero if we saw an escape sequence specifying
2877 a multibyte character. */
2878 int force_multibyte
= 0;
2879 /* Nonzero if we saw an escape sequence specifying
2880 a single-byte character. */
2881 int force_singlebyte
= 0;
2885 while ((c
= READCHAR
) >= 0
2888 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2890 int offset
= p
- read_buffer
;
2891 read_buffer
= (char *) xrealloc (read_buffer
,
2892 read_buffer_size
*= 2);
2893 p
= read_buffer
+ offset
;
2894 end
= read_buffer
+ read_buffer_size
;
2901 c
= read_escape (readcharfun
, 1);
2903 /* C is -1 if \ newline has just been seen */
2906 if (p
== read_buffer
)
2911 modifiers
= c
& CHAR_MODIFIER_MASK
;
2912 c
= c
& ~CHAR_MODIFIER_MASK
;
2914 if (CHAR_BYTE8_P (c
))
2915 force_singlebyte
= 1;
2916 else if (! ASCII_CHAR_P (c
))
2917 force_multibyte
= 1;
2918 else /* i.e. ASCII_CHAR_P (c) */
2920 /* Allow `\C- ' and `\C-?'. */
2921 if (modifiers
== CHAR_CTL
)
2924 c
= 0, modifiers
= 0;
2926 c
= 127, modifiers
= 0;
2928 if (modifiers
& CHAR_SHIFT
)
2930 /* Shift modifier is valid only with [A-Za-z]. */
2931 if (c
>= 'A' && c
<= 'Z')
2932 modifiers
&= ~CHAR_SHIFT
;
2933 else if (c
>= 'a' && c
<= 'z')
2934 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2937 if (modifiers
& CHAR_META
)
2939 /* Move the meta bit to the right place for a
2941 modifiers
&= ~CHAR_META
;
2942 c
= BYTE8_TO_CHAR (c
| 0x80);
2943 force_singlebyte
= 1;
2947 /* Any modifiers remaining are invalid. */
2949 error ("Invalid modifier in string");
2950 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2954 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2955 if (CHAR_BYTE8_P (c
))
2956 force_singlebyte
= 1;
2957 else if (! ASCII_CHAR_P (c
))
2958 force_multibyte
= 1;
2964 end_of_file_error ();
2966 /* If purifying, and string starts with \ newline,
2967 return zero instead. This is for doc strings
2968 that we are really going to find in etc/DOC.nn.nn */
2969 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2970 return make_number (0);
2972 if (force_multibyte
)
2973 /* READ_BUFFER already contains valid multibyte forms. */
2975 else if (force_singlebyte
)
2977 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2978 p
= read_buffer
+ nchars
;
2981 /* Otherwise, READ_BUFFER contains only ASCII. */
2984 /* We want readchar_count to be the number of characters, not
2985 bytes. Hence we adjust for multibyte characters in the
2986 string. ... But it doesn't seem to be necessary, because
2987 READCHAR *does* read multibyte characters from buffers. */
2988 /* readchar_count -= (p - read_buffer) - nchars; */
2990 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2992 || (p
- read_buffer
!= nchars
)));
2993 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2995 || (p
- read_buffer
!= nchars
)));
3000 int next_char
= READCHAR
;
3003 if (next_char
<= 040
3004 || (next_char
< 0200
3005 && (strchr ("\"';([#?`,", next_char
))))
3011 /* Otherwise, we fall through! Note that the atom-reading loop
3012 below will now loop at least once, assuring that we will not
3013 try to UNREAD two characters in a row. */
3017 if (c
<= 040) goto retry
;
3018 if (c
== 0x8a0) /* NBSP */
3021 char *p
= read_buffer
;
3025 char *end
= read_buffer
+ read_buffer_size
;
3028 && c
!= 0x8a0 /* NBSP */
3030 || !(strchr ("\"';()[]#`,", c
))))
3032 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3034 int offset
= p
- read_buffer
;
3035 read_buffer
= (char *) xrealloc (read_buffer
,
3036 read_buffer_size
*= 2);
3037 p
= read_buffer
+ offset
;
3038 end
= read_buffer
+ read_buffer_size
;
3045 end_of_file_error ();
3050 p
+= CHAR_STRING (c
, p
);
3058 int offset
= p
- read_buffer
;
3059 read_buffer
= (char *) xrealloc (read_buffer
,
3060 read_buffer_size
*= 2);
3061 p
= read_buffer
+ offset
;
3062 end
= read_buffer
+ read_buffer_size
;
3069 if (!quoted
&& !uninterned_symbol
)
3073 if (*p1
== '+' || *p1
== '-') p1
++;
3074 /* Is it an integer? */
3077 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3078 /* Integers can have trailing decimal points. */
3079 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3081 /* It is an integer. */
3086 /* EMACS_INT n = atol (read_buffer); */
3087 char *endptr
= NULL
;
3088 EMACS_INT n
= (errno
= 0,
3089 strtol (read_buffer
, &endptr
, 10));
3090 if (errno
== ERANGE
&& endptr
)
3093 = Fcons (make_string (read_buffer
,
3094 endptr
- read_buffer
),
3096 xsignal (Qoverflow_error
, args
);
3098 return make_fixnum_or_float (n
);
3102 if (isfloat_string (read_buffer
, 0))
3104 /* Compute NaN and infinities using 0.0 in a variable,
3105 to cope with compilers that think they are smarter
3111 /* Negate the value ourselves. This treats 0, NaNs,
3112 and infinity properly on IEEE floating point hosts,
3113 and works around a common bug where atof ("-0.0")
3115 int negative
= read_buffer
[0] == '-';
3117 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3118 returns 1, is if the input ends in e+INF or e+NaN. */
3125 value
= zero
/ zero
;
3127 /* If that made a "negative" NaN, negate it. */
3131 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3134 u_minus_zero
.d
= - 0.0;
3135 for (i
= 0; i
< sizeof (double); i
++)
3136 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3142 /* Now VALUE is a positive NaN. */
3145 value
= atof (read_buffer
+ negative
);
3149 return make_float (negative
? - value
: value
);
3153 Lisp_Object name
, result
;
3154 EMACS_INT nbytes
= p
- read_buffer
;
3156 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3159 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3160 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3162 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3163 result
= (uninterned_symbol
? Fmake_symbol (name
)
3164 : Fintern (name
, Qnil
));
3166 if (EQ (Vread_with_symbol_positions
, Qt
)
3167 || EQ (Vread_with_symbol_positions
, readcharfun
))
3168 Vread_symbol_positions_list
=
3169 /* Kind of a hack; this will probably fail if characters
3170 in the symbol name were escaped. Not really a big
3172 Fcons (Fcons (result
,
3173 make_number (readchar_count
3174 - XFASTINT (Flength (Fsymbol_name (result
))))),
3175 Vread_symbol_positions_list
);
3183 /* List of nodes we've seen during substitute_object_in_subtree. */
3184 static Lisp_Object seen_list
;
3187 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
3189 Lisp_Object check_object
;
3191 /* We haven't seen any objects when we start. */
3194 /* Make all the substitutions. */
3196 = substitute_object_recurse (object
, placeholder
, object
);
3198 /* Clear seen_list because we're done with it. */
3201 /* The returned object here is expected to always eq the
3203 if (!EQ (check_object
, object
))
3204 error ("Unexpected mutation error in reader");
3207 /* Feval doesn't get called from here, so no gc protection is needed. */
3208 #define SUBSTITUTE(get_val, set_val) \
3210 Lisp_Object old_value = get_val; \
3211 Lisp_Object true_value \
3212 = substitute_object_recurse (object, placeholder, \
3215 if (!EQ (old_value, true_value)) \
3222 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3224 /* If we find the placeholder, return the target object. */
3225 if (EQ (placeholder
, subtree
))
3228 /* If we've been to this node before, don't explore it again. */
3229 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3232 /* If this node can be the entry point to a cycle, remember that
3233 we've seen it. It can only be such an entry point if it was made
3234 by #n=, which means that we can find it as a value in
3236 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3237 seen_list
= Fcons (subtree
, seen_list
);
3239 /* Recurse according to subtree's type.
3240 Every branch must return a Lisp_Object. */
3241 switch (XTYPE (subtree
))
3243 case Lisp_Vectorlike
:
3246 if (BOOL_VECTOR_P (subtree
))
3247 return subtree
; /* No sub-objects anyway. */
3248 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3249 || COMPILEDP (subtree
))
3250 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3251 else if (VECTORP (subtree
))
3252 length
= ASIZE (subtree
);
3254 /* An unknown pseudovector may contain non-Lisp fields, so we
3255 can't just blindly traverse all its fields. We used to call
3256 `Flength' which signaled `sequencep', so I just preserved this
3258 wrong_type_argument (Qsequencep
, subtree
);
3260 for (i
= 0; i
< length
; i
++)
3261 SUBSTITUTE (AREF (subtree
, i
),
3262 ASET (subtree
, i
, true_value
));
3268 SUBSTITUTE (XCAR (subtree
),
3269 XSETCAR (subtree
, true_value
));
3270 SUBSTITUTE (XCDR (subtree
),
3271 XSETCDR (subtree
, true_value
));
3277 /* Check for text properties in each interval.
3278 substitute_in_interval contains part of the logic. */
3280 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3281 Lisp_Object arg
= Fcons (object
, placeholder
);
3283 traverse_intervals_noorder (root_interval
,
3284 &substitute_in_interval
, arg
);
3289 /* Other types don't recurse any further. */
3295 /* Helper function for substitute_object_recurse. */
3297 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3299 Lisp_Object object
= Fcar (arg
);
3300 Lisp_Object placeholder
= Fcdr (arg
);
3302 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3313 isfloat_string (const char *cp
, int ignore_trailing
)
3316 const char *start
= cp
;
3319 if (*cp
== '+' || *cp
== '-')
3322 if (*cp
>= '0' && *cp
<= '9')
3325 while (*cp
>= '0' && *cp
<= '9')
3333 if (*cp
>= '0' && *cp
<= '9')
3336 while (*cp
>= '0' && *cp
<= '9')
3339 if (*cp
== 'e' || *cp
== 'E')
3343 if (*cp
== '+' || *cp
== '-')
3347 if (*cp
>= '0' && *cp
<= '9')
3350 while (*cp
>= '0' && *cp
<= '9')
3353 else if (cp
== start
)
3355 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3360 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3366 return ((ignore_trailing
3367 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3368 || *cp
== '\r' || *cp
== '\f')
3369 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3370 || state
== (DOT_CHAR
|TRAIL_INT
)
3371 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3372 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3373 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3378 read_vector (Lisp_Object readcharfun
, int read_funvec
)
3382 register Lisp_Object
*ptr
;
3383 register Lisp_Object tem
, item
, vector
;
3384 register struct Lisp_Cons
*otem
;
3386 /* If we're reading a funvec object we start out assuming it's also a
3387 byte-code object (a subset of funvecs), so we can do any special
3388 processing needed. If it's just an ordinary funvec object, we'll
3389 realize that as soon as we've read the first element. */
3390 int read_bytecode
= read_funvec
;
3392 tem
= read_list (1, readcharfun
);
3393 len
= Flength (tem
);
3394 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3396 size
= XVECTOR (vector
)->size
;
3397 ptr
= XVECTOR (vector
)->contents
;
3398 for (i
= 0; i
< size
; i
++)
3402 /* If READ_BYTECODE is set, check whether this is really a byte-code
3403 object, or just an ordinary `funvec' object -- non-byte-code
3404 funvec objects use the same reader syntax. We can tell from the
3405 first element which one it is. */
3406 if (read_bytecode
&& i
== 0 && ! FUNVEC_COMPILED_TAG_P (item
))
3407 read_bytecode
= 0; /* Nope. */
3409 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3410 bytecode object, the docstring containing the bytecode and
3411 constants values must be treated as unibyte and passed to
3412 Fread, to get the actual bytecode string and constants vector. */
3413 if (read_bytecode
&& load_force_doc_strings
)
3415 if (i
== COMPILED_BYTECODE
)
3417 if (!STRINGP (item
))
3418 error ("Invalid byte code");
3420 /* Delay handling the bytecode slot until we know whether
3421 it is lazily-loaded (we can tell by whether the
3422 constants slot is nil). */
3423 ptr
[COMPILED_CONSTANTS
] = item
;
3426 else if (i
== COMPILED_CONSTANTS
)
3428 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3432 /* Coerce string to unibyte (like string-as-unibyte,
3433 but without generating extra garbage and
3434 guaranteeing no change in the contents). */
3435 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3436 STRING_SET_UNIBYTE (bytestr
);
3438 item
= Fread (Fcons (bytestr
, readcharfun
));
3440 error ("Invalid byte code");
3442 otem
= XCONS (item
);
3443 bytestr
= XCAR (item
);
3448 /* Now handle the bytecode slot. */
3449 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3451 else if (i
== COMPILED_DOC_STRING
3453 && ! STRING_MULTIBYTE (item
))
3455 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3456 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3458 item
= Fstring_as_multibyte (item
);
3461 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3467 if (read_bytecode
&& size
>= 4)
3468 /* Convert this vector to a bytecode object. */
3469 vector
= Fmake_byte_code (size
, XVECTOR (vector
)->contents
);
3470 else if (read_funvec
&& size
>= 1)
3471 /* Convert this vector to an ordinary funvec object. */
3472 XSETFUNVEC (vector
, XVECTOR (vector
));
3477 /* FLAG = 1 means check for ] to terminate rather than ) and .
3478 FLAG = -1 means check for starting with defun
3479 and make structure pure. */
3482 read_list (int flag
, register Lisp_Object readcharfun
)
3484 /* -1 means check next element for defun,
3485 0 means don't check,
3486 1 means already checked and found defun. */
3487 int defunflag
= flag
< 0 ? -1 : 0;
3488 Lisp_Object val
, tail
;
3489 register Lisp_Object elt
, tem
;
3490 struct gcpro gcpro1
, gcpro2
;
3491 /* 0 is the normal case.
3492 1 means this list is a doc reference; replace it with the number 0.
3493 2 means this list is a doc reference; replace it with the doc string. */
3494 int doc_reference
= 0;
3496 /* Initialize this to 1 if we are reading a list. */
3497 int first_in_list
= flag
<= 0;
3506 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3511 /* While building, if the list starts with #$, treat it specially. */
3512 if (EQ (elt
, Vload_file_name
)
3514 && !NILP (Vpurify_flag
))
3516 if (NILP (Vdoc_file_name
))
3517 /* We have not yet called Snarf-documentation, so assume
3518 this file is described in the DOC-MM.NN file
3519 and Snarf-documentation will fill in the right value later.
3520 For now, replace the whole list with 0. */
3523 /* We have already called Snarf-documentation, so make a relative
3524 file name for this file, so it can be found properly
3525 in the installed Lisp directory.
3526 We don't use Fexpand_file_name because that would make
3527 the directory absolute now. */
3528 elt
= concat2 (build_string ("../lisp/"),
3529 Ffile_name_nondirectory (elt
));
3531 else if (EQ (elt
, Vload_file_name
)
3533 && load_force_doc_strings
)
3542 invalid_syntax (") or . in a vector", 18);
3550 XSETCDR (tail
, read0 (readcharfun
));
3552 val
= read0 (readcharfun
);
3553 read1 (readcharfun
, &ch
, 0);
3557 if (doc_reference
== 1)
3558 return make_number (0);
3559 if (doc_reference
== 2)
3561 /* Get a doc string from the file we are loading.
3562 If it's in saved_doc_string, get it from there.
3564 Here, we don't know if the string is a
3565 bytecode string or a doc string. As a
3566 bytecode string must be unibyte, we always
3567 return a unibyte string. If it is actually a
3568 doc string, caller must make it
3571 int pos
= XINT (XCDR (val
));
3572 /* Position is negative for user variables. */
3573 if (pos
< 0) pos
= -pos
;
3574 if (pos
>= saved_doc_string_position
3575 && pos
< (saved_doc_string_position
3576 + saved_doc_string_length
))
3578 int start
= pos
- saved_doc_string_position
;
3581 /* Process quoting with ^A,
3582 and find the end of the string,
3583 which is marked with ^_ (037). */
3584 for (from
= start
, to
= start
;
3585 saved_doc_string
[from
] != 037;)
3587 int c
= saved_doc_string
[from
++];
3590 c
= saved_doc_string
[from
++];
3592 saved_doc_string
[to
++] = c
;
3594 saved_doc_string
[to
++] = 0;
3596 saved_doc_string
[to
++] = 037;
3599 saved_doc_string
[to
++] = c
;
3602 return make_unibyte_string (saved_doc_string
+ start
,
3605 /* Look in prev_saved_doc_string the same way. */
3606 else if (pos
>= prev_saved_doc_string_position
3607 && pos
< (prev_saved_doc_string_position
3608 + prev_saved_doc_string_length
))
3610 int start
= pos
- prev_saved_doc_string_position
;
3613 /* Process quoting with ^A,
3614 and find the end of the string,
3615 which is marked with ^_ (037). */
3616 for (from
= start
, to
= start
;
3617 prev_saved_doc_string
[from
] != 037;)
3619 int c
= prev_saved_doc_string
[from
++];
3622 c
= prev_saved_doc_string
[from
++];
3624 prev_saved_doc_string
[to
++] = c
;
3626 prev_saved_doc_string
[to
++] = 0;
3628 prev_saved_doc_string
[to
++] = 037;
3631 prev_saved_doc_string
[to
++] = c
;
3634 return make_unibyte_string (prev_saved_doc_string
3639 return get_doc_string (val
, 1, 0);
3644 invalid_syntax (". in wrong context", 18);
3646 invalid_syntax ("] in a list", 11);
3648 tem
= (read_pure
&& flag
<= 0
3649 ? pure_cons (elt
, Qnil
)
3650 : Fcons (elt
, Qnil
));
3652 XSETCDR (tail
, tem
);
3657 defunflag
= EQ (elt
, Qdefun
);
3658 else if (defunflag
> 0)
3663 Lisp_Object Vobarray
;
3664 Lisp_Object initial_obarray
;
3666 /* oblookup stores the bucket number here, for the sake of Funintern. */
3668 int oblookup_last_bucket_number
;
3670 static int hash_string (const unsigned char *ptr
, int len
);
3672 /* Get an error if OBARRAY is not an obarray.
3673 If it is one, return it. */
3676 check_obarray (Lisp_Object obarray
)
3678 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3680 /* If Vobarray is now invalid, force it to be valid. */
3681 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3682 wrong_type_argument (Qvectorp
, obarray
);
3687 /* Intern the C string STR: return a symbol with that name,
3688 interned in the current obarray. */
3691 intern (const char *str
)
3694 int len
= strlen (str
);
3695 Lisp_Object obarray
;
3698 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3699 obarray
= check_obarray (obarray
);
3700 tem
= oblookup (obarray
, str
, len
, len
);
3703 return Fintern (make_string (str
, len
), obarray
);
3707 intern_c_string (const char *str
)
3710 int len
= strlen (str
);
3711 Lisp_Object obarray
;
3714 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3715 obarray
= check_obarray (obarray
);
3716 tem
= oblookup (obarray
, str
, len
, len
);
3720 if (NILP (Vpurify_flag
))
3721 /* Creating a non-pure string from a string literal not
3722 implemented yet. We could just use make_string here and live
3723 with the extra copy. */
3726 return Fintern (make_pure_c_string (str
), obarray
);
3729 /* Create an uninterned symbol with name STR. */
3732 make_symbol (const char *str
)
3734 int len
= strlen (str
);
3736 return Fmake_symbol (!NILP (Vpurify_flag
)
3737 ? make_pure_string (str
, len
, len
, 0)
3738 : make_string (str
, len
));
3741 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3742 doc
: /* Return the canonical symbol whose name is STRING.
3743 If there is none, one is created by this function and returned.
3744 A second optional argument specifies the obarray to use;
3745 it defaults to the value of `obarray'. */)
3746 (Lisp_Object string
, Lisp_Object obarray
)
3748 register Lisp_Object tem
, sym
, *ptr
;
3750 if (NILP (obarray
)) obarray
= Vobarray
;
3751 obarray
= check_obarray (obarray
);
3753 CHECK_STRING (string
);
3755 tem
= oblookup (obarray
, SDATA (string
),
3758 if (!INTEGERP (tem
))
3761 if (!NILP (Vpurify_flag
))
3762 string
= Fpurecopy (string
);
3763 sym
= Fmake_symbol (string
);
3765 if (EQ (obarray
, initial_obarray
))
3766 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3768 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3770 if ((SREF (string
, 0) == ':')
3771 && EQ (obarray
, initial_obarray
))
3773 XSYMBOL (sym
)->constant
= 1;
3774 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3775 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3778 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3780 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3782 XSYMBOL (sym
)->next
= 0;
3787 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3788 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3789 NAME may be a string or a symbol. If it is a symbol, that exact
3790 symbol is searched for.
3791 A second optional argument specifies the obarray to use;
3792 it defaults to the value of `obarray'. */)
3793 (Lisp_Object name
, Lisp_Object obarray
)
3795 register Lisp_Object tem
, string
;
3797 if (NILP (obarray
)) obarray
= Vobarray
;
3798 obarray
= check_obarray (obarray
);
3800 if (!SYMBOLP (name
))
3802 CHECK_STRING (name
);
3806 string
= SYMBOL_NAME (name
);
3808 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3809 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3815 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3816 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3817 The value is t if a symbol was found and deleted, nil otherwise.
3818 NAME may be a string or a symbol. If it is a symbol, that symbol
3819 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3820 OBARRAY defaults to the value of the variable `obarray'. */)
3821 (Lisp_Object name
, Lisp_Object obarray
)
3823 register Lisp_Object string
, tem
;
3826 if (NILP (obarray
)) obarray
= Vobarray
;
3827 obarray
= check_obarray (obarray
);
3830 string
= SYMBOL_NAME (name
);
3833 CHECK_STRING (name
);
3837 tem
= oblookup (obarray
, SDATA (string
),
3842 /* If arg was a symbol, don't delete anything but that symbol itself. */
3843 if (SYMBOLP (name
) && !EQ (name
, tem
))
3846 /* There are plenty of other symbols which will screw up the Emacs
3847 session if we unintern them, as well as even more ways to use
3848 `setq' or `fset' or whatnot to make the Emacs session
3849 unusable. Let's not go down this silly road. --Stef */
3850 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3851 error ("Attempt to unintern t or nil"); */
3853 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3855 hash
= oblookup_last_bucket_number
;
3857 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3859 if (XSYMBOL (tem
)->next
)
3860 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3862 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3866 Lisp_Object tail
, following
;
3868 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3869 XSYMBOL (tail
)->next
;
3872 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3873 if (EQ (following
, tem
))
3875 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3884 /* Return the symbol in OBARRAY whose names matches the string
3885 of SIZE characters (SIZE_BYTE bytes) at PTR.
3886 If there is no such symbol in OBARRAY, return nil.
3888 Also store the bucket number in oblookup_last_bucket_number. */
3891 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3895 register Lisp_Object tail
;
3896 Lisp_Object bucket
, tem
;
3898 if (!VECTORP (obarray
)
3899 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3901 obarray
= check_obarray (obarray
);
3902 obsize
= XVECTOR (obarray
)->size
;
3904 /* This is sometimes needed in the middle of GC. */
3905 obsize
&= ~ARRAY_MARK_FLAG
;
3906 hash
= hash_string (ptr
, size_byte
) % obsize
;
3907 bucket
= XVECTOR (obarray
)->contents
[hash
];
3908 oblookup_last_bucket_number
= hash
;
3909 if (EQ (bucket
, make_number (0)))
3911 else if (!SYMBOLP (bucket
))
3912 error ("Bad data in guts of obarray"); /* Like CADR error message */
3914 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3916 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3917 && SCHARS (SYMBOL_NAME (tail
)) == size
3918 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3920 else if (XSYMBOL (tail
)->next
== 0)
3923 XSETINT (tem
, hash
);
3928 hash_string (const unsigned char *ptr
, int len
)
3930 register const unsigned char *p
= ptr
;
3931 register const unsigned char *end
= p
+ len
;
3932 register unsigned char c
;
3933 register int hash
= 0;
3938 if (c
>= 0140) c
-= 40;
3939 hash
= ((hash
<<3) + (hash
>>28) + c
);
3941 return hash
& 07777777777;
3945 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3948 register Lisp_Object tail
;
3949 CHECK_VECTOR (obarray
);
3950 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3952 tail
= XVECTOR (obarray
)->contents
[i
];
3957 if (XSYMBOL (tail
)->next
== 0)
3959 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3965 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3967 call1 (function
, sym
);
3970 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3971 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3972 OBARRAY defaults to the value of `obarray'. */)
3973 (Lisp_Object function
, Lisp_Object obarray
)
3975 if (NILP (obarray
)) obarray
= Vobarray
;
3976 obarray
= check_obarray (obarray
);
3978 map_obarray (obarray
, mapatoms_1
, function
);
3982 #define OBARRAY_SIZE 1511
3987 Lisp_Object oblength
;
3989 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3991 Vobarray
= Fmake_vector (oblength
, make_number (0));
3992 initial_obarray
= Vobarray
;
3993 staticpro (&initial_obarray
);
3995 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3996 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3997 NILP (Vpurify_flag) check in intern_c_string. */
3998 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3999 Qnil
= intern_c_string ("nil");
4001 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4002 so those two need to be fixed manally. */
4003 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4004 XSYMBOL (Qunbound
)->function
= Qunbound
;
4005 XSYMBOL (Qunbound
)->plist
= Qnil
;
4006 /* XSYMBOL (Qnil)->function = Qunbound; */
4007 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4008 XSYMBOL (Qnil
)->constant
= 1;
4009 XSYMBOL (Qnil
)->plist
= Qnil
;
4011 Qt
= intern_c_string ("t");
4012 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4013 XSYMBOL (Qt
)->constant
= 1;
4015 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4018 Qvariable_documentation
= intern_c_string ("variable-documentation");
4019 staticpro (&Qvariable_documentation
);
4021 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
4022 read_buffer
= (char *) xmalloc (read_buffer_size
);
4026 defsubr (struct Lisp_Subr
*sname
)
4029 sym
= intern_c_string (sname
->symbol_name
);
4030 XSETPVECTYPE (sname
, PVEC_SUBR
);
4031 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4034 #ifdef NOTDEF /* use fset in subr.el now */
4036 defalias (sname
, string
)
4037 struct Lisp_Subr
*sname
;
4041 sym
= intern (string
);
4042 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4046 /* Define an "integer variable"; a symbol whose value is forwarded to a
4047 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
4048 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4050 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4051 const char *namestring
, EMACS_INT
*address
)
4054 sym
= intern_c_string (namestring
);
4055 i_fwd
->type
= Lisp_Fwd_Int
;
4056 i_fwd
->intvar
= address
;
4057 XSYMBOL (sym
)->declared_special
= 1;
4058 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4059 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4062 /* Similar but define a variable whose value is t if address contains 1,
4063 nil if address contains 0. */
4065 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4066 const char *namestring
, int *address
)
4069 sym
= intern_c_string (namestring
);
4070 b_fwd
->type
= Lisp_Fwd_Bool
;
4071 b_fwd
->boolvar
= address
;
4072 XSYMBOL (sym
)->declared_special
= 1;
4073 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4074 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4075 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4078 /* Similar but define a variable whose value is the Lisp Object stored
4079 at address. Two versions: with and without gc-marking of the C
4080 variable. The nopro version is used when that variable will be
4081 gc-marked for some other reason, since marking the same slot twice
4082 can cause trouble with strings. */
4084 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4085 const char *namestring
, Lisp_Object
*address
)
4088 sym
= intern_c_string (namestring
);
4089 o_fwd
->type
= Lisp_Fwd_Obj
;
4090 o_fwd
->objvar
= address
;
4091 XSYMBOL (sym
)->declared_special
= 1;
4092 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4093 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4097 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4098 const char *namestring
, Lisp_Object
*address
)
4100 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4101 staticpro (address
);
4105 /* Similar but define a variable whose value is the Lisp Object stored
4106 at a particular offset in the current kboard object. */
4109 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4110 const char *namestring
, int offset
)
4113 sym
= intern_c_string (namestring
);
4114 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4115 ko_fwd
->offset
= offset
;
4116 XSYMBOL (sym
)->declared_special
= 1;
4117 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4118 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4121 /* Record the value of load-path used at the start of dumping
4122 so we can see if the site changed it later during dumping. */
4123 static Lisp_Object dump_path
;
4129 int turn_off_warning
= 0;
4131 /* Compute the default load-path. */
4133 normal
= PATH_LOADSEARCH
;
4134 Vload_path
= decode_env_path (0, normal
);
4136 if (NILP (Vpurify_flag
))
4137 normal
= PATH_LOADSEARCH
;
4139 normal
= PATH_DUMPLOADSEARCH
;
4141 /* In a dumped Emacs, we normally have to reset the value of
4142 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4143 uses ../lisp, instead of the path of the installed elisp
4144 libraries. However, if it appears that Vload_path was changed
4145 from the default before dumping, don't override that value. */
4148 if (! NILP (Fequal (dump_path
, Vload_path
)))
4150 Vload_path
= decode_env_path (0, normal
);
4151 if (!NILP (Vinstallation_directory
))
4153 Lisp_Object tem
, tem1
, sitelisp
;
4155 /* Remove site-lisp dirs from path temporarily and store
4156 them in sitelisp, then conc them on at the end so
4157 they're always first in path. */
4161 tem
= Fcar (Vload_path
);
4162 tem1
= Fstring_match (build_string ("site-lisp"),
4166 Vload_path
= Fcdr (Vload_path
);
4167 sitelisp
= Fcons (tem
, sitelisp
);
4173 /* Add to the path the lisp subdir of the
4174 installation dir, if it exists. */
4175 tem
= Fexpand_file_name (build_string ("lisp"),
4176 Vinstallation_directory
);
4177 tem1
= Ffile_exists_p (tem
);
4180 if (NILP (Fmember (tem
, Vload_path
)))
4182 turn_off_warning
= 1;
4183 Vload_path
= Fcons (tem
, Vload_path
);
4187 /* That dir doesn't exist, so add the build-time
4188 Lisp dirs instead. */
4189 Vload_path
= nconc2 (Vload_path
, dump_path
);
4191 /* Add leim under the installation dir, if it exists. */
4192 tem
= Fexpand_file_name (build_string ("leim"),
4193 Vinstallation_directory
);
4194 tem1
= Ffile_exists_p (tem
);
4197 if (NILP (Fmember (tem
, Vload_path
)))
4198 Vload_path
= Fcons (tem
, Vload_path
);
4201 /* Add site-lisp under the installation dir, if it exists. */
4202 tem
= Fexpand_file_name (build_string ("site-lisp"),
4203 Vinstallation_directory
);
4204 tem1
= Ffile_exists_p (tem
);
4207 if (NILP (Fmember (tem
, Vload_path
)))
4208 Vload_path
= Fcons (tem
, Vload_path
);
4211 /* If Emacs was not built in the source directory,
4212 and it is run from where it was built, add to load-path
4213 the lisp, leim and site-lisp dirs under that directory. */
4215 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4219 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4220 Vinstallation_directory
);
4221 tem1
= Ffile_exists_p (tem
);
4223 /* Don't be fooled if they moved the entire source tree
4224 AFTER dumping Emacs. If the build directory is indeed
4225 different from the source dir, src/Makefile.in and
4226 src/Makefile will not be found together. */
4227 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4228 Vinstallation_directory
);
4229 tem2
= Ffile_exists_p (tem
);
4230 if (!NILP (tem1
) && NILP (tem2
))
4232 tem
= Fexpand_file_name (build_string ("lisp"),
4235 if (NILP (Fmember (tem
, Vload_path
)))
4236 Vload_path
= Fcons (tem
, Vload_path
);
4238 tem
= Fexpand_file_name (build_string ("leim"),
4241 if (NILP (Fmember (tem
, Vload_path
)))
4242 Vload_path
= Fcons (tem
, Vload_path
);
4244 tem
= Fexpand_file_name (build_string ("site-lisp"),
4247 if (NILP (Fmember (tem
, Vload_path
)))
4248 Vload_path
= Fcons (tem
, Vload_path
);
4251 if (!NILP (sitelisp
))
4252 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4258 /* NORMAL refers to the lisp dir in the source directory. */
4259 /* We used to add ../lisp at the front here, but
4260 that caused trouble because it was copied from dump_path
4261 into Vload_path, above, when Vinstallation_directory was non-nil.
4262 It should be unnecessary. */
4263 Vload_path
= decode_env_path (0, normal
);
4264 dump_path
= Vload_path
;
4268 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4269 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4270 almost never correct, thereby causing a warning to be printed out that
4271 confuses users. Since PATH_LOADSEARCH is always overridden by the
4272 EMACSLOADPATH environment variable below, disable the warning on NT. */
4274 /* Warn if dirs in the *standard* path don't exist. */
4275 if (!turn_off_warning
)
4277 Lisp_Object path_tail
;
4279 for (path_tail
= Vload_path
;
4281 path_tail
= XCDR (path_tail
))
4283 Lisp_Object dirfile
;
4284 dirfile
= Fcar (path_tail
);
4285 if (STRINGP (dirfile
))
4287 dirfile
= Fdirectory_file_name (dirfile
);
4288 if (access (SDATA (dirfile
), 0) < 0)
4289 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4294 #endif /* !(WINDOWSNT || HAVE_NS) */
4296 /* If the EMACSLOADPATH environment variable is set, use its value.
4297 This doesn't apply if we're dumping. */
4299 if (NILP (Vpurify_flag
)
4300 && egetenv ("EMACSLOADPATH"))
4302 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4306 load_in_progress
= 0;
4307 Vload_file_name
= Qnil
;
4309 load_descriptor_list
= Qnil
;
4311 Vstandard_input
= Qt
;
4312 Vloads_in_progress
= Qnil
;
4315 /* Print a warning, using format string FORMAT, that directory DIRNAME
4316 does not exist. Print it on stderr and put it in *Messages*. */
4319 dir_warning (const char *format
, Lisp_Object dirname
)
4322 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4324 fprintf (stderr
, format
, SDATA (dirname
));
4325 sprintf (buffer
, format
, SDATA (dirname
));
4326 /* Don't log the warning before we've initialized!! */
4328 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4332 syms_of_lread (void)
4335 defsubr (&Sread_from_string
);
4337 defsubr (&Sintern_soft
);
4338 defsubr (&Sunintern
);
4339 defsubr (&Sget_load_suffixes
);
4341 defsubr (&Seval_buffer
);
4342 defsubr (&Seval_region
);
4343 defsubr (&Sread_char
);
4344 defsubr (&Sread_char_exclusive
);
4345 defsubr (&Sread_event
);
4346 defsubr (&Sget_file_char
);
4347 defsubr (&Smapatoms
);
4348 defsubr (&Slocate_file_internal
);
4350 DEFVAR_LISP ("obarray", &Vobarray
,
4351 doc
: /* Symbol table for use by `intern' and `read'.
4352 It is a vector whose length ought to be prime for best results.
4353 The vector's contents don't make sense if examined from Lisp programs;
4354 to find all the symbols in an obarray, use `mapatoms'. */);
4356 DEFVAR_LISP ("values", &Vvalues
,
4357 doc
: /* List of values of all expressions which were read, evaluated and printed.
4358 Order is reverse chronological. */);
4360 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4361 doc
: /* Stream for read to get input from.
4362 See documentation of `read' for possible values. */);
4363 Vstandard_input
= Qt
;
4365 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4366 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4368 If this variable is a buffer, then only forms read from that buffer
4369 will be added to `read-symbol-positions-list'.
4370 If this variable is t, then all read forms will be added.
4371 The effect of all other values other than nil are not currently
4372 defined, although they may be in the future.
4374 The positions are relative to the last call to `read' or
4375 `read-from-string'. It is probably a bad idea to set this variable at
4376 the toplevel; bind it instead. */);
4377 Vread_with_symbol_positions
= Qnil
;
4379 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4380 doc
: /* A list mapping read symbols to their positions.
4381 This variable is modified during calls to `read' or
4382 `read-from-string', but only when `read-with-symbol-positions' is
4385 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4386 CHAR-POSITION is an integer giving the offset of that occurrence of the
4387 symbol from the position where `read' or `read-from-string' started.
4389 Note that a symbol will appear multiple times in this list, if it was
4390 read multiple times. The list is in the same order as the symbols
4392 Vread_symbol_positions_list
= Qnil
;
4394 DEFVAR_LISP ("read-circle", &Vread_circle
,
4395 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4398 DEFVAR_LISP ("load-path", &Vload_path
,
4399 doc
: /* *List of directories to search for files to load.
4400 Each element is a string (directory name) or nil (try default directory).
4401 Initialized based on EMACSLOADPATH environment variable, if any,
4402 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4404 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4405 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4406 This list should not include the empty string.
4407 `load' and related functions try to append these suffixes, in order,
4408 to the specified file name if a Lisp suffix is allowed or required. */);
4409 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4410 Fcons (make_pure_c_string (".el"), Qnil
));
4411 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4412 doc
: /* List of suffixes that indicate representations of \
4414 This list should normally start with the empty string.
4416 Enabling Auto Compression mode appends the suffixes in
4417 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4418 mode removes them again. `load' and related functions use this list to
4419 determine whether they should look for compressed versions of a file
4420 and, if so, which suffixes they should try to append to the file name
4421 in order to do so. However, if you want to customize which suffixes
4422 the loading functions recognize as compression suffixes, you should
4423 customize `jka-compr-load-suffixes' rather than the present variable. */);
4424 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4426 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4427 doc
: /* Non-nil if inside of `load'. */);
4428 Qload_in_progress
= intern_c_string ("load-in-progress");
4429 staticpro (&Qload_in_progress
);
4431 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4432 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4433 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4435 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4436 a symbol \(a feature name).
4438 When `load' is run and the file-name argument matches an element's
4439 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4440 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4442 An error in FORMS does not undo the load, but does prevent execution of
4443 the rest of the FORMS. */);
4444 Vafter_load_alist
= Qnil
;
4446 DEFVAR_LISP ("load-history", &Vload_history
,
4447 doc
: /* Alist mapping loaded file names to symbols and features.
4448 Each alist element should be a list (FILE-NAME ENTRIES...), where
4449 FILE-NAME is the name of a file that has been loaded into Emacs.
4450 The file name is absolute and true (i.e. it doesn't contain symlinks).
4451 As an exception, one of the alist elements may have FILE-NAME nil,
4452 for symbols and features not associated with any file.
4454 The remaining ENTRIES in the alist element describe the functions and
4455 variables defined in that file, the features provided, and the
4456 features required. Each entry has the form `(provide . FEATURE)',
4457 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4458 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4459 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4460 SYMBOL was an autoload before this file redefined it as a function.
4462 During preloading, the file name recorded is relative to the main Lisp
4463 directory. These file names are converted to absolute at startup. */);
4464 Vload_history
= Qnil
;
4466 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4467 doc
: /* Full name of file being loaded by `load'. */);
4468 Vload_file_name
= Qnil
;
4470 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4471 doc
: /* File name, including directory, of user's initialization file.
4472 If the file loaded had extension `.elc', and the corresponding source file
4473 exists, this variable contains the name of source file, suitable for use
4474 by functions like `custom-save-all' which edit the init file.
4475 While Emacs loads and evaluates the init file, value is the real name
4476 of the file, regardless of whether or not it has the `.elc' extension. */);
4477 Vuser_init_file
= Qnil
;
4479 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4480 doc
: /* Used for internal purposes by `load'. */);
4481 Vcurrent_load_list
= Qnil
;
4483 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4484 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4485 The default is nil, which means use the function `read'. */);
4486 Vload_read_function
= Qnil
;
4488 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4489 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4490 This function is for doing code conversion before reading the source file.
4491 If nil, loading is done without any code conversion.
4492 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4493 FULLNAME is the full name of FILE.
4494 See `load' for the meaning of the remaining arguments. */);
4495 Vload_source_file_function
= Qnil
;
4497 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4498 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4499 This is useful when the file being loaded is a temporary copy. */);
4500 load_force_doc_strings
= 0;
4502 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4503 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4504 This is normally bound by `load' and `eval-buffer' to control `read',
4505 and is not meant for users to change. */);
4506 load_convert_to_unibyte
= 0;
4508 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4509 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4510 You cannot count on them to still be there! */);
4512 = Fexpand_file_name (build_string ("../"),
4513 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4515 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4516 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4517 Vpreloaded_file_list
= Qnil
;
4519 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4520 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4521 Vbyte_boolean_vars
= Qnil
;
4523 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4524 doc
: /* Non-nil means load dangerous compiled Lisp files.
4525 Some versions of XEmacs use different byte codes than Emacs. These
4526 incompatible byte codes can make Emacs crash when it tries to execute
4528 load_dangerous_libraries
= 0;
4530 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4531 doc
: /* Non-nil means force printing messages when loading Lisp files.
4532 This overrides the value of the NOMESSAGE argument to `load'. */);
4533 force_load_messages
= 0;
4535 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4536 doc
: /* Regular expression matching safe to load compiled Lisp files.
4537 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4538 from the file, and matches them against this regular expression.
4539 When the regular expression matches, the file is considered to be safe
4540 to load. See also `load-dangerous-libraries'. */);
4541 Vbytecomp_version_regexp
4542 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4544 Qlexical_binding
= intern ("lexical-binding");
4545 staticpro (&Qlexical_binding
);
4546 DEFVAR_LISP ("lexical-binding", &Vlexical_binding
,
4547 doc
: /* If non-nil, use lexical binding when evaluating code.
4548 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4549 This variable is automatically set from the file variables of an interpreted
4550 lisp file read using `load'. */);
4551 Fmake_variable_buffer_local (Qlexical_binding
);
4553 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4554 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4555 Veval_buffer_list
= Qnil
;
4557 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4558 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4559 Vold_style_backquotes
= Qnil
;
4560 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4561 staticpro (&Qold_style_backquotes
);
4563 /* Vsource_directory was initialized in init_lread. */
4565 load_descriptor_list
= Qnil
;
4566 staticpro (&load_descriptor_list
);
4568 Qcurrent_load_list
= intern_c_string ("current-load-list");
4569 staticpro (&Qcurrent_load_list
);
4571 Qstandard_input
= intern_c_string ("standard-input");
4572 staticpro (&Qstandard_input
);
4574 Qread_char
= intern_c_string ("read-char");
4575 staticpro (&Qread_char
);
4577 Qget_file_char
= intern_c_string ("get-file-char");
4578 staticpro (&Qget_file_char
);
4580 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4581 staticpro (&Qget_emacs_mule_file_char
);
4583 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4584 staticpro (&Qload_force_doc_strings
);
4586 Qbackquote
= intern_c_string ("`");
4587 staticpro (&Qbackquote
);
4588 Qcomma
= intern_c_string (",");
4589 staticpro (&Qcomma
);
4590 Qcomma_at
= intern_c_string (",@");
4591 staticpro (&Qcomma_at
);
4592 Qcomma_dot
= intern_c_string (",.");
4593 staticpro (&Qcomma_dot
);
4595 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4596 staticpro (&Qinhibit_file_name_operation
);
4598 Qascii_character
= intern_c_string ("ascii-character");
4599 staticpro (&Qascii_character
);
4601 Qfunction
= intern_c_string ("function");
4602 staticpro (&Qfunction
);
4604 Qload
= intern_c_string ("load");
4607 Qload_file_name
= intern_c_string ("load-file-name");
4608 staticpro (&Qload_file_name
);
4610 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4611 staticpro (&Qeval_buffer_list
);
4613 Qfile_truename
= intern_c_string ("file-truename");
4614 staticpro (&Qfile_truename
) ;
4616 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4617 staticpro (&Qdo_after_load_evaluation
) ;
4619 staticpro (&dump_path
);
4621 staticpro (&read_objects
);
4622 read_objects
= Qnil
;
4623 staticpro (&seen_list
);
4626 Vloads_in_progress
= Qnil
;
4627 staticpro (&Vloads_in_progress
);
4629 Qhash_table
= intern_c_string ("hash-table");
4630 staticpro (&Qhash_table
);
4631 Qdata
= intern_c_string ("data");
4633 Qtest
= intern_c_string ("test");
4635 Qsize
= intern_c_string ("size");
4637 Qweakness
= intern_c_string ("weakness");
4638 staticpro (&Qweakness
);
4639 Qrehash_size
= intern_c_string ("rehash-size");
4640 staticpro (&Qrehash_size
);
4641 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4642 staticpro (&Qrehash_threshold
);