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"
36 #include "termhooks.h"
39 #include <sys/inode.h>
44 #include <unistd.h> /* to get X_OK */
61 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
79 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
80 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
81 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
82 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
83 Lisp_Object Qinhibit_file_name_operation
;
85 extern Lisp_Object Qevent_symbol_element_mask
;
86 extern Lisp_Object Qfile_exists_p
;
88 /* non-zero if inside `load' */
91 /* Directory in which the sources were found. */
92 Lisp_Object Vsource_directory
;
94 /* Search path and suffixes for files to be loaded. */
95 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
97 /* File name of user's init file. */
98 Lisp_Object Vuser_init_file
;
100 /* This is the user-visible association list that maps features to
101 lists of defs in their load files. */
102 Lisp_Object Vload_history
;
104 /* This is used to build the load history. */
105 Lisp_Object Vcurrent_load_list
;
107 /* List of files that were preloaded. */
108 Lisp_Object Vpreloaded_file_list
;
110 /* Name of file actually being read by `load'. */
111 Lisp_Object Vload_file_name
;
113 /* Function to use for reading, in `load' and friends. */
114 Lisp_Object Vload_read_function
;
116 /* The association list of objects read with the #n=object form.
117 Each member of the list has the form (n . object), and is used to
118 look up the object for the corresponding #n# construct.
119 It must be set to nil before all top-level calls to read0. */
120 Lisp_Object read_objects
;
122 /* Nonzero means load should forcibly load all dynamic doc strings. */
123 static int load_force_doc_strings
;
125 /* Nonzero means read should convert strings to unibyte. */
126 static int load_convert_to_unibyte
;
128 /* Function to use for loading an Emacs lisp source file (not
129 compiled) instead of readevalloop. */
130 Lisp_Object Vload_source_file_function
;
132 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
133 Lisp_Object Vbyte_boolean_vars
;
135 /* List of descriptors now open for Fload. */
136 static Lisp_Object load_descriptor_list
;
138 /* File for get_file_char to read from. Use by load. */
139 static FILE *instream
;
141 /* When nonzero, read conses in pure space */
142 static int read_pure
;
144 /* For use within read-from-string (this reader is non-reentrant!!) */
145 static int read_from_string_index
;
146 static int read_from_string_index_byte
;
147 static int read_from_string_limit
;
149 /* Number of bytes left to read in the buffer character
150 that `readchar' has already advanced over. */
151 static int readchar_backlog
;
153 /* This contains the last string skipped with #@. */
154 static char *saved_doc_string
;
155 /* Length of buffer allocated in saved_doc_string. */
156 static int saved_doc_string_size
;
157 /* Length of actual data in saved_doc_string. */
158 static int saved_doc_string_length
;
159 /* This is the file position that string came from. */
160 static file_offset saved_doc_string_position
;
162 /* This contains the previous string skipped with #@.
163 We copy it from saved_doc_string when a new string
164 is put in saved_doc_string. */
165 static char *prev_saved_doc_string
;
166 /* Length of buffer allocated in prev_saved_doc_string. */
167 static int prev_saved_doc_string_size
;
168 /* Length of actual data in prev_saved_doc_string. */
169 static int prev_saved_doc_string_length
;
170 /* This is the file position that string came from. */
171 static file_offset prev_saved_doc_string_position
;
173 /* Nonzero means inside a new-style backquote
174 with no surrounding parentheses.
175 Fread initializes this to zero, so we need not specbind it
176 or worry about what happens to it when there is an error. */
177 static int new_backquote_flag
;
179 /* A list of file names for files being loaded in Fload. Used to
180 check for recursive loads. */
182 static Lisp_Object Vloads_in_progress
;
184 /* Non-zero means load dangerous compiled Lisp files. */
186 int load_dangerous_libraries
;
188 /* A regular expression used to detect files compiled with Emacs. */
190 static Lisp_Object Vbytecomp_version_regexp
;
192 static void to_multibyte
P_ ((char **, char **, int *));
193 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
194 Lisp_Object (*) (), int,
195 Lisp_Object
, Lisp_Object
));
196 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
197 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
200 /* Handle unreading and rereading of characters.
201 Write READCHAR to read a character,
202 UNREAD(c) to unread c to be read again.
204 These macros actually read/unread a byte code, multibyte characters
205 are not handled here. The caller should manage them if necessary.
208 #define READCHAR readchar (readcharfun)
209 #define UNREAD(c) unreadchar (readcharfun, c)
212 readchar (readcharfun
)
213 Lisp_Object readcharfun
;
218 if (BUFFERP (readcharfun
))
220 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
222 int pt_byte
= BUF_PT_BYTE (inbuffer
);
223 int orig_pt_byte
= pt_byte
;
225 if (readchar_backlog
> 0)
226 /* We get the address of the byte just passed,
227 which is the last byte of the character.
228 The other bytes in this character are consecutive with it,
229 because the gap can't be in the middle of a character. */
230 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
231 - --readchar_backlog
);
233 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
236 readchar_backlog
= -1;
238 if (! NILP (inbuffer
->enable_multibyte_characters
))
240 /* Fetch the character code from the buffer. */
241 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
242 BUF_INC_POS (inbuffer
, pt_byte
);
243 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
247 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
250 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
254 if (MARKERP (readcharfun
))
256 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
258 int bytepos
= marker_byte_position (readcharfun
);
259 int orig_bytepos
= bytepos
;
261 if (readchar_backlog
> 0)
262 /* We get the address of the byte just passed,
263 which is the last byte of the character.
264 The other bytes in this character are consecutive with it,
265 because the gap can't be in the middle of a character. */
266 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
267 - --readchar_backlog
);
269 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
272 readchar_backlog
= -1;
274 if (! NILP (inbuffer
->enable_multibyte_characters
))
276 /* Fetch the character code from the buffer. */
277 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
278 BUF_INC_POS (inbuffer
, bytepos
);
279 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
283 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
287 XMARKER (readcharfun
)->bytepos
= bytepos
;
288 XMARKER (readcharfun
)->charpos
++;
293 if (EQ (readcharfun
, Qlambda
))
294 return read_bytecode_char (0);
296 if (EQ (readcharfun
, Qget_file_char
))
300 /* Interrupted reads have been observed while reading over the network */
301 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
310 if (STRINGP (readcharfun
))
312 if (read_from_string_index
>= read_from_string_limit
)
315 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
316 read_from_string_index
,
317 read_from_string_index_byte
);
322 tem
= call0 (readcharfun
);
329 /* Unread the character C in the way appropriate for the stream READCHARFUN.
330 If the stream is a user function, call it with the char as argument. */
333 unreadchar (readcharfun
, c
)
334 Lisp_Object readcharfun
;
338 /* Don't back up the pointer if we're unreading the end-of-input mark,
339 since readchar didn't advance it when we read it. */
341 else if (BUFFERP (readcharfun
))
343 struct buffer
*b
= XBUFFER (readcharfun
);
344 int bytepos
= BUF_PT_BYTE (b
);
346 if (readchar_backlog
>= 0)
351 if (! NILP (b
->enable_multibyte_characters
))
352 BUF_DEC_POS (b
, bytepos
);
356 BUF_PT_BYTE (b
) = bytepos
;
359 else if (MARKERP (readcharfun
))
361 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
362 int bytepos
= XMARKER (readcharfun
)->bytepos
;
364 if (readchar_backlog
>= 0)
368 XMARKER (readcharfun
)->charpos
--;
369 if (! NILP (b
->enable_multibyte_characters
))
370 BUF_DEC_POS (b
, bytepos
);
374 XMARKER (readcharfun
)->bytepos
= bytepos
;
377 else if (STRINGP (readcharfun
))
379 read_from_string_index
--;
380 read_from_string_index_byte
381 = string_char_to_byte (readcharfun
, read_from_string_index
);
383 else if (EQ (readcharfun
, Qlambda
))
384 read_bytecode_char (1);
385 else if (EQ (readcharfun
, Qget_file_char
))
386 ungetc (c
, instream
);
388 call1 (readcharfun
, make_number (c
));
391 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
392 static int read_multibyte ();
393 static Lisp_Object
substitute_object_recurse ();
394 static void substitute_object_in_subtree (), substitute_in_interval ();
397 /* Get a character from the tty. */
399 extern Lisp_Object
read_char ();
401 /* Read input events until we get one that's acceptable for our purposes.
403 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
404 until we get a character we like, and then stuffed into
407 If ASCII_REQUIRED is non-zero, we check function key events to see
408 if the unmodified version of the symbol has a Qascii_character
409 property, and use that character, if present.
411 If ERROR_NONASCII is non-zero, we signal an error if the input we
412 get isn't an ASCII character with modifiers. If it's zero but
413 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
416 If INPUT_METHOD is nonzero, we invoke the current input method
417 if the character warrants that. */
420 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
422 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
424 register Lisp_Object val
, delayed_switch_frame
;
426 #ifdef HAVE_WINDOW_SYSTEM
427 if (display_hourglass_p
)
431 delayed_switch_frame
= Qnil
;
433 /* Read until we get an acceptable event. */
435 val
= read_char (0, 0, 0,
436 (input_method
? Qnil
: Qt
),
442 /* switch-frame events are put off until after the next ASCII
443 character. This is better than signaling an error just because
444 the last characters were typed to a separate minibuffer frame,
445 for example. Eventually, some code which can deal with
446 switch-frame events will read it and process it. */
448 && EVENT_HAS_PARAMETERS (val
)
449 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
451 delayed_switch_frame
= val
;
457 /* Convert certain symbols to their ASCII equivalents. */
460 Lisp_Object tem
, tem1
;
461 tem
= Fget (val
, Qevent_symbol_element_mask
);
464 tem1
= Fget (Fcar (tem
), Qascii_character
);
465 /* Merge this symbol's modifier bits
466 with the ASCII equivalent of its basic code. */
468 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
472 /* If we don't have a character now, deal with it appropriately. */
477 Vunread_command_events
= Fcons (val
, Qnil
);
478 error ("Non-character input-event");
485 if (! NILP (delayed_switch_frame
))
486 unread_switch_frame
= delayed_switch_frame
;
488 #ifdef HAVE_WINDOW_SYSTEM
489 if (display_hourglass_p
)
495 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
496 doc
: /* Read a character from the command input (keyboard or macro).
497 It is returned as a number.
498 If the user generates an event which is not a character (i.e. a mouse
499 click or function key event), `read-char' signals an error. As an
500 exception, switch-frame events are put off until non-ASCII events can
502 If you want to read non-character events, or ignore them, call
503 `read-event' or `read-char-exclusive' instead.
505 If the optional argument PROMPT is non-nil, display that as a prompt.
506 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
507 input method is turned on in the current buffer, that input method
508 is used for reading a character. */)
509 (prompt
, inherit_input_method
)
510 Lisp_Object prompt
, inherit_input_method
;
513 message_with_string ("%s", prompt
, 0);
514 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
517 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
518 doc
: /* Read an event object from the input stream.
519 If the optional argument PROMPT is non-nil, display that as a prompt.
520 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
521 input method is turned on in the current buffer, that input method
522 is used for reading a character. */)
523 (prompt
, inherit_input_method
)
524 Lisp_Object prompt
, inherit_input_method
;
527 message_with_string ("%s", prompt
, 0);
528 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
531 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
532 doc
: /* Read a character from the command input (keyboard or macro).
533 It is returned as a number. Non-character events are ignored.
535 If the optional argument PROMPT is non-nil, display that as a prompt.
536 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
537 input method is turned on in the current buffer, that input method
538 is used for reading a character. */)
539 (prompt
, inherit_input_method
)
540 Lisp_Object prompt
, inherit_input_method
;
543 message_with_string ("%s", prompt
, 0);
544 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
547 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
548 doc
: /* Don't use this yourself. */)
551 register Lisp_Object val
;
552 XSETINT (val
, getc (instream
));
558 /* Value is non-zero if the file asswociated with file descriptor FD
559 is a compiled Lisp file that's safe to load. Only files compiled
560 with Emacs are safe to load. Files compiled with XEmacs can lead
561 to a crash in Fbyte_code because of an incompatible change in the
572 /* Read the first few bytes from the file, and look for a line
573 specifying the byte compiler version used. */
574 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
579 /* Skip to the next newline, skipping over the initial `ELC'
580 with NUL bytes following it. */
581 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
585 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
590 lseek (fd
, 0, SEEK_SET
);
595 /* Callback for record_unwind_protect. Restore the old load list OLD,
596 after loading a file successfully. */
599 record_load_unwind (old
)
602 return Vloads_in_progress
= old
;
606 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
607 doc
: /* Execute a file of Lisp code named FILE.
608 First try FILE with `.elc' appended, then try with `.el',
609 then try FILE unmodified. Environment variable references in FILE
610 are replaced with their values by calling `substitute-in-file-name'.
611 This function searches the directories in `load-path'.
612 If optional second arg NOERROR is non-nil,
613 report no error if FILE doesn't exist.
614 Print messages at start and end of loading unless
615 optional third arg NOMESSAGE is non-nil.
616 If optional fourth arg NOSUFFIX is non-nil, don't try adding
617 suffixes `.elc' or `.el' to the specified name FILE.
618 If optional fifth arg MUST-SUFFIX is non-nil, insist on
619 the suffix `.elc' or `.el'; don't accept just FILE unless
620 it ends in one of those suffixes or includes a directory name.
621 Return t if file exists. */)
622 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
623 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
625 register FILE *stream
;
626 register int fd
= -1;
627 register Lisp_Object lispstream
;
628 int count
= specpdl_ptr
- specpdl
;
632 /* 1 means we printed the ".el is newer" message. */
634 /* 1 means we are loading a compiled file. */
645 /* If file name is magic, call the handler. */
646 /* This shouldn't be necessary any more now that `openp' handles it right.
647 handler = Ffind_file_name_handler (file, Qload);
649 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
651 /* Do this after the handler to avoid
652 the need to gcpro noerror, nomessage and nosuffix.
653 (Below here, we care only whether they are nil or not.)
654 The presence of this call is the result of a historical accident:
655 it used to be in every file-operations and when it got removed
656 everywhere, it accidentally stayed here. Since then, enough people
657 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
658 that it seemed risky to remove. */
659 file
= Fsubstitute_in_file_name (file
);
661 /* Avoid weird lossage with null string as arg,
662 since it would try to load a directory as a Lisp file */
663 if (XSTRING (file
)->size
> 0)
665 int size
= STRING_BYTES (XSTRING (file
));
670 if (! NILP (must_suffix
))
672 /* Don't insist on adding a suffix if FILE already ends with one. */
674 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
677 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
679 /* Don't insist on adding a suffix
680 if the argument includes a directory name. */
681 else if (! NILP (Ffile_name_directory (file
)))
685 fd
= openp (Vload_path
, file
,
686 (!NILP (nosuffix
) ? Qnil
687 : !NILP (must_suffix
) ? Vload_suffixes
688 : Fappend (2, (tmp
[0] = Vload_suffixes
,
689 tmp
[1] = default_suffixes
,
699 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
700 Fcons (file
, Qnil
)));
705 /* Tell startup.el whether or not we found the user's init file. */
706 if (EQ (Qt
, Vuser_init_file
))
707 Vuser_init_file
= found
;
709 /* If FD is -2, that means openp found a magic file. */
712 if (NILP (Fequal (found
, file
)))
713 /* If FOUND is a different file name from FILE,
714 find its handler even if we have already inhibited
715 the `load' operation on FILE. */
716 handler
= Ffind_file_name_handler (found
, Qt
);
718 handler
= Ffind_file_name_handler (found
, Qload
);
719 if (! NILP (handler
))
720 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
723 /* Check if we're stuck in a recursive load cycle.
725 2000-09-21: It's not possible to just check for the file loaded
726 being a member of Vloads_in_progress. This fails because of the
727 way the byte compiler currently works; `provide's are not
728 evaluted, see font-lock.el/jit-lock.el as an example. This
729 leads to a certain amount of ``normal'' recursion.
731 Also, just loading a file recursively is not always an error in
732 the general case; the second load may do something different. */
736 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
737 if (!NILP (Fequal (found
, XCAR (tem
))))
740 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
741 Fcons (found
, Vloads_in_progress
)));
742 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
743 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
746 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
748 /* Load .elc files directly, but not when they are
749 remote and have no handler! */
756 if (!safe_to_load_p (fd
))
759 if (!load_dangerous_libraries
)
760 error ("File `%s' was not compiled in Emacs",
761 XSTRING (found
)->data
);
762 else if (!NILP (nomessage
))
763 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
771 stat ((char *)XSTRING (found
)->data
, &s1
);
772 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
773 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
774 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
776 /* Make the progress messages mention that source is newer. */
779 /* If we won't print another message, mention this anyway. */
780 if (! NILP (nomessage
))
781 message_with_string ("Source file `%s' newer than byte-compiled file",
784 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
789 /* We are loading a source file (*.el). */
790 if (!NILP (Vload_source_file_function
))
796 val
= call4 (Vload_source_file_function
, found
, file
,
797 NILP (noerror
) ? Qnil
: Qt
,
798 NILP (nomessage
) ? Qnil
: Qt
);
799 return unbind_to (count
, val
);
805 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
806 #else /* not WINDOWSNT */
807 stream
= fdopen (fd
, fmode
);
808 #endif /* not WINDOWSNT */
812 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
815 if (! NILP (Vpurify_flag
))
816 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
818 if (NILP (nomessage
))
821 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
824 message_with_string ("Loading %s (source)...", file
, 1);
826 message_with_string ("Loading %s (compiled; note, source file is newer)...",
828 else /* The typical case; compiled file newer than source file. */
829 message_with_string ("Loading %s...", file
, 1);
833 lispstream
= Fcons (Qnil
, Qnil
);
834 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
835 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
836 record_unwind_protect (load_unwind
, lispstream
);
837 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
838 specbind (Qload_file_name
, found
);
839 specbind (Qinhibit_file_name_operation
, Qnil
);
841 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
843 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
844 unbind_to (count
, Qnil
);
846 /* Run any load-hooks for this file. */
847 temp
= Fassoc (file
, Vafter_load_alist
);
849 Fprogn (Fcdr (temp
));
852 if (saved_doc_string
)
853 free (saved_doc_string
);
854 saved_doc_string
= 0;
855 saved_doc_string_size
= 0;
857 if (prev_saved_doc_string
)
858 xfree (prev_saved_doc_string
);
859 prev_saved_doc_string
= 0;
860 prev_saved_doc_string_size
= 0;
862 if (!noninteractive
&& NILP (nomessage
))
865 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
868 message_with_string ("Loading %s (source)...done", file
, 1);
870 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
872 else /* The typical case; compiled file newer than source file. */
873 message_with_string ("Loading %s...done", file
, 1);
880 load_unwind (stream
) /* used as unwind-protect function in load */
883 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
884 | XFASTINT (XCDR (stream
))));
885 if (--load_in_progress
< 0) load_in_progress
= 0;
890 load_descriptor_unwind (oldlist
)
893 load_descriptor_list
= oldlist
;
897 /* Close all descriptors in use for Floads.
898 This is used when starting a subprocess. */
905 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
906 emacs_close (XFASTINT (XCAR (tail
)));
911 complete_filename_p (pathname
)
912 Lisp_Object pathname
;
914 register unsigned char *s
= XSTRING (pathname
)->data
;
915 return (IS_DIRECTORY_SEP (s
[0])
916 || (XSTRING (pathname
)->size
> 2
917 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
927 /* Search for a file whose name is STR, looking in directories
928 in the Lisp list PATH, and trying suffixes from SUFFIX.
929 On success, returns a file descriptor. On failure, returns -1.
931 SUFFIXES is a list of strings containing possible suffixes.
932 The empty suffix is automatically added iff the list is empty.
934 EXEC_ONLY nonzero means don't open the files,
935 just look for one that is executable. In this case,
936 returns 1 on success.
938 If STOREPTR is nonzero, it points to a slot where the name of
939 the file actually found should be stored as a Lisp string.
940 nil is stored there on failure.
942 If the file we find is remote, return -2
943 but store the found remote file name in *STOREPTR.
944 We do not check for remote files if EXEC_ONLY is nonzero. */
947 openp (path
, str
, suffixes
, storeptr
, exec_only
)
948 Lisp_Object path
, str
;
949 Lisp_Object suffixes
;
950 Lisp_Object
*storeptr
;
956 register char *fn
= buf
;
959 Lisp_Object filename
;
961 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
962 Lisp_Object string
, tail
;
963 int max_suffix_len
= 0;
965 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
967 CHECK_STRING_CAR (tail
);
968 max_suffix_len
= max (max_suffix_len
,
969 STRING_BYTES (XSTRING (XCAR (tail
))));
972 string
= filename
= Qnil
;
973 GCPRO5 (str
, string
, filename
, path
, suffixes
);
978 if (complete_filename_p (str
))
981 for (; CONSP (path
); path
= XCDR (path
))
983 filename
= Fexpand_file_name (str
, XCAR (path
));
984 if (!complete_filename_p (filename
))
985 /* If there are non-absolute elts in PATH (eg ".") */
986 /* Of course, this could conceivably lose if luser sets
987 default-directory to be something non-absolute... */
989 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
990 if (!complete_filename_p (filename
))
991 /* Give up on this path element! */
995 /* Calculate maximum size of any filename made from
996 this path element/specified file name and any possible suffix. */
997 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
998 if (fn_size
< want_size
)
999 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1001 /* Loop over suffixes. */
1002 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1003 CONSP (tail
); tail
= XCDR (tail
))
1005 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1006 Lisp_Object handler
;
1008 /* Concatenate path element/specified name with the suffix.
1009 If the directory starts with /:, remove that. */
1010 if (XSTRING (filename
)->size
> 2
1011 && XSTRING (filename
)->data
[0] == '/'
1012 && XSTRING (filename
)->data
[1] == ':')
1014 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1015 STRING_BYTES (XSTRING (filename
)) - 2);
1016 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1020 strncpy (fn
, XSTRING (filename
)->data
,
1021 STRING_BYTES (XSTRING (filename
)));
1022 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1025 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1026 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1028 /* Check that the file exists and is not a directory. */
1029 /* We used to only check for handlers on non-absolute file names:
1033 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1034 It's not clear why that was the case and it breaks things like
1035 (load "/bar.el") where the file is actually "/bar.el.gz". */
1036 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1037 if (!NILP (handler
) && !exec_only
)
1041 string
= build_string (fn
);
1042 exists
= !NILP (Ffile_readable_p (string
));
1043 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1048 /* We succeeded; return this descriptor and filename. */
1050 *storeptr
= build_string (fn
);
1057 int exists
= (stat (fn
, &st
) >= 0
1058 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1061 /* Check that we can access or open it. */
1063 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1065 fd
= emacs_open (fn
, O_RDONLY
, 0);
1069 /* We succeeded; return this descriptor and filename. */
1071 *storeptr
= build_string (fn
);
1087 /* Merge the list we've accumulated of globals from the current input source
1088 into the load_history variable. The details depend on whether
1089 the source has an associated file name or not. */
1092 build_load_history (stream
, source
)
1096 register Lisp_Object tail
, prev
, newelt
;
1097 register Lisp_Object tem
, tem2
;
1098 register int foundit
, loading
;
1100 loading
= stream
|| !NARROWED
;
1102 tail
= Vload_history
;
1105 while (!NILP (tail
))
1109 /* Find the feature's previous assoc list... */
1110 if (!NILP (Fequal (source
, Fcar (tem
))))
1114 /* If we're loading, remove it. */
1118 Vload_history
= Fcdr (tail
);
1120 Fsetcdr (prev
, Fcdr (tail
));
1123 /* Otherwise, cons on new symbols that are not already members. */
1126 tem2
= Vcurrent_load_list
;
1128 while (CONSP (tem2
))
1130 newelt
= Fcar (tem2
);
1132 if (NILP (Fmemq (newelt
, tem
)))
1133 Fsetcar (tail
, Fcons (Fcar (tem
),
1134 Fcons (newelt
, Fcdr (tem
))));
1147 /* If we're loading, cons the new assoc onto the front of load-history,
1148 the most-recently-loaded position. Also do this if we didn't find
1149 an existing member for the current source. */
1150 if (loading
|| !foundit
)
1151 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1156 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1164 readevalloop_1 (old
)
1167 load_convert_to_unibyte
= ! NILP (old
);
1171 /* Signal an `end-of-file' error, if possible with file name
1175 end_of_file_error ()
1179 if (STRINGP (Vload_file_name
))
1180 data
= Fcons (Vload_file_name
, Qnil
);
1184 Fsignal (Qend_of_file
, data
);
1187 /* UNIBYTE specifies how to set load_convert_to_unibyte
1188 for this invocation.
1189 READFUN, if non-nil, is used instead of `read'. */
1192 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1193 Lisp_Object readcharfun
;
1195 Lisp_Object sourcename
;
1196 Lisp_Object (*evalfun
) ();
1198 Lisp_Object unibyte
, readfun
;
1201 register Lisp_Object val
;
1202 int count
= specpdl_ptr
- specpdl
;
1203 struct gcpro gcpro1
;
1204 struct buffer
*b
= 0;
1205 int continue_reading_p
;
1207 if (BUFFERP (readcharfun
))
1208 b
= XBUFFER (readcharfun
);
1209 else if (MARKERP (readcharfun
))
1210 b
= XMARKER (readcharfun
)->buffer
;
1212 specbind (Qstandard_input
, readcharfun
);
1213 specbind (Qcurrent_load_list
, Qnil
);
1214 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1215 load_convert_to_unibyte
= !NILP (unibyte
);
1217 readchar_backlog
= -1;
1219 GCPRO1 (sourcename
);
1221 LOADHIST_ATTACH (sourcename
);
1223 continue_reading_p
= 1;
1224 while (continue_reading_p
)
1226 if (b
!= 0 && NILP (b
->name
))
1227 error ("Reading from killed buffer");
1233 while ((c
= READCHAR
) != '\n' && c
!= -1);
1238 /* Ignore whitespace here, so we can detect eof. */
1239 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1242 if (!NILP (Vpurify_flag
) && c
== '(')
1244 int count1
= specpdl_ptr
- specpdl
;
1245 record_unwind_protect (unreadpure
, Qnil
);
1246 val
= read_list (-1, readcharfun
);
1247 unbind_to (count1
, Qnil
);
1252 read_objects
= Qnil
;
1253 if (!NILP (readfun
))
1255 val
= call1 (readfun
, readcharfun
);
1257 /* If READCHARFUN has set point to ZV, we should
1258 stop reading, even if the form read sets point
1259 to a different value when evaluated. */
1260 if (BUFFERP (readcharfun
))
1262 struct buffer
*b
= XBUFFER (readcharfun
);
1263 if (BUF_PT (b
) == BUF_ZV (b
))
1264 continue_reading_p
= 0;
1267 else if (! NILP (Vload_read_function
))
1268 val
= call1 (Vload_read_function
, readcharfun
);
1270 val
= read0 (readcharfun
);
1273 val
= (*evalfun
) (val
);
1277 Vvalues
= Fcons (val
, Vvalues
);
1278 if (EQ (Vstandard_output
, Qt
))
1285 build_load_history (stream
, sourcename
);
1288 unbind_to (count
, Qnil
);
1291 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1292 doc
: /* Execute the current buffer as Lisp code.
1293 Programs can pass two arguments, BUFFER and PRINTFLAG.
1294 BUFFER is the buffer to evaluate (nil means use current buffer).
1295 PRINTFLAG controls printing of output:
1296 nil means discard it; anything else is stream for print.
1298 If the optional third argument FILENAME is non-nil,
1299 it specifies the file name to use for `load-history'.
1300 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1301 for this invocation.
1303 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1304 `print' and related functions should work normally even if PRINTFLAG is nil.
1306 This function preserves the position of point. */)
1307 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1308 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1310 int count
= specpdl_ptr
- specpdl
;
1311 Lisp_Object tem
, buf
;
1314 buf
= Fcurrent_buffer ();
1316 buf
= Fget_buffer (buffer
);
1318 error ("No such buffer");
1320 if (NILP (printflag
) && NILP (do_allow_print
))
1325 if (NILP (filename
))
1326 filename
= XBUFFER (buf
)->filename
;
1328 specbind (Qstandard_output
, tem
);
1329 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1330 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1331 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1332 unbind_to (count
, Qnil
);
1337 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1338 doc
: /* Execute the region as Lisp code.
1339 When called from programs, expects two arguments,
1340 giving starting and ending indices in the current buffer
1341 of the text to be executed.
1342 Programs can pass third argument PRINTFLAG which controls output:
1343 nil means discard it; anything else is stream for printing it.
1344 Also the fourth argument READ-FUNCTION, if non-nil, is used
1345 instead of `read' to read each expression. It gets one argument
1346 which is the input stream for reading characters.
1348 This function does not move point. */)
1349 (start
, end
, printflag
, read_function
)
1350 Lisp_Object start
, end
, printflag
, read_function
;
1352 int count
= specpdl_ptr
- specpdl
;
1353 Lisp_Object tem
, cbuf
;
1355 cbuf
= Fcurrent_buffer ();
1357 if (NILP (printflag
))
1361 specbind (Qstandard_output
, tem
);
1363 if (NILP (printflag
))
1364 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1365 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1367 /* This both uses start and checks its type. */
1369 Fnarrow_to_region (make_number (BEGV
), end
);
1370 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1371 !NILP (printflag
), Qnil
, read_function
);
1373 return unbind_to (count
, Qnil
);
1377 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1378 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1379 If STREAM is nil, use the value of `standard-input' (which see).
1380 STREAM or the value of `standard-input' may be:
1381 a buffer (read from point and advance it)
1382 a marker (read from where it points and advance it)
1383 a function (call it with no arguments for each character,
1384 call it with a char as argument to push a char back)
1385 a string (takes text from string, starting at the beginning)
1386 t (read text line using minibuffer and use it, or read from
1387 standard input in batch mode). */)
1391 extern Lisp_Object
Fread_minibuffer ();
1394 stream
= Vstandard_input
;
1395 if (EQ (stream
, Qt
))
1396 stream
= Qread_char
;
1398 readchar_backlog
= -1;
1399 new_backquote_flag
= 0;
1400 read_objects
= Qnil
;
1402 if (EQ (stream
, Qread_char
))
1403 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1405 if (STRINGP (stream
))
1406 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1408 return read0 (stream
);
1411 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1412 doc
: /* Read one Lisp expression which is represented as text by STRING.
1413 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1414 START and END optionally delimit a substring of STRING from which to read;
1415 they default to 0 and (length STRING) respectively. */)
1416 (string
, start
, end
)
1417 Lisp_Object string
, start
, end
;
1419 int startval
, endval
;
1422 CHECK_STRING (string
);
1425 endval
= XSTRING (string
)->size
;
1429 endval
= XINT (end
);
1430 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1431 args_out_of_range (string
, end
);
1438 CHECK_NUMBER (start
);
1439 startval
= XINT (start
);
1440 if (startval
< 0 || startval
> endval
)
1441 args_out_of_range (string
, start
);
1444 read_from_string_index
= startval
;
1445 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1446 read_from_string_limit
= endval
;
1448 new_backquote_flag
= 0;
1449 read_objects
= Qnil
;
1451 tem
= read0 (string
);
1452 return Fcons (tem
, make_number (read_from_string_index
));
1455 /* Use this for recursive reads, in contexts where internal tokens
1460 Lisp_Object readcharfun
;
1462 register Lisp_Object val
;
1465 val
= read1 (readcharfun
, &c
, 0);
1467 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1474 static int read_buffer_size
;
1475 static char *read_buffer
;
1477 /* Read multibyte form and return it as a character. C is a first
1478 byte of multibyte form, and rest of them are read from
1482 read_multibyte (c
, readcharfun
)
1484 Lisp_Object readcharfun
;
1486 /* We need the actual character code of this multibyte
1488 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1493 while ((c
= READCHAR
) >= 0xA0
1494 && len
< MAX_MULTIBYTE_LENGTH
)
1497 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1498 return STRING_CHAR (str
, len
);
1499 /* The byte sequence is not valid as multibyte. Unread all bytes
1500 but the first one, and return the first byte. */
1506 /* Read a \-escape sequence, assuming we already read the `\'. */
1509 read_escape (readcharfun
, stringp
)
1510 Lisp_Object readcharfun
;
1513 register int c
= READCHAR
;
1517 end_of_file_error ();
1547 error ("Invalid escape character syntax");
1550 c
= read_escape (readcharfun
, 0);
1551 return c
| meta_modifier
;
1556 error ("Invalid escape character syntax");
1559 c
= read_escape (readcharfun
, 0);
1560 return c
| shift_modifier
;
1565 error ("Invalid escape character syntax");
1568 c
= read_escape (readcharfun
, 0);
1569 return c
| hyper_modifier
;
1574 error ("Invalid escape character syntax");
1577 c
= read_escape (readcharfun
, 0);
1578 return c
| alt_modifier
;
1583 error ("Invalid escape character syntax");
1586 c
= read_escape (readcharfun
, 0);
1587 return c
| super_modifier
;
1592 error ("Invalid escape character syntax");
1596 c
= read_escape (readcharfun
, 0);
1597 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1598 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1599 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1600 return c
| ctrl_modifier
;
1601 /* ASCII control chars are made from letters (both cases),
1602 as well as the non-letters within 0100...0137. */
1603 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1604 return (c
& (037 | ~0177));
1605 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1606 return (c
& (037 | ~0177));
1608 return c
| ctrl_modifier
;
1618 /* An octal escape, as in ANSI C. */
1620 register int i
= c
- '0';
1621 register int count
= 0;
1624 if ((c
= READCHAR
) >= '0' && c
<= '7')
1639 /* A hex escape, as in ANSI C. */
1645 if (c
>= '0' && c
<= '9')
1650 else if ((c
>= 'a' && c
<= 'f')
1651 || (c
>= 'A' && c
<= 'F'))
1654 if (c
>= 'a' && c
<= 'f')
1669 if (BASE_LEADING_CODE_P (c
))
1670 c
= read_multibyte (c
, readcharfun
);
1676 /* Read an integer in radix RADIX using READCHARFUN to read
1677 characters. RADIX must be in the interval [2..36]; if it isn't, a
1678 read error is signaled . Value is the integer read. Signals an
1679 error if encountering invalid read syntax or if RADIX is out of
1683 read_integer (readcharfun
, radix
)
1684 Lisp_Object readcharfun
;
1687 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1688 EMACS_INT number
= 0;
1690 if (radix
< 2 || radix
> 36)
1694 number
= ndigits
= invalid_p
= 0;
1710 if (c
>= '0' && c
<= '9')
1712 else if (c
>= 'a' && c
<= 'z')
1713 digit
= c
- 'a' + 10;
1714 else if (c
>= 'A' && c
<= 'Z')
1715 digit
= c
- 'A' + 10;
1722 if (digit
< 0 || digit
>= radix
)
1725 number
= radix
* number
+ digit
;
1731 if (ndigits
== 0 || invalid_p
)
1734 sprintf (buf
, "integer, radix %d", radix
);
1735 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1738 return make_number (sign
* number
);
1742 /* Convert unibyte text in read_buffer to multibyte.
1744 Initially, *P is a pointer after the end of the unibyte text, and
1745 the pointer *END points after the end of read_buffer.
1747 If read_buffer doesn't have enough room to hold the result
1748 of the conversion, reallocate it and adjust *P and *END.
1750 At the end, make *P point after the result of the conversion, and
1751 return in *NCHARS the number of characters in the converted
1755 to_multibyte (p
, end
, nchars
)
1761 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1762 if (read_buffer_size
< 2 * nbytes
)
1764 int offset
= *p
- read_buffer
;
1765 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1766 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1767 *p
= read_buffer
+ offset
;
1768 *end
= read_buffer
+ read_buffer_size
;
1771 if (nbytes
!= *nchars
)
1772 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1773 *p
- read_buffer
, nchars
);
1775 *p
= read_buffer
+ nbytes
;
1779 /* If the next token is ')' or ']' or '.', we store that character
1780 in *PCH and the return value is not interesting. Else, we store
1781 zero in *PCH and we read and return one lisp object.
1783 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1786 read1 (readcharfun
, pch
, first_in_list
)
1787 register Lisp_Object readcharfun
;
1792 int uninterned_symbol
= 0;
1800 end_of_file_error ();
1805 return read_list (0, readcharfun
);
1808 return read_vector (readcharfun
, 0);
1825 tmp
= read_vector (readcharfun
, 0);
1826 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1827 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1828 error ("Invalid size char-table");
1829 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1830 XCHAR_TABLE (tmp
)->top
= Qt
;
1839 tmp
= read_vector (readcharfun
, 0);
1840 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1841 error ("Invalid size char-table");
1842 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1843 XCHAR_TABLE (tmp
)->top
= Qnil
;
1846 Fsignal (Qinvalid_read_syntax
,
1847 Fcons (make_string ("#^^", 3), Qnil
));
1849 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1854 length
= read1 (readcharfun
, pch
, first_in_list
);
1858 Lisp_Object tmp
, val
;
1859 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1863 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1864 if (size_in_chars
!= XSTRING (tmp
)->size
1865 /* We used to print 1 char too many
1866 when the number of bits was a multiple of 8.
1867 Accept such input in case it came from an old version. */
1868 && ! (XFASTINT (length
)
1869 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1870 Fsignal (Qinvalid_read_syntax
,
1871 Fcons (make_string ("#&...", 5), Qnil
));
1873 val
= Fmake_bool_vector (length
, Qnil
);
1874 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1876 /* Clear the extraneous bits in the last byte. */
1877 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1878 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1879 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1882 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1887 /* Accept compiled functions at read-time so that we don't have to
1888 build them using function calls. */
1890 tmp
= read_vector (readcharfun
, 1);
1891 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1892 XVECTOR (tmp
)->contents
);
1897 struct gcpro gcpro1
;
1900 /* Read the string itself. */
1901 tmp
= read1 (readcharfun
, &ch
, 0);
1902 if (ch
!= 0 || !STRINGP (tmp
))
1903 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1905 /* Read the intervals and their properties. */
1908 Lisp_Object beg
, end
, plist
;
1910 beg
= read1 (readcharfun
, &ch
, 0);
1915 end
= read1 (readcharfun
, &ch
, 0);
1917 plist
= read1 (readcharfun
, &ch
, 0);
1919 Fsignal (Qinvalid_read_syntax
,
1920 Fcons (build_string ("invalid string property list"),
1922 Fset_text_properties (beg
, end
, plist
, tmp
);
1928 /* #@NUMBER is used to skip NUMBER following characters.
1929 That's used in .elc files to skip over doc strings
1930 and function definitions. */
1935 /* Read a decimal integer. */
1936 while ((c
= READCHAR
) >= 0
1937 && c
>= '0' && c
<= '9')
1945 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1947 /* If we are supposed to force doc strings into core right now,
1948 record the last string that we skipped,
1949 and record where in the file it comes from. */
1951 /* But first exchange saved_doc_string
1952 with prev_saved_doc_string, so we save two strings. */
1954 char *temp
= saved_doc_string
;
1955 int temp_size
= saved_doc_string_size
;
1956 file_offset temp_pos
= saved_doc_string_position
;
1957 int temp_len
= saved_doc_string_length
;
1959 saved_doc_string
= prev_saved_doc_string
;
1960 saved_doc_string_size
= prev_saved_doc_string_size
;
1961 saved_doc_string_position
= prev_saved_doc_string_position
;
1962 saved_doc_string_length
= prev_saved_doc_string_length
;
1964 prev_saved_doc_string
= temp
;
1965 prev_saved_doc_string_size
= temp_size
;
1966 prev_saved_doc_string_position
= temp_pos
;
1967 prev_saved_doc_string_length
= temp_len
;
1970 if (saved_doc_string_size
== 0)
1972 saved_doc_string_size
= nskip
+ 100;
1973 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1975 if (nskip
> saved_doc_string_size
)
1977 saved_doc_string_size
= nskip
+ 100;
1978 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1979 saved_doc_string_size
);
1982 saved_doc_string_position
= file_tell (instream
);
1984 /* Copy that many characters into saved_doc_string. */
1985 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1986 saved_doc_string
[i
] = c
= READCHAR
;
1988 saved_doc_string_length
= i
;
1992 /* Skip that many characters. */
1993 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2000 return Vload_file_name
;
2002 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2003 /* #:foo is the uninterned symbol named foo. */
2006 uninterned_symbol
= 1;
2010 /* Reader forms that can reuse previously read objects. */
2011 if (c
>= '0' && c
<= '9')
2016 /* Read a non-negative integer. */
2017 while (c
>= '0' && c
<= '9')
2023 /* #n=object returns object, but associates it with n for #n#. */
2026 /* Make a placeholder for #n# to use temporarily */
2027 Lisp_Object placeholder
;
2030 placeholder
= Fcons(Qnil
, Qnil
);
2031 cell
= Fcons (make_number (n
), placeholder
);
2032 read_objects
= Fcons (cell
, read_objects
);
2034 /* Read the object itself. */
2035 tem
= read0 (readcharfun
);
2037 /* Now put it everywhere the placeholder was... */
2038 substitute_object_in_subtree (tem
, placeholder
);
2040 /* ...and #n# will use the real value from now on. */
2041 Fsetcdr (cell
, tem
);
2045 /* #n# returns a previously read object. */
2048 tem
= Fassq (make_number (n
), read_objects
);
2051 /* Fall through to error message. */
2053 else if (c
== 'r' || c
== 'R')
2054 return read_integer (readcharfun
, n
);
2056 /* Fall through to error message. */
2058 else if (c
== 'x' || c
== 'X')
2059 return read_integer (readcharfun
, 16);
2060 else if (c
== 'o' || c
== 'O')
2061 return read_integer (readcharfun
, 8);
2062 else if (c
== 'b' || c
== 'B')
2063 return read_integer (readcharfun
, 2);
2066 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2069 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2074 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2084 new_backquote_flag
++;
2085 value
= read0 (readcharfun
);
2086 new_backquote_flag
--;
2088 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2092 if (new_backquote_flag
)
2094 Lisp_Object comma_type
= Qnil
;
2099 comma_type
= Qcomma_at
;
2101 comma_type
= Qcomma_dot
;
2104 if (ch
>= 0) UNREAD (ch
);
2105 comma_type
= Qcomma
;
2108 new_backquote_flag
--;
2109 value
= read0 (readcharfun
);
2110 new_backquote_flag
++;
2111 return Fcons (comma_type
, Fcons (value
, Qnil
));
2120 end_of_file_error ();
2123 c
= read_escape (readcharfun
, 0);
2124 else if (BASE_LEADING_CODE_P (c
))
2125 c
= read_multibyte (c
, readcharfun
);
2127 return make_number (c
);
2132 char *p
= read_buffer
;
2133 char *end
= read_buffer
+ read_buffer_size
;
2135 /* Nonzero if we saw an escape sequence specifying
2136 a multibyte character. */
2137 int force_multibyte
= 0;
2138 /* Nonzero if we saw an escape sequence specifying
2139 a single-byte character. */
2140 int force_singlebyte
= 0;
2144 while ((c
= READCHAR
) >= 0
2147 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2149 int offset
= p
- read_buffer
;
2150 read_buffer
= (char *) xrealloc (read_buffer
,
2151 read_buffer_size
*= 2);
2152 p
= read_buffer
+ offset
;
2153 end
= read_buffer
+ read_buffer_size
;
2158 c
= read_escape (readcharfun
, 1);
2160 /* C is -1 if \ newline has just been seen */
2163 if (p
== read_buffer
)
2168 /* If an escape specifies a non-ASCII single-byte character,
2169 this must be a unibyte string. */
2170 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2171 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2172 force_singlebyte
= 1;
2175 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2177 /* Any modifiers for a multibyte character are invalid. */
2178 if (c
& CHAR_MODIFIER_MASK
)
2179 error ("Invalid modifier in string");
2180 p
+= CHAR_STRING (c
, p
);
2181 force_multibyte
= 1;
2185 /* Allow `\C- ' and `\C-?'. */
2186 if (c
== (CHAR_CTL
| ' '))
2188 else if (c
== (CHAR_CTL
| '?'))
2193 /* Shift modifier is valid only with [A-Za-z]. */
2194 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2196 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2197 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2201 /* Move the meta bit to the right place for a string. */
2202 c
= (c
& ~CHAR_META
) | 0x80;
2204 error ("Invalid modifier in string");
2209 end_of_file_error ();
2211 /* If purifying, and string starts with \ newline,
2212 return zero instead. This is for doc strings
2213 that we are really going to find in etc/DOC.nn.nn */
2214 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2215 return make_number (0);
2217 if (force_multibyte
)
2218 to_multibyte (&p
, &end
, &nchars
);
2219 else if (force_singlebyte
)
2220 nchars
= p
- read_buffer
;
2221 else if (load_convert_to_unibyte
)
2224 to_multibyte (&p
, &end
, &nchars
);
2225 if (p
- read_buffer
!= nchars
)
2227 string
= make_multibyte_string (read_buffer
, nchars
,
2229 return Fstring_make_unibyte (string
);
2232 else if (EQ (readcharfun
, Qget_file_char
)
2233 || EQ (readcharfun
, Qlambda
))
2235 /* Nowadays, reading directly from a file is used only for
2236 compiled Emacs Lisp files, and those always use the
2237 Emacs internal encoding. Meanwhile, Qlambda is used
2238 for reading dynamic byte code (compiled with
2239 byte-compile-dynamic = t). */
2240 to_multibyte (&p
, &end
, &nchars
);
2243 /* In all other cases, if we read these bytes as
2244 separate characters, treat them as separate characters now. */
2245 nchars
= p
- read_buffer
;
2248 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2250 || (p
- read_buffer
!= nchars
)));
2251 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2253 || (p
- read_buffer
!= nchars
)));
2258 int next_char
= READCHAR
;
2261 if (next_char
<= 040
2262 || index ("\"'`,(", next_char
))
2268 /* Otherwise, we fall through! Note that the atom-reading loop
2269 below will now loop at least once, assuring that we will not
2270 try to UNREAD two characters in a row. */
2274 if (c
<= 040) goto retry
;
2276 char *p
= read_buffer
;
2280 char *end
= read_buffer
+ read_buffer_size
;
2283 && !(c
== '\"' || c
== '\'' || c
== ';'
2284 || c
== '(' || c
== ')'
2285 || c
== '[' || c
== ']' || c
== '#'))
2287 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2289 int offset
= p
- read_buffer
;
2290 read_buffer
= (char *) xrealloc (read_buffer
,
2291 read_buffer_size
*= 2);
2292 p
= read_buffer
+ offset
;
2293 end
= read_buffer
+ read_buffer_size
;
2300 end_of_file_error ();
2304 if (! SINGLE_BYTE_CHAR_P (c
))
2305 p
+= CHAR_STRING (c
, p
);
2314 int offset
= p
- read_buffer
;
2315 read_buffer
= (char *) xrealloc (read_buffer
,
2316 read_buffer_size
*= 2);
2317 p
= read_buffer
+ offset
;
2318 end
= read_buffer
+ read_buffer_size
;
2325 if (!quoted
&& !uninterned_symbol
)
2328 register Lisp_Object val
;
2330 if (*p1
== '+' || *p1
== '-') p1
++;
2331 /* Is it an integer? */
2334 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2335 /* Integers can have trailing decimal points. */
2336 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2338 /* It is an integer. */
2342 if (sizeof (int) == sizeof (EMACS_INT
))
2343 XSETINT (val
, atoi (read_buffer
));
2344 else if (sizeof (long) == sizeof (EMACS_INT
))
2345 XSETINT (val
, atol (read_buffer
));
2351 if (isfloat_string (read_buffer
))
2353 /* Compute NaN and infinities using 0.0 in a variable,
2354 to cope with compilers that think they are smarter
2360 /* Negate the value ourselves. This treats 0, NaNs,
2361 and infinity properly on IEEE floating point hosts,
2362 and works around a common bug where atof ("-0.0")
2364 int negative
= read_buffer
[0] == '-';
2366 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2367 returns 1, is if the input ends in e+INF or e+NaN. */
2374 value
= zero
/ zero
;
2377 value
= atof (read_buffer
+ negative
);
2381 return make_float (negative
? - value
: value
);
2385 if (uninterned_symbol
)
2386 return make_symbol (read_buffer
);
2388 return intern (read_buffer
);
2394 /* List of nodes we've seen during substitute_object_in_subtree. */
2395 static Lisp_Object seen_list
;
2398 substitute_object_in_subtree (object
, placeholder
)
2400 Lisp_Object placeholder
;
2402 Lisp_Object check_object
;
2404 /* We haven't seen any objects when we start. */
2407 /* Make all the substitutions. */
2409 = substitute_object_recurse (object
, placeholder
, object
);
2411 /* Clear seen_list because we're done with it. */
2414 /* The returned object here is expected to always eq the
2416 if (!EQ (check_object
, object
))
2417 error ("Unexpected mutation error in reader");
2420 /* Feval doesn't get called from here, so no gc protection is needed. */
2421 #define SUBSTITUTE(get_val, set_val) \
2423 Lisp_Object old_value = get_val; \
2424 Lisp_Object true_value \
2425 = substitute_object_recurse (object, placeholder,\
2428 if (!EQ (old_value, true_value)) \
2435 substitute_object_recurse (object
, placeholder
, subtree
)
2437 Lisp_Object placeholder
;
2438 Lisp_Object subtree
;
2440 /* If we find the placeholder, return the target object. */
2441 if (EQ (placeholder
, subtree
))
2444 /* If we've been to this node before, don't explore it again. */
2445 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2448 /* If this node can be the entry point to a cycle, remember that
2449 we've seen it. It can only be such an entry point if it was made
2450 by #n=, which means that we can find it as a value in
2452 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2453 seen_list
= Fcons (subtree
, seen_list
);
2455 /* Recurse according to subtree's type.
2456 Every branch must return a Lisp_Object. */
2457 switch (XTYPE (subtree
))
2459 case Lisp_Vectorlike
:
2462 int length
= XINT (Flength(subtree
));
2463 for (i
= 0; i
< length
; i
++)
2465 Lisp_Object idx
= make_number (i
);
2466 SUBSTITUTE (Faref (subtree
, idx
),
2467 Faset (subtree
, idx
, true_value
));
2474 SUBSTITUTE (Fcar_safe (subtree
),
2475 Fsetcar (subtree
, true_value
));
2476 SUBSTITUTE (Fcdr_safe (subtree
),
2477 Fsetcdr (subtree
, true_value
));
2483 /* Check for text properties in each interval.
2484 substitute_in_interval contains part of the logic. */
2486 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2487 Lisp_Object arg
= Fcons (object
, placeholder
);
2489 traverse_intervals_noorder (root_interval
,
2490 &substitute_in_interval
, arg
);
2495 /* Other types don't recurse any further. */
2501 /* Helper function for substitute_object_recurse. */
2503 substitute_in_interval (interval
, arg
)
2507 Lisp_Object object
= Fcar (arg
);
2508 Lisp_Object placeholder
= Fcdr (arg
);
2510 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2529 if (*cp
== '+' || *cp
== '-')
2532 if (*cp
>= '0' && *cp
<= '9')
2535 while (*cp
>= '0' && *cp
<= '9')
2543 if (*cp
>= '0' && *cp
<= '9')
2546 while (*cp
>= '0' && *cp
<= '9')
2549 if (*cp
== 'e' || *cp
== 'E')
2553 if (*cp
== '+' || *cp
== '-')
2557 if (*cp
>= '0' && *cp
<= '9')
2560 while (*cp
>= '0' && *cp
<= '9')
2563 else if (cp
== start
)
2565 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2570 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2576 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2577 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2578 || state
== (DOT_CHAR
|TRAIL_INT
)
2579 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2580 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2581 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2586 read_vector (readcharfun
, bytecodeflag
)
2587 Lisp_Object readcharfun
;
2592 register Lisp_Object
*ptr
;
2593 register Lisp_Object tem
, item
, vector
;
2594 register struct Lisp_Cons
*otem
;
2597 tem
= read_list (1, readcharfun
);
2598 len
= Flength (tem
);
2599 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2601 size
= XVECTOR (vector
)->size
;
2602 ptr
= XVECTOR (vector
)->contents
;
2603 for (i
= 0; i
< size
; i
++)
2606 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2607 bytecode object, the docstring containing the bytecode and
2608 constants values must be treated as unibyte and passed to
2609 Fread, to get the actual bytecode string and constants vector. */
2610 if (bytecodeflag
&& load_force_doc_strings
)
2612 if (i
== COMPILED_BYTECODE
)
2614 if (!STRINGP (item
))
2615 error ("invalid byte code");
2617 /* Delay handling the bytecode slot until we know whether
2618 it is lazily-loaded (we can tell by whether the
2619 constants slot is nil). */
2620 ptr
[COMPILED_CONSTANTS
] = item
;
2623 else if (i
== COMPILED_CONSTANTS
)
2625 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2629 /* Coerce string to unibyte (like string-as-unibyte,
2630 but without generating extra garbage and
2631 guaranteeing no change in the contents). */
2632 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2633 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2635 item
= Fread (bytestr
);
2637 error ("invalid byte code");
2639 otem
= XCONS (item
);
2640 bytestr
= XCAR (item
);
2645 /* Now handle the bytecode slot. */
2646 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2649 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2657 /* FLAG = 1 means check for ] to terminate rather than ) and .
2658 FLAG = -1 means check for starting with defun
2659 and make structure pure. */
2662 read_list (flag
, readcharfun
)
2664 register Lisp_Object readcharfun
;
2666 /* -1 means check next element for defun,
2667 0 means don't check,
2668 1 means already checked and found defun. */
2669 int defunflag
= flag
< 0 ? -1 : 0;
2670 Lisp_Object val
, tail
;
2671 register Lisp_Object elt
, tem
;
2672 struct gcpro gcpro1
, gcpro2
;
2673 /* 0 is the normal case.
2674 1 means this list is a doc reference; replace it with the number 0.
2675 2 means this list is a doc reference; replace it with the doc string. */
2676 int doc_reference
= 0;
2678 /* Initialize this to 1 if we are reading a list. */
2679 int first_in_list
= flag
<= 0;
2688 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2693 /* While building, if the list starts with #$, treat it specially. */
2694 if (EQ (elt
, Vload_file_name
)
2696 && !NILP (Vpurify_flag
))
2698 if (NILP (Vdoc_file_name
))
2699 /* We have not yet called Snarf-documentation, so assume
2700 this file is described in the DOC-MM.NN file
2701 and Snarf-documentation will fill in the right value later.
2702 For now, replace the whole list with 0. */
2705 /* We have already called Snarf-documentation, so make a relative
2706 file name for this file, so it can be found properly
2707 in the installed Lisp directory.
2708 We don't use Fexpand_file_name because that would make
2709 the directory absolute now. */
2710 elt
= concat2 (build_string ("../lisp/"),
2711 Ffile_name_nondirectory (elt
));
2713 else if (EQ (elt
, Vload_file_name
)
2715 && load_force_doc_strings
)
2724 Fsignal (Qinvalid_read_syntax
,
2725 Fcons (make_string (") or . in a vector", 18), Qnil
));
2733 XSETCDR (tail
, read0 (readcharfun
));
2735 val
= read0 (readcharfun
);
2736 read1 (readcharfun
, &ch
, 0);
2740 if (doc_reference
== 1)
2741 return make_number (0);
2742 if (doc_reference
== 2)
2744 /* Get a doc string from the file we are loading.
2745 If it's in saved_doc_string, get it from there. */
2746 int pos
= XINT (XCDR (val
));
2747 /* Position is negative for user variables. */
2748 if (pos
< 0) pos
= -pos
;
2749 if (pos
>= saved_doc_string_position
2750 && pos
< (saved_doc_string_position
2751 + saved_doc_string_length
))
2753 int start
= pos
- saved_doc_string_position
;
2756 /* Process quoting with ^A,
2757 and find the end of the string,
2758 which is marked with ^_ (037). */
2759 for (from
= start
, to
= start
;
2760 saved_doc_string
[from
] != 037;)
2762 int c
= saved_doc_string
[from
++];
2765 c
= saved_doc_string
[from
++];
2767 saved_doc_string
[to
++] = c
;
2769 saved_doc_string
[to
++] = 0;
2771 saved_doc_string
[to
++] = 037;
2774 saved_doc_string
[to
++] = c
;
2777 return make_string (saved_doc_string
+ start
,
2780 /* Look in prev_saved_doc_string the same way. */
2781 else if (pos
>= prev_saved_doc_string_position
2782 && pos
< (prev_saved_doc_string_position
2783 + prev_saved_doc_string_length
))
2785 int start
= pos
- prev_saved_doc_string_position
;
2788 /* Process quoting with ^A,
2789 and find the end of the string,
2790 which is marked with ^_ (037). */
2791 for (from
= start
, to
= start
;
2792 prev_saved_doc_string
[from
] != 037;)
2794 int c
= prev_saved_doc_string
[from
++];
2797 c
= prev_saved_doc_string
[from
++];
2799 prev_saved_doc_string
[to
++] = c
;
2801 prev_saved_doc_string
[to
++] = 0;
2803 prev_saved_doc_string
[to
++] = 037;
2806 prev_saved_doc_string
[to
++] = c
;
2809 return make_string (prev_saved_doc_string
+ start
,
2813 return get_doc_string (val
, 0, 0);
2818 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2820 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2822 tem
= (read_pure
&& flag
<= 0
2823 ? pure_cons (elt
, Qnil
)
2824 : Fcons (elt
, Qnil
));
2826 XSETCDR (tail
, tem
);
2831 defunflag
= EQ (elt
, Qdefun
);
2832 else if (defunflag
> 0)
2837 Lisp_Object Vobarray
;
2838 Lisp_Object initial_obarray
;
2840 /* oblookup stores the bucket number here, for the sake of Funintern. */
2842 int oblookup_last_bucket_number
;
2844 static int hash_string ();
2845 Lisp_Object
oblookup ();
2847 /* Get an error if OBARRAY is not an obarray.
2848 If it is one, return it. */
2851 check_obarray (obarray
)
2852 Lisp_Object obarray
;
2854 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2856 /* If Vobarray is now invalid, force it to be valid. */
2857 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2859 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2864 /* Intern the C string STR: return a symbol with that name,
2865 interned in the current obarray. */
2872 int len
= strlen (str
);
2873 Lisp_Object obarray
;
2876 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2877 obarray
= check_obarray (obarray
);
2878 tem
= oblookup (obarray
, str
, len
, len
);
2881 return Fintern (make_string (str
, len
), obarray
);
2884 /* Create an uninterned symbol with name STR. */
2890 int len
= strlen (str
);
2892 return Fmake_symbol ((!NILP (Vpurify_flag
)
2893 ? make_pure_string (str
, len
, len
, 0)
2894 : make_string (str
, len
)));
2897 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2898 doc
: /* Return the canonical symbol whose name is STRING.
2899 If there is none, one is created by this function and returned.
2900 A second optional argument specifies the obarray to use;
2901 it defaults to the value of `obarray'. */)
2903 Lisp_Object string
, obarray
;
2905 register Lisp_Object tem
, sym
, *ptr
;
2907 if (NILP (obarray
)) obarray
= Vobarray
;
2908 obarray
= check_obarray (obarray
);
2910 CHECK_STRING (string
);
2912 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2913 XSTRING (string
)->size
,
2914 STRING_BYTES (XSTRING (string
)));
2915 if (!INTEGERP (tem
))
2918 if (!NILP (Vpurify_flag
))
2919 string
= Fpurecopy (string
);
2920 sym
= Fmake_symbol (string
);
2922 if (EQ (obarray
, initial_obarray
))
2923 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2925 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2927 if ((XSTRING (string
)->data
[0] == ':')
2928 && EQ (obarray
, initial_obarray
))
2930 XSYMBOL (sym
)->constant
= 1;
2931 XSYMBOL (sym
)->value
= sym
;
2934 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2936 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2938 XSYMBOL (sym
)->next
= 0;
2943 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2944 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
2945 NAME may be a string or a symbol. If it is a symbol, that exact
2946 symbol is searched for.
2947 A second optional argument specifies the obarray to use;
2948 it defaults to the value of `obarray'. */)
2950 Lisp_Object name
, obarray
;
2952 register Lisp_Object tem
;
2953 struct Lisp_String
*string
;
2955 if (NILP (obarray
)) obarray
= Vobarray
;
2956 obarray
= check_obarray (obarray
);
2958 if (!SYMBOLP (name
))
2960 CHECK_STRING (name
);
2961 string
= XSTRING (name
);
2964 string
= XSYMBOL (name
)->name
;
2966 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2967 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2973 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2974 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
2975 The value is t if a symbol was found and deleted, nil otherwise.
2976 NAME may be a string or a symbol. If it is a symbol, that symbol
2977 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
2978 OBARRAY defaults to the value of the variable `obarray'. */)
2980 Lisp_Object name
, obarray
;
2982 register Lisp_Object string
, tem
;
2985 if (NILP (obarray
)) obarray
= Vobarray
;
2986 obarray
= check_obarray (obarray
);
2989 XSETSTRING (string
, XSYMBOL (name
)->name
);
2992 CHECK_STRING (name
);
2996 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2997 XSTRING (string
)->size
,
2998 STRING_BYTES (XSTRING (string
)));
3001 /* If arg was a symbol, don't delete anything but that symbol itself. */
3002 if (SYMBOLP (name
) && !EQ (name
, tem
))
3005 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3006 XSYMBOL (tem
)->constant
= 0;
3007 XSYMBOL (tem
)->indirect_variable
= 0;
3009 hash
= oblookup_last_bucket_number
;
3011 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3013 if (XSYMBOL (tem
)->next
)
3014 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3016 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3020 Lisp_Object tail
, following
;
3022 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3023 XSYMBOL (tail
)->next
;
3026 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3027 if (EQ (following
, tem
))
3029 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3038 /* Return the symbol in OBARRAY whose names matches the string
3039 of SIZE characters (SIZE_BYTE bytes) at PTR.
3040 If there is no such symbol in OBARRAY, return nil.
3042 Also store the bucket number in oblookup_last_bucket_number. */
3045 oblookup (obarray
, ptr
, size
, size_byte
)
3046 Lisp_Object obarray
;
3048 int size
, size_byte
;
3052 register Lisp_Object tail
;
3053 Lisp_Object bucket
, tem
;
3055 if (!VECTORP (obarray
)
3056 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3058 obarray
= check_obarray (obarray
);
3059 obsize
= XVECTOR (obarray
)->size
;
3061 /* This is sometimes needed in the middle of GC. */
3062 obsize
&= ~ARRAY_MARK_FLAG
;
3063 /* Combining next two lines breaks VMS C 2.3. */
3064 hash
= hash_string (ptr
, size_byte
);
3066 bucket
= XVECTOR (obarray
)->contents
[hash
];
3067 oblookup_last_bucket_number
= hash
;
3068 if (XFASTINT (bucket
) == 0)
3070 else if (!SYMBOLP (bucket
))
3071 error ("Bad data in guts of obarray"); /* Like CADR error message */
3073 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3075 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3076 && XSYMBOL (tail
)->name
->size
== size
3077 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3079 else if (XSYMBOL (tail
)->next
== 0)
3082 XSETINT (tem
, hash
);
3087 hash_string (ptr
, len
)
3091 register unsigned char *p
= ptr
;
3092 register unsigned char *end
= p
+ len
;
3093 register unsigned char c
;
3094 register int hash
= 0;
3099 if (c
>= 0140) c
-= 40;
3100 hash
= ((hash
<<3) + (hash
>>28) + c
);
3102 return hash
& 07777777777;
3106 map_obarray (obarray
, fn
, arg
)
3107 Lisp_Object obarray
;
3108 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3112 register Lisp_Object tail
;
3113 CHECK_VECTOR (obarray
);
3114 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3116 tail
= XVECTOR (obarray
)->contents
[i
];
3121 if (XSYMBOL (tail
)->next
== 0)
3123 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3129 mapatoms_1 (sym
, function
)
3130 Lisp_Object sym
, function
;
3132 call1 (function
, sym
);
3135 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3136 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3137 OBARRAY defaults to the value of `obarray'. */)
3139 Lisp_Object function
, obarray
;
3141 if (NILP (obarray
)) obarray
= Vobarray
;
3142 obarray
= check_obarray (obarray
);
3144 map_obarray (obarray
, mapatoms_1
, function
);
3148 #define OBARRAY_SIZE 1511
3153 Lisp_Object oblength
;
3157 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3159 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3160 Vobarray
= Fmake_vector (oblength
, make_number (0));
3161 initial_obarray
= Vobarray
;
3162 staticpro (&initial_obarray
);
3163 /* Intern nil in the obarray */
3164 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3165 XSYMBOL (Qnil
)->constant
= 1;
3167 /* These locals are to kludge around a pyramid compiler bug. */
3168 hash
= hash_string ("nil", 3);
3169 /* Separate statement here to avoid VAXC bug. */
3170 hash
%= OBARRAY_SIZE
;
3171 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3174 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3175 XSYMBOL (Qnil
)->function
= Qunbound
;
3176 XSYMBOL (Qunbound
)->value
= Qunbound
;
3177 XSYMBOL (Qunbound
)->function
= Qunbound
;
3180 XSYMBOL (Qnil
)->value
= Qnil
;
3181 XSYMBOL (Qnil
)->plist
= Qnil
;
3182 XSYMBOL (Qt
)->value
= Qt
;
3183 XSYMBOL (Qt
)->constant
= 1;
3185 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3188 Qvariable_documentation
= intern ("variable-documentation");
3189 staticpro (&Qvariable_documentation
);
3191 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3192 read_buffer
= (char *) xmalloc (read_buffer_size
);
3197 struct Lisp_Subr
*sname
;
3200 sym
= intern (sname
->symbol_name
);
3201 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3204 #ifdef NOTDEF /* use fset in subr.el now */
3206 defalias (sname
, string
)
3207 struct Lisp_Subr
*sname
;
3211 sym
= intern (string
);
3212 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3216 /* Define an "integer variable"; a symbol whose value is forwarded
3217 to a C variable of type int. Sample call: */
3218 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3220 defvar_int (namestring
, address
)
3224 Lisp_Object sym
, val
;
3225 sym
= intern (namestring
);
3226 val
= allocate_misc ();
3227 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3228 XINTFWD (val
)->intvar
= address
;
3229 SET_SYMBOL_VALUE (sym
, val
);
3232 /* Similar but define a variable whose value is t if address contains 1,
3233 nil if address contains 0 */
3235 defvar_bool (namestring
, address
)
3239 Lisp_Object sym
, val
;
3240 sym
= intern (namestring
);
3241 val
= allocate_misc ();
3242 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3243 XBOOLFWD (val
)->boolvar
= address
;
3244 SET_SYMBOL_VALUE (sym
, val
);
3245 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3248 /* Similar but define a variable whose value is the Lisp Object stored
3249 at address. Two versions: with and without gc-marking of the C
3250 variable. The nopro version is used when that variable will be
3251 gc-marked for some other reason, since marking the same slot twice
3252 can cause trouble with strings. */
3254 defvar_lisp_nopro (namestring
, address
)
3256 Lisp_Object
*address
;
3258 Lisp_Object sym
, val
;
3259 sym
= intern (namestring
);
3260 val
= allocate_misc ();
3261 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3262 XOBJFWD (val
)->objvar
= address
;
3263 SET_SYMBOL_VALUE (sym
, val
);
3267 defvar_lisp (namestring
, address
)
3269 Lisp_Object
*address
;
3271 defvar_lisp_nopro (namestring
, address
);
3272 staticpro (address
);
3275 /* Similar but define a variable whose value is the Lisp Object stored in
3276 the current buffer. address is the address of the slot in the buffer
3277 that is current now. */
3280 defvar_per_buffer (namestring
, address
, type
, doc
)
3282 Lisp_Object
*address
;
3286 Lisp_Object sym
, val
;
3288 extern struct buffer buffer_local_symbols
;
3290 sym
= intern (namestring
);
3291 val
= allocate_misc ();
3292 offset
= (char *)address
- (char *)current_buffer
;
3294 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3295 XBUFFER_OBJFWD (val
)->offset
= offset
;
3296 SET_SYMBOL_VALUE (sym
, val
);
3297 PER_BUFFER_SYMBOL (offset
) = sym
;
3298 PER_BUFFER_TYPE (offset
) = type
;
3300 if (PER_BUFFER_IDX (offset
) == 0)
3301 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3302 slot of buffer_local_flags */
3307 /* Similar but define a variable whose value is the Lisp Object stored
3308 at a particular offset in the current kboard object. */
3311 defvar_kboard (namestring
, offset
)
3315 Lisp_Object sym
, val
;
3316 sym
= intern (namestring
);
3317 val
= allocate_misc ();
3318 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3319 XKBOARD_OBJFWD (val
)->offset
= offset
;
3320 SET_SYMBOL_VALUE (sym
, val
);
3323 /* Record the value of load-path used at the start of dumping
3324 so we can see if the site changed it later during dumping. */
3325 static Lisp_Object dump_path
;
3331 int turn_off_warning
= 0;
3333 /* Compute the default load-path. */
3335 normal
= PATH_LOADSEARCH
;
3336 Vload_path
= decode_env_path (0, normal
);
3338 if (NILP (Vpurify_flag
))
3339 normal
= PATH_LOADSEARCH
;
3341 normal
= PATH_DUMPLOADSEARCH
;
3343 /* In a dumped Emacs, we normally have to reset the value of
3344 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3345 uses ../lisp, instead of the path of the installed elisp
3346 libraries. However, if it appears that Vload_path was changed
3347 from the default before dumping, don't override that value. */
3350 if (! NILP (Fequal (dump_path
, Vload_path
)))
3352 Vload_path
= decode_env_path (0, normal
);
3353 if (!NILP (Vinstallation_directory
))
3355 /* Add to the path the lisp subdir of the
3356 installation dir, if it exists. */
3357 Lisp_Object tem
, tem1
;
3358 tem
= Fexpand_file_name (build_string ("lisp"),
3359 Vinstallation_directory
);
3360 tem1
= Ffile_exists_p (tem
);
3363 if (NILP (Fmember (tem
, Vload_path
)))
3365 turn_off_warning
= 1;
3366 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3370 /* That dir doesn't exist, so add the build-time
3371 Lisp dirs instead. */
3372 Vload_path
= nconc2 (Vload_path
, dump_path
);
3374 /* Add leim under the installation dir, if it exists. */
3375 tem
= Fexpand_file_name (build_string ("leim"),
3376 Vinstallation_directory
);
3377 tem1
= Ffile_exists_p (tem
);
3380 if (NILP (Fmember (tem
, Vload_path
)))
3381 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3384 /* Add site-list under the installation dir, if it exists. */
3385 tem
= Fexpand_file_name (build_string ("site-lisp"),
3386 Vinstallation_directory
);
3387 tem1
= Ffile_exists_p (tem
);
3390 if (NILP (Fmember (tem
, Vload_path
)))
3391 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3394 /* If Emacs was not built in the source directory,
3395 and it is run from where it was built, add to load-path
3396 the lisp, leim and site-lisp dirs under that directory. */
3398 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3402 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3403 Vinstallation_directory
);
3404 tem1
= Ffile_exists_p (tem
);
3406 /* Don't be fooled if they moved the entire source tree
3407 AFTER dumping Emacs. If the build directory is indeed
3408 different from the source dir, src/Makefile.in and
3409 src/Makefile will not be found together. */
3410 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3411 Vinstallation_directory
);
3412 tem2
= Ffile_exists_p (tem
);
3413 if (!NILP (tem1
) && NILP (tem2
))
3415 tem
= Fexpand_file_name (build_string ("lisp"),
3418 if (NILP (Fmember (tem
, Vload_path
)))
3419 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3421 tem
= Fexpand_file_name (build_string ("leim"),
3424 if (NILP (Fmember (tem
, Vload_path
)))
3425 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3427 tem
= Fexpand_file_name (build_string ("site-lisp"),
3430 if (NILP (Fmember (tem
, Vload_path
)))
3431 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3439 /* NORMAL refers to the lisp dir in the source directory. */
3440 /* We used to add ../lisp at the front here, but
3441 that caused trouble because it was copied from dump_path
3442 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3443 It should be unnecessary. */
3444 Vload_path
= decode_env_path (0, normal
);
3445 dump_path
= Vload_path
;
3450 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3451 almost never correct, thereby causing a warning to be printed out that
3452 confuses users. Since PATH_LOADSEARCH is always overridden by the
3453 EMACSLOADPATH environment variable below, disable the warning on NT. */
3455 /* Warn if dirs in the *standard* path don't exist. */
3456 if (!turn_off_warning
)
3458 Lisp_Object path_tail
;
3460 for (path_tail
= Vload_path
;
3462 path_tail
= XCDR (path_tail
))
3464 Lisp_Object dirfile
;
3465 dirfile
= Fcar (path_tail
);
3466 if (STRINGP (dirfile
))
3468 dirfile
= Fdirectory_file_name (dirfile
);
3469 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3470 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3475 #endif /* WINDOWSNT */
3477 /* If the EMACSLOADPATH environment variable is set, use its value.
3478 This doesn't apply if we're dumping. */
3480 if (NILP (Vpurify_flag
)
3481 && egetenv ("EMACSLOADPATH"))
3483 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3487 load_in_progress
= 0;
3488 Vload_file_name
= Qnil
;
3490 load_descriptor_list
= Qnil
;
3492 Vstandard_input
= Qt
;
3493 Vloads_in_progress
= Qnil
;
3496 /* Print a warning, using format string FORMAT, that directory DIRNAME
3497 does not exist. Print it on stderr and put it in *Message*. */
3500 dir_warning (format
, dirname
)
3502 Lisp_Object dirname
;
3505 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3507 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3508 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3509 /* Don't log the warning before we've initialized!! */
3511 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3518 defsubr (&Sread_from_string
);
3520 defsubr (&Sintern_soft
);
3521 defsubr (&Sunintern
);
3523 defsubr (&Seval_buffer
);
3524 defsubr (&Seval_region
);
3525 defsubr (&Sread_char
);
3526 defsubr (&Sread_char_exclusive
);
3527 defsubr (&Sread_event
);
3528 defsubr (&Sget_file_char
);
3529 defsubr (&Smapatoms
);
3531 DEFVAR_LISP ("obarray", &Vobarray
,
3532 doc
: /* Symbol table for use by `intern' and `read'.
3533 It is a vector whose length ought to be prime for best results.
3534 The vector's contents don't make sense if examined from Lisp programs;
3535 to find all the symbols in an obarray, use `mapatoms'. */);
3537 DEFVAR_LISP ("values", &Vvalues
,
3538 doc
: /* List of values of all expressions which were read, evaluated and printed.
3539 Order is reverse chronological. */);
3541 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3542 doc
: /* Stream for read to get input from.
3543 See documentation of `read' for possible values. */);
3544 Vstandard_input
= Qt
;
3546 DEFVAR_LISP ("load-path", &Vload_path
,
3547 doc
: /* *List of directories to search for files to load.
3548 Each element is a string (directory name) or nil (try default directory).
3549 Initialized based on EMACSLOADPATH environment variable, if any,
3550 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3552 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3553 doc
: /* *List of suffixes to try for files to load.
3554 This list should not include the empty string. */);
3555 Vload_suffixes
= Fcons (build_string (".elc"),
3556 Fcons (build_string (".el"), Qnil
));
3557 /* We don't use empty_string because it's not initialized yet. */
3558 default_suffixes
= Fcons (build_string (""), Qnil
);
3559 staticpro (&default_suffixes
);
3561 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3562 doc
: /* Non-nil iff inside of `load'. */);
3564 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3565 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3566 Each element looks like (FILENAME FORMS...).
3567 When `load' is run and the file-name argument is FILENAME,
3568 the FORMS in the corresponding element are executed at the end of loading.
3570 FILENAME must match exactly! Normally FILENAME is the name of a library,
3571 with no directory specified, since that is how `load' is normally called.
3572 An error in FORMS does not undo the load,
3573 but does prevent execution of the rest of the FORMS.
3574 FILENAME can also be a symbol (a feature) and FORMS are then executed
3575 when the corresponding call to `provide' is made. */);
3576 Vafter_load_alist
= Qnil
;
3578 DEFVAR_LISP ("load-history", &Vload_history
,
3579 doc
: /* Alist mapping source file names to symbols and features.
3580 Each alist element is a list that starts with a file name,
3581 except for one element (optional) that starts with nil and describes
3582 definitions evaluated from buffers not visiting files.
3583 The remaining elements of each list are symbols defined as functions
3584 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3585 and `(autoload . SYMBOL)'. */);
3586 Vload_history
= Qnil
;
3588 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3589 doc
: /* Full name of file being loaded by `load'. */);
3590 Vload_file_name
= Qnil
;
3592 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3593 doc
: /* File name, including directory, of user's initialization file.
3594 If the file loaded had extension `.elc' and there was a corresponding `.el'
3595 file, this variable contains the name of the .el file, suitable for use
3596 by functions like `custom-save-all' which edit the init file. */);
3597 Vuser_init_file
= Qnil
;
3599 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3600 doc
: /* Used for internal purposes by `load'. */);
3601 Vcurrent_load_list
= Qnil
;
3603 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3604 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3605 The default is nil, which means use the function `read'. */);
3606 Vload_read_function
= Qnil
;
3608 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3609 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3610 This function is for doing code conversion before reading the source file.
3611 If nil, loading is done without any code conversion.
3612 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3613 FULLNAME is the full name of FILE.
3614 See `load' for the meaning of the remaining arguments. */);
3615 Vload_source_file_function
= Qnil
;
3617 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3618 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3619 This is useful when the file being loaded is a temporary copy. */);
3620 load_force_doc_strings
= 0;
3622 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3623 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3624 This is normally bound by `load' and `eval-buffer' to control `read',
3625 and is not meant for users to change. */);
3626 load_convert_to_unibyte
= 0;
3628 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3629 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3630 You cannot count on them to still be there! */);
3632 = Fexpand_file_name (build_string ("../"),
3633 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3635 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3636 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3637 Vpreloaded_file_list
= Qnil
;
3639 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3640 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3641 Vbyte_boolean_vars
= Qnil
;
3643 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3644 doc
: /* Non-nil means load dangerous compiled Lisp files.
3645 Some versions of XEmacs use different byte codes than Emacs. These
3646 incompatible byte codes can make Emacs crash when it tries to execute
3648 load_dangerous_libraries
= 0;
3650 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3651 doc
: /* Regular expression matching safe to load compiled Lisp files.
3652 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3653 from the file, and matches them against this regular expression.
3654 When the regular expression matches, the file is considered to be safe
3655 to load. See also `load-dangerous-libraries'. */);
3656 Vbytecomp_version_regexp
3657 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3659 /* Vsource_directory was initialized in init_lread. */
3661 load_descriptor_list
= Qnil
;
3662 staticpro (&load_descriptor_list
);
3664 Qcurrent_load_list
= intern ("current-load-list");
3665 staticpro (&Qcurrent_load_list
);
3667 Qstandard_input
= intern ("standard-input");
3668 staticpro (&Qstandard_input
);
3670 Qread_char
= intern ("read-char");
3671 staticpro (&Qread_char
);
3673 Qget_file_char
= intern ("get-file-char");
3674 staticpro (&Qget_file_char
);
3676 Qbackquote
= intern ("`");
3677 staticpro (&Qbackquote
);
3678 Qcomma
= intern (",");
3679 staticpro (&Qcomma
);
3680 Qcomma_at
= intern (",@");
3681 staticpro (&Qcomma_at
);
3682 Qcomma_dot
= intern (",.");
3683 staticpro (&Qcomma_dot
);
3685 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3686 staticpro (&Qinhibit_file_name_operation
);
3688 Qascii_character
= intern ("ascii-character");
3689 staticpro (&Qascii_character
);
3691 Qfunction
= intern ("function");
3692 staticpro (&Qfunction
);
3694 Qload
= intern ("load");
3697 Qload_file_name
= intern ("load-file-name");
3698 staticpro (&Qload_file_name
);
3700 staticpro (&dump_path
);
3702 staticpro (&read_objects
);
3703 read_objects
= Qnil
;
3704 staticpro (&seen_list
);
3706 Vloads_in_progress
= Qnil
;
3707 staticpro (&Vloads_in_progress
);