1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
37 #include "termhooks.h"
40 #include <sys/inode.h>
45 #include <unistd.h> /* to get X_OK */
62 #endif /* HAVE_SETLOCALE */
69 #define file_offset off_t
70 #define file_tell ftello
72 #define file_offset long
73 #define file_tell ftell
80 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
81 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
82 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
83 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
84 Lisp_Object Qinhibit_file_name_operation
;
86 extern Lisp_Object Qevent_symbol_element_mask
;
87 extern Lisp_Object Qfile_exists_p
;
89 /* non-zero if inside `load' */
92 /* Directory in which the sources were found. */
93 Lisp_Object Vsource_directory
;
95 /* Search path and suffixes for files to be loaded. */
96 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
98 /* File name of user's init file. */
99 Lisp_Object Vuser_init_file
;
101 /* This is the user-visible association list that maps features to
102 lists of defs in their load files. */
103 Lisp_Object Vload_history
;
105 /* This is used to build the load history. */
106 Lisp_Object Vcurrent_load_list
;
108 /* List of files that were preloaded. */
109 Lisp_Object Vpreloaded_file_list
;
111 /* Name of file actually being read by `load'. */
112 Lisp_Object Vload_file_name
;
114 /* Function to use for reading, in `load' and friends. */
115 Lisp_Object Vload_read_function
;
117 /* The association list of objects read with the #n=object form.
118 Each member of the list has the form (n . object), and is used to
119 look up the object for the corresponding #n# construct.
120 It must be set to nil before all top-level calls to read0. */
121 Lisp_Object read_objects
;
123 /* Nonzero means load should forcibly load all dynamic doc strings. */
124 static int load_force_doc_strings
;
126 /* Nonzero means read should convert strings to unibyte. */
127 static int load_convert_to_unibyte
;
129 /* Function to use for loading an Emacs lisp source file (not
130 compiled) instead of readevalloop. */
131 Lisp_Object Vload_source_file_function
;
133 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
134 Lisp_Object Vbyte_boolean_vars
;
136 /* List of descriptors now open for Fload. */
137 static Lisp_Object load_descriptor_list
;
139 /* File for get_file_char to read from. Use by load. */
140 static FILE *instream
;
142 /* When nonzero, read conses in pure space */
143 static int read_pure
;
145 /* For use within read-from-string (this reader is non-reentrant!!) */
146 static int read_from_string_index
;
147 static int read_from_string_index_byte
;
148 static int read_from_string_limit
;
150 /* Number of bytes left to read in the buffer character
151 that `readchar' has already advanced over. */
152 static int readchar_backlog
;
154 /* This contains the last string skipped with #@. */
155 static char *saved_doc_string
;
156 /* Length of buffer allocated in saved_doc_string. */
157 static int saved_doc_string_size
;
158 /* Length of actual data in saved_doc_string. */
159 static int saved_doc_string_length
;
160 /* This is the file position that string came from. */
161 static file_offset saved_doc_string_position
;
163 /* This contains the previous string skipped with #@.
164 We copy it from saved_doc_string when a new string
165 is put in saved_doc_string. */
166 static char *prev_saved_doc_string
;
167 /* Length of buffer allocated in prev_saved_doc_string. */
168 static int prev_saved_doc_string_size
;
169 /* Length of actual data in prev_saved_doc_string. */
170 static int prev_saved_doc_string_length
;
171 /* This is the file position that string came from. */
172 static file_offset prev_saved_doc_string_position
;
174 /* Nonzero means inside a new-style backquote
175 with no surrounding parentheses.
176 Fread initializes this to zero, so we need not specbind it
177 or worry about what happens to it when there is an error. */
178 static int new_backquote_flag
;
180 /* A list of file names for files being loaded in Fload. Used to
181 check for recursive loads. */
183 static Lisp_Object Vloads_in_progress
;
185 /* Non-zero means load dangerous compiled Lisp files. */
187 int load_dangerous_libraries
;
189 /* A regular expression used to detect files compiled with Emacs. */
191 static Lisp_Object Vbytecomp_version_regexp
;
193 static void to_multibyte
P_ ((char **, char **, int *));
194 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
195 Lisp_Object (*) (), int,
196 Lisp_Object
, Lisp_Object
));
197 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
198 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
201 /* Handle unreading and rereading of characters.
202 Write READCHAR to read a character,
203 UNREAD(c) to unread c to be read again.
205 These macros actually read/unread a byte code, multibyte characters
206 are not handled here. The caller should manage them if necessary.
209 #define READCHAR readchar (readcharfun)
210 #define UNREAD(c) unreadchar (readcharfun, c)
213 readchar (readcharfun
)
214 Lisp_Object readcharfun
;
219 if (BUFFERP (readcharfun
))
221 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
223 int pt_byte
= BUF_PT_BYTE (inbuffer
);
224 int orig_pt_byte
= pt_byte
;
226 if (readchar_backlog
> 0)
227 /* We get the address of the byte just passed,
228 which is the last byte of the character.
229 The other bytes in this character are consecutive with it,
230 because the gap can't be in the middle of a character. */
231 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
232 - --readchar_backlog
);
234 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
237 readchar_backlog
= -1;
239 if (! NILP (inbuffer
->enable_multibyte_characters
))
241 /* Fetch the character code from the buffer. */
242 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
243 BUF_INC_POS (inbuffer
, pt_byte
);
244 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
248 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
251 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
255 if (MARKERP (readcharfun
))
257 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
259 int bytepos
= marker_byte_position (readcharfun
);
260 int orig_bytepos
= bytepos
;
262 if (readchar_backlog
> 0)
263 /* We get the address of the byte just passed,
264 which is the last byte of the character.
265 The other bytes in this character are consecutive with it,
266 because the gap can't be in the middle of a character. */
267 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
268 - --readchar_backlog
);
270 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
273 readchar_backlog
= -1;
275 if (! NILP (inbuffer
->enable_multibyte_characters
))
277 /* Fetch the character code from the buffer. */
278 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
279 BUF_INC_POS (inbuffer
, bytepos
);
280 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
284 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
288 XMARKER (readcharfun
)->bytepos
= bytepos
;
289 XMARKER (readcharfun
)->charpos
++;
294 if (EQ (readcharfun
, Qlambda
))
295 return read_bytecode_char (0);
297 if (EQ (readcharfun
, Qget_file_char
))
301 /* Interrupted reads have been observed while reading over the network */
302 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
311 if (STRINGP (readcharfun
))
313 if (read_from_string_index
>= read_from_string_limit
)
316 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
317 read_from_string_index
,
318 read_from_string_index_byte
);
323 tem
= call0 (readcharfun
);
330 /* Unread the character C in the way appropriate for the stream READCHARFUN.
331 If the stream is a user function, call it with the char as argument. */
334 unreadchar (readcharfun
, c
)
335 Lisp_Object readcharfun
;
339 /* Don't back up the pointer if we're unreading the end-of-input mark,
340 since readchar didn't advance it when we read it. */
342 else if (BUFFERP (readcharfun
))
344 struct buffer
*b
= XBUFFER (readcharfun
);
345 int bytepos
= BUF_PT_BYTE (b
);
347 if (readchar_backlog
>= 0)
352 if (! NILP (b
->enable_multibyte_characters
))
353 BUF_DEC_POS (b
, bytepos
);
357 BUF_PT_BYTE (b
) = bytepos
;
360 else if (MARKERP (readcharfun
))
362 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
363 int bytepos
= XMARKER (readcharfun
)->bytepos
;
365 if (readchar_backlog
>= 0)
369 XMARKER (readcharfun
)->charpos
--;
370 if (! NILP (b
->enable_multibyte_characters
))
371 BUF_DEC_POS (b
, bytepos
);
375 XMARKER (readcharfun
)->bytepos
= bytepos
;
378 else if (STRINGP (readcharfun
))
380 read_from_string_index
--;
381 read_from_string_index_byte
382 = string_char_to_byte (readcharfun
, read_from_string_index
);
384 else if (EQ (readcharfun
, Qlambda
))
385 read_bytecode_char (1);
386 else if (EQ (readcharfun
, Qget_file_char
))
387 ungetc (c
, instream
);
389 call1 (readcharfun
, make_number (c
));
392 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
393 static int read_multibyte ();
394 static Lisp_Object
substitute_object_recurse ();
395 static void substitute_object_in_subtree (), substitute_in_interval ();
398 /* Get a character from the tty. */
400 extern Lisp_Object
read_char ();
402 /* Read input events until we get one that's acceptable for our purposes.
404 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
405 until we get a character we like, and then stuffed into
408 If ASCII_REQUIRED is non-zero, we check function key events to see
409 if the unmodified version of the symbol has a Qascii_character
410 property, and use that character, if present.
412 If ERROR_NONASCII is non-zero, we signal an error if the input we
413 get isn't an ASCII character with modifiers. If it's zero but
414 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
417 If INPUT_METHOD is nonzero, we invoke the current input method
418 if the character warrants that. */
421 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
423 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
425 register Lisp_Object val
, delayed_switch_frame
;
427 #ifdef HAVE_WINDOW_SYSTEM
428 if (display_hourglass_p
)
432 delayed_switch_frame
= Qnil
;
434 /* Read until we get an acceptable event. */
436 val
= read_char (0, 0, 0,
437 (input_method
? Qnil
: Qt
),
443 /* switch-frame events are put off until after the next ASCII
444 character. This is better than signaling an error just because
445 the last characters were typed to a separate minibuffer frame,
446 for example. Eventually, some code which can deal with
447 switch-frame events will read it and process it. */
449 && EVENT_HAS_PARAMETERS (val
)
450 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
452 delayed_switch_frame
= val
;
458 /* Convert certain symbols to their ASCII equivalents. */
461 Lisp_Object tem
, tem1
;
462 tem
= Fget (val
, Qevent_symbol_element_mask
);
465 tem1
= Fget (Fcar (tem
), Qascii_character
);
466 /* Merge this symbol's modifier bits
467 with the ASCII equivalent of its basic code. */
469 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
473 /* If we don't have a character now, deal with it appropriately. */
478 Vunread_command_events
= Fcons (val
, Qnil
);
479 error ("Non-character input-event");
486 if (! NILP (delayed_switch_frame
))
487 unread_switch_frame
= delayed_switch_frame
;
489 #ifdef HAVE_WINDOW_SYSTEM
490 if (display_hourglass_p
)
496 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
497 doc
: /* Read a character from the command input (keyboard or macro).
498 It is returned as a number.
499 If the user generates an event which is not a character (i.e. a mouse
500 click or function key event), `read-char' signals an error. As an
501 exception, switch-frame events are put off until non-ASCII events can
503 If you want to read non-character events, or ignore them, call
504 `read-event' or `read-char-exclusive' instead.
506 If the optional argument PROMPT is non-nil, display that as a prompt.
507 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
508 input method is turned on in the current buffer, that input method
509 is used for reading a character. */)
510 (prompt
, inherit_input_method
)
511 Lisp_Object prompt
, inherit_input_method
;
514 message_with_string ("%s", prompt
, 0);
515 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
518 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
519 doc
: /* Read an event object from the input stream.
520 If the optional argument PROMPT is non-nil, display that as a prompt.
521 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
522 input method is turned on in the current buffer, that input method
523 is used for reading a character. */)
524 (prompt
, inherit_input_method
)
525 Lisp_Object prompt
, inherit_input_method
;
528 message_with_string ("%s", prompt
, 0);
529 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
532 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
533 doc
: /* Read a character from the command input (keyboard or macro).
534 It is returned as a number. Non-character events are ignored.
536 If the optional argument PROMPT is non-nil, display that as a prompt.
537 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
538 input method is turned on in the current buffer, that input method
539 is used for reading a character. */)
540 (prompt
, inherit_input_method
)
541 Lisp_Object prompt
, inherit_input_method
;
544 message_with_string ("%s", prompt
, 0);
545 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
548 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
549 doc
: /* Don't use this yourself. */)
552 register Lisp_Object val
;
553 XSETINT (val
, getc (instream
));
559 /* Value is non-zero if the file asswociated with file descriptor FD
560 is a compiled Lisp file that's safe to load. Only files compiled
561 with Emacs are safe to load. Files compiled with XEmacs can lead
562 to a crash in Fbyte_code because of an incompatible change in the
573 /* Read the first few bytes from the file, and look for a line
574 specifying the byte compiler version used. */
575 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
580 /* Skip to the next newline, skipping over the initial `ELC'
581 with NUL bytes following it. */
582 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
586 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
591 lseek (fd
, 0, SEEK_SET
);
596 /* Callback for record_unwind_protect. Restore the old load list OLD,
597 after loading a file successfully. */
600 record_load_unwind (old
)
603 return Vloads_in_progress
= old
;
607 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
608 doc
: /* Execute a file of Lisp code named FILE.
609 First try FILE with `.elc' appended, then try with `.el',
610 then try FILE unmodified. Environment variable references in FILE
611 are replaced with their values by calling `substitute-in-file-name'.
612 This function searches the directories in `load-path'.
613 If optional second arg NOERROR is non-nil,
614 report no error if FILE doesn't exist.
615 Print messages at start and end of loading unless
616 optional third arg NOMESSAGE is non-nil.
617 If optional fourth arg NOSUFFIX is non-nil, don't try adding
618 suffixes `.elc' or `.el' to the specified name FILE.
619 If optional fifth arg MUST-SUFFIX is non-nil, insist on
620 the suffix `.elc' or `.el'; don't accept just FILE unless
621 it ends in one of those suffixes or includes a directory name.
622 Return t if file exists. */)
623 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
624 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
626 register FILE *stream
;
627 register int fd
= -1;
628 register Lisp_Object lispstream
;
629 int count
= specpdl_ptr
- specpdl
;
633 /* 1 means we printed the ".el is newer" message. */
635 /* 1 means we are loading a compiled file. */
646 /* If file name is magic, call the handler. */
647 /* This shouldn't be necessary any more now that `openp' handles it right.
648 handler = Ffind_file_name_handler (file, Qload);
650 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
652 /* Do this after the handler to avoid
653 the need to gcpro noerror, nomessage and nosuffix.
654 (Below here, we care only whether they are nil or not.)
655 The presence of this call is the result of a historical accident:
656 it used to be in every file-operations and when it got removed
657 everywhere, it accidentally stayed here. Since then, enough people
658 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
659 that it seemed risky to remove. */
660 file
= Fsubstitute_in_file_name (file
);
662 /* Avoid weird lossage with null string as arg,
663 since it would try to load a directory as a Lisp file */
664 if (XSTRING (file
)->size
> 0)
666 int size
= STRING_BYTES (XSTRING (file
));
671 if (! NILP (must_suffix
))
673 /* Don't insist on adding a suffix if FILE already ends with one. */
675 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
678 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
680 /* Don't insist on adding a suffix
681 if the argument includes a directory name. */
682 else if (! NILP (Ffile_name_directory (file
)))
686 fd
= openp (Vload_path
, file
,
687 (!NILP (nosuffix
) ? Qnil
688 : !NILP (must_suffix
) ? Vload_suffixes
689 : Fappend (2, (tmp
[0] = Vload_suffixes
,
690 tmp
[1] = default_suffixes
,
700 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
701 Fcons (file
, Qnil
)));
706 /* Tell startup.el whether or not we found the user's init file. */
707 if (EQ (Qt
, Vuser_init_file
))
708 Vuser_init_file
= found
;
710 /* If FD is -2, that means openp found a magic file. */
713 if (NILP (Fequal (found
, file
)))
714 /* If FOUND is a different file name from FILE,
715 find its handler even if we have already inhibited
716 the `load' operation on FILE. */
717 handler
= Ffind_file_name_handler (found
, Qt
);
719 handler
= Ffind_file_name_handler (found
, Qload
);
720 if (! NILP (handler
))
721 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
724 /* Check if we're stuck in a recursive load cycle.
726 2000-09-21: It's not possible to just check for the file loaded
727 being a member of Vloads_in_progress. This fails because of the
728 way the byte compiler currently works; `provide's are not
729 evaluted, see font-lock.el/jit-lock.el as an example. This
730 leads to a certain amount of ``normal'' recursion.
732 Also, just loading a file recursively is not always an error in
733 the general case; the second load may do something different. */
737 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
738 if (!NILP (Fequal (found
, XCAR (tem
))))
741 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
742 Fcons (found
, Vloads_in_progress
)));
743 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
744 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
747 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
749 /* Load .elc files directly, but not when they are
750 remote and have no handler! */
757 if (!safe_to_load_p (fd
))
760 if (!load_dangerous_libraries
)
761 error ("File `%s' was not compiled in Emacs",
762 XSTRING (found
)->data
);
763 else if (!NILP (nomessage
))
764 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
772 stat ((char *)XSTRING (found
)->data
, &s1
);
773 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
774 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
775 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
777 /* Make the progress messages mention that source is newer. */
780 /* If we won't print another message, mention this anyway. */
781 if (! NILP (nomessage
))
782 message_with_string ("Source file `%s' newer than byte-compiled file",
785 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
790 /* We are loading a source file (*.el). */
791 if (!NILP (Vload_source_file_function
))
797 val
= call4 (Vload_source_file_function
, found
, file
,
798 NILP (noerror
) ? Qnil
: Qt
,
799 NILP (nomessage
) ? Qnil
: Qt
);
800 return unbind_to (count
, val
);
806 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
807 #else /* not WINDOWSNT */
808 stream
= fdopen (fd
, fmode
);
809 #endif /* not WINDOWSNT */
813 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
816 if (! NILP (Vpurify_flag
))
817 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
819 if (NILP (nomessage
))
822 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
825 message_with_string ("Loading %s (source)...", file
, 1);
827 message_with_string ("Loading %s (compiled; note, source file is newer)...",
829 else /* The typical case; compiled file newer than source file. */
830 message_with_string ("Loading %s...", file
, 1);
834 lispstream
= Fcons (Qnil
, Qnil
);
835 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
836 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
837 record_unwind_protect (load_unwind
, lispstream
);
838 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
839 specbind (Qload_file_name
, found
);
840 specbind (Qinhibit_file_name_operation
, Qnil
);
842 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
844 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
845 unbind_to (count
, Qnil
);
847 /* Run any load-hooks for this file. */
848 temp
= Fassoc (file
, Vafter_load_alist
);
850 Fprogn (Fcdr (temp
));
853 if (saved_doc_string
)
854 free (saved_doc_string
);
855 saved_doc_string
= 0;
856 saved_doc_string_size
= 0;
858 if (prev_saved_doc_string
)
859 xfree (prev_saved_doc_string
);
860 prev_saved_doc_string
= 0;
861 prev_saved_doc_string_size
= 0;
863 if (!noninteractive
&& NILP (nomessage
))
866 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
869 message_with_string ("Loading %s (source)...done", file
, 1);
871 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
873 else /* The typical case; compiled file newer than source file. */
874 message_with_string ("Loading %s...done", file
, 1);
881 load_unwind (stream
) /* used as unwind-protect function in load */
884 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
885 | XFASTINT (XCDR (stream
))));
886 if (--load_in_progress
< 0) load_in_progress
= 0;
891 load_descriptor_unwind (oldlist
)
894 load_descriptor_list
= oldlist
;
898 /* Close all descriptors in use for Floads.
899 This is used when starting a subprocess. */
906 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
907 emacs_close (XFASTINT (XCAR (tail
)));
912 complete_filename_p (pathname
)
913 Lisp_Object pathname
;
915 register unsigned char *s
= XSTRING (pathname
)->data
;
916 return (IS_DIRECTORY_SEP (s
[0])
917 || (XSTRING (pathname
)->size
> 2
918 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
928 /* Search for a file whose name is STR, looking in directories
929 in the Lisp list PATH, and trying suffixes from SUFFIX.
930 On success, returns a file descriptor. On failure, returns -1.
932 SUFFIXES is a list of strings containing possible suffixes.
933 The empty suffix is automatically added iff the list is empty.
935 EXEC_ONLY nonzero means don't open the files,
936 just look for one that is executable. In this case,
937 returns 1 on success.
939 If STOREPTR is nonzero, it points to a slot where the name of
940 the file actually found should be stored as a Lisp string.
941 nil is stored there on failure.
943 If the file we find is remote, return -2
944 but store the found remote file name in *STOREPTR.
945 We do not check for remote files if EXEC_ONLY is nonzero. */
948 openp (path
, str
, suffixes
, storeptr
, exec_only
)
949 Lisp_Object path
, str
;
950 Lisp_Object suffixes
;
951 Lisp_Object
*storeptr
;
957 register char *fn
= buf
;
960 Lisp_Object filename
;
962 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
963 Lisp_Object string
, tail
;
964 int max_suffix_len
= 0;
966 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
968 CHECK_STRING_CAR (tail
);
969 max_suffix_len
= max (max_suffix_len
,
970 STRING_BYTES (XSTRING (XCAR (tail
))));
973 string
= filename
= Qnil
;
974 GCPRO5 (str
, string
, filename
, path
, suffixes
);
979 if (complete_filename_p (str
))
982 for (; CONSP (path
); path
= XCDR (path
))
984 filename
= Fexpand_file_name (str
, XCAR (path
));
985 if (!complete_filename_p (filename
))
986 /* If there are non-absolute elts in PATH (eg ".") */
987 /* Of course, this could conceivably lose if luser sets
988 default-directory to be something non-absolute... */
990 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
991 if (!complete_filename_p (filename
))
992 /* Give up on this path element! */
996 /* Calculate maximum size of any filename made from
997 this path element/specified file name and any possible suffix. */
998 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
999 if (fn_size
< want_size
)
1000 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1002 /* Loop over suffixes. */
1003 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1004 CONSP (tail
); tail
= XCDR (tail
))
1006 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1007 Lisp_Object handler
;
1009 /* Concatenate path element/specified name with the suffix.
1010 If the directory starts with /:, remove that. */
1011 if (XSTRING (filename
)->size
> 2
1012 && XSTRING (filename
)->data
[0] == '/'
1013 && XSTRING (filename
)->data
[1] == ':')
1015 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1016 STRING_BYTES (XSTRING (filename
)) - 2);
1017 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1021 strncpy (fn
, XSTRING (filename
)->data
,
1022 STRING_BYTES (XSTRING (filename
)));
1023 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1026 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1027 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1029 /* Check that the file exists and is not a directory. */
1030 /* We used to only check for handlers on non-absolute file names:
1034 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1035 It's not clear why that was the case and it breaks things like
1036 (load "/bar.el") where the file is actually "/bar.el.gz". */
1037 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1038 if (!NILP (handler
) && !exec_only
)
1042 string
= build_string (fn
);
1043 exists
= !NILP (Ffile_readable_p (string
));
1044 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1049 /* We succeeded; return this descriptor and filename. */
1051 *storeptr
= build_string (fn
);
1058 int exists
= (stat (fn
, &st
) >= 0
1059 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1062 /* Check that we can access or open it. */
1064 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1066 fd
= emacs_open (fn
, O_RDONLY
, 0);
1070 /* We succeeded; return this descriptor and filename. */
1072 *storeptr
= build_string (fn
);
1088 /* Merge the list we've accumulated of globals from the current input source
1089 into the load_history variable. The details depend on whether
1090 the source has an associated file name or not. */
1093 build_load_history (stream
, source
)
1097 register Lisp_Object tail
, prev
, newelt
;
1098 register Lisp_Object tem
, tem2
;
1099 register int foundit
, loading
;
1101 loading
= stream
|| !NARROWED
;
1103 tail
= Vload_history
;
1106 while (!NILP (tail
))
1110 /* Find the feature's previous assoc list... */
1111 if (!NILP (Fequal (source
, Fcar (tem
))))
1115 /* If we're loading, remove it. */
1119 Vload_history
= Fcdr (tail
);
1121 Fsetcdr (prev
, Fcdr (tail
));
1124 /* Otherwise, cons on new symbols that are not already members. */
1127 tem2
= Vcurrent_load_list
;
1129 while (CONSP (tem2
))
1131 newelt
= Fcar (tem2
);
1133 if (NILP (Fmemq (newelt
, tem
)))
1134 Fsetcar (tail
, Fcons (Fcar (tem
),
1135 Fcons (newelt
, Fcdr (tem
))));
1148 /* If we're loading, cons the new assoc onto the front of load-history,
1149 the most-recently-loaded position. Also do this if we didn't find
1150 an existing member for the current source. */
1151 if (loading
|| !foundit
)
1152 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1157 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1165 readevalloop_1 (old
)
1168 load_convert_to_unibyte
= ! NILP (old
);
1172 /* Signal an `end-of-file' error, if possible with file name
1176 end_of_file_error ()
1180 if (STRINGP (Vload_file_name
))
1181 data
= Fcons (Vload_file_name
, Qnil
);
1185 Fsignal (Qend_of_file
, data
);
1188 /* UNIBYTE specifies how to set load_convert_to_unibyte
1189 for this invocation.
1190 READFUN, if non-nil, is used instead of `read'. */
1193 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1194 Lisp_Object readcharfun
;
1196 Lisp_Object sourcename
;
1197 Lisp_Object (*evalfun
) ();
1199 Lisp_Object unibyte
, readfun
;
1202 register Lisp_Object val
;
1203 int count
= specpdl_ptr
- specpdl
;
1204 struct gcpro gcpro1
;
1205 struct buffer
*b
= 0;
1206 int continue_reading_p
;
1208 if (BUFFERP (readcharfun
))
1209 b
= XBUFFER (readcharfun
);
1210 else if (MARKERP (readcharfun
))
1211 b
= XMARKER (readcharfun
)->buffer
;
1213 specbind (Qstandard_input
, readcharfun
);
1214 specbind (Qcurrent_load_list
, Qnil
);
1215 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1216 load_convert_to_unibyte
= !NILP (unibyte
);
1218 readchar_backlog
= -1;
1220 GCPRO1 (sourcename
);
1222 LOADHIST_ATTACH (sourcename
);
1224 continue_reading_p
= 1;
1225 while (continue_reading_p
)
1227 if (b
!= 0 && NILP (b
->name
))
1228 error ("Reading from killed buffer");
1234 while ((c
= READCHAR
) != '\n' && c
!= -1);
1239 /* Ignore whitespace here, so we can detect eof. */
1240 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1243 if (!NILP (Vpurify_flag
) && c
== '(')
1245 int count1
= specpdl_ptr
- specpdl
;
1246 record_unwind_protect (unreadpure
, Qnil
);
1247 val
= read_list (-1, readcharfun
);
1248 unbind_to (count1
, Qnil
);
1253 read_objects
= Qnil
;
1254 if (!NILP (readfun
))
1256 val
= call1 (readfun
, readcharfun
);
1258 /* If READCHARFUN has set point to ZV, we should
1259 stop reading, even if the form read sets point
1260 to a different value when evaluated. */
1261 if (BUFFERP (readcharfun
))
1263 struct buffer
*b
= XBUFFER (readcharfun
);
1264 if (BUF_PT (b
) == BUF_ZV (b
))
1265 continue_reading_p
= 0;
1268 else if (! NILP (Vload_read_function
))
1269 val
= call1 (Vload_read_function
, readcharfun
);
1271 val
= read0 (readcharfun
);
1274 val
= (*evalfun
) (val
);
1278 Vvalues
= Fcons (val
, Vvalues
);
1279 if (EQ (Vstandard_output
, Qt
))
1286 build_load_history (stream
, sourcename
);
1289 unbind_to (count
, Qnil
);
1292 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1293 doc
: /* Execute the current buffer as Lisp code.
1294 Programs can pass two arguments, BUFFER and PRINTFLAG.
1295 BUFFER is the buffer to evaluate (nil means use current buffer).
1296 PRINTFLAG controls printing of output:
1297 nil means discard it; anything else is stream for print.
1299 If the optional third argument FILENAME is non-nil,
1300 it specifies the file name to use for `load-history'.
1301 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1302 for this invocation.
1304 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1305 `print' and related functions should work normally even if PRINTFLAG is nil.
1307 This function preserves the position of point. */)
1308 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1309 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1311 int count
= specpdl_ptr
- specpdl
;
1312 Lisp_Object tem
, buf
;
1315 buf
= Fcurrent_buffer ();
1317 buf
= Fget_buffer (buffer
);
1319 error ("No such buffer");
1321 if (NILP (printflag
) && NILP (do_allow_print
))
1326 if (NILP (filename
))
1327 filename
= XBUFFER (buf
)->filename
;
1329 specbind (Qstandard_output
, tem
);
1330 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1331 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1332 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1333 unbind_to (count
, Qnil
);
1338 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1339 doc
: /* Execute the region as Lisp code.
1340 When called from programs, expects two arguments,
1341 giving starting and ending indices in the current buffer
1342 of the text to be executed.
1343 Programs can pass third argument PRINTFLAG which controls output:
1344 nil means discard it; anything else is stream for printing it.
1345 Also the fourth argument READ-FUNCTION, if non-nil, is used
1346 instead of `read' to read each expression. It gets one argument
1347 which is the input stream for reading characters.
1349 This function does not move point. */)
1350 (start
, end
, printflag
, read_function
)
1351 Lisp_Object start
, end
, printflag
, read_function
;
1353 int count
= specpdl_ptr
- specpdl
;
1354 Lisp_Object tem
, cbuf
;
1356 cbuf
= Fcurrent_buffer ();
1358 if (NILP (printflag
))
1362 specbind (Qstandard_output
, tem
);
1364 if (NILP (printflag
))
1365 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1366 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1368 /* This both uses start and checks its type. */
1370 Fnarrow_to_region (make_number (BEGV
), end
);
1371 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1372 !NILP (printflag
), Qnil
, read_function
);
1374 return unbind_to (count
, Qnil
);
1378 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1379 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1380 If STREAM is nil, use the value of `standard-input' (which see).
1381 STREAM or the value of `standard-input' may be:
1382 a buffer (read from point and advance it)
1383 a marker (read from where it points and advance it)
1384 a function (call it with no arguments for each character,
1385 call it with a char as argument to push a char back)
1386 a string (takes text from string, starting at the beginning)
1387 t (read text line using minibuffer and use it, or read from
1388 standard input in batch mode). */)
1392 extern Lisp_Object
Fread_minibuffer ();
1395 stream
= Vstandard_input
;
1396 if (EQ (stream
, Qt
))
1397 stream
= Qread_char
;
1399 readchar_backlog
= -1;
1400 new_backquote_flag
= 0;
1401 read_objects
= Qnil
;
1403 if (EQ (stream
, Qread_char
))
1404 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1406 if (STRINGP (stream
))
1407 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1409 return read0 (stream
);
1412 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1413 doc
: /* Read one Lisp expression which is represented as text by STRING.
1414 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1415 START and END optionally delimit a substring of STRING from which to read;
1416 they default to 0 and (length STRING) respectively. */)
1417 (string
, start
, end
)
1418 Lisp_Object string
, start
, end
;
1420 int startval
, endval
;
1423 CHECK_STRING (string
);
1426 endval
= XSTRING (string
)->size
;
1430 endval
= XINT (end
);
1431 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1432 args_out_of_range (string
, end
);
1439 CHECK_NUMBER (start
);
1440 startval
= XINT (start
);
1441 if (startval
< 0 || startval
> endval
)
1442 args_out_of_range (string
, start
);
1445 read_from_string_index
= startval
;
1446 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1447 read_from_string_limit
= endval
;
1449 new_backquote_flag
= 0;
1450 read_objects
= Qnil
;
1452 tem
= read0 (string
);
1453 return Fcons (tem
, make_number (read_from_string_index
));
1456 /* Use this for recursive reads, in contexts where internal tokens
1461 Lisp_Object readcharfun
;
1463 register Lisp_Object val
;
1466 val
= read1 (readcharfun
, &c
, 0);
1468 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1475 static int read_buffer_size
;
1476 static char *read_buffer
;
1478 /* Read multibyte form and return it as a character. C is a first
1479 byte of multibyte form, and rest of them are read from
1480 READCHARFUN. Store the byte length of the form into *NBYTES. */
1483 read_multibyte (c
, readcharfun
, nbytes
)
1485 Lisp_Object readcharfun
;
1488 /* We need the actual character code of this multibyte
1490 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1492 int bytes
= BYTES_BY_CHAR_HEAD (c
);
1498 if (CHAR_HEAD_P (c
))
1506 if (len
== bytes
&& MULTIBYTE_LENGTH_NO_CHECK (str
) > 0)
1509 return STRING_CHAR (str
, len
);
1511 /* The byte sequence is not valid as multibyte. Unread all bytes
1512 but the first one, and return the first byte. */
1519 /* Read a \-escape sequence, assuming we already read the `\'.
1520 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1521 If the escape sequence forces multibyte and the returned character
1522 is raw 8-bit char, store 2 into *BYTEREP.
1523 If the escape sequence forces multibyte and the returned character
1524 is not raw 8-bit char, store 3 into *BYTEREP.
1525 Otherwise store 0 into *BYTEREP. */
1528 read_escape (readcharfun
, stringp
, byterep
)
1529 Lisp_Object readcharfun
;
1533 register int c
= READCHAR
;
1540 end_of_file_error ();
1570 error ("Invalid escape character syntax");
1573 c
= read_escape (readcharfun
, 0, byterep
);
1574 return c
| meta_modifier
;
1579 error ("Invalid escape character syntax");
1582 c
= read_escape (readcharfun
, 0, byterep
);
1583 return c
| shift_modifier
;
1588 error ("Invalid escape character syntax");
1591 c
= read_escape (readcharfun
, 0, byterep
);
1592 return c
| hyper_modifier
;
1597 error ("Invalid escape character syntax");
1600 c
= read_escape (readcharfun
, 0, byterep
);
1601 return c
| alt_modifier
;
1606 error ("Invalid escape character syntax");
1609 c
= read_escape (readcharfun
, 0, byterep
);
1610 return c
| super_modifier
;
1615 error ("Invalid escape character syntax");
1619 c
= read_escape (readcharfun
, 0, byterep
);
1620 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1621 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1622 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1623 return c
| ctrl_modifier
;
1624 /* ASCII control chars are made from letters (both cases),
1625 as well as the non-letters within 0100...0137. */
1626 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1627 return (c
& (037 | ~0177));
1628 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1629 return (c
& (037 | ~0177));
1631 return c
| ctrl_modifier
;
1641 /* An octal escape, as in ANSI C. */
1643 register int i
= c
- '0';
1644 register int count
= 0;
1647 if ((c
= READCHAR
) >= '0' && c
<= '7')
1667 /* A hex escape, as in ANSI C. */
1674 if (c
>= '0' && c
<= '9')
1679 else if ((c
>= 'a' && c
<= 'f')
1680 || (c
>= 'A' && c
<= 'F'))
1683 if (c
>= 'a' && c
<= 'f')
1696 if (count
< 3 && i
>= 0x80)
1704 if (EQ (readcharfun
, Qget_file_char
)
1705 && BASE_LEADING_CODE_P (c
))
1709 c
= read_multibyte (c
, readcharfun
, &nbytes
);
1718 /* Read an integer in radix RADIX using READCHARFUN to read
1719 characters. RADIX must be in the interval [2..36]; if it isn't, a
1720 read error is signaled . Value is the integer read. Signals an
1721 error if encountering invalid read syntax or if RADIX is out of
1725 read_integer (readcharfun
, radix
)
1726 Lisp_Object readcharfun
;
1729 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1730 EMACS_INT number
= 0;
1732 if (radix
< 2 || radix
> 36)
1736 number
= ndigits
= invalid_p
= 0;
1752 if (c
>= '0' && c
<= '9')
1754 else if (c
>= 'a' && c
<= 'z')
1755 digit
= c
- 'a' + 10;
1756 else if (c
>= 'A' && c
<= 'Z')
1757 digit
= c
- 'A' + 10;
1764 if (digit
< 0 || digit
>= radix
)
1767 number
= radix
* number
+ digit
;
1773 if (ndigits
== 0 || invalid_p
)
1776 sprintf (buf
, "integer, radix %d", radix
);
1777 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1780 return make_number (sign
* number
);
1784 /* If the next token is ')' or ']' or '.', we store that character
1785 in *PCH and the return value is not interesting. Else, we store
1786 zero in *PCH and we read and return one lisp object.
1788 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1791 read1 (readcharfun
, pch
, first_in_list
)
1792 register Lisp_Object readcharfun
;
1797 int uninterned_symbol
= 0;
1805 end_of_file_error ();
1810 return read_list (0, readcharfun
);
1813 return read_vector (readcharfun
, 0);
1830 tmp
= read_vector (readcharfun
, 0);
1831 if (XVECTOR (tmp
)->size
!= VECSIZE (struct Lisp_Char_Table
))
1832 error ("Invalid size char-table");
1833 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1844 tmp
= read_vector (readcharfun
, 0);
1845 if (!INTEGERP (AREF (tmp
, 0)))
1846 error ("Invalid depth in char-table");
1847 depth
= XINT (AREF (tmp
, 0));
1848 if (depth
< 1 || depth
> 3)
1849 error ("Invalid depth in char-table");
1850 size
= XVECTOR (tmp
)->size
+ 2;
1851 if (chartab_size
[depth
] != size
)
1852 error ("Invalid size char-table");
1853 XSETSUB_CHAR_TABLE (tmp
, XSUB_CHAR_TABLE (tmp
));
1856 Fsignal (Qinvalid_read_syntax
,
1857 Fcons (make_string ("#^^", 3), Qnil
));
1859 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1864 length
= read1 (readcharfun
, pch
, first_in_list
);
1868 Lisp_Object tmp
, val
;
1869 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1873 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1874 if (size_in_chars
!= XSTRING (tmp
)->size
1875 /* We used to print 1 char too many
1876 when the number of bits was a multiple of 8.
1877 Accept such input in case it came from an old version. */
1878 && ! (XFASTINT (length
)
1879 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1880 Fsignal (Qinvalid_read_syntax
,
1881 Fcons (make_string ("#&...", 5), Qnil
));
1883 val
= Fmake_bool_vector (length
, Qnil
);
1884 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1886 /* Clear the extraneous bits in the last byte. */
1887 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1888 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1889 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1892 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1897 /* Accept compiled functions at read-time so that we don't have to
1898 build them using function calls. */
1900 tmp
= read_vector (readcharfun
, 1);
1901 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1902 XVECTOR (tmp
)->contents
);
1907 struct gcpro gcpro1
;
1910 /* Read the string itself. */
1911 tmp
= read1 (readcharfun
, &ch
, 0);
1912 if (ch
!= 0 || !STRINGP (tmp
))
1913 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1915 /* Read the intervals and their properties. */
1918 Lisp_Object beg
, end
, plist
;
1920 beg
= read1 (readcharfun
, &ch
, 0);
1925 end
= read1 (readcharfun
, &ch
, 0);
1927 plist
= read1 (readcharfun
, &ch
, 0);
1929 Fsignal (Qinvalid_read_syntax
,
1930 Fcons (build_string ("invalid string property list"),
1932 Fset_text_properties (beg
, end
, plist
, tmp
);
1938 /* #@NUMBER is used to skip NUMBER following characters.
1939 That's used in .elc files to skip over doc strings
1940 and function definitions. */
1945 /* Read a decimal integer. */
1946 while ((c
= READCHAR
) >= 0
1947 && c
>= '0' && c
<= '9')
1955 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1957 /* If we are supposed to force doc strings into core right now,
1958 record the last string that we skipped,
1959 and record where in the file it comes from. */
1961 /* But first exchange saved_doc_string
1962 with prev_saved_doc_string, so we save two strings. */
1964 char *temp
= saved_doc_string
;
1965 int temp_size
= saved_doc_string_size
;
1966 file_offset temp_pos
= saved_doc_string_position
;
1967 int temp_len
= saved_doc_string_length
;
1969 saved_doc_string
= prev_saved_doc_string
;
1970 saved_doc_string_size
= prev_saved_doc_string_size
;
1971 saved_doc_string_position
= prev_saved_doc_string_position
;
1972 saved_doc_string_length
= prev_saved_doc_string_length
;
1974 prev_saved_doc_string
= temp
;
1975 prev_saved_doc_string_size
= temp_size
;
1976 prev_saved_doc_string_position
= temp_pos
;
1977 prev_saved_doc_string_length
= temp_len
;
1980 if (saved_doc_string_size
== 0)
1982 saved_doc_string_size
= nskip
+ 100;
1983 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1985 if (nskip
> saved_doc_string_size
)
1987 saved_doc_string_size
= nskip
+ 100;
1988 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1989 saved_doc_string_size
);
1992 saved_doc_string_position
= file_tell (instream
);
1994 /* Copy that many characters into saved_doc_string. */
1995 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1996 saved_doc_string
[i
] = c
= READCHAR
;
1998 saved_doc_string_length
= i
;
2002 /* Skip that many characters. */
2003 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2010 return Vload_file_name
;
2012 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2013 /* #:foo is the uninterned symbol named foo. */
2016 uninterned_symbol
= 1;
2020 /* Reader forms that can reuse previously read objects. */
2021 if (c
>= '0' && c
<= '9')
2026 /* Read a non-negative integer. */
2027 while (c
>= '0' && c
<= '9')
2033 /* #n=object returns object, but associates it with n for #n#. */
2036 /* Make a placeholder for #n# to use temporarily */
2037 Lisp_Object placeholder
;
2040 placeholder
= Fcons(Qnil
, Qnil
);
2041 cell
= Fcons (make_number (n
), placeholder
);
2042 read_objects
= Fcons (cell
, read_objects
);
2044 /* Read the object itself. */
2045 tem
= read0 (readcharfun
);
2047 /* Now put it everywhere the placeholder was... */
2048 substitute_object_in_subtree (tem
, placeholder
);
2050 /* ...and #n# will use the real value from now on. */
2051 Fsetcdr (cell
, tem
);
2055 /* #n# returns a previously read object. */
2058 tem
= Fassq (make_number (n
), read_objects
);
2061 /* Fall through to error message. */
2063 else if (c
== 'r' || c
== 'R')
2064 return read_integer (readcharfun
, n
);
2066 /* Fall through to error message. */
2068 else if (c
== 'x' || c
== 'X')
2069 return read_integer (readcharfun
, 16);
2070 else if (c
== 'o' || c
== 'O')
2071 return read_integer (readcharfun
, 8);
2072 else if (c
== 'b' || c
== 'B')
2073 return read_integer (readcharfun
, 2);
2076 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2079 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2084 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2094 new_backquote_flag
++;
2095 value
= read0 (readcharfun
);
2096 new_backquote_flag
--;
2098 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2102 if (new_backquote_flag
)
2104 Lisp_Object comma_type
= Qnil
;
2109 comma_type
= Qcomma_at
;
2111 comma_type
= Qcomma_dot
;
2114 if (ch
>= 0) UNREAD (ch
);
2115 comma_type
= Qcomma
;
2118 new_backquote_flag
--;
2119 value
= read0 (readcharfun
);
2120 new_backquote_flag
++;
2121 return Fcons (comma_type
, Fcons (value
, Qnil
));
2132 end_of_file_error ();
2135 c
= read_escape (readcharfun
, 0, &discard
);
2136 else if (EQ (readcharfun
, Qget_file_char
)
2137 && BASE_LEADING_CODE_P (c
))
2138 c
= read_multibyte (c
, readcharfun
, &discard
);
2140 return make_number (c
);
2145 char *p
= read_buffer
;
2146 char *end
= read_buffer
+ read_buffer_size
;
2148 /* Nonzero if we saw an escape sequence specifying
2149 a multibyte character. */
2150 int force_multibyte
= 0;
2151 /* Nonzero if we saw an escape sequence specifying
2152 a single-byte character. */
2153 int force_singlebyte
= 0;
2157 while ((c
= READCHAR
) >= 0
2160 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2162 int offset
= p
- read_buffer
;
2163 read_buffer
= (char *) xrealloc (read_buffer
,
2164 read_buffer_size
*= 2);
2165 p
= read_buffer
+ offset
;
2166 end
= read_buffer
+ read_buffer_size
;
2174 c
= read_escape (readcharfun
, 1, &byterep
);
2176 /* C is -1 if \ newline has just been seen */
2179 if (p
== read_buffer
)
2184 modifiers
= c
& CHAR_MODIFIER_MASK
;
2185 c
= c
& ~CHAR_MODIFIER_MASK
;
2189 force_singlebyte
= 1;
2191 /* Raw 8-bit code */
2192 c
= BYTE8_TO_CHAR (c
);
2194 else if (byterep
> 1)
2196 force_multibyte
= 1;
2198 c
= BYTE8_TO_CHAR (c
);
2202 force_singlebyte
= 1;
2203 c
= BYTE8_TO_CHAR (c
);
2206 if (ASCII_CHAR_P (c
))
2208 /* Allow `\C- ' and `\C-?'. */
2209 if (modifiers
== CHAR_CTL
)
2212 c
= 0, modifiers
= 0;
2214 c
= 127, modifiers
= 0;
2216 if (modifiers
& CHAR_SHIFT
)
2218 /* Shift modifier is valid only with [A-Za-z]. */
2219 if (c
>= 'A' && c
<= 'Z')
2220 modifiers
&= ~CHAR_SHIFT
;
2221 else if (c
>= 'a' && c
<= 'z')
2222 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2225 if (modifiers
& CHAR_META
)
2227 /* Move the meta bit to the right place for a
2229 modifiers
&= ~CHAR_META
;
2230 c
= BYTE8_TO_CHAR (c
| 0x80);
2231 force_singlebyte
= 1;
2235 /* Any modifiers remaining are invalid. */
2237 error ("Invalid modifier in string");
2238 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2242 if (EQ (readcharfun
, Qget_file_char
))
2244 if (BASE_LEADING_CODE_P (c
))
2247 c
= read_multibyte (c
, readcharfun
, &nbytes
);
2249 force_multibyte
= 1;
2252 force_singlebyte
= 1;
2253 c
= BYTE8_TO_CHAR (c
);
2258 force_singlebyte
= 1;
2259 c
= BYTE8_TO_CHAR (c
);
2263 force_multibyte
= 1;
2264 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2271 end_of_file_error ();
2273 /* If purifying, and string starts with \ newline,
2274 return zero instead. This is for doc strings
2275 that we are really going to find in etc/DOC.nn.nn */
2276 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2277 return make_number (0);
2279 if (force_multibyte
)
2280 /* READ_BUFFER already contains valid multibyte forms. */
2282 else if (force_singlebyte
)
2284 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2285 p
= read_buffer
+ nchars
;
2288 /* Otherwise, READ_BUFFER contains only ASCII. */
2291 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2293 || (p
- read_buffer
!= nchars
)));
2294 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2296 || (p
- read_buffer
!= nchars
)));
2301 int next_char
= READCHAR
;
2304 if (next_char
<= 040
2305 || index ("\"'`,(", next_char
))
2311 /* Otherwise, we fall through! Note that the atom-reading loop
2312 below will now loop at least once, assuring that we will not
2313 try to UNREAD two characters in a row. */
2317 if (c
<= 040) goto retry
;
2319 char *p
= read_buffer
;
2323 char *end
= read_buffer
+ read_buffer_size
;
2326 && !(c
== '\"' || c
== '\'' || c
== ';'
2327 || c
== '(' || c
== ')'
2328 || c
== '[' || c
== ']' || c
== '#'))
2330 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2332 int offset
= p
- read_buffer
;
2333 read_buffer
= (char *) xrealloc (read_buffer
,
2334 read_buffer_size
*= 2);
2335 p
= read_buffer
+ offset
;
2336 end
= read_buffer
+ read_buffer_size
;
2343 end_of_file_error ();
2347 if (! SINGLE_BYTE_CHAR_P (c
))
2348 p
+= CHAR_STRING (c
, p
);
2357 int offset
= p
- read_buffer
;
2358 read_buffer
= (char *) xrealloc (read_buffer
,
2359 read_buffer_size
*= 2);
2360 p
= read_buffer
+ offset
;
2361 end
= read_buffer
+ read_buffer_size
;
2368 if (!quoted
&& !uninterned_symbol
)
2371 register Lisp_Object val
;
2373 if (*p1
== '+' || *p1
== '-') p1
++;
2374 /* Is it an integer? */
2377 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2378 /* Integers can have trailing decimal points. */
2379 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2381 /* It is an integer. */
2385 if (sizeof (int) == sizeof (EMACS_INT
))
2386 XSETINT (val
, atoi (read_buffer
));
2387 else if (sizeof (long) == sizeof (EMACS_INT
))
2388 XSETINT (val
, atol (read_buffer
));
2394 if (isfloat_string (read_buffer
))
2396 /* Compute NaN and infinities using 0.0 in a variable,
2397 to cope with compilers that think they are smarter
2403 /* Negate the value ourselves. This treats 0, NaNs,
2404 and infinity properly on IEEE floating point hosts,
2405 and works around a common bug where atof ("-0.0")
2407 int negative
= read_buffer
[0] == '-';
2409 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2410 returns 1, is if the input ends in e+INF or e+NaN. */
2417 value
= zero
/ zero
;
2420 value
= atof (read_buffer
+ negative
);
2424 return make_float (negative
? - value
: value
);
2428 if (uninterned_symbol
)
2429 return make_symbol (read_buffer
);
2431 return intern (read_buffer
);
2437 /* List of nodes we've seen during substitute_object_in_subtree. */
2438 static Lisp_Object seen_list
;
2441 substitute_object_in_subtree (object
, placeholder
)
2443 Lisp_Object placeholder
;
2445 Lisp_Object check_object
;
2447 /* We haven't seen any objects when we start. */
2450 /* Make all the substitutions. */
2452 = substitute_object_recurse (object
, placeholder
, object
);
2454 /* Clear seen_list because we're done with it. */
2457 /* The returned object here is expected to always eq the
2459 if (!EQ (check_object
, object
))
2460 error ("Unexpected mutation error in reader");
2463 /* Feval doesn't get called from here, so no gc protection is needed. */
2464 #define SUBSTITUTE(get_val, set_val) \
2466 Lisp_Object old_value = get_val; \
2467 Lisp_Object true_value \
2468 = substitute_object_recurse (object, placeholder,\
2471 if (!EQ (old_value, true_value)) \
2478 substitute_object_recurse (object
, placeholder
, subtree
)
2480 Lisp_Object placeholder
;
2481 Lisp_Object subtree
;
2483 /* If we find the placeholder, return the target object. */
2484 if (EQ (placeholder
, subtree
))
2487 /* If we've been to this node before, don't explore it again. */
2488 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2491 /* If this node can be the entry point to a cycle, remember that
2492 we've seen it. It can only be such an entry point if it was made
2493 by #n=, which means that we can find it as a value in
2495 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2496 seen_list
= Fcons (subtree
, seen_list
);
2498 /* Recurse according to subtree's type.
2499 Every branch must return a Lisp_Object. */
2500 switch (XTYPE (subtree
))
2502 case Lisp_Vectorlike
:
2505 int length
= XINT (Flength(subtree
));
2506 for (i
= 0; i
< length
; i
++)
2508 Lisp_Object idx
= make_number (i
);
2509 SUBSTITUTE (Faref (subtree
, idx
),
2510 Faset (subtree
, idx
, true_value
));
2517 SUBSTITUTE (Fcar_safe (subtree
),
2518 Fsetcar (subtree
, true_value
));
2519 SUBSTITUTE (Fcdr_safe (subtree
),
2520 Fsetcdr (subtree
, true_value
));
2526 /* Check for text properties in each interval.
2527 substitute_in_interval contains part of the logic. */
2529 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2530 Lisp_Object arg
= Fcons (object
, placeholder
);
2532 traverse_intervals_noorder (root_interval
,
2533 &substitute_in_interval
, arg
);
2538 /* Other types don't recurse any further. */
2544 /* Helper function for substitute_object_recurse. */
2546 substitute_in_interval (interval
, arg
)
2550 Lisp_Object object
= Fcar (arg
);
2551 Lisp_Object placeholder
= Fcdr (arg
);
2553 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2572 if (*cp
== '+' || *cp
== '-')
2575 if (*cp
>= '0' && *cp
<= '9')
2578 while (*cp
>= '0' && *cp
<= '9')
2586 if (*cp
>= '0' && *cp
<= '9')
2589 while (*cp
>= '0' && *cp
<= '9')
2592 if (*cp
== 'e' || *cp
== 'E')
2596 if (*cp
== '+' || *cp
== '-')
2600 if (*cp
>= '0' && *cp
<= '9')
2603 while (*cp
>= '0' && *cp
<= '9')
2606 else if (cp
== start
)
2608 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2613 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2619 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2620 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2621 || state
== (DOT_CHAR
|TRAIL_INT
)
2622 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2623 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2624 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2629 read_vector (readcharfun
, bytecodeflag
)
2630 Lisp_Object readcharfun
;
2635 register Lisp_Object
*ptr
;
2636 register Lisp_Object tem
, item
, vector
;
2637 register struct Lisp_Cons
*otem
;
2640 tem
= read_list (1, readcharfun
);
2641 len
= Flength (tem
);
2642 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2644 size
= XVECTOR (vector
)->size
;
2645 ptr
= XVECTOR (vector
)->contents
;
2646 for (i
= 0; i
< size
; i
++)
2649 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2650 bytecode object, the docstring containing the bytecode and
2651 constants values must be treated as unibyte and passed to
2652 Fread, to get the actual bytecode string and constants vector. */
2653 if (bytecodeflag
&& load_force_doc_strings
)
2655 if (i
== COMPILED_BYTECODE
)
2657 if (!STRINGP (item
))
2658 error ("invalid byte code");
2660 /* Delay handling the bytecode slot until we know whether
2661 it is lazily-loaded (we can tell by whether the
2662 constants slot is nil). */
2663 ptr
[COMPILED_CONSTANTS
] = item
;
2666 else if (i
== COMPILED_CONSTANTS
)
2668 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2672 /* Coerce string to unibyte (like string-as-unibyte,
2673 but without generating extra garbage and
2674 guaranteeing no change in the contents). */
2675 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2676 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2678 item
= Fread (bytestr
);
2680 error ("invalid byte code");
2682 otem
= XCONS (item
);
2683 bytestr
= XCAR (item
);
2688 /* Now handle the bytecode slot. */
2689 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2692 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2700 /* FLAG = 1 means check for ] to terminate rather than ) and .
2701 FLAG = -1 means check for starting with defun
2702 and make structure pure. */
2705 read_list (flag
, readcharfun
)
2707 register Lisp_Object readcharfun
;
2709 /* -1 means check next element for defun,
2710 0 means don't check,
2711 1 means already checked and found defun. */
2712 int defunflag
= flag
< 0 ? -1 : 0;
2713 Lisp_Object val
, tail
;
2714 register Lisp_Object elt
, tem
;
2715 struct gcpro gcpro1
, gcpro2
;
2716 /* 0 is the normal case.
2717 1 means this list is a doc reference; replace it with the number 0.
2718 2 means this list is a doc reference; replace it with the doc string. */
2719 int doc_reference
= 0;
2721 /* Initialize this to 1 if we are reading a list. */
2722 int first_in_list
= flag
<= 0;
2731 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2736 /* While building, if the list starts with #$, treat it specially. */
2737 if (EQ (elt
, Vload_file_name
)
2739 && !NILP (Vpurify_flag
))
2741 if (NILP (Vdoc_file_name
))
2742 /* We have not yet called Snarf-documentation, so assume
2743 this file is described in the DOC-MM.NN file
2744 and Snarf-documentation will fill in the right value later.
2745 For now, replace the whole list with 0. */
2748 /* We have already called Snarf-documentation, so make a relative
2749 file name for this file, so it can be found properly
2750 in the installed Lisp directory.
2751 We don't use Fexpand_file_name because that would make
2752 the directory absolute now. */
2753 elt
= concat2 (build_string ("../lisp/"),
2754 Ffile_name_nondirectory (elt
));
2756 else if (EQ (elt
, Vload_file_name
)
2758 && load_force_doc_strings
)
2767 Fsignal (Qinvalid_read_syntax
,
2768 Fcons (make_string (") or . in a vector", 18), Qnil
));
2776 XSETCDR (tail
, read0 (readcharfun
));
2778 val
= read0 (readcharfun
);
2779 read1 (readcharfun
, &ch
, 0);
2783 if (doc_reference
== 1)
2784 return make_number (0);
2785 if (doc_reference
== 2)
2787 /* Get a doc string from the file we are loading.
2788 If it's in saved_doc_string, get it from there. */
2789 int pos
= XINT (XCDR (val
));
2790 /* Position is negative for user variables. */
2791 if (pos
< 0) pos
= -pos
;
2792 if (pos
>= saved_doc_string_position
2793 && pos
< (saved_doc_string_position
2794 + saved_doc_string_length
))
2796 int start
= pos
- saved_doc_string_position
;
2799 /* Process quoting with ^A,
2800 and find the end of the string,
2801 which is marked with ^_ (037). */
2802 for (from
= start
, to
= start
;
2803 saved_doc_string
[from
] != 037;)
2805 int c
= saved_doc_string
[from
++];
2808 c
= saved_doc_string
[from
++];
2810 saved_doc_string
[to
++] = c
;
2812 saved_doc_string
[to
++] = 0;
2814 saved_doc_string
[to
++] = 037;
2817 saved_doc_string
[to
++] = c
;
2820 return make_string (saved_doc_string
+ start
,
2823 /* Look in prev_saved_doc_string the same way. */
2824 else if (pos
>= prev_saved_doc_string_position
2825 && pos
< (prev_saved_doc_string_position
2826 + prev_saved_doc_string_length
))
2828 int start
= pos
- prev_saved_doc_string_position
;
2831 /* Process quoting with ^A,
2832 and find the end of the string,
2833 which is marked with ^_ (037). */
2834 for (from
= start
, to
= start
;
2835 prev_saved_doc_string
[from
] != 037;)
2837 int c
= prev_saved_doc_string
[from
++];
2840 c
= prev_saved_doc_string
[from
++];
2842 prev_saved_doc_string
[to
++] = c
;
2844 prev_saved_doc_string
[to
++] = 0;
2846 prev_saved_doc_string
[to
++] = 037;
2849 prev_saved_doc_string
[to
++] = c
;
2852 return make_string (prev_saved_doc_string
+ start
,
2856 return get_doc_string (val
, 0, 0);
2861 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2863 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2865 tem
= (read_pure
&& flag
<= 0
2866 ? pure_cons (elt
, Qnil
)
2867 : Fcons (elt
, Qnil
));
2869 XSETCDR (tail
, tem
);
2874 defunflag
= EQ (elt
, Qdefun
);
2875 else if (defunflag
> 0)
2880 Lisp_Object Vobarray
;
2881 Lisp_Object initial_obarray
;
2883 /* oblookup stores the bucket number here, for the sake of Funintern. */
2885 int oblookup_last_bucket_number
;
2887 static int hash_string ();
2888 Lisp_Object
oblookup ();
2890 /* Get an error if OBARRAY is not an obarray.
2891 If it is one, return it. */
2894 check_obarray (obarray
)
2895 Lisp_Object obarray
;
2897 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2899 /* If Vobarray is now invalid, force it to be valid. */
2900 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2902 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2907 /* Intern the C string STR: return a symbol with that name,
2908 interned in the current obarray. */
2915 int len
= strlen (str
);
2916 Lisp_Object obarray
;
2919 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2920 obarray
= check_obarray (obarray
);
2921 tem
= oblookup (obarray
, str
, len
, len
);
2924 return Fintern (make_string (str
, len
), obarray
);
2927 /* Create an uninterned symbol with name STR. */
2933 int len
= strlen (str
);
2935 return Fmake_symbol ((!NILP (Vpurify_flag
)
2936 ? make_pure_string (str
, len
, len
, 0)
2937 : make_string (str
, len
)));
2940 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2941 doc
: /* Return the canonical symbol whose name is STRING.
2942 If there is none, one is created by this function and returned.
2943 A second optional argument specifies the obarray to use;
2944 it defaults to the value of `obarray'. */)
2946 Lisp_Object string
, obarray
;
2948 register Lisp_Object tem
, sym
, *ptr
;
2950 if (NILP (obarray
)) obarray
= Vobarray
;
2951 obarray
= check_obarray (obarray
);
2953 CHECK_STRING (string
);
2955 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2956 XSTRING (string
)->size
,
2957 STRING_BYTES (XSTRING (string
)));
2958 if (!INTEGERP (tem
))
2961 if (!NILP (Vpurify_flag
))
2962 string
= Fpurecopy (string
);
2963 sym
= Fmake_symbol (string
);
2965 if (EQ (obarray
, initial_obarray
))
2966 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2968 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2970 if ((XSTRING (string
)->data
[0] == ':')
2971 && EQ (obarray
, initial_obarray
))
2973 XSYMBOL (sym
)->constant
= 1;
2974 XSYMBOL (sym
)->value
= sym
;
2977 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2979 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2981 XSYMBOL (sym
)->next
= 0;
2986 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2987 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
2988 NAME may be a string or a symbol. If it is a symbol, that exact
2989 symbol is searched for.
2990 A second optional argument specifies the obarray to use;
2991 it defaults to the value of `obarray'. */)
2993 Lisp_Object name
, obarray
;
2995 register Lisp_Object tem
;
2996 struct Lisp_String
*string
;
2998 if (NILP (obarray
)) obarray
= Vobarray
;
2999 obarray
= check_obarray (obarray
);
3001 if (!SYMBOLP (name
))
3003 CHECK_STRING (name
);
3004 string
= XSTRING (name
);
3007 string
= XSYMBOL (name
)->name
;
3009 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
3010 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3016 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3017 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3018 The value is t if a symbol was found and deleted, nil otherwise.
3019 NAME may be a string or a symbol. If it is a symbol, that symbol
3020 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3021 OBARRAY defaults to the value of the variable `obarray'. */)
3023 Lisp_Object name
, obarray
;
3025 register Lisp_Object string
, tem
;
3028 if (NILP (obarray
)) obarray
= Vobarray
;
3029 obarray
= check_obarray (obarray
);
3032 XSETSTRING (string
, XSYMBOL (name
)->name
);
3035 CHECK_STRING (name
);
3039 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3040 XSTRING (string
)->size
,
3041 STRING_BYTES (XSTRING (string
)));
3044 /* If arg was a symbol, don't delete anything but that symbol itself. */
3045 if (SYMBOLP (name
) && !EQ (name
, tem
))
3048 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3049 XSYMBOL (tem
)->constant
= 0;
3050 XSYMBOL (tem
)->indirect_variable
= 0;
3052 hash
= oblookup_last_bucket_number
;
3054 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3056 if (XSYMBOL (tem
)->next
)
3057 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3059 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3063 Lisp_Object tail
, following
;
3065 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3066 XSYMBOL (tail
)->next
;
3069 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3070 if (EQ (following
, tem
))
3072 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3081 /* Return the symbol in OBARRAY whose names matches the string
3082 of SIZE characters (SIZE_BYTE bytes) at PTR.
3083 If there is no such symbol in OBARRAY, return nil.
3085 Also store the bucket number in oblookup_last_bucket_number. */
3088 oblookup (obarray
, ptr
, size
, size_byte
)
3089 Lisp_Object obarray
;
3091 int size
, size_byte
;
3095 register Lisp_Object tail
;
3096 Lisp_Object bucket
, tem
;
3098 if (!VECTORP (obarray
)
3099 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3101 obarray
= check_obarray (obarray
);
3102 obsize
= XVECTOR (obarray
)->size
;
3104 /* This is sometimes needed in the middle of GC. */
3105 obsize
&= ~ARRAY_MARK_FLAG
;
3106 /* Combining next two lines breaks VMS C 2.3. */
3107 hash
= hash_string (ptr
, size_byte
);
3109 bucket
= XVECTOR (obarray
)->contents
[hash
];
3110 oblookup_last_bucket_number
= hash
;
3111 if (XFASTINT (bucket
) == 0)
3113 else if (!SYMBOLP (bucket
))
3114 error ("Bad data in guts of obarray"); /* Like CADR error message */
3116 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3118 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3119 && XSYMBOL (tail
)->name
->size
== size
3120 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3122 else if (XSYMBOL (tail
)->next
== 0)
3125 XSETINT (tem
, hash
);
3130 hash_string (ptr
, len
)
3134 register unsigned char *p
= ptr
;
3135 register unsigned char *end
= p
+ len
;
3136 register unsigned char c
;
3137 register int hash
= 0;
3142 if (c
>= 0140) c
-= 40;
3143 hash
= ((hash
<<3) + (hash
>>28) + c
);
3145 return hash
& 07777777777;
3149 map_obarray (obarray
, fn
, arg
)
3150 Lisp_Object obarray
;
3151 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3155 register Lisp_Object tail
;
3156 CHECK_VECTOR (obarray
);
3157 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3159 tail
= XVECTOR (obarray
)->contents
[i
];
3164 if (XSYMBOL (tail
)->next
== 0)
3166 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3172 mapatoms_1 (sym
, function
)
3173 Lisp_Object sym
, function
;
3175 call1 (function
, sym
);
3178 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3179 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3180 OBARRAY defaults to the value of `obarray'. */)
3182 Lisp_Object function
, obarray
;
3184 if (NILP (obarray
)) obarray
= Vobarray
;
3185 obarray
= check_obarray (obarray
);
3187 map_obarray (obarray
, mapatoms_1
, function
);
3191 #define OBARRAY_SIZE 1511
3196 Lisp_Object oblength
;
3200 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3202 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3203 Vobarray
= Fmake_vector (oblength
, make_number (0));
3204 initial_obarray
= Vobarray
;
3205 staticpro (&initial_obarray
);
3206 /* Intern nil in the obarray */
3207 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3208 XSYMBOL (Qnil
)->constant
= 1;
3210 /* These locals are to kludge around a pyramid compiler bug. */
3211 hash
= hash_string ("nil", 3);
3212 /* Separate statement here to avoid VAXC bug. */
3213 hash
%= OBARRAY_SIZE
;
3214 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3217 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3218 XSYMBOL (Qnil
)->function
= Qunbound
;
3219 XSYMBOL (Qunbound
)->value
= Qunbound
;
3220 XSYMBOL (Qunbound
)->function
= Qunbound
;
3223 XSYMBOL (Qnil
)->value
= Qnil
;
3224 XSYMBOL (Qnil
)->plist
= Qnil
;
3225 XSYMBOL (Qt
)->value
= Qt
;
3226 XSYMBOL (Qt
)->constant
= 1;
3228 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3231 Qvariable_documentation
= intern ("variable-documentation");
3232 staticpro (&Qvariable_documentation
);
3234 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3235 read_buffer
= (char *) xmalloc (read_buffer_size
);
3240 struct Lisp_Subr
*sname
;
3243 sym
= intern (sname
->symbol_name
);
3244 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3247 #ifdef NOTDEF /* use fset in subr.el now */
3249 defalias (sname
, string
)
3250 struct Lisp_Subr
*sname
;
3254 sym
= intern (string
);
3255 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3259 /* Define an "integer variable"; a symbol whose value is forwarded
3260 to a C variable of type int. Sample call: */
3261 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3263 defvar_int (namestring
, address
)
3267 Lisp_Object sym
, val
;
3268 sym
= intern (namestring
);
3269 val
= allocate_misc ();
3270 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3271 XINTFWD (val
)->intvar
= address
;
3272 SET_SYMBOL_VALUE (sym
, val
);
3275 /* Similar but define a variable whose value is t if address contains 1,
3276 nil if address contains 0 */
3278 defvar_bool (namestring
, address
)
3282 Lisp_Object sym
, val
;
3283 sym
= intern (namestring
);
3284 val
= allocate_misc ();
3285 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3286 XBOOLFWD (val
)->boolvar
= address
;
3287 SET_SYMBOL_VALUE (sym
, val
);
3288 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3291 /* Similar but define a variable whose value is the Lisp Object stored
3292 at address. Two versions: with and without gc-marking of the C
3293 variable. The nopro version is used when that variable will be
3294 gc-marked for some other reason, since marking the same slot twice
3295 can cause trouble with strings. */
3297 defvar_lisp_nopro (namestring
, address
)
3299 Lisp_Object
*address
;
3301 Lisp_Object sym
, val
;
3302 sym
= intern (namestring
);
3303 val
= allocate_misc ();
3304 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3305 XOBJFWD (val
)->objvar
= address
;
3306 SET_SYMBOL_VALUE (sym
, val
);
3310 defvar_lisp (namestring
, address
)
3312 Lisp_Object
*address
;
3314 defvar_lisp_nopro (namestring
, address
);
3315 staticpro (address
);
3318 /* Similar but define a variable whose value is the Lisp Object stored in
3319 the current buffer. address is the address of the slot in the buffer
3320 that is current now. */
3323 defvar_per_buffer (namestring
, address
, type
, doc
)
3325 Lisp_Object
*address
;
3329 Lisp_Object sym
, val
;
3331 extern struct buffer buffer_local_symbols
;
3333 sym
= intern (namestring
);
3334 val
= allocate_misc ();
3335 offset
= (char *)address
- (char *)current_buffer
;
3337 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3338 XBUFFER_OBJFWD (val
)->offset
= offset
;
3339 SET_SYMBOL_VALUE (sym
, val
);
3340 PER_BUFFER_SYMBOL (offset
) = sym
;
3341 PER_BUFFER_TYPE (offset
) = type
;
3343 if (PER_BUFFER_IDX (offset
) == 0)
3344 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3345 slot of buffer_local_flags */
3350 /* Similar but define a variable whose value is the Lisp Object stored
3351 at a particular offset in the current kboard object. */
3354 defvar_kboard (namestring
, offset
)
3358 Lisp_Object sym
, val
;
3359 sym
= intern (namestring
);
3360 val
= allocate_misc ();
3361 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3362 XKBOARD_OBJFWD (val
)->offset
= offset
;
3363 SET_SYMBOL_VALUE (sym
, val
);
3366 /* Record the value of load-path used at the start of dumping
3367 so we can see if the site changed it later during dumping. */
3368 static Lisp_Object dump_path
;
3374 int turn_off_warning
= 0;
3376 /* Compute the default load-path. */
3378 normal
= PATH_LOADSEARCH
;
3379 Vload_path
= decode_env_path (0, normal
);
3381 if (NILP (Vpurify_flag
))
3382 normal
= PATH_LOADSEARCH
;
3384 normal
= PATH_DUMPLOADSEARCH
;
3386 /* In a dumped Emacs, we normally have to reset the value of
3387 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3388 uses ../lisp, instead of the path of the installed elisp
3389 libraries. However, if it appears that Vload_path was changed
3390 from the default before dumping, don't override that value. */
3393 if (! NILP (Fequal (dump_path
, Vload_path
)))
3395 Vload_path
= decode_env_path (0, normal
);
3396 if (!NILP (Vinstallation_directory
))
3398 Lisp_Object tem
, tem1
, sitelisp
;
3400 /* Remove site-lisp dirs from path temporarily and store
3401 them in sitelisp, then conc them on at the end so
3402 they're always first in path. */
3406 tem
= Fcar (Vload_path
);
3407 tem1
= Fstring_match (build_string ("site-lisp"),
3411 Vload_path
= Fcdr (Vload_path
);
3412 sitelisp
= Fcons (tem
, sitelisp
);
3418 /* Add to the path the lisp subdir of the
3419 installation dir, if it exists. */
3420 tem
= Fexpand_file_name (build_string ("lisp"),
3421 Vinstallation_directory
);
3422 tem1
= Ffile_exists_p (tem
);
3425 if (NILP (Fmember (tem
, Vload_path
)))
3427 turn_off_warning
= 1;
3428 Vload_path
= Fcons (tem
, Vload_path
);
3432 /* That dir doesn't exist, so add the build-time
3433 Lisp dirs instead. */
3434 Vload_path
= nconc2 (Vload_path
, dump_path
);
3436 /* Add leim under the installation dir, if it exists. */
3437 tem
= Fexpand_file_name (build_string ("leim"),
3438 Vinstallation_directory
);
3439 tem1
= Ffile_exists_p (tem
);
3442 if (NILP (Fmember (tem
, Vload_path
)))
3443 Vload_path
= Fcons (tem
, Vload_path
);
3446 /* Add site-list under the installation dir, if it exists. */
3447 tem
= Fexpand_file_name (build_string ("site-lisp"),
3448 Vinstallation_directory
);
3449 tem1
= Ffile_exists_p (tem
);
3452 if (NILP (Fmember (tem
, Vload_path
)))
3453 Vload_path
= Fcons (tem
, Vload_path
);
3456 /* If Emacs was not built in the source directory,
3457 and it is run from where it was built, add to load-path
3458 the lisp, leim and site-lisp dirs under that directory. */
3460 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3464 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3465 Vinstallation_directory
);
3466 tem1
= Ffile_exists_p (tem
);
3468 /* Don't be fooled if they moved the entire source tree
3469 AFTER dumping Emacs. If the build directory is indeed
3470 different from the source dir, src/Makefile.in and
3471 src/Makefile will not be found together. */
3472 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3473 Vinstallation_directory
);
3474 tem2
= Ffile_exists_p (tem
);
3475 if (!NILP (tem1
) && NILP (tem2
))
3477 tem
= Fexpand_file_name (build_string ("lisp"),
3480 if (NILP (Fmember (tem
, Vload_path
)))
3481 Vload_path
= Fcons (tem
, Vload_path
);
3483 tem
= Fexpand_file_name (build_string ("leim"),
3486 if (NILP (Fmember (tem
, Vload_path
)))
3487 Vload_path
= Fcons (tem
, Vload_path
);
3489 tem
= Fexpand_file_name (build_string ("site-lisp"),
3492 if (NILP (Fmember (tem
, Vload_path
)))
3493 Vload_path
= Fcons (tem
, Vload_path
);
3496 if (!NILP (sitelisp
))
3497 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3503 /* NORMAL refers to the lisp dir in the source directory. */
3504 /* We used to add ../lisp at the front here, but
3505 that caused trouble because it was copied from dump_path
3506 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3507 It should be unnecessary. */
3508 Vload_path
= decode_env_path (0, normal
);
3509 dump_path
= Vload_path
;
3514 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3515 almost never correct, thereby causing a warning to be printed out that
3516 confuses users. Since PATH_LOADSEARCH is always overridden by the
3517 EMACSLOADPATH environment variable below, disable the warning on NT. */
3519 /* Warn if dirs in the *standard* path don't exist. */
3520 if (!turn_off_warning
)
3522 Lisp_Object path_tail
;
3524 for (path_tail
= Vload_path
;
3526 path_tail
= XCDR (path_tail
))
3528 Lisp_Object dirfile
;
3529 dirfile
= Fcar (path_tail
);
3530 if (STRINGP (dirfile
))
3532 dirfile
= Fdirectory_file_name (dirfile
);
3533 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3534 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3539 #endif /* WINDOWSNT */
3541 /* If the EMACSLOADPATH environment variable is set, use its value.
3542 This doesn't apply if we're dumping. */
3544 if (NILP (Vpurify_flag
)
3545 && egetenv ("EMACSLOADPATH"))
3547 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3551 load_in_progress
= 0;
3552 Vload_file_name
= Qnil
;
3554 load_descriptor_list
= Qnil
;
3556 Vstandard_input
= Qt
;
3557 Vloads_in_progress
= Qnil
;
3560 /* Print a warning, using format string FORMAT, that directory DIRNAME
3561 does not exist. Print it on stderr and put it in *Message*. */
3564 dir_warning (format
, dirname
)
3566 Lisp_Object dirname
;
3569 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3571 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3572 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3573 /* Don't log the warning before we've initialized!! */
3575 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3582 defsubr (&Sread_from_string
);
3584 defsubr (&Sintern_soft
);
3585 defsubr (&Sunintern
);
3587 defsubr (&Seval_buffer
);
3588 defsubr (&Seval_region
);
3589 defsubr (&Sread_char
);
3590 defsubr (&Sread_char_exclusive
);
3591 defsubr (&Sread_event
);
3592 defsubr (&Sget_file_char
);
3593 defsubr (&Smapatoms
);
3595 DEFVAR_LISP ("obarray", &Vobarray
,
3596 doc
: /* Symbol table for use by `intern' and `read'.
3597 It is a vector whose length ought to be prime for best results.
3598 The vector's contents don't make sense if examined from Lisp programs;
3599 to find all the symbols in an obarray, use `mapatoms'. */);
3601 DEFVAR_LISP ("values", &Vvalues
,
3602 doc
: /* List of values of all expressions which were read, evaluated and printed.
3603 Order is reverse chronological. */);
3605 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3606 doc
: /* Stream for read to get input from.
3607 See documentation of `read' for possible values. */);
3608 Vstandard_input
= Qt
;
3610 DEFVAR_LISP ("load-path", &Vload_path
,
3611 doc
: /* *List of directories to search for files to load.
3612 Each element is a string (directory name) or nil (try default directory).
3613 Initialized based on EMACSLOADPATH environment variable, if any,
3614 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3616 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3617 doc
: /* *List of suffixes to try for files to load.
3618 This list should not include the empty string. */);
3619 Vload_suffixes
= Fcons (build_string (".elc"),
3620 Fcons (build_string (".el"), Qnil
));
3621 /* We don't use empty_string because it's not initialized yet. */
3622 default_suffixes
= Fcons (build_string (""), Qnil
);
3623 staticpro (&default_suffixes
);
3625 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3626 doc
: /* Non-nil iff inside of `load'. */);
3628 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3629 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3630 Each element looks like (FILENAME FORMS...).
3631 When `load' is run and the file-name argument is FILENAME,
3632 the FORMS in the corresponding element are executed at the end of loading.
3634 FILENAME must match exactly! Normally FILENAME is the name of a library,
3635 with no directory specified, since that is how `load' is normally called.
3636 An error in FORMS does not undo the load,
3637 but does prevent execution of the rest of the FORMS.
3638 FILENAME can also be a symbol (a feature) and FORMS are then executed
3639 when the corresponding call to `provide' is made. */);
3640 Vafter_load_alist
= Qnil
;
3642 DEFVAR_LISP ("load-history", &Vload_history
,
3643 doc
: /* Alist mapping source file names to symbols and features.
3644 Each alist element is a list that starts with a file name,
3645 except for one element (optional) that starts with nil and describes
3646 definitions evaluated from buffers not visiting files.
3647 The remaining elements of each list are symbols defined as functions
3648 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3649 and `(autoload . SYMBOL)'. */);
3650 Vload_history
= Qnil
;
3652 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3653 doc
: /* Full name of file being loaded by `load'. */);
3654 Vload_file_name
= Qnil
;
3656 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3657 doc
: /* File name, including directory, of user's initialization file.
3658 If the file loaded had extension `.elc' and there was a corresponding `.el'
3659 file, this variable contains the name of the .el file, suitable for use
3660 by functions like `custom-save-all' which edit the init file. */);
3661 Vuser_init_file
= Qnil
;
3663 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3664 doc
: /* Used for internal purposes by `load'. */);
3665 Vcurrent_load_list
= Qnil
;
3667 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3668 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3669 The default is nil, which means use the function `read'. */);
3670 Vload_read_function
= Qnil
;
3672 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3673 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3674 This function is for doing code conversion before reading the source file.
3675 If nil, loading is done without any code conversion.
3676 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3677 FULLNAME is the full name of FILE.
3678 See `load' for the meaning of the remaining arguments. */);
3679 Vload_source_file_function
= Qnil
;
3681 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3682 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3683 This is useful when the file being loaded is a temporary copy. */);
3684 load_force_doc_strings
= 0;
3686 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3687 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3688 This is normally bound by `load' and `eval-buffer' to control `read',
3689 and is not meant for users to change. */);
3690 load_convert_to_unibyte
= 0;
3692 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3693 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3694 You cannot count on them to still be there! */);
3696 = Fexpand_file_name (build_string ("../"),
3697 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3699 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3700 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3701 Vpreloaded_file_list
= Qnil
;
3703 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3704 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3705 Vbyte_boolean_vars
= Qnil
;
3707 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3708 doc
: /* Non-nil means load dangerous compiled Lisp files.
3709 Some versions of XEmacs use different byte codes than Emacs. These
3710 incompatible byte codes can make Emacs crash when it tries to execute
3712 load_dangerous_libraries
= 0;
3714 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3715 doc
: /* Regular expression matching safe to load compiled Lisp files.
3716 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3717 from the file, and matches them against this regular expression.
3718 When the regular expression matches, the file is considered to be safe
3719 to load. See also `load-dangerous-libraries'. */);
3720 Vbytecomp_version_regexp
3721 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3723 /* Vsource_directory was initialized in init_lread. */
3725 load_descriptor_list
= Qnil
;
3726 staticpro (&load_descriptor_list
);
3728 Qcurrent_load_list
= intern ("current-load-list");
3729 staticpro (&Qcurrent_load_list
);
3731 Qstandard_input
= intern ("standard-input");
3732 staticpro (&Qstandard_input
);
3734 Qread_char
= intern ("read-char");
3735 staticpro (&Qread_char
);
3737 Qget_file_char
= intern ("get-file-char");
3738 staticpro (&Qget_file_char
);
3740 Qbackquote
= intern ("`");
3741 staticpro (&Qbackquote
);
3742 Qcomma
= intern (",");
3743 staticpro (&Qcomma
);
3744 Qcomma_at
= intern (",@");
3745 staticpro (&Qcomma_at
);
3746 Qcomma_dot
= intern (",.");
3747 staticpro (&Qcomma_dot
);
3749 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3750 staticpro (&Qinhibit_file_name_operation
);
3752 Qascii_character
= intern ("ascii-character");
3753 staticpro (&Qascii_character
);
3755 Qfunction
= intern ("function");
3756 staticpro (&Qfunction
);
3758 Qload
= intern ("load");
3761 Qload_file_name
= intern ("load-file-name");
3762 staticpro (&Qload_file_name
);
3764 staticpro (&dump_path
);
3766 staticpro (&read_objects
);
3767 read_objects
= Qnil
;
3768 staticpro (&seen_list
);
3770 Vloads_in_progress
= Qnil
;
3771 staticpro (&Vloads_in_progress
);