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"
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
;
491 #ifdef HAVE_WINDOW_SYSTEM
492 if (display_hourglass_p
)
501 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
502 doc
: /* Read a character from the command input (keyboard or macro).
503 It is returned as a number.
504 If the user generates an event which is not a character (i.e. a mouse
505 click or function key event), `read-char' signals an error. As an
506 exception, switch-frame events are put off until non-ASCII events can
508 If you want to read non-character events, or ignore them, call
509 `read-event' or `read-char-exclusive' instead.
511 If the optional argument PROMPT is non-nil, display that as a prompt.
512 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
513 input method is turned on in the current buffer, that input method
514 is used for reading a character. */)
515 (prompt
, inherit_input_method
)
516 Lisp_Object prompt
, inherit_input_method
;
519 message_with_string ("%s", prompt
, 0);
520 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
523 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
524 doc
: /* Read an event object from the input stream.
525 If the optional argument PROMPT is non-nil, display that as a prompt.
526 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
527 input method is turned on in the current buffer, that input method
528 is used for reading a character. */)
529 (prompt
, inherit_input_method
)
530 Lisp_Object prompt
, inherit_input_method
;
533 message_with_string ("%s", prompt
, 0);
534 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
537 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
538 doc
: /* Read a character from the command input (keyboard or macro).
539 It is returned as a number. Non-character events are ignored.
541 If the optional argument PROMPT is non-nil, display that as a prompt.
542 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
543 input method is turned on in the current buffer, that input method
544 is used for reading a character. */)
545 (prompt
, inherit_input_method
)
546 Lisp_Object prompt
, inherit_input_method
;
549 message_with_string ("%s", prompt
, 0);
550 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
553 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
554 doc
: /* Don't use this yourself. */)
557 register Lisp_Object val
;
558 XSETINT (val
, getc (instream
));
564 /* Value is non-zero if the file asswociated with file descriptor FD
565 is a compiled Lisp file that's safe to load. Only files compiled
566 with Emacs are safe to load. Files compiled with XEmacs can lead
567 to a crash in Fbyte_code because of an incompatible change in the
578 /* Read the first few bytes from the file, and look for a line
579 specifying the byte compiler version used. */
580 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
585 /* Skip to the next newline, skipping over the initial `ELC'
586 with NUL bytes following it. */
587 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
591 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
596 lseek (fd
, 0, SEEK_SET
);
601 /* Callback for record_unwind_protect. Restore the old load list OLD,
602 after loading a file successfully. */
605 record_load_unwind (old
)
608 return Vloads_in_progress
= old
;
612 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
613 doc
: /* Execute a file of Lisp code named FILE.
614 First try FILE with `.elc' appended, then try with `.el',
615 then try FILE unmodified. Environment variable references in FILE
616 are replaced with their values by calling `substitute-in-file-name'.
617 This function searches the directories in `load-path'.
618 If optional second arg NOERROR is non-nil,
619 report no error if FILE doesn't exist.
620 Print messages at start and end of loading unless
621 optional third arg NOMESSAGE is non-nil.
622 If optional fourth arg NOSUFFIX is non-nil, don't try adding
623 suffixes `.elc' or `.el' to the specified name FILE.
624 If optional fifth arg MUST-SUFFIX is non-nil, insist on
625 the suffix `.elc' or `.el'; don't accept just FILE unless
626 it ends in one of those suffixes or includes a directory name.
627 Return t if file exists. */)
628 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
629 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
631 register FILE *stream
;
632 register int fd
= -1;
633 register Lisp_Object lispstream
;
634 int count
= specpdl_ptr
- specpdl
;
637 Lisp_Object found
, efound
;
638 /* 1 means we printed the ".el is newer" message. */
640 /* 1 means we are loading a compiled file. */
651 /* If file name is magic, call the handler. */
652 /* This shouldn't be necessary any more now that `openp' handles it right.
653 handler = Ffind_file_name_handler (file, Qload);
655 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
657 /* Do this after the handler to avoid
658 the need to gcpro noerror, nomessage and nosuffix.
659 (Below here, we care only whether they are nil or not.)
660 The presence of this call is the result of a historical accident:
661 it used to be in every file-operations and when it got removed
662 everywhere, it accidentally stayed here. Since then, enough people
663 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
664 that it seemed risky to remove. */
665 file
= Fsubstitute_in_file_name (file
);
667 /* Avoid weird lossage with null string as arg,
668 since it would try to load a directory as a Lisp file */
669 if (XSTRING (file
)->size
> 0)
671 int size
= STRING_BYTES (XSTRING (file
));
676 if (! NILP (must_suffix
))
678 /* Don't insist on adding a suffix if FILE already ends with one. */
680 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
683 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
685 /* Don't insist on adding a suffix
686 if the argument includes a directory name. */
687 else if (! NILP (Ffile_name_directory (file
)))
691 fd
= openp (Vload_path
, file
,
692 (!NILP (nosuffix
) ? Qnil
693 : !NILP (must_suffix
) ? Vload_suffixes
694 : Fappend (2, (tmp
[0] = Vload_suffixes
,
695 tmp
[1] = default_suffixes
,
705 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
706 Fcons (file
, Qnil
)));
711 /* Tell startup.el whether or not we found the user's init file. */
712 if (EQ (Qt
, Vuser_init_file
))
713 Vuser_init_file
= found
;
715 /* If FD is -2, that means openp found a magic file. */
718 if (NILP (Fequal (found
, file
)))
719 /* If FOUND is a different file name from FILE,
720 find its handler even if we have already inhibited
721 the `load' operation on FILE. */
722 handler
= Ffind_file_name_handler (found
, Qt
);
724 handler
= Ffind_file_name_handler (found
, Qload
);
725 if (! NILP (handler
))
726 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
729 /* Check if we're stuck in a recursive load cycle.
731 2000-09-21: It's not possible to just check for the file loaded
732 being a member of Vloads_in_progress. This fails because of the
733 way the byte compiler currently works; `provide's are not
734 evaluted, see font-lock.el/jit-lock.el as an example. This
735 leads to a certain amount of ``normal'' recursion.
737 Also, just loading a file recursively is not always an error in
738 the general case; the second load may do something different. */
742 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
743 if (!NILP (Fequal (found
, XCAR (tem
))))
746 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
747 Fcons (found
, Vloads_in_progress
)));
748 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
749 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
752 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
754 /* Load .elc files directly, but not when they are
755 remote and have no handler! */
762 if (!safe_to_load_p (fd
))
765 if (!load_dangerous_libraries
)
766 error ("File `%s' was not compiled in Emacs",
767 XSTRING (found
)->data
);
768 else if (!NILP (nomessage
))
769 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
775 efound
= ENCODE_FILE (found
);
780 stat ((char *)XSTRING (efound
)->data
, &s1
);
781 XSTRING (efound
)->data
[STRING_BYTES (XSTRING (efound
)) - 1] = 0;
782 result
= stat ((char *)XSTRING (efound
)->data
, &s2
);
783 XSTRING (efound
)->data
[STRING_BYTES (XSTRING (efound
)) - 1] = 'c';
786 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
788 /* Make the progress messages mention that source is newer. */
791 /* If we won't print another message, mention this anyway. */
792 if (!NILP (nomessage
))
795 file
= Fsubstring (found
, make_number (0), make_number (-1));
796 message_with_string ("Source file `%s' newer than byte-compiled file",
804 /* We are loading a source file (*.el). */
805 if (!NILP (Vload_source_file_function
))
811 val
= call4 (Vload_source_file_function
, found
, file
,
812 NILP (noerror
) ? Qnil
: Qt
,
813 NILP (nomessage
) ? Qnil
: Qt
);
814 return unbind_to (count
, val
);
821 efound
= ENCODE_FILE (found
);
822 stream
= fopen ((char *) XSTRING (efound
)->data
, fmode
);
824 #else /* not WINDOWSNT */
825 stream
= fdopen (fd
, fmode
);
826 #endif /* not WINDOWSNT */
830 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
833 if (! NILP (Vpurify_flag
))
834 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
836 if (NILP (nomessage
))
839 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
842 message_with_string ("Loading %s (source)...", file
, 1);
844 message_with_string ("Loading %s (compiled; note, source file is newer)...",
846 else /* The typical case; compiled file newer than source file. */
847 message_with_string ("Loading %s...", file
, 1);
851 lispstream
= Fcons (Qnil
, Qnil
);
852 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
853 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
854 record_unwind_protect (load_unwind
, lispstream
);
855 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
856 specbind (Qload_file_name
, found
);
857 specbind (Qinhibit_file_name_operation
, Qnil
);
859 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
861 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
862 unbind_to (count
, Qnil
);
864 /* Run any load-hooks for this file. */
865 temp
= Fassoc (file
, Vafter_load_alist
);
867 Fprogn (Fcdr (temp
));
870 if (saved_doc_string
)
871 free (saved_doc_string
);
872 saved_doc_string
= 0;
873 saved_doc_string_size
= 0;
875 if (prev_saved_doc_string
)
876 xfree (prev_saved_doc_string
);
877 prev_saved_doc_string
= 0;
878 prev_saved_doc_string_size
= 0;
880 if (!noninteractive
&& NILP (nomessage
))
883 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
886 message_with_string ("Loading %s (source)...done", file
, 1);
888 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
890 else /* The typical case; compiled file newer than source file. */
891 message_with_string ("Loading %s...done", file
, 1);
898 load_unwind (stream
) /* used as unwind-protect function in load */
901 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
902 | XFASTINT (XCDR (stream
))));
903 if (--load_in_progress
< 0) load_in_progress
= 0;
908 load_descriptor_unwind (oldlist
)
911 load_descriptor_list
= oldlist
;
915 /* Close all descriptors in use for Floads.
916 This is used when starting a subprocess. */
923 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
924 emacs_close (XFASTINT (XCAR (tail
)));
929 complete_filename_p (pathname
)
930 Lisp_Object pathname
;
932 register unsigned char *s
= XSTRING (pathname
)->data
;
933 return (IS_DIRECTORY_SEP (s
[0])
934 || (XSTRING (pathname
)->size
> 2
935 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
945 /* Search for a file whose name is STR, looking in directories
946 in the Lisp list PATH, and trying suffixes from SUFFIX.
947 On success, returns a file descriptor. On failure, returns -1.
949 SUFFIXES is a list of strings containing possible suffixes.
950 The empty suffix is automatically added iff the list is empty.
952 EXEC_ONLY nonzero means don't open the files,
953 just look for one that is executable. In this case,
954 returns 1 on success.
956 If STOREPTR is nonzero, it points to a slot where the name of
957 the file actually found should be stored as a Lisp string.
958 nil is stored there on failure.
960 If the file we find is remote, return -2
961 but store the found remote file name in *STOREPTR.
962 We do not check for remote files if EXEC_ONLY is nonzero. */
965 openp (path
, str
, suffixes
, storeptr
, exec_only
)
966 Lisp_Object path
, str
;
967 Lisp_Object suffixes
;
968 Lisp_Object
*storeptr
;
974 register char *fn
= buf
;
977 Lisp_Object filename
;
979 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
980 Lisp_Object string
, tail
, encoded_fn
;
981 int max_suffix_len
= 0;
983 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
985 CHECK_STRING_CAR (tail
);
986 max_suffix_len
= max (max_suffix_len
,
987 STRING_BYTES (XSTRING (XCAR (tail
))));
990 string
= filename
= Qnil
;
991 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
996 if (complete_filename_p (str
))
999 for (; CONSP (path
); path
= XCDR (path
))
1001 filename
= Fexpand_file_name (str
, XCAR (path
));
1002 if (!complete_filename_p (filename
))
1003 /* If there are non-absolute elts in PATH (eg ".") */
1004 /* Of course, this could conceivably lose if luser sets
1005 default-directory to be something non-absolute... */
1007 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1008 if (!complete_filename_p (filename
))
1009 /* Give up on this path element! */
1013 /* Calculate maximum size of any filename made from
1014 this path element/specified file name and any possible suffix. */
1015 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1016 if (fn_size
< want_size
)
1017 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1019 /* Loop over suffixes. */
1020 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1021 CONSP (tail
); tail
= XCDR (tail
))
1023 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1024 Lisp_Object handler
;
1027 /* Concatenate path element/specified name with the suffix.
1028 If the directory starts with /:, remove that. */
1029 if (XSTRING (filename
)->size
> 2
1030 && XSTRING (filename
)->data
[0] == '/'
1031 && XSTRING (filename
)->data
[1] == ':')
1033 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1034 STRING_BYTES (XSTRING (filename
)) - 2);
1035 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1039 strncpy (fn
, XSTRING (filename
)->data
,
1040 STRING_BYTES (XSTRING (filename
)));
1041 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1044 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1045 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1047 /* Check that the file exists and is not a directory. */
1048 /* We used to only check for handlers on non-absolute file names:
1052 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1053 It's not clear why that was the case and it breaks things like
1054 (load "/bar.el") where the file is actually "/bar.el.gz". */
1055 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1056 string
= build_string (fn
);
1057 if (!NILP (handler
) && !exec_only
)
1059 exists
= !NILP (Ffile_readable_p (string
));
1060 if (exists
&& !NILP (Ffile_directory_p (string
)))
1065 /* We succeeded; return this descriptor and filename. */
1076 encoded_fn
= ENCODE_FILE (string
);
1077 pfn
= XSTRING (encoded_fn
)->data
;
1078 exists
= (stat (pfn
, &st
) >= 0
1079 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1082 /* Check that we can access or open it. */
1084 fd
= (access (pfn
, X_OK
) == 0) ? 1 : -1;
1086 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1090 /* We succeeded; return this descriptor and filename. */
1108 /* Merge the list we've accumulated of globals from the current input source
1109 into the load_history variable. The details depend on whether
1110 the source has an associated file name or not. */
1113 build_load_history (stream
, source
)
1117 register Lisp_Object tail
, prev
, newelt
;
1118 register Lisp_Object tem
, tem2
;
1119 register int foundit
, loading
;
1121 loading
= stream
|| !NARROWED
;
1123 tail
= Vload_history
;
1126 while (!NILP (tail
))
1130 /* Find the feature's previous assoc list... */
1131 if (!NILP (Fequal (source
, Fcar (tem
))))
1135 /* If we're loading, remove it. */
1139 Vload_history
= Fcdr (tail
);
1141 Fsetcdr (prev
, Fcdr (tail
));
1144 /* Otherwise, cons on new symbols that are not already members. */
1147 tem2
= Vcurrent_load_list
;
1149 while (CONSP (tem2
))
1151 newelt
= Fcar (tem2
);
1153 if (NILP (Fmemq (newelt
, tem
)))
1154 Fsetcar (tail
, Fcons (Fcar (tem
),
1155 Fcons (newelt
, Fcdr (tem
))));
1168 /* If we're loading, cons the new assoc onto the front of load-history,
1169 the most-recently-loaded position. Also do this if we didn't find
1170 an existing member for the current source. */
1171 if (loading
|| !foundit
)
1172 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1177 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1185 readevalloop_1 (old
)
1188 load_convert_to_unibyte
= ! NILP (old
);
1192 /* Signal an `end-of-file' error, if possible with file name
1196 end_of_file_error ()
1200 if (STRINGP (Vload_file_name
))
1201 data
= Fcons (Vload_file_name
, Qnil
);
1205 Fsignal (Qend_of_file
, data
);
1208 /* UNIBYTE specifies how to set load_convert_to_unibyte
1209 for this invocation.
1210 READFUN, if non-nil, is used instead of `read'. */
1213 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1214 Lisp_Object readcharfun
;
1216 Lisp_Object sourcename
;
1217 Lisp_Object (*evalfun
) ();
1219 Lisp_Object unibyte
, readfun
;
1222 register Lisp_Object val
;
1223 int count
= specpdl_ptr
- specpdl
;
1224 struct gcpro gcpro1
;
1225 struct buffer
*b
= 0;
1226 int continue_reading_p
;
1228 if (BUFFERP (readcharfun
))
1229 b
= XBUFFER (readcharfun
);
1230 else if (MARKERP (readcharfun
))
1231 b
= XMARKER (readcharfun
)->buffer
;
1233 specbind (Qstandard_input
, readcharfun
);
1234 specbind (Qcurrent_load_list
, Qnil
);
1235 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1236 load_convert_to_unibyte
= !NILP (unibyte
);
1238 readchar_backlog
= -1;
1240 GCPRO1 (sourcename
);
1242 LOADHIST_ATTACH (sourcename
);
1244 continue_reading_p
= 1;
1245 while (continue_reading_p
)
1247 if (b
!= 0 && NILP (b
->name
))
1248 error ("Reading from killed buffer");
1254 while ((c
= READCHAR
) != '\n' && c
!= -1);
1259 /* Ignore whitespace here, so we can detect eof. */
1260 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1263 if (!NILP (Vpurify_flag
) && c
== '(')
1265 int count1
= specpdl_ptr
- specpdl
;
1266 record_unwind_protect (unreadpure
, Qnil
);
1267 val
= read_list (-1, readcharfun
);
1268 unbind_to (count1
, Qnil
);
1273 read_objects
= Qnil
;
1274 if (!NILP (readfun
))
1276 val
= call1 (readfun
, readcharfun
);
1278 /* If READCHARFUN has set point to ZV, we should
1279 stop reading, even if the form read sets point
1280 to a different value when evaluated. */
1281 if (BUFFERP (readcharfun
))
1283 struct buffer
*b
= XBUFFER (readcharfun
);
1284 if (BUF_PT (b
) == BUF_ZV (b
))
1285 continue_reading_p
= 0;
1288 else if (! NILP (Vload_read_function
))
1289 val
= call1 (Vload_read_function
, readcharfun
);
1291 val
= read0 (readcharfun
);
1294 val
= (*evalfun
) (val
);
1298 Vvalues
= Fcons (val
, Vvalues
);
1299 if (EQ (Vstandard_output
, Qt
))
1306 build_load_history (stream
, sourcename
);
1309 unbind_to (count
, Qnil
);
1312 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1313 doc
: /* Execute the current buffer as Lisp code.
1314 Programs can pass two arguments, BUFFER and PRINTFLAG.
1315 BUFFER is the buffer to evaluate (nil means use current buffer).
1316 PRINTFLAG controls printing of output:
1317 nil means discard it; anything else is stream for print.
1319 If the optional third argument FILENAME is non-nil,
1320 it specifies the file name to use for `load-history'.
1321 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1322 for this invocation.
1324 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1325 `print' and related functions should work normally even if PRINTFLAG is nil.
1327 This function preserves the position of point. */)
1328 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1329 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1331 int count
= specpdl_ptr
- specpdl
;
1332 Lisp_Object tem
, buf
;
1335 buf
= Fcurrent_buffer ();
1337 buf
= Fget_buffer (buffer
);
1339 error ("No such buffer");
1341 if (NILP (printflag
) && NILP (do_allow_print
))
1346 if (NILP (filename
))
1347 filename
= XBUFFER (buf
)->filename
;
1349 specbind (Qstandard_output
, tem
);
1350 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1351 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1352 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1353 unbind_to (count
, Qnil
);
1358 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1359 doc
: /* Execute the region as Lisp code.
1360 When called from programs, expects two arguments,
1361 giving starting and ending indices in the current buffer
1362 of the text to be executed.
1363 Programs can pass third argument PRINTFLAG which controls output:
1364 nil means discard it; anything else is stream for printing it.
1365 Also the fourth argument READ-FUNCTION, if non-nil, is used
1366 instead of `read' to read each expression. It gets one argument
1367 which is the input stream for reading characters.
1369 This function does not move point. */)
1370 (start
, end
, printflag
, read_function
)
1371 Lisp_Object start
, end
, printflag
, read_function
;
1373 int count
= specpdl_ptr
- specpdl
;
1374 Lisp_Object tem
, cbuf
;
1376 cbuf
= Fcurrent_buffer ();
1378 if (NILP (printflag
))
1382 specbind (Qstandard_output
, tem
);
1384 if (NILP (printflag
))
1385 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1386 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1388 /* This both uses start and checks its type. */
1390 Fnarrow_to_region (make_number (BEGV
), end
);
1391 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1392 !NILP (printflag
), Qnil
, read_function
);
1394 return unbind_to (count
, Qnil
);
1398 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1399 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1400 If STREAM is nil, use the value of `standard-input' (which see).
1401 STREAM or the value of `standard-input' may be:
1402 a buffer (read from point and advance it)
1403 a marker (read from where it points and advance it)
1404 a function (call it with no arguments for each character,
1405 call it with a char as argument to push a char back)
1406 a string (takes text from string, starting at the beginning)
1407 t (read text line using minibuffer and use it, or read from
1408 standard input in batch mode). */)
1412 extern Lisp_Object
Fread_minibuffer ();
1415 stream
= Vstandard_input
;
1416 if (EQ (stream
, Qt
))
1417 stream
= Qread_char
;
1419 readchar_backlog
= -1;
1420 new_backquote_flag
= 0;
1421 read_objects
= Qnil
;
1423 if (EQ (stream
, Qread_char
))
1424 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1426 if (STRINGP (stream
))
1427 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1429 return read0 (stream
);
1432 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1433 doc
: /* Read one Lisp expression which is represented as text by STRING.
1434 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1435 START and END optionally delimit a substring of STRING from which to read;
1436 they default to 0 and (length STRING) respectively. */)
1437 (string
, start
, end
)
1438 Lisp_Object string
, start
, end
;
1440 int startval
, endval
;
1443 CHECK_STRING (string
);
1446 endval
= XSTRING (string
)->size
;
1450 endval
= XINT (end
);
1451 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1452 args_out_of_range (string
, end
);
1459 CHECK_NUMBER (start
);
1460 startval
= XINT (start
);
1461 if (startval
< 0 || startval
> endval
)
1462 args_out_of_range (string
, start
);
1465 read_from_string_index
= startval
;
1466 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1467 read_from_string_limit
= endval
;
1469 new_backquote_flag
= 0;
1470 read_objects
= Qnil
;
1472 tem
= read0 (string
);
1473 return Fcons (tem
, make_number (read_from_string_index
));
1476 /* Use this for recursive reads, in contexts where internal tokens
1481 Lisp_Object readcharfun
;
1483 register Lisp_Object val
;
1486 val
= read1 (readcharfun
, &c
, 0);
1488 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1495 static int read_buffer_size
;
1496 static char *read_buffer
;
1498 /* Read multibyte form and return it as a character. C is a first
1499 byte of multibyte form, and rest of them are read from
1503 read_multibyte (c
, readcharfun
)
1505 Lisp_Object readcharfun
;
1507 /* We need the actual character code of this multibyte
1509 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1514 while ((c
= READCHAR
) >= 0xA0
1515 && len
< MAX_MULTIBYTE_LENGTH
)
1518 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1519 return STRING_CHAR (str
, len
);
1520 /* The byte sequence is not valid as multibyte. Unread all bytes
1521 but the first one, and return the first byte. */
1527 /* Read a \-escape sequence, assuming we already read the `\'.
1528 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1529 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1530 Otherwise store 0 into *BYTEREP. */
1533 read_escape (readcharfun
, stringp
, byterep
)
1534 Lisp_Object readcharfun
;
1538 register int c
= READCHAR
;
1545 end_of_file_error ();
1575 error ("Invalid escape character syntax");
1578 c
= read_escape (readcharfun
, 0, byterep
);
1579 return c
| meta_modifier
;
1584 error ("Invalid escape character syntax");
1587 c
= read_escape (readcharfun
, 0, byterep
);
1588 return c
| shift_modifier
;
1593 error ("Invalid escape character syntax");
1596 c
= read_escape (readcharfun
, 0, byterep
);
1597 return c
| hyper_modifier
;
1602 error ("Invalid escape character syntax");
1605 c
= read_escape (readcharfun
, 0, byterep
);
1606 return c
| alt_modifier
;
1611 error ("Invalid escape character syntax");
1614 c
= read_escape (readcharfun
, 0, byterep
);
1615 return c
| super_modifier
;
1620 error ("Invalid escape character syntax");
1624 c
= read_escape (readcharfun
, 0, byterep
);
1625 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1626 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1627 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1628 return c
| ctrl_modifier
;
1629 /* ASCII control chars are made from letters (both cases),
1630 as well as the non-letters within 0100...0137. */
1631 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1632 return (c
& (037 | ~0177));
1633 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1634 return (c
& (037 | ~0177));
1636 return c
| ctrl_modifier
;
1646 /* An octal escape, as in ANSI C. */
1648 register int i
= c
- '0';
1649 register int count
= 0;
1652 if ((c
= READCHAR
) >= '0' && c
<= '7')
1669 /* A hex escape, as in ANSI C. */
1675 if (c
>= '0' && c
<= '9')
1680 else if ((c
>= 'a' && c
<= 'f')
1681 || (c
>= 'A' && c
<= 'F'))
1684 if (c
>= 'a' && c
<= 'f')
1701 if (BASE_LEADING_CODE_P (c
))
1702 c
= read_multibyte (c
, readcharfun
);
1708 /* Read an integer in radix RADIX using READCHARFUN to read
1709 characters. RADIX must be in the interval [2..36]; if it isn't, a
1710 read error is signaled . Value is the integer read. Signals an
1711 error if encountering invalid read syntax or if RADIX is out of
1715 read_integer (readcharfun
, radix
)
1716 Lisp_Object readcharfun
;
1719 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1720 EMACS_INT number
= 0;
1722 if (radix
< 2 || radix
> 36)
1726 number
= ndigits
= invalid_p
= 0;
1742 if (c
>= '0' && c
<= '9')
1744 else if (c
>= 'a' && c
<= 'z')
1745 digit
= c
- 'a' + 10;
1746 else if (c
>= 'A' && c
<= 'Z')
1747 digit
= c
- 'A' + 10;
1754 if (digit
< 0 || digit
>= radix
)
1757 number
= radix
* number
+ digit
;
1763 if (ndigits
== 0 || invalid_p
)
1766 sprintf (buf
, "integer, radix %d", radix
);
1767 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1770 return make_number (sign
* number
);
1774 /* Convert unibyte text in read_buffer to multibyte.
1776 Initially, *P is a pointer after the end of the unibyte text, and
1777 the pointer *END points after the end of read_buffer.
1779 If read_buffer doesn't have enough room to hold the result
1780 of the conversion, reallocate it and adjust *P and *END.
1782 At the end, make *P point after the result of the conversion, and
1783 return in *NCHARS the number of characters in the converted
1787 to_multibyte (p
, end
, nchars
)
1793 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1794 if (read_buffer_size
< 2 * nbytes
)
1796 int offset
= *p
- read_buffer
;
1797 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1798 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1799 *p
= read_buffer
+ offset
;
1800 *end
= read_buffer
+ read_buffer_size
;
1803 if (nbytes
!= *nchars
)
1804 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1805 *p
- read_buffer
, nchars
);
1807 *p
= read_buffer
+ nbytes
;
1811 /* If the next token is ')' or ']' or '.', we store that character
1812 in *PCH and the return value is not interesting. Else, we store
1813 zero in *PCH and we read and return one lisp object.
1815 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1818 read1 (readcharfun
, pch
, first_in_list
)
1819 register Lisp_Object readcharfun
;
1824 int uninterned_symbol
= 0;
1832 end_of_file_error ();
1837 return read_list (0, readcharfun
);
1840 return read_vector (readcharfun
, 0);
1857 tmp
= read_vector (readcharfun
, 0);
1858 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1859 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1860 error ("Invalid size char-table");
1861 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1862 XCHAR_TABLE (tmp
)->top
= Qt
;
1871 tmp
= read_vector (readcharfun
, 0);
1872 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1873 error ("Invalid size char-table");
1874 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1875 XCHAR_TABLE (tmp
)->top
= Qnil
;
1878 Fsignal (Qinvalid_read_syntax
,
1879 Fcons (make_string ("#^^", 3), Qnil
));
1881 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1886 length
= read1 (readcharfun
, pch
, first_in_list
);
1890 Lisp_Object tmp
, val
;
1891 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1895 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1896 if (size_in_chars
!= XSTRING (tmp
)->size
1897 /* We used to print 1 char too many
1898 when the number of bits was a multiple of 8.
1899 Accept such input in case it came from an old version. */
1900 && ! (XFASTINT (length
)
1901 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1902 Fsignal (Qinvalid_read_syntax
,
1903 Fcons (make_string ("#&...", 5), Qnil
));
1905 val
= Fmake_bool_vector (length
, Qnil
);
1906 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1908 /* Clear the extraneous bits in the last byte. */
1909 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1910 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1911 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1914 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1919 /* Accept compiled functions at read-time so that we don't have to
1920 build them using function calls. */
1922 tmp
= read_vector (readcharfun
, 1);
1923 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1924 XVECTOR (tmp
)->contents
);
1929 struct gcpro gcpro1
;
1932 /* Read the string itself. */
1933 tmp
= read1 (readcharfun
, &ch
, 0);
1934 if (ch
!= 0 || !STRINGP (tmp
))
1935 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1937 /* Read the intervals and their properties. */
1940 Lisp_Object beg
, end
, plist
;
1942 beg
= read1 (readcharfun
, &ch
, 0);
1947 end
= read1 (readcharfun
, &ch
, 0);
1949 plist
= read1 (readcharfun
, &ch
, 0);
1951 Fsignal (Qinvalid_read_syntax
,
1952 Fcons (build_string ("invalid string property list"),
1954 Fset_text_properties (beg
, end
, plist
, tmp
);
1960 /* #@NUMBER is used to skip NUMBER following characters.
1961 That's used in .elc files to skip over doc strings
1962 and function definitions. */
1967 /* Read a decimal integer. */
1968 while ((c
= READCHAR
) >= 0
1969 && c
>= '0' && c
<= '9')
1977 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1979 /* If we are supposed to force doc strings into core right now,
1980 record the last string that we skipped,
1981 and record where in the file it comes from. */
1983 /* But first exchange saved_doc_string
1984 with prev_saved_doc_string, so we save two strings. */
1986 char *temp
= saved_doc_string
;
1987 int temp_size
= saved_doc_string_size
;
1988 file_offset temp_pos
= saved_doc_string_position
;
1989 int temp_len
= saved_doc_string_length
;
1991 saved_doc_string
= prev_saved_doc_string
;
1992 saved_doc_string_size
= prev_saved_doc_string_size
;
1993 saved_doc_string_position
= prev_saved_doc_string_position
;
1994 saved_doc_string_length
= prev_saved_doc_string_length
;
1996 prev_saved_doc_string
= temp
;
1997 prev_saved_doc_string_size
= temp_size
;
1998 prev_saved_doc_string_position
= temp_pos
;
1999 prev_saved_doc_string_length
= temp_len
;
2002 if (saved_doc_string_size
== 0)
2004 saved_doc_string_size
= nskip
+ 100;
2005 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2007 if (nskip
> saved_doc_string_size
)
2009 saved_doc_string_size
= nskip
+ 100;
2010 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2011 saved_doc_string_size
);
2014 saved_doc_string_position
= file_tell (instream
);
2016 /* Copy that many characters into saved_doc_string. */
2017 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2018 saved_doc_string
[i
] = c
= READCHAR
;
2020 saved_doc_string_length
= i
;
2024 /* Skip that many characters. */
2025 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2032 return Vload_file_name
;
2034 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2035 /* #:foo is the uninterned symbol named foo. */
2038 uninterned_symbol
= 1;
2042 /* Reader forms that can reuse previously read objects. */
2043 if (c
>= '0' && c
<= '9')
2048 /* Read a non-negative integer. */
2049 while (c
>= '0' && c
<= '9')
2055 /* #n=object returns object, but associates it with n for #n#. */
2058 /* Make a placeholder for #n# to use temporarily */
2059 Lisp_Object placeholder
;
2062 placeholder
= Fcons(Qnil
, Qnil
);
2063 cell
= Fcons (make_number (n
), placeholder
);
2064 read_objects
= Fcons (cell
, read_objects
);
2066 /* Read the object itself. */
2067 tem
= read0 (readcharfun
);
2069 /* Now put it everywhere the placeholder was... */
2070 substitute_object_in_subtree (tem
, placeholder
);
2072 /* ...and #n# will use the real value from now on. */
2073 Fsetcdr (cell
, tem
);
2077 /* #n# returns a previously read object. */
2080 tem
= Fassq (make_number (n
), read_objects
);
2083 /* Fall through to error message. */
2085 else if (c
== 'r' || c
== 'R')
2086 return read_integer (readcharfun
, n
);
2088 /* Fall through to error message. */
2090 else if (c
== 'x' || c
== 'X')
2091 return read_integer (readcharfun
, 16);
2092 else if (c
== 'o' || c
== 'O')
2093 return read_integer (readcharfun
, 8);
2094 else if (c
== 'b' || c
== 'B')
2095 return read_integer (readcharfun
, 2);
2098 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2101 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2106 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2116 new_backquote_flag
++;
2117 value
= read0 (readcharfun
);
2118 new_backquote_flag
--;
2120 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2124 if (new_backquote_flag
)
2126 Lisp_Object comma_type
= Qnil
;
2131 comma_type
= Qcomma_at
;
2133 comma_type
= Qcomma_dot
;
2136 if (ch
>= 0) UNREAD (ch
);
2137 comma_type
= Qcomma
;
2140 new_backquote_flag
--;
2141 value
= read0 (readcharfun
);
2142 new_backquote_flag
++;
2143 return Fcons (comma_type
, Fcons (value
, Qnil
));
2154 end_of_file_error ();
2157 c
= read_escape (readcharfun
, 0, &discard
);
2158 else if (BASE_LEADING_CODE_P (c
))
2159 c
= read_multibyte (c
, readcharfun
);
2161 return make_number (c
);
2166 char *p
= read_buffer
;
2167 char *end
= read_buffer
+ read_buffer_size
;
2169 /* 1 if we saw an escape sequence specifying
2170 a multibyte character, or a multibyte character. */
2171 int force_multibyte
= 0;
2172 /* 1 if we saw an escape sequence specifying
2173 a single-byte character. */
2174 int force_singlebyte
= 0;
2175 /* 1 if read_buffer contains multibyte text now. */
2176 int is_multibyte
= 0;
2180 while ((c
= READCHAR
) >= 0
2183 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2185 int offset
= p
- read_buffer
;
2186 read_buffer
= (char *) xrealloc (read_buffer
,
2187 read_buffer_size
*= 2);
2188 p
= read_buffer
+ offset
;
2189 end
= read_buffer
+ read_buffer_size
;
2196 c
= read_escape (readcharfun
, 1, &byterep
);
2198 /* C is -1 if \ newline has just been seen */
2201 if (p
== read_buffer
)
2207 force_singlebyte
= 1;
2208 else if (byterep
== 2)
2209 force_multibyte
= 1;
2212 /* A character that must be multibyte forces multibyte. */
2213 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2214 force_multibyte
= 1;
2216 /* If we just discovered the need to be multibyte,
2217 convert the text accumulated thus far. */
2218 if (force_multibyte
&& ! is_multibyte
)
2221 to_multibyte (&p
, &end
, &nchars
);
2224 /* Allow `\C- ' and `\C-?'. */
2225 if (c
== (CHAR_CTL
| ' '))
2227 else if (c
== (CHAR_CTL
| '?'))
2232 /* Shift modifier is valid only with [A-Za-z]. */
2233 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2235 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2236 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2240 /* Move the meta bit to the right place for a string. */
2241 c
= (c
& ~CHAR_META
) | 0x80;
2242 if (c
& CHAR_MODIFIER_MASK
)
2243 error ("Invalid modifier in string");
2246 p
+= CHAR_STRING (c
, p
);
2254 end_of_file_error ();
2256 /* If purifying, and string starts with \ newline,
2257 return zero instead. This is for doc strings
2258 that we are really going to find in etc/DOC.nn.nn */
2259 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2260 return make_number (0);
2262 if (is_multibyte
|| force_singlebyte
)
2264 else if (load_convert_to_unibyte
)
2267 to_multibyte (&p
, &end
, &nchars
);
2268 if (p
- read_buffer
!= nchars
)
2270 string
= make_multibyte_string (read_buffer
, nchars
,
2272 return Fstring_make_unibyte (string
);
2274 /* We can make a unibyte string directly. */
2277 else if (EQ (readcharfun
, Qget_file_char
)
2278 || EQ (readcharfun
, Qlambda
))
2280 /* Nowadays, reading directly from a file is used only for
2281 compiled Emacs Lisp files, and those always use the
2282 Emacs internal encoding. Meanwhile, Qlambda is used
2283 for reading dynamic byte code (compiled with
2284 byte-compile-dynamic = t). So make the string multibyte
2285 if the string contains any multibyte sequences.
2286 (to_multibyte is a no-op if not.) */
2287 to_multibyte (&p
, &end
, &nchars
);
2288 is_multibyte
= (p
- read_buffer
) != nchars
;
2291 /* In all other cases, if we read these bytes as
2292 separate characters, treat them as separate characters now. */
2296 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2298 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2304 int next_char
= READCHAR
;
2307 if (next_char
<= 040
2308 || index ("\"'`,(", next_char
))
2314 /* Otherwise, we fall through! Note that the atom-reading loop
2315 below will now loop at least once, assuring that we will not
2316 try to UNREAD two characters in a row. */
2320 if (c
<= 040) goto retry
;
2322 char *p
= read_buffer
;
2326 char *end
= read_buffer
+ read_buffer_size
;
2329 && !(c
== '\"' || c
== '\'' || c
== ';'
2330 || c
== '(' || c
== ')'
2331 || c
== '[' || c
== ']' || c
== '#'))
2333 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2335 int offset
= p
- read_buffer
;
2336 read_buffer
= (char *) xrealloc (read_buffer
,
2337 read_buffer_size
*= 2);
2338 p
= read_buffer
+ offset
;
2339 end
= read_buffer
+ read_buffer_size
;
2346 end_of_file_error ();
2350 if (! SINGLE_BYTE_CHAR_P (c
))
2351 p
+= CHAR_STRING (c
, p
);
2360 int offset
= p
- read_buffer
;
2361 read_buffer
= (char *) xrealloc (read_buffer
,
2362 read_buffer_size
*= 2);
2363 p
= read_buffer
+ offset
;
2364 end
= read_buffer
+ read_buffer_size
;
2371 if (!quoted
&& !uninterned_symbol
)
2374 register Lisp_Object val
;
2376 if (*p1
== '+' || *p1
== '-') p1
++;
2377 /* Is it an integer? */
2380 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2381 /* Integers can have trailing decimal points. */
2382 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2384 /* It is an integer. */
2388 if (sizeof (int) == sizeof (EMACS_INT
))
2389 XSETINT (val
, atoi (read_buffer
));
2390 else if (sizeof (long) == sizeof (EMACS_INT
))
2391 XSETINT (val
, atol (read_buffer
));
2397 if (isfloat_string (read_buffer
))
2399 /* Compute NaN and infinities using 0.0 in a variable,
2400 to cope with compilers that think they are smarter
2406 /* Negate the value ourselves. This treats 0, NaNs,
2407 and infinity properly on IEEE floating point hosts,
2408 and works around a common bug where atof ("-0.0")
2410 int negative
= read_buffer
[0] == '-';
2412 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2413 returns 1, is if the input ends in e+INF or e+NaN. */
2420 value
= zero
/ zero
;
2423 value
= atof (read_buffer
+ negative
);
2427 return make_float (negative
? - value
: value
);
2431 if (uninterned_symbol
)
2432 return make_symbol (read_buffer
);
2434 return intern (read_buffer
);
2440 /* List of nodes we've seen during substitute_object_in_subtree. */
2441 static Lisp_Object seen_list
;
2444 substitute_object_in_subtree (object
, placeholder
)
2446 Lisp_Object placeholder
;
2448 Lisp_Object check_object
;
2450 /* We haven't seen any objects when we start. */
2453 /* Make all the substitutions. */
2455 = substitute_object_recurse (object
, placeholder
, object
);
2457 /* Clear seen_list because we're done with it. */
2460 /* The returned object here is expected to always eq the
2462 if (!EQ (check_object
, object
))
2463 error ("Unexpected mutation error in reader");
2466 /* Feval doesn't get called from here, so no gc protection is needed. */
2467 #define SUBSTITUTE(get_val, set_val) \
2469 Lisp_Object old_value = get_val; \
2470 Lisp_Object true_value \
2471 = substitute_object_recurse (object, placeholder,\
2474 if (!EQ (old_value, true_value)) \
2481 substitute_object_recurse (object
, placeholder
, subtree
)
2483 Lisp_Object placeholder
;
2484 Lisp_Object subtree
;
2486 /* If we find the placeholder, return the target object. */
2487 if (EQ (placeholder
, subtree
))
2490 /* If we've been to this node before, don't explore it again. */
2491 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2494 /* If this node can be the entry point to a cycle, remember that
2495 we've seen it. It can only be such an entry point if it was made
2496 by #n=, which means that we can find it as a value in
2498 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2499 seen_list
= Fcons (subtree
, seen_list
);
2501 /* Recurse according to subtree's type.
2502 Every branch must return a Lisp_Object. */
2503 switch (XTYPE (subtree
))
2505 case Lisp_Vectorlike
:
2508 int length
= XINT (Flength(subtree
));
2509 for (i
= 0; i
< length
; i
++)
2511 Lisp_Object idx
= make_number (i
);
2512 SUBSTITUTE (Faref (subtree
, idx
),
2513 Faset (subtree
, idx
, true_value
));
2520 SUBSTITUTE (Fcar_safe (subtree
),
2521 Fsetcar (subtree
, true_value
));
2522 SUBSTITUTE (Fcdr_safe (subtree
),
2523 Fsetcdr (subtree
, true_value
));
2529 /* Check for text properties in each interval.
2530 substitute_in_interval contains part of the logic. */
2532 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2533 Lisp_Object arg
= Fcons (object
, placeholder
);
2535 traverse_intervals_noorder (root_interval
,
2536 &substitute_in_interval
, arg
);
2541 /* Other types don't recurse any further. */
2547 /* Helper function for substitute_object_recurse. */
2549 substitute_in_interval (interval
, arg
)
2553 Lisp_Object object
= Fcar (arg
);
2554 Lisp_Object placeholder
= Fcdr (arg
);
2556 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2575 if (*cp
== '+' || *cp
== '-')
2578 if (*cp
>= '0' && *cp
<= '9')
2581 while (*cp
>= '0' && *cp
<= '9')
2589 if (*cp
>= '0' && *cp
<= '9')
2592 while (*cp
>= '0' && *cp
<= '9')
2595 if (*cp
== 'e' || *cp
== 'E')
2599 if (*cp
== '+' || *cp
== '-')
2603 if (*cp
>= '0' && *cp
<= '9')
2606 while (*cp
>= '0' && *cp
<= '9')
2609 else if (cp
== start
)
2611 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2616 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2622 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2623 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2624 || state
== (DOT_CHAR
|TRAIL_INT
)
2625 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2626 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2627 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2632 read_vector (readcharfun
, bytecodeflag
)
2633 Lisp_Object readcharfun
;
2638 register Lisp_Object
*ptr
;
2639 register Lisp_Object tem
, item
, vector
;
2640 register struct Lisp_Cons
*otem
;
2643 tem
= read_list (1, readcharfun
);
2644 len
= Flength (tem
);
2645 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2647 size
= XVECTOR (vector
)->size
;
2648 ptr
= XVECTOR (vector
)->contents
;
2649 for (i
= 0; i
< size
; i
++)
2652 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2653 bytecode object, the docstring containing the bytecode and
2654 constants values must be treated as unibyte and passed to
2655 Fread, to get the actual bytecode string and constants vector. */
2656 if (bytecodeflag
&& load_force_doc_strings
)
2658 if (i
== COMPILED_BYTECODE
)
2660 if (!STRINGP (item
))
2661 error ("invalid byte code");
2663 /* Delay handling the bytecode slot until we know whether
2664 it is lazily-loaded (we can tell by whether the
2665 constants slot is nil). */
2666 ptr
[COMPILED_CONSTANTS
] = item
;
2669 else if (i
== COMPILED_CONSTANTS
)
2671 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2675 /* Coerce string to unibyte (like string-as-unibyte,
2676 but without generating extra garbage and
2677 guaranteeing no change in the contents). */
2678 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2679 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2681 item
= Fread (bytestr
);
2683 error ("invalid byte code");
2685 otem
= XCONS (item
);
2686 bytestr
= XCAR (item
);
2691 /* Now handle the bytecode slot. */
2692 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2695 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2703 /* FLAG = 1 means check for ] to terminate rather than ) and .
2704 FLAG = -1 means check for starting with defun
2705 and make structure pure. */
2708 read_list (flag
, readcharfun
)
2710 register Lisp_Object readcharfun
;
2712 /* -1 means check next element for defun,
2713 0 means don't check,
2714 1 means already checked and found defun. */
2715 int defunflag
= flag
< 0 ? -1 : 0;
2716 Lisp_Object val
, tail
;
2717 register Lisp_Object elt
, tem
;
2718 struct gcpro gcpro1
, gcpro2
;
2719 /* 0 is the normal case.
2720 1 means this list is a doc reference; replace it with the number 0.
2721 2 means this list is a doc reference; replace it with the doc string. */
2722 int doc_reference
= 0;
2724 /* Initialize this to 1 if we are reading a list. */
2725 int first_in_list
= flag
<= 0;
2734 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2739 /* While building, if the list starts with #$, treat it specially. */
2740 if (EQ (elt
, Vload_file_name
)
2742 && !NILP (Vpurify_flag
))
2744 if (NILP (Vdoc_file_name
))
2745 /* We have not yet called Snarf-documentation, so assume
2746 this file is described in the DOC-MM.NN file
2747 and Snarf-documentation will fill in the right value later.
2748 For now, replace the whole list with 0. */
2751 /* We have already called Snarf-documentation, so make a relative
2752 file name for this file, so it can be found properly
2753 in the installed Lisp directory.
2754 We don't use Fexpand_file_name because that would make
2755 the directory absolute now. */
2756 elt
= concat2 (build_string ("../lisp/"),
2757 Ffile_name_nondirectory (elt
));
2759 else if (EQ (elt
, Vload_file_name
)
2761 && load_force_doc_strings
)
2770 Fsignal (Qinvalid_read_syntax
,
2771 Fcons (make_string (") or . in a vector", 18), Qnil
));
2779 XSETCDR (tail
, read0 (readcharfun
));
2781 val
= read0 (readcharfun
);
2782 read1 (readcharfun
, &ch
, 0);
2786 if (doc_reference
== 1)
2787 return make_number (0);
2788 if (doc_reference
== 2)
2790 /* Get a doc string from the file we are loading.
2791 If it's in saved_doc_string, get it from there. */
2792 int pos
= XINT (XCDR (val
));
2793 /* Position is negative for user variables. */
2794 if (pos
< 0) pos
= -pos
;
2795 if (pos
>= saved_doc_string_position
2796 && pos
< (saved_doc_string_position
2797 + saved_doc_string_length
))
2799 int start
= pos
- saved_doc_string_position
;
2802 /* Process quoting with ^A,
2803 and find the end of the string,
2804 which is marked with ^_ (037). */
2805 for (from
= start
, to
= start
;
2806 saved_doc_string
[from
] != 037;)
2808 int c
= saved_doc_string
[from
++];
2811 c
= saved_doc_string
[from
++];
2813 saved_doc_string
[to
++] = c
;
2815 saved_doc_string
[to
++] = 0;
2817 saved_doc_string
[to
++] = 037;
2820 saved_doc_string
[to
++] = c
;
2823 return make_string (saved_doc_string
+ start
,
2826 /* Look in prev_saved_doc_string the same way. */
2827 else if (pos
>= prev_saved_doc_string_position
2828 && pos
< (prev_saved_doc_string_position
2829 + prev_saved_doc_string_length
))
2831 int start
= pos
- prev_saved_doc_string_position
;
2834 /* Process quoting with ^A,
2835 and find the end of the string,
2836 which is marked with ^_ (037). */
2837 for (from
= start
, to
= start
;
2838 prev_saved_doc_string
[from
] != 037;)
2840 int c
= prev_saved_doc_string
[from
++];
2843 c
= prev_saved_doc_string
[from
++];
2845 prev_saved_doc_string
[to
++] = c
;
2847 prev_saved_doc_string
[to
++] = 0;
2849 prev_saved_doc_string
[to
++] = 037;
2852 prev_saved_doc_string
[to
++] = c
;
2855 return make_string (prev_saved_doc_string
+ start
,
2859 return get_doc_string (val
, 0, 0);
2864 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2866 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2868 tem
= (read_pure
&& flag
<= 0
2869 ? pure_cons (elt
, Qnil
)
2870 : Fcons (elt
, Qnil
));
2872 XSETCDR (tail
, tem
);
2877 defunflag
= EQ (elt
, Qdefun
);
2878 else if (defunflag
> 0)
2883 Lisp_Object Vobarray
;
2884 Lisp_Object initial_obarray
;
2886 /* oblookup stores the bucket number here, for the sake of Funintern. */
2888 int oblookup_last_bucket_number
;
2890 static int hash_string ();
2891 Lisp_Object
oblookup ();
2893 /* Get an error if OBARRAY is not an obarray.
2894 If it is one, return it. */
2897 check_obarray (obarray
)
2898 Lisp_Object obarray
;
2900 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2902 /* If Vobarray is now invalid, force it to be valid. */
2903 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2905 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2910 /* Intern the C string STR: return a symbol with that name,
2911 interned in the current obarray. */
2918 int len
= strlen (str
);
2919 Lisp_Object obarray
;
2922 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2923 obarray
= check_obarray (obarray
);
2924 tem
= oblookup (obarray
, str
, len
, len
);
2927 return Fintern (make_string (str
, len
), obarray
);
2930 /* Create an uninterned symbol with name STR. */
2936 int len
= strlen (str
);
2938 return Fmake_symbol ((!NILP (Vpurify_flag
)
2939 ? make_pure_string (str
, len
, len
, 0)
2940 : make_string (str
, len
)));
2943 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2944 doc
: /* Return the canonical symbol whose name is STRING.
2945 If there is none, one is created by this function and returned.
2946 A second optional argument specifies the obarray to use;
2947 it defaults to the value of `obarray'. */)
2949 Lisp_Object string
, obarray
;
2951 register Lisp_Object tem
, sym
, *ptr
;
2953 if (NILP (obarray
)) obarray
= Vobarray
;
2954 obarray
= check_obarray (obarray
);
2956 CHECK_STRING (string
);
2958 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2959 XSTRING (string
)->size
,
2960 STRING_BYTES (XSTRING (string
)));
2961 if (!INTEGERP (tem
))
2964 if (!NILP (Vpurify_flag
))
2965 string
= Fpurecopy (string
);
2966 sym
= Fmake_symbol (string
);
2968 if (EQ (obarray
, initial_obarray
))
2969 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2971 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2973 if ((XSTRING (string
)->data
[0] == ':')
2974 && EQ (obarray
, initial_obarray
))
2976 XSYMBOL (sym
)->constant
= 1;
2977 XSYMBOL (sym
)->value
= sym
;
2980 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2982 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2984 XSYMBOL (sym
)->next
= 0;
2989 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2990 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
2991 NAME may be a string or a symbol. If it is a symbol, that exact
2992 symbol is searched for.
2993 A second optional argument specifies the obarray to use;
2994 it defaults to the value of `obarray'. */)
2996 Lisp_Object name
, obarray
;
2998 register Lisp_Object tem
;
2999 struct Lisp_String
*string
;
3001 if (NILP (obarray
)) obarray
= Vobarray
;
3002 obarray
= check_obarray (obarray
);
3004 if (!SYMBOLP (name
))
3006 CHECK_STRING (name
);
3007 string
= XSTRING (name
);
3010 string
= XSYMBOL (name
)->name
;
3012 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
3013 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3019 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3020 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3021 The value is t if a symbol was found and deleted, nil otherwise.
3022 NAME may be a string or a symbol. If it is a symbol, that symbol
3023 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3024 OBARRAY defaults to the value of the variable `obarray'. */)
3026 Lisp_Object name
, obarray
;
3028 register Lisp_Object string
, tem
;
3031 if (NILP (obarray
)) obarray
= Vobarray
;
3032 obarray
= check_obarray (obarray
);
3035 XSETSTRING (string
, XSYMBOL (name
)->name
);
3038 CHECK_STRING (name
);
3042 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3043 XSTRING (string
)->size
,
3044 STRING_BYTES (XSTRING (string
)));
3047 /* If arg was a symbol, don't delete anything but that symbol itself. */
3048 if (SYMBOLP (name
) && !EQ (name
, tem
))
3051 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3052 XSYMBOL (tem
)->constant
= 0;
3053 XSYMBOL (tem
)->indirect_variable
= 0;
3055 hash
= oblookup_last_bucket_number
;
3057 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3059 if (XSYMBOL (tem
)->next
)
3060 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3062 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3066 Lisp_Object tail
, following
;
3068 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3069 XSYMBOL (tail
)->next
;
3072 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3073 if (EQ (following
, tem
))
3075 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3084 /* Return the symbol in OBARRAY whose names matches the string
3085 of SIZE characters (SIZE_BYTE bytes) at PTR.
3086 If there is no such symbol in OBARRAY, return nil.
3088 Also store the bucket number in oblookup_last_bucket_number. */
3091 oblookup (obarray
, ptr
, size
, size_byte
)
3092 Lisp_Object obarray
;
3094 int size
, size_byte
;
3098 register Lisp_Object tail
;
3099 Lisp_Object bucket
, tem
;
3101 if (!VECTORP (obarray
)
3102 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3104 obarray
= check_obarray (obarray
);
3105 obsize
= XVECTOR (obarray
)->size
;
3107 /* This is sometimes needed in the middle of GC. */
3108 obsize
&= ~ARRAY_MARK_FLAG
;
3109 /* Combining next two lines breaks VMS C 2.3. */
3110 hash
= hash_string (ptr
, size_byte
);
3112 bucket
= XVECTOR (obarray
)->contents
[hash
];
3113 oblookup_last_bucket_number
= hash
;
3114 if (XFASTINT (bucket
) == 0)
3116 else if (!SYMBOLP (bucket
))
3117 error ("Bad data in guts of obarray"); /* Like CADR error message */
3119 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3121 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3122 && XSYMBOL (tail
)->name
->size
== size
3123 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3125 else if (XSYMBOL (tail
)->next
== 0)
3128 XSETINT (tem
, hash
);
3133 hash_string (ptr
, len
)
3137 register unsigned char *p
= ptr
;
3138 register unsigned char *end
= p
+ len
;
3139 register unsigned char c
;
3140 register int hash
= 0;
3145 if (c
>= 0140) c
-= 40;
3146 hash
= ((hash
<<3) + (hash
>>28) + c
);
3148 return hash
& 07777777777;
3152 map_obarray (obarray
, fn
, arg
)
3153 Lisp_Object obarray
;
3154 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3158 register Lisp_Object tail
;
3159 CHECK_VECTOR (obarray
);
3160 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3162 tail
= XVECTOR (obarray
)->contents
[i
];
3167 if (XSYMBOL (tail
)->next
== 0)
3169 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3175 mapatoms_1 (sym
, function
)
3176 Lisp_Object sym
, function
;
3178 call1 (function
, sym
);
3181 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3182 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3183 OBARRAY defaults to the value of `obarray'. */)
3185 Lisp_Object function
, obarray
;
3187 if (NILP (obarray
)) obarray
= Vobarray
;
3188 obarray
= check_obarray (obarray
);
3190 map_obarray (obarray
, mapatoms_1
, function
);
3194 #define OBARRAY_SIZE 1511
3199 Lisp_Object oblength
;
3203 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3205 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3206 Vobarray
= Fmake_vector (oblength
, make_number (0));
3207 initial_obarray
= Vobarray
;
3208 staticpro (&initial_obarray
);
3209 /* Intern nil in the obarray */
3210 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3211 XSYMBOL (Qnil
)->constant
= 1;
3213 /* These locals are to kludge around a pyramid compiler bug. */
3214 hash
= hash_string ("nil", 3);
3215 /* Separate statement here to avoid VAXC bug. */
3216 hash
%= OBARRAY_SIZE
;
3217 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3220 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3221 XSYMBOL (Qnil
)->function
= Qunbound
;
3222 XSYMBOL (Qunbound
)->value
= Qunbound
;
3223 XSYMBOL (Qunbound
)->function
= Qunbound
;
3226 XSYMBOL (Qnil
)->value
= Qnil
;
3227 XSYMBOL (Qnil
)->plist
= Qnil
;
3228 XSYMBOL (Qt
)->value
= Qt
;
3229 XSYMBOL (Qt
)->constant
= 1;
3231 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3234 Qvariable_documentation
= intern ("variable-documentation");
3235 staticpro (&Qvariable_documentation
);
3237 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3238 read_buffer
= (char *) xmalloc (read_buffer_size
);
3243 struct Lisp_Subr
*sname
;
3246 sym
= intern (sname
->symbol_name
);
3247 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3250 #ifdef NOTDEF /* use fset in subr.el now */
3252 defalias (sname
, string
)
3253 struct Lisp_Subr
*sname
;
3257 sym
= intern (string
);
3258 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3262 /* Define an "integer variable"; a symbol whose value is forwarded
3263 to a C variable of type int. Sample call: */
3264 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3266 defvar_int (namestring
, address
)
3270 Lisp_Object sym
, val
;
3271 sym
= intern (namestring
);
3272 val
= allocate_misc ();
3273 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3274 XINTFWD (val
)->intvar
= address
;
3275 SET_SYMBOL_VALUE (sym
, val
);
3278 /* Similar but define a variable whose value is t if address contains 1,
3279 nil if address contains 0 */
3281 defvar_bool (namestring
, address
)
3285 Lisp_Object sym
, val
;
3286 sym
= intern (namestring
);
3287 val
= allocate_misc ();
3288 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3289 XBOOLFWD (val
)->boolvar
= address
;
3290 SET_SYMBOL_VALUE (sym
, val
);
3291 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3294 /* Similar but define a variable whose value is the Lisp Object stored
3295 at address. Two versions: with and without gc-marking of the C
3296 variable. The nopro version is used when that variable will be
3297 gc-marked for some other reason, since marking the same slot twice
3298 can cause trouble with strings. */
3300 defvar_lisp_nopro (namestring
, address
)
3302 Lisp_Object
*address
;
3304 Lisp_Object sym
, val
;
3305 sym
= intern (namestring
);
3306 val
= allocate_misc ();
3307 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3308 XOBJFWD (val
)->objvar
= address
;
3309 SET_SYMBOL_VALUE (sym
, val
);
3313 defvar_lisp (namestring
, address
)
3315 Lisp_Object
*address
;
3317 defvar_lisp_nopro (namestring
, address
);
3318 staticpro (address
);
3321 /* Similar but define a variable whose value is the Lisp Object stored in
3322 the current buffer. address is the address of the slot in the buffer
3323 that is current now. */
3326 defvar_per_buffer (namestring
, address
, type
, doc
)
3328 Lisp_Object
*address
;
3332 Lisp_Object sym
, val
;
3334 extern struct buffer buffer_local_symbols
;
3336 sym
= intern (namestring
);
3337 val
= allocate_misc ();
3338 offset
= (char *)address
- (char *)current_buffer
;
3340 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3341 XBUFFER_OBJFWD (val
)->offset
= offset
;
3342 SET_SYMBOL_VALUE (sym
, val
);
3343 PER_BUFFER_SYMBOL (offset
) = sym
;
3344 PER_BUFFER_TYPE (offset
) = type
;
3346 if (PER_BUFFER_IDX (offset
) == 0)
3347 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3348 slot of buffer_local_flags */
3353 /* Similar but define a variable whose value is the Lisp Object stored
3354 at a particular offset in the current kboard object. */
3357 defvar_kboard (namestring
, offset
)
3361 Lisp_Object sym
, val
;
3362 sym
= intern (namestring
);
3363 val
= allocate_misc ();
3364 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3365 XKBOARD_OBJFWD (val
)->offset
= offset
;
3366 SET_SYMBOL_VALUE (sym
, val
);
3369 /* Record the value of load-path used at the start of dumping
3370 so we can see if the site changed it later during dumping. */
3371 static Lisp_Object dump_path
;
3377 int turn_off_warning
= 0;
3379 /* Compute the default load-path. */
3381 normal
= PATH_LOADSEARCH
;
3382 Vload_path
= decode_env_path (0, normal
);
3384 if (NILP (Vpurify_flag
))
3385 normal
= PATH_LOADSEARCH
;
3387 normal
= PATH_DUMPLOADSEARCH
;
3389 /* In a dumped Emacs, we normally have to reset the value of
3390 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3391 uses ../lisp, instead of the path of the installed elisp
3392 libraries. However, if it appears that Vload_path was changed
3393 from the default before dumping, don't override that value. */
3396 if (! NILP (Fequal (dump_path
, Vload_path
)))
3398 Vload_path
= decode_env_path (0, normal
);
3399 if (!NILP (Vinstallation_directory
))
3401 Lisp_Object tem
, tem1
, sitelisp
;
3403 /* Remove site-lisp dirs from path temporarily and store
3404 them in sitelisp, then conc them on at the end so
3405 they're always first in path. */
3409 tem
= Fcar (Vload_path
);
3410 tem1
= Fstring_match (build_string ("site-lisp"),
3414 Vload_path
= Fcdr (Vload_path
);
3415 sitelisp
= Fcons (tem
, sitelisp
);
3421 /* Add to the path the lisp subdir of the
3422 installation dir, if it exists. */
3423 tem
= Fexpand_file_name (build_string ("lisp"),
3424 Vinstallation_directory
);
3425 tem1
= Ffile_exists_p (tem
);
3428 if (NILP (Fmember (tem
, Vload_path
)))
3430 turn_off_warning
= 1;
3431 Vload_path
= Fcons (tem
, Vload_path
);
3435 /* That dir doesn't exist, so add the build-time
3436 Lisp dirs instead. */
3437 Vload_path
= nconc2 (Vload_path
, dump_path
);
3439 /* Add leim under the installation dir, if it exists. */
3440 tem
= Fexpand_file_name (build_string ("leim"),
3441 Vinstallation_directory
);
3442 tem1
= Ffile_exists_p (tem
);
3445 if (NILP (Fmember (tem
, Vload_path
)))
3446 Vload_path
= Fcons (tem
, Vload_path
);
3449 /* Add site-list under the installation dir, if it exists. */
3450 tem
= Fexpand_file_name (build_string ("site-lisp"),
3451 Vinstallation_directory
);
3452 tem1
= Ffile_exists_p (tem
);
3455 if (NILP (Fmember (tem
, Vload_path
)))
3456 Vload_path
= Fcons (tem
, Vload_path
);
3459 /* If Emacs was not built in the source directory,
3460 and it is run from where it was built, add to load-path
3461 the lisp, leim and site-lisp dirs under that directory. */
3463 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3467 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3468 Vinstallation_directory
);
3469 tem1
= Ffile_exists_p (tem
);
3471 /* Don't be fooled if they moved the entire source tree
3472 AFTER dumping Emacs. If the build directory is indeed
3473 different from the source dir, src/Makefile.in and
3474 src/Makefile will not be found together. */
3475 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3476 Vinstallation_directory
);
3477 tem2
= Ffile_exists_p (tem
);
3478 if (!NILP (tem1
) && NILP (tem2
))
3480 tem
= Fexpand_file_name (build_string ("lisp"),
3483 if (NILP (Fmember (tem
, Vload_path
)))
3484 Vload_path
= Fcons (tem
, Vload_path
);
3486 tem
= Fexpand_file_name (build_string ("leim"),
3489 if (NILP (Fmember (tem
, Vload_path
)))
3490 Vload_path
= Fcons (tem
, Vload_path
);
3492 tem
= Fexpand_file_name (build_string ("site-lisp"),
3495 if (NILP (Fmember (tem
, Vload_path
)))
3496 Vload_path
= Fcons (tem
, Vload_path
);
3499 if (!NILP (sitelisp
))
3500 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3506 /* NORMAL refers to the lisp dir in the source directory. */
3507 /* We used to add ../lisp at the front here, but
3508 that caused trouble because it was copied from dump_path
3509 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3510 It should be unnecessary. */
3511 Vload_path
= decode_env_path (0, normal
);
3512 dump_path
= Vload_path
;
3517 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3518 almost never correct, thereby causing a warning to be printed out that
3519 confuses users. Since PATH_LOADSEARCH is always overridden by the
3520 EMACSLOADPATH environment variable below, disable the warning on NT. */
3522 /* Warn if dirs in the *standard* path don't exist. */
3523 if (!turn_off_warning
)
3525 Lisp_Object path_tail
;
3527 for (path_tail
= Vload_path
;
3529 path_tail
= XCDR (path_tail
))
3531 Lisp_Object dirfile
;
3532 dirfile
= Fcar (path_tail
);
3533 if (STRINGP (dirfile
))
3535 dirfile
= Fdirectory_file_name (dirfile
);
3536 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3537 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3542 #endif /* WINDOWSNT */
3544 /* If the EMACSLOADPATH environment variable is set, use its value.
3545 This doesn't apply if we're dumping. */
3547 if (NILP (Vpurify_flag
)
3548 && egetenv ("EMACSLOADPATH"))
3550 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3554 load_in_progress
= 0;
3555 Vload_file_name
= Qnil
;
3557 load_descriptor_list
= Qnil
;
3559 Vstandard_input
= Qt
;
3560 Vloads_in_progress
= Qnil
;
3563 /* Print a warning, using format string FORMAT, that directory DIRNAME
3564 does not exist. Print it on stderr and put it in *Message*. */
3567 dir_warning (format
, dirname
)
3569 Lisp_Object dirname
;
3572 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3574 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3575 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3576 /* Don't log the warning before we've initialized!! */
3578 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3585 defsubr (&Sread_from_string
);
3587 defsubr (&Sintern_soft
);
3588 defsubr (&Sunintern
);
3590 defsubr (&Seval_buffer
);
3591 defsubr (&Seval_region
);
3592 defsubr (&Sread_char
);
3593 defsubr (&Sread_char_exclusive
);
3594 defsubr (&Sread_event
);
3595 defsubr (&Sget_file_char
);
3596 defsubr (&Smapatoms
);
3598 DEFVAR_LISP ("obarray", &Vobarray
,
3599 doc
: /* Symbol table for use by `intern' and `read'.
3600 It is a vector whose length ought to be prime for best results.
3601 The vector's contents don't make sense if examined from Lisp programs;
3602 to find all the symbols in an obarray, use `mapatoms'. */);
3604 DEFVAR_LISP ("values", &Vvalues
,
3605 doc
: /* List of values of all expressions which were read, evaluated and printed.
3606 Order is reverse chronological. */);
3608 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3609 doc
: /* Stream for read to get input from.
3610 See documentation of `read' for possible values. */);
3611 Vstandard_input
= Qt
;
3613 DEFVAR_LISP ("load-path", &Vload_path
,
3614 doc
: /* *List of directories to search for files to load.
3615 Each element is a string (directory name) or nil (try default directory).
3616 Initialized based on EMACSLOADPATH environment variable, if any,
3617 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3619 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3620 doc
: /* *List of suffixes to try for files to load.
3621 This list should not include the empty string. */);
3622 Vload_suffixes
= Fcons (build_string (".elc"),
3623 Fcons (build_string (".el"), Qnil
));
3624 /* We don't use empty_string because it's not initialized yet. */
3625 default_suffixes
= Fcons (build_string (""), Qnil
);
3626 staticpro (&default_suffixes
);
3628 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3629 doc
: /* Non-nil iff inside of `load'. */);
3631 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3632 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3633 Each element looks like (FILENAME FORMS...).
3634 When `load' is run and the file-name argument is FILENAME,
3635 the FORMS in the corresponding element are executed at the end of loading.
3637 FILENAME must match exactly! Normally FILENAME is the name of a library,
3638 with no directory specified, since that is how `load' is normally called.
3639 An error in FORMS does not undo the load,
3640 but does prevent execution of the rest of the FORMS.
3641 FILENAME can also be a symbol (a feature) and FORMS are then executed
3642 when the corresponding call to `provide' is made. */);
3643 Vafter_load_alist
= Qnil
;
3645 DEFVAR_LISP ("load-history", &Vload_history
,
3646 doc
: /* Alist mapping source file names to symbols and features.
3647 Each alist element is a list that starts with a file name,
3648 except for one element (optional) that starts with nil and describes
3649 definitions evaluated from buffers not visiting files.
3650 The remaining elements of each list are symbols defined as functions
3651 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3652 and `(autoload . SYMBOL)'. */);
3653 Vload_history
= Qnil
;
3655 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3656 doc
: /* Full name of file being loaded by `load'. */);
3657 Vload_file_name
= Qnil
;
3659 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3660 doc
: /* File name, including directory, of user's initialization file.
3661 If the file loaded had extension `.elc' and there was a corresponding `.el'
3662 file, this variable contains the name of the .el file, suitable for use
3663 by functions like `custom-save-all' which edit the init file. */);
3664 Vuser_init_file
= Qnil
;
3666 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3667 doc
: /* Used for internal purposes by `load'. */);
3668 Vcurrent_load_list
= Qnil
;
3670 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3671 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3672 The default is nil, which means use the function `read'. */);
3673 Vload_read_function
= Qnil
;
3675 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3676 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3677 This function is for doing code conversion before reading the source file.
3678 If nil, loading is done without any code conversion.
3679 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3680 FULLNAME is the full name of FILE.
3681 See `load' for the meaning of the remaining arguments. */);
3682 Vload_source_file_function
= Qnil
;
3684 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3685 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3686 This is useful when the file being loaded is a temporary copy. */);
3687 load_force_doc_strings
= 0;
3689 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3690 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3691 This is normally bound by `load' and `eval-buffer' to control `read',
3692 and is not meant for users to change. */);
3693 load_convert_to_unibyte
= 0;
3695 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3696 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3697 You cannot count on them to still be there! */);
3699 = Fexpand_file_name (build_string ("../"),
3700 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3702 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3703 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3704 Vpreloaded_file_list
= Qnil
;
3706 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3707 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3708 Vbyte_boolean_vars
= Qnil
;
3710 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3711 doc
: /* Non-nil means load dangerous compiled Lisp files.
3712 Some versions of XEmacs use different byte codes than Emacs. These
3713 incompatible byte codes can make Emacs crash when it tries to execute
3715 load_dangerous_libraries
= 0;
3717 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3718 doc
: /* Regular expression matching safe to load compiled Lisp files.
3719 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3720 from the file, and matches them against this regular expression.
3721 When the regular expression matches, the file is considered to be safe
3722 to load. See also `load-dangerous-libraries'. */);
3723 Vbytecomp_version_regexp
3724 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3726 /* Vsource_directory was initialized in init_lread. */
3728 load_descriptor_list
= Qnil
;
3729 staticpro (&load_descriptor_list
);
3731 Qcurrent_load_list
= intern ("current-load-list");
3732 staticpro (&Qcurrent_load_list
);
3734 Qstandard_input
= intern ("standard-input");
3735 staticpro (&Qstandard_input
);
3737 Qread_char
= intern ("read-char");
3738 staticpro (&Qread_char
);
3740 Qget_file_char
= intern ("get-file-char");
3741 staticpro (&Qget_file_char
);
3743 Qbackquote
= intern ("`");
3744 staticpro (&Qbackquote
);
3745 Qcomma
= intern (",");
3746 staticpro (&Qcomma
);
3747 Qcomma_at
= intern (",@");
3748 staticpro (&Qcomma_at
);
3749 Qcomma_dot
= intern (",.");
3750 staticpro (&Qcomma_dot
);
3752 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3753 staticpro (&Qinhibit_file_name_operation
);
3755 Qascii_character
= intern ("ascii-character");
3756 staticpro (&Qascii_character
);
3758 Qfunction
= intern ("function");
3759 staticpro (&Qfunction
);
3761 Qload
= intern ("load");
3764 Qload_file_name
= intern ("load-file-name");
3765 staticpro (&Qload_file_name
);
3767 staticpro (&dump_path
);
3769 staticpro (&read_objects
);
3770 read_objects
= Qnil
;
3771 staticpro (&seen_list
);
3773 Vloads_in_progress
= Qnil
;
3774 staticpro (&Vloads_in_progress
);