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 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, or (at your option)
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; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
32 #include "intervals.h"
34 #include "character.h"
41 #include "termhooks.h"
43 #include "blockinput.h"
46 #include <sys/inode.h>
51 #include <unistd.h> /* to get X_OK */
68 #endif /* HAVE_SETLOCALE */
78 #define file_offset off_t
79 #define file_tell ftello
81 #define file_offset long
82 #define file_tell ftell
89 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
90 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
91 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
92 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
93 Lisp_Object Qinhibit_file_name_operation
;
94 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
95 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
97 /* Used instead of Qget_file_char while loading *.elc files compiled
98 by Emacs 21 or older. */
99 static Lisp_Object Qget_emacs_mule_file_char
;
101 static Lisp_Object Qload_force_doc_strings
;
103 extern Lisp_Object Qevent_symbol_element_mask
;
104 extern Lisp_Object Qfile_exists_p
;
106 /* non-zero if inside `load' */
107 int load_in_progress
;
109 /* Directory in which the sources were found. */
110 Lisp_Object Vsource_directory
;
112 /* Search path and suffixes for files to be loaded. */
113 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
115 /* File name of user's init file. */
116 Lisp_Object Vuser_init_file
;
118 /* This is the user-visible association list that maps features to
119 lists of defs in their load files. */
120 Lisp_Object Vload_history
;
122 /* This is used to build the load history. */
123 Lisp_Object Vcurrent_load_list
;
125 /* List of files that were preloaded. */
126 Lisp_Object Vpreloaded_file_list
;
128 /* Name of file actually being read by `load'. */
129 Lisp_Object Vload_file_name
;
131 /* Function to use for reading, in `load' and friends. */
132 Lisp_Object Vload_read_function
;
134 /* The association list of objects read with the #n=object form.
135 Each member of the list has the form (n . object), and is used to
136 look up the object for the corresponding #n# construct.
137 It must be set to nil before all top-level calls to read0. */
138 Lisp_Object read_objects
;
140 /* Nonzero means load should forcibly load all dynamic doc strings. */
141 static int load_force_doc_strings
;
143 /* Nonzero means read should convert strings to unibyte. */
144 static int load_convert_to_unibyte
;
146 /* Nonzero means READCHAR should read bytes one by one (not character)
147 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
148 This is set to 1 by read1 temporarily while handling #@NUMBER. */
149 static int load_each_byte
;
151 /* Function to use for loading an Emacs Lisp source file (not
152 compiled) instead of readevalloop. */
153 Lisp_Object Vload_source_file_function
;
155 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
156 Lisp_Object Vbyte_boolean_vars
;
158 /* Whether or not to add a `read-positions' property to symbols
160 Lisp_Object Vread_with_symbol_positions
;
162 /* List of (SYMBOL . POSITION) accumulated so far. */
163 Lisp_Object Vread_symbol_positions_list
;
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 /* A regular expression used to detect files compiled with Emacs. */
221 static Lisp_Object Vbytecomp_version_regexp
;
223 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
226 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
227 Lisp_Object (*) (), int,
228 Lisp_Object
, Lisp_Object
,
229 Lisp_Object
, Lisp_Object
));
230 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
231 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
233 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
234 static void end_of_file_error
P_ (()) NO_RETURN
;
237 /* Functions that read one byte from the current source READCHARFUN
238 or unreads one byte. If the integer argument C is -1, it returns
239 one read byte, or -1 when there's no more byte in the source. If C
240 is 0 or positive, it unreads C, and the return value is not
243 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
244 static int readbyte_from_file
P_ ((int, Lisp_Object
));
245 static int readbyte_from_string
P_ ((int, Lisp_Object
));
247 /* Handle unreading and rereading of characters.
248 Write READCHAR to read a character,
249 UNREAD(c) to unread c to be read again.
251 These macros correctly read/unread multibyte characters. */
253 #define READCHAR readchar (readcharfun)
254 #define UNREAD(c) unreadchar (readcharfun, c)
256 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
257 Qlambda, or a cons, we use this to keep an unread character because
258 a file stream can't handle multibyte-char unreading. The value -1
259 means that there's no unread character. */
260 static int unread_char
;
263 readchar (readcharfun
)
264 Lisp_Object readcharfun
;
268 int (*readbyte
) P_ ((int, Lisp_Object
));
269 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
271 int emacs_mule_encoding
= 0;
275 if (BUFFERP (readcharfun
))
277 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
279 int pt_byte
= BUF_PT_BYTE (inbuffer
);
281 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
284 if (! NILP (inbuffer
->enable_multibyte_characters
))
286 /* Fetch the character code from the buffer. */
287 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
288 BUF_INC_POS (inbuffer
, pt_byte
);
289 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
293 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
294 if (! ASCII_BYTE_P (c
))
295 c
= BYTE8_TO_CHAR (c
);
298 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
302 if (MARKERP (readcharfun
))
304 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
306 int bytepos
= marker_byte_position (readcharfun
);
308 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
311 if (! NILP (inbuffer
->enable_multibyte_characters
))
313 /* Fetch the character code from the buffer. */
314 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
315 BUF_INC_POS (inbuffer
, bytepos
);
316 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
320 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
321 if (! ASCII_BYTE_P (c
))
322 c
= BYTE8_TO_CHAR (c
);
326 XMARKER (readcharfun
)->bytepos
= bytepos
;
327 XMARKER (readcharfun
)->charpos
++;
332 if (EQ (readcharfun
, Qlambda
))
334 readbyte
= readbyte_for_lambda
;
338 if (EQ (readcharfun
, Qget_file_char
))
340 readbyte
= readbyte_from_file
;
344 if (STRINGP (readcharfun
))
346 if (read_from_string_index
>= read_from_string_limit
)
349 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
350 read_from_string_index
,
351 read_from_string_index_byte
);
356 if (CONSP (readcharfun
))
358 /* This is the case that read_vector is reading from a unibyte
359 string that contains a byte sequence previously skipped
360 because of #@NUMBER. The car part of readcharfun is that
361 string, and the cdr part is a value of readcharfun given to
363 readbyte
= readbyte_from_string
;
364 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
365 emacs_mule_encoding
= 1;
369 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
371 readbyte
= readbyte_from_file
;
372 emacs_mule_encoding
= 1;
376 tem
= call0 (readcharfun
);
383 if (unread_char
>= 0)
389 c
= (*readbyte
) (-1, readcharfun
);
390 if (c
< 0 || ASCII_BYTE_P (c
) || load_each_byte
)
392 if (emacs_mule_encoding
)
393 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
396 len
= BYTES_BY_CHAR_HEAD (c
);
399 c
= (*readbyte
) (-1, readcharfun
);
400 if (c
< 0 || ! TRAILING_CODE_P (c
))
403 (*readbyte
) (buf
[i
], readcharfun
);
404 return BYTE8_TO_CHAR (buf
[0]);
408 return STRING_CHAR (buf
, i
);
411 /* Unread the character C in the way appropriate for the stream READCHARFUN.
412 If the stream is a user function, call it with the char as argument. */
415 unreadchar (readcharfun
, c
)
416 Lisp_Object readcharfun
;
421 /* Don't back up the pointer if we're unreading the end-of-input mark,
422 since readchar didn't advance it when we read it. */
424 else if (BUFFERP (readcharfun
))
426 struct buffer
*b
= XBUFFER (readcharfun
);
427 int bytepos
= BUF_PT_BYTE (b
);
430 if (! NILP (b
->enable_multibyte_characters
))
431 BUF_DEC_POS (b
, bytepos
);
435 BUF_PT_BYTE (b
) = bytepos
;
437 else if (MARKERP (readcharfun
))
439 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
440 int bytepos
= XMARKER (readcharfun
)->bytepos
;
442 XMARKER (readcharfun
)->charpos
--;
443 if (! NILP (b
->enable_multibyte_characters
))
444 BUF_DEC_POS (b
, bytepos
);
448 XMARKER (readcharfun
)->bytepos
= bytepos
;
450 else if (STRINGP (readcharfun
))
452 read_from_string_index
--;
453 read_from_string_index_byte
454 = string_char_to_byte (readcharfun
, read_from_string_index
);
456 else if (CONSP (readcharfun
))
460 else if (EQ (readcharfun
, Qlambda
))
464 else if (EQ (readcharfun
, Qget_file_char
)
465 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
470 ungetc (c
, instream
);
477 call1 (readcharfun
, make_number (c
));
481 readbyte_for_lambda (c
, readcharfun
)
483 Lisp_Object readcharfun
;
485 return read_bytecode_char (c
>= 0);
490 readbyte_from_file (c
, readcharfun
)
492 Lisp_Object readcharfun
;
497 ungetc (c
, instream
);
506 /* Interrupted reads have been observed while reading over the network */
507 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
519 return (c
== EOF
? -1 : c
);
523 readbyte_from_string (c
, readcharfun
)
525 Lisp_Object readcharfun
;
527 Lisp_Object string
= XCAR (readcharfun
);
531 read_from_string_index
--;
532 read_from_string_index_byte
533 = string_char_to_byte (string
, read_from_string_index
);
536 if (read_from_string_index
>= read_from_string_limit
)
539 FETCH_STRING_CHAR_ADVANCE (c
, string
,
540 read_from_string_index
,
541 read_from_string_index_byte
);
546 /* Read one non-ASCII character from INSTREAM. The character is
547 encoded in `emacs-mule' and the first byte is already read in
550 extern char emacs_mule_bytes
[256];
553 read_emacs_mule_char (c
, readbyte
, readcharfun
)
555 int (*readbyte
) P_ ((int, Lisp_Object
));
556 Lisp_Object readcharfun
;
558 /* Emacs-mule coding uses at most 4-byte for one character. */
559 unsigned char buf
[4];
560 int len
= emacs_mule_bytes
[c
];
561 struct charset
*charset
;
566 /* C is not a valid leading-code of `emacs-mule'. */
567 return BYTE8_TO_CHAR (c
);
573 c
= (*readbyte
) (-1, readcharfun
);
577 (*readbyte
) (buf
[i
], readcharfun
);
578 return BYTE8_TO_CHAR (buf
[0]);
585 charset
= emacs_mule_charset
[buf
[0]];
586 code
= buf
[1] & 0x7F;
590 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
591 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
593 charset
= emacs_mule_charset
[buf
[1]];
594 code
= buf
[2] & 0x7F;
598 charset
= emacs_mule_charset
[buf
[0]];
599 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
604 charset
= emacs_mule_charset
[buf
[1]];
605 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
607 c
= DECODE_CHAR (charset
, code
);
609 Fsignal (Qinvalid_read_syntax
,
610 Fcons (build_string ("invalid multibyte form"), Qnil
));
615 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
617 static Lisp_Object read0
P_ ((Lisp_Object
));
618 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
620 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
621 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
623 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
625 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
627 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
630 /* Get a character from the tty. */
632 /* Read input events until we get one that's acceptable for our purposes.
634 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
635 until we get a character we like, and then stuffed into
638 If ASCII_REQUIRED is non-zero, we check function key events to see
639 if the unmodified version of the symbol has a Qascii_character
640 property, and use that character, if present.
642 If ERROR_NONASCII is non-zero, we signal an error if the input we
643 get isn't an ASCII character with modifiers. If it's zero but
644 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
647 If INPUT_METHOD is nonzero, we invoke the current input method
648 if the character warrants that.
650 If SECONDS is a number, we wait that many seconds for input, and
651 return Qnil if no input arrives within that time. */
654 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
655 input_method
, seconds
)
656 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
659 Lisp_Object val
, delayed_switch_frame
;
662 #ifdef HAVE_WINDOW_SYSTEM
663 if (display_hourglass_p
)
667 delayed_switch_frame
= Qnil
;
669 /* Compute timeout. */
670 if (NUMBERP (seconds
))
672 EMACS_TIME wait_time
;
674 double duration
= extract_float (seconds
);
676 sec
= (int) duration
;
677 usec
= (duration
- sec
) * 1000000;
678 EMACS_GET_TIME (end_time
);
679 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
680 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
683 /* Read until we get an acceptable event. */
686 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
687 NUMBERP (seconds
) ? &end_time
: NULL
);
688 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
693 /* switch-frame events are put off until after the next ASCII
694 character. This is better than signaling an error just because
695 the last characters were typed to a separate minibuffer frame,
696 for example. Eventually, some code which can deal with
697 switch-frame events will read it and process it. */
699 && EVENT_HAS_PARAMETERS (val
)
700 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
702 delayed_switch_frame
= val
;
706 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
708 /* Convert certain symbols to their ASCII equivalents. */
711 Lisp_Object tem
, tem1
;
712 tem
= Fget (val
, Qevent_symbol_element_mask
);
715 tem1
= Fget (Fcar (tem
), Qascii_character
);
716 /* Merge this symbol's modifier bits
717 with the ASCII equivalent of its basic code. */
719 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
723 /* If we don't have a character now, deal with it appropriately. */
728 Vunread_command_events
= Fcons (val
, Qnil
);
729 error ("Non-character input-event");
736 if (! NILP (delayed_switch_frame
))
737 unread_switch_frame
= delayed_switch_frame
;
741 #ifdef HAVE_WINDOW_SYSTEM
742 if (display_hourglass_p
)
751 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
752 doc
: /* Read a character from the command input (keyboard or macro).
753 It is returned as a number.
754 If the user generates an event which is not a character (i.e. a mouse
755 click or function key event), `read-char' signals an error. As an
756 exception, switch-frame events are put off until non-ASCII events can
758 If you want to read non-character events, or ignore them, call
759 `read-event' or `read-char-exclusive' instead.
761 If the optional argument PROMPT is non-nil, display that as a prompt.
762 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
763 input method is turned on in the current buffer, that input method
764 is used for reading a character.
765 If the optional argument SECONDS is non-nil, it should be a number
766 specifying the maximum number of seconds to wait for input. If no
767 input arrives in that time, return nil. SECONDS may be a
768 floating-point value. */)
769 (prompt
, inherit_input_method
, seconds
)
770 Lisp_Object prompt
, inherit_input_method
, seconds
;
773 message_with_string ("%s", prompt
, 0);
774 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
777 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
778 doc
: /* Read an event object from the input stream.
779 If the optional argument PROMPT is non-nil, display that as a prompt.
780 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
781 input method is turned on in the current buffer, that input method
782 is used for reading a character.
783 If the optional argument SECONDS is non-nil, it should be a number
784 specifying the maximum number of seconds to wait for input. If no
785 input arrives in that time, return nil. SECONDS may be a
786 floating-point value. */)
787 (prompt
, inherit_input_method
, seconds
)
788 Lisp_Object prompt
, inherit_input_method
, seconds
;
791 message_with_string ("%s", prompt
, 0);
792 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
795 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
796 doc
: /* Read a character from the command input (keyboard or macro).
797 It is returned as a number. Non-character events are ignored.
799 If the optional argument PROMPT is non-nil, display that as a prompt.
800 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
801 input method is turned on in the current buffer, that input method
802 is used for reading a character.
803 If the optional argument SECONDS is non-nil, it should be a number
804 specifying the maximum number of seconds to wait for input. If no
805 input arrives in that time, return nil. SECONDS may be a
806 floating-point value. */)
807 (prompt
, inherit_input_method
, seconds
)
808 Lisp_Object prompt
, inherit_input_method
, seconds
;
811 message_with_string ("%s", prompt
, 0);
812 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
815 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
816 doc
: /* Don't use this yourself. */)
819 register Lisp_Object val
;
821 XSETINT (val
, getc (instream
));
828 /* Value is a version number of byte compiled code if the file
829 associated with file descriptor FD is a compiled Lisp file that's
830 safe to load. Only files compiled with Emacs are safe to load.
831 Files compiled with XEmacs can lead to a crash in Fbyte_code
832 because of an incompatible change in the byte compiler. */
843 /* Read the first few bytes from the file, and look for a line
844 specifying the byte compiler version used. */
845 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
850 /* Skip to the next newline, skipping over the initial `ELC'
851 with NUL bytes following it, but note the version. */
852 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
857 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
864 lseek (fd
, 0, SEEK_SET
);
869 /* Callback for record_unwind_protect. Restore the old load list OLD,
870 after loading a file successfully. */
873 record_load_unwind (old
)
876 return Vloads_in_progress
= old
;
879 /* This handler function is used via internal_condition_case_1. */
882 load_error_handler (data
)
889 load_warn_old_style_backquotes (file
)
892 if (!NILP (Vold_style_backquotes
))
895 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
902 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
903 doc
: /* Return the suffixes that `load' should try if a suffix is \
905 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
908 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
909 while (CONSP (suffixes
))
911 Lisp_Object exts
= Vload_file_rep_suffixes
;
912 suffix
= XCAR (suffixes
);
913 suffixes
= XCDR (suffixes
);
918 lst
= Fcons (concat2 (suffix
, ext
), lst
);
921 return Fnreverse (lst
);
924 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
925 doc
: /* Execute a file of Lisp code named FILE.
926 First try FILE with `.elc' appended, then try with `.el',
927 then try FILE unmodified (the exact suffixes in the exact order are
928 determined by `load-suffixes'). Environment variable references in
929 FILE are replaced with their values by calling `substitute-in-file-name'.
930 This function searches the directories in `load-path'.
932 If optional second arg NOERROR is non-nil,
933 report no error if FILE doesn't exist.
934 Print messages at start and end of loading unless
935 optional third arg NOMESSAGE is non-nil.
936 If optional fourth arg NOSUFFIX is non-nil, don't try adding
937 suffixes `.elc' or `.el' to the specified name FILE.
938 If optional fifth arg MUST-SUFFIX is non-nil, insist on
939 the suffix `.elc' or `.el'; don't accept just FILE unless
940 it ends in one of those suffixes or includes a directory name.
942 If this function fails to find a file, it may look for different
943 representations of that file before trying another file.
944 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
945 to the file name. Emacs uses this feature mainly to find compressed
946 versions of files when Auto Compression mode is enabled.
948 The exact suffixes that this function tries out, in the exact order,
949 are given by the value of the variable `load-file-rep-suffixes' if
950 NOSUFFIX is non-nil and by the return value of the function
951 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
952 MUST-SUFFIX are nil, this function first tries out the latter suffixes
955 Loading a file records its definitions, and its `provide' and
956 `require' calls, in an element of `load-history' whose
957 car is the file name loaded. See `load-history'.
959 Return t if the file exists and loads successfully. */)
960 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
961 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
963 register FILE *stream
;
964 register int fd
= -1;
965 int count
= SPECPDL_INDEX ();
966 struct gcpro gcpro1
, gcpro2
, gcpro3
;
967 Lisp_Object found
, efound
, hist_file_name
;
968 /* 1 means we printed the ".el is newer" message. */
970 /* 1 means we are loading a compiled file. */
984 /* If file name is magic, call the handler. */
985 /* This shouldn't be necessary any more now that `openp' handles it right.
986 handler = Ffind_file_name_handler (file, Qload);
988 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
990 /* Do this after the handler to avoid
991 the need to gcpro noerror, nomessage and nosuffix.
992 (Below here, we care only whether they are nil or not.)
993 The presence of this call is the result of a historical accident:
994 it used to be in every file-operation and when it got removed
995 everywhere, it accidentally stayed here. Since then, enough people
996 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
997 that it seemed risky to remove. */
998 if (! NILP (noerror
))
1000 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1001 Qt
, load_error_handler
);
1006 file
= Fsubstitute_in_file_name (file
);
1009 /* Avoid weird lossage with null string as arg,
1010 since it would try to load a directory as a Lisp file */
1011 if (SCHARS (file
) > 0)
1013 int size
= SBYTES (file
);
1016 GCPRO2 (file
, found
);
1018 if (! NILP (must_suffix
))
1020 /* Don't insist on adding a suffix if FILE already ends with one. */
1022 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1025 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1027 /* Don't insist on adding a suffix
1028 if the argument includes a directory name. */
1029 else if (! NILP (Ffile_name_directory (file
)))
1033 fd
= openp (Vload_path
, file
,
1034 (!NILP (nosuffix
) ? Qnil
1035 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1036 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1037 tmp
[1] = Vload_file_rep_suffixes
,
1046 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1050 /* Tell startup.el whether or not we found the user's init file. */
1051 if (EQ (Qt
, Vuser_init_file
))
1052 Vuser_init_file
= found
;
1054 /* If FD is -2, that means openp found a magic file. */
1057 if (NILP (Fequal (found
, file
)))
1058 /* If FOUND is a different file name from FILE,
1059 find its handler even if we have already inhibited
1060 the `load' operation on FILE. */
1061 handler
= Ffind_file_name_handler (found
, Qt
);
1063 handler
= Ffind_file_name_handler (found
, Qload
);
1064 if (! NILP (handler
))
1065 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1068 /* Check if we're stuck in a recursive load cycle.
1070 2000-09-21: It's not possible to just check for the file loaded
1071 being a member of Vloads_in_progress. This fails because of the
1072 way the byte compiler currently works; `provide's are not
1073 evaluted, see font-lock.el/jit-lock.el as an example. This
1074 leads to a certain amount of ``normal'' recursion.
1076 Also, just loading a file recursively is not always an error in
1077 the general case; the second load may do something different. */
1081 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1082 if (!NILP (Fequal (found
, XCAR (tem
))))
1088 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1090 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1091 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1094 /* Get the name for load-history. */
1095 hist_file_name
= (! NILP (Vpurify_flag
)
1096 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1097 tmp
[1] = Ffile_name_nondirectory (found
),
1103 /* Check for the presence of old-style quotes and warn about them. */
1104 specbind (Qold_style_backquotes
, Qnil
);
1105 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1107 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1109 || (version
= safe_to_load_p (fd
)) > 0)
1110 /* Load .elc files directly, but not when they are
1111 remote and have no handler! */
1118 GCPRO3 (file
, found
, hist_file_name
);
1121 && ! (version
= safe_to_load_p (fd
)))
1124 if (!load_dangerous_libraries
)
1128 error ("File `%s' was not compiled in Emacs",
1131 else if (!NILP (nomessage
))
1132 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1137 efound
= ENCODE_FILE (found
);
1142 stat ((char *)SDATA (efound
), &s1
);
1143 SSET (efound
, SBYTES (efound
) - 1, 0);
1144 result
= stat ((char *)SDATA (efound
), &s2
);
1145 SSET (efound
, SBYTES (efound
) - 1, 'c');
1147 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1149 /* Make the progress messages mention that source is newer. */
1152 /* If we won't print another message, mention this anyway. */
1153 if (!NILP (nomessage
))
1155 Lisp_Object msg_file
;
1156 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1157 message_with_string ("Source file `%s' newer than byte-compiled file",
1166 /* We are loading a source file (*.el). */
1167 if (!NILP (Vload_source_file_function
))
1173 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1174 NILP (noerror
) ? Qnil
: Qt
,
1175 NILP (nomessage
) ? Qnil
: Qt
);
1176 return unbind_to (count
, val
);
1180 GCPRO3 (file
, found
, hist_file_name
);
1184 efound
= ENCODE_FILE (found
);
1185 stream
= fopen ((char *) SDATA (efound
), fmode
);
1186 #else /* not WINDOWSNT */
1187 stream
= fdopen (fd
, fmode
);
1188 #endif /* not WINDOWSNT */
1192 error ("Failure to create stdio stream for %s", SDATA (file
));
1195 if (! NILP (Vpurify_flag
))
1196 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1198 if (NILP (nomessage
))
1201 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1204 message_with_string ("Loading %s (source)...", file
, 1);
1206 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1208 else /* The typical case; compiled file newer than source file. */
1209 message_with_string ("Loading %s...", file
, 1);
1212 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1213 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1214 specbind (Qload_file_name
, found
);
1215 specbind (Qinhibit_file_name_operation
, Qnil
);
1216 load_descriptor_list
1217 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1219 if (! version
|| version
>= 22)
1220 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1221 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1224 /* We can't handle a file which was compiled with
1225 byte-compile-dynamic by older version of Emacs. */
1226 specbind (Qload_force_doc_strings
, Qt
);
1227 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1228 0, Qnil
, Qnil
, Qnil
, Qnil
);
1230 unbind_to (count
, Qnil
);
1232 /* Run any eval-after-load forms for this file */
1233 if (NILP (Vpurify_flag
)
1234 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1235 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1239 if (saved_doc_string
)
1240 free (saved_doc_string
);
1241 saved_doc_string
= 0;
1242 saved_doc_string_size
= 0;
1244 if (prev_saved_doc_string
)
1245 xfree (prev_saved_doc_string
);
1246 prev_saved_doc_string
= 0;
1247 prev_saved_doc_string_size
= 0;
1249 if (!noninteractive
&& NILP (nomessage
))
1252 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1255 message_with_string ("Loading %s (source)...done", file
, 1);
1257 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1259 else /* The typical case; compiled file newer than source file. */
1260 message_with_string ("Loading %s...done", file
, 1);
1263 if (!NILP (Fequal (build_string ("obsolete"),
1264 Ffile_name_nondirectory
1265 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1266 message_with_string ("Package %s is obsolete", file
, 1);
1272 load_unwind (arg
) /* used as unwind-protect function in load */
1275 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1282 if (--load_in_progress
< 0) load_in_progress
= 0;
1287 load_descriptor_unwind (oldlist
)
1288 Lisp_Object oldlist
;
1290 load_descriptor_list
= oldlist
;
1294 /* Close all descriptors in use for Floads.
1295 This is used when starting a subprocess. */
1302 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1303 emacs_close (XFASTINT (XCAR (tail
)));
1308 complete_filename_p (pathname
)
1309 Lisp_Object pathname
;
1311 register const unsigned char *s
= SDATA (pathname
);
1312 return (IS_DIRECTORY_SEP (s
[0])
1313 || (SCHARS (pathname
) > 2
1314 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1324 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1325 doc
: /* Search for FILENAME through PATH.
1326 Returns the file's name in absolute form, or nil if not found.
1327 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1328 file name when searching.
1329 If non-nil, PREDICATE is used instead of `file-readable-p'.
1330 PREDICATE can also be an integer to pass to the access(2) function,
1331 in which case file-name-handlers are ignored. */)
1332 (filename
, path
, suffixes
, predicate
)
1333 Lisp_Object filename
, path
, suffixes
, predicate
;
1336 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1337 if (NILP (predicate
) && fd
> 0)
1343 /* Search for a file whose name is STR, looking in directories
1344 in the Lisp list PATH, and trying suffixes from SUFFIX.
1345 On success, returns a file descriptor. On failure, returns -1.
1347 SUFFIXES is a list of strings containing possible suffixes.
1348 The empty suffix is automatically added if the list is empty.
1350 PREDICATE non-nil means don't open the files,
1351 just look for one that satisfies the predicate. In this case,
1352 returns 1 on success. The predicate can be a lisp function or
1353 an integer to pass to `access' (in which case file-name-handlers
1356 If STOREPTR is nonzero, it points to a slot where the name of
1357 the file actually found should be stored as a Lisp string.
1358 nil is stored there on failure.
1360 If the file we find is remote, return -2
1361 but store the found remote file name in *STOREPTR. */
1364 openp (path
, str
, suffixes
, storeptr
, predicate
)
1365 Lisp_Object path
, str
;
1366 Lisp_Object suffixes
;
1367 Lisp_Object
*storeptr
;
1368 Lisp_Object predicate
;
1373 register char *fn
= buf
;
1376 Lisp_Object filename
;
1378 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1379 Lisp_Object string
, tail
, encoded_fn
;
1380 int max_suffix_len
= 0;
1384 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1386 CHECK_STRING_CAR (tail
);
1387 max_suffix_len
= max (max_suffix_len
,
1388 SBYTES (XCAR (tail
)));
1391 string
= filename
= encoded_fn
= Qnil
;
1392 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1397 if (complete_filename_p (str
))
1400 for (; CONSP (path
); path
= XCDR (path
))
1402 filename
= Fexpand_file_name (str
, XCAR (path
));
1403 if (!complete_filename_p (filename
))
1404 /* If there are non-absolute elts in PATH (eg ".") */
1405 /* Of course, this could conceivably lose if luser sets
1406 default-directory to be something non-absolute... */
1408 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1409 if (!complete_filename_p (filename
))
1410 /* Give up on this path element! */
1414 /* Calculate maximum size of any filename made from
1415 this path element/specified file name and any possible suffix. */
1416 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1417 if (fn_size
< want_size
)
1418 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1420 /* Loop over suffixes. */
1421 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1422 CONSP (tail
); tail
= XCDR (tail
))
1424 int lsuffix
= SBYTES (XCAR (tail
));
1425 Lisp_Object handler
;
1428 /* Concatenate path element/specified name with the suffix.
1429 If the directory starts with /:, remove that. */
1430 if (SCHARS (filename
) > 2
1431 && SREF (filename
, 0) == '/'
1432 && SREF (filename
, 1) == ':')
1434 strncpy (fn
, SDATA (filename
) + 2,
1435 SBYTES (filename
) - 2);
1436 fn
[SBYTES (filename
) - 2] = 0;
1440 strncpy (fn
, SDATA (filename
),
1442 fn
[SBYTES (filename
)] = 0;
1445 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1446 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1448 /* Check that the file exists and is not a directory. */
1449 /* We used to only check for handlers on non-absolute file names:
1453 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1454 It's not clear why that was the case and it breaks things like
1455 (load "/bar.el") where the file is actually "/bar.el.gz". */
1456 string
= build_string (fn
);
1457 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1458 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1460 if (NILP (predicate
))
1461 exists
= !NILP (Ffile_readable_p (string
));
1463 exists
= !NILP (call1 (predicate
, string
));
1464 if (exists
&& !NILP (Ffile_directory_p (string
)))
1469 /* We succeeded; return this descriptor and filename. */
1480 encoded_fn
= ENCODE_FILE (string
);
1481 pfn
= SDATA (encoded_fn
);
1482 exists
= (stat (pfn
, &st
) >= 0
1483 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1486 /* Check that we can access or open it. */
1487 if (NATNUMP (predicate
))
1488 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1490 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1494 /* We succeeded; return this descriptor and filename. */
1512 /* Merge the list we've accumulated of globals from the current input source
1513 into the load_history variable. The details depend on whether
1514 the source has an associated file name or not.
1516 FILENAME is the file name that we are loading from.
1517 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1520 build_load_history (filename
, entire
)
1521 Lisp_Object filename
;
1524 register Lisp_Object tail
, prev
, newelt
;
1525 register Lisp_Object tem
, tem2
;
1526 register int foundit
= 0;
1528 tail
= Vload_history
;
1531 while (CONSP (tail
))
1535 /* Find the feature's previous assoc list... */
1536 if (!NILP (Fequal (filename
, Fcar (tem
))))
1540 /* If we're loading the entire file, remove old data. */
1544 Vload_history
= XCDR (tail
);
1546 Fsetcdr (prev
, XCDR (tail
));
1549 /* Otherwise, cons on new symbols that are not already members. */
1552 tem2
= Vcurrent_load_list
;
1554 while (CONSP (tem2
))
1556 newelt
= XCAR (tem2
);
1558 if (NILP (Fmember (newelt
, tem
)))
1559 Fsetcar (tail
, Fcons (XCAR (tem
),
1560 Fcons (newelt
, XCDR (tem
))));
1573 /* If we're loading an entire file, cons the new assoc onto the
1574 front of load-history, the most-recently-loaded position. Also
1575 do this if we didn't find an existing member for the file. */
1576 if (entire
|| !foundit
)
1577 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1582 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1590 readevalloop_1 (old
)
1593 load_convert_to_unibyte
= ! NILP (old
);
1597 /* Signal an `end-of-file' error, if possible with file name
1601 end_of_file_error ()
1603 if (STRINGP (Vload_file_name
))
1604 xsignal1 (Qend_of_file
, Vload_file_name
);
1606 xsignal0 (Qend_of_file
);
1609 /* UNIBYTE specifies how to set load_convert_to_unibyte
1610 for this invocation.
1611 READFUN, if non-nil, is used instead of `read'.
1613 START, END specify region to read in current buffer (from eval-region).
1614 If the input is not from a buffer, they must be nil. */
1617 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1618 printflag
, unibyte
, readfun
, start
, end
)
1619 Lisp_Object readcharfun
;
1621 Lisp_Object sourcename
;
1622 Lisp_Object (*evalfun
) ();
1624 Lisp_Object unibyte
, readfun
;
1625 Lisp_Object start
, end
;
1628 register Lisp_Object val
;
1629 int count
= SPECPDL_INDEX ();
1630 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1631 struct buffer
*b
= 0;
1632 int continue_reading_p
;
1633 /* Nonzero if reading an entire buffer. */
1634 int whole_buffer
= 0;
1635 /* 1 on the first time around. */
1638 if (MARKERP (readcharfun
))
1641 start
= readcharfun
;
1644 if (BUFFERP (readcharfun
))
1645 b
= XBUFFER (readcharfun
);
1646 else if (MARKERP (readcharfun
))
1647 b
= XMARKER (readcharfun
)->buffer
;
1649 /* We assume START is nil when input is not from a buffer. */
1650 if (! NILP (start
) && !b
)
1653 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1654 specbind (Qcurrent_load_list
, Qnil
);
1655 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1656 load_convert_to_unibyte
= !NILP (unibyte
);
1658 GCPRO4 (sourcename
, readfun
, start
, end
);
1660 /* Try to ensure sourcename is a truename, except whilst preloading. */
1661 if (NILP (Vpurify_flag
)
1662 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1663 && !NILP (Ffboundp (Qfile_truename
)))
1664 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1666 LOADHIST_ATTACH (sourcename
);
1668 continue_reading_p
= 1;
1669 while (continue_reading_p
)
1671 int count1
= SPECPDL_INDEX ();
1673 if (b
!= 0 && NILP (b
->name
))
1674 error ("Reading from killed buffer");
1678 /* Switch to the buffer we are reading from. */
1679 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1680 set_buffer_internal (b
);
1682 /* Save point in it. */
1683 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1684 /* Save ZV in it. */
1685 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1686 /* Those get unbound after we read one expression. */
1688 /* Set point and ZV around stuff to be read. */
1691 Fnarrow_to_region (make_number (BEGV
), end
);
1693 /* Just for cleanliness, convert END to a marker
1694 if it is an integer. */
1696 end
= Fpoint_max_marker ();
1699 /* On the first cycle, we can easily test here
1700 whether we are reading the whole buffer. */
1701 if (b
&& first_sexp
)
1702 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1709 while ((c
= READCHAR
) != '\n' && c
!= -1);
1714 unbind_to (count1
, Qnil
);
1718 /* Ignore whitespace here, so we can detect eof. */
1719 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1720 || c
== 0x8a0) /* NBSP */
1723 if (!NILP (Vpurify_flag
) && c
== '(')
1725 record_unwind_protect (unreadpure
, Qnil
);
1726 val
= read_list (-1, readcharfun
);
1731 read_objects
= Qnil
;
1732 if (!NILP (readfun
))
1734 val
= call1 (readfun
, readcharfun
);
1736 /* If READCHARFUN has set point to ZV, we should
1737 stop reading, even if the form read sets point
1738 to a different value when evaluated. */
1739 if (BUFFERP (readcharfun
))
1741 struct buffer
*b
= XBUFFER (readcharfun
);
1742 if (BUF_PT (b
) == BUF_ZV (b
))
1743 continue_reading_p
= 0;
1746 else if (! NILP (Vload_read_function
))
1747 val
= call1 (Vload_read_function
, readcharfun
);
1749 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1752 if (!NILP (start
) && continue_reading_p
)
1753 start
= Fpoint_marker ();
1755 /* Restore saved point and BEGV. */
1756 unbind_to (count1
, Qnil
);
1758 /* Now eval what we just read. */
1759 val
= (*evalfun
) (val
);
1763 Vvalues
= Fcons (val
, Vvalues
);
1764 if (EQ (Vstandard_output
, Qt
))
1773 build_load_history (sourcename
,
1774 stream
|| whole_buffer
);
1778 unbind_to (count
, Qnil
);
1781 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1782 doc
: /* Execute the current buffer as Lisp code.
1783 Programs can pass two arguments, BUFFER and PRINTFLAG.
1784 BUFFER is the buffer to evaluate (nil means use current buffer).
1785 PRINTFLAG controls printing of output:
1786 A value of nil means discard it; anything else is stream for print.
1788 If the optional third argument FILENAME is non-nil,
1789 it specifies the file name to use for `load-history'.
1790 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1791 for this invocation.
1793 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1794 `print' and related functions should work normally even if PRINTFLAG is nil.
1796 This function preserves the position of point. */)
1797 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1798 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1800 int count
= SPECPDL_INDEX ();
1801 Lisp_Object tem
, buf
;
1804 buf
= Fcurrent_buffer ();
1806 buf
= Fget_buffer (buffer
);
1808 error ("No such buffer");
1810 if (NILP (printflag
) && NILP (do_allow_print
))
1815 if (NILP (filename
))
1816 filename
= XBUFFER (buf
)->filename
;
1818 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1819 specbind (Qstandard_output
, tem
);
1820 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1821 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1822 readevalloop (buf
, 0, filename
, Feval
,
1823 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1824 unbind_to (count
, Qnil
);
1829 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1830 doc
: /* Execute the region as Lisp code.
1831 When called from programs, expects two arguments,
1832 giving starting and ending indices in the current buffer
1833 of the text to be executed.
1834 Programs can pass third argument PRINTFLAG which controls output:
1835 A value of nil means discard it; anything else is stream for printing it.
1836 Also the fourth argument READ-FUNCTION, if non-nil, is used
1837 instead of `read' to read each expression. It gets one argument
1838 which is the input stream for reading characters.
1840 This function does not move point. */)
1841 (start
, end
, printflag
, read_function
)
1842 Lisp_Object start
, end
, printflag
, read_function
;
1844 int count
= SPECPDL_INDEX ();
1845 Lisp_Object tem
, cbuf
;
1847 cbuf
= Fcurrent_buffer ();
1849 if (NILP (printflag
))
1853 specbind (Qstandard_output
, tem
);
1854 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1856 /* readevalloop calls functions which check the type of start and end. */
1857 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1858 !NILP (printflag
), Qnil
, read_function
,
1861 return unbind_to (count
, Qnil
);
1865 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1866 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1867 If STREAM is nil, use the value of `standard-input' (which see).
1868 STREAM or the value of `standard-input' may be:
1869 a buffer (read from point and advance it)
1870 a marker (read from where it points and advance it)
1871 a function (call it with no arguments for each character,
1872 call it with a char as argument to push a char back)
1873 a string (takes text from string, starting at the beginning)
1874 t (read text line using minibuffer and use it, or read from
1875 standard input in batch mode). */)
1880 stream
= Vstandard_input
;
1881 if (EQ (stream
, Qt
))
1882 stream
= Qread_char
;
1883 if (EQ (stream
, Qread_char
))
1884 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1886 return read_internal_start (stream
, Qnil
, Qnil
);
1889 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1890 doc
: /* Read one Lisp expression which is represented as text by STRING.
1891 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1892 START and END optionally delimit a substring of STRING from which to read;
1893 they default to 0 and (length STRING) respectively. */)
1894 (string
, start
, end
)
1895 Lisp_Object string
, start
, end
;
1898 CHECK_STRING (string
);
1899 /* read_internal_start sets read_from_string_index. */
1900 ret
= read_internal_start (string
, start
, end
);
1901 return Fcons (ret
, make_number (read_from_string_index
));
1904 /* Function to set up the global context we need in toplevel read
1907 read_internal_start (stream
, start
, end
)
1909 Lisp_Object start
; /* Only used when stream is a string. */
1910 Lisp_Object end
; /* Only used when stream is a string. */
1915 new_backquote_flag
= 0;
1916 read_objects
= Qnil
;
1917 if (EQ (Vread_with_symbol_positions
, Qt
)
1918 || EQ (Vread_with_symbol_positions
, stream
))
1919 Vread_symbol_positions_list
= Qnil
;
1921 if (STRINGP (stream
)
1922 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1924 int startval
, endval
;
1927 if (STRINGP (stream
))
1930 string
= XCAR (stream
);
1933 endval
= SCHARS (string
);
1937 endval
= XINT (end
);
1938 if (endval
< 0 || endval
> SCHARS (string
))
1939 args_out_of_range (string
, end
);
1946 CHECK_NUMBER (start
);
1947 startval
= XINT (start
);
1948 if (startval
< 0 || startval
> endval
)
1949 args_out_of_range (string
, start
);
1951 read_from_string_index
= startval
;
1952 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1953 read_from_string_limit
= endval
;
1956 retval
= read0 (stream
);
1957 if (EQ (Vread_with_symbol_positions
, Qt
)
1958 || EQ (Vread_with_symbol_positions
, stream
))
1959 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1964 /* Signal Qinvalid_read_syntax error.
1965 S is error string of length N (if > 0) */
1968 invalid_syntax (s
, n
)
1974 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1978 /* Use this for recursive reads, in contexts where internal tokens
1983 Lisp_Object readcharfun
;
1985 register Lisp_Object val
;
1988 val
= read1 (readcharfun
, &c
, 0);
1992 xsignal1 (Qinvalid_read_syntax
,
1993 Fmake_string (make_number (1), make_number (c
)));
1996 static int read_buffer_size
;
1997 static char *read_buffer
;
1999 /* Read a \-escape sequence, assuming we already read the `\'.
2000 If the escape sequence forces unibyte, return eight-bit char. */
2003 read_escape (readcharfun
, stringp
)
2004 Lisp_Object readcharfun
;
2007 register int c
= READCHAR
;
2008 /* \u allows up to four hex digits, \U up to eight. Default to the
2009 behaviour for \u, and change this value in the case that \U is seen. */
2010 int unicode_hex_count
= 4;
2015 end_of_file_error ();
2045 error ("Invalid escape character syntax");
2048 c
= read_escape (readcharfun
, 0);
2049 return c
| meta_modifier
;
2054 error ("Invalid escape character syntax");
2057 c
= read_escape (readcharfun
, 0);
2058 return c
| shift_modifier
;
2063 error ("Invalid escape character syntax");
2066 c
= read_escape (readcharfun
, 0);
2067 return c
| hyper_modifier
;
2072 error ("Invalid escape character syntax");
2075 c
= read_escape (readcharfun
, 0);
2076 return c
| alt_modifier
;
2080 if (stringp
|| c
!= '-')
2087 c
= read_escape (readcharfun
, 0);
2088 return c
| super_modifier
;
2093 error ("Invalid escape character syntax");
2097 c
= read_escape (readcharfun
, 0);
2098 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2099 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2100 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2101 return c
| ctrl_modifier
;
2102 /* ASCII control chars are made from letters (both cases),
2103 as well as the non-letters within 0100...0137. */
2104 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2105 return (c
& (037 | ~0177));
2106 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2107 return (c
& (037 | ~0177));
2109 return c
| ctrl_modifier
;
2119 /* An octal escape, as in ANSI C. */
2121 register int i
= c
- '0';
2122 register int count
= 0;
2125 if ((c
= READCHAR
) >= '0' && c
<= '7')
2137 if (i
>= 0x80 && i
< 0x100)
2138 i
= BYTE8_TO_CHAR (i
);
2143 /* A hex escape, as in ANSI C. */
2150 if (c
>= '0' && c
<= '9')
2155 else if ((c
>= 'a' && c
<= 'f')
2156 || (c
>= 'A' && c
<= 'F'))
2159 if (c
>= 'a' && c
<= 'f')
2172 if (count
< 3 && i
>= 0x80)
2173 return BYTE8_TO_CHAR (i
);
2178 /* Post-Unicode-2.0: Up to eight hex chars. */
2179 unicode_hex_count
= 8;
2182 /* A Unicode escape. We only permit them in strings and characters,
2183 not arbitrarily in the source code, as in some other languages. */
2188 while (++count
<= unicode_hex_count
)
2191 /* isdigit and isalpha may be locale-specific, which we don't
2193 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2194 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2195 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2198 error ("Non-hex digit used for Unicode escape");
2211 /* Read an integer in radix RADIX using READCHARFUN to read
2212 characters. RADIX must be in the interval [2..36]; if it isn't, a
2213 read error is signaled . Value is the integer read. Signals an
2214 error if encountering invalid read syntax or if RADIX is out of
2218 read_integer (readcharfun
, radix
)
2219 Lisp_Object readcharfun
;
2222 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2223 EMACS_INT number
= 0;
2225 if (radix
< 2 || radix
> 36)
2229 number
= ndigits
= invalid_p
= 0;
2245 if (c
>= '0' && c
<= '9')
2247 else if (c
>= 'a' && c
<= 'z')
2248 digit
= c
- 'a' + 10;
2249 else if (c
>= 'A' && c
<= 'Z')
2250 digit
= c
- 'A' + 10;
2257 if (digit
< 0 || digit
>= radix
)
2260 number
= radix
* number
+ digit
;
2266 if (ndigits
== 0 || invalid_p
)
2269 sprintf (buf
, "integer, radix %d", radix
);
2270 invalid_syntax (buf
, 0);
2273 return make_number (sign
* number
);
2277 /* If the next token is ')' or ']' or '.', we store that character
2278 in *PCH and the return value is not interesting. Else, we store
2279 zero in *PCH and we read and return one lisp object.
2281 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2284 read1 (readcharfun
, pch
, first_in_list
)
2285 register Lisp_Object readcharfun
;
2290 int uninterned_symbol
= 0;
2299 end_of_file_error ();
2304 return read_list (0, readcharfun
);
2307 return read_vector (readcharfun
, 0);
2324 tmp
= read_vector (readcharfun
, 0);
2325 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2326 error ("Invalid size char-table");
2327 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2338 tmp
= read_vector (readcharfun
, 0);
2339 if (!INTEGERP (AREF (tmp
, 0)))
2340 error ("Invalid depth in char-table");
2341 depth
= XINT (AREF (tmp
, 0));
2342 if (depth
< 1 || depth
> 3)
2343 error ("Invalid depth in char-table");
2344 size
= XVECTOR (tmp
)->size
- 2;
2345 if (chartab_size
[depth
] != size
)
2346 error ("Invalid size char-table");
2347 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2350 invalid_syntax ("#^^", 3);
2352 invalid_syntax ("#^", 2);
2357 length
= read1 (readcharfun
, pch
, first_in_list
);
2361 Lisp_Object tmp
, val
;
2363 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2364 / BOOL_VECTOR_BITS_PER_CHAR
);
2367 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2368 if (STRING_MULTIBYTE (tmp
)
2369 || (size_in_chars
!= SCHARS (tmp
)
2370 /* We used to print 1 char too many
2371 when the number of bits was a multiple of 8.
2372 Accept such input in case it came from an old
2374 && ! (XFASTINT (length
)
2375 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2376 invalid_syntax ("#&...", 5);
2378 val
= Fmake_bool_vector (length
, Qnil
);
2379 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2381 /* Clear the extraneous bits in the last byte. */
2382 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2383 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2384 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2387 invalid_syntax ("#&...", 5);
2391 /* Accept compiled functions at read-time so that we don't have to
2392 build them using function calls. */
2394 tmp
= read_vector (readcharfun
, 1);
2395 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2396 XVECTOR (tmp
)->contents
);
2401 struct gcpro gcpro1
;
2404 /* Read the string itself. */
2405 tmp
= read1 (readcharfun
, &ch
, 0);
2406 if (ch
!= 0 || !STRINGP (tmp
))
2407 invalid_syntax ("#", 1);
2409 /* Read the intervals and their properties. */
2412 Lisp_Object beg
, end
, plist
;
2414 beg
= read1 (readcharfun
, &ch
, 0);
2419 end
= read1 (readcharfun
, &ch
, 0);
2421 plist
= read1 (readcharfun
, &ch
, 0);
2423 invalid_syntax ("Invalid string property list", 0);
2424 Fset_text_properties (beg
, end
, plist
, tmp
);
2430 /* #@NUMBER is used to skip NUMBER following characters.
2431 That's used in .elc files to skip over doc strings
2432 and function definitions. */
2438 /* Read a decimal integer. */
2439 while ((c
= READCHAR
) >= 0
2440 && c
>= '0' && c
<= '9')
2448 if (load_force_doc_strings
2449 && (EQ (readcharfun
, Qget_file_char
)
2450 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2452 /* If we are supposed to force doc strings into core right now,
2453 record the last string that we skipped,
2454 and record where in the file it comes from. */
2456 /* But first exchange saved_doc_string
2457 with prev_saved_doc_string, so we save two strings. */
2459 char *temp
= saved_doc_string
;
2460 int temp_size
= saved_doc_string_size
;
2461 file_offset temp_pos
= saved_doc_string_position
;
2462 int temp_len
= saved_doc_string_length
;
2464 saved_doc_string
= prev_saved_doc_string
;
2465 saved_doc_string_size
= prev_saved_doc_string_size
;
2466 saved_doc_string_position
= prev_saved_doc_string_position
;
2467 saved_doc_string_length
= prev_saved_doc_string_length
;
2469 prev_saved_doc_string
= temp
;
2470 prev_saved_doc_string_size
= temp_size
;
2471 prev_saved_doc_string_position
= temp_pos
;
2472 prev_saved_doc_string_length
= temp_len
;
2475 if (saved_doc_string_size
== 0)
2477 saved_doc_string_size
= nskip
+ 100;
2478 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2480 if (nskip
> saved_doc_string_size
)
2482 saved_doc_string_size
= nskip
+ 100;
2483 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2484 saved_doc_string_size
);
2487 saved_doc_string_position
= file_tell (instream
);
2489 /* Copy that many characters into saved_doc_string. */
2490 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2491 saved_doc_string
[i
] = c
= READCHAR
;
2493 saved_doc_string_length
= i
;
2497 /* Skip that many characters. */
2498 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2507 /* #! appears at the beginning of an executable file.
2508 Skip the first line. */
2509 while (c
!= '\n' && c
>= 0)
2514 return Vload_file_name
;
2516 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2517 /* #:foo is the uninterned symbol named foo. */
2520 uninterned_symbol
= 1;
2524 /* Reader forms that can reuse previously read objects. */
2525 if (c
>= '0' && c
<= '9')
2530 /* Read a non-negative integer. */
2531 while (c
>= '0' && c
<= '9')
2537 /* #n=object returns object, but associates it with n for #n#. */
2540 /* Make a placeholder for #n# to use temporarily */
2541 Lisp_Object placeholder
;
2544 placeholder
= Fcons(Qnil
, Qnil
);
2545 cell
= Fcons (make_number (n
), placeholder
);
2546 read_objects
= Fcons (cell
, read_objects
);
2548 /* Read the object itself. */
2549 tem
= read0 (readcharfun
);
2551 /* Now put it everywhere the placeholder was... */
2552 substitute_object_in_subtree (tem
, placeholder
);
2554 /* ...and #n# will use the real value from now on. */
2555 Fsetcdr (cell
, tem
);
2559 /* #n# returns a previously read object. */
2562 tem
= Fassq (make_number (n
), read_objects
);
2565 /* Fall through to error message. */
2567 else if (c
== 'r' || c
== 'R')
2568 return read_integer (readcharfun
, n
);
2570 /* Fall through to error message. */
2572 else if (c
== 'x' || c
== 'X')
2573 return read_integer (readcharfun
, 16);
2574 else if (c
== 'o' || c
== 'O')
2575 return read_integer (readcharfun
, 8);
2576 else if (c
== 'b' || c
== 'B')
2577 return read_integer (readcharfun
, 2);
2580 invalid_syntax ("#", 1);
2583 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2588 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2594 Vold_style_backquotes
= Qt
;
2601 new_backquote_flag
++;
2602 value
= read0 (readcharfun
);
2603 new_backquote_flag
--;
2605 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2609 if (new_backquote_flag
)
2611 Lisp_Object comma_type
= Qnil
;
2616 comma_type
= Qcomma_at
;
2618 comma_type
= Qcomma_dot
;
2621 if (ch
>= 0) UNREAD (ch
);
2622 comma_type
= Qcomma
;
2625 new_backquote_flag
--;
2626 value
= read0 (readcharfun
);
2627 new_backquote_flag
++;
2628 return Fcons (comma_type
, Fcons (value
, Qnil
));
2632 Vold_style_backquotes
= Qt
;
2644 end_of_file_error ();
2646 /* Accept `single space' syntax like (list ? x) where the
2647 whitespace character is SPC or TAB.
2648 Other literal whitespace like NL, CR, and FF are not accepted,
2649 as there are well-established escape sequences for these. */
2650 if (c
== ' ' || c
== '\t')
2651 return make_number (c
);
2654 c
= read_escape (readcharfun
, 0);
2655 modifiers
= c
& CHAR_MODIFIER_MASK
;
2656 c
&= ~CHAR_MODIFIER_MASK
;
2657 if (CHAR_BYTE8_P (c
))
2658 c
= CHAR_TO_BYTE8 (c
);
2661 next_char
= READCHAR
;
2662 if (next_char
== '.')
2664 /* Only a dotted-pair dot is valid after a char constant. */
2665 int next_next_char
= READCHAR
;
2666 UNREAD (next_next_char
);
2668 ok
= (next_next_char
<= 040
2669 || (next_next_char
< 0200
2670 && (index ("\"';([#?", next_next_char
)
2671 || (!first_in_list
&& next_next_char
== '`')
2672 || (new_backquote_flag
&& next_next_char
== ','))));
2676 ok
= (next_char
<= 040
2677 || (next_char
< 0200
2678 && (index ("\"';()[]#?", next_char
)
2679 || (!first_in_list
&& next_char
== '`')
2680 || (new_backquote_flag
&& next_char
== ','))));
2684 return make_number (c
);
2686 invalid_syntax ("?", 1);
2691 char *p
= read_buffer
;
2692 char *end
= read_buffer
+ read_buffer_size
;
2694 /* Nonzero if we saw an escape sequence specifying
2695 a multibyte character. */
2696 int force_multibyte
= 0;
2697 /* Nonzero if we saw an escape sequence specifying
2698 a single-byte character. */
2699 int force_singlebyte
= 0;
2703 while ((c
= READCHAR
) >= 0
2706 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2708 int offset
= p
- read_buffer
;
2709 read_buffer
= (char *) xrealloc (read_buffer
,
2710 read_buffer_size
*= 2);
2711 p
= read_buffer
+ offset
;
2712 end
= read_buffer
+ read_buffer_size
;
2719 c
= read_escape (readcharfun
, 1);
2721 /* C is -1 if \ newline has just been seen */
2724 if (p
== read_buffer
)
2729 modifiers
= c
& CHAR_MODIFIER_MASK
;
2730 c
= c
& ~CHAR_MODIFIER_MASK
;
2732 if (CHAR_BYTE8_P (c
))
2733 force_singlebyte
= 1;
2734 else if (! ASCII_CHAR_P (c
))
2735 force_multibyte
= 1;
2736 else /* i.e. ASCII_CHAR_P (c) */
2738 /* Allow `\C- ' and `\C-?'. */
2739 if (modifiers
== CHAR_CTL
)
2742 c
= 0, modifiers
= 0;
2744 c
= 127, modifiers
= 0;
2746 if (modifiers
& CHAR_SHIFT
)
2748 /* Shift modifier is valid only with [A-Za-z]. */
2749 if (c
>= 'A' && c
<= 'Z')
2750 modifiers
&= ~CHAR_SHIFT
;
2751 else if (c
>= 'a' && c
<= 'z')
2752 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2755 if (modifiers
& CHAR_META
)
2757 /* Move the meta bit to the right place for a
2759 modifiers
&= ~CHAR_META
;
2760 c
= BYTE8_TO_CHAR (c
| 0x80);
2761 force_singlebyte
= 1;
2765 /* Any modifiers remaining are invalid. */
2767 error ("Invalid modifier in string");
2768 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2772 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2773 if (CHAR_BYTE8_P (c
))
2774 force_singlebyte
= 1;
2775 else if (! ASCII_CHAR_P (c
))
2776 force_multibyte
= 1;
2782 end_of_file_error ();
2784 /* If purifying, and string starts with \ newline,
2785 return zero instead. This is for doc strings
2786 that we are really going to find in etc/DOC.nn.nn */
2787 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2788 return make_number (0);
2790 if (force_multibyte
)
2791 /* READ_BUFFER already contains valid multibyte forms. */
2793 else if (force_singlebyte
)
2795 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2796 p
= read_buffer
+ nchars
;
2799 /* Otherwise, READ_BUFFER contains only ASCII. */
2802 /* We want readchar_count to be the number of characters, not
2803 bytes. Hence we adjust for multibyte characters in the
2804 string. ... But it doesn't seem to be necessary, because
2805 READCHAR *does* read multibyte characters from buffers. */
2806 /* readchar_count -= (p - read_buffer) - nchars; */
2808 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2810 || (p
- read_buffer
!= nchars
)));
2811 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2813 || (p
- read_buffer
!= nchars
)));
2818 int next_char
= READCHAR
;
2821 if (next_char
<= 040
2822 || (next_char
< 0200
2823 && (index ("\"';([#?", next_char
)
2824 || (!first_in_list
&& next_char
== '`')
2825 || (new_backquote_flag
&& next_char
== ','))))
2831 /* Otherwise, we fall through! Note that the atom-reading loop
2832 below will now loop at least once, assuring that we will not
2833 try to UNREAD two characters in a row. */
2837 if (c
<= 040) goto retry
;
2838 if (c
== 0x8a0) /* NBSP */
2841 char *p
= read_buffer
;
2845 char *end
= read_buffer
+ read_buffer_size
;
2848 && c
!= 0x8a0 /* NBSP */
2850 || (!index ("\"';()[]#", c
)
2851 && !(!first_in_list
&& c
== '`')
2852 && !(new_backquote_flag
&& c
== ','))))
2854 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2856 int offset
= p
- read_buffer
;
2857 read_buffer
= (char *) xrealloc (read_buffer
,
2858 read_buffer_size
*= 2);
2859 p
= read_buffer
+ offset
;
2860 end
= read_buffer
+ read_buffer_size
;
2867 end_of_file_error ();
2871 p
+= CHAR_STRING (c
, p
);
2877 int offset
= p
- read_buffer
;
2878 read_buffer
= (char *) xrealloc (read_buffer
,
2879 read_buffer_size
*= 2);
2880 p
= read_buffer
+ offset
;
2881 end
= read_buffer
+ read_buffer_size
;
2888 if (!quoted
&& !uninterned_symbol
)
2891 register Lisp_Object val
;
2893 if (*p1
== '+' || *p1
== '-') p1
++;
2894 /* Is it an integer? */
2897 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2898 /* Integers can have trailing decimal points. */
2899 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2901 /* It is an integer. */
2905 /* Fixme: if we have strtol, use that, and check
2907 if (sizeof (int) == sizeof (EMACS_INT
))
2908 XSETINT (val
, atoi (read_buffer
));
2909 else if (sizeof (long) == sizeof (EMACS_INT
))
2910 XSETINT (val
, atol (read_buffer
));
2916 if (isfloat_string (read_buffer
))
2918 /* Compute NaN and infinities using 0.0 in a variable,
2919 to cope with compilers that think they are smarter
2925 /* Negate the value ourselves. This treats 0, NaNs,
2926 and infinity properly on IEEE floating point hosts,
2927 and works around a common bug where atof ("-0.0")
2929 int negative
= read_buffer
[0] == '-';
2931 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2932 returns 1, is if the input ends in e+INF or e+NaN. */
2939 value
= zero
/ zero
;
2941 /* If that made a "negative" NaN, negate it. */
2945 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2948 u_minus_zero
.d
= - 0.0;
2949 for (i
= 0; i
< sizeof (double); i
++)
2950 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2956 /* Now VALUE is a positive NaN. */
2959 value
= atof (read_buffer
+ negative
);
2963 return make_float (negative
? - value
: value
);
2967 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2968 : intern (read_buffer
);
2969 if (EQ (Vread_with_symbol_positions
, Qt
)
2970 || EQ (Vread_with_symbol_positions
, readcharfun
))
2971 Vread_symbol_positions_list
=
2972 /* Kind of a hack; this will probably fail if characters
2973 in the symbol name were escaped. Not really a big
2975 Fcons (Fcons (result
,
2976 make_number (readchar_count
2977 - XFASTINT (Flength (Fsymbol_name (result
))))),
2978 Vread_symbol_positions_list
);
2986 /* List of nodes we've seen during substitute_object_in_subtree. */
2987 static Lisp_Object seen_list
;
2990 substitute_object_in_subtree (object
, placeholder
)
2992 Lisp_Object placeholder
;
2994 Lisp_Object check_object
;
2996 /* We haven't seen any objects when we start. */
2999 /* Make all the substitutions. */
3001 = substitute_object_recurse (object
, placeholder
, object
);
3003 /* Clear seen_list because we're done with it. */
3006 /* The returned object here is expected to always eq the
3008 if (!EQ (check_object
, object
))
3009 error ("Unexpected mutation error in reader");
3012 /* Feval doesn't get called from here, so no gc protection is needed. */
3013 #define SUBSTITUTE(get_val, set_val) \
3015 Lisp_Object old_value = get_val; \
3016 Lisp_Object true_value \
3017 = substitute_object_recurse (object, placeholder,\
3020 if (!EQ (old_value, true_value)) \
3027 substitute_object_recurse (object
, placeholder
, subtree
)
3029 Lisp_Object placeholder
;
3030 Lisp_Object subtree
;
3032 /* If we find the placeholder, return the target object. */
3033 if (EQ (placeholder
, subtree
))
3036 /* If we've been to this node before, don't explore it again. */
3037 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3040 /* If this node can be the entry point to a cycle, remember that
3041 we've seen it. It can only be such an entry point if it was made
3042 by #n=, which means that we can find it as a value in
3044 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3045 seen_list
= Fcons (subtree
, seen_list
);
3047 /* Recurse according to subtree's type.
3048 Every branch must return a Lisp_Object. */
3049 switch (XTYPE (subtree
))
3051 case Lisp_Vectorlike
:
3054 int length
= XINT (Flength(subtree
));
3055 for (i
= 0; i
< length
; i
++)
3057 Lisp_Object idx
= make_number (i
);
3058 SUBSTITUTE (Faref (subtree
, idx
),
3059 Faset (subtree
, idx
, true_value
));
3066 SUBSTITUTE (Fcar_safe (subtree
),
3067 Fsetcar (subtree
, true_value
));
3068 SUBSTITUTE (Fcdr_safe (subtree
),
3069 Fsetcdr (subtree
, true_value
));
3075 /* Check for text properties in each interval.
3076 substitute_in_interval contains part of the logic. */
3078 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3079 Lisp_Object arg
= Fcons (object
, placeholder
);
3081 traverse_intervals_noorder (root_interval
,
3082 &substitute_in_interval
, arg
);
3087 /* Other types don't recurse any further. */
3093 /* Helper function for substitute_object_recurse. */
3095 substitute_in_interval (interval
, arg
)
3099 Lisp_Object object
= Fcar (arg
);
3100 Lisp_Object placeholder
= Fcdr (arg
);
3102 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3121 if (*cp
== '+' || *cp
== '-')
3124 if (*cp
>= '0' && *cp
<= '9')
3127 while (*cp
>= '0' && *cp
<= '9')
3135 if (*cp
>= '0' && *cp
<= '9')
3138 while (*cp
>= '0' && *cp
<= '9')
3141 if (*cp
== 'e' || *cp
== 'E')
3145 if (*cp
== '+' || *cp
== '-')
3149 if (*cp
>= '0' && *cp
<= '9')
3152 while (*cp
>= '0' && *cp
<= '9')
3155 else if (cp
== start
)
3157 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3162 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3168 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3169 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3170 || state
== (DOT_CHAR
|TRAIL_INT
)
3171 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3172 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3173 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3178 read_vector (readcharfun
, bytecodeflag
)
3179 Lisp_Object readcharfun
;
3184 register Lisp_Object
*ptr
;
3185 register Lisp_Object tem
, item
, vector
;
3186 register struct Lisp_Cons
*otem
;
3189 tem
= read_list (1, readcharfun
);
3190 len
= Flength (tem
);
3191 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3193 size
= XVECTOR (vector
)->size
;
3194 ptr
= XVECTOR (vector
)->contents
;
3195 for (i
= 0; i
< size
; i
++)
3198 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3199 bytecode object, the docstring containing the bytecode and
3200 constants values must be treated as unibyte and passed to
3201 Fread, to get the actual bytecode string and constants vector. */
3202 if (bytecodeflag
&& load_force_doc_strings
)
3204 if (i
== COMPILED_BYTECODE
)
3206 if (!STRINGP (item
))
3207 error ("Invalid byte code");
3209 /* Delay handling the bytecode slot until we know whether
3210 it is lazily-loaded (we can tell by whether the
3211 constants slot is nil). */
3212 ptr
[COMPILED_CONSTANTS
] = item
;
3215 else if (i
== COMPILED_CONSTANTS
)
3217 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3221 /* Coerce string to unibyte (like string-as-unibyte,
3222 but without generating extra garbage and
3223 guaranteeing no change in the contents). */
3224 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3225 STRING_SET_UNIBYTE (bytestr
);
3227 item
= Fread (Fcons (bytestr
, readcharfun
));
3229 error ("Invalid byte code");
3231 otem
= XCONS (item
);
3232 bytestr
= XCAR (item
);
3237 /* Now handle the bytecode slot. */
3238 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3240 else if (i
== COMPILED_DOC_STRING
3242 && ! STRING_MULTIBYTE (item
))
3244 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3245 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3247 item
= Fstring_as_multibyte (item
);
3250 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3258 /* FLAG = 1 means check for ] to terminate rather than ) and .
3259 FLAG = -1 means check for starting with defun
3260 and make structure pure. */
3263 read_list (flag
, readcharfun
)
3265 register Lisp_Object readcharfun
;
3267 /* -1 means check next element for defun,
3268 0 means don't check,
3269 1 means already checked and found defun. */
3270 int defunflag
= flag
< 0 ? -1 : 0;
3271 Lisp_Object val
, tail
;
3272 register Lisp_Object elt
, tem
;
3273 struct gcpro gcpro1
, gcpro2
;
3274 /* 0 is the normal case.
3275 1 means this list is a doc reference; replace it with the number 0.
3276 2 means this list is a doc reference; replace it with the doc string. */
3277 int doc_reference
= 0;
3279 /* Initialize this to 1 if we are reading a list. */
3280 int first_in_list
= flag
<= 0;
3289 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3294 /* While building, if the list starts with #$, treat it specially. */
3295 if (EQ (elt
, Vload_file_name
)
3297 && !NILP (Vpurify_flag
))
3299 if (NILP (Vdoc_file_name
))
3300 /* We have not yet called Snarf-documentation, so assume
3301 this file is described in the DOC-MM.NN file
3302 and Snarf-documentation will fill in the right value later.
3303 For now, replace the whole list with 0. */
3306 /* We have already called Snarf-documentation, so make a relative
3307 file name for this file, so it can be found properly
3308 in the installed Lisp directory.
3309 We don't use Fexpand_file_name because that would make
3310 the directory absolute now. */
3311 elt
= concat2 (build_string ("../lisp/"),
3312 Ffile_name_nondirectory (elt
));
3314 else if (EQ (elt
, Vload_file_name
)
3316 && load_force_doc_strings
)
3325 invalid_syntax (") or . in a vector", 18);
3333 XSETCDR (tail
, read0 (readcharfun
));
3335 val
= read0 (readcharfun
);
3336 read1 (readcharfun
, &ch
, 0);
3340 if (doc_reference
== 1)
3341 return make_number (0);
3342 if (doc_reference
== 2)
3344 /* Get a doc string from the file we are loading.
3345 If it's in saved_doc_string, get it from there.
3347 Here, we don't know if the string is a
3348 bytecode string or a doc string. As a
3349 bytecode string must be unibyte, we always
3350 return a unibyte string. If it is actually a
3351 doc string, caller must make it
3354 int pos
= XINT (XCDR (val
));
3355 /* Position is negative for user variables. */
3356 if (pos
< 0) pos
= -pos
;
3357 if (pos
>= saved_doc_string_position
3358 && pos
< (saved_doc_string_position
3359 + saved_doc_string_length
))
3361 int start
= pos
- saved_doc_string_position
;
3364 /* Process quoting with ^A,
3365 and find the end of the string,
3366 which is marked with ^_ (037). */
3367 for (from
= start
, to
= start
;
3368 saved_doc_string
[from
] != 037;)
3370 int c
= saved_doc_string
[from
++];
3373 c
= saved_doc_string
[from
++];
3375 saved_doc_string
[to
++] = c
;
3377 saved_doc_string
[to
++] = 0;
3379 saved_doc_string
[to
++] = 037;
3382 saved_doc_string
[to
++] = c
;
3385 return make_unibyte_string (saved_doc_string
+ start
,
3388 /* Look in prev_saved_doc_string the same way. */
3389 else if (pos
>= prev_saved_doc_string_position
3390 && pos
< (prev_saved_doc_string_position
3391 + prev_saved_doc_string_length
))
3393 int start
= pos
- prev_saved_doc_string_position
;
3396 /* Process quoting with ^A,
3397 and find the end of the string,
3398 which is marked with ^_ (037). */
3399 for (from
= start
, to
= start
;
3400 prev_saved_doc_string
[from
] != 037;)
3402 int c
= prev_saved_doc_string
[from
++];
3405 c
= prev_saved_doc_string
[from
++];
3407 prev_saved_doc_string
[to
++] = c
;
3409 prev_saved_doc_string
[to
++] = 0;
3411 prev_saved_doc_string
[to
++] = 037;
3414 prev_saved_doc_string
[to
++] = c
;
3417 return make_unibyte_string (prev_saved_doc_string
3422 return get_doc_string (val
, 1, 0);
3427 invalid_syntax (". in wrong context", 18);
3429 invalid_syntax ("] in a list", 11);
3431 tem
= (read_pure
&& flag
<= 0
3432 ? pure_cons (elt
, Qnil
)
3433 : Fcons (elt
, Qnil
));
3435 XSETCDR (tail
, tem
);
3440 defunflag
= EQ (elt
, Qdefun
);
3441 else if (defunflag
> 0)
3446 Lisp_Object Vobarray
;
3447 Lisp_Object initial_obarray
;
3449 /* oblookup stores the bucket number here, for the sake of Funintern. */
3451 int oblookup_last_bucket_number
;
3453 static int hash_string ();
3455 /* Get an error if OBARRAY is not an obarray.
3456 If it is one, return it. */
3459 check_obarray (obarray
)
3460 Lisp_Object obarray
;
3462 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3464 /* If Vobarray is now invalid, force it to be valid. */
3465 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3466 wrong_type_argument (Qvectorp
, obarray
);
3471 /* Intern the C string STR: return a symbol with that name,
3472 interned in the current obarray. */
3479 int len
= strlen (str
);
3480 Lisp_Object obarray
;
3483 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3484 obarray
= check_obarray (obarray
);
3485 tem
= oblookup (obarray
, str
, len
, len
);
3488 return Fintern (make_string (str
, len
), obarray
);
3491 /* Create an uninterned symbol with name STR. */
3497 int len
= strlen (str
);
3499 return Fmake_symbol ((!NILP (Vpurify_flag
)
3500 ? make_pure_string (str
, len
, len
, 0)
3501 : make_string (str
, len
)));
3504 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3505 doc
: /* Return the canonical symbol whose name is STRING.
3506 If there is none, one is created by this function and returned.
3507 A second optional argument specifies the obarray to use;
3508 it defaults to the value of `obarray'. */)
3510 Lisp_Object string
, obarray
;
3512 register Lisp_Object tem
, sym
, *ptr
;
3514 if (NILP (obarray
)) obarray
= Vobarray
;
3515 obarray
= check_obarray (obarray
);
3517 CHECK_STRING (string
);
3519 tem
= oblookup (obarray
, SDATA (string
),
3522 if (!INTEGERP (tem
))
3525 if (!NILP (Vpurify_flag
))
3526 string
= Fpurecopy (string
);
3527 sym
= Fmake_symbol (string
);
3529 if (EQ (obarray
, initial_obarray
))
3530 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3532 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3534 if ((SREF (string
, 0) == ':')
3535 && EQ (obarray
, initial_obarray
))
3537 XSYMBOL (sym
)->constant
= 1;
3538 XSYMBOL (sym
)->value
= sym
;
3541 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3543 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3545 XSYMBOL (sym
)->next
= 0;
3550 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3551 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3552 NAME may be a string or a symbol. If it is a symbol, that exact
3553 symbol is searched for.
3554 A second optional argument specifies the obarray to use;
3555 it defaults to the value of `obarray'. */)
3557 Lisp_Object name
, obarray
;
3559 register Lisp_Object tem
, string
;
3561 if (NILP (obarray
)) obarray
= Vobarray
;
3562 obarray
= check_obarray (obarray
);
3564 if (!SYMBOLP (name
))
3566 CHECK_STRING (name
);
3570 string
= SYMBOL_NAME (name
);
3572 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3573 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3579 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3580 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3581 The value is t if a symbol was found and deleted, nil otherwise.
3582 NAME may be a string or a symbol. If it is a symbol, that symbol
3583 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3584 OBARRAY defaults to the value of the variable `obarray'. */)
3586 Lisp_Object name
, obarray
;
3588 register Lisp_Object string
, tem
;
3591 if (NILP (obarray
)) obarray
= Vobarray
;
3592 obarray
= check_obarray (obarray
);
3595 string
= SYMBOL_NAME (name
);
3598 CHECK_STRING (name
);
3602 tem
= oblookup (obarray
, SDATA (string
),
3607 /* If arg was a symbol, don't delete anything but that symbol itself. */
3608 if (SYMBOLP (name
) && !EQ (name
, tem
))
3611 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3612 XSYMBOL (tem
)->constant
= 0;
3613 XSYMBOL (tem
)->indirect_variable
= 0;
3615 hash
= oblookup_last_bucket_number
;
3617 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3619 if (XSYMBOL (tem
)->next
)
3620 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3622 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3626 Lisp_Object tail
, following
;
3628 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3629 XSYMBOL (tail
)->next
;
3632 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3633 if (EQ (following
, tem
))
3635 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3644 /* Return the symbol in OBARRAY whose names matches the string
3645 of SIZE characters (SIZE_BYTE bytes) at PTR.
3646 If there is no such symbol in OBARRAY, return nil.
3648 Also store the bucket number in oblookup_last_bucket_number. */
3651 oblookup (obarray
, ptr
, size
, size_byte
)
3652 Lisp_Object obarray
;
3653 register const char *ptr
;
3654 int size
, size_byte
;
3658 register Lisp_Object tail
;
3659 Lisp_Object bucket
, tem
;
3661 if (!VECTORP (obarray
)
3662 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3664 obarray
= check_obarray (obarray
);
3665 obsize
= XVECTOR (obarray
)->size
;
3667 /* This is sometimes needed in the middle of GC. */
3668 obsize
&= ~ARRAY_MARK_FLAG
;
3669 /* Combining next two lines breaks VMS C 2.3. */
3670 hash
= hash_string (ptr
, size_byte
);
3672 bucket
= XVECTOR (obarray
)->contents
[hash
];
3673 oblookup_last_bucket_number
= hash
;
3674 if (EQ (bucket
, make_number (0)))
3676 else if (!SYMBOLP (bucket
))
3677 error ("Bad data in guts of obarray"); /* Like CADR error message */
3679 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3681 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3682 && SCHARS (SYMBOL_NAME (tail
)) == size
3683 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3685 else if (XSYMBOL (tail
)->next
== 0)
3688 XSETINT (tem
, hash
);
3693 hash_string (ptr
, len
)
3694 const unsigned char *ptr
;
3697 register const unsigned char *p
= ptr
;
3698 register const unsigned char *end
= p
+ len
;
3699 register unsigned char c
;
3700 register int hash
= 0;
3705 if (c
>= 0140) c
-= 40;
3706 hash
= ((hash
<<3) + (hash
>>28) + c
);
3708 return hash
& 07777777777;
3712 map_obarray (obarray
, fn
, arg
)
3713 Lisp_Object obarray
;
3714 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3718 register Lisp_Object tail
;
3719 CHECK_VECTOR (obarray
);
3720 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3722 tail
= XVECTOR (obarray
)->contents
[i
];
3727 if (XSYMBOL (tail
)->next
== 0)
3729 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3735 mapatoms_1 (sym
, function
)
3736 Lisp_Object sym
, function
;
3738 call1 (function
, sym
);
3741 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3742 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3743 OBARRAY defaults to the value of `obarray'. */)
3745 Lisp_Object function
, obarray
;
3747 if (NILP (obarray
)) obarray
= Vobarray
;
3748 obarray
= check_obarray (obarray
);
3750 map_obarray (obarray
, mapatoms_1
, function
);
3754 #define OBARRAY_SIZE 1511
3759 Lisp_Object oblength
;
3763 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3765 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3766 Vobarray
= Fmake_vector (oblength
, make_number (0));
3767 initial_obarray
= Vobarray
;
3768 staticpro (&initial_obarray
);
3769 /* Intern nil in the obarray */
3770 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3771 XSYMBOL (Qnil
)->constant
= 1;
3773 /* These locals are to kludge around a pyramid compiler bug. */
3774 hash
= hash_string ("nil", 3);
3775 /* Separate statement here to avoid VAXC bug. */
3776 hash
%= OBARRAY_SIZE
;
3777 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3780 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3781 XSYMBOL (Qnil
)->function
= Qunbound
;
3782 XSYMBOL (Qunbound
)->value
= Qunbound
;
3783 XSYMBOL (Qunbound
)->function
= Qunbound
;
3786 XSYMBOL (Qnil
)->value
= Qnil
;
3787 XSYMBOL (Qnil
)->plist
= Qnil
;
3788 XSYMBOL (Qt
)->value
= Qt
;
3789 XSYMBOL (Qt
)->constant
= 1;
3791 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3794 Qvariable_documentation
= intern ("variable-documentation");
3795 staticpro (&Qvariable_documentation
);
3797 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3798 read_buffer
= (char *) xmalloc (read_buffer_size
);
3803 struct Lisp_Subr
*sname
;
3806 sym
= intern (sname
->symbol_name
);
3807 XSETPVECTYPE (sname
, PVEC_SUBR
);
3808 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3811 #ifdef NOTDEF /* use fset in subr.el now */
3813 defalias (sname
, string
)
3814 struct Lisp_Subr
*sname
;
3818 sym
= intern (string
);
3819 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3823 /* Define an "integer variable"; a symbol whose value is forwarded
3824 to a C variable of type int. Sample call:
3825 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3827 defvar_int (namestring
, address
)
3831 Lisp_Object sym
, val
;
3832 sym
= intern (namestring
);
3833 val
= allocate_misc ();
3834 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3835 XINTFWD (val
)->intvar
= address
;
3836 SET_SYMBOL_VALUE (sym
, val
);
3839 /* Similar but define a variable whose value is t if address contains 1,
3840 nil if address contains 0. */
3842 defvar_bool (namestring
, address
)
3846 Lisp_Object sym
, val
;
3847 sym
= intern (namestring
);
3848 val
= allocate_misc ();
3849 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3850 XBOOLFWD (val
)->boolvar
= address
;
3851 SET_SYMBOL_VALUE (sym
, val
);
3852 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3855 /* Similar but define a variable whose value is the Lisp Object stored
3856 at address. Two versions: with and without gc-marking of the C
3857 variable. The nopro version is used when that variable will be
3858 gc-marked for some other reason, since marking the same slot twice
3859 can cause trouble with strings. */
3861 defvar_lisp_nopro (namestring
, address
)
3863 Lisp_Object
*address
;
3865 Lisp_Object sym
, val
;
3866 sym
= intern (namestring
);
3867 val
= allocate_misc ();
3868 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3869 XOBJFWD (val
)->objvar
= address
;
3870 SET_SYMBOL_VALUE (sym
, val
);
3874 defvar_lisp (namestring
, address
)
3876 Lisp_Object
*address
;
3878 defvar_lisp_nopro (namestring
, address
);
3879 staticpro (address
);
3882 /* Similar but define a variable whose value is the Lisp Object stored
3883 at a particular offset in the current kboard object. */
3886 defvar_kboard (namestring
, offset
)
3890 Lisp_Object sym
, val
;
3891 sym
= intern (namestring
);
3892 val
= allocate_misc ();
3893 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3894 XKBOARD_OBJFWD (val
)->offset
= offset
;
3895 SET_SYMBOL_VALUE (sym
, val
);
3898 /* Record the value of load-path used at the start of dumping
3899 so we can see if the site changed it later during dumping. */
3900 static Lisp_Object dump_path
;
3906 int turn_off_warning
= 0;
3908 /* Compute the default load-path. */
3910 normal
= PATH_LOADSEARCH
;
3911 Vload_path
= decode_env_path (0, normal
);
3913 if (NILP (Vpurify_flag
))
3914 normal
= PATH_LOADSEARCH
;
3916 normal
= PATH_DUMPLOADSEARCH
;
3918 /* In a dumped Emacs, we normally have to reset the value of
3919 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3920 uses ../lisp, instead of the path of the installed elisp
3921 libraries. However, if it appears that Vload_path was changed
3922 from the default before dumping, don't override that value. */
3925 if (! NILP (Fequal (dump_path
, Vload_path
)))
3927 Vload_path
= decode_env_path (0, normal
);
3928 if (!NILP (Vinstallation_directory
))
3930 Lisp_Object tem
, tem1
, sitelisp
;
3932 /* Remove site-lisp dirs from path temporarily and store
3933 them in sitelisp, then conc them on at the end so
3934 they're always first in path. */
3938 tem
= Fcar (Vload_path
);
3939 tem1
= Fstring_match (build_string ("site-lisp"),
3943 Vload_path
= Fcdr (Vload_path
);
3944 sitelisp
= Fcons (tem
, sitelisp
);
3950 /* Add to the path the lisp subdir of the
3951 installation dir, if it exists. */
3952 tem
= Fexpand_file_name (build_string ("lisp"),
3953 Vinstallation_directory
);
3954 tem1
= Ffile_exists_p (tem
);
3957 if (NILP (Fmember (tem
, Vload_path
)))
3959 turn_off_warning
= 1;
3960 Vload_path
= Fcons (tem
, Vload_path
);
3964 /* That dir doesn't exist, so add the build-time
3965 Lisp dirs instead. */
3966 Vload_path
= nconc2 (Vload_path
, dump_path
);
3968 /* Add leim under the installation dir, if it exists. */
3969 tem
= Fexpand_file_name (build_string ("leim"),
3970 Vinstallation_directory
);
3971 tem1
= Ffile_exists_p (tem
);
3974 if (NILP (Fmember (tem
, Vload_path
)))
3975 Vload_path
= Fcons (tem
, Vload_path
);
3978 /* Add site-lisp under the installation dir, if it exists. */
3979 tem
= Fexpand_file_name (build_string ("site-lisp"),
3980 Vinstallation_directory
);
3981 tem1
= Ffile_exists_p (tem
);
3984 if (NILP (Fmember (tem
, Vload_path
)))
3985 Vload_path
= Fcons (tem
, Vload_path
);
3988 /* If Emacs was not built in the source directory,
3989 and it is run from where it was built, add to load-path
3990 the lisp, leim and site-lisp dirs under that directory. */
3992 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3996 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3997 Vinstallation_directory
);
3998 tem1
= Ffile_exists_p (tem
);
4000 /* Don't be fooled if they moved the entire source tree
4001 AFTER dumping Emacs. If the build directory is indeed
4002 different from the source dir, src/Makefile.in and
4003 src/Makefile will not be found together. */
4004 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4005 Vinstallation_directory
);
4006 tem2
= Ffile_exists_p (tem
);
4007 if (!NILP (tem1
) && NILP (tem2
))
4009 tem
= Fexpand_file_name (build_string ("lisp"),
4012 if (NILP (Fmember (tem
, Vload_path
)))
4013 Vload_path
= Fcons (tem
, Vload_path
);
4015 tem
= Fexpand_file_name (build_string ("leim"),
4018 if (NILP (Fmember (tem
, Vload_path
)))
4019 Vload_path
= Fcons (tem
, Vload_path
);
4021 tem
= Fexpand_file_name (build_string ("site-lisp"),
4024 if (NILP (Fmember (tem
, Vload_path
)))
4025 Vload_path
= Fcons (tem
, Vload_path
);
4028 if (!NILP (sitelisp
))
4029 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4035 /* NORMAL refers to the lisp dir in the source directory. */
4036 /* We used to add ../lisp at the front here, but
4037 that caused trouble because it was copied from dump_path
4038 into Vload_path, above, when Vinstallation_directory was non-nil.
4039 It should be unnecessary. */
4040 Vload_path
= decode_env_path (0, normal
);
4041 dump_path
= Vload_path
;
4045 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
4046 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4047 almost never correct, thereby causing a warning to be printed out that
4048 confuses users. Since PATH_LOADSEARCH is always overridden by the
4049 EMACSLOADPATH environment variable below, disable the warning on NT.
4050 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
4051 the "standard" paths may not exist and would be overridden by
4052 EMACSLOADPATH as on NT. Since this depends on how the executable
4053 was build and packaged, turn off the warnings in general */
4055 /* Warn if dirs in the *standard* path don't exist. */
4056 if (!turn_off_warning
)
4058 Lisp_Object path_tail
;
4060 for (path_tail
= Vload_path
;
4062 path_tail
= XCDR (path_tail
))
4064 Lisp_Object dirfile
;
4065 dirfile
= Fcar (path_tail
);
4066 if (STRINGP (dirfile
))
4068 dirfile
= Fdirectory_file_name (dirfile
);
4069 if (access (SDATA (dirfile
), 0) < 0)
4070 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4075 #endif /* !(WINDOWSNT || HAVE_CARBON) */
4077 /* If the EMACSLOADPATH environment variable is set, use its value.
4078 This doesn't apply if we're dumping. */
4080 if (NILP (Vpurify_flag
)
4081 && egetenv ("EMACSLOADPATH"))
4083 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4087 load_in_progress
= 0;
4088 Vload_file_name
= Qnil
;
4090 load_descriptor_list
= Qnil
;
4092 Vstandard_input
= Qt
;
4093 Vloads_in_progress
= Qnil
;
4096 /* Print a warning, using format string FORMAT, that directory DIRNAME
4097 does not exist. Print it on stderr and put it in *Messages*. */
4100 dir_warning (format
, dirname
)
4102 Lisp_Object dirname
;
4105 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4107 fprintf (stderr
, format
, SDATA (dirname
));
4108 sprintf (buffer
, format
, SDATA (dirname
));
4109 /* Don't log the warning before we've initialized!! */
4111 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4118 defsubr (&Sread_from_string
);
4120 defsubr (&Sintern_soft
);
4121 defsubr (&Sunintern
);
4122 defsubr (&Sget_load_suffixes
);
4124 defsubr (&Seval_buffer
);
4125 defsubr (&Seval_region
);
4126 defsubr (&Sread_char
);
4127 defsubr (&Sread_char_exclusive
);
4128 defsubr (&Sread_event
);
4129 defsubr (&Sget_file_char
);
4130 defsubr (&Smapatoms
);
4131 defsubr (&Slocate_file_internal
);
4133 DEFVAR_LISP ("obarray", &Vobarray
,
4134 doc
: /* Symbol table for use by `intern' and `read'.
4135 It is a vector whose length ought to be prime for best results.
4136 The vector's contents don't make sense if examined from Lisp programs;
4137 to find all the symbols in an obarray, use `mapatoms'. */);
4139 DEFVAR_LISP ("values", &Vvalues
,
4140 doc
: /* List of values of all expressions which were read, evaluated and printed.
4141 Order is reverse chronological. */);
4143 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4144 doc
: /* Stream for read to get input from.
4145 See documentation of `read' for possible values. */);
4146 Vstandard_input
= Qt
;
4148 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4149 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4151 If this variable is a buffer, then only forms read from that buffer
4152 will be added to `read-symbol-positions-list'.
4153 If this variable is t, then all read forms will be added.
4154 The effect of all other values other than nil are not currently
4155 defined, although they may be in the future.
4157 The positions are relative to the last call to `read' or
4158 `read-from-string'. It is probably a bad idea to set this variable at
4159 the toplevel; bind it instead. */);
4160 Vread_with_symbol_positions
= Qnil
;
4162 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4163 doc
: /* A list mapping read symbols to their positions.
4164 This variable is modified during calls to `read' or
4165 `read-from-string', but only when `read-with-symbol-positions' is
4168 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4169 CHAR-POSITION is an integer giving the offset of that occurrence of the
4170 symbol from the position where `read' or `read-from-string' started.
4172 Note that a symbol will appear multiple times in this list, if it was
4173 read multiple times. The list is in the same order as the symbols
4175 Vread_symbol_positions_list
= Qnil
;
4177 DEFVAR_LISP ("load-path", &Vload_path
,
4178 doc
: /* *List of directories to search for files to load.
4179 Each element is a string (directory name) or nil (try default directory).
4180 Initialized based on EMACSLOADPATH environment variable, if any,
4181 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4183 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4184 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4185 This list should not include the empty string.
4186 `load' and related functions try to append these suffixes, in order,
4187 to the specified file name if a Lisp suffix is allowed or required. */);
4188 Vload_suffixes
= Fcons (build_string (".elc"),
4189 Fcons (build_string (".el"), Qnil
));
4190 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4191 doc
: /* List of suffixes that indicate representations of \
4193 This list should normally start with the empty string.
4195 Enabling Auto Compression mode appends the suffixes in
4196 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4197 mode removes them again. `load' and related functions use this list to
4198 determine whether they should look for compressed versions of a file
4199 and, if so, which suffixes they should try to append to the file name
4200 in order to do so. However, if you want to customize which suffixes
4201 the loading functions recognize as compression suffixes, you should
4202 customize `jka-compr-load-suffixes' rather than the present variable. */);
4203 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4205 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4206 doc
: /* Non-nil if inside of `load'. */);
4208 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4209 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4210 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4212 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4213 a symbol \(a feature name).
4215 When `load' is run and the file-name argument matches an element's
4216 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4217 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4219 An error in FORMS does not undo the load, but does prevent execution of
4220 the rest of the FORMS. */);
4221 Vafter_load_alist
= Qnil
;
4223 DEFVAR_LISP ("load-history", &Vload_history
,
4224 doc
: /* Alist mapping file names to symbols and features.
4225 Each alist element is a list that starts with a file name,
4226 except for one element (optional) that starts with nil and describes
4227 definitions evaluated from buffers not visiting files.
4229 The file name is absolute and is the true file name (i.e. it doesn't
4230 contain symbolic links) of the loaded file.
4232 The remaining elements of each list are symbols defined as variables
4233 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4234 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4235 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4236 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
4237 this file redefined it as a function.
4239 During preloading, the file name recorded is relative to the main Lisp
4240 directory. These file names are converted to absolute at startup. */);
4241 Vload_history
= Qnil
;
4243 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4244 doc
: /* Full name of file being loaded by `load'. */);
4245 Vload_file_name
= Qnil
;
4247 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4248 doc
: /* File name, including directory, of user's initialization file.
4249 If the file loaded had extension `.elc', and the corresponding source file
4250 exists, this variable contains the name of source file, suitable for use
4251 by functions like `custom-save-all' which edit the init file.
4252 While Emacs loads and evaluates the init file, value is the real name
4253 of the file, regardless of whether or not it has the `.elc' extension. */);
4254 Vuser_init_file
= Qnil
;
4256 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4257 doc
: /* Used for internal purposes by `load'. */);
4258 Vcurrent_load_list
= Qnil
;
4260 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4261 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4262 The default is nil, which means use the function `read'. */);
4263 Vload_read_function
= Qnil
;
4265 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4266 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4267 This function is for doing code conversion before reading the source file.
4268 If nil, loading is done without any code conversion.
4269 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4270 FULLNAME is the full name of FILE.
4271 See `load' for the meaning of the remaining arguments. */);
4272 Vload_source_file_function
= Qnil
;
4274 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4275 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4276 This is useful when the file being loaded is a temporary copy. */);
4277 load_force_doc_strings
= 0;
4279 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4280 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4281 This is normally bound by `load' and `eval-buffer' to control `read',
4282 and is not meant for users to change. */);
4283 load_convert_to_unibyte
= 0;
4285 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4286 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4287 You cannot count on them to still be there! */);
4289 = Fexpand_file_name (build_string ("../"),
4290 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4292 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4293 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4294 Vpreloaded_file_list
= Qnil
;
4296 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4297 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4298 Vbyte_boolean_vars
= Qnil
;
4300 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4301 doc
: /* Non-nil means load dangerous compiled Lisp files.
4302 Some versions of XEmacs use different byte codes than Emacs. These
4303 incompatible byte codes can make Emacs crash when it tries to execute
4305 load_dangerous_libraries
= 0;
4307 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4308 doc
: /* Regular expression matching safe to load compiled Lisp files.
4309 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4310 from the file, and matches them against this regular expression.
4311 When the regular expression matches, the file is considered to be safe
4312 to load. See also `load-dangerous-libraries'. */);
4313 Vbytecomp_version_regexp
4314 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4316 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4317 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4318 Veval_buffer_list
= Qnil
;
4320 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4321 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4322 Vold_style_backquotes
= Qnil
;
4323 Qold_style_backquotes
= intern ("old-style-backquotes");
4324 staticpro (&Qold_style_backquotes
);
4326 /* Vsource_directory was initialized in init_lread. */
4328 load_descriptor_list
= Qnil
;
4329 staticpro (&load_descriptor_list
);
4331 Qcurrent_load_list
= intern ("current-load-list");
4332 staticpro (&Qcurrent_load_list
);
4334 Qstandard_input
= intern ("standard-input");
4335 staticpro (&Qstandard_input
);
4337 Qread_char
= intern ("read-char");
4338 staticpro (&Qread_char
);
4340 Qget_file_char
= intern ("get-file-char");
4341 staticpro (&Qget_file_char
);
4343 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4344 staticpro (&Qget_emacs_mule_file_char
);
4346 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4347 staticpro (&Qload_force_doc_strings
);
4349 Qbackquote
= intern ("`");
4350 staticpro (&Qbackquote
);
4351 Qcomma
= intern (",");
4352 staticpro (&Qcomma
);
4353 Qcomma_at
= intern (",@");
4354 staticpro (&Qcomma_at
);
4355 Qcomma_dot
= intern (",.");
4356 staticpro (&Qcomma_dot
);
4358 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4359 staticpro (&Qinhibit_file_name_operation
);
4361 Qascii_character
= intern ("ascii-character");
4362 staticpro (&Qascii_character
);
4364 Qfunction
= intern ("function");
4365 staticpro (&Qfunction
);
4367 Qload
= intern ("load");
4370 Qload_file_name
= intern ("load-file-name");
4371 staticpro (&Qload_file_name
);
4373 Qeval_buffer_list
= intern ("eval-buffer-list");
4374 staticpro (&Qeval_buffer_list
);
4376 Qfile_truename
= intern ("file-truename");
4377 staticpro (&Qfile_truename
) ;
4379 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4380 staticpro (&Qdo_after_load_evaluation
) ;
4382 staticpro (&dump_path
);
4384 staticpro (&read_objects
);
4385 read_objects
= Qnil
;
4386 staticpro (&seen_list
);
4389 Vloads_in_progress
= Qnil
;
4390 staticpro (&Vloads_in_progress
);
4393 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4394 (do not change this comment) */