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 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
946 doc
: /* Search for FILENAME through PATH.
947 If SUFFIXES is non-nil, it should be a list of suffixes to append to
948 file name when searching.
949 If non-nil, PREDICATE is used instead of `file-readable-p'.
950 PREDICATE can also be an integer to pass to the access(2) function,
951 in which case file-name-handlers are ignored. */)
952 (filename
, path
, suffixes
, predicate
)
953 Lisp_Object filename
, path
, suffixes
, predicate
;
956 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
957 if (NILP (predicate
) && fd
> 0)
963 /* Search for a file whose name is STR, looking in directories
964 in the Lisp list PATH, and trying suffixes from SUFFIX.
965 On success, returns a file descriptor. On failure, returns -1.
967 SUFFIXES is a list of strings containing possible suffixes.
968 The empty suffix is automatically added iff the list is empty.
970 PREDICATE non-nil means don't open the files,
971 just look for one that satisfies the predicate. In this case,
972 returns 1 on success. The predicate can be a lisp function or
973 an integer to pass to `access' (in which case file-name-handlers
976 If STOREPTR is nonzero, it points to a slot where the name of
977 the file actually found should be stored as a Lisp string.
978 nil is stored there on failure.
980 If the file we find is remote, return -2
981 but store the found remote file name in *STOREPTR. */
984 openp (path
, str
, suffixes
, storeptr
, predicate
)
985 Lisp_Object path
, str
;
986 Lisp_Object suffixes
;
987 Lisp_Object
*storeptr
;
988 Lisp_Object predicate
;
993 register char *fn
= buf
;
996 Lisp_Object filename
;
998 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
999 Lisp_Object string
, tail
, encoded_fn
;
1000 int max_suffix_len
= 0;
1002 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1004 CHECK_STRING_CAR (tail
);
1005 max_suffix_len
= max (max_suffix_len
,
1006 STRING_BYTES (XSTRING (XCAR (tail
))));
1009 string
= filename
= Qnil
;
1010 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1015 if (complete_filename_p (str
))
1018 for (; CONSP (path
); path
= XCDR (path
))
1020 filename
= Fexpand_file_name (str
, XCAR (path
));
1021 if (!complete_filename_p (filename
))
1022 /* If there are non-absolute elts in PATH (eg ".") */
1023 /* Of course, this could conceivably lose if luser sets
1024 default-directory to be something non-absolute... */
1026 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1027 if (!complete_filename_p (filename
))
1028 /* Give up on this path element! */
1032 /* Calculate maximum size of any filename made from
1033 this path element/specified file name and any possible suffix. */
1034 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1035 if (fn_size
< want_size
)
1036 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1038 /* Loop over suffixes. */
1039 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1040 CONSP (tail
); tail
= XCDR (tail
))
1042 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1043 Lisp_Object handler
;
1046 /* Concatenate path element/specified name with the suffix.
1047 If the directory starts with /:, remove that. */
1048 if (XSTRING (filename
)->size
> 2
1049 && XSTRING (filename
)->data
[0] == '/'
1050 && XSTRING (filename
)->data
[1] == ':')
1052 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1053 STRING_BYTES (XSTRING (filename
)) - 2);
1054 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1058 strncpy (fn
, XSTRING (filename
)->data
,
1059 STRING_BYTES (XSTRING (filename
)));
1060 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1063 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1064 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1066 /* Check that the file exists and is not a directory. */
1067 /* We used to only check for handlers on non-absolute file names:
1071 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1072 It's not clear why that was the case and it breaks things like
1073 (load "/bar.el") where the file is actually "/bar.el.gz". */
1074 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1075 string
= build_string (fn
);
1076 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1078 if (NILP (predicate
))
1079 exists
= !NILP (Ffile_readable_p (string
));
1081 exists
= !NILP (call1 (predicate
, string
));
1082 if (exists
&& !NILP (Ffile_directory_p (string
)))
1087 /* We succeeded; return this descriptor and filename. */
1098 encoded_fn
= ENCODE_FILE (string
);
1099 pfn
= XSTRING (encoded_fn
)->data
;
1100 exists
= (stat (pfn
, &st
) >= 0
1101 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1104 /* Check that we can access or open it. */
1105 if (NATNUMP (predicate
))
1106 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1108 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1112 /* We succeeded; return this descriptor and filename. */
1130 /* Merge the list we've accumulated of globals from the current input source
1131 into the load_history variable. The details depend on whether
1132 the source has an associated file name or not. */
1135 build_load_history (stream
, source
)
1139 register Lisp_Object tail
, prev
, newelt
;
1140 register Lisp_Object tem
, tem2
;
1141 register int foundit
, loading
;
1143 loading
= stream
|| !NARROWED
;
1145 tail
= Vload_history
;
1148 while (CONSP (tail
))
1152 /* Find the feature's previous assoc list... */
1153 if (!NILP (Fequal (source
, Fcar (tem
))))
1157 /* If we're loading, remove it. */
1161 Vload_history
= XCDR (tail
);
1163 Fsetcdr (prev
, XCDR (tail
));
1166 /* Otherwise, cons on new symbols that are not already members. */
1169 tem2
= Vcurrent_load_list
;
1171 while (CONSP (tem2
))
1173 newelt
= XCAR (tem2
);
1175 if (NILP (Fmemq (newelt
, tem
)))
1176 Fsetcar (tail
, Fcons (XCAR (tem
),
1177 Fcons (newelt
, XCDR (tem
))));
1190 /* If we're loading, cons the new assoc onto the front of load-history,
1191 the most-recently-loaded position. Also do this if we didn't find
1192 an existing member for the current source. */
1193 if (loading
|| !foundit
)
1194 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1199 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1207 readevalloop_1 (old
)
1210 load_convert_to_unibyte
= ! NILP (old
);
1214 /* Signal an `end-of-file' error, if possible with file name
1218 end_of_file_error ()
1222 if (STRINGP (Vload_file_name
))
1223 data
= Fcons (Vload_file_name
, Qnil
);
1227 Fsignal (Qend_of_file
, data
);
1230 /* UNIBYTE specifies how to set load_convert_to_unibyte
1231 for this invocation.
1232 READFUN, if non-nil, is used instead of `read'. */
1235 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1236 Lisp_Object readcharfun
;
1238 Lisp_Object sourcename
;
1239 Lisp_Object (*evalfun
) ();
1241 Lisp_Object unibyte
, readfun
;
1244 register Lisp_Object val
;
1245 int count
= specpdl_ptr
- specpdl
;
1246 struct gcpro gcpro1
;
1247 struct buffer
*b
= 0;
1248 int continue_reading_p
;
1250 if (BUFFERP (readcharfun
))
1251 b
= XBUFFER (readcharfun
);
1252 else if (MARKERP (readcharfun
))
1253 b
= XMARKER (readcharfun
)->buffer
;
1255 specbind (Qstandard_input
, readcharfun
);
1256 specbind (Qcurrent_load_list
, Qnil
);
1257 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1258 load_convert_to_unibyte
= !NILP (unibyte
);
1260 readchar_backlog
= -1;
1262 GCPRO1 (sourcename
);
1264 LOADHIST_ATTACH (sourcename
);
1266 continue_reading_p
= 1;
1267 while (continue_reading_p
)
1269 if (b
!= 0 && NILP (b
->name
))
1270 error ("Reading from killed buffer");
1276 while ((c
= READCHAR
) != '\n' && c
!= -1);
1281 /* Ignore whitespace here, so we can detect eof. */
1282 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1285 if (!NILP (Vpurify_flag
) && c
== '(')
1287 int count1
= specpdl_ptr
- specpdl
;
1288 record_unwind_protect (unreadpure
, Qnil
);
1289 val
= read_list (-1, readcharfun
);
1290 unbind_to (count1
, Qnil
);
1295 read_objects
= Qnil
;
1296 if (!NILP (readfun
))
1298 val
= call1 (readfun
, readcharfun
);
1300 /* If READCHARFUN has set point to ZV, we should
1301 stop reading, even if the form read sets point
1302 to a different value when evaluated. */
1303 if (BUFFERP (readcharfun
))
1305 struct buffer
*b
= XBUFFER (readcharfun
);
1306 if (BUF_PT (b
) == BUF_ZV (b
))
1307 continue_reading_p
= 0;
1310 else if (! NILP (Vload_read_function
))
1311 val
= call1 (Vload_read_function
, readcharfun
);
1313 val
= read0 (readcharfun
);
1316 val
= (*evalfun
) (val
);
1320 Vvalues
= Fcons (val
, Vvalues
);
1321 if (EQ (Vstandard_output
, Qt
))
1328 build_load_history (stream
, sourcename
);
1331 unbind_to (count
, Qnil
);
1334 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1335 doc
: /* Execute the current buffer as Lisp code.
1336 Programs can pass two arguments, BUFFER and PRINTFLAG.
1337 BUFFER is the buffer to evaluate (nil means use current buffer).
1338 PRINTFLAG controls printing of output:
1339 nil means discard it; anything else is stream for print.
1341 If the optional third argument FILENAME is non-nil,
1342 it specifies the file name to use for `load-history'.
1343 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1344 for this invocation.
1346 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1347 `print' and related functions should work normally even if PRINTFLAG is nil.
1349 This function preserves the position of point. */)
1350 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1351 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1353 int count
= specpdl_ptr
- specpdl
;
1354 Lisp_Object tem
, buf
;
1357 buf
= Fcurrent_buffer ();
1359 buf
= Fget_buffer (buffer
);
1361 error ("No such buffer");
1363 if (NILP (printflag
) && NILP (do_allow_print
))
1368 if (NILP (filename
))
1369 filename
= XBUFFER (buf
)->filename
;
1371 specbind (Qstandard_output
, tem
);
1372 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1373 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1374 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1375 unbind_to (count
, Qnil
);
1380 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1381 doc
: /* Execute the region as Lisp code.
1382 When called from programs, expects two arguments,
1383 giving starting and ending indices in the current buffer
1384 of the text to be executed.
1385 Programs can pass third argument PRINTFLAG which controls output:
1386 nil means discard it; anything else is stream for printing it.
1387 Also the fourth argument READ-FUNCTION, if non-nil, is used
1388 instead of `read' to read each expression. It gets one argument
1389 which is the input stream for reading characters.
1391 This function does not move point. */)
1392 (start
, end
, printflag
, read_function
)
1393 Lisp_Object start
, end
, printflag
, read_function
;
1395 int count
= specpdl_ptr
- specpdl
;
1396 Lisp_Object tem
, cbuf
;
1398 cbuf
= Fcurrent_buffer ();
1400 if (NILP (printflag
))
1404 specbind (Qstandard_output
, tem
);
1406 if (NILP (printflag
))
1407 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1408 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1410 /* This both uses start and checks its type. */
1412 Fnarrow_to_region (make_number (BEGV
), end
);
1413 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1414 !NILP (printflag
), Qnil
, read_function
);
1416 return unbind_to (count
, Qnil
);
1420 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1421 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1422 If STREAM is nil, use the value of `standard-input' (which see).
1423 STREAM or the value of `standard-input' may be:
1424 a buffer (read from point and advance it)
1425 a marker (read from where it points and advance it)
1426 a function (call it with no arguments for each character,
1427 call it with a char as argument to push a char back)
1428 a string (takes text from string, starting at the beginning)
1429 t (read text line using minibuffer and use it, or read from
1430 standard input in batch mode). */)
1434 extern Lisp_Object
Fread_minibuffer ();
1437 stream
= Vstandard_input
;
1438 if (EQ (stream
, Qt
))
1439 stream
= Qread_char
;
1441 readchar_backlog
= -1;
1442 new_backquote_flag
= 0;
1443 read_objects
= Qnil
;
1445 if (EQ (stream
, Qread_char
))
1446 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1448 if (STRINGP (stream
))
1449 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1451 return read0 (stream
);
1454 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1455 doc
: /* Read one Lisp expression which is represented as text by STRING.
1456 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1457 START and END optionally delimit a substring of STRING from which to read;
1458 they default to 0 and (length STRING) respectively. */)
1459 (string
, start
, end
)
1460 Lisp_Object string
, start
, end
;
1462 int startval
, endval
;
1465 CHECK_STRING (string
);
1468 endval
= XSTRING (string
)->size
;
1472 endval
= XINT (end
);
1473 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1474 args_out_of_range (string
, end
);
1481 CHECK_NUMBER (start
);
1482 startval
= XINT (start
);
1483 if (startval
< 0 || startval
> endval
)
1484 args_out_of_range (string
, start
);
1487 read_from_string_index
= startval
;
1488 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1489 read_from_string_limit
= endval
;
1491 new_backquote_flag
= 0;
1492 read_objects
= Qnil
;
1494 tem
= read0 (string
);
1495 return Fcons (tem
, make_number (read_from_string_index
));
1498 /* Use this for recursive reads, in contexts where internal tokens
1503 Lisp_Object readcharfun
;
1505 register Lisp_Object val
;
1508 val
= read1 (readcharfun
, &c
, 0);
1510 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1517 static int read_buffer_size
;
1518 static char *read_buffer
;
1520 /* Read multibyte form and return it as a character. C is a first
1521 byte of multibyte form, and rest of them are read from
1525 read_multibyte (c
, readcharfun
)
1527 Lisp_Object readcharfun
;
1529 /* We need the actual character code of this multibyte
1531 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1536 while ((c
= READCHAR
) >= 0xA0
1537 && len
< MAX_MULTIBYTE_LENGTH
)
1540 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1541 return STRING_CHAR (str
, len
);
1542 /* The byte sequence is not valid as multibyte. Unread all bytes
1543 but the first one, and return the first byte. */
1549 /* Read a \-escape sequence, assuming we already read the `\'.
1550 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1551 If the escape sequence forces multibyte, store 2 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')
1691 /* A hex escape, as in ANSI C. */
1697 if (c
>= '0' && c
<= '9')
1702 else if ((c
>= 'a' && c
<= 'f')
1703 || (c
>= 'A' && c
<= 'F'))
1706 if (c
>= 'a' && c
<= 'f')
1723 if (BASE_LEADING_CODE_P (c
))
1724 c
= read_multibyte (c
, readcharfun
);
1730 /* Read an integer in radix RADIX using READCHARFUN to read
1731 characters. RADIX must be in the interval [2..36]; if it isn't, a
1732 read error is signaled . Value is the integer read. Signals an
1733 error if encountering invalid read syntax or if RADIX is out of
1737 read_integer (readcharfun
, radix
)
1738 Lisp_Object readcharfun
;
1741 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1742 EMACS_INT number
= 0;
1744 if (radix
< 2 || radix
> 36)
1748 number
= ndigits
= invalid_p
= 0;
1764 if (c
>= '0' && c
<= '9')
1766 else if (c
>= 'a' && c
<= 'z')
1767 digit
= c
- 'a' + 10;
1768 else if (c
>= 'A' && c
<= 'Z')
1769 digit
= c
- 'A' + 10;
1776 if (digit
< 0 || digit
>= radix
)
1779 number
= radix
* number
+ digit
;
1785 if (ndigits
== 0 || invalid_p
)
1788 sprintf (buf
, "integer, radix %d", radix
);
1789 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1792 return make_number (sign
* number
);
1796 /* Convert unibyte text in read_buffer to multibyte.
1798 Initially, *P is a pointer after the end of the unibyte text, and
1799 the pointer *END points after the end of read_buffer.
1801 If read_buffer doesn't have enough room to hold the result
1802 of the conversion, reallocate it and adjust *P and *END.
1804 At the end, make *P point after the result of the conversion, and
1805 return in *NCHARS the number of characters in the converted
1809 to_multibyte (p
, end
, nchars
)
1815 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1816 if (read_buffer_size
< 2 * nbytes
)
1818 int offset
= *p
- read_buffer
;
1819 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1820 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1821 *p
= read_buffer
+ offset
;
1822 *end
= read_buffer
+ read_buffer_size
;
1825 if (nbytes
!= *nchars
)
1826 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1827 *p
- read_buffer
, nchars
);
1829 *p
= read_buffer
+ nbytes
;
1833 /* If the next token is ')' or ']' or '.', we store that character
1834 in *PCH and the return value is not interesting. Else, we store
1835 zero in *PCH and we read and return one lisp object.
1837 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1840 read1 (readcharfun
, pch
, first_in_list
)
1841 register Lisp_Object readcharfun
;
1846 int uninterned_symbol
= 0;
1854 end_of_file_error ();
1859 return read_list (0, readcharfun
);
1862 return read_vector (readcharfun
, 0);
1879 tmp
= read_vector (readcharfun
, 0);
1880 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1881 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1882 error ("Invalid size char-table");
1883 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1884 XCHAR_TABLE (tmp
)->top
= Qt
;
1893 tmp
= read_vector (readcharfun
, 0);
1894 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1895 error ("Invalid size char-table");
1896 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1897 XCHAR_TABLE (tmp
)->top
= Qnil
;
1900 Fsignal (Qinvalid_read_syntax
,
1901 Fcons (make_string ("#^^", 3), Qnil
));
1903 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1908 length
= read1 (readcharfun
, pch
, first_in_list
);
1912 Lisp_Object tmp
, val
;
1913 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1917 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1918 if (size_in_chars
!= XSTRING (tmp
)->size
1919 /* We used to print 1 char too many
1920 when the number of bits was a multiple of 8.
1921 Accept such input in case it came from an old version. */
1922 && ! (XFASTINT (length
)
1923 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1924 Fsignal (Qinvalid_read_syntax
,
1925 Fcons (make_string ("#&...", 5), Qnil
));
1927 val
= Fmake_bool_vector (length
, Qnil
);
1928 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1930 /* Clear the extraneous bits in the last byte. */
1931 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1932 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1933 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1936 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1941 /* Accept compiled functions at read-time so that we don't have to
1942 build them using function calls. */
1944 tmp
= read_vector (readcharfun
, 1);
1945 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1946 XVECTOR (tmp
)->contents
);
1951 struct gcpro gcpro1
;
1954 /* Read the string itself. */
1955 tmp
= read1 (readcharfun
, &ch
, 0);
1956 if (ch
!= 0 || !STRINGP (tmp
))
1957 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1959 /* Read the intervals and their properties. */
1962 Lisp_Object beg
, end
, plist
;
1964 beg
= read1 (readcharfun
, &ch
, 0);
1969 end
= read1 (readcharfun
, &ch
, 0);
1971 plist
= read1 (readcharfun
, &ch
, 0);
1973 Fsignal (Qinvalid_read_syntax
,
1974 Fcons (build_string ("invalid string property list"),
1976 Fset_text_properties (beg
, end
, plist
, tmp
);
1982 /* #@NUMBER is used to skip NUMBER following characters.
1983 That's used in .elc files to skip over doc strings
1984 and function definitions. */
1989 /* Read a decimal integer. */
1990 while ((c
= READCHAR
) >= 0
1991 && c
>= '0' && c
<= '9')
1999 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2001 /* If we are supposed to force doc strings into core right now,
2002 record the last string that we skipped,
2003 and record where in the file it comes from. */
2005 /* But first exchange saved_doc_string
2006 with prev_saved_doc_string, so we save two strings. */
2008 char *temp
= saved_doc_string
;
2009 int temp_size
= saved_doc_string_size
;
2010 file_offset temp_pos
= saved_doc_string_position
;
2011 int temp_len
= saved_doc_string_length
;
2013 saved_doc_string
= prev_saved_doc_string
;
2014 saved_doc_string_size
= prev_saved_doc_string_size
;
2015 saved_doc_string_position
= prev_saved_doc_string_position
;
2016 saved_doc_string_length
= prev_saved_doc_string_length
;
2018 prev_saved_doc_string
= temp
;
2019 prev_saved_doc_string_size
= temp_size
;
2020 prev_saved_doc_string_position
= temp_pos
;
2021 prev_saved_doc_string_length
= temp_len
;
2024 if (saved_doc_string_size
== 0)
2026 saved_doc_string_size
= nskip
+ 100;
2027 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2029 if (nskip
> saved_doc_string_size
)
2031 saved_doc_string_size
= nskip
+ 100;
2032 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2033 saved_doc_string_size
);
2036 saved_doc_string_position
= file_tell (instream
);
2038 /* Copy that many characters into saved_doc_string. */
2039 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2040 saved_doc_string
[i
] = c
= READCHAR
;
2042 saved_doc_string_length
= i
;
2046 /* Skip that many characters. */
2047 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2054 return Vload_file_name
;
2056 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2057 /* #:foo is the uninterned symbol named foo. */
2060 uninterned_symbol
= 1;
2064 /* Reader forms that can reuse previously read objects. */
2065 if (c
>= '0' && c
<= '9')
2070 /* Read a non-negative integer. */
2071 while (c
>= '0' && c
<= '9')
2077 /* #n=object returns object, but associates it with n for #n#. */
2080 /* Make a placeholder for #n# to use temporarily */
2081 Lisp_Object placeholder
;
2084 placeholder
= Fcons(Qnil
, Qnil
);
2085 cell
= Fcons (make_number (n
), placeholder
);
2086 read_objects
= Fcons (cell
, read_objects
);
2088 /* Read the object itself. */
2089 tem
= read0 (readcharfun
);
2091 /* Now put it everywhere the placeholder was... */
2092 substitute_object_in_subtree (tem
, placeholder
);
2094 /* ...and #n# will use the real value from now on. */
2095 Fsetcdr (cell
, tem
);
2099 /* #n# returns a previously read object. */
2102 tem
= Fassq (make_number (n
), read_objects
);
2105 /* Fall through to error message. */
2107 else if (c
== 'r' || c
== 'R')
2108 return read_integer (readcharfun
, n
);
2110 /* Fall through to error message. */
2112 else if (c
== 'x' || c
== 'X')
2113 return read_integer (readcharfun
, 16);
2114 else if (c
== 'o' || c
== 'O')
2115 return read_integer (readcharfun
, 8);
2116 else if (c
== 'b' || c
== 'B')
2117 return read_integer (readcharfun
, 2);
2120 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2123 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2128 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2138 new_backquote_flag
++;
2139 value
= read0 (readcharfun
);
2140 new_backquote_flag
--;
2142 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2146 if (new_backquote_flag
)
2148 Lisp_Object comma_type
= Qnil
;
2153 comma_type
= Qcomma_at
;
2155 comma_type
= Qcomma_dot
;
2158 if (ch
>= 0) UNREAD (ch
);
2159 comma_type
= Qcomma
;
2162 new_backquote_flag
--;
2163 value
= read0 (readcharfun
);
2164 new_backquote_flag
++;
2165 return Fcons (comma_type
, Fcons (value
, Qnil
));
2176 end_of_file_error ();
2179 c
= read_escape (readcharfun
, 0, &discard
);
2180 else if (BASE_LEADING_CODE_P (c
))
2181 c
= read_multibyte (c
, readcharfun
);
2183 return make_number (c
);
2188 char *p
= read_buffer
;
2189 char *end
= read_buffer
+ read_buffer_size
;
2191 /* 1 if we saw an escape sequence specifying
2192 a multibyte character, or a multibyte character. */
2193 int force_multibyte
= 0;
2194 /* 1 if we saw an escape sequence specifying
2195 a single-byte character. */
2196 int force_singlebyte
= 0;
2197 /* 1 if read_buffer contains multibyte text now. */
2198 int is_multibyte
= 0;
2202 while ((c
= READCHAR
) >= 0
2205 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2207 int offset
= p
- read_buffer
;
2208 read_buffer
= (char *) xrealloc (read_buffer
,
2209 read_buffer_size
*= 2);
2210 p
= read_buffer
+ offset
;
2211 end
= read_buffer
+ read_buffer_size
;
2218 c
= read_escape (readcharfun
, 1, &byterep
);
2220 /* C is -1 if \ newline has just been seen */
2223 if (p
== read_buffer
)
2229 force_singlebyte
= 1;
2230 else if (byterep
== 2)
2231 force_multibyte
= 1;
2234 /* A character that must be multibyte forces multibyte. */
2235 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2236 force_multibyte
= 1;
2238 /* If we just discovered the need to be multibyte,
2239 convert the text accumulated thus far. */
2240 if (force_multibyte
&& ! is_multibyte
)
2243 to_multibyte (&p
, &end
, &nchars
);
2246 /* Allow `\C- ' and `\C-?'. */
2247 if (c
== (CHAR_CTL
| ' '))
2249 else if (c
== (CHAR_CTL
| '?'))
2254 /* Shift modifier is valid only with [A-Za-z]. */
2255 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2257 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2258 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2262 /* Move the meta bit to the right place for a string. */
2263 c
= (c
& ~CHAR_META
) | 0x80;
2264 if (c
& CHAR_MODIFIER_MASK
)
2265 error ("Invalid modifier in string");
2268 p
+= CHAR_STRING (c
, p
);
2276 end_of_file_error ();
2278 /* If purifying, and string starts with \ newline,
2279 return zero instead. This is for doc strings
2280 that we are really going to find in etc/DOC.nn.nn */
2281 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2282 return make_number (0);
2284 if (is_multibyte
|| force_singlebyte
)
2286 else if (load_convert_to_unibyte
)
2289 to_multibyte (&p
, &end
, &nchars
);
2290 if (p
- read_buffer
!= nchars
)
2292 string
= make_multibyte_string (read_buffer
, nchars
,
2294 return Fstring_make_unibyte (string
);
2296 /* We can make a unibyte string directly. */
2299 else if (EQ (readcharfun
, Qget_file_char
)
2300 || EQ (readcharfun
, Qlambda
))
2302 /* Nowadays, reading directly from a file is used only for
2303 compiled Emacs Lisp files, and those always use the
2304 Emacs internal encoding. Meanwhile, Qlambda is used
2305 for reading dynamic byte code (compiled with
2306 byte-compile-dynamic = t). So make the string multibyte
2307 if the string contains any multibyte sequences.
2308 (to_multibyte is a no-op if not.) */
2309 to_multibyte (&p
, &end
, &nchars
);
2310 is_multibyte
= (p
- read_buffer
) != nchars
;
2313 /* In all other cases, if we read these bytes as
2314 separate characters, treat them as separate characters now. */
2318 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2320 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2326 int next_char
= READCHAR
;
2329 if (next_char
<= 040
2330 || index ("\"'`,(", next_char
))
2336 /* Otherwise, we fall through! Note that the atom-reading loop
2337 below will now loop at least once, assuring that we will not
2338 try to UNREAD two characters in a row. */
2342 if (c
<= 040) goto retry
;
2344 char *p
= read_buffer
;
2348 char *end
= read_buffer
+ read_buffer_size
;
2351 && !(c
== '\"' || c
== '\'' || c
== ';'
2352 || c
== '(' || c
== ')'
2353 || c
== '[' || c
== ']' || c
== '#'))
2355 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2357 int offset
= p
- read_buffer
;
2358 read_buffer
= (char *) xrealloc (read_buffer
,
2359 read_buffer_size
*= 2);
2360 p
= read_buffer
+ offset
;
2361 end
= read_buffer
+ read_buffer_size
;
2368 end_of_file_error ();
2372 if (! SINGLE_BYTE_CHAR_P (c
))
2373 p
+= CHAR_STRING (c
, p
);
2382 int offset
= p
- read_buffer
;
2383 read_buffer
= (char *) xrealloc (read_buffer
,
2384 read_buffer_size
*= 2);
2385 p
= read_buffer
+ offset
;
2386 end
= read_buffer
+ read_buffer_size
;
2393 if (!quoted
&& !uninterned_symbol
)
2396 register Lisp_Object val
;
2398 if (*p1
== '+' || *p1
== '-') p1
++;
2399 /* Is it an integer? */
2402 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2403 /* Integers can have trailing decimal points. */
2404 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2406 /* It is an integer. */
2410 if (sizeof (int) == sizeof (EMACS_INT
))
2411 XSETINT (val
, atoi (read_buffer
));
2412 else if (sizeof (long) == sizeof (EMACS_INT
))
2413 XSETINT (val
, atol (read_buffer
));
2419 if (isfloat_string (read_buffer
))
2421 /* Compute NaN and infinities using 0.0 in a variable,
2422 to cope with compilers that think they are smarter
2428 /* Negate the value ourselves. This treats 0, NaNs,
2429 and infinity properly on IEEE floating point hosts,
2430 and works around a common bug where atof ("-0.0")
2432 int negative
= read_buffer
[0] == '-';
2434 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2435 returns 1, is if the input ends in e+INF or e+NaN. */
2442 value
= zero
/ zero
;
2445 value
= atof (read_buffer
+ negative
);
2449 return make_float (negative
? - value
: value
);
2453 if (uninterned_symbol
)
2454 return make_symbol (read_buffer
);
2456 return intern (read_buffer
);
2462 /* List of nodes we've seen during substitute_object_in_subtree. */
2463 static Lisp_Object seen_list
;
2466 substitute_object_in_subtree (object
, placeholder
)
2468 Lisp_Object placeholder
;
2470 Lisp_Object check_object
;
2472 /* We haven't seen any objects when we start. */
2475 /* Make all the substitutions. */
2477 = substitute_object_recurse (object
, placeholder
, object
);
2479 /* Clear seen_list because we're done with it. */
2482 /* The returned object here is expected to always eq the
2484 if (!EQ (check_object
, object
))
2485 error ("Unexpected mutation error in reader");
2488 /* Feval doesn't get called from here, so no gc protection is needed. */
2489 #define SUBSTITUTE(get_val, set_val) \
2491 Lisp_Object old_value = get_val; \
2492 Lisp_Object true_value \
2493 = substitute_object_recurse (object, placeholder,\
2496 if (!EQ (old_value, true_value)) \
2503 substitute_object_recurse (object
, placeholder
, subtree
)
2505 Lisp_Object placeholder
;
2506 Lisp_Object subtree
;
2508 /* If we find the placeholder, return the target object. */
2509 if (EQ (placeholder
, subtree
))
2512 /* If we've been to this node before, don't explore it again. */
2513 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2516 /* If this node can be the entry point to a cycle, remember that
2517 we've seen it. It can only be such an entry point if it was made
2518 by #n=, which means that we can find it as a value in
2520 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2521 seen_list
= Fcons (subtree
, seen_list
);
2523 /* Recurse according to subtree's type.
2524 Every branch must return a Lisp_Object. */
2525 switch (XTYPE (subtree
))
2527 case Lisp_Vectorlike
:
2530 int length
= XINT (Flength(subtree
));
2531 for (i
= 0; i
< length
; i
++)
2533 Lisp_Object idx
= make_number (i
);
2534 SUBSTITUTE (Faref (subtree
, idx
),
2535 Faset (subtree
, idx
, true_value
));
2542 SUBSTITUTE (Fcar_safe (subtree
),
2543 Fsetcar (subtree
, true_value
));
2544 SUBSTITUTE (Fcdr_safe (subtree
),
2545 Fsetcdr (subtree
, true_value
));
2551 /* Check for text properties in each interval.
2552 substitute_in_interval contains part of the logic. */
2554 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2555 Lisp_Object arg
= Fcons (object
, placeholder
);
2557 traverse_intervals_noorder (root_interval
,
2558 &substitute_in_interval
, arg
);
2563 /* Other types don't recurse any further. */
2569 /* Helper function for substitute_object_recurse. */
2571 substitute_in_interval (interval
, arg
)
2575 Lisp_Object object
= Fcar (arg
);
2576 Lisp_Object placeholder
= Fcdr (arg
);
2578 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2597 if (*cp
== '+' || *cp
== '-')
2600 if (*cp
>= '0' && *cp
<= '9')
2603 while (*cp
>= '0' && *cp
<= '9')
2611 if (*cp
>= '0' && *cp
<= '9')
2614 while (*cp
>= '0' && *cp
<= '9')
2617 if (*cp
== 'e' || *cp
== 'E')
2621 if (*cp
== '+' || *cp
== '-')
2625 if (*cp
>= '0' && *cp
<= '9')
2628 while (*cp
>= '0' && *cp
<= '9')
2631 else if (cp
== start
)
2633 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2638 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2644 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2645 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2646 || state
== (DOT_CHAR
|TRAIL_INT
)
2647 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2648 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2649 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2654 read_vector (readcharfun
, bytecodeflag
)
2655 Lisp_Object readcharfun
;
2660 register Lisp_Object
*ptr
;
2661 register Lisp_Object tem
, item
, vector
;
2662 register struct Lisp_Cons
*otem
;
2665 tem
= read_list (1, readcharfun
);
2666 len
= Flength (tem
);
2667 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2669 size
= XVECTOR (vector
)->size
;
2670 ptr
= XVECTOR (vector
)->contents
;
2671 for (i
= 0; i
< size
; i
++)
2674 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2675 bytecode object, the docstring containing the bytecode and
2676 constants values must be treated as unibyte and passed to
2677 Fread, to get the actual bytecode string and constants vector. */
2678 if (bytecodeflag
&& load_force_doc_strings
)
2680 if (i
== COMPILED_BYTECODE
)
2682 if (!STRINGP (item
))
2683 error ("invalid byte code");
2685 /* Delay handling the bytecode slot until we know whether
2686 it is lazily-loaded (we can tell by whether the
2687 constants slot is nil). */
2688 ptr
[COMPILED_CONSTANTS
] = item
;
2691 else if (i
== COMPILED_CONSTANTS
)
2693 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2697 /* Coerce string to unibyte (like string-as-unibyte,
2698 but without generating extra garbage and
2699 guaranteeing no change in the contents). */
2700 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2701 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2703 item
= Fread (bytestr
);
2705 error ("invalid byte code");
2707 otem
= XCONS (item
);
2708 bytestr
= XCAR (item
);
2713 /* Now handle the bytecode slot. */
2714 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2717 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2725 /* FLAG = 1 means check for ] to terminate rather than ) and .
2726 FLAG = -1 means check for starting with defun
2727 and make structure pure. */
2730 read_list (flag
, readcharfun
)
2732 register Lisp_Object readcharfun
;
2734 /* -1 means check next element for defun,
2735 0 means don't check,
2736 1 means already checked and found defun. */
2737 int defunflag
= flag
< 0 ? -1 : 0;
2738 Lisp_Object val
, tail
;
2739 register Lisp_Object elt
, tem
;
2740 struct gcpro gcpro1
, gcpro2
;
2741 /* 0 is the normal case.
2742 1 means this list is a doc reference; replace it with the number 0.
2743 2 means this list is a doc reference; replace it with the doc string. */
2744 int doc_reference
= 0;
2746 /* Initialize this to 1 if we are reading a list. */
2747 int first_in_list
= flag
<= 0;
2756 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2761 /* While building, if the list starts with #$, treat it specially. */
2762 if (EQ (elt
, Vload_file_name
)
2764 && !NILP (Vpurify_flag
))
2766 if (NILP (Vdoc_file_name
))
2767 /* We have not yet called Snarf-documentation, so assume
2768 this file is described in the DOC-MM.NN file
2769 and Snarf-documentation will fill in the right value later.
2770 For now, replace the whole list with 0. */
2773 /* We have already called Snarf-documentation, so make a relative
2774 file name for this file, so it can be found properly
2775 in the installed Lisp directory.
2776 We don't use Fexpand_file_name because that would make
2777 the directory absolute now. */
2778 elt
= concat2 (build_string ("../lisp/"),
2779 Ffile_name_nondirectory (elt
));
2781 else if (EQ (elt
, Vload_file_name
)
2783 && load_force_doc_strings
)
2792 Fsignal (Qinvalid_read_syntax
,
2793 Fcons (make_string (") or . in a vector", 18), Qnil
));
2801 XSETCDR (tail
, read0 (readcharfun
));
2803 val
= read0 (readcharfun
);
2804 read1 (readcharfun
, &ch
, 0);
2808 if (doc_reference
== 1)
2809 return make_number (0);
2810 if (doc_reference
== 2)
2812 /* Get a doc string from the file we are loading.
2813 If it's in saved_doc_string, get it from there. */
2814 int pos
= XINT (XCDR (val
));
2815 /* Position is negative for user variables. */
2816 if (pos
< 0) pos
= -pos
;
2817 if (pos
>= saved_doc_string_position
2818 && pos
< (saved_doc_string_position
2819 + saved_doc_string_length
))
2821 int start
= pos
- saved_doc_string_position
;
2824 /* Process quoting with ^A,
2825 and find the end of the string,
2826 which is marked with ^_ (037). */
2827 for (from
= start
, to
= start
;
2828 saved_doc_string
[from
] != 037;)
2830 int c
= saved_doc_string
[from
++];
2833 c
= saved_doc_string
[from
++];
2835 saved_doc_string
[to
++] = c
;
2837 saved_doc_string
[to
++] = 0;
2839 saved_doc_string
[to
++] = 037;
2842 saved_doc_string
[to
++] = c
;
2845 return make_string (saved_doc_string
+ start
,
2848 /* Look in prev_saved_doc_string the same way. */
2849 else if (pos
>= prev_saved_doc_string_position
2850 && pos
< (prev_saved_doc_string_position
2851 + prev_saved_doc_string_length
))
2853 int start
= pos
- prev_saved_doc_string_position
;
2856 /* Process quoting with ^A,
2857 and find the end of the string,
2858 which is marked with ^_ (037). */
2859 for (from
= start
, to
= start
;
2860 prev_saved_doc_string
[from
] != 037;)
2862 int c
= prev_saved_doc_string
[from
++];
2865 c
= prev_saved_doc_string
[from
++];
2867 prev_saved_doc_string
[to
++] = c
;
2869 prev_saved_doc_string
[to
++] = 0;
2871 prev_saved_doc_string
[to
++] = 037;
2874 prev_saved_doc_string
[to
++] = c
;
2877 return make_string (prev_saved_doc_string
+ start
,
2881 return get_doc_string (val
, 0, 0);
2886 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2888 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2890 tem
= (read_pure
&& flag
<= 0
2891 ? pure_cons (elt
, Qnil
)
2892 : Fcons (elt
, Qnil
));
2894 XSETCDR (tail
, tem
);
2899 defunflag
= EQ (elt
, Qdefun
);
2900 else if (defunflag
> 0)
2905 Lisp_Object Vobarray
;
2906 Lisp_Object initial_obarray
;
2908 /* oblookup stores the bucket number here, for the sake of Funintern. */
2910 int oblookup_last_bucket_number
;
2912 static int hash_string ();
2913 Lisp_Object
oblookup ();
2915 /* Get an error if OBARRAY is not an obarray.
2916 If it is one, return it. */
2919 check_obarray (obarray
)
2920 Lisp_Object obarray
;
2922 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2924 /* If Vobarray is now invalid, force it to be valid. */
2925 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2927 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2932 /* Intern the C string STR: return a symbol with that name,
2933 interned in the current obarray. */
2940 int len
= strlen (str
);
2941 Lisp_Object obarray
;
2944 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2945 obarray
= check_obarray (obarray
);
2946 tem
= oblookup (obarray
, str
, len
, len
);
2949 return Fintern (make_string (str
, len
), obarray
);
2952 /* Create an uninterned symbol with name STR. */
2958 int len
= strlen (str
);
2960 return Fmake_symbol ((!NILP (Vpurify_flag
)
2961 ? make_pure_string (str
, len
, len
, 0)
2962 : make_string (str
, len
)));
2965 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2966 doc
: /* Return the canonical symbol whose name is STRING.
2967 If there is none, one is created by this function and returned.
2968 A second optional argument specifies the obarray to use;
2969 it defaults to the value of `obarray'. */)
2971 Lisp_Object string
, obarray
;
2973 register Lisp_Object tem
, sym
, *ptr
;
2975 if (NILP (obarray
)) obarray
= Vobarray
;
2976 obarray
= check_obarray (obarray
);
2978 CHECK_STRING (string
);
2980 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2981 XSTRING (string
)->size
,
2982 STRING_BYTES (XSTRING (string
)));
2983 if (!INTEGERP (tem
))
2986 if (!NILP (Vpurify_flag
))
2987 string
= Fpurecopy (string
);
2988 sym
= Fmake_symbol (string
);
2990 if (EQ (obarray
, initial_obarray
))
2991 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2993 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2995 if ((XSTRING (string
)->data
[0] == ':')
2996 && EQ (obarray
, initial_obarray
))
2998 XSYMBOL (sym
)->constant
= 1;
2999 XSYMBOL (sym
)->value
= sym
;
3002 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3004 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3006 XSYMBOL (sym
)->next
= 0;
3011 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3012 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3013 NAME may be a string or a symbol. If it is a symbol, that exact
3014 symbol is searched for.
3015 A second optional argument specifies the obarray to use;
3016 it defaults to the value of `obarray'. */)
3018 Lisp_Object name
, obarray
;
3020 register Lisp_Object tem
;
3021 struct Lisp_String
*string
;
3023 if (NILP (obarray
)) obarray
= Vobarray
;
3024 obarray
= check_obarray (obarray
);
3026 if (!SYMBOLP (name
))
3028 CHECK_STRING (name
);
3029 string
= XSTRING (name
);
3032 string
= XSYMBOL (name
)->name
;
3034 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
3035 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3041 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3042 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3043 The value is t if a symbol was found and deleted, nil otherwise.
3044 NAME may be a string or a symbol. If it is a symbol, that symbol
3045 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3046 OBARRAY defaults to the value of the variable `obarray'. */)
3048 Lisp_Object name
, obarray
;
3050 register Lisp_Object string
, tem
;
3053 if (NILP (obarray
)) obarray
= Vobarray
;
3054 obarray
= check_obarray (obarray
);
3057 XSETSTRING (string
, XSYMBOL (name
)->name
);
3060 CHECK_STRING (name
);
3064 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3065 XSTRING (string
)->size
,
3066 STRING_BYTES (XSTRING (string
)));
3069 /* If arg was a symbol, don't delete anything but that symbol itself. */
3070 if (SYMBOLP (name
) && !EQ (name
, tem
))
3073 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3074 XSYMBOL (tem
)->constant
= 0;
3075 XSYMBOL (tem
)->indirect_variable
= 0;
3077 hash
= oblookup_last_bucket_number
;
3079 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3081 if (XSYMBOL (tem
)->next
)
3082 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3084 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3088 Lisp_Object tail
, following
;
3090 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3091 XSYMBOL (tail
)->next
;
3094 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3095 if (EQ (following
, tem
))
3097 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3106 /* Return the symbol in OBARRAY whose names matches the string
3107 of SIZE characters (SIZE_BYTE bytes) at PTR.
3108 If there is no such symbol in OBARRAY, return nil.
3110 Also store the bucket number in oblookup_last_bucket_number. */
3113 oblookup (obarray
, ptr
, size
, size_byte
)
3114 Lisp_Object obarray
;
3116 int size
, size_byte
;
3120 register Lisp_Object tail
;
3121 Lisp_Object bucket
, tem
;
3123 if (!VECTORP (obarray
)
3124 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3126 obarray
= check_obarray (obarray
);
3127 obsize
= XVECTOR (obarray
)->size
;
3129 /* This is sometimes needed in the middle of GC. */
3130 obsize
&= ~ARRAY_MARK_FLAG
;
3131 /* Combining next two lines breaks VMS C 2.3. */
3132 hash
= hash_string (ptr
, size_byte
);
3134 bucket
= XVECTOR (obarray
)->contents
[hash
];
3135 oblookup_last_bucket_number
= hash
;
3136 if (XFASTINT (bucket
) == 0)
3138 else if (!SYMBOLP (bucket
))
3139 error ("Bad data in guts of obarray"); /* Like CADR error message */
3141 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3143 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3144 && XSYMBOL (tail
)->name
->size
== size
3145 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3147 else if (XSYMBOL (tail
)->next
== 0)
3150 XSETINT (tem
, hash
);
3155 hash_string (ptr
, len
)
3159 register unsigned char *p
= ptr
;
3160 register unsigned char *end
= p
+ len
;
3161 register unsigned char c
;
3162 register int hash
= 0;
3167 if (c
>= 0140) c
-= 40;
3168 hash
= ((hash
<<3) + (hash
>>28) + c
);
3170 return hash
& 07777777777;
3174 map_obarray (obarray
, fn
, arg
)
3175 Lisp_Object obarray
;
3176 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3180 register Lisp_Object tail
;
3181 CHECK_VECTOR (obarray
);
3182 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3184 tail
= XVECTOR (obarray
)->contents
[i
];
3189 if (XSYMBOL (tail
)->next
== 0)
3191 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3197 mapatoms_1 (sym
, function
)
3198 Lisp_Object sym
, function
;
3200 call1 (function
, sym
);
3203 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3204 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3205 OBARRAY defaults to the value of `obarray'. */)
3207 Lisp_Object function
, obarray
;
3209 if (NILP (obarray
)) obarray
= Vobarray
;
3210 obarray
= check_obarray (obarray
);
3212 map_obarray (obarray
, mapatoms_1
, function
);
3216 #define OBARRAY_SIZE 1511
3221 Lisp_Object oblength
;
3225 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3227 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3228 Vobarray
= Fmake_vector (oblength
, make_number (0));
3229 initial_obarray
= Vobarray
;
3230 staticpro (&initial_obarray
);
3231 /* Intern nil in the obarray */
3232 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3233 XSYMBOL (Qnil
)->constant
= 1;
3235 /* These locals are to kludge around a pyramid compiler bug. */
3236 hash
= hash_string ("nil", 3);
3237 /* Separate statement here to avoid VAXC bug. */
3238 hash
%= OBARRAY_SIZE
;
3239 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3242 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3243 XSYMBOL (Qnil
)->function
= Qunbound
;
3244 XSYMBOL (Qunbound
)->value
= Qunbound
;
3245 XSYMBOL (Qunbound
)->function
= Qunbound
;
3248 XSYMBOL (Qnil
)->value
= Qnil
;
3249 XSYMBOL (Qnil
)->plist
= Qnil
;
3250 XSYMBOL (Qt
)->value
= Qt
;
3251 XSYMBOL (Qt
)->constant
= 1;
3253 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3256 Qvariable_documentation
= intern ("variable-documentation");
3257 staticpro (&Qvariable_documentation
);
3259 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3260 read_buffer
= (char *) xmalloc (read_buffer_size
);
3265 struct Lisp_Subr
*sname
;
3268 sym
= intern (sname
->symbol_name
);
3269 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3272 #ifdef NOTDEF /* use fset in subr.el now */
3274 defalias (sname
, string
)
3275 struct Lisp_Subr
*sname
;
3279 sym
= intern (string
);
3280 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3284 /* Define an "integer variable"; a symbol whose value is forwarded
3285 to a C variable of type int. Sample call: */
3286 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3288 defvar_int (namestring
, address
)
3292 Lisp_Object sym
, val
;
3293 sym
= intern (namestring
);
3294 val
= allocate_misc ();
3295 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3296 XINTFWD (val
)->intvar
= address
;
3297 SET_SYMBOL_VALUE (sym
, val
);
3300 /* Similar but define a variable whose value is t if address contains 1,
3301 nil if address contains 0 */
3303 defvar_bool (namestring
, address
)
3307 Lisp_Object sym
, val
;
3308 sym
= intern (namestring
);
3309 val
= allocate_misc ();
3310 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3311 XBOOLFWD (val
)->boolvar
= address
;
3312 SET_SYMBOL_VALUE (sym
, val
);
3313 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3316 /* Similar but define a variable whose value is the Lisp Object stored
3317 at address. Two versions: with and without gc-marking of the C
3318 variable. The nopro version is used when that variable will be
3319 gc-marked for some other reason, since marking the same slot twice
3320 can cause trouble with strings. */
3322 defvar_lisp_nopro (namestring
, address
)
3324 Lisp_Object
*address
;
3326 Lisp_Object sym
, val
;
3327 sym
= intern (namestring
);
3328 val
= allocate_misc ();
3329 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3330 XOBJFWD (val
)->objvar
= address
;
3331 SET_SYMBOL_VALUE (sym
, val
);
3335 defvar_lisp (namestring
, address
)
3337 Lisp_Object
*address
;
3339 defvar_lisp_nopro (namestring
, address
);
3340 staticpro (address
);
3343 /* Similar but define a variable whose value is the Lisp Object stored in
3344 the current buffer. address is the address of the slot in the buffer
3345 that is current now. */
3348 defvar_per_buffer (namestring
, address
, type
, doc
)
3350 Lisp_Object
*address
;
3354 Lisp_Object sym
, val
;
3356 extern struct buffer buffer_local_symbols
;
3358 sym
= intern (namestring
);
3359 val
= allocate_misc ();
3360 offset
= (char *)address
- (char *)current_buffer
;
3362 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3363 XBUFFER_OBJFWD (val
)->offset
= offset
;
3364 SET_SYMBOL_VALUE (sym
, val
);
3365 PER_BUFFER_SYMBOL (offset
) = sym
;
3366 PER_BUFFER_TYPE (offset
) = type
;
3368 if (PER_BUFFER_IDX (offset
) == 0)
3369 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3370 slot of buffer_local_flags */
3375 /* Similar but define a variable whose value is the Lisp Object stored
3376 at a particular offset in the current kboard object. */
3379 defvar_kboard (namestring
, offset
)
3383 Lisp_Object sym
, val
;
3384 sym
= intern (namestring
);
3385 val
= allocate_misc ();
3386 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3387 XKBOARD_OBJFWD (val
)->offset
= offset
;
3388 SET_SYMBOL_VALUE (sym
, val
);
3391 /* Record the value of load-path used at the start of dumping
3392 so we can see if the site changed it later during dumping. */
3393 static Lisp_Object dump_path
;
3399 int turn_off_warning
= 0;
3401 /* Compute the default load-path. */
3403 normal
= PATH_LOADSEARCH
;
3404 Vload_path
= decode_env_path (0, normal
);
3406 if (NILP (Vpurify_flag
))
3407 normal
= PATH_LOADSEARCH
;
3409 normal
= PATH_DUMPLOADSEARCH
;
3411 /* In a dumped Emacs, we normally have to reset the value of
3412 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3413 uses ../lisp, instead of the path of the installed elisp
3414 libraries. However, if it appears that Vload_path was changed
3415 from the default before dumping, don't override that value. */
3418 if (! NILP (Fequal (dump_path
, Vload_path
)))
3420 Vload_path
= decode_env_path (0, normal
);
3421 if (!NILP (Vinstallation_directory
))
3423 Lisp_Object tem
, tem1
, sitelisp
;
3425 /* Remove site-lisp dirs from path temporarily and store
3426 them in sitelisp, then conc them on at the end so
3427 they're always first in path. */
3431 tem
= Fcar (Vload_path
);
3432 tem1
= Fstring_match (build_string ("site-lisp"),
3436 Vload_path
= Fcdr (Vload_path
);
3437 sitelisp
= Fcons (tem
, sitelisp
);
3443 /* Add to the path the lisp subdir of the
3444 installation dir, if it exists. */
3445 tem
= Fexpand_file_name (build_string ("lisp"),
3446 Vinstallation_directory
);
3447 tem1
= Ffile_exists_p (tem
);
3450 if (NILP (Fmember (tem
, Vload_path
)))
3452 turn_off_warning
= 1;
3453 Vload_path
= Fcons (tem
, Vload_path
);
3457 /* That dir doesn't exist, so add the build-time
3458 Lisp dirs instead. */
3459 Vload_path
= nconc2 (Vload_path
, dump_path
);
3461 /* Add leim under the installation dir, if it exists. */
3462 tem
= Fexpand_file_name (build_string ("leim"),
3463 Vinstallation_directory
);
3464 tem1
= Ffile_exists_p (tem
);
3467 if (NILP (Fmember (tem
, Vload_path
)))
3468 Vload_path
= Fcons (tem
, Vload_path
);
3471 /* Add site-list under the installation dir, if it exists. */
3472 tem
= Fexpand_file_name (build_string ("site-lisp"),
3473 Vinstallation_directory
);
3474 tem1
= Ffile_exists_p (tem
);
3477 if (NILP (Fmember (tem
, Vload_path
)))
3478 Vload_path
= Fcons (tem
, Vload_path
);
3481 /* If Emacs was not built in the source directory,
3482 and it is run from where it was built, add to load-path
3483 the lisp, leim and site-lisp dirs under that directory. */
3485 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3489 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3490 Vinstallation_directory
);
3491 tem1
= Ffile_exists_p (tem
);
3493 /* Don't be fooled if they moved the entire source tree
3494 AFTER dumping Emacs. If the build directory is indeed
3495 different from the source dir, src/Makefile.in and
3496 src/Makefile will not be found together. */
3497 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3498 Vinstallation_directory
);
3499 tem2
= Ffile_exists_p (tem
);
3500 if (!NILP (tem1
) && NILP (tem2
))
3502 tem
= Fexpand_file_name (build_string ("lisp"),
3505 if (NILP (Fmember (tem
, Vload_path
)))
3506 Vload_path
= Fcons (tem
, Vload_path
);
3508 tem
= Fexpand_file_name (build_string ("leim"),
3511 if (NILP (Fmember (tem
, Vload_path
)))
3512 Vload_path
= Fcons (tem
, Vload_path
);
3514 tem
= Fexpand_file_name (build_string ("site-lisp"),
3517 if (NILP (Fmember (tem
, Vload_path
)))
3518 Vload_path
= Fcons (tem
, Vload_path
);
3521 if (!NILP (sitelisp
))
3522 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3528 /* NORMAL refers to the lisp dir in the source directory. */
3529 /* We used to add ../lisp at the front here, but
3530 that caused trouble because it was copied from dump_path
3531 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3532 It should be unnecessary. */
3533 Vload_path
= decode_env_path (0, normal
);
3534 dump_path
= Vload_path
;
3539 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3540 almost never correct, thereby causing a warning to be printed out that
3541 confuses users. Since PATH_LOADSEARCH is always overridden by the
3542 EMACSLOADPATH environment variable below, disable the warning on NT. */
3544 /* Warn if dirs in the *standard* path don't exist. */
3545 if (!turn_off_warning
)
3547 Lisp_Object path_tail
;
3549 for (path_tail
= Vload_path
;
3551 path_tail
= XCDR (path_tail
))
3553 Lisp_Object dirfile
;
3554 dirfile
= Fcar (path_tail
);
3555 if (STRINGP (dirfile
))
3557 dirfile
= Fdirectory_file_name (dirfile
);
3558 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3559 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3564 #endif /* WINDOWSNT */
3566 /* If the EMACSLOADPATH environment variable is set, use its value.
3567 This doesn't apply if we're dumping. */
3569 if (NILP (Vpurify_flag
)
3570 && egetenv ("EMACSLOADPATH"))
3572 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3576 load_in_progress
= 0;
3577 Vload_file_name
= Qnil
;
3579 load_descriptor_list
= Qnil
;
3581 Vstandard_input
= Qt
;
3582 Vloads_in_progress
= Qnil
;
3585 /* Print a warning, using format string FORMAT, that directory DIRNAME
3586 does not exist. Print it on stderr and put it in *Message*. */
3589 dir_warning (format
, dirname
)
3591 Lisp_Object dirname
;
3594 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3596 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3597 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3598 /* Don't log the warning before we've initialized!! */
3600 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3607 defsubr (&Sread_from_string
);
3609 defsubr (&Sintern_soft
);
3610 defsubr (&Sunintern
);
3612 defsubr (&Seval_buffer
);
3613 defsubr (&Seval_region
);
3614 defsubr (&Sread_char
);
3615 defsubr (&Sread_char_exclusive
);
3616 defsubr (&Sread_event
);
3617 defsubr (&Sget_file_char
);
3618 defsubr (&Smapatoms
);
3619 defsubr (&Slocate_file_internal
);
3621 DEFVAR_LISP ("obarray", &Vobarray
,
3622 doc
: /* Symbol table for use by `intern' and `read'.
3623 It is a vector whose length ought to be prime for best results.
3624 The vector's contents don't make sense if examined from Lisp programs;
3625 to find all the symbols in an obarray, use `mapatoms'. */);
3627 DEFVAR_LISP ("values", &Vvalues
,
3628 doc
: /* List of values of all expressions which were read, evaluated and printed.
3629 Order is reverse chronological. */);
3631 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3632 doc
: /* Stream for read to get input from.
3633 See documentation of `read' for possible values. */);
3634 Vstandard_input
= Qt
;
3636 DEFVAR_LISP ("load-path", &Vload_path
,
3637 doc
: /* *List of directories to search for files to load.
3638 Each element is a string (directory name) or nil (try default directory).
3639 Initialized based on EMACSLOADPATH environment variable, if any,
3640 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3642 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3643 doc
: /* *List of suffixes to try for files to load.
3644 This list should not include the empty string. */);
3645 Vload_suffixes
= Fcons (build_string (".elc"),
3646 Fcons (build_string (".el"), Qnil
));
3647 /* We don't use empty_string because it's not initialized yet. */
3648 default_suffixes
= Fcons (build_string (""), Qnil
);
3649 staticpro (&default_suffixes
);
3651 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3652 doc
: /* Non-nil iff inside of `load'. */);
3654 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3655 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3656 Each element looks like (FILENAME FORMS...).
3657 When `load' is run and the file-name argument is FILENAME,
3658 the FORMS in the corresponding element are executed at the end of loading.
3660 FILENAME must match exactly! Normally FILENAME is the name of a library,
3661 with no directory specified, since that is how `load' is normally called.
3662 An error in FORMS does not undo the load,
3663 but does prevent execution of the rest of the FORMS.
3664 FILENAME can also be a symbol (a feature) and FORMS are then executed
3665 when the corresponding call to `provide' is made. */);
3666 Vafter_load_alist
= Qnil
;
3668 DEFVAR_LISP ("load-history", &Vload_history
,
3669 doc
: /* Alist mapping source file names to symbols and features.
3670 Each alist element is a list that starts with a file name,
3671 except for one element (optional) that starts with nil and describes
3672 definitions evaluated from buffers not visiting files.
3673 The remaining elements of each list are symbols defined as functions
3674 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3675 and `(autoload . SYMBOL)'. */);
3676 Vload_history
= Qnil
;
3678 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3679 doc
: /* Full name of file being loaded by `load'. */);
3680 Vload_file_name
= Qnil
;
3682 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3683 doc
: /* File name, including directory, of user's initialization file.
3684 If the file loaded had extension `.elc' and there was a corresponding `.el'
3685 file, this variable contains the name of the .el file, suitable for use
3686 by functions like `custom-save-all' which edit the init file. */);
3687 Vuser_init_file
= Qnil
;
3689 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3690 doc
: /* Used for internal purposes by `load'. */);
3691 Vcurrent_load_list
= Qnil
;
3693 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3694 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3695 The default is nil, which means use the function `read'. */);
3696 Vload_read_function
= Qnil
;
3698 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3699 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3700 This function is for doing code conversion before reading the source file.
3701 If nil, loading is done without any code conversion.
3702 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3703 FULLNAME is the full name of FILE.
3704 See `load' for the meaning of the remaining arguments. */);
3705 Vload_source_file_function
= Qnil
;
3707 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3708 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3709 This is useful when the file being loaded is a temporary copy. */);
3710 load_force_doc_strings
= 0;
3712 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3713 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3714 This is normally bound by `load' and `eval-buffer' to control `read',
3715 and is not meant for users to change. */);
3716 load_convert_to_unibyte
= 0;
3718 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3719 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3720 You cannot count on them to still be there! */);
3722 = Fexpand_file_name (build_string ("../"),
3723 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3725 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3726 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3727 Vpreloaded_file_list
= Qnil
;
3729 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3730 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3731 Vbyte_boolean_vars
= Qnil
;
3733 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3734 doc
: /* Non-nil means load dangerous compiled Lisp files.
3735 Some versions of XEmacs use different byte codes than Emacs. These
3736 incompatible byte codes can make Emacs crash when it tries to execute
3738 load_dangerous_libraries
= 0;
3740 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3741 doc
: /* Regular expression matching safe to load compiled Lisp files.
3742 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3743 from the file, and matches them against this regular expression.
3744 When the regular expression matches, the file is considered to be safe
3745 to load. See also `load-dangerous-libraries'. */);
3746 Vbytecomp_version_regexp
3747 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3749 /* Vsource_directory was initialized in init_lread. */
3751 load_descriptor_list
= Qnil
;
3752 staticpro (&load_descriptor_list
);
3754 Qcurrent_load_list
= intern ("current-load-list");
3755 staticpro (&Qcurrent_load_list
);
3757 Qstandard_input
= intern ("standard-input");
3758 staticpro (&Qstandard_input
);
3760 Qread_char
= intern ("read-char");
3761 staticpro (&Qread_char
);
3763 Qget_file_char
= intern ("get-file-char");
3764 staticpro (&Qget_file_char
);
3766 Qbackquote
= intern ("`");
3767 staticpro (&Qbackquote
);
3768 Qcomma
= intern (",");
3769 staticpro (&Qcomma
);
3770 Qcomma_at
= intern (",@");
3771 staticpro (&Qcomma_at
);
3772 Qcomma_dot
= intern (",.");
3773 staticpro (&Qcomma_dot
);
3775 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3776 staticpro (&Qinhibit_file_name_operation
);
3778 Qascii_character
= intern ("ascii-character");
3779 staticpro (&Qascii_character
);
3781 Qfunction
= intern ("function");
3782 staticpro (&Qfunction
);
3784 Qload
= intern ("load");
3787 Qload_file_name
= intern ("load-file-name");
3788 staticpro (&Qload_file_name
);
3790 staticpro (&dump_path
);
3792 staticpro (&read_objects
);
3793 read_objects
= Qnil
;
3794 staticpro (&seen_list
);
3796 Vloads_in_progress
= Qnil
;
3797 staticpro (&Vloads_in_progress
);