1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
55 #endif /* HAVE_SETLOCALE */
65 #define file_offset off_t
66 #define file_tell ftello
68 #define file_offset long
69 #define file_tell ftell
72 /* hash table read constants */
73 Lisp_Object Qhash_table
, Qdata
;
74 Lisp_Object Qtest
, Qsize
;
75 Lisp_Object Qweakness
;
76 Lisp_Object Qrehash_size
;
77 Lisp_Object Qrehash_threshold
;
78 extern Lisp_Object QCtest
, QCsize
, QCrehash_size
, QCrehash_threshold
, QCweakness
;
80 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
81 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
82 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
83 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
84 Lisp_Object Qinhibit_file_name_operation
;
85 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
86 Lisp_Object Qlexical_binding
;
87 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
89 /* Used instead of Qget_file_char while loading *.elc files compiled
90 by Emacs 21 or older. */
91 static Lisp_Object Qget_emacs_mule_file_char
;
93 static Lisp_Object Qload_force_doc_strings
;
95 extern Lisp_Object Qevent_symbol_element_mask
;
96 extern Lisp_Object Qfile_exists_p
;
97 extern Lisp_Object Qinternal_interpreter_environment
;
99 /* non-zero if inside `load' */
100 int load_in_progress
;
101 static Lisp_Object Qload_in_progress
;
103 /* Directory in which the sources were found. */
104 Lisp_Object Vsource_directory
;
106 /* Search path and suffixes for files to be loaded. */
107 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
109 /* File name of user's init file. */
110 Lisp_Object Vuser_init_file
;
112 /* This is the user-visible association list that maps features to
113 lists of defs in their load files. */
114 Lisp_Object Vload_history
;
116 /* This is used to build the load history. */
117 Lisp_Object Vcurrent_load_list
;
119 /* List of files that were preloaded. */
120 Lisp_Object Vpreloaded_file_list
;
122 /* Name of file actually being read by `load'. */
123 Lisp_Object Vload_file_name
;
125 /* Function to use for reading, in `load' and friends. */
126 Lisp_Object Vload_read_function
;
128 /* Non-nil means read recursive structures using #n= and #n# syntax. */
129 Lisp_Object Vread_circle
;
131 /* The association list of objects read with the #n=object form.
132 Each member of the list has the form (n . object), and is used to
133 look up the object for the corresponding #n# construct.
134 It must be set to nil before all top-level calls to read0. */
135 Lisp_Object read_objects
;
137 /* Nonzero means load should forcibly load all dynamic doc strings. */
138 static int load_force_doc_strings
;
140 /* Nonzero means read should convert strings to unibyte. */
141 static int load_convert_to_unibyte
;
143 /* Nonzero means READCHAR should read bytes one by one (not character)
144 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
145 This is set to 1 by read1 temporarily while handling #@NUMBER. */
146 static int load_each_byte
;
148 /* Function to use for loading an Emacs Lisp source file (not
149 compiled) instead of readevalloop. */
150 Lisp_Object Vload_source_file_function
;
152 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
153 Lisp_Object Vbyte_boolean_vars
;
155 /* Whether or not to add a `read-positions' property to symbols
157 Lisp_Object Vread_with_symbol_positions
;
159 /* List of (SYMBOL . POSITION) accumulated so far. */
160 Lisp_Object Vread_symbol_positions_list
;
162 /* If non-nil `readevalloop' evaluates code in a lexical environment. */
163 Lisp_Object Vlexical_binding
;
165 /* List of descriptors now open for Fload. */
166 static Lisp_Object load_descriptor_list
;
168 /* File for get_file_char to read from. Use by load. */
169 static FILE *instream
;
171 /* When nonzero, read conses in pure space */
172 static int read_pure
;
174 /* For use within read-from-string (this reader is non-reentrant!!) */
175 static int read_from_string_index
;
176 static int read_from_string_index_byte
;
177 static int read_from_string_limit
;
179 /* Number of characters read in the current call to Fread or
180 Fread_from_string. */
181 static int readchar_count
;
183 /* This contains the last string skipped with #@. */
184 static char *saved_doc_string
;
185 /* Length of buffer allocated in saved_doc_string. */
186 static int saved_doc_string_size
;
187 /* Length of actual data in saved_doc_string. */
188 static int saved_doc_string_length
;
189 /* This is the file position that string came from. */
190 static file_offset saved_doc_string_position
;
192 /* This contains the previous string skipped with #@.
193 We copy it from saved_doc_string when a new string
194 is put in saved_doc_string. */
195 static char *prev_saved_doc_string
;
196 /* Length of buffer allocated in prev_saved_doc_string. */
197 static int prev_saved_doc_string_size
;
198 /* Length of actual data in prev_saved_doc_string. */
199 static int prev_saved_doc_string_length
;
200 /* This is the file position that string came from. */
201 static file_offset prev_saved_doc_string_position
;
203 /* Nonzero means inside a new-style backquote
204 with no surrounding parentheses.
205 Fread initializes this to zero, so we need not specbind it
206 or worry about what happens to it when there is an error. */
207 static int new_backquote_flag
;
208 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
210 /* A list of file names for files being loaded in Fload. Used to
211 check for recursive loads. */
213 static Lisp_Object Vloads_in_progress
;
215 /* Non-zero means load dangerous compiled Lisp files. */
217 int load_dangerous_libraries
;
219 /* Non-zero means force printing messages when loading Lisp files. */
221 int force_load_messages
;
223 /* A regular expression used to detect files compiled with Emacs. */
225 static Lisp_Object Vbytecomp_version_regexp
;
227 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
230 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
231 Lisp_Object (*) (), int,
232 Lisp_Object
, Lisp_Object
,
233 Lisp_Object
, Lisp_Object
));
234 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
235 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
237 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
238 static void end_of_file_error
P_ (()) NO_RETURN
;
241 /* Functions that read one byte from the current source READCHARFUN
242 or unreads one byte. If the integer argument C is -1, it returns
243 one read byte, or -1 when there's no more byte in the source. If C
244 is 0 or positive, it unreads C, and the return value is not
247 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
248 static int readbyte_from_file
P_ ((int, Lisp_Object
));
249 static int readbyte_from_string
P_ ((int, Lisp_Object
));
251 /* Handle unreading and rereading of characters.
252 Write READCHAR to read a character,
253 UNREAD(c) to unread c to be read again.
255 These macros correctly read/unread multibyte characters. */
257 #define READCHAR readchar (readcharfun, NULL)
258 #define UNREAD(c) unreadchar (readcharfun, c)
260 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
261 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
263 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
264 Qlambda, or a cons, we use this to keep an unread character because
265 a file stream can't handle multibyte-char unreading. The value -1
266 means that there's no unread character. */
267 static int unread_char
;
270 readchar (readcharfun
, multibyte
)
271 Lisp_Object readcharfun
;
276 int (*readbyte
) P_ ((int, Lisp_Object
));
277 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
279 int emacs_mule_encoding
= 0;
286 if (BUFFERP (readcharfun
))
288 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
290 int pt_byte
= BUF_PT_BYTE (inbuffer
);
292 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
295 if (! NILP (inbuffer
->enable_multibyte_characters
))
297 /* Fetch the character code from the buffer. */
298 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
299 BUF_INC_POS (inbuffer
, pt_byte
);
306 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
307 if (! ASCII_BYTE_P (c
))
308 c
= BYTE8_TO_CHAR (c
);
311 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
315 if (MARKERP (readcharfun
))
317 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
319 int bytepos
= marker_byte_position (readcharfun
);
321 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
324 if (! NILP (inbuffer
->enable_multibyte_characters
))
326 /* Fetch the character code from the buffer. */
327 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
328 BUF_INC_POS (inbuffer
, bytepos
);
335 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
336 if (! ASCII_BYTE_P (c
))
337 c
= BYTE8_TO_CHAR (c
);
341 XMARKER (readcharfun
)->bytepos
= bytepos
;
342 XMARKER (readcharfun
)->charpos
++;
347 if (EQ (readcharfun
, Qlambda
))
349 readbyte
= readbyte_for_lambda
;
353 if (EQ (readcharfun
, Qget_file_char
))
355 readbyte
= readbyte_from_file
;
359 if (STRINGP (readcharfun
))
361 if (read_from_string_index
>= read_from_string_limit
)
363 else if (STRING_MULTIBYTE (readcharfun
))
367 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
368 read_from_string_index
,
369 read_from_string_index_byte
);
373 c
= SREF (readcharfun
, read_from_string_index_byte
);
374 read_from_string_index
++;
375 read_from_string_index_byte
++;
380 if (CONSP (readcharfun
))
382 /* This is the case that read_vector is reading from a unibyte
383 string that contains a byte sequence previously skipped
384 because of #@NUMBER. The car part of readcharfun is that
385 string, and the cdr part is a value of readcharfun given to
387 readbyte
= readbyte_from_string
;
388 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
389 emacs_mule_encoding
= 1;
393 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
395 readbyte
= readbyte_from_file
;
396 emacs_mule_encoding
= 1;
400 tem
= call0 (readcharfun
);
407 if (unread_char
>= 0)
413 c
= (*readbyte
) (-1, readcharfun
);
414 if (c
< 0 || load_each_byte
)
418 if (ASCII_BYTE_P (c
))
420 if (emacs_mule_encoding
)
421 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
424 len
= BYTES_BY_CHAR_HEAD (c
);
427 c
= (*readbyte
) (-1, readcharfun
);
428 if (c
< 0 || ! TRAILING_CODE_P (c
))
431 (*readbyte
) (buf
[i
], readcharfun
);
432 return BYTE8_TO_CHAR (buf
[0]);
436 return STRING_CHAR (buf
);
439 /* Unread the character C in the way appropriate for the stream READCHARFUN.
440 If the stream is a user function, call it with the char as argument. */
443 unreadchar (readcharfun
, c
)
444 Lisp_Object readcharfun
;
449 /* Don't back up the pointer if we're unreading the end-of-input mark,
450 since readchar didn't advance it when we read it. */
452 else if (BUFFERP (readcharfun
))
454 struct buffer
*b
= XBUFFER (readcharfun
);
455 int bytepos
= BUF_PT_BYTE (b
);
458 if (! NILP (b
->enable_multibyte_characters
))
459 BUF_DEC_POS (b
, bytepos
);
463 BUF_PT_BYTE (b
) = bytepos
;
465 else if (MARKERP (readcharfun
))
467 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
468 int bytepos
= XMARKER (readcharfun
)->bytepos
;
470 XMARKER (readcharfun
)->charpos
--;
471 if (! NILP (b
->enable_multibyte_characters
))
472 BUF_DEC_POS (b
, bytepos
);
476 XMARKER (readcharfun
)->bytepos
= bytepos
;
478 else if (STRINGP (readcharfun
))
480 read_from_string_index
--;
481 read_from_string_index_byte
482 = string_char_to_byte (readcharfun
, read_from_string_index
);
484 else if (CONSP (readcharfun
))
488 else if (EQ (readcharfun
, Qlambda
))
492 else if (EQ (readcharfun
, Qget_file_char
)
493 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
498 ungetc (c
, instream
);
505 call1 (readcharfun
, make_number (c
));
509 readbyte_for_lambda (c
, readcharfun
)
511 Lisp_Object readcharfun
;
513 return read_bytecode_char (c
>= 0);
518 readbyte_from_file (c
, readcharfun
)
520 Lisp_Object readcharfun
;
525 ungetc (c
, instream
);
534 /* Interrupted reads have been observed while reading over the network */
535 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
547 return (c
== EOF
? -1 : c
);
551 readbyte_from_string (c
, readcharfun
)
553 Lisp_Object readcharfun
;
555 Lisp_Object string
= XCAR (readcharfun
);
559 read_from_string_index
--;
560 read_from_string_index_byte
561 = string_char_to_byte (string
, read_from_string_index
);
564 if (read_from_string_index
>= read_from_string_limit
)
567 FETCH_STRING_CHAR_ADVANCE (c
, string
,
568 read_from_string_index
,
569 read_from_string_index_byte
);
574 /* Read one non-ASCII character from INSTREAM. The character is
575 encoded in `emacs-mule' and the first byte is already read in
578 extern char emacs_mule_bytes
[256];
581 read_emacs_mule_char (c
, readbyte
, readcharfun
)
583 int (*readbyte
) P_ ((int, Lisp_Object
));
584 Lisp_Object readcharfun
;
586 /* Emacs-mule coding uses at most 4-byte for one character. */
587 unsigned char buf
[4];
588 int len
= emacs_mule_bytes
[c
];
589 struct charset
*charset
;
594 /* C is not a valid leading-code of `emacs-mule'. */
595 return BYTE8_TO_CHAR (c
);
601 c
= (*readbyte
) (-1, readcharfun
);
605 (*readbyte
) (buf
[i
], readcharfun
);
606 return BYTE8_TO_CHAR (buf
[0]);
613 charset
= emacs_mule_charset
[buf
[0]];
614 code
= buf
[1] & 0x7F;
618 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
619 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
621 charset
= emacs_mule_charset
[buf
[1]];
622 code
= buf
[2] & 0x7F;
626 charset
= emacs_mule_charset
[buf
[0]];
627 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
632 charset
= emacs_mule_charset
[buf
[1]];
633 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
635 c
= DECODE_CHAR (charset
, code
);
637 Fsignal (Qinvalid_read_syntax
,
638 Fcons (build_string ("invalid multibyte form"), Qnil
));
643 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
645 static Lisp_Object read0
P_ ((Lisp_Object
));
646 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
648 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
649 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
651 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
653 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
655 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
658 /* Get a character from the tty. */
660 /* Read input events until we get one that's acceptable for our purposes.
662 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
663 until we get a character we like, and then stuffed into
666 If ASCII_REQUIRED is non-zero, we check function key events to see
667 if the unmodified version of the symbol has a Qascii_character
668 property, and use that character, if present.
670 If ERROR_NONASCII is non-zero, we signal an error if the input we
671 get isn't an ASCII character with modifiers. If it's zero but
672 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
675 If INPUT_METHOD is nonzero, we invoke the current input method
676 if the character warrants that.
678 If SECONDS is a number, we wait that many seconds for input, and
679 return Qnil if no input arrives within that time. */
682 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
683 input_method
, seconds
)
684 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
687 Lisp_Object val
, delayed_switch_frame
;
690 #ifdef HAVE_WINDOW_SYSTEM
691 if (display_hourglass_p
)
695 delayed_switch_frame
= Qnil
;
697 /* Compute timeout. */
698 if (NUMBERP (seconds
))
700 EMACS_TIME wait_time
;
702 double duration
= extract_float (seconds
);
704 sec
= (int) duration
;
705 usec
= (duration
- sec
) * 1000000;
706 EMACS_GET_TIME (end_time
);
707 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
708 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
711 /* Read until we get an acceptable event. */
714 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
715 NUMBERP (seconds
) ? &end_time
: NULL
);
716 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
721 /* switch-frame events are put off until after the next ASCII
722 character. This is better than signaling an error just because
723 the last characters were typed to a separate minibuffer frame,
724 for example. Eventually, some code which can deal with
725 switch-frame events will read it and process it. */
727 && EVENT_HAS_PARAMETERS (val
)
728 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
730 delayed_switch_frame
= val
;
734 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
736 /* Convert certain symbols to their ASCII equivalents. */
739 Lisp_Object tem
, tem1
;
740 tem
= Fget (val
, Qevent_symbol_element_mask
);
743 tem1
= Fget (Fcar (tem
), Qascii_character
);
744 /* Merge this symbol's modifier bits
745 with the ASCII equivalent of its basic code. */
747 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
751 /* If we don't have a character now, deal with it appropriately. */
756 Vunread_command_events
= Fcons (val
, Qnil
);
757 error ("Non-character input-event");
764 if (! NILP (delayed_switch_frame
))
765 unread_switch_frame
= delayed_switch_frame
;
769 #ifdef HAVE_WINDOW_SYSTEM
770 if (display_hourglass_p
)
779 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
780 doc
: /* Read a character from the command input (keyboard or macro).
781 It is returned as a number.
782 If the character has modifiers, they are resolved and reflected to the
783 character code if possible (e.g. C-SPC -> 0).
785 If the user generates an event which is not a character (i.e. a mouse
786 click or function key event), `read-char' signals an error. As an
787 exception, switch-frame events are put off until non-character events
789 If you want to read non-character events, or ignore them, call
790 `read-event' or `read-char-exclusive' instead.
792 If the optional argument PROMPT is non-nil, display that as a prompt.
793 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
794 input method is turned on in the current buffer, that input method
795 is used for reading a character.
796 If the optional argument SECONDS is non-nil, it should be a number
797 specifying the maximum number of seconds to wait for input. If no
798 input arrives in that time, return nil. SECONDS may be a
799 floating-point value. */)
800 (prompt
, inherit_input_method
, seconds
)
801 Lisp_Object prompt
, inherit_input_method
, seconds
;
806 message_with_string ("%s", prompt
, 0);
807 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
809 return (NILP (val
) ? Qnil
810 : make_number (char_resolve_modifier_mask (XINT (val
))));
813 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
814 doc
: /* Read an event object from the input stream.
815 If the optional argument PROMPT is non-nil, display that as a prompt.
816 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
817 input method is turned on in the current buffer, that input method
818 is used for reading a character.
819 If the optional argument SECONDS is non-nil, it should be a number
820 specifying the maximum number of seconds to wait for input. If no
821 input arrives in that time, return nil. SECONDS may be a
822 floating-point value. */)
823 (prompt
, inherit_input_method
, seconds
)
824 Lisp_Object prompt
, inherit_input_method
, seconds
;
827 message_with_string ("%s", prompt
, 0);
828 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
831 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
832 doc
: /* Read a character from the command input (keyboard or macro).
833 It is returned as a number. Non-character events are ignored.
834 If the character has modifiers, they are resolved and reflected to the
835 character code if possible (e.g. C-SPC -> 0).
837 If the optional argument PROMPT is non-nil, display that as a prompt.
838 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
839 input method is turned on in the current buffer, that input method
840 is used for reading a character.
841 If the optional argument SECONDS is non-nil, it should be a number
842 specifying the maximum number of seconds to wait for input. If no
843 input arrives in that time, return nil. SECONDS may be a
844 floating-point value. */)
845 (prompt
, inherit_input_method
, seconds
)
846 Lisp_Object prompt
, inherit_input_method
, seconds
;
851 message_with_string ("%s", prompt
, 0);
853 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
855 return (NILP (val
) ? Qnil
856 : make_number (char_resolve_modifier_mask (XINT (val
))));
859 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
860 doc
: /* Don't use this yourself. */)
863 register Lisp_Object val
;
865 XSETINT (val
, getc (instream
));
873 /* Return true if the lisp code read using READCHARFUN defines a non-nil
874 `lexical-binding' file variable. After returning, the stream is
875 positioned following the first line, if it is a comment, otherwise
879 lisp_file_lexically_bound_p (readcharfun
)
880 Lisp_Object readcharfun
;
884 /* The first line isn't a comment, just give up. */
890 /* Look for an appropriate file-variable in the first line. */
894 NOMINAL
, AFTER_FIRST_DASH
, AFTER_ASTERIX
,
895 } beg_end_state
= NOMINAL
;
896 int in_file_vars
= 0;
898 #define UPDATE_BEG_END_STATE(ch) \
899 if (beg_end_state == NOMINAL) \
900 beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \
901 else if (beg_end_state == AFTER_FIRST_DASH) \
902 beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \
903 else if (beg_end_state == AFTER_ASTERIX) \
906 in_file_vars = !in_file_vars; \
907 beg_end_state = NOMINAL; \
910 /* Skip until we get to the file vars, if any. */
914 UPDATE_BEG_END_STATE (ch
);
916 while (!in_file_vars
&& ch
!= '\n' && ch
!= EOF
);
920 char var
[100], *var_end
, val
[100], *val_end
;
924 /* Read a variable name. */
925 while (ch
== ' ' || ch
== '\t')
929 while (ch
!= ':' && ch
!= '\n' && ch
!= EOF
)
931 if (var_end
< var
+ sizeof var
- 1)
933 UPDATE_BEG_END_STATE (ch
);
938 && (var_end
[-1] == ' ' || var_end
[-1] == '\t'))
944 /* Read a variable value. */
947 while (ch
== ' ' || ch
== '\t')
951 while (ch
!= ';' && ch
!= '\n' && ch
!= EOF
&& in_file_vars
)
953 if (val_end
< val
+ sizeof val
- 1)
955 UPDATE_BEG_END_STATE (ch
);
959 /* The value was terminated by an end-marker, which
963 && (val_end
[-1] == ' ' || val_end
[-1] == '\t'))
967 if (strcmp (var
, "lexical-binding") == 0)
970 rv
= (strcmp (val
, "nil") != 0);
976 while (ch
!= '\n' && ch
!= EOF
)
984 /* Value is a version number of byte compiled code if the file
985 associated with file descriptor FD is a compiled Lisp file that's
986 safe to load. Only files compiled with Emacs are safe to load.
987 Files compiled with XEmacs can lead to a crash in Fbyte_code
988 because of an incompatible change in the byte compiler. */
999 /* Read the first few bytes from the file, and look for a line
1000 specifying the byte compiler version used. */
1001 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
1006 /* Skip to the next newline, skipping over the initial `ELC'
1007 with NUL bytes following it, but note the version. */
1008 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
1013 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
1020 lseek (fd
, 0, SEEK_SET
);
1025 /* Callback for record_unwind_protect. Restore the old load list OLD,
1026 after loading a file successfully. */
1029 record_load_unwind (old
)
1032 return Vloads_in_progress
= old
;
1035 /* This handler function is used via internal_condition_case_1. */
1038 load_error_handler (data
)
1045 load_warn_old_style_backquotes (file
)
1048 if (!NILP (Vold_style_backquotes
))
1050 Lisp_Object args
[2];
1051 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
1058 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
1059 doc
: /* Return the suffixes that `load' should try if a suffix is \
1061 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
1064 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
1065 while (CONSP (suffixes
))
1067 Lisp_Object exts
= Vload_file_rep_suffixes
;
1068 suffix
= XCAR (suffixes
);
1069 suffixes
= XCDR (suffixes
);
1070 while (CONSP (exts
))
1074 lst
= Fcons (concat2 (suffix
, ext
), lst
);
1077 return Fnreverse (lst
);
1080 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
1081 doc
: /* Execute a file of Lisp code named FILE.
1082 First try FILE with `.elc' appended, then try with `.el',
1083 then try FILE unmodified (the exact suffixes in the exact order are
1084 determined by `load-suffixes'). Environment variable references in
1085 FILE are replaced with their values by calling `substitute-in-file-name'.
1086 This function searches the directories in `load-path'.
1088 If optional second arg NOERROR is non-nil,
1089 report no error if FILE doesn't exist.
1090 Print messages at start and end of loading unless
1091 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
1093 If optional fourth arg NOSUFFIX is non-nil, don't try adding
1094 suffixes `.elc' or `.el' to the specified name FILE.
1095 If optional fifth arg MUST-SUFFIX is non-nil, insist on
1096 the suffix `.elc' or `.el'; don't accept just FILE unless
1097 it ends in one of those suffixes or includes a directory name.
1099 If this function fails to find a file, it may look for different
1100 representations of that file before trying another file.
1101 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
1102 to the file name. Emacs uses this feature mainly to find compressed
1103 versions of files when Auto Compression mode is enabled.
1105 The exact suffixes that this function tries out, in the exact order,
1106 are given by the value of the variable `load-file-rep-suffixes' if
1107 NOSUFFIX is non-nil and by the return value of the function
1108 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
1109 MUST-SUFFIX are nil, this function first tries out the latter suffixes
1110 and then the former.
1112 Loading a file records its definitions, and its `provide' and
1113 `require' calls, in an element of `load-history' whose
1114 car is the file name loaded. See `load-history'.
1116 Return t if the file exists and loads successfully. */)
1117 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
1118 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
1120 register FILE *stream
;
1121 register int fd
= -1;
1122 int count
= SPECPDL_INDEX ();
1123 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1124 Lisp_Object found
, efound
, hist_file_name
;
1125 /* 1 means we printed the ".el is newer" message. */
1127 /* 1 means we are loading a compiled file. */
1129 Lisp_Object handler
;
1139 CHECK_STRING (file
);
1141 /* If file name is magic, call the handler. */
1142 /* This shouldn't be necessary any more now that `openp' handles it right.
1143 handler = Ffind_file_name_handler (file, Qload);
1144 if (!NILP (handler))
1145 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1147 /* Do this after the handler to avoid
1148 the need to gcpro noerror, nomessage and nosuffix.
1149 (Below here, we care only whether they are nil or not.)
1150 The presence of this call is the result of a historical accident:
1151 it used to be in every file-operation and when it got removed
1152 everywhere, it accidentally stayed here. Since then, enough people
1153 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1154 that it seemed risky to remove. */
1155 if (! NILP (noerror
))
1157 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1158 Qt
, load_error_handler
);
1163 file
= Fsubstitute_in_file_name (file
);
1166 /* Avoid weird lossage with null string as arg,
1167 since it would try to load a directory as a Lisp file */
1168 if (SCHARS (file
) > 0)
1170 int size
= SBYTES (file
);
1173 GCPRO2 (file
, found
);
1175 if (! NILP (must_suffix
))
1177 /* Don't insist on adding a suffix if FILE already ends with one. */
1179 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1182 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1184 /* Don't insist on adding a suffix
1185 if the argument includes a directory name. */
1186 else if (! NILP (Ffile_name_directory (file
)))
1190 fd
= openp (Vload_path
, file
,
1191 (!NILP (nosuffix
) ? Qnil
1192 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1193 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1194 tmp
[1] = Vload_file_rep_suffixes
,
1203 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1207 /* Tell startup.el whether or not we found the user's init file. */
1208 if (EQ (Qt
, Vuser_init_file
))
1209 Vuser_init_file
= found
;
1211 /* If FD is -2, that means openp found a magic file. */
1214 if (NILP (Fequal (found
, file
)))
1215 /* If FOUND is a different file name from FILE,
1216 find its handler even if we have already inhibited
1217 the `load' operation on FILE. */
1218 handler
= Ffind_file_name_handler (found
, Qt
);
1220 handler
= Ffind_file_name_handler (found
, Qload
);
1221 if (! NILP (handler
))
1222 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1225 /* Check if we're stuck in a recursive load cycle.
1227 2000-09-21: It's not possible to just check for the file loaded
1228 being a member of Vloads_in_progress. This fails because of the
1229 way the byte compiler currently works; `provide's are not
1230 evaluated, see font-lock.el/jit-lock.el as an example. This
1231 leads to a certain amount of ``normal'' recursion.
1233 Also, just loading a file recursively is not always an error in
1234 the general case; the second load may do something different. */
1238 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1239 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1243 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1245 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1246 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1249 /* All loads are by default dynamic, unless the file itself specifies
1250 otherwise using a file-variable in the first line. This is bound here
1251 so that it takes effect whether or not we use
1252 Vload_source_file_function. */
1253 specbind (Qlexical_binding
, Qnil
);
1255 /* Get the name for load-history. */
1256 hist_file_name
= (! NILP (Vpurify_flag
)
1257 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1258 tmp
[1] = Ffile_name_nondirectory (found
),
1264 /* Check for the presence of old-style quotes and warn about them. */
1265 specbind (Qold_style_backquotes
, Qnil
);
1266 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1268 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1270 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1271 /* Load .elc files directly, but not when they are
1272 remote and have no handler! */
1279 GCPRO3 (file
, found
, hist_file_name
);
1282 && ! (version
= safe_to_load_p (fd
)))
1285 if (!load_dangerous_libraries
)
1289 error ("File `%s' was not compiled in Emacs",
1292 else if (!NILP (nomessage
) && !force_load_messages
)
1293 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1298 efound
= ENCODE_FILE (found
);
1303 stat ((char *)SDATA (efound
), &s1
);
1304 SSET (efound
, SBYTES (efound
) - 1, 0);
1305 result
= stat ((char *)SDATA (efound
), &s2
);
1306 SSET (efound
, SBYTES (efound
) - 1, 'c');
1308 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1310 /* Make the progress messages mention that source is newer. */
1313 /* If we won't print another message, mention this anyway. */
1314 if (!NILP (nomessage
) && !force_load_messages
)
1316 Lisp_Object msg_file
;
1317 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1318 message_with_string ("Source file `%s' newer than byte-compiled file",
1327 /* We are loading a source file (*.el). */
1328 if (!NILP (Vload_source_file_function
))
1334 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1335 NILP (noerror
) ? Qnil
: Qt
,
1336 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1337 return unbind_to (count
, val
);
1341 GCPRO3 (file
, found
, hist_file_name
);
1345 efound
= ENCODE_FILE (found
);
1346 stream
= fopen ((char *) SDATA (efound
), fmode
);
1347 #else /* not WINDOWSNT */
1348 stream
= fdopen (fd
, fmode
);
1349 #endif /* not WINDOWSNT */
1353 error ("Failure to create stdio stream for %s", SDATA (file
));
1356 if (! NILP (Vpurify_flag
))
1357 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1359 if (NILP (nomessage
) || force_load_messages
)
1362 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1365 message_with_string ("Loading %s (source)...", file
, 1);
1367 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1369 else /* The typical case; compiled file newer than source file. */
1370 message_with_string ("Loading %s...", file
, 1);
1373 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1374 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1375 specbind (Qload_file_name
, found
);
1376 specbind (Qinhibit_file_name_operation
, Qnil
);
1377 load_descriptor_list
1378 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1380 specbind (Qload_in_progress
, Qt
);
1383 if (lisp_file_lexically_bound_p (Qget_file_char
))
1384 Fset (Qlexical_binding
, Qt
);
1386 if (! version
|| version
>= 22)
1387 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1388 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1391 /* We can't handle a file which was compiled with
1392 byte-compile-dynamic by older version of Emacs. */
1393 specbind (Qload_force_doc_strings
, Qt
);
1394 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1395 0, Qnil
, Qnil
, Qnil
, Qnil
);
1397 unbind_to (count
, Qnil
);
1399 /* Run any eval-after-load forms for this file */
1400 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1401 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1405 xfree (saved_doc_string
);
1406 saved_doc_string
= 0;
1407 saved_doc_string_size
= 0;
1409 xfree (prev_saved_doc_string
);
1410 prev_saved_doc_string
= 0;
1411 prev_saved_doc_string_size
= 0;
1413 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1416 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1419 message_with_string ("Loading %s (source)...done", file
, 1);
1421 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1423 else /* The typical case; compiled file newer than source file. */
1424 message_with_string ("Loading %s...done", file
, 1);
1431 load_unwind (arg
) /* used as unwind-protect function in load */
1434 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1445 load_descriptor_unwind (oldlist
)
1446 Lisp_Object oldlist
;
1448 load_descriptor_list
= oldlist
;
1452 /* Close all descriptors in use for Floads.
1453 This is used when starting a subprocess. */
1460 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1461 emacs_close (XFASTINT (XCAR (tail
)));
1466 complete_filename_p (pathname
)
1467 Lisp_Object pathname
;
1469 register const unsigned char *s
= SDATA (pathname
);
1470 return (IS_DIRECTORY_SEP (s
[0])
1471 || (SCHARS (pathname
) > 2
1472 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1475 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1476 doc
: /* Search for FILENAME through PATH.
1477 Returns the file's name in absolute form, or nil if not found.
1478 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1479 file name when searching.
1480 If non-nil, PREDICATE is used instead of `file-readable-p'.
1481 PREDICATE can also be an integer to pass to the access(2) function,
1482 in which case file-name-handlers are ignored. */)
1483 (filename
, path
, suffixes
, predicate
)
1484 Lisp_Object filename
, path
, suffixes
, predicate
;
1487 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1488 if (NILP (predicate
) && fd
> 0)
1494 /* Search for a file whose name is STR, looking in directories
1495 in the Lisp list PATH, and trying suffixes from SUFFIX.
1496 On success, returns a file descriptor. On failure, returns -1.
1498 SUFFIXES is a list of strings containing possible suffixes.
1499 The empty suffix is automatically added if the list is empty.
1501 PREDICATE non-nil means don't open the files,
1502 just look for one that satisfies the predicate. In this case,
1503 returns 1 on success. The predicate can be a lisp function or
1504 an integer to pass to `access' (in which case file-name-handlers
1507 If STOREPTR is nonzero, it points to a slot where the name of
1508 the file actually found should be stored as a Lisp string.
1509 nil is stored there on failure.
1511 If the file we find is remote, return -2
1512 but store the found remote file name in *STOREPTR. */
1515 openp (path
, str
, suffixes
, storeptr
, predicate
)
1516 Lisp_Object path
, str
;
1517 Lisp_Object suffixes
;
1518 Lisp_Object
*storeptr
;
1519 Lisp_Object predicate
;
1524 register char *fn
= buf
;
1527 Lisp_Object filename
;
1529 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1530 Lisp_Object string
, tail
, encoded_fn
;
1531 int max_suffix_len
= 0;
1535 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1537 CHECK_STRING_CAR (tail
);
1538 max_suffix_len
= max (max_suffix_len
,
1539 SBYTES (XCAR (tail
)));
1542 string
= filename
= encoded_fn
= Qnil
;
1543 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1548 if (complete_filename_p (str
))
1551 for (; CONSP (path
); path
= XCDR (path
))
1553 filename
= Fexpand_file_name (str
, XCAR (path
));
1554 if (!complete_filename_p (filename
))
1555 /* If there are non-absolute elts in PATH (eg ".") */
1556 /* Of course, this could conceivably lose if luser sets
1557 default-directory to be something non-absolute... */
1559 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1560 if (!complete_filename_p (filename
))
1561 /* Give up on this path element! */
1565 /* Calculate maximum size of any filename made from
1566 this path element/specified file name and any possible suffix. */
1567 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1568 if (fn_size
< want_size
)
1569 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1571 /* Loop over suffixes. */
1572 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1573 CONSP (tail
); tail
= XCDR (tail
))
1575 int lsuffix
= SBYTES (XCAR (tail
));
1576 Lisp_Object handler
;
1579 /* Concatenate path element/specified name with the suffix.
1580 If the directory starts with /:, remove that. */
1581 if (SCHARS (filename
) > 2
1582 && SREF (filename
, 0) == '/'
1583 && SREF (filename
, 1) == ':')
1585 strncpy (fn
, SDATA (filename
) + 2,
1586 SBYTES (filename
) - 2);
1587 fn
[SBYTES (filename
) - 2] = 0;
1591 strncpy (fn
, SDATA (filename
),
1593 fn
[SBYTES (filename
)] = 0;
1596 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1597 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1599 /* Check that the file exists and is not a directory. */
1600 /* We used to only check for handlers on non-absolute file names:
1604 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1605 It's not clear why that was the case and it breaks things like
1606 (load "/bar.el") where the file is actually "/bar.el.gz". */
1607 string
= build_string (fn
);
1608 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1609 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1611 if (NILP (predicate
))
1612 exists
= !NILP (Ffile_readable_p (string
));
1614 exists
= !NILP (call1 (predicate
, string
));
1615 if (exists
&& !NILP (Ffile_directory_p (string
)))
1620 /* We succeeded; return this descriptor and filename. */
1631 encoded_fn
= ENCODE_FILE (string
);
1632 pfn
= SDATA (encoded_fn
);
1633 exists
= (stat (pfn
, &st
) >= 0
1634 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1637 /* Check that we can access or open it. */
1638 if (NATNUMP (predicate
))
1639 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1641 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1645 /* We succeeded; return this descriptor and filename. */
1663 /* Merge the list we've accumulated of globals from the current input source
1664 into the load_history variable. The details depend on whether
1665 the source has an associated file name or not.
1667 FILENAME is the file name that we are loading from.
1668 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1671 build_load_history (filename
, entire
)
1672 Lisp_Object filename
;
1675 register Lisp_Object tail
, prev
, newelt
;
1676 register Lisp_Object tem
, tem2
;
1677 register int foundit
= 0;
1679 tail
= Vload_history
;
1682 while (CONSP (tail
))
1686 /* Find the feature's previous assoc list... */
1687 if (!NILP (Fequal (filename
, Fcar (tem
))))
1691 /* If we're loading the entire file, remove old data. */
1695 Vload_history
= XCDR (tail
);
1697 Fsetcdr (prev
, XCDR (tail
));
1700 /* Otherwise, cons on new symbols that are not already members. */
1703 tem2
= Vcurrent_load_list
;
1705 while (CONSP (tem2
))
1707 newelt
= XCAR (tem2
);
1709 if (NILP (Fmember (newelt
, tem
)))
1710 Fsetcar (tail
, Fcons (XCAR (tem
),
1711 Fcons (newelt
, XCDR (tem
))));
1724 /* If we're loading an entire file, cons the new assoc onto the
1725 front of load-history, the most-recently-loaded position. Also
1726 do this if we didn't find an existing member for the file. */
1727 if (entire
|| !foundit
)
1728 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1733 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1741 readevalloop_1 (old
)
1744 load_convert_to_unibyte
= ! NILP (old
);
1748 /* Signal an `end-of-file' error, if possible with file name
1752 end_of_file_error ()
1754 if (STRINGP (Vload_file_name
))
1755 xsignal1 (Qend_of_file
, Vload_file_name
);
1757 xsignal0 (Qend_of_file
);
1760 /* UNIBYTE specifies how to set load_convert_to_unibyte
1761 for this invocation.
1762 READFUN, if non-nil, is used instead of `read'.
1764 START, END specify region to read in current buffer (from eval-region).
1765 If the input is not from a buffer, they must be nil. */
1768 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1769 printflag
, unibyte
, readfun
, start
, end
)
1770 Lisp_Object readcharfun
;
1772 Lisp_Object sourcename
;
1773 Lisp_Object (*evalfun
) ();
1775 Lisp_Object unibyte
, readfun
;
1776 Lisp_Object start
, end
;
1779 register Lisp_Object val
;
1780 int count
= SPECPDL_INDEX ();
1781 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1782 struct buffer
*b
= 0;
1783 int continue_reading_p
;
1784 Lisp_Object lex_bound
;
1785 /* Nonzero if reading an entire buffer. */
1786 int whole_buffer
= 0;
1787 /* 1 on the first time around. */
1790 if (MARKERP (readcharfun
))
1793 start
= readcharfun
;
1796 if (BUFFERP (readcharfun
))
1797 b
= XBUFFER (readcharfun
);
1798 else if (MARKERP (readcharfun
))
1799 b
= XMARKER (readcharfun
)->buffer
;
1801 /* We assume START is nil when input is not from a buffer. */
1802 if (! NILP (start
) && !b
)
1805 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1806 specbind (Qcurrent_load_list
, Qnil
);
1807 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1808 load_convert_to_unibyte
= !NILP (unibyte
);
1810 /* If lexical binding is active (either because it was specified in
1811 the file's header, or via a buffer-local variable), create an empty
1812 lexical environment, otherwise, turn off lexical binding. */
1813 lex_bound
= find_symbol_value (Qlexical_binding
);
1814 if (NILP (lex_bound
) || EQ (lex_bound
, Qunbound
))
1815 specbind (Qinternal_interpreter_environment
, Qnil
);
1817 specbind (Qinternal_interpreter_environment
, Fcons (Qt
, Qnil
));
1819 GCPRO4 (sourcename
, readfun
, start
, end
);
1821 /* Try to ensure sourcename is a truename, except whilst preloading. */
1822 if (NILP (Vpurify_flag
)
1823 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1824 && !NILP (Ffboundp (Qfile_truename
)))
1825 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1827 LOADHIST_ATTACH (sourcename
);
1829 continue_reading_p
= 1;
1830 while (continue_reading_p
)
1832 int count1
= SPECPDL_INDEX ();
1834 if (b
!= 0 && NILP (b
->name
))
1835 error ("Reading from killed buffer");
1839 /* Switch to the buffer we are reading from. */
1840 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1841 set_buffer_internal (b
);
1843 /* Save point in it. */
1844 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1845 /* Save ZV in it. */
1846 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1847 /* Those get unbound after we read one expression. */
1849 /* Set point and ZV around stuff to be read. */
1852 Fnarrow_to_region (make_number (BEGV
), end
);
1854 /* Just for cleanliness, convert END to a marker
1855 if it is an integer. */
1857 end
= Fpoint_max_marker ();
1860 /* On the first cycle, we can easily test here
1861 whether we are reading the whole buffer. */
1862 if (b
&& first_sexp
)
1863 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1870 while ((c
= READCHAR
) != '\n' && c
!= -1);
1875 unbind_to (count1
, Qnil
);
1879 /* Ignore whitespace here, so we can detect eof. */
1880 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1881 || c
== 0x8a0) /* NBSP */
1884 if (!NILP (Vpurify_flag
) && c
== '(')
1886 record_unwind_protect (unreadpure
, Qnil
);
1887 val
= read_list (-1, readcharfun
);
1892 read_objects
= Qnil
;
1893 if (!NILP (readfun
))
1895 val
= call1 (readfun
, readcharfun
);
1897 /* If READCHARFUN has set point to ZV, we should
1898 stop reading, even if the form read sets point
1899 to a different value when evaluated. */
1900 if (BUFFERP (readcharfun
))
1902 struct buffer
*b
= XBUFFER (readcharfun
);
1903 if (BUF_PT (b
) == BUF_ZV (b
))
1904 continue_reading_p
= 0;
1907 else if (! NILP (Vload_read_function
))
1908 val
= call1 (Vload_read_function
, readcharfun
);
1910 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1913 if (!NILP (start
) && continue_reading_p
)
1914 start
= Fpoint_marker ();
1916 /* Restore saved point and BEGV. */
1917 unbind_to (count1
, Qnil
);
1919 /* Now eval what we just read. */
1920 val
= (*evalfun
) (val
);
1924 Vvalues
= Fcons (val
, Vvalues
);
1925 if (EQ (Vstandard_output
, Qt
))
1934 build_load_history (sourcename
,
1935 stream
|| whole_buffer
);
1939 unbind_to (count
, Qnil
);
1942 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1943 doc
: /* Execute the current buffer as Lisp code.
1944 When called from a Lisp program (i.e., not interactively), this
1945 function accepts up to five optional arguments:
1946 BUFFER is the buffer to evaluate (nil means use current buffer).
1947 PRINTFLAG controls printing of output:
1948 A value of nil means discard it; anything else is stream for print.
1949 FILENAME specifies the file name to use for `load-history'.
1950 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1952 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1953 functions should work normally even if PRINTFLAG is nil.
1955 This function preserves the position of point. */)
1956 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1957 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1959 int count
= SPECPDL_INDEX ();
1960 Lisp_Object tem
, buf
;
1963 buf
= Fcurrent_buffer ();
1965 buf
= Fget_buffer (buffer
);
1967 error ("No such buffer");
1969 if (NILP (printflag
) && NILP (do_allow_print
))
1974 if (NILP (filename
))
1975 filename
= XBUFFER (buf
)->filename
;
1977 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1978 specbind (Qstandard_output
, tem
);
1979 specbind (Qlexical_binding
, Qnil
);
1980 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1981 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1982 if (lisp_file_lexically_bound_p (buf
))
1983 Fset (Qlexical_binding
, Qt
);
1984 readevalloop (buf
, 0, filename
, Feval
,
1985 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1986 unbind_to (count
, Qnil
);
1991 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1992 doc
: /* Execute the region as Lisp code.
1993 When called from programs, expects two arguments,
1994 giving starting and ending indices in the current buffer
1995 of the text to be executed.
1996 Programs can pass third argument PRINTFLAG which controls output:
1997 A value of nil means discard it; anything else is stream for printing it.
1998 Also the fourth argument READ-FUNCTION, if non-nil, is used
1999 instead of `read' to read each expression. It gets one argument
2000 which is the input stream for reading characters.
2002 This function does not move point. */)
2003 (start
, end
, printflag
, read_function
)
2004 Lisp_Object start
, end
, printflag
, read_function
;
2006 int count
= SPECPDL_INDEX ();
2007 Lisp_Object tem
, cbuf
;
2009 cbuf
= Fcurrent_buffer ();
2011 if (NILP (printflag
))
2015 specbind (Qstandard_output
, tem
);
2016 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
2018 /* readevalloop calls functions which check the type of start and end. */
2019 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
2020 !NILP (printflag
), Qnil
, read_function
,
2023 return unbind_to (count
, Qnil
);
2027 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
2028 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
2029 If STREAM is nil, use the value of `standard-input' (which see).
2030 STREAM or the value of `standard-input' may be:
2031 a buffer (read from point and advance it)
2032 a marker (read from where it points and advance it)
2033 a function (call it with no arguments for each character,
2034 call it with a char as argument to push a char back)
2035 a string (takes text from string, starting at the beginning)
2036 t (read text line using minibuffer and use it, or read from
2037 standard input in batch mode). */)
2042 stream
= Vstandard_input
;
2043 if (EQ (stream
, Qt
))
2044 stream
= Qread_char
;
2045 if (EQ (stream
, Qread_char
))
2046 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
2048 return read_internal_start (stream
, Qnil
, Qnil
);
2051 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
2052 doc
: /* Read one Lisp expression which is represented as text by STRING.
2053 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
2054 START and END optionally delimit a substring of STRING from which to read;
2055 they default to 0 and (length STRING) respectively. */)
2056 (string
, start
, end
)
2057 Lisp_Object string
, start
, end
;
2060 CHECK_STRING (string
);
2061 /* read_internal_start sets read_from_string_index. */
2062 ret
= read_internal_start (string
, start
, end
);
2063 return Fcons (ret
, make_number (read_from_string_index
));
2066 /* Function to set up the global context we need in toplevel read
2069 read_internal_start (stream
, start
, end
)
2071 Lisp_Object start
; /* Only used when stream is a string. */
2072 Lisp_Object end
; /* Only used when stream is a string. */
2077 new_backquote_flag
= 0;
2078 read_objects
= Qnil
;
2079 if (EQ (Vread_with_symbol_positions
, Qt
)
2080 || EQ (Vread_with_symbol_positions
, stream
))
2081 Vread_symbol_positions_list
= Qnil
;
2083 if (STRINGP (stream
)
2084 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
2086 int startval
, endval
;
2089 if (STRINGP (stream
))
2092 string
= XCAR (stream
);
2095 endval
= SCHARS (string
);
2099 endval
= XINT (end
);
2100 if (endval
< 0 || endval
> SCHARS (string
))
2101 args_out_of_range (string
, end
);
2108 CHECK_NUMBER (start
);
2109 startval
= XINT (start
);
2110 if (startval
< 0 || startval
> endval
)
2111 args_out_of_range (string
, start
);
2113 read_from_string_index
= startval
;
2114 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
2115 read_from_string_limit
= endval
;
2118 retval
= read0 (stream
);
2119 if (EQ (Vread_with_symbol_positions
, Qt
)
2120 || EQ (Vread_with_symbol_positions
, stream
))
2121 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
2126 /* Signal Qinvalid_read_syntax error.
2127 S is error string of length N (if > 0) */
2130 invalid_syntax (s
, n
)
2136 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2140 /* Use this for recursive reads, in contexts where internal tokens
2145 Lisp_Object readcharfun
;
2147 register Lisp_Object val
;
2150 val
= read1 (readcharfun
, &c
, 0);
2154 xsignal1 (Qinvalid_read_syntax
,
2155 Fmake_string (make_number (1), make_number (c
)));
2158 static int read_buffer_size
;
2159 static char *read_buffer
;
2161 /* Read a \-escape sequence, assuming we already read the `\'.
2162 If the escape sequence forces unibyte, return eight-bit char. */
2165 read_escape (readcharfun
, stringp
)
2166 Lisp_Object readcharfun
;
2169 register int c
= READCHAR
;
2170 /* \u allows up to four hex digits, \U up to eight. Default to the
2171 behavior for \u, and change this value in the case that \U is seen. */
2172 int unicode_hex_count
= 4;
2177 end_of_file_error ();
2207 error ("Invalid escape character syntax");
2210 c
= read_escape (readcharfun
, 0);
2211 return c
| meta_modifier
;
2216 error ("Invalid escape character syntax");
2219 c
= read_escape (readcharfun
, 0);
2220 return c
| shift_modifier
;
2225 error ("Invalid escape character syntax");
2228 c
= read_escape (readcharfun
, 0);
2229 return c
| hyper_modifier
;
2234 error ("Invalid escape character syntax");
2237 c
= read_escape (readcharfun
, 0);
2238 return c
| alt_modifier
;
2242 if (stringp
|| c
!= '-')
2249 c
= read_escape (readcharfun
, 0);
2250 return c
| super_modifier
;
2255 error ("Invalid escape character syntax");
2259 c
= read_escape (readcharfun
, 0);
2260 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2261 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2262 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2263 return c
| ctrl_modifier
;
2264 /* ASCII control chars are made from letters (both cases),
2265 as well as the non-letters within 0100...0137. */
2266 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2267 return (c
& (037 | ~0177));
2268 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2269 return (c
& (037 | ~0177));
2271 return c
| ctrl_modifier
;
2281 /* An octal escape, as in ANSI C. */
2283 register int i
= c
- '0';
2284 register int count
= 0;
2287 if ((c
= READCHAR
) >= '0' && c
<= '7')
2299 if (i
>= 0x80 && i
< 0x100)
2300 i
= BYTE8_TO_CHAR (i
);
2305 /* A hex escape, as in ANSI C. */
2312 if (c
>= '0' && c
<= '9')
2317 else if ((c
>= 'a' && c
<= 'f')
2318 || (c
>= 'A' && c
<= 'F'))
2321 if (c
>= 'a' && c
<= 'f')
2334 if (count
< 3 && i
>= 0x80)
2335 return BYTE8_TO_CHAR (i
);
2340 /* Post-Unicode-2.0: Up to eight hex chars. */
2341 unicode_hex_count
= 8;
2344 /* A Unicode escape. We only permit them in strings and characters,
2345 not arbitrarily in the source code, as in some other languages. */
2350 while (++count
<= unicode_hex_count
)
2353 /* isdigit and isalpha may be locale-specific, which we don't
2355 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2356 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2357 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2360 error ("Non-hex digit used for Unicode escape");
2365 error ("Non-Unicode character: 0x%x", i
);
2374 /* Read an integer in radix RADIX using READCHARFUN to read
2375 characters. RADIX must be in the interval [2..36]; if it isn't, a
2376 read error is signaled . Value is the integer read. Signals an
2377 error if encountering invalid read syntax or if RADIX is out of
2381 read_integer (readcharfun
, radix
)
2382 Lisp_Object readcharfun
;
2385 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2386 /* We use a floating point number because */
2389 if (radix
< 2 || radix
> 36)
2393 number
= ndigits
= invalid_p
= 0;
2409 if (c
>= '0' && c
<= '9')
2411 else if (c
>= 'a' && c
<= 'z')
2412 digit
= c
- 'a' + 10;
2413 else if (c
>= 'A' && c
<= 'Z')
2414 digit
= c
- 'A' + 10;
2421 if (digit
< 0 || digit
>= radix
)
2424 number
= radix
* number
+ digit
;
2430 if (ndigits
== 0 || invalid_p
)
2433 sprintf (buf
, "integer, radix %d", radix
);
2434 invalid_syntax (buf
, 0);
2437 return make_fixnum_or_float (sign
* number
);
2441 /* If the next token is ')' or ']' or '.', we store that character
2442 in *PCH and the return value is not interesting. Else, we store
2443 zero in *PCH and we read and return one lisp object.
2445 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2448 read1 (readcharfun
, pch
, first_in_list
)
2449 register Lisp_Object readcharfun
;
2454 int uninterned_symbol
= 0;
2462 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2464 end_of_file_error ();
2469 return read_list (0, readcharfun
);
2472 return read_vector (readcharfun
, 0);
2488 /* Accept extended format for hashtables (extensible to
2490 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2491 Lisp_Object tmp
= read_list (0, readcharfun
);
2492 Lisp_Object head
= CAR_SAFE (tmp
);
2493 Lisp_Object data
= Qnil
;
2494 Lisp_Object val
= Qnil
;
2495 /* The size is 2 * number of allowed keywords to
2497 Lisp_Object params
[10];
2499 Lisp_Object key
= Qnil
;
2500 int param_count
= 0;
2502 if (!EQ (head
, Qhash_table
))
2503 error ("Invalid extended read marker at head of #s list "
2504 "(only hash-table allowed)");
2506 tmp
= CDR_SAFE (tmp
);
2508 /* This is repetitive but fast and simple. */
2509 params
[param_count
] = QCsize
;
2510 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2511 if (!NILP (params
[param_count
+1]))
2514 params
[param_count
] = QCtest
;
2515 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2516 if (!NILP (params
[param_count
+1]))
2519 params
[param_count
] = QCweakness
;
2520 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2521 if (!NILP (params
[param_count
+1]))
2524 params
[param_count
] = QCrehash_size
;
2525 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2526 if (!NILP (params
[param_count
+1]))
2529 params
[param_count
] = QCrehash_threshold
;
2530 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2531 if (!NILP (params
[param_count
+1]))
2534 /* This is the hashtable data. */
2535 data
= Fplist_get (tmp
, Qdata
);
2537 /* Now use params to make a new hashtable and fill it. */
2538 ht
= Fmake_hash_table (param_count
, params
);
2540 while (CONSP (data
))
2545 error ("Odd number of elements in hashtable data");
2548 Fputhash (key
, val
, ht
);
2560 tmp
= read_vector (readcharfun
, 0);
2561 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2562 error ("Invalid size char-table");
2563 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2574 tmp
= read_vector (readcharfun
, 0);
2575 if (!INTEGERP (AREF (tmp
, 0)))
2576 error ("Invalid depth in char-table");
2577 depth
= XINT (AREF (tmp
, 0));
2578 if (depth
< 1 || depth
> 3)
2579 error ("Invalid depth in char-table");
2580 size
= XVECTOR (tmp
)->size
- 2;
2581 if (chartab_size
[depth
] != size
)
2582 error ("Invalid size char-table");
2583 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2586 invalid_syntax ("#^^", 3);
2588 invalid_syntax ("#^", 2);
2593 length
= read1 (readcharfun
, pch
, first_in_list
);
2597 Lisp_Object tmp
, val
;
2599 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2600 / BOOL_VECTOR_BITS_PER_CHAR
);
2603 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2604 if (STRING_MULTIBYTE (tmp
)
2605 || (size_in_chars
!= SCHARS (tmp
)
2606 /* We used to print 1 char too many
2607 when the number of bits was a multiple of 8.
2608 Accept such input in case it came from an old
2610 && ! (XFASTINT (length
)
2611 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2612 invalid_syntax ("#&...", 5);
2614 val
= Fmake_bool_vector (length
, Qnil
);
2615 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2617 /* Clear the extraneous bits in the last byte. */
2618 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2619 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2620 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2623 invalid_syntax ("#&...", 5);
2626 /* `function vector' objects, including byte-compiled functions. */
2627 return read_vector (readcharfun
, 1);
2631 struct gcpro gcpro1
;
2634 /* Read the string itself. */
2635 tmp
= read1 (readcharfun
, &ch
, 0);
2636 if (ch
!= 0 || !STRINGP (tmp
))
2637 invalid_syntax ("#", 1);
2639 /* Read the intervals and their properties. */
2642 Lisp_Object beg
, end
, plist
;
2644 beg
= read1 (readcharfun
, &ch
, 0);
2649 end
= read1 (readcharfun
, &ch
, 0);
2651 plist
= read1 (readcharfun
, &ch
, 0);
2653 invalid_syntax ("Invalid string property list", 0);
2654 Fset_text_properties (beg
, end
, plist
, tmp
);
2660 /* #@NUMBER is used to skip NUMBER following characters.
2661 That's used in .elc files to skip over doc strings
2662 and function definitions. */
2668 /* Read a decimal integer. */
2669 while ((c
= READCHAR
) >= 0
2670 && c
>= '0' && c
<= '9')
2678 if (load_force_doc_strings
2679 && (EQ (readcharfun
, Qget_file_char
)
2680 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2682 /* If we are supposed to force doc strings into core right now,
2683 record the last string that we skipped,
2684 and record where in the file it comes from. */
2686 /* But first exchange saved_doc_string
2687 with prev_saved_doc_string, so we save two strings. */
2689 char *temp
= saved_doc_string
;
2690 int temp_size
= saved_doc_string_size
;
2691 file_offset temp_pos
= saved_doc_string_position
;
2692 int temp_len
= saved_doc_string_length
;
2694 saved_doc_string
= prev_saved_doc_string
;
2695 saved_doc_string_size
= prev_saved_doc_string_size
;
2696 saved_doc_string_position
= prev_saved_doc_string_position
;
2697 saved_doc_string_length
= prev_saved_doc_string_length
;
2699 prev_saved_doc_string
= temp
;
2700 prev_saved_doc_string_size
= temp_size
;
2701 prev_saved_doc_string_position
= temp_pos
;
2702 prev_saved_doc_string_length
= temp_len
;
2705 if (saved_doc_string_size
== 0)
2707 saved_doc_string_size
= nskip
+ 100;
2708 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2710 if (nskip
> saved_doc_string_size
)
2712 saved_doc_string_size
= nskip
+ 100;
2713 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2714 saved_doc_string_size
);
2717 saved_doc_string_position
= file_tell (instream
);
2719 /* Copy that many characters into saved_doc_string. */
2720 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2721 saved_doc_string
[i
] = c
= READCHAR
;
2723 saved_doc_string_length
= i
;
2727 /* Skip that many characters. */
2728 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2737 /* #! appears at the beginning of an executable file.
2738 Skip the first line. */
2739 while (c
!= '\n' && c
>= 0)
2744 return Vload_file_name
;
2746 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2747 /* #:foo is the uninterned symbol named foo. */
2750 uninterned_symbol
= 1;
2754 /* Reader forms that can reuse previously read objects. */
2755 if (c
>= '0' && c
<= '9')
2760 /* Read a non-negative integer. */
2761 while (c
>= '0' && c
<= '9')
2767 /* #n=object returns object, but associates it with n for #n#. */
2768 if (c
== '=' && !NILP (Vread_circle
))
2770 /* Make a placeholder for #n# to use temporarily */
2771 Lisp_Object placeholder
;
2774 placeholder
= Fcons (Qnil
, Qnil
);
2775 cell
= Fcons (make_number (n
), placeholder
);
2776 read_objects
= Fcons (cell
, read_objects
);
2778 /* Read the object itself. */
2779 tem
= read0 (readcharfun
);
2781 /* Now put it everywhere the placeholder was... */
2782 substitute_object_in_subtree (tem
, placeholder
);
2784 /* ...and #n# will use the real value from now on. */
2785 Fsetcdr (cell
, tem
);
2789 /* #n# returns a previously read object. */
2790 if (c
== '#' && !NILP (Vread_circle
))
2792 tem
= Fassq (make_number (n
), read_objects
);
2795 /* Fall through to error message. */
2797 else if (c
== 'r' || c
== 'R')
2798 return read_integer (readcharfun
, n
);
2800 /* Fall through to error message. */
2802 else if (c
== 'x' || c
== 'X')
2803 return read_integer (readcharfun
, 16);
2804 else if (c
== 'o' || c
== 'O')
2805 return read_integer (readcharfun
, 8);
2806 else if (c
== 'b' || c
== 'B')
2807 return read_integer (readcharfun
, 2);
2810 invalid_syntax ("#", 1);
2813 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2818 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2824 Vold_style_backquotes
= Qt
;
2831 new_backquote_flag
++;
2832 value
= read0 (readcharfun
);
2833 new_backquote_flag
--;
2835 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2839 if (new_backquote_flag
)
2841 Lisp_Object comma_type
= Qnil
;
2846 comma_type
= Qcomma_at
;
2848 comma_type
= Qcomma_dot
;
2851 if (ch
>= 0) UNREAD (ch
);
2852 comma_type
= Qcomma
;
2855 new_backquote_flag
--;
2856 value
= read0 (readcharfun
);
2857 new_backquote_flag
++;
2858 return Fcons (comma_type
, Fcons (value
, Qnil
));
2862 Vold_style_backquotes
= Qt
;
2874 end_of_file_error ();
2876 /* Accept `single space' syntax like (list ? x) where the
2877 whitespace character is SPC or TAB.
2878 Other literal whitespace like NL, CR, and FF are not accepted,
2879 as there are well-established escape sequences for these. */
2880 if (c
== ' ' || c
== '\t')
2881 return make_number (c
);
2884 c
= read_escape (readcharfun
, 0);
2885 modifiers
= c
& CHAR_MODIFIER_MASK
;
2886 c
&= ~CHAR_MODIFIER_MASK
;
2887 if (CHAR_BYTE8_P (c
))
2888 c
= CHAR_TO_BYTE8 (c
);
2891 next_char
= READCHAR
;
2892 if (next_char
== '.')
2894 /* Only a dotted-pair dot is valid after a char constant. */
2895 int next_next_char
= READCHAR
;
2896 UNREAD (next_next_char
);
2898 ok
= (next_next_char
<= 040
2899 || (next_next_char
< 0200
2900 && (index ("\"';([#?", next_next_char
)
2901 || (!first_in_list
&& next_next_char
== '`')
2902 || (new_backquote_flag
&& next_next_char
== ','))));
2906 ok
= (next_char
<= 040
2907 || (next_char
< 0200
2908 && (index ("\"';()[]#?", next_char
)
2909 || (!first_in_list
&& next_char
== '`')
2910 || (new_backquote_flag
&& next_char
== ','))));
2914 return make_number (c
);
2916 invalid_syntax ("?", 1);
2921 char *p
= read_buffer
;
2922 char *end
= read_buffer
+ read_buffer_size
;
2924 /* Nonzero if we saw an escape sequence specifying
2925 a multibyte character. */
2926 int force_multibyte
= 0;
2927 /* Nonzero if we saw an escape sequence specifying
2928 a single-byte character. */
2929 int force_singlebyte
= 0;
2933 while ((c
= READCHAR
) >= 0
2936 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2938 int offset
= p
- read_buffer
;
2939 read_buffer
= (char *) xrealloc (read_buffer
,
2940 read_buffer_size
*= 2);
2941 p
= read_buffer
+ offset
;
2942 end
= read_buffer
+ read_buffer_size
;
2949 c
= read_escape (readcharfun
, 1);
2951 /* C is -1 if \ newline has just been seen */
2954 if (p
== read_buffer
)
2959 modifiers
= c
& CHAR_MODIFIER_MASK
;
2960 c
= c
& ~CHAR_MODIFIER_MASK
;
2962 if (CHAR_BYTE8_P (c
))
2963 force_singlebyte
= 1;
2964 else if (! ASCII_CHAR_P (c
))
2965 force_multibyte
= 1;
2966 else /* i.e. ASCII_CHAR_P (c) */
2968 /* Allow `\C- ' and `\C-?'. */
2969 if (modifiers
== CHAR_CTL
)
2972 c
= 0, modifiers
= 0;
2974 c
= 127, modifiers
= 0;
2976 if (modifiers
& CHAR_SHIFT
)
2978 /* Shift modifier is valid only with [A-Za-z]. */
2979 if (c
>= 'A' && c
<= 'Z')
2980 modifiers
&= ~CHAR_SHIFT
;
2981 else if (c
>= 'a' && c
<= 'z')
2982 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2985 if (modifiers
& CHAR_META
)
2987 /* Move the meta bit to the right place for a
2989 modifiers
&= ~CHAR_META
;
2990 c
= BYTE8_TO_CHAR (c
| 0x80);
2991 force_singlebyte
= 1;
2995 /* Any modifiers remaining are invalid. */
2997 error ("Invalid modifier in string");
2998 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3002 p
+= CHAR_STRING (c
, (unsigned char *) p
);
3003 if (CHAR_BYTE8_P (c
))
3004 force_singlebyte
= 1;
3005 else if (! ASCII_CHAR_P (c
))
3006 force_multibyte
= 1;
3012 end_of_file_error ();
3014 /* If purifying, and string starts with \ newline,
3015 return zero instead. This is for doc strings
3016 that we are really going to find in etc/DOC.nn.nn */
3017 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
3018 return make_number (0);
3020 if (force_multibyte
)
3021 /* READ_BUFFER already contains valid multibyte forms. */
3023 else if (force_singlebyte
)
3025 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
3026 p
= read_buffer
+ nchars
;
3029 /* Otherwise, READ_BUFFER contains only ASCII. */
3032 /* We want readchar_count to be the number of characters, not
3033 bytes. Hence we adjust for multibyte characters in the
3034 string. ... But it doesn't seem to be necessary, because
3035 READCHAR *does* read multibyte characters from buffers. */
3036 /* readchar_count -= (p - read_buffer) - nchars; */
3038 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
3040 || (p
- read_buffer
!= nchars
)));
3041 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
3043 || (p
- read_buffer
!= nchars
)));
3048 int next_char
= READCHAR
;
3051 if (next_char
<= 040
3052 || (next_char
< 0200
3053 && (index ("\"';([#?", next_char
)
3054 || (!first_in_list
&& next_char
== '`')
3055 || (new_backquote_flag
&& next_char
== ','))))
3061 /* Otherwise, we fall through! Note that the atom-reading loop
3062 below will now loop at least once, assuring that we will not
3063 try to UNREAD two characters in a row. */
3067 if (c
<= 040) goto retry
;
3068 if (c
== 0x8a0) /* NBSP */
3071 char *p
= read_buffer
;
3075 char *end
= read_buffer
+ read_buffer_size
;
3078 && c
!= 0x8a0 /* NBSP */
3080 || (!index ("\"';()[]#", c
)
3081 && !(!first_in_list
&& c
== '`')
3082 && !(new_backquote_flag
&& c
== ','))))
3084 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
3086 int offset
= p
- read_buffer
;
3087 read_buffer
= (char *) xrealloc (read_buffer
,
3088 read_buffer_size
*= 2);
3089 p
= read_buffer
+ offset
;
3090 end
= read_buffer
+ read_buffer_size
;
3097 end_of_file_error ();
3102 p
+= CHAR_STRING (c
, p
);
3110 int offset
= p
- read_buffer
;
3111 read_buffer
= (char *) xrealloc (read_buffer
,
3112 read_buffer_size
*= 2);
3113 p
= read_buffer
+ offset
;
3114 end
= read_buffer
+ read_buffer_size
;
3121 if (!quoted
&& !uninterned_symbol
)
3125 if (*p1
== '+' || *p1
== '-') p1
++;
3126 /* Is it an integer? */
3129 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
3130 /* Integers can have trailing decimal points. */
3131 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
3133 /* It is an integer. */
3138 /* EMACS_INT n = atol (read_buffer); */
3139 char *endptr
= NULL
;
3140 EMACS_INT n
= (errno
= 0,
3141 strtol (read_buffer
, &endptr
, 10));
3142 if (errno
== ERANGE
&& endptr
)
3145 = Fcons (make_string (read_buffer
,
3146 endptr
- read_buffer
),
3148 xsignal (Qoverflow_error
, args
);
3150 return make_fixnum_or_float (n
);
3154 if (isfloat_string (read_buffer
, 0))
3156 /* Compute NaN and infinities using 0.0 in a variable,
3157 to cope with compilers that think they are smarter
3163 /* Negate the value ourselves. This treats 0, NaNs,
3164 and infinity properly on IEEE floating point hosts,
3165 and works around a common bug where atof ("-0.0")
3167 int negative
= read_buffer
[0] == '-';
3169 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3170 returns 1, is if the input ends in e+INF or e+NaN. */
3177 value
= zero
/ zero
;
3179 /* If that made a "negative" NaN, negate it. */
3183 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
3186 u_minus_zero
.d
= - 0.0;
3187 for (i
= 0; i
< sizeof (double); i
++)
3188 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
3194 /* Now VALUE is a positive NaN. */
3197 value
= atof (read_buffer
+ negative
);
3201 return make_float (negative
? - value
: value
);
3205 Lisp_Object name
, result
;
3206 EMACS_INT nbytes
= p
- read_buffer
;
3208 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3211 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3212 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3214 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3215 result
= (uninterned_symbol
? Fmake_symbol (name
)
3216 : Fintern (name
, Qnil
));
3218 if (EQ (Vread_with_symbol_positions
, Qt
)
3219 || EQ (Vread_with_symbol_positions
, readcharfun
))
3220 Vread_symbol_positions_list
=
3221 /* Kind of a hack; this will probably fail if characters
3222 in the symbol name were escaped. Not really a big
3224 Fcons (Fcons (result
,
3225 make_number (readchar_count
3226 - XFASTINT (Flength (Fsymbol_name (result
))))),
3227 Vread_symbol_positions_list
);
3235 /* List of nodes we've seen during substitute_object_in_subtree. */
3236 static Lisp_Object seen_list
;
3239 substitute_object_in_subtree (object
, placeholder
)
3241 Lisp_Object placeholder
;
3243 Lisp_Object check_object
;
3245 /* We haven't seen any objects when we start. */
3248 /* Make all the substitutions. */
3250 = substitute_object_recurse (object
, placeholder
, object
);
3252 /* Clear seen_list because we're done with it. */
3255 /* The returned object here is expected to always eq the
3257 if (!EQ (check_object
, object
))
3258 error ("Unexpected mutation error in reader");
3261 /* Feval doesn't get called from here, so no gc protection is needed. */
3262 #define SUBSTITUTE(get_val, set_val) \
3264 Lisp_Object old_value = get_val; \
3265 Lisp_Object true_value \
3266 = substitute_object_recurse (object, placeholder, \
3269 if (!EQ (old_value, true_value)) \
3276 substitute_object_recurse (object
, placeholder
, subtree
)
3278 Lisp_Object placeholder
;
3279 Lisp_Object subtree
;
3281 /* If we find the placeholder, return the target object. */
3282 if (EQ (placeholder
, subtree
))
3285 /* If we've been to this node before, don't explore it again. */
3286 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3289 /* If this node can be the entry point to a cycle, remember that
3290 we've seen it. It can only be such an entry point if it was made
3291 by #n=, which means that we can find it as a value in
3293 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3294 seen_list
= Fcons (subtree
, seen_list
);
3296 /* Recurse according to subtree's type.
3297 Every branch must return a Lisp_Object. */
3298 switch (XTYPE (subtree
))
3300 case Lisp_Vectorlike
:
3303 if (BOOL_VECTOR_P (subtree
))
3304 return subtree
; /* No sub-objects anyway. */
3305 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3306 || COMPILEDP (subtree
))
3307 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3308 else if (VECTORP (subtree
))
3309 length
= ASIZE (subtree
);
3311 /* An unknown pseudovector may contain non-Lisp fields, so we
3312 can't just blindly traverse all its fields. We used to call
3313 `Flength' which signaled `sequencep', so I just preserved this
3315 wrong_type_argument (Qsequencep
, subtree
);
3317 for (i
= 0; i
< length
; i
++)
3318 SUBSTITUTE (AREF (subtree
, i
),
3319 ASET (subtree
, i
, true_value
));
3325 SUBSTITUTE (XCAR (subtree
),
3326 XSETCAR (subtree
, true_value
));
3327 SUBSTITUTE (XCDR (subtree
),
3328 XSETCDR (subtree
, true_value
));
3334 /* Check for text properties in each interval.
3335 substitute_in_interval contains part of the logic. */
3337 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3338 Lisp_Object arg
= Fcons (object
, placeholder
);
3340 traverse_intervals_noorder (root_interval
,
3341 &substitute_in_interval
, arg
);
3346 /* Other types don't recurse any further. */
3352 /* Helper function for substitute_object_recurse. */
3354 substitute_in_interval (interval
, arg
)
3358 Lisp_Object object
= Fcar (arg
);
3359 Lisp_Object placeholder
= Fcdr (arg
);
3361 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3372 isfloat_string (cp
, ignore_trailing
)
3374 int ignore_trailing
;
3381 if (*cp
== '+' || *cp
== '-')
3384 if (*cp
>= '0' && *cp
<= '9')
3387 while (*cp
>= '0' && *cp
<= '9')
3395 if (*cp
>= '0' && *cp
<= '9')
3398 while (*cp
>= '0' && *cp
<= '9')
3401 if (*cp
== 'e' || *cp
== 'E')
3405 if (*cp
== '+' || *cp
== '-')
3409 if (*cp
>= '0' && *cp
<= '9')
3412 while (*cp
>= '0' && *cp
<= '9')
3415 else if (cp
== start
)
3417 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3422 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3428 return ((ignore_trailing
3429 || (*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3430 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3431 || state
== (DOT_CHAR
|TRAIL_INT
)
3432 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3433 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3434 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3439 read_vector (readcharfun
, read_funvec
)
3440 Lisp_Object readcharfun
;
3445 register Lisp_Object
*ptr
;
3446 register Lisp_Object tem
, item
, vector
;
3447 register struct Lisp_Cons
*otem
;
3449 /* If we're reading a funvec object we start out assuming it's also a
3450 byte-code object (a subset of funvecs), so we can do any special
3451 processing needed. If it's just an ordinary funvec object, we'll
3452 realize that as soon as we've read the first element. */
3453 int read_bytecode
= read_funvec
;
3455 tem
= read_list (1, readcharfun
);
3456 len
= Flength (tem
);
3457 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3459 size
= XVECTOR (vector
)->size
;
3460 ptr
= XVECTOR (vector
)->contents
;
3461 for (i
= 0; i
< size
; i
++)
3465 /* If READ_BYTECODE is set, check whether this is really a byte-code
3466 object, or just an ordinary `funvec' object -- non-byte-code
3467 funvec objects use the same reader syntax. We can tell from the
3468 first element which one it is. */
3469 if (read_bytecode
&& i
== 0 && ! FUNVEC_COMPILED_TAG_P (item
))
3470 read_bytecode
= 0; /* Nope. */
3472 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3473 bytecode object, the docstring containing the bytecode and
3474 constants values must be treated as unibyte and passed to
3475 Fread, to get the actual bytecode string and constants vector. */
3476 if (read_bytecode
&& load_force_doc_strings
)
3478 if (i
== COMPILED_BYTECODE
)
3480 if (!STRINGP (item
))
3481 error ("Invalid byte code");
3483 /* Delay handling the bytecode slot until we know whether
3484 it is lazily-loaded (we can tell by whether the
3485 constants slot is nil). */
3486 ptr
[COMPILED_CONSTANTS
] = item
;
3489 else if (i
== COMPILED_CONSTANTS
)
3491 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3495 /* Coerce string to unibyte (like string-as-unibyte,
3496 but without generating extra garbage and
3497 guaranteeing no change in the contents). */
3498 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3499 STRING_SET_UNIBYTE (bytestr
);
3501 item
= Fread (Fcons (bytestr
, readcharfun
));
3503 error ("Invalid byte code");
3505 otem
= XCONS (item
);
3506 bytestr
= XCAR (item
);
3511 /* Now handle the bytecode slot. */
3512 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3514 else if (i
== COMPILED_DOC_STRING
3516 && ! STRING_MULTIBYTE (item
))
3518 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3519 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3521 item
= Fstring_as_multibyte (item
);
3524 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3530 if (read_bytecode
&& size
>= 4)
3531 /* Convert this vector to a bytecode object. */
3532 vector
= Fmake_byte_code (size
, XVECTOR (vector
)->contents
);
3533 else if (read_funvec
&& size
>= 1)
3534 /* Convert this vector to an ordinary funvec object. */
3535 XSETFUNVEC (vector
, XVECTOR (vector
));
3540 /* FLAG = 1 means check for ] to terminate rather than ) and .
3541 FLAG = -1 means check for starting with defun
3542 and make structure pure. */
3545 read_list (flag
, readcharfun
)
3547 register Lisp_Object readcharfun
;
3549 /* -1 means check next element for defun,
3550 0 means don't check,
3551 1 means already checked and found defun. */
3552 int defunflag
= flag
< 0 ? -1 : 0;
3553 Lisp_Object val
, tail
;
3554 register Lisp_Object elt
, tem
;
3555 struct gcpro gcpro1
, gcpro2
;
3556 /* 0 is the normal case.
3557 1 means this list is a doc reference; replace it with the number 0.
3558 2 means this list is a doc reference; replace it with the doc string. */
3559 int doc_reference
= 0;
3561 /* Initialize this to 1 if we are reading a list. */
3562 int first_in_list
= flag
<= 0;
3571 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3576 /* While building, if the list starts with #$, treat it specially. */
3577 if (EQ (elt
, Vload_file_name
)
3579 && !NILP (Vpurify_flag
))
3581 if (NILP (Vdoc_file_name
))
3582 /* We have not yet called Snarf-documentation, so assume
3583 this file is described in the DOC-MM.NN file
3584 and Snarf-documentation will fill in the right value later.
3585 For now, replace the whole list with 0. */
3588 /* We have already called Snarf-documentation, so make a relative
3589 file name for this file, so it can be found properly
3590 in the installed Lisp directory.
3591 We don't use Fexpand_file_name because that would make
3592 the directory absolute now. */
3593 elt
= concat2 (build_string ("../lisp/"),
3594 Ffile_name_nondirectory (elt
));
3596 else if (EQ (elt
, Vload_file_name
)
3598 && load_force_doc_strings
)
3607 invalid_syntax (") or . in a vector", 18);
3615 XSETCDR (tail
, read0 (readcharfun
));
3617 val
= read0 (readcharfun
);
3618 read1 (readcharfun
, &ch
, 0);
3622 if (doc_reference
== 1)
3623 return make_number (0);
3624 if (doc_reference
== 2)
3626 /* Get a doc string from the file we are loading.
3627 If it's in saved_doc_string, get it from there.
3629 Here, we don't know if the string is a
3630 bytecode string or a doc string. As a
3631 bytecode string must be unibyte, we always
3632 return a unibyte string. If it is actually a
3633 doc string, caller must make it
3636 int pos
= XINT (XCDR (val
));
3637 /* Position is negative for user variables. */
3638 if (pos
< 0) pos
= -pos
;
3639 if (pos
>= saved_doc_string_position
3640 && pos
< (saved_doc_string_position
3641 + saved_doc_string_length
))
3643 int start
= pos
- saved_doc_string_position
;
3646 /* Process quoting with ^A,
3647 and find the end of the string,
3648 which is marked with ^_ (037). */
3649 for (from
= start
, to
= start
;
3650 saved_doc_string
[from
] != 037;)
3652 int c
= saved_doc_string
[from
++];
3655 c
= saved_doc_string
[from
++];
3657 saved_doc_string
[to
++] = c
;
3659 saved_doc_string
[to
++] = 0;
3661 saved_doc_string
[to
++] = 037;
3664 saved_doc_string
[to
++] = c
;
3667 return make_unibyte_string (saved_doc_string
+ start
,
3670 /* Look in prev_saved_doc_string the same way. */
3671 else if (pos
>= prev_saved_doc_string_position
3672 && pos
< (prev_saved_doc_string_position
3673 + prev_saved_doc_string_length
))
3675 int start
= pos
- prev_saved_doc_string_position
;
3678 /* Process quoting with ^A,
3679 and find the end of the string,
3680 which is marked with ^_ (037). */
3681 for (from
= start
, to
= start
;
3682 prev_saved_doc_string
[from
] != 037;)
3684 int c
= prev_saved_doc_string
[from
++];
3687 c
= prev_saved_doc_string
[from
++];
3689 prev_saved_doc_string
[to
++] = c
;
3691 prev_saved_doc_string
[to
++] = 0;
3693 prev_saved_doc_string
[to
++] = 037;
3696 prev_saved_doc_string
[to
++] = c
;
3699 return make_unibyte_string (prev_saved_doc_string
3704 return get_doc_string (val
, 1, 0);
3709 invalid_syntax (". in wrong context", 18);
3711 invalid_syntax ("] in a list", 11);
3713 tem
= (read_pure
&& flag
<= 0
3714 ? pure_cons (elt
, Qnil
)
3715 : Fcons (elt
, Qnil
));
3717 XSETCDR (tail
, tem
);
3722 defunflag
= EQ (elt
, Qdefun
);
3723 else if (defunflag
> 0)
3728 Lisp_Object Vobarray
;
3729 Lisp_Object initial_obarray
;
3731 /* oblookup stores the bucket number here, for the sake of Funintern. */
3733 int oblookup_last_bucket_number
;
3735 static int hash_string ();
3737 /* Get an error if OBARRAY is not an obarray.
3738 If it is one, return it. */
3741 check_obarray (obarray
)
3742 Lisp_Object obarray
;
3744 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3746 /* If Vobarray is now invalid, force it to be valid. */
3747 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3748 wrong_type_argument (Qvectorp
, obarray
);
3753 /* Intern the C string STR: return a symbol with that name,
3754 interned in the current obarray. */
3761 int len
= strlen (str
);
3762 Lisp_Object obarray
;
3765 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3766 obarray
= check_obarray (obarray
);
3767 tem
= oblookup (obarray
, str
, len
, len
);
3770 return Fintern (make_string (str
, len
), obarray
);
3774 intern_c_string (const char *str
)
3777 int len
= strlen (str
);
3778 Lisp_Object obarray
;
3781 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3782 obarray
= check_obarray (obarray
);
3783 tem
= oblookup (obarray
, str
, len
, len
);
3787 if (NILP (Vpurify_flag
))
3788 /* Creating a non-pure string from a string literal not
3789 implemented yet. We could just use make_string here and live
3790 with the extra copy. */
3793 return Fintern (make_pure_c_string (str
), obarray
);
3796 /* Create an uninterned symbol with name STR. */
3802 int len
= strlen (str
);
3804 return Fmake_symbol ((!NILP (Vpurify_flag
)
3805 ? make_pure_string (str
, len
, len
, 0)
3806 : make_string (str
, len
)));
3809 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3810 doc
: /* Return the canonical symbol whose name is STRING.
3811 If there is none, one is created by this function and returned.
3812 A second optional argument specifies the obarray to use;
3813 it defaults to the value of `obarray'. */)
3815 Lisp_Object string
, obarray
;
3817 register Lisp_Object tem
, sym
, *ptr
;
3819 if (NILP (obarray
)) obarray
= Vobarray
;
3820 obarray
= check_obarray (obarray
);
3822 CHECK_STRING (string
);
3824 tem
= oblookup (obarray
, SDATA (string
),
3827 if (!INTEGERP (tem
))
3830 if (!NILP (Vpurify_flag
))
3831 string
= Fpurecopy (string
);
3832 sym
= Fmake_symbol (string
);
3834 if (EQ (obarray
, initial_obarray
))
3835 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3837 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3839 if ((SREF (string
, 0) == ':')
3840 && EQ (obarray
, initial_obarray
))
3842 XSYMBOL (sym
)->constant
= 1;
3843 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3844 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3847 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3849 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3851 XSYMBOL (sym
)->next
= 0;
3856 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3857 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3858 NAME may be a string or a symbol. If it is a symbol, that exact
3859 symbol is searched for.
3860 A second optional argument specifies the obarray to use;
3861 it defaults to the value of `obarray'. */)
3863 Lisp_Object name
, obarray
;
3865 register Lisp_Object tem
, string
;
3867 if (NILP (obarray
)) obarray
= Vobarray
;
3868 obarray
= check_obarray (obarray
);
3870 if (!SYMBOLP (name
))
3872 CHECK_STRING (name
);
3876 string
= SYMBOL_NAME (name
);
3878 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3879 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3885 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3886 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3887 The value is t if a symbol was found and deleted, nil otherwise.
3888 NAME may be a string or a symbol. If it is a symbol, that symbol
3889 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3890 OBARRAY defaults to the value of the variable `obarray'. */)
3892 Lisp_Object name
, obarray
;
3894 register Lisp_Object string
, tem
;
3897 if (NILP (obarray
)) obarray
= Vobarray
;
3898 obarray
= check_obarray (obarray
);
3901 string
= SYMBOL_NAME (name
);
3904 CHECK_STRING (name
);
3908 tem
= oblookup (obarray
, SDATA (string
),
3913 /* If arg was a symbol, don't delete anything but that symbol itself. */
3914 if (SYMBOLP (name
) && !EQ (name
, tem
))
3917 /* There are plenty of other symbols which will screw up the Emacs
3918 session if we unintern them, as well as even more ways to use
3919 `setq' or `fset' or whatnot to make the Emacs session
3920 unusable. Let's not go down this silly road. --Stef */
3921 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3922 error ("Attempt to unintern t or nil"); */
3924 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3926 hash
= oblookup_last_bucket_number
;
3928 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3930 if (XSYMBOL (tem
)->next
)
3931 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3933 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3937 Lisp_Object tail
, following
;
3939 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3940 XSYMBOL (tail
)->next
;
3943 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3944 if (EQ (following
, tem
))
3946 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3955 /* Return the symbol in OBARRAY whose names matches the string
3956 of SIZE characters (SIZE_BYTE bytes) at PTR.
3957 If there is no such symbol in OBARRAY, return nil.
3959 Also store the bucket number in oblookup_last_bucket_number. */
3962 oblookup (obarray
, ptr
, size
, size_byte
)
3963 Lisp_Object obarray
;
3964 register const char *ptr
;
3965 int size
, size_byte
;
3969 register Lisp_Object tail
;
3970 Lisp_Object bucket
, tem
;
3972 if (!VECTORP (obarray
)
3973 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3975 obarray
= check_obarray (obarray
);
3976 obsize
= XVECTOR (obarray
)->size
;
3978 /* This is sometimes needed in the middle of GC. */
3979 obsize
&= ~ARRAY_MARK_FLAG
;
3980 hash
= hash_string (ptr
, size_byte
) % obsize
;
3981 bucket
= XVECTOR (obarray
)->contents
[hash
];
3982 oblookup_last_bucket_number
= hash
;
3983 if (EQ (bucket
, make_number (0)))
3985 else if (!SYMBOLP (bucket
))
3986 error ("Bad data in guts of obarray"); /* Like CADR error message */
3988 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3990 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3991 && SCHARS (SYMBOL_NAME (tail
)) == size
3992 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3994 else if (XSYMBOL (tail
)->next
== 0)
3997 XSETINT (tem
, hash
);
4002 hash_string (ptr
, len
)
4003 const unsigned char *ptr
;
4006 register const unsigned char *p
= ptr
;
4007 register const unsigned char *end
= p
+ len
;
4008 register unsigned char c
;
4009 register int hash
= 0;
4014 if (c
>= 0140) c
-= 40;
4015 hash
= ((hash
<<3) + (hash
>>28) + c
);
4017 return hash
& 07777777777;
4021 map_obarray (obarray
, fn
, arg
)
4022 Lisp_Object obarray
;
4023 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
4027 register Lisp_Object tail
;
4028 CHECK_VECTOR (obarray
);
4029 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
4031 tail
= XVECTOR (obarray
)->contents
[i
];
4036 if (XSYMBOL (tail
)->next
== 0)
4038 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
4044 mapatoms_1 (sym
, function
)
4045 Lisp_Object sym
, function
;
4047 call1 (function
, sym
);
4050 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
4051 doc
: /* Call FUNCTION on every symbol in OBARRAY.
4052 OBARRAY defaults to the value of `obarray'. */)
4054 Lisp_Object function
, obarray
;
4056 if (NILP (obarray
)) obarray
= Vobarray
;
4057 obarray
= check_obarray (obarray
);
4059 map_obarray (obarray
, mapatoms_1
, function
);
4063 #define OBARRAY_SIZE 1511
4068 Lisp_Object oblength
;
4070 XSETFASTINT (oblength
, OBARRAY_SIZE
);
4072 Vobarray
= Fmake_vector (oblength
, make_number (0));
4073 initial_obarray
= Vobarray
;
4074 staticpro (&initial_obarray
);
4076 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
4077 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
4078 NILP (Vpurify_flag) check in intern_c_string. */
4079 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
4080 Qnil
= intern_c_string ("nil");
4082 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
4083 so those two need to be fixed manally. */
4084 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
4085 XSYMBOL (Qunbound
)->function
= Qunbound
;
4086 XSYMBOL (Qunbound
)->plist
= Qnil
;
4087 /* XSYMBOL (Qnil)->function = Qunbound; */
4088 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
4089 XSYMBOL (Qnil
)->constant
= 1;
4090 XSYMBOL (Qnil
)->plist
= Qnil
;
4092 Qt
= intern_c_string ("t");
4093 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
4094 XSYMBOL (Qt
)->constant
= 1;
4096 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
4099 Qvariable_documentation
= intern_c_string ("variable-documentation");
4100 staticpro (&Qvariable_documentation
);
4102 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
4103 read_buffer
= (char *) xmalloc (read_buffer_size
);
4108 struct Lisp_Subr
*sname
;
4111 sym
= intern_c_string (sname
->symbol_name
);
4112 XSETPVECTYPE (sname
, PVEC_SUBR
);
4113 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4116 #ifdef NOTDEF /* use fset in subr.el now */
4118 defalias (sname
, string
)
4119 struct Lisp_Subr
*sname
;
4123 sym
= intern (string
);
4124 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
4128 /* Define an "integer variable"; a symbol whose value is forwarded
4129 to a C variable of type int. Sample call:
4130 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
4132 defvar_int (struct Lisp_Intfwd
*i_fwd
,
4133 const char *namestring
, EMACS_INT
*address
)
4136 sym
= intern_c_string (namestring
);
4137 i_fwd
->type
= Lisp_Fwd_Int
;
4138 i_fwd
->intvar
= address
;
4139 XSYMBOL (sym
)->declared_special
= 1;
4140 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4141 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
4144 /* Similar but define a variable whose value is t if address contains 1,
4145 nil if address contains 0. */
4147 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
4148 const char *namestring
, int *address
)
4151 sym
= intern_c_string (namestring
);
4152 b_fwd
->type
= Lisp_Fwd_Bool
;
4153 b_fwd
->boolvar
= address
;
4154 XSYMBOL (sym
)->declared_special
= 1;
4155 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4156 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
4157 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
4160 /* Similar but define a variable whose value is the Lisp Object stored
4161 at address. Two versions: with and without gc-marking of the C
4162 variable. The nopro version is used when that variable will be
4163 gc-marked for some other reason, since marking the same slot twice
4164 can cause trouble with strings. */
4166 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
4167 const char *namestring
, Lisp_Object
*address
)
4170 sym
= intern_c_string (namestring
);
4171 o_fwd
->type
= Lisp_Fwd_Obj
;
4172 o_fwd
->objvar
= address
;
4173 XSYMBOL (sym
)->declared_special
= 1;
4174 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4175 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
4179 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
4180 const char *namestring
, Lisp_Object
*address
)
4182 defvar_lisp_nopro (o_fwd
, namestring
, address
);
4183 staticpro (address
);
4187 /* Similar but define a variable whose value is the Lisp Object stored
4188 at a particular offset in the current kboard object. */
4191 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
4192 const char *namestring
, int offset
)
4195 sym
= intern_c_string (namestring
);
4196 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
4197 ko_fwd
->offset
= offset
;
4198 XSYMBOL (sym
)->declared_special
= 1;
4199 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
4200 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
4203 /* Record the value of load-path used at the start of dumping
4204 so we can see if the site changed it later during dumping. */
4205 static Lisp_Object dump_path
;
4211 int turn_off_warning
= 0;
4213 /* Compute the default load-path. */
4215 normal
= PATH_LOADSEARCH
;
4216 Vload_path
= decode_env_path (0, normal
);
4218 if (NILP (Vpurify_flag
))
4219 normal
= PATH_LOADSEARCH
;
4221 normal
= PATH_DUMPLOADSEARCH
;
4223 /* In a dumped Emacs, we normally have to reset the value of
4224 Vload_path from PATH_LOADSEARCH, since the value that was dumped
4225 uses ../lisp, instead of the path of the installed elisp
4226 libraries. However, if it appears that Vload_path was changed
4227 from the default before dumping, don't override that value. */
4230 if (! NILP (Fequal (dump_path
, Vload_path
)))
4232 Vload_path
= decode_env_path (0, normal
);
4233 if (!NILP (Vinstallation_directory
))
4235 Lisp_Object tem
, tem1
, sitelisp
;
4237 /* Remove site-lisp dirs from path temporarily and store
4238 them in sitelisp, then conc them on at the end so
4239 they're always first in path. */
4243 tem
= Fcar (Vload_path
);
4244 tem1
= Fstring_match (build_string ("site-lisp"),
4248 Vload_path
= Fcdr (Vload_path
);
4249 sitelisp
= Fcons (tem
, sitelisp
);
4255 /* Add to the path the lisp subdir of the
4256 installation dir, if it exists. */
4257 tem
= Fexpand_file_name (build_string ("lisp"),
4258 Vinstallation_directory
);
4259 tem1
= Ffile_exists_p (tem
);
4262 if (NILP (Fmember (tem
, Vload_path
)))
4264 turn_off_warning
= 1;
4265 Vload_path
= Fcons (tem
, Vload_path
);
4269 /* That dir doesn't exist, so add the build-time
4270 Lisp dirs instead. */
4271 Vload_path
= nconc2 (Vload_path
, dump_path
);
4273 /* Add leim under the installation dir, if it exists. */
4274 tem
= Fexpand_file_name (build_string ("leim"),
4275 Vinstallation_directory
);
4276 tem1
= Ffile_exists_p (tem
);
4279 if (NILP (Fmember (tem
, Vload_path
)))
4280 Vload_path
= Fcons (tem
, Vload_path
);
4283 /* Add site-lisp under the installation dir, if it exists. */
4284 tem
= Fexpand_file_name (build_string ("site-lisp"),
4285 Vinstallation_directory
);
4286 tem1
= Ffile_exists_p (tem
);
4289 if (NILP (Fmember (tem
, Vload_path
)))
4290 Vload_path
= Fcons (tem
, Vload_path
);
4293 /* If Emacs was not built in the source directory,
4294 and it is run from where it was built, add to load-path
4295 the lisp, leim and site-lisp dirs under that directory. */
4297 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4301 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4302 Vinstallation_directory
);
4303 tem1
= Ffile_exists_p (tem
);
4305 /* Don't be fooled if they moved the entire source tree
4306 AFTER dumping Emacs. If the build directory is indeed
4307 different from the source dir, src/Makefile.in and
4308 src/Makefile will not be found together. */
4309 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4310 Vinstallation_directory
);
4311 tem2
= Ffile_exists_p (tem
);
4312 if (!NILP (tem1
) && NILP (tem2
))
4314 tem
= Fexpand_file_name (build_string ("lisp"),
4317 if (NILP (Fmember (tem
, Vload_path
)))
4318 Vload_path
= Fcons (tem
, Vload_path
);
4320 tem
= Fexpand_file_name (build_string ("leim"),
4323 if (NILP (Fmember (tem
, Vload_path
)))
4324 Vload_path
= Fcons (tem
, Vload_path
);
4326 tem
= Fexpand_file_name (build_string ("site-lisp"),
4329 if (NILP (Fmember (tem
, Vload_path
)))
4330 Vload_path
= Fcons (tem
, Vload_path
);
4333 if (!NILP (sitelisp
))
4334 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4340 /* NORMAL refers to the lisp dir in the source directory. */
4341 /* We used to add ../lisp at the front here, but
4342 that caused trouble because it was copied from dump_path
4343 into Vload_path, above, when Vinstallation_directory was non-nil.
4344 It should be unnecessary. */
4345 Vload_path
= decode_env_path (0, normal
);
4346 dump_path
= Vload_path
;
4350 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4351 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4352 almost never correct, thereby causing a warning to be printed out that
4353 confuses users. Since PATH_LOADSEARCH is always overridden by the
4354 EMACSLOADPATH environment variable below, disable the warning on NT. */
4356 /* Warn if dirs in the *standard* path don't exist. */
4357 if (!turn_off_warning
)
4359 Lisp_Object path_tail
;
4361 for (path_tail
= Vload_path
;
4363 path_tail
= XCDR (path_tail
))
4365 Lisp_Object dirfile
;
4366 dirfile
= Fcar (path_tail
);
4367 if (STRINGP (dirfile
))
4369 dirfile
= Fdirectory_file_name (dirfile
);
4370 if (access (SDATA (dirfile
), 0) < 0)
4371 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4376 #endif /* !(WINDOWSNT || HAVE_NS) */
4378 /* If the EMACSLOADPATH environment variable is set, use its value.
4379 This doesn't apply if we're dumping. */
4381 if (NILP (Vpurify_flag
)
4382 && egetenv ("EMACSLOADPATH"))
4384 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4388 load_in_progress
= 0;
4389 Vload_file_name
= Qnil
;
4391 load_descriptor_list
= Qnil
;
4393 Vstandard_input
= Qt
;
4394 Vloads_in_progress
= Qnil
;
4397 /* Print a warning, using format string FORMAT, that directory DIRNAME
4398 does not exist. Print it on stderr and put it in *Messages*. */
4401 dir_warning (format
, dirname
)
4403 Lisp_Object dirname
;
4406 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4408 fprintf (stderr
, format
, SDATA (dirname
));
4409 sprintf (buffer
, format
, SDATA (dirname
));
4410 /* Don't log the warning before we've initialized!! */
4412 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4419 defsubr (&Sread_from_string
);
4421 defsubr (&Sintern_soft
);
4422 defsubr (&Sunintern
);
4423 defsubr (&Sget_load_suffixes
);
4425 defsubr (&Seval_buffer
);
4426 defsubr (&Seval_region
);
4427 defsubr (&Sread_char
);
4428 defsubr (&Sread_char_exclusive
);
4429 defsubr (&Sread_event
);
4430 defsubr (&Sget_file_char
);
4431 defsubr (&Smapatoms
);
4432 defsubr (&Slocate_file_internal
);
4434 DEFVAR_LISP ("obarray", &Vobarray
,
4435 doc
: /* Symbol table for use by `intern' and `read'.
4436 It is a vector whose length ought to be prime for best results.
4437 The vector's contents don't make sense if examined from Lisp programs;
4438 to find all the symbols in an obarray, use `mapatoms'. */);
4440 DEFVAR_LISP ("values", &Vvalues
,
4441 doc
: /* List of values of all expressions which were read, evaluated and printed.
4442 Order is reverse chronological. */);
4444 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4445 doc
: /* Stream for read to get input from.
4446 See documentation of `read' for possible values. */);
4447 Vstandard_input
= Qt
;
4449 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4450 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4452 If this variable is a buffer, then only forms read from that buffer
4453 will be added to `read-symbol-positions-list'.
4454 If this variable is t, then all read forms will be added.
4455 The effect of all other values other than nil are not currently
4456 defined, although they may be in the future.
4458 The positions are relative to the last call to `read' or
4459 `read-from-string'. It is probably a bad idea to set this variable at
4460 the toplevel; bind it instead. */);
4461 Vread_with_symbol_positions
= Qnil
;
4463 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4464 doc
: /* A list mapping read symbols to their positions.
4465 This variable is modified during calls to `read' or
4466 `read-from-string', but only when `read-with-symbol-positions' is
4469 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4470 CHAR-POSITION is an integer giving the offset of that occurrence of the
4471 symbol from the position where `read' or `read-from-string' started.
4473 Note that a symbol will appear multiple times in this list, if it was
4474 read multiple times. The list is in the same order as the symbols
4476 Vread_symbol_positions_list
= Qnil
;
4478 DEFVAR_LISP ("read-circle", &Vread_circle
,
4479 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4482 DEFVAR_LISP ("load-path", &Vload_path
,
4483 doc
: /* *List of directories to search for files to load.
4484 Each element is a string (directory name) or nil (try default directory).
4485 Initialized based on EMACSLOADPATH environment variable, if any,
4486 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4488 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4489 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4490 This list should not include the empty string.
4491 `load' and related functions try to append these suffixes, in order,
4492 to the specified file name if a Lisp suffix is allowed or required. */);
4493 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4494 Fcons (make_pure_c_string (".el"), Qnil
));
4495 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4496 doc
: /* List of suffixes that indicate representations of \
4498 This list should normally start with the empty string.
4500 Enabling Auto Compression mode appends the suffixes in
4501 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4502 mode removes them again. `load' and related functions use this list to
4503 determine whether they should look for compressed versions of a file
4504 and, if so, which suffixes they should try to append to the file name
4505 in order to do so. However, if you want to customize which suffixes
4506 the loading functions recognize as compression suffixes, you should
4507 customize `jka-compr-load-suffixes' rather than the present variable. */);
4508 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4510 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4511 doc
: /* Non-nil if inside of `load'. */);
4512 Qload_in_progress
= intern_c_string ("load-in-progress");
4513 staticpro (&Qload_in_progress
);
4515 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4516 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4517 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4519 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4520 a symbol \(a feature name).
4522 When `load' is run and the file-name argument matches an element's
4523 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4524 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4526 An error in FORMS does not undo the load, but does prevent execution of
4527 the rest of the FORMS. */);
4528 Vafter_load_alist
= Qnil
;
4530 DEFVAR_LISP ("load-history", &Vload_history
,
4531 doc
: /* Alist mapping loaded file names to symbols and features.
4532 Each alist element should be a list (FILE-NAME ENTRIES...), where
4533 FILE-NAME is the name of a file that has been loaded into Emacs.
4534 The file name is absolute and true (i.e. it doesn't contain symlinks).
4535 As an exception, one of the alist elements may have FILE-NAME nil,
4536 for symbols and features not associated with any file.
4538 The remaining ENTRIES in the alist element describe the functions and
4539 variables defined in that file, the features provided, and the
4540 features required. Each entry has the form `(provide . FEATURE)',
4541 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4542 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4543 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4544 SYMBOL was an autoload before this file redefined it as a function.
4546 During preloading, the file name recorded is relative to the main Lisp
4547 directory. These file names are converted to absolute at startup. */);
4548 Vload_history
= Qnil
;
4550 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4551 doc
: /* Full name of file being loaded by `load'. */);
4552 Vload_file_name
= Qnil
;
4554 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4555 doc
: /* File name, including directory, of user's initialization file.
4556 If the file loaded had extension `.elc', and the corresponding source file
4557 exists, this variable contains the name of source file, suitable for use
4558 by functions like `custom-save-all' which edit the init file.
4559 While Emacs loads and evaluates the init file, value is the real name
4560 of the file, regardless of whether or not it has the `.elc' extension. */);
4561 Vuser_init_file
= Qnil
;
4563 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4564 doc
: /* Used for internal purposes by `load'. */);
4565 Vcurrent_load_list
= Qnil
;
4567 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4568 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4569 The default is nil, which means use the function `read'. */);
4570 Vload_read_function
= Qnil
;
4572 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4573 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4574 This function is for doing code conversion before reading the source file.
4575 If nil, loading is done without any code conversion.
4576 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4577 FULLNAME is the full name of FILE.
4578 See `load' for the meaning of the remaining arguments. */);
4579 Vload_source_file_function
= Qnil
;
4581 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4582 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4583 This is useful when the file being loaded is a temporary copy. */);
4584 load_force_doc_strings
= 0;
4586 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4587 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4588 This is normally bound by `load' and `eval-buffer' to control `read',
4589 and is not meant for users to change. */);
4590 load_convert_to_unibyte
= 0;
4592 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4593 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4594 You cannot count on them to still be there! */);
4596 = Fexpand_file_name (build_string ("../"),
4597 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4599 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4600 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4601 Vpreloaded_file_list
= Qnil
;
4603 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4604 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4605 Vbyte_boolean_vars
= Qnil
;
4607 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4608 doc
: /* Non-nil means load dangerous compiled Lisp files.
4609 Some versions of XEmacs use different byte codes than Emacs. These
4610 incompatible byte codes can make Emacs crash when it tries to execute
4612 load_dangerous_libraries
= 0;
4614 DEFVAR_BOOL ("force-load-messages", &force_load_messages
,
4615 doc
: /* Non-nil means force printing messages when loading Lisp files.
4616 This overrides the value of the NOMESSAGE argument to `load'. */);
4617 force_load_messages
= 0;
4619 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4620 doc
: /* Regular expression matching safe to load compiled Lisp files.
4621 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4622 from the file, and matches them against this regular expression.
4623 When the regular expression matches, the file is considered to be safe
4624 to load. See also `load-dangerous-libraries'. */);
4625 Vbytecomp_version_regexp
4626 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4628 Qlexical_binding
= intern ("lexical-binding");
4629 staticpro (&Qlexical_binding
);
4630 DEFVAR_LISP ("lexical-binding", &Vlexical_binding
,
4631 doc
: /* If non-nil, use lexical binding when evaluating code.
4632 This only applies to code evaluated by `eval-buffer' and `eval-region'.
4633 This variable is automatically set from the file variables of an interpreted
4634 lisp file read using `load'.
4635 This variable automatically becomes buffer-local when set. */);
4636 Fmake_variable_buffer_local (Qlexical_binding
);
4638 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4639 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4640 Veval_buffer_list
= Qnil
;
4642 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4643 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4644 Vold_style_backquotes
= Qnil
;
4645 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4646 staticpro (&Qold_style_backquotes
);
4648 /* Vsource_directory was initialized in init_lread. */
4650 load_descriptor_list
= Qnil
;
4651 staticpro (&load_descriptor_list
);
4653 Qcurrent_load_list
= intern_c_string ("current-load-list");
4654 staticpro (&Qcurrent_load_list
);
4656 Qstandard_input
= intern_c_string ("standard-input");
4657 staticpro (&Qstandard_input
);
4659 Qread_char
= intern_c_string ("read-char");
4660 staticpro (&Qread_char
);
4662 Qget_file_char
= intern_c_string ("get-file-char");
4663 staticpro (&Qget_file_char
);
4665 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4666 staticpro (&Qget_emacs_mule_file_char
);
4668 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4669 staticpro (&Qload_force_doc_strings
);
4671 Qbackquote
= intern_c_string ("`");
4672 staticpro (&Qbackquote
);
4673 Qcomma
= intern_c_string (",");
4674 staticpro (&Qcomma
);
4675 Qcomma_at
= intern_c_string (",@");
4676 staticpro (&Qcomma_at
);
4677 Qcomma_dot
= intern_c_string (",.");
4678 staticpro (&Qcomma_dot
);
4680 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4681 staticpro (&Qinhibit_file_name_operation
);
4683 Qascii_character
= intern_c_string ("ascii-character");
4684 staticpro (&Qascii_character
);
4686 Qfunction
= intern_c_string ("function");
4687 staticpro (&Qfunction
);
4689 Qload
= intern_c_string ("load");
4692 Qload_file_name
= intern_c_string ("load-file-name");
4693 staticpro (&Qload_file_name
);
4695 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4696 staticpro (&Qeval_buffer_list
);
4698 Qfile_truename
= intern_c_string ("file-truename");
4699 staticpro (&Qfile_truename
) ;
4701 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4702 staticpro (&Qdo_after_load_evaluation
) ;
4704 staticpro (&dump_path
);
4706 staticpro (&read_objects
);
4707 read_objects
= Qnil
;
4708 staticpro (&seen_list
);
4711 Vloads_in_progress
= Qnil
;
4712 staticpro (&Vloads_in_progress
);
4714 Qhash_table
= intern_c_string ("hash-table");
4715 staticpro (&Qhash_table
);
4716 Qdata
= intern_c_string ("data");
4718 Qtest
= intern_c_string ("test");
4720 Qsize
= intern_c_string ("size");
4722 Qweakness
= intern_c_string ("weakness");
4723 staticpro (&Qweakness
);
4724 Qrehash_size
= intern_c_string ("rehash-size");
4725 staticpro (&Qrehash_size
);
4726 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4727 staticpro (&Qrehash_threshold
);
4730 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4731 (do not change this comment) */