1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 01, 02
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
37 #include "termhooks.h"
40 #include <sys/inode.h>
45 #include <unistd.h> /* to get X_OK */
62 #endif /* HAVE_SETLOCALE */
69 #define file_offset off_t
70 #define file_tell ftello
72 #define file_offset long
73 #define file_tell ftell
80 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
81 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
82 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
83 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
84 Lisp_Object Qinhibit_file_name_operation
;
86 extern Lisp_Object Qevent_symbol_element_mask
;
87 extern Lisp_Object Qfile_exists_p
;
89 /* non-zero if inside `load' */
92 /* Directory in which the sources were found. */
93 Lisp_Object Vsource_directory
;
95 /* Search path and suffixes for files to be loaded. */
96 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
98 /* File name of user's init file. */
99 Lisp_Object Vuser_init_file
;
101 /* This is the user-visible association list that maps features to
102 lists of defs in their load files. */
103 Lisp_Object Vload_history
;
105 /* This is used to build the load history. */
106 Lisp_Object Vcurrent_load_list
;
108 /* List of files that were preloaded. */
109 Lisp_Object Vpreloaded_file_list
;
111 /* Name of file actually being read by `load'. */
112 Lisp_Object Vload_file_name
;
114 /* Function to use for reading, in `load' and friends. */
115 Lisp_Object Vload_read_function
;
117 /* The association list of objects read with the #n=object form.
118 Each member of the list has the form (n . object), and is used to
119 look up the object for the corresponding #n# construct.
120 It must be set to nil before all top-level calls to read0. */
121 Lisp_Object read_objects
;
123 /* Nonzero means load should forcibly load all dynamic doc strings. */
124 static int load_force_doc_strings
;
126 /* Nonzero means read should convert strings to unibyte. */
127 static int load_convert_to_unibyte
;
129 /* Function to use for loading an Emacs lisp source file (not
130 compiled) instead of readevalloop. */
131 Lisp_Object Vload_source_file_function
;
133 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
134 Lisp_Object Vbyte_boolean_vars
;
136 /* List of descriptors now open for Fload. */
137 static Lisp_Object load_descriptor_list
;
139 /* File for get_file_char to read from. Use by load. */
140 static FILE *instream
;
142 /* When nonzero, read conses in pure space */
143 static int read_pure
;
145 /* For use within read-from-string (this reader is non-reentrant!!) */
146 static int read_from_string_index
;
147 static int read_from_string_index_byte
;
148 static int read_from_string_limit
;
150 /* Number of bytes left to read in the buffer character
151 that `readchar' has already advanced over. */
152 static int readchar_backlog
;
154 /* This contains the last string skipped with #@. */
155 static char *saved_doc_string
;
156 /* Length of buffer allocated in saved_doc_string. */
157 static int saved_doc_string_size
;
158 /* Length of actual data in saved_doc_string. */
159 static int saved_doc_string_length
;
160 /* This is the file position that string came from. */
161 static file_offset saved_doc_string_position
;
163 /* This contains the previous string skipped with #@.
164 We copy it from saved_doc_string when a new string
165 is put in saved_doc_string. */
166 static char *prev_saved_doc_string
;
167 /* Length of buffer allocated in prev_saved_doc_string. */
168 static int prev_saved_doc_string_size
;
169 /* Length of actual data in prev_saved_doc_string. */
170 static int prev_saved_doc_string_length
;
171 /* This is the file position that string came from. */
172 static file_offset prev_saved_doc_string_position
;
174 /* Nonzero means inside a new-style backquote
175 with no surrounding parentheses.
176 Fread initializes this to zero, so we need not specbind it
177 or worry about what happens to it when there is an error. */
178 static int new_backquote_flag
;
180 /* A list of file names for files being loaded in Fload. Used to
181 check for recursive loads. */
183 static Lisp_Object Vloads_in_progress
;
185 /* Non-zero means load dangerous compiled Lisp files. */
187 int load_dangerous_libraries
;
189 /* A regular expression used to detect files compiled with Emacs. */
191 static Lisp_Object Vbytecomp_version_regexp
;
193 static void 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
);
224 if (readchar_backlog
> 0)
225 /* We get the address of the byte just passed,
226 which is the last byte of the character.
227 The other bytes in this character are consecutive with it,
228 because the gap can't be in the middle of a character. */
229 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
230 - --readchar_backlog
);
232 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
235 readchar_backlog
= -1;
237 if (! NILP (inbuffer
->enable_multibyte_characters
))
239 /* Fetch the character code from the buffer. */
240 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
241 BUF_INC_POS (inbuffer
, pt_byte
);
242 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
246 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
249 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
253 if (MARKERP (readcharfun
))
255 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
257 int bytepos
= marker_byte_position (readcharfun
);
259 if (readchar_backlog
> 0)
260 /* We get the address of the byte just passed,
261 which is the last byte of the character.
262 The other bytes in this character are consecutive with it,
263 because the gap can't be in the middle of a character. */
264 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
265 - --readchar_backlog
);
267 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
270 readchar_backlog
= -1;
272 if (! NILP (inbuffer
->enable_multibyte_characters
))
274 /* Fetch the character code from the buffer. */
275 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
276 BUF_INC_POS (inbuffer
, bytepos
);
277 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
281 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
285 XMARKER (readcharfun
)->bytepos
= bytepos
;
286 XMARKER (readcharfun
)->charpos
++;
291 if (EQ (readcharfun
, Qlambda
))
292 return read_bytecode_char (0);
294 if (EQ (readcharfun
, Qget_file_char
))
298 /* Interrupted reads have been observed while reading over the network */
299 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
308 if (STRINGP (readcharfun
))
310 if (read_from_string_index
>= read_from_string_limit
)
313 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
314 read_from_string_index
,
315 read_from_string_index_byte
);
320 tem
= call0 (readcharfun
);
327 /* Unread the character C in the way appropriate for the stream READCHARFUN.
328 If the stream is a user function, call it with the char as argument. */
331 unreadchar (readcharfun
, c
)
332 Lisp_Object readcharfun
;
336 /* Don't back up the pointer if we're unreading the end-of-input mark,
337 since readchar didn't advance it when we read it. */
339 else if (BUFFERP (readcharfun
))
341 struct buffer
*b
= XBUFFER (readcharfun
);
342 int bytepos
= BUF_PT_BYTE (b
);
344 if (readchar_backlog
>= 0)
349 if (! NILP (b
->enable_multibyte_characters
))
350 BUF_DEC_POS (b
, bytepos
);
354 BUF_PT_BYTE (b
) = bytepos
;
357 else if (MARKERP (readcharfun
))
359 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
360 int bytepos
= XMARKER (readcharfun
)->bytepos
;
362 if (readchar_backlog
>= 0)
366 XMARKER (readcharfun
)->charpos
--;
367 if (! NILP (b
->enable_multibyte_characters
))
368 BUF_DEC_POS (b
, bytepos
);
372 XMARKER (readcharfun
)->bytepos
= bytepos
;
375 else if (STRINGP (readcharfun
))
377 read_from_string_index
--;
378 read_from_string_index_byte
379 = string_char_to_byte (readcharfun
, read_from_string_index
);
381 else if (EQ (readcharfun
, Qlambda
))
382 read_bytecode_char (1);
383 else if (EQ (readcharfun
, Qget_file_char
))
384 ungetc (c
, instream
);
386 call1 (readcharfun
, make_number (c
));
389 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
390 static int read_multibyte ();
391 static Lisp_Object
substitute_object_recurse ();
392 static void substitute_object_in_subtree (), substitute_in_interval ();
395 /* Get a character from the tty. */
397 extern Lisp_Object
read_char ();
399 /* Read input events until we get one that's acceptable for our purposes.
401 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
402 until we get a character we like, and then stuffed into
405 If ASCII_REQUIRED is non-zero, we check function key events to see
406 if the unmodified version of the symbol has a Qascii_character
407 property, and use that character, if present.
409 If ERROR_NONASCII is non-zero, we signal an error if the input we
410 get isn't an ASCII character with modifiers. If it's zero but
411 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
414 If INPUT_METHOD is nonzero, we invoke the current input method
415 if the character warrants that. */
418 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
420 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
422 register Lisp_Object val
, delayed_switch_frame
;
424 #ifdef HAVE_WINDOW_SYSTEM
425 if (display_hourglass_p
)
429 delayed_switch_frame
= Qnil
;
431 /* Read until we get an acceptable event. */
433 val
= read_char (0, 0, 0,
434 (input_method
? Qnil
: Qt
),
440 /* switch-frame events are put off until after the next ASCII
441 character. This is better than signaling an error just because
442 the last characters were typed to a separate minibuffer frame,
443 for example. Eventually, some code which can deal with
444 switch-frame events will read it and process it. */
446 && EVENT_HAS_PARAMETERS (val
)
447 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
449 delayed_switch_frame
= val
;
455 /* Convert certain symbols to their ASCII equivalents. */
458 Lisp_Object tem
, tem1
;
459 tem
= Fget (val
, Qevent_symbol_element_mask
);
462 tem1
= Fget (Fcar (tem
), Qascii_character
);
463 /* Merge this symbol's modifier bits
464 with the ASCII equivalent of its basic code. */
466 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
470 /* If we don't have a character now, deal with it appropriately. */
475 Vunread_command_events
= Fcons (val
, Qnil
);
476 error ("Non-character input-event");
483 if (! NILP (delayed_switch_frame
))
484 unread_switch_frame
= delayed_switch_frame
;
486 #ifdef HAVE_WINDOW_SYSTEM
487 if (display_hourglass_p
)
493 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
494 doc
: /* Read a character from the command input (keyboard or macro).
495 It is returned as a number.
496 If the user generates an event which is not a character (i.e. a mouse
497 click or function key event), `read-char' signals an error. As an
498 exception, switch-frame events are put off until non-ASCII events can
500 If you want to read non-character events, or ignore them, call
501 `read-event' or `read-char-exclusive' instead.
503 If the optional argument PROMPT is non-nil, display that as a prompt.
504 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
505 input method is turned on in the current buffer, that input method
506 is used for reading a character. */)
507 (prompt
, inherit_input_method
)
508 Lisp_Object prompt
, inherit_input_method
;
511 message_with_string ("%s", prompt
, 0);
512 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
515 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
516 doc
: /* Read an event object from the input stream.
517 If the optional argument PROMPT is non-nil, display that as a prompt.
518 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
519 input method is turned on in the current buffer, that input method
520 is used for reading a character. */)
521 (prompt
, inherit_input_method
)
522 Lisp_Object prompt
, inherit_input_method
;
525 message_with_string ("%s", prompt
, 0);
526 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
529 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
530 doc
: /* Read a character from the command input (keyboard or macro).
531 It is returned as a number. Non-character events are ignored.
533 If the optional argument PROMPT is non-nil, display that as a prompt.
534 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
535 input method is turned on in the current buffer, that input method
536 is used for reading a character. */)
537 (prompt
, inherit_input_method
)
538 Lisp_Object prompt
, inherit_input_method
;
541 message_with_string ("%s", prompt
, 0);
542 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
545 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
546 doc
: /* Don't use this yourself. */)
549 register Lisp_Object val
;
550 XSETINT (val
, getc (instream
));
556 /* Value is non-zero if the file asswociated with file descriptor FD
557 is a compiled Lisp file that's safe to load. Only files compiled
558 with Emacs are safe to load. Files compiled with XEmacs can lead
559 to a crash in Fbyte_code because of an incompatible change in the
568 int safe_p
= 1, version
= 0;
570 /* Read the first few bytes from the file, and look for a line
571 specifying the byte compiler version used. */
572 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
577 /* Skip to the next newline, skipping over the initial `ELC'
578 with NUL bytes following it, but note the version. */
579 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
584 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
591 lseek (fd
, 0, SEEK_SET
);
596 /* Callback for record_unwind_protect. Restore the old load list OLD,
597 after loading a file successfully. */
600 record_load_unwind (old
)
603 return Vloads_in_progress
= old
;
607 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
608 doc
: /* Execute a file of Lisp code named FILE.
609 First try FILE with `.elc' appended, then try with `.el',
610 then try FILE unmodified. Environment variable references in FILE
611 are replaced with their values by calling `substitute-in-file-name'.
612 This function searches the directories in `load-path'.
613 If optional second arg NOERROR is non-nil,
614 report no error if FILE doesn't exist.
615 Print messages at start and end of loading unless
616 optional third arg NOMESSAGE is non-nil.
617 If optional fourth arg NOSUFFIX is non-nil, don't try adding
618 suffixes `.elc' or `.el' to the specified name FILE.
619 If optional fifth arg MUST-SUFFIX is non-nil, insist on
620 the suffix `.elc' or `.el'; don't accept just FILE unless
621 it ends in one of those suffixes or includes a directory name.
622 Return t if file exists. */)
623 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
624 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
626 register FILE *stream
;
627 register int fd
= -1;
628 register Lisp_Object lispstream
;
629 int count
= specpdl_ptr
- specpdl
;
633 /* 1 means we printed the ".el is newer" message. */
635 /* 1 means we are loading a compiled file. */
646 /* If file name is magic, call the handler. */
647 /* This shouldn't be necessary any more now that `openp' handles it right.
648 handler = Ffind_file_name_handler (file, Qload);
650 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
652 /* Do this after the handler to avoid
653 the need to gcpro noerror, nomessage and nosuffix.
654 (Below here, we care only whether they are nil or not.)
655 The presence of this call is the result of a historical accident:
656 it used to be in every file-operations and when it got removed
657 everywhere, it accidentally stayed here. Since then, enough people
658 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
659 that it seemed risky to remove. */
660 file
= Fsubstitute_in_file_name (file
);
662 /* Avoid weird lossage with null string as arg,
663 since it would try to load a directory as a Lisp file */
664 if (XSTRING (file
)->size
> 0)
666 int size
= STRING_BYTES (XSTRING (file
));
671 if (! NILP (must_suffix
))
673 /* Don't insist on adding a suffix if FILE already ends with one. */
675 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
678 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
680 /* Don't insist on adding a suffix
681 if the argument includes a directory name. */
682 else if (! NILP (Ffile_name_directory (file
)))
686 fd
= openp (Vload_path
, file
,
687 (!NILP (nosuffix
) ? Qnil
688 : !NILP (must_suffix
) ? Vload_suffixes
689 : Fappend (2, (tmp
[0] = Vload_suffixes
,
690 tmp
[1] = default_suffixes
,
700 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
701 Fcons (file
, Qnil
)));
706 /* Tell startup.el whether or not we found the user's init file. */
707 if (EQ (Qt
, Vuser_init_file
))
708 Vuser_init_file
= found
;
710 /* If FD is -2, that means openp found a magic file. */
713 if (NILP (Fequal (found
, file
)))
714 /* If FOUND is a different file name from FILE,
715 find its handler even if we have already inhibited
716 the `load' operation on FILE. */
717 handler
= Ffind_file_name_handler (found
, Qt
);
719 handler
= Ffind_file_name_handler (found
, Qload
);
720 if (! NILP (handler
))
721 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
724 /* Check if we're stuck in a recursive load cycle.
726 2000-09-21: It's not possible to just check for the file loaded
727 being a member of Vloads_in_progress. This fails because of the
728 way the byte compiler currently works; `provide's are not
729 evaluted, see font-lock.el/jit-lock.el as an example. This
730 leads to a certain amount of ``normal'' recursion.
732 Also, just loading a file recursively is not always an error in
733 the general case; the second load may do something different. */
737 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
738 if (!NILP (Fequal (found
, XCAR (tem
))))
741 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
742 Fcons (found
, Vloads_in_progress
)));
743 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
744 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
747 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
749 /* Load .elc files directly, but not when they are
750 remote and have no handler! */
757 if (!(version
= safe_to_load_p (fd
)))
760 if (!load_dangerous_libraries
)
763 error ("File `%s' was not compiled in Emacs",
764 XSTRING (found
)->data
);
766 else if (!NILP (nomessage
))
767 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
772 if (version
== 20) /* 21 isn't used */
773 /* We're loading something compiled with Mule 3, 4 or 5,
774 and thus potentially emacs-mule-encoded; load it with
775 code conversion. (Perhaps the test should actually be
776 <22?) We could check further on whether the comment
777 mentions multibyte and only code-convert if it does. I
778 doubt it's worth the effort. -- fx */
784 /* load-with-code-conversion currently fails with
785 emacs-mule non-ASCII doc strings. */
786 error ("Can't currently load Emacs 20/1-compiled files: %s",
787 XSTRING (found
)->data
);
789 val
= call4 (intern ("load-with-code-conversion"), found
, file
,
790 NILP (noerror
) ? Qnil
: Qt
,
791 NILP (nomessage
) ? Qnil
: Qt
);
793 return unbind_to (count
, val
);
799 stat ((char *)XSTRING (found
)->data
, &s1
);
800 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
801 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
802 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
804 /* Make the progress messages mention that source is newer. */
807 /* If we won't print another message, mention this anyway. */
808 if (! NILP (nomessage
))
809 message_with_string ("Source file `%s' newer than byte-compiled file",
812 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
817 /* We are loading a source file (*.el). */
818 if (!NILP (Vload_source_file_function
))
824 val
= call4 (Vload_source_file_function
, found
, file
,
825 NILP (noerror
) ? Qnil
: Qt
,
826 NILP (nomessage
) ? Qnil
: Qt
);
827 return unbind_to (count
, val
);
833 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
834 #else /* not WINDOWSNT */
835 stream
= fdopen (fd
, fmode
);
836 #endif /* not WINDOWSNT */
840 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
843 if (! NILP (Vpurify_flag
))
844 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
846 if (NILP (nomessage
))
849 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
852 message_with_string ("Loading %s (source)...", file
, 1);
854 message_with_string ("Loading %s (compiled; note, source file is newer)...",
856 else /* The typical case; compiled file newer than source file. */
857 message_with_string ("Loading %s...", file
, 1);
861 lispstream
= Fcons (Qnil
, Qnil
);
862 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
863 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
864 record_unwind_protect (load_unwind
, lispstream
);
865 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
866 specbind (Qload_file_name
, found
);
867 specbind (Qinhibit_file_name_operation
, Qnil
);
869 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
871 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
872 unbind_to (count
, Qnil
);
874 /* Run any load-hooks for this file. */
875 temp
= Fassoc (file
, Vafter_load_alist
);
877 Fprogn (Fcdr (temp
));
880 if (saved_doc_string
)
881 free (saved_doc_string
);
882 saved_doc_string
= 0;
883 saved_doc_string_size
= 0;
885 if (prev_saved_doc_string
)
886 xfree (prev_saved_doc_string
);
887 prev_saved_doc_string
= 0;
888 prev_saved_doc_string_size
= 0;
890 if (!noninteractive
&& NILP (nomessage
))
893 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
896 message_with_string ("Loading %s (source)...done", file
, 1);
898 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
900 else /* The typical case; compiled file newer than source file. */
901 message_with_string ("Loading %s...done", file
, 1);
908 load_unwind (stream
) /* used as unwind-protect function in load */
911 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
912 | XFASTINT (XCDR (stream
))));
913 if (--load_in_progress
< 0) load_in_progress
= 0;
918 load_descriptor_unwind (oldlist
)
921 load_descriptor_list
= oldlist
;
925 /* Close all descriptors in use for Floads.
926 This is used when starting a subprocess. */
933 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
934 emacs_close (XFASTINT (XCAR (tail
)));
939 complete_filename_p (pathname
)
940 Lisp_Object pathname
;
942 register unsigned char *s
= XSTRING (pathname
)->data
;
943 return (IS_DIRECTORY_SEP (s
[0])
944 || (XSTRING (pathname
)->size
> 2
945 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
955 /* Search for a file whose name is STR, looking in directories
956 in the Lisp list PATH, and trying suffixes from SUFFIX.
957 On success, returns a file descriptor. On failure, returns -1.
959 SUFFIXES is a list of strings containing possible suffixes.
960 The empty suffix is automatically added iff the list is empty.
962 EXEC_ONLY nonzero means don't open the files,
963 just look for one that is executable. In this case,
964 returns 1 on success.
966 If STOREPTR is nonzero, it points to a slot where the name of
967 the file actually found should be stored as a Lisp string.
968 nil is stored there on failure.
970 If the file we find is remote, return -2
971 but store the found remote file name in *STOREPTR.
972 We do not check for remote files if EXEC_ONLY is nonzero. */
975 openp (path
, str
, suffixes
, storeptr
, exec_only
)
976 Lisp_Object path
, str
;
977 Lisp_Object suffixes
;
978 Lisp_Object
*storeptr
;
984 register char *fn
= buf
;
987 Lisp_Object filename
;
989 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
990 Lisp_Object string
, tail
;
991 int max_suffix_len
= 0;
993 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
995 CHECK_STRING_CAR (tail
);
996 max_suffix_len
= max (max_suffix_len
,
997 STRING_BYTES (XSTRING (XCAR (tail
))));
1000 string
= filename
= Qnil
;
1001 GCPRO5 (str
, string
, filename
, path
, suffixes
);
1006 if (complete_filename_p (str
))
1009 for (; CONSP (path
); path
= XCDR (path
))
1011 filename
= Fexpand_file_name (str
, XCAR (path
));
1012 if (!complete_filename_p (filename
))
1013 /* If there are non-absolute elts in PATH (eg ".") */
1014 /* Of course, this could conceivably lose if luser sets
1015 default-directory to be something non-absolute... */
1017 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1018 if (!complete_filename_p (filename
))
1019 /* Give up on this path element! */
1023 /* Calculate maximum size of any filename made from
1024 this path element/specified file name and any possible suffix. */
1025 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1026 if (fn_size
< want_size
)
1027 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1029 /* Loop over suffixes. */
1030 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1031 CONSP (tail
); tail
= XCDR (tail
))
1033 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1034 Lisp_Object handler
;
1036 /* Concatenate path element/specified name with the suffix.
1037 If the directory starts with /:, remove that. */
1038 if (XSTRING (filename
)->size
> 2
1039 && XSTRING (filename
)->data
[0] == '/'
1040 && XSTRING (filename
)->data
[1] == ':')
1042 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1043 STRING_BYTES (XSTRING (filename
)) - 2);
1044 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1048 strncpy (fn
, XSTRING (filename
)->data
,
1049 STRING_BYTES (XSTRING (filename
)));
1050 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1053 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1054 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1056 /* Check that the file exists and is not a directory. */
1057 /* We used to only check for handlers on non-absolute file names:
1061 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1062 It's not clear why that was the case and it breaks things like
1063 (load "/bar.el") where the file is actually "/bar.el.gz". */
1064 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1065 if (!NILP (handler
) && !exec_only
)
1069 string
= build_string (fn
);
1070 exists
= !NILP (Ffile_readable_p (string
));
1071 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1076 /* We succeeded; return this descriptor and filename. */
1078 *storeptr
= build_string (fn
);
1085 int exists
= (stat (fn
, &st
) >= 0
1086 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1089 /* Check that we can access or open it. */
1091 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1093 fd
= emacs_open (fn
, O_RDONLY
, 0);
1097 /* We succeeded; return this descriptor and filename. */
1099 *storeptr
= build_string (fn
);
1115 /* Merge the list we've accumulated of globals from the current input source
1116 into the load_history variable. The details depend on whether
1117 the source has an associated file name or not. */
1120 build_load_history (stream
, source
)
1124 register Lisp_Object tail
, prev
, newelt
;
1125 register Lisp_Object tem
, tem2
;
1126 register int foundit
, loading
;
1128 loading
= stream
|| !NARROWED
;
1130 tail
= Vload_history
;
1133 while (!NILP (tail
))
1137 /* Find the feature's previous assoc list... */
1138 if (!NILP (Fequal (source
, Fcar (tem
))))
1142 /* If we're loading, remove it. */
1146 Vload_history
= Fcdr (tail
);
1148 Fsetcdr (prev
, Fcdr (tail
));
1151 /* Otherwise, cons on new symbols that are not already members. */
1154 tem2
= Vcurrent_load_list
;
1156 while (CONSP (tem2
))
1158 newelt
= Fcar (tem2
);
1160 if (NILP (Fmemq (newelt
, tem
)))
1161 Fsetcar (tail
, Fcons (Fcar (tem
),
1162 Fcons (newelt
, Fcdr (tem
))));
1175 /* If we're loading, cons the new assoc onto the front of load-history,
1176 the most-recently-loaded position. Also do this if we didn't find
1177 an existing member for the current source. */
1178 if (loading
|| !foundit
)
1179 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1184 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1192 readevalloop_1 (old
)
1195 load_convert_to_unibyte
= ! NILP (old
);
1199 /* Signal an `end-of-file' error, if possible with file name
1203 end_of_file_error ()
1207 if (STRINGP (Vload_file_name
))
1208 data
= Fcons (Vload_file_name
, Qnil
);
1212 Fsignal (Qend_of_file
, data
);
1215 /* UNIBYTE specifies how to set load_convert_to_unibyte
1216 for this invocation.
1217 READFUN, if non-nil, is used instead of `read'. */
1220 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1221 Lisp_Object readcharfun
;
1223 Lisp_Object sourcename
;
1224 Lisp_Object (*evalfun
) ();
1226 Lisp_Object unibyte
, readfun
;
1229 register Lisp_Object val
;
1230 int count
= specpdl_ptr
- specpdl
;
1231 struct gcpro gcpro1
;
1232 struct buffer
*b
= 0;
1233 int continue_reading_p
;
1235 if (BUFFERP (readcharfun
))
1236 b
= XBUFFER (readcharfun
);
1237 else if (MARKERP (readcharfun
))
1238 b
= XMARKER (readcharfun
)->buffer
;
1240 specbind (Qstandard_input
, readcharfun
);
1241 specbind (Qcurrent_load_list
, Qnil
);
1242 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1243 load_convert_to_unibyte
= !NILP (unibyte
);
1245 readchar_backlog
= -1;
1247 GCPRO1 (sourcename
);
1249 LOADHIST_ATTACH (sourcename
);
1251 continue_reading_p
= 1;
1252 while (continue_reading_p
)
1254 if (b
!= 0 && NILP (b
->name
))
1255 error ("Reading from killed buffer");
1261 while ((c
= READCHAR
) != '\n' && c
!= -1);
1266 /* Ignore whitespace here, so we can detect eof. */
1267 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1270 if (!NILP (Vpurify_flag
) && c
== '(')
1272 int count1
= specpdl_ptr
- specpdl
;
1273 record_unwind_protect (unreadpure
, Qnil
);
1274 val
= read_list (-1, readcharfun
);
1275 unbind_to (count1
, Qnil
);
1280 read_objects
= Qnil
;
1281 if (!NILP (readfun
))
1283 val
= call1 (readfun
, readcharfun
);
1285 /* If READCHARFUN has set point to ZV, we should
1286 stop reading, even if the form read sets point
1287 to a different value when evaluated. */
1288 if (BUFFERP (readcharfun
))
1290 struct buffer
*b
= XBUFFER (readcharfun
);
1291 if (BUF_PT (b
) == BUF_ZV (b
))
1292 continue_reading_p
= 0;
1295 else if (! NILP (Vload_read_function
))
1296 val
= call1 (Vload_read_function
, readcharfun
);
1298 val
= read0 (readcharfun
);
1301 val
= (*evalfun
) (val
);
1305 Vvalues
= Fcons (val
, Vvalues
);
1306 if (EQ (Vstandard_output
, Qt
))
1313 build_load_history (stream
, sourcename
);
1316 unbind_to (count
, Qnil
);
1319 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1320 doc
: /* Execute the current buffer as Lisp code.
1321 Programs can pass two arguments, BUFFER and PRINTFLAG.
1322 BUFFER is the buffer to evaluate (nil means use current buffer).
1323 PRINTFLAG controls printing of output:
1324 nil means discard it; anything else is stream for print.
1326 If the optional third argument FILENAME is non-nil,
1327 it specifies the file name to use for `load-history'.
1328 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1329 for this invocation.
1331 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1332 `print' and related functions should work normally even if PRINTFLAG is nil.
1334 This function preserves the position of point. */)
1335 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1336 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1338 int count
= specpdl_ptr
- specpdl
;
1339 Lisp_Object tem
, buf
;
1342 buf
= Fcurrent_buffer ();
1344 buf
= Fget_buffer (buffer
);
1346 error ("No such buffer");
1348 if (NILP (printflag
) && NILP (do_allow_print
))
1353 if (NILP (filename
))
1354 filename
= XBUFFER (buf
)->filename
;
1356 specbind (Qstandard_output
, tem
);
1357 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1358 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1359 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1360 unbind_to (count
, Qnil
);
1365 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1366 doc
: /* Execute the region as Lisp code.
1367 When called from programs, expects two arguments,
1368 giving starting and ending indices in the current buffer
1369 of the text to be executed.
1370 Programs can pass third argument PRINTFLAG which controls output:
1371 nil means discard it; anything else is stream for printing it.
1372 Also the fourth argument READ-FUNCTION, if non-nil, is used
1373 instead of `read' to read each expression. It gets one argument
1374 which is the input stream for reading characters.
1376 This function does not move point. */)
1377 (start
, end
, printflag
, read_function
)
1378 Lisp_Object start
, end
, printflag
, read_function
;
1380 int count
= specpdl_ptr
- specpdl
;
1381 Lisp_Object tem
, cbuf
;
1383 cbuf
= Fcurrent_buffer ();
1385 if (NILP (printflag
))
1389 specbind (Qstandard_output
, tem
);
1391 if (NILP (printflag
))
1392 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1393 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1395 /* This both uses start and checks its type. */
1397 Fnarrow_to_region (make_number (BEGV
), end
);
1398 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1399 !NILP (printflag
), Qnil
, read_function
);
1401 return unbind_to (count
, Qnil
);
1405 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1406 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1407 If STREAM is nil, use the value of `standard-input' (which see).
1408 STREAM or the value of `standard-input' may be:
1409 a buffer (read from point and advance it)
1410 a marker (read from where it points and advance it)
1411 a function (call it with no arguments for each character,
1412 call it with a char as argument to push a char back)
1413 a string (takes text from string, starting at the beginning)
1414 t (read text line using minibuffer and use it, or read from
1415 standard input in batch mode). */)
1419 extern Lisp_Object
Fread_minibuffer ();
1422 stream
= Vstandard_input
;
1423 if (EQ (stream
, Qt
))
1424 stream
= Qread_char
;
1426 readchar_backlog
= -1;
1427 new_backquote_flag
= 0;
1428 read_objects
= Qnil
;
1430 if (EQ (stream
, Qread_char
))
1431 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1433 if (STRINGP (stream
))
1434 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1436 return read0 (stream
);
1439 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1440 doc
: /* Read one Lisp expression which is represented as text by STRING.
1441 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1442 START and END optionally delimit a substring of STRING from which to read;
1443 they default to 0 and (length STRING) respectively. */)
1444 (string
, start
, end
)
1445 Lisp_Object string
, start
, end
;
1447 int startval
, endval
;
1450 CHECK_STRING (string
);
1453 endval
= XSTRING (string
)->size
;
1457 endval
= XINT (end
);
1458 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1459 args_out_of_range (string
, end
);
1466 CHECK_NUMBER (start
);
1467 startval
= XINT (start
);
1468 if (startval
< 0 || startval
> endval
)
1469 args_out_of_range (string
, start
);
1472 read_from_string_index
= startval
;
1473 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1474 read_from_string_limit
= endval
;
1476 new_backquote_flag
= 0;
1477 read_objects
= Qnil
;
1479 tem
= read0 (string
);
1480 return Fcons (tem
, make_number (read_from_string_index
));
1483 /* Use this for recursive reads, in contexts where internal tokens
1488 Lisp_Object readcharfun
;
1490 register Lisp_Object val
;
1493 val
= read1 (readcharfun
, &c
, 0);
1495 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1502 static int read_buffer_size
;
1503 static char *read_buffer
;
1505 /* Read multibyte form and return it as a character. C is a first
1506 byte of multibyte form, and rest of them are read from
1507 READCHARFUN. Store the byte length of the form into *NBYTES. */
1510 read_multibyte (c
, readcharfun
, nbytes
)
1512 Lisp_Object readcharfun
;
1515 /* We need the actual character code of this multibyte
1517 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1519 int bytes
= BYTES_BY_CHAR_HEAD (c
);
1525 if (CHAR_HEAD_P (c
))
1533 if (len
== bytes
&& MULTIBYTE_LENGTH_NO_CHECK (str
) > 0)
1536 return STRING_CHAR (str
, len
);
1538 /* The byte sequence is not valid as multibyte. Unread all bytes
1539 but the first one, and return the first byte. */
1546 /* Read a \-escape sequence, assuming we already read the `\'.
1547 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1548 If the escape sequence forces multibyte and the returned character
1549 is raw 8-bit char, store 2 into *BYTEREP.
1550 If the escape sequence forces multibyte and the returned character
1551 is not raw 8-bit char, store 3 into *BYTEREP.
1552 Otherwise store 0 into *BYTEREP. */
1555 read_escape (readcharfun
, stringp
, byterep
)
1556 Lisp_Object readcharfun
;
1560 register int c
= READCHAR
;
1567 end_of_file_error ();
1597 error ("Invalid escape character syntax");
1600 c
= read_escape (readcharfun
, 0, byterep
);
1601 return c
| meta_modifier
;
1606 error ("Invalid escape character syntax");
1609 c
= read_escape (readcharfun
, 0, byterep
);
1610 return c
| shift_modifier
;
1615 error ("Invalid escape character syntax");
1618 c
= read_escape (readcharfun
, 0, byterep
);
1619 return c
| hyper_modifier
;
1624 error ("Invalid escape character syntax");
1627 c
= read_escape (readcharfun
, 0, byterep
);
1628 return c
| alt_modifier
;
1633 error ("Invalid escape character syntax");
1636 c
= read_escape (readcharfun
, 0, byterep
);
1637 return c
| super_modifier
;
1642 error ("Invalid escape character syntax");
1646 c
= read_escape (readcharfun
, 0, byterep
);
1647 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1648 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1649 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1650 return c
| ctrl_modifier
;
1651 /* ASCII control chars are made from letters (both cases),
1652 as well as the non-letters within 0100...0137. */
1653 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1654 return (c
& (037 | ~0177));
1655 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1656 return (c
& (037 | ~0177));
1658 return c
| ctrl_modifier
;
1668 /* An octal escape, as in ANSI C. */
1670 register int i
= c
- '0';
1671 register int count
= 0;
1674 if ((c
= READCHAR
) >= '0' && c
<= '7')
1694 /* A hex escape, as in ANSI C. */
1701 if (c
>= '0' && c
<= '9')
1706 else if ((c
>= 'a' && c
<= 'f')
1707 || (c
>= 'A' && c
<= 'F'))
1710 if (c
>= 'a' && c
<= 'f')
1723 if (count
< 3 && i
>= 0x80)
1731 if (EQ (readcharfun
, Qget_file_char
)
1732 && BASE_LEADING_CODE_P (c
))
1736 c
= read_multibyte (c
, readcharfun
, &nbytes
);
1745 /* Read an integer in radix RADIX using READCHARFUN to read
1746 characters. RADIX must be in the interval [2..36]; if it isn't, a
1747 read error is signaled . Value is the integer read. Signals an
1748 error if encountering invalid read syntax or if RADIX is out of
1752 read_integer (readcharfun
, radix
)
1753 Lisp_Object readcharfun
;
1756 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1757 EMACS_INT number
= 0;
1759 if (radix
< 2 || radix
> 36)
1763 number
= ndigits
= invalid_p
= 0;
1779 if (c
>= '0' && c
<= '9')
1781 else if (c
>= 'a' && c
<= 'z')
1782 digit
= c
- 'a' + 10;
1783 else if (c
>= 'A' && c
<= 'Z')
1784 digit
= c
- 'A' + 10;
1791 if (digit
< 0 || digit
>= radix
)
1794 number
= radix
* number
+ digit
;
1800 if (ndigits
== 0 || invalid_p
)
1803 sprintf (buf
, "integer, radix %d", radix
);
1804 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1807 return make_number (sign
* number
);
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
!= VECSIZE (struct Lisp_Char_Table
))
1859 error ("Invalid size char-table");
1860 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1871 tmp
= read_vector (readcharfun
, 0);
1872 if (!INTEGERP (AREF (tmp
, 0)))
1873 error ("Invalid depth in char-table");
1874 depth
= XINT (AREF (tmp
, 0));
1875 if (depth
< 1 || depth
> 3)
1876 error ("Invalid depth in char-table");
1877 size
= XVECTOR (tmp
)->size
+ 2;
1878 if (chartab_size
[depth
] != size
)
1879 error ("Invalid size char-table");
1880 XSETSUB_CHAR_TABLE (tmp
, XSUB_CHAR_TABLE (tmp
));
1883 Fsignal (Qinvalid_read_syntax
,
1884 Fcons (make_string ("#^^", 3), Qnil
));
1886 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1891 length
= read1 (readcharfun
, pch
, first_in_list
);
1895 Lisp_Object tmp
, val
;
1896 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1900 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1901 if (size_in_chars
!= XSTRING (tmp
)->size
1902 /* We used to print 1 char too many
1903 when the number of bits was a multiple of 8.
1904 Accept such input in case it came from an old version. */
1905 && ! (XFASTINT (length
)
1906 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1907 Fsignal (Qinvalid_read_syntax
,
1908 Fcons (make_string ("#&...", 5), Qnil
));
1910 val
= Fmake_bool_vector (length
, Qnil
);
1911 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1913 /* Clear the extraneous bits in the last byte. */
1914 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1915 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1916 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1919 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1924 /* Accept compiled functions at read-time so that we don't have to
1925 build them using function calls. */
1927 tmp
= read_vector (readcharfun
, 1);
1928 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1929 XVECTOR (tmp
)->contents
);
1934 struct gcpro gcpro1
;
1937 /* Read the string itself. */
1938 tmp
= read1 (readcharfun
, &ch
, 0);
1939 if (ch
!= 0 || !STRINGP (tmp
))
1940 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1942 /* Read the intervals and their properties. */
1945 Lisp_Object beg
, end
, plist
;
1947 beg
= read1 (readcharfun
, &ch
, 0);
1952 end
= read1 (readcharfun
, &ch
, 0);
1954 plist
= read1 (readcharfun
, &ch
, 0);
1956 Fsignal (Qinvalid_read_syntax
,
1957 Fcons (build_string ("invalid string property list"),
1959 Fset_text_properties (beg
, end
, plist
, tmp
);
1965 /* #@NUMBER is used to skip NUMBER following characters.
1966 That's used in .elc files to skip over doc strings
1967 and function definitions. */
1972 /* Read a decimal integer. */
1973 while ((c
= READCHAR
) >= 0
1974 && c
>= '0' && c
<= '9')
1982 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1984 /* If we are supposed to force doc strings into core right now,
1985 record the last string that we skipped,
1986 and record where in the file it comes from. */
1988 /* But first exchange saved_doc_string
1989 with prev_saved_doc_string, so we save two strings. */
1991 char *temp
= saved_doc_string
;
1992 int temp_size
= saved_doc_string_size
;
1993 file_offset temp_pos
= saved_doc_string_position
;
1994 int temp_len
= saved_doc_string_length
;
1996 saved_doc_string
= prev_saved_doc_string
;
1997 saved_doc_string_size
= prev_saved_doc_string_size
;
1998 saved_doc_string_position
= prev_saved_doc_string_position
;
1999 saved_doc_string_length
= prev_saved_doc_string_length
;
2001 prev_saved_doc_string
= temp
;
2002 prev_saved_doc_string_size
= temp_size
;
2003 prev_saved_doc_string_position
= temp_pos
;
2004 prev_saved_doc_string_length
= temp_len
;
2007 if (saved_doc_string_size
== 0)
2009 saved_doc_string_size
= nskip
+ 100;
2010 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2012 if (nskip
> saved_doc_string_size
)
2014 saved_doc_string_size
= nskip
+ 100;
2015 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2016 saved_doc_string_size
);
2019 saved_doc_string_position
= file_tell (instream
);
2021 /* Copy that many characters into saved_doc_string. */
2022 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2023 saved_doc_string
[i
] = c
= READCHAR
;
2025 saved_doc_string_length
= i
;
2029 /* Skip that many characters. */
2030 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2037 return Vload_file_name
;
2039 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2040 /* #:foo is the uninterned symbol named foo. */
2043 uninterned_symbol
= 1;
2047 /* Reader forms that can reuse previously read objects. */
2048 if (c
>= '0' && c
<= '9')
2053 /* Read a non-negative integer. */
2054 while (c
>= '0' && c
<= '9')
2060 /* #n=object returns object, but associates it with n for #n#. */
2063 /* Make a placeholder for #n# to use temporarily */
2064 Lisp_Object placeholder
;
2067 placeholder
= Fcons(Qnil
, Qnil
);
2068 cell
= Fcons (make_number (n
), placeholder
);
2069 read_objects
= Fcons (cell
, read_objects
);
2071 /* Read the object itself. */
2072 tem
= read0 (readcharfun
);
2074 /* Now put it everywhere the placeholder was... */
2075 substitute_object_in_subtree (tem
, placeholder
);
2077 /* ...and #n# will use the real value from now on. */
2078 Fsetcdr (cell
, tem
);
2082 /* #n# returns a previously read object. */
2085 tem
= Fassq (make_number (n
), read_objects
);
2088 /* Fall through to error message. */
2090 else if (c
== 'r' || c
== 'R')
2091 return read_integer (readcharfun
, n
);
2093 /* Fall through to error message. */
2095 else if (c
== 'x' || c
== 'X')
2096 return read_integer (readcharfun
, 16);
2097 else if (c
== 'o' || c
== 'O')
2098 return read_integer (readcharfun
, 8);
2099 else if (c
== 'b' || c
== 'B')
2100 return read_integer (readcharfun
, 2);
2103 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2106 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2111 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2121 new_backquote_flag
++;
2122 value
= read0 (readcharfun
);
2123 new_backquote_flag
--;
2125 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2129 if (new_backquote_flag
)
2131 Lisp_Object comma_type
= Qnil
;
2136 comma_type
= Qcomma_at
;
2138 comma_type
= Qcomma_dot
;
2141 if (ch
>= 0) UNREAD (ch
);
2142 comma_type
= Qcomma
;
2145 new_backquote_flag
--;
2146 value
= read0 (readcharfun
);
2147 new_backquote_flag
++;
2148 return Fcons (comma_type
, Fcons (value
, Qnil
));
2159 end_of_file_error ();
2162 c
= read_escape (readcharfun
, 0, &discard
);
2163 else if (EQ (readcharfun
, Qget_file_char
)
2164 && BASE_LEADING_CODE_P (c
))
2165 c
= read_multibyte (c
, readcharfun
, &discard
);
2167 return make_number (c
);
2172 char *p
= read_buffer
;
2173 char *end
= read_buffer
+ read_buffer_size
;
2175 /* Nonzero if we saw an escape sequence specifying
2176 a multibyte character. */
2177 int force_multibyte
= 0;
2178 /* Nonzero if we saw an escape sequence specifying
2179 a single-byte character. */
2180 int force_singlebyte
= 0;
2184 while ((c
= READCHAR
) >= 0
2187 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2189 int offset
= p
- read_buffer
;
2190 read_buffer
= (char *) xrealloc (read_buffer
,
2191 read_buffer_size
*= 2);
2192 p
= read_buffer
+ offset
;
2193 end
= read_buffer
+ read_buffer_size
;
2201 c
= read_escape (readcharfun
, 1, &byterep
);
2203 /* C is -1 if \ newline has just been seen */
2206 if (p
== read_buffer
)
2211 modifiers
= c
& CHAR_MODIFIER_MASK
;
2212 c
= c
& ~CHAR_MODIFIER_MASK
;
2216 force_singlebyte
= 1;
2218 /* Raw 8-bit code */
2219 c
= BYTE8_TO_CHAR (c
);
2221 else if (byterep
> 1)
2223 force_multibyte
= 1;
2225 c
= BYTE8_TO_CHAR (c
);
2229 force_singlebyte
= 1;
2230 c
= BYTE8_TO_CHAR (c
);
2233 if (ASCII_CHAR_P (c
))
2235 /* Allow `\C- ' and `\C-?'. */
2236 if (modifiers
== CHAR_CTL
)
2239 c
= 0, modifiers
= 0;
2241 c
= 127, modifiers
= 0;
2243 if (modifiers
& CHAR_SHIFT
)
2245 /* Shift modifier is valid only with [A-Za-z]. */
2246 if (c
>= 'A' && c
<= 'Z')
2247 modifiers
&= ~CHAR_SHIFT
;
2248 else if (c
>= 'a' && c
<= 'z')
2249 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2252 if (modifiers
& CHAR_META
)
2254 /* Move the meta bit to the right place for a
2256 modifiers
&= ~CHAR_META
;
2257 c
= BYTE8_TO_CHAR (c
| 0x80);
2258 force_singlebyte
= 1;
2262 /* Any modifiers remaining are invalid. */
2264 error ("Invalid modifier in string");
2265 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2269 if (EQ (readcharfun
, Qget_file_char
))
2271 if (BASE_LEADING_CODE_P (c
))
2274 c
= read_multibyte (c
, readcharfun
, &nbytes
);
2276 force_multibyte
= 1;
2279 force_singlebyte
= 1;
2280 c
= BYTE8_TO_CHAR (c
);
2285 force_singlebyte
= 1;
2286 c
= BYTE8_TO_CHAR (c
);
2290 force_multibyte
= 1;
2291 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2298 end_of_file_error ();
2300 /* If purifying, and string starts with \ newline,
2301 return zero instead. This is for doc strings
2302 that we are really going to find in etc/DOC.nn.nn */
2303 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2304 return make_number (0);
2306 if (force_multibyte
)
2307 /* READ_BUFFER already contains valid multibyte forms. */
2309 else if (force_singlebyte
)
2311 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2312 p
= read_buffer
+ nchars
;
2315 /* Otherwise, READ_BUFFER contains only ASCII. */
2318 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2320 || (p
- read_buffer
!= nchars
)));
2321 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2323 || (p
- read_buffer
!= nchars
)));
2328 int next_char
= READCHAR
;
2331 if (next_char
<= 040
2332 || index ("\"'`,(", next_char
))
2338 /* Otherwise, we fall through! Note that the atom-reading loop
2339 below will now loop at least once, assuring that we will not
2340 try to UNREAD two characters in a row. */
2344 if (c
<= 040) goto retry
;
2346 char *p
= read_buffer
;
2350 char *end
= read_buffer
+ read_buffer_size
;
2353 && !(c
== '\"' || c
== '\'' || c
== ';'
2354 || c
== '(' || c
== ')'
2355 || c
== '[' || c
== ']' || c
== '#'))
2357 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2359 int offset
= p
- read_buffer
;
2360 read_buffer
= (char *) xrealloc (read_buffer
,
2361 read_buffer_size
*= 2);
2362 p
= read_buffer
+ offset
;
2363 end
= read_buffer
+ read_buffer_size
;
2370 end_of_file_error ();
2374 if (! SINGLE_BYTE_CHAR_P (c
))
2375 p
+= CHAR_STRING (c
, p
);
2384 int offset
= p
- read_buffer
;
2385 read_buffer
= (char *) xrealloc (read_buffer
,
2386 read_buffer_size
*= 2);
2387 p
= read_buffer
+ offset
;
2388 end
= read_buffer
+ read_buffer_size
;
2395 if (!quoted
&& !uninterned_symbol
)
2398 register Lisp_Object val
;
2400 if (*p1
== '+' || *p1
== '-') p1
++;
2401 /* Is it an integer? */
2404 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2405 /* Integers can have trailing decimal points. */
2406 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2408 /* It is an integer. */
2412 if (sizeof (int) == sizeof (EMACS_INT
))
2413 XSETINT (val
, atoi (read_buffer
));
2414 else if (sizeof (long) == sizeof (EMACS_INT
))
2415 XSETINT (val
, atol (read_buffer
));
2421 if (isfloat_string (read_buffer
))
2423 /* Compute NaN and infinities using 0.0 in a variable,
2424 to cope with compilers that think they are smarter
2430 /* Negate the value ourselves. This treats 0, NaNs,
2431 and infinity properly on IEEE floating point hosts,
2432 and works around a common bug where atof ("-0.0")
2434 int negative
= read_buffer
[0] == '-';
2436 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2437 returns 1, is if the input ends in e+INF or e+NaN. */
2444 value
= zero
/ zero
;
2447 value
= atof (read_buffer
+ negative
);
2451 return make_float (negative
? - value
: value
);
2455 if (uninterned_symbol
)
2456 return make_symbol (read_buffer
);
2458 return intern (read_buffer
);
2464 /* List of nodes we've seen during substitute_object_in_subtree. */
2465 static Lisp_Object seen_list
;
2468 substitute_object_in_subtree (object
, placeholder
)
2470 Lisp_Object placeholder
;
2472 Lisp_Object check_object
;
2474 /* We haven't seen any objects when we start. */
2477 /* Make all the substitutions. */
2479 = substitute_object_recurse (object
, placeholder
, object
);
2481 /* Clear seen_list because we're done with it. */
2484 /* The returned object here is expected to always eq the
2486 if (!EQ (check_object
, object
))
2487 error ("Unexpected mutation error in reader");
2490 /* Feval doesn't get called from here, so no gc protection is needed. */
2491 #define SUBSTITUTE(get_val, set_val) \
2493 Lisp_Object old_value = get_val; \
2494 Lisp_Object true_value \
2495 = substitute_object_recurse (object, placeholder,\
2498 if (!EQ (old_value, true_value)) \
2505 substitute_object_recurse (object
, placeholder
, subtree
)
2507 Lisp_Object placeholder
;
2508 Lisp_Object subtree
;
2510 /* If we find the placeholder, return the target object. */
2511 if (EQ (placeholder
, subtree
))
2514 /* If we've been to this node before, don't explore it again. */
2515 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2518 /* If this node can be the entry point to a cycle, remember that
2519 we've seen it. It can only be such an entry point if it was made
2520 by #n=, which means that we can find it as a value in
2522 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2523 seen_list
= Fcons (subtree
, seen_list
);
2525 /* Recurse according to subtree's type.
2526 Every branch must return a Lisp_Object. */
2527 switch (XTYPE (subtree
))
2529 case Lisp_Vectorlike
:
2532 int length
= XINT (Flength(subtree
));
2533 for (i
= 0; i
< length
; i
++)
2535 Lisp_Object idx
= make_number (i
);
2536 SUBSTITUTE (Faref (subtree
, idx
),
2537 Faset (subtree
, idx
, true_value
));
2544 SUBSTITUTE (Fcar_safe (subtree
),
2545 Fsetcar (subtree
, true_value
));
2546 SUBSTITUTE (Fcdr_safe (subtree
),
2547 Fsetcdr (subtree
, true_value
));
2553 /* Check for text properties in each interval.
2554 substitute_in_interval contains part of the logic. */
2556 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2557 Lisp_Object arg
= Fcons (object
, placeholder
);
2559 traverse_intervals_noorder (root_interval
,
2560 &substitute_in_interval
, arg
);
2565 /* Other types don't recurse any further. */
2571 /* Helper function for substitute_object_recurse. */
2573 substitute_in_interval (interval
, arg
)
2577 Lisp_Object object
= Fcar (arg
);
2578 Lisp_Object placeholder
= Fcdr (arg
);
2580 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2599 if (*cp
== '+' || *cp
== '-')
2602 if (*cp
>= '0' && *cp
<= '9')
2605 while (*cp
>= '0' && *cp
<= '9')
2613 if (*cp
>= '0' && *cp
<= '9')
2616 while (*cp
>= '0' && *cp
<= '9')
2619 if (*cp
== 'e' || *cp
== 'E')
2623 if (*cp
== '+' || *cp
== '-')
2627 if (*cp
>= '0' && *cp
<= '9')
2630 while (*cp
>= '0' && *cp
<= '9')
2633 else if (cp
== start
)
2635 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2640 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2646 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2647 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2648 || state
== (DOT_CHAR
|TRAIL_INT
)
2649 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2650 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2651 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2656 read_vector (readcharfun
, bytecodeflag
)
2657 Lisp_Object readcharfun
;
2662 register Lisp_Object
*ptr
;
2663 register Lisp_Object tem
, item
, vector
;
2664 register struct Lisp_Cons
*otem
;
2667 tem
= read_list (1, readcharfun
);
2668 len
= Flength (tem
);
2669 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2671 size
= XVECTOR (vector
)->size
;
2672 ptr
= XVECTOR (vector
)->contents
;
2673 for (i
= 0; i
< size
; i
++)
2676 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2677 bytecode object, the docstring containing the bytecode and
2678 constants values must be treated as unibyte and passed to
2679 Fread, to get the actual bytecode string and constants vector. */
2680 if (bytecodeflag
&& load_force_doc_strings
)
2682 if (i
== COMPILED_BYTECODE
)
2684 if (!STRINGP (item
))
2685 error ("invalid byte code");
2687 /* Delay handling the bytecode slot until we know whether
2688 it is lazily-loaded (we can tell by whether the
2689 constants slot is nil). */
2690 ptr
[COMPILED_CONSTANTS
] = item
;
2693 else if (i
== COMPILED_CONSTANTS
)
2695 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2699 /* Coerce string to unibyte (like string-as-unibyte,
2700 but without generating extra garbage and
2701 guaranteeing no change in the contents). */
2702 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2703 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2705 item
= Fread (bytestr
);
2707 error ("invalid byte code");
2709 otem
= XCONS (item
);
2710 bytestr
= XCAR (item
);
2715 /* Now handle the bytecode slot. */
2716 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2719 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2727 /* FLAG = 1 means check for ] to terminate rather than ) and .
2728 FLAG = -1 means check for starting with defun
2729 and make structure pure. */
2732 read_list (flag
, readcharfun
)
2734 register Lisp_Object readcharfun
;
2736 /* -1 means check next element for defun,
2737 0 means don't check,
2738 1 means already checked and found defun. */
2739 int defunflag
= flag
< 0 ? -1 : 0;
2740 Lisp_Object val
, tail
;
2741 register Lisp_Object elt
, tem
;
2742 struct gcpro gcpro1
, gcpro2
;
2743 /* 0 is the normal case.
2744 1 means this list is a doc reference; replace it with the number 0.
2745 2 means this list is a doc reference; replace it with the doc string. */
2746 int doc_reference
= 0;
2748 /* Initialize this to 1 if we are reading a list. */
2749 int first_in_list
= flag
<= 0;
2758 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2763 /* While building, if the list starts with #$, treat it specially. */
2764 if (EQ (elt
, Vload_file_name
)
2766 && !NILP (Vpurify_flag
))
2768 if (NILP (Vdoc_file_name
))
2769 /* We have not yet called Snarf-documentation, so assume
2770 this file is described in the DOC-MM.NN file
2771 and Snarf-documentation will fill in the right value later.
2772 For now, replace the whole list with 0. */
2775 /* We have already called Snarf-documentation, so make a relative
2776 file name for this file, so it can be found properly
2777 in the installed Lisp directory.
2778 We don't use Fexpand_file_name because that would make
2779 the directory absolute now. */
2780 elt
= concat2 (build_string ("../lisp/"),
2781 Ffile_name_nondirectory (elt
));
2783 else if (EQ (elt
, Vload_file_name
)
2785 && load_force_doc_strings
)
2794 Fsignal (Qinvalid_read_syntax
,
2795 Fcons (make_string (") or . in a vector", 18), Qnil
));
2803 XSETCDR (tail
, read0 (readcharfun
));
2805 val
= read0 (readcharfun
);
2806 read1 (readcharfun
, &ch
, 0);
2810 if (doc_reference
== 1)
2811 return make_number (0);
2812 if (doc_reference
== 2)
2814 /* Get a doc string from the file we are loading.
2815 If it's in saved_doc_string, get it from there. */
2816 int pos
= XINT (XCDR (val
));
2817 /* Position is negative for user variables. */
2818 if (pos
< 0) pos
= -pos
;
2819 if (pos
>= saved_doc_string_position
2820 && pos
< (saved_doc_string_position
2821 + saved_doc_string_length
))
2823 int start
= pos
- saved_doc_string_position
;
2826 /* Process quoting with ^A,
2827 and find the end of the string,
2828 which is marked with ^_ (037). */
2829 for (from
= start
, to
= start
;
2830 saved_doc_string
[from
] != 037;)
2832 int c
= saved_doc_string
[from
++];
2835 c
= saved_doc_string
[from
++];
2837 saved_doc_string
[to
++] = c
;
2839 saved_doc_string
[to
++] = 0;
2841 saved_doc_string
[to
++] = 037;
2844 saved_doc_string
[to
++] = c
;
2847 return make_string (saved_doc_string
+ start
,
2850 /* Look in prev_saved_doc_string the same way. */
2851 else if (pos
>= prev_saved_doc_string_position
2852 && pos
< (prev_saved_doc_string_position
2853 + prev_saved_doc_string_length
))
2855 int start
= pos
- prev_saved_doc_string_position
;
2858 /* Process quoting with ^A,
2859 and find the end of the string,
2860 which is marked with ^_ (037). */
2861 for (from
= start
, to
= start
;
2862 prev_saved_doc_string
[from
] != 037;)
2864 int c
= prev_saved_doc_string
[from
++];
2867 c
= prev_saved_doc_string
[from
++];
2869 prev_saved_doc_string
[to
++] = c
;
2871 prev_saved_doc_string
[to
++] = 0;
2873 prev_saved_doc_string
[to
++] = 037;
2876 prev_saved_doc_string
[to
++] = c
;
2879 return make_string (prev_saved_doc_string
+ start
,
2883 return get_doc_string (val
, 0, 0);
2888 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2890 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2892 tem
= (read_pure
&& flag
<= 0
2893 ? pure_cons (elt
, Qnil
)
2894 : Fcons (elt
, Qnil
));
2896 XSETCDR (tail
, tem
);
2901 defunflag
= EQ (elt
, Qdefun
);
2902 else if (defunflag
> 0)
2907 Lisp_Object Vobarray
;
2908 Lisp_Object initial_obarray
;
2910 /* oblookup stores the bucket number here, for the sake of Funintern. */
2912 int oblookup_last_bucket_number
;
2914 static int hash_string ();
2915 Lisp_Object
oblookup ();
2917 /* Get an error if OBARRAY is not an obarray.
2918 If it is one, return it. */
2921 check_obarray (obarray
)
2922 Lisp_Object obarray
;
2924 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2926 /* If Vobarray is now invalid, force it to be valid. */
2927 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2929 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2934 /* Intern the C string STR: return a symbol with that name,
2935 interned in the current obarray. */
2942 int len
= strlen (str
);
2943 Lisp_Object obarray
;
2946 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2947 obarray
= check_obarray (obarray
);
2948 tem
= oblookup (obarray
, str
, len
, len
);
2951 return Fintern (make_string (str
, len
), obarray
);
2954 /* Create an uninterned symbol with name STR. */
2960 int len
= strlen (str
);
2962 return Fmake_symbol ((!NILP (Vpurify_flag
)
2963 ? make_pure_string (str
, len
, len
, 0)
2964 : make_string (str
, len
)));
2967 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2968 doc
: /* Return the canonical symbol whose name is STRING.
2969 If there is none, one is created by this function and returned.
2970 A second optional argument specifies the obarray to use;
2971 it defaults to the value of `obarray'. */)
2973 Lisp_Object string
, obarray
;
2975 register Lisp_Object tem
, sym
, *ptr
;
2977 if (NILP (obarray
)) obarray
= Vobarray
;
2978 obarray
= check_obarray (obarray
);
2980 CHECK_STRING (string
);
2982 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2983 XSTRING (string
)->size
,
2984 STRING_BYTES (XSTRING (string
)));
2985 if (!INTEGERP (tem
))
2988 if (!NILP (Vpurify_flag
))
2989 string
= Fpurecopy (string
);
2990 sym
= Fmake_symbol (string
);
2992 if (EQ (obarray
, initial_obarray
))
2993 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2995 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2997 if ((XSTRING (string
)->data
[0] == ':')
2998 && EQ (obarray
, initial_obarray
))
3000 XSYMBOL (sym
)->constant
= 1;
3001 XSYMBOL (sym
)->value
= sym
;
3004 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3006 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3008 XSYMBOL (sym
)->next
= 0;
3013 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3014 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3015 NAME may be a string or a symbol. If it is a symbol, that exact
3016 symbol is searched for.
3017 A second optional argument specifies the obarray to use;
3018 it defaults to the value of `obarray'. */)
3020 Lisp_Object name
, obarray
;
3022 register Lisp_Object tem
;
3023 struct Lisp_String
*string
;
3025 if (NILP (obarray
)) obarray
= Vobarray
;
3026 obarray
= check_obarray (obarray
);
3028 if (!SYMBOLP (name
))
3030 CHECK_STRING (name
);
3031 string
= XSTRING (name
);
3034 string
= XSYMBOL (name
)->name
;
3036 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
3037 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3043 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3044 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3045 The value is t if a symbol was found and deleted, nil otherwise.
3046 NAME may be a string or a symbol. If it is a symbol, that symbol
3047 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3048 OBARRAY defaults to the value of the variable `obarray'. */)
3050 Lisp_Object name
, obarray
;
3052 register Lisp_Object string
, tem
;
3055 if (NILP (obarray
)) obarray
= Vobarray
;
3056 obarray
= check_obarray (obarray
);
3059 XSETSTRING (string
, XSYMBOL (name
)->name
);
3062 CHECK_STRING (name
);
3066 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3067 XSTRING (string
)->size
,
3068 STRING_BYTES (XSTRING (string
)));
3071 /* If arg was a symbol, don't delete anything but that symbol itself. */
3072 if (SYMBOLP (name
) && !EQ (name
, tem
))
3075 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3076 XSYMBOL (tem
)->constant
= 0;
3077 XSYMBOL (tem
)->indirect_variable
= 0;
3079 hash
= oblookup_last_bucket_number
;
3081 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3083 if (XSYMBOL (tem
)->next
)
3084 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3086 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3090 Lisp_Object tail
, following
;
3092 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3093 XSYMBOL (tail
)->next
;
3096 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3097 if (EQ (following
, tem
))
3099 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3108 /* Return the symbol in OBARRAY whose names matches the string
3109 of SIZE characters (SIZE_BYTE bytes) at PTR.
3110 If there is no such symbol in OBARRAY, return nil.
3112 Also store the bucket number in oblookup_last_bucket_number. */
3115 oblookup (obarray
, ptr
, size
, size_byte
)
3116 Lisp_Object obarray
;
3118 int size
, size_byte
;
3122 register Lisp_Object tail
;
3123 Lisp_Object bucket
, tem
;
3125 if (!VECTORP (obarray
)
3126 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3128 obarray
= check_obarray (obarray
);
3129 obsize
= XVECTOR (obarray
)->size
;
3131 /* This is sometimes needed in the middle of GC. */
3132 obsize
&= ~ARRAY_MARK_FLAG
;
3133 /* Combining next two lines breaks VMS C 2.3. */
3134 hash
= hash_string (ptr
, size_byte
);
3136 bucket
= XVECTOR (obarray
)->contents
[hash
];
3137 oblookup_last_bucket_number
= hash
;
3138 if (XFASTINT (bucket
) == 0)
3140 else if (!SYMBOLP (bucket
))
3141 error ("Bad data in guts of obarray"); /* Like CADR error message */
3143 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3145 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3146 && XSYMBOL (tail
)->name
->size
== size
3147 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3149 else if (XSYMBOL (tail
)->next
== 0)
3152 XSETINT (tem
, hash
);
3157 hash_string (ptr
, len
)
3161 register unsigned char *p
= ptr
;
3162 register unsigned char *end
= p
+ len
;
3163 register unsigned char c
;
3164 register int hash
= 0;
3169 if (c
>= 0140) c
-= 40;
3170 hash
= ((hash
<<3) + (hash
>>28) + c
);
3172 return hash
& 07777777777;
3176 map_obarray (obarray
, fn
, arg
)
3177 Lisp_Object obarray
;
3178 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3182 register Lisp_Object tail
;
3183 CHECK_VECTOR (obarray
);
3184 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3186 tail
= XVECTOR (obarray
)->contents
[i
];
3191 if (XSYMBOL (tail
)->next
== 0)
3193 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3199 mapatoms_1 (sym
, function
)
3200 Lisp_Object sym
, function
;
3202 call1 (function
, sym
);
3205 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3206 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3207 OBARRAY defaults to the value of `obarray'. */)
3209 Lisp_Object function
, obarray
;
3211 if (NILP (obarray
)) obarray
= Vobarray
;
3212 obarray
= check_obarray (obarray
);
3214 map_obarray (obarray
, mapatoms_1
, function
);
3218 #define OBARRAY_SIZE 1511
3223 Lisp_Object oblength
;
3227 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3229 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3230 Vobarray
= Fmake_vector (oblength
, make_number (0));
3231 initial_obarray
= Vobarray
;
3232 staticpro (&initial_obarray
);
3233 /* Intern nil in the obarray */
3234 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3235 XSYMBOL (Qnil
)->constant
= 1;
3237 /* These locals are to kludge around a pyramid compiler bug. */
3238 hash
= hash_string ("nil", 3);
3239 /* Separate statement here to avoid VAXC bug. */
3240 hash
%= OBARRAY_SIZE
;
3241 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3244 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3245 XSYMBOL (Qnil
)->function
= Qunbound
;
3246 XSYMBOL (Qunbound
)->value
= Qunbound
;
3247 XSYMBOL (Qunbound
)->function
= Qunbound
;
3250 XSYMBOL (Qnil
)->value
= Qnil
;
3251 XSYMBOL (Qnil
)->plist
= Qnil
;
3252 XSYMBOL (Qt
)->value
= Qt
;
3253 XSYMBOL (Qt
)->constant
= 1;
3255 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3258 Qvariable_documentation
= intern ("variable-documentation");
3259 staticpro (&Qvariable_documentation
);
3261 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3262 read_buffer
= (char *) xmalloc (read_buffer_size
);
3267 struct Lisp_Subr
*sname
;
3270 sym
= intern (sname
->symbol_name
);
3271 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3274 #ifdef NOTDEF /* use fset in subr.el now */
3276 defalias (sname
, string
)
3277 struct Lisp_Subr
*sname
;
3281 sym
= intern (string
);
3282 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3286 /* Define an "integer variable"; a symbol whose value is forwarded
3287 to a C variable of type int. Sample call: */
3288 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3290 defvar_int (namestring
, address
)
3294 Lisp_Object sym
, val
;
3295 sym
= intern (namestring
);
3296 val
= allocate_misc ();
3297 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3298 XINTFWD (val
)->intvar
= address
;
3299 SET_SYMBOL_VALUE (sym
, val
);
3302 /* Similar but define a variable whose value is t if address contains 1,
3303 nil if address contains 0 */
3305 defvar_bool (namestring
, address
)
3309 Lisp_Object sym
, val
;
3310 sym
= intern (namestring
);
3311 val
= allocate_misc ();
3312 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3313 XBOOLFWD (val
)->boolvar
= address
;
3314 SET_SYMBOL_VALUE (sym
, val
);
3315 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3318 /* Similar but define a variable whose value is the Lisp Object stored
3319 at address. Two versions: with and without gc-marking of the C
3320 variable. The nopro version is used when that variable will be
3321 gc-marked for some other reason, since marking the same slot twice
3322 can cause trouble with strings. */
3324 defvar_lisp_nopro (namestring
, address
)
3326 Lisp_Object
*address
;
3328 Lisp_Object sym
, val
;
3329 sym
= intern (namestring
);
3330 val
= allocate_misc ();
3331 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3332 XOBJFWD (val
)->objvar
= address
;
3333 SET_SYMBOL_VALUE (sym
, val
);
3337 defvar_lisp (namestring
, address
)
3339 Lisp_Object
*address
;
3341 defvar_lisp_nopro (namestring
, address
);
3342 staticpro (address
);
3345 /* Similar but define a variable whose value is the Lisp Object stored in
3346 the current buffer. address is the address of the slot in the buffer
3347 that is current now. */
3350 defvar_per_buffer (namestring
, address
, type
, doc
)
3352 Lisp_Object
*address
;
3356 Lisp_Object sym
, val
;
3358 extern struct buffer buffer_local_symbols
;
3360 sym
= intern (namestring
);
3361 val
= allocate_misc ();
3362 offset
= (char *)address
- (char *)current_buffer
;
3364 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3365 XBUFFER_OBJFWD (val
)->offset
= offset
;
3366 SET_SYMBOL_VALUE (sym
, val
);
3367 PER_BUFFER_SYMBOL (offset
) = sym
;
3368 PER_BUFFER_TYPE (offset
) = type
;
3370 if (PER_BUFFER_IDX (offset
) == 0)
3371 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3372 slot of buffer_local_flags */
3377 /* Similar but define a variable whose value is the Lisp Object stored
3378 at a particular offset in the current kboard object. */
3381 defvar_kboard (namestring
, offset
)
3385 Lisp_Object sym
, val
;
3386 sym
= intern (namestring
);
3387 val
= allocate_misc ();
3388 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3389 XKBOARD_OBJFWD (val
)->offset
= offset
;
3390 SET_SYMBOL_VALUE (sym
, val
);
3393 /* Record the value of load-path used at the start of dumping
3394 so we can see if the site changed it later during dumping. */
3395 static Lisp_Object dump_path
;
3401 int turn_off_warning
= 0;
3403 /* Compute the default load-path. */
3405 normal
= PATH_LOADSEARCH
;
3406 Vload_path
= decode_env_path (0, normal
);
3408 if (NILP (Vpurify_flag
))
3409 normal
= PATH_LOADSEARCH
;
3411 normal
= PATH_DUMPLOADSEARCH
;
3413 /* In a dumped Emacs, we normally have to reset the value of
3414 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3415 uses ../lisp, instead of the path of the installed elisp
3416 libraries. However, if it appears that Vload_path was changed
3417 from the default before dumping, don't override that value. */
3420 if (! NILP (Fequal (dump_path
, Vload_path
)))
3422 Vload_path
= decode_env_path (0, normal
);
3423 if (!NILP (Vinstallation_directory
))
3425 Lisp_Object tem
, tem1
, sitelisp
;
3427 /* Remove site-lisp dirs from path temporarily and store
3428 them in sitelisp, then conc them on at the end so
3429 they're always first in path. */
3433 tem
= Fcar (Vload_path
);
3434 tem1
= Fstring_match (build_string ("site-lisp"),
3438 Vload_path
= Fcdr (Vload_path
);
3439 sitelisp
= Fcons (tem
, sitelisp
);
3445 /* Add to the path the lisp subdir of the
3446 installation dir, if it exists. */
3447 tem
= Fexpand_file_name (build_string ("lisp"),
3448 Vinstallation_directory
);
3449 tem1
= Ffile_exists_p (tem
);
3452 if (NILP (Fmember (tem
, Vload_path
)))
3454 turn_off_warning
= 1;
3455 Vload_path
= Fcons (tem
, Vload_path
);
3459 /* That dir doesn't exist, so add the build-time
3460 Lisp dirs instead. */
3461 Vload_path
= nconc2 (Vload_path
, dump_path
);
3463 /* Add leim under the installation dir, if it exists. */
3464 tem
= Fexpand_file_name (build_string ("leim"),
3465 Vinstallation_directory
);
3466 tem1
= Ffile_exists_p (tem
);
3469 if (NILP (Fmember (tem
, Vload_path
)))
3470 Vload_path
= Fcons (tem
, Vload_path
);
3473 /* Add site-list under the installation dir, if it exists. */
3474 tem
= Fexpand_file_name (build_string ("site-lisp"),
3475 Vinstallation_directory
);
3476 tem1
= Ffile_exists_p (tem
);
3479 if (NILP (Fmember (tem
, Vload_path
)))
3480 Vload_path
= Fcons (tem
, Vload_path
);
3483 /* If Emacs was not built in the source directory,
3484 and it is run from where it was built, add to load-path
3485 the lisp, leim and site-lisp dirs under that directory. */
3487 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3491 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3492 Vinstallation_directory
);
3493 tem1
= Ffile_exists_p (tem
);
3495 /* Don't be fooled if they moved the entire source tree
3496 AFTER dumping Emacs. If the build directory is indeed
3497 different from the source dir, src/Makefile.in and
3498 src/Makefile will not be found together. */
3499 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3500 Vinstallation_directory
);
3501 tem2
= Ffile_exists_p (tem
);
3502 if (!NILP (tem1
) && NILP (tem2
))
3504 tem
= Fexpand_file_name (build_string ("lisp"),
3507 if (NILP (Fmember (tem
, Vload_path
)))
3508 Vload_path
= Fcons (tem
, Vload_path
);
3510 tem
= Fexpand_file_name (build_string ("leim"),
3513 if (NILP (Fmember (tem
, Vload_path
)))
3514 Vload_path
= Fcons (tem
, Vload_path
);
3516 tem
= Fexpand_file_name (build_string ("site-lisp"),
3519 if (NILP (Fmember (tem
, Vload_path
)))
3520 Vload_path
= Fcons (tem
, Vload_path
);
3523 if (!NILP (sitelisp
))
3524 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3530 /* NORMAL refers to the lisp dir in the source directory. */
3531 /* We used to add ../lisp at the front here, but
3532 that caused trouble because it was copied from dump_path
3533 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3534 It should be unnecessary. */
3535 Vload_path
= decode_env_path (0, normal
);
3536 dump_path
= Vload_path
;
3541 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3542 almost never correct, thereby causing a warning to be printed out that
3543 confuses users. Since PATH_LOADSEARCH is always overridden by the
3544 EMACSLOADPATH environment variable below, disable the warning on NT. */
3546 /* Warn if dirs in the *standard* path don't exist. */
3547 if (!turn_off_warning
)
3549 Lisp_Object path_tail
;
3551 for (path_tail
= Vload_path
;
3553 path_tail
= XCDR (path_tail
))
3555 Lisp_Object dirfile
;
3556 dirfile
= Fcar (path_tail
);
3557 if (STRINGP (dirfile
))
3559 dirfile
= Fdirectory_file_name (dirfile
);
3560 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3561 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3566 #endif /* WINDOWSNT */
3568 /* If the EMACSLOADPATH environment variable is set, use its value.
3569 This doesn't apply if we're dumping. */
3571 if (NILP (Vpurify_flag
)
3572 && egetenv ("EMACSLOADPATH"))
3574 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3578 load_in_progress
= 0;
3579 Vload_file_name
= Qnil
;
3581 load_descriptor_list
= Qnil
;
3583 Vstandard_input
= Qt
;
3584 Vloads_in_progress
= Qnil
;
3587 /* Print a warning, using format string FORMAT, that directory DIRNAME
3588 does not exist. Print it on stderr and put it in *Message*. */
3591 dir_warning (format
, dirname
)
3593 Lisp_Object dirname
;
3596 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3598 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3599 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3600 /* Don't log the warning before we've initialized!! */
3602 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3609 defsubr (&Sread_from_string
);
3611 defsubr (&Sintern_soft
);
3612 defsubr (&Sunintern
);
3614 defsubr (&Seval_buffer
);
3615 defsubr (&Seval_region
);
3616 defsubr (&Sread_char
);
3617 defsubr (&Sread_char_exclusive
);
3618 defsubr (&Sread_event
);
3619 defsubr (&Sget_file_char
);
3620 defsubr (&Smapatoms
);
3622 DEFVAR_LISP ("obarray", &Vobarray
,
3623 doc
: /* Symbol table for use by `intern' and `read'.
3624 It is a vector whose length ought to be prime for best results.
3625 The vector's contents don't make sense if examined from Lisp programs;
3626 to find all the symbols in an obarray, use `mapatoms'. */);
3628 DEFVAR_LISP ("values", &Vvalues
,
3629 doc
: /* List of values of all expressions which were read, evaluated and printed.
3630 Order is reverse chronological. */);
3632 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3633 doc
: /* Stream for read to get input from.
3634 See documentation of `read' for possible values. */);
3635 Vstandard_input
= Qt
;
3637 DEFVAR_LISP ("load-path", &Vload_path
,
3638 doc
: /* *List of directories to search for files to load.
3639 Each element is a string (directory name) or nil (try default directory).
3640 Initialized based on EMACSLOADPATH environment variable, if any,
3641 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3643 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3644 doc
: /* *List of suffixes to try for files to load.
3645 This list should not include the empty string. */);
3646 Vload_suffixes
= Fcons (build_string (".elc"),
3647 Fcons (build_string (".el"), Qnil
));
3648 /* We don't use empty_string because it's not initialized yet. */
3649 default_suffixes
= Fcons (build_string (""), Qnil
);
3650 staticpro (&default_suffixes
);
3652 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3653 doc
: /* Non-nil iff inside of `load'. */);
3655 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3656 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3657 Each element looks like (FILENAME FORMS...).
3658 When `load' is run and the file-name argument is FILENAME,
3659 the FORMS in the corresponding element are executed at the end of loading.
3661 FILENAME must match exactly! Normally FILENAME is the name of a library,
3662 with no directory specified, since that is how `load' is normally called.
3663 An error in FORMS does not undo the load,
3664 but does prevent execution of the rest of the FORMS.
3665 FILENAME can also be a symbol (a feature) and FORMS are then executed
3666 when the corresponding call to `provide' is made. */);
3667 Vafter_load_alist
= Qnil
;
3669 DEFVAR_LISP ("load-history", &Vload_history
,
3670 doc
: /* Alist mapping source file names to symbols and features.
3671 Each alist element is a list that starts with a file name,
3672 except for one element (optional) that starts with nil and describes
3673 definitions evaluated from buffers not visiting files.
3674 The remaining elements of each list are symbols defined as functions
3675 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3676 and `(autoload . SYMBOL)'. */);
3677 Vload_history
= Qnil
;
3679 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3680 doc
: /* Full name of file being loaded by `load'. */);
3681 Vload_file_name
= Qnil
;
3683 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3684 doc
: /* File name, including directory, of user's initialization file.
3685 If the file loaded had extension `.elc' and there was a corresponding `.el'
3686 file, this variable contains the name of the .el file, suitable for use
3687 by functions like `custom-save-all' which edit the init file. */);
3688 Vuser_init_file
= Qnil
;
3690 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3691 doc
: /* Used for internal purposes by `load'. */);
3692 Vcurrent_load_list
= Qnil
;
3694 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3695 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3696 The default is nil, which means use the function `read'. */);
3697 Vload_read_function
= Qnil
;
3699 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3700 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3701 This function is for doing code conversion before reading the source file.
3702 If nil, loading is done without any code conversion.
3703 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3704 FULLNAME is the full name of FILE.
3705 See `load' for the meaning of the remaining arguments. */);
3706 Vload_source_file_function
= Qnil
;
3708 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3709 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3710 This is useful when the file being loaded is a temporary copy. */);
3711 load_force_doc_strings
= 0;
3713 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3714 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3715 This is normally bound by `load' and `eval-buffer' to control `read',
3716 and is not meant for users to change. */);
3717 load_convert_to_unibyte
= 0;
3719 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3720 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3721 You cannot count on them to still be there! */);
3723 = Fexpand_file_name (build_string ("../"),
3724 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3726 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3727 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3728 Vpreloaded_file_list
= Qnil
;
3730 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3731 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3732 Vbyte_boolean_vars
= Qnil
;
3734 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3735 doc
: /* Non-nil means load dangerous compiled Lisp files.
3736 Some versions of XEmacs use different byte codes than Emacs. These
3737 incompatible byte codes can make Emacs crash when it tries to execute
3739 load_dangerous_libraries
= 0;
3741 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3742 doc
: /* Regular expression matching safe to load compiled Lisp files.
3743 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3744 from the file, and matches them against this regular expression.
3745 When the regular expression matches, the file is considered to be safe
3746 to load. See also `load-dangerous-libraries'. */);
3747 Vbytecomp_version_regexp
3748 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3750 /* Vsource_directory was initialized in init_lread. */
3752 load_descriptor_list
= Qnil
;
3753 staticpro (&load_descriptor_list
);
3755 Qcurrent_load_list
= intern ("current-load-list");
3756 staticpro (&Qcurrent_load_list
);
3758 Qstandard_input
= intern ("standard-input");
3759 staticpro (&Qstandard_input
);
3761 Qread_char
= intern ("read-char");
3762 staticpro (&Qread_char
);
3764 Qget_file_char
= intern ("get-file-char");
3765 staticpro (&Qget_file_char
);
3767 Qbackquote
= intern ("`");
3768 staticpro (&Qbackquote
);
3769 Qcomma
= intern (",");
3770 staticpro (&Qcomma
);
3771 Qcomma_at
= intern (",@");
3772 staticpro (&Qcomma_at
);
3773 Qcomma_dot
= intern (",.");
3774 staticpro (&Qcomma_dot
);
3776 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3777 staticpro (&Qinhibit_file_name_operation
);
3779 Qascii_character
= intern ("ascii-character");
3780 staticpro (&Qascii_character
);
3782 Qfunction
= intern ("function");
3783 staticpro (&Qfunction
);
3785 Qload
= intern ("load");
3788 Qload_file_name
= intern ("load-file-name");
3789 staticpro (&Qload_file_name
);
3791 staticpro (&dump_path
);
3793 staticpro (&read_objects
);
3794 read_objects
= Qnil
;
3795 staticpro (&seen_list
);
3797 Vloads_in_progress
= Qnil
;
3798 staticpro (&Vloads_in_progress
);