1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
36 #include "termhooks.h"
39 #include <sys/inode.h>
44 #include <unistd.h> /* to get X_OK */
61 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
79 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
80 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
81 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
82 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
83 Lisp_Object Qinhibit_file_name_operation
;
85 extern Lisp_Object Qevent_symbol_element_mask
;
86 extern Lisp_Object Qfile_exists_p
;
88 /* non-zero if inside `load' */
91 /* Directory in which the sources were found. */
92 Lisp_Object Vsource_directory
;
94 /* Search path and suffixes for files to be loaded. */
95 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
97 /* File name of user's init file. */
98 Lisp_Object Vuser_init_file
;
100 /* This is the user-visible association list that maps features to
101 lists of defs in their load files. */
102 Lisp_Object Vload_history
;
104 /* This is used to build the load history. */
105 Lisp_Object Vcurrent_load_list
;
107 /* List of files that were preloaded. */
108 Lisp_Object Vpreloaded_file_list
;
110 /* Name of file actually being read by `load'. */
111 Lisp_Object Vload_file_name
;
113 /* Function to use for reading, in `load' and friends. */
114 Lisp_Object Vload_read_function
;
116 /* The association list of objects read with the #n=object form.
117 Each member of the list has the form (n . object), and is used to
118 look up the object for the corresponding #n# construct.
119 It must be set to nil before all top-level calls to read0. */
120 Lisp_Object read_objects
;
122 /* Nonzero means load should forcibly load all dynamic doc strings. */
123 static int load_force_doc_strings
;
125 /* Nonzero means read should convert strings to unibyte. */
126 static int load_convert_to_unibyte
;
128 /* Function to use for loading an Emacs lisp source file (not
129 compiled) instead of readevalloop. */
130 Lisp_Object Vload_source_file_function
;
132 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
133 Lisp_Object Vbyte_boolean_vars
;
135 /* List of descriptors now open for Fload. */
136 static Lisp_Object load_descriptor_list
;
138 /* File for get_file_char to read from. Use by load. */
139 static FILE *instream
;
141 /* When nonzero, read conses in pure space */
142 static int read_pure
;
144 /* For use within read-from-string (this reader is non-reentrant!!) */
145 static int read_from_string_index
;
146 static int read_from_string_index_byte
;
147 static int read_from_string_limit
;
149 /* Number of bytes left to read in the buffer character
150 that `readchar' has already advanced over. */
151 static int readchar_backlog
;
153 /* This contains the last string skipped with #@. */
154 static char *saved_doc_string
;
155 /* Length of buffer allocated in saved_doc_string. */
156 static int saved_doc_string_size
;
157 /* Length of actual data in saved_doc_string. */
158 static int saved_doc_string_length
;
159 /* This is the file position that string came from. */
160 static file_offset saved_doc_string_position
;
162 /* This contains the previous string skipped with #@.
163 We copy it from saved_doc_string when a new string
164 is put in saved_doc_string. */
165 static char *prev_saved_doc_string
;
166 /* Length of buffer allocated in prev_saved_doc_string. */
167 static int prev_saved_doc_string_size
;
168 /* Length of actual data in prev_saved_doc_string. */
169 static int prev_saved_doc_string_length
;
170 /* This is the file position that string came from. */
171 static file_offset prev_saved_doc_string_position
;
173 /* Nonzero means inside a new-style backquote
174 with no surrounding parentheses.
175 Fread initializes this to zero, so we need not specbind it
176 or worry about what happens to it when there is an error. */
177 static int new_backquote_flag
;
179 /* A list of file names for files being loaded in Fload. Used to
180 check for recursive loads. */
182 static Lisp_Object Vloads_in_progress
;
184 /* Limit of the depth of recursive loads. */
186 Lisp_Object Vrecursive_load_depth_limit
;
188 /* Non-zero means load dangerous compiled Lisp files. */
190 int load_dangerous_libraries
;
192 /* A regular expression used to detect files compiled with Emacs. */
194 static Lisp_Object Vbytecomp_version_regexp
;
196 static void to_multibyte
P_ ((char **, char **, int *));
197 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
198 Lisp_Object (*) (), int,
199 Lisp_Object
, Lisp_Object
));
200 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
201 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
204 /* Handle unreading and rereading of characters.
205 Write READCHAR to read a character,
206 UNREAD(c) to unread c to be read again.
208 These macros actually read/unread a byte code, multibyte characters
209 are not handled here. The caller should manage them if necessary.
212 #define READCHAR readchar (readcharfun)
213 #define UNREAD(c) unreadchar (readcharfun, c)
216 readchar (readcharfun
)
217 Lisp_Object readcharfun
;
222 if (BUFFERP (readcharfun
))
224 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
226 int pt_byte
= BUF_PT_BYTE (inbuffer
);
227 int orig_pt_byte
= pt_byte
;
229 if (readchar_backlog
> 0)
230 /* We get the address of the byte just passed,
231 which is the last byte of the character.
232 The other bytes in this character are consecutive with it,
233 because the gap can't be in the middle of a character. */
234 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
235 - --readchar_backlog
);
237 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
240 readchar_backlog
= -1;
242 if (! NILP (inbuffer
->enable_multibyte_characters
))
244 /* Fetch the character code from the buffer. */
245 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
246 BUF_INC_POS (inbuffer
, pt_byte
);
247 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
251 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
254 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
258 if (MARKERP (readcharfun
))
260 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
262 int bytepos
= marker_byte_position (readcharfun
);
263 int orig_bytepos
= bytepos
;
265 if (readchar_backlog
> 0)
266 /* We get the address of the byte just passed,
267 which is the last byte of the character.
268 The other bytes in this character are consecutive with it,
269 because the gap can't be in the middle of a character. */
270 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
271 - --readchar_backlog
);
273 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
276 readchar_backlog
= -1;
278 if (! NILP (inbuffer
->enable_multibyte_characters
))
280 /* Fetch the character code from the buffer. */
281 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
282 BUF_INC_POS (inbuffer
, bytepos
);
283 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
287 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
291 XMARKER (readcharfun
)->bytepos
= bytepos
;
292 XMARKER (readcharfun
)->charpos
++;
297 if (EQ (readcharfun
, Qlambda
))
298 return read_bytecode_char (0);
300 if (EQ (readcharfun
, Qget_file_char
))
304 /* Interrupted reads have been observed while reading over the network */
305 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
314 if (STRINGP (readcharfun
))
316 if (read_from_string_index
>= read_from_string_limit
)
319 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
320 read_from_string_index
,
321 read_from_string_index_byte
);
326 tem
= call0 (readcharfun
);
333 /* Unread the character C in the way appropriate for the stream READCHARFUN.
334 If the stream is a user function, call it with the char as argument. */
337 unreadchar (readcharfun
, c
)
338 Lisp_Object readcharfun
;
342 /* Don't back up the pointer if we're unreading the end-of-input mark,
343 since readchar didn't advance it when we read it. */
345 else if (BUFFERP (readcharfun
))
347 struct buffer
*b
= XBUFFER (readcharfun
);
348 int bytepos
= BUF_PT_BYTE (b
);
350 if (readchar_backlog
>= 0)
355 if (! NILP (b
->enable_multibyte_characters
))
356 BUF_DEC_POS (b
, bytepos
);
360 BUF_PT_BYTE (b
) = bytepos
;
363 else if (MARKERP (readcharfun
))
365 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
366 int bytepos
= XMARKER (readcharfun
)->bytepos
;
368 if (readchar_backlog
>= 0)
372 XMARKER (readcharfun
)->charpos
--;
373 if (! NILP (b
->enable_multibyte_characters
))
374 BUF_DEC_POS (b
, bytepos
);
378 XMARKER (readcharfun
)->bytepos
= bytepos
;
381 else if (STRINGP (readcharfun
))
383 read_from_string_index
--;
384 read_from_string_index_byte
385 = string_char_to_byte (readcharfun
, read_from_string_index
);
387 else if (EQ (readcharfun
, Qlambda
))
388 read_bytecode_char (1);
389 else if (EQ (readcharfun
, Qget_file_char
))
390 ungetc (c
, instream
);
392 call1 (readcharfun
, make_number (c
));
395 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
396 static int read_multibyte ();
397 static Lisp_Object
substitute_object_recurse ();
398 static void substitute_object_in_subtree (), substitute_in_interval ();
401 /* Get a character from the tty. */
403 extern Lisp_Object
read_char ();
405 /* Read input events until we get one that's acceptable for our purposes.
407 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
408 until we get a character we like, and then stuffed into
411 If ASCII_REQUIRED is non-zero, we check function key events to see
412 if the unmodified version of the symbol has a Qascii_character
413 property, and use that character, if present.
415 If ERROR_NONASCII is non-zero, we signal an error if the input we
416 get isn't an ASCII character with modifiers. If it's zero but
417 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
420 If INPUT_METHOD is nonzero, we invoke the current input method
421 if the character warrants that. */
424 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
426 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
428 register Lisp_Object val
, delayed_switch_frame
;
430 #ifdef HAVE_WINDOW_SYSTEM
431 if (display_hourglass_p
)
435 delayed_switch_frame
= Qnil
;
437 /* Read until we get an acceptable event. */
439 val
= read_char (0, 0, 0,
440 (input_method
? Qnil
: Qt
),
446 /* switch-frame events are put off until after the next ASCII
447 character. This is better than signaling an error just because
448 the last characters were typed to a separate minibuffer frame,
449 for example. Eventually, some code which can deal with
450 switch-frame events will read it and process it. */
452 && EVENT_HAS_PARAMETERS (val
)
453 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
455 delayed_switch_frame
= val
;
461 /* Convert certain symbols to their ASCII equivalents. */
464 Lisp_Object tem
, tem1
;
465 tem
= Fget (val
, Qevent_symbol_element_mask
);
468 tem1
= Fget (Fcar (tem
), Qascii_character
);
469 /* Merge this symbol's modifier bits
470 with the ASCII equivalent of its basic code. */
472 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
476 /* If we don't have a character now, deal with it appropriately. */
481 Vunread_command_events
= Fcons (val
, Qnil
);
482 error ("Non-character input-event");
489 if (! NILP (delayed_switch_frame
))
490 unread_switch_frame
= delayed_switch_frame
;
492 #ifdef HAVE_WINDOW_SYSTEM
493 if (display_hourglass_p
)
499 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
500 doc
: /* Read a character from the command input (keyboard or macro).
501 It is returned as a number.
502 If the user generates an event which is not a character (i.e. a mouse
503 click or function key event), `read-char' signals an error. As an
504 exception, switch-frame events are put off until non-ASCII events can
506 If you want to read non-character events, or ignore them, call
507 `read-event' or `read-char-exclusive' instead.
509 If the optional argument PROMPT is non-nil, display that as a prompt.
510 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
511 input method is turned on in the current buffer, that input method
512 is used for reading a character. */)
513 (prompt
, inherit_input_method
)
514 Lisp_Object prompt
, inherit_input_method
;
517 message_with_string ("%s", prompt
, 0);
518 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
521 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
522 doc
: /* Read an event object from the input stream.
523 If the optional argument PROMPT is non-nil, display that as a prompt.
524 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
525 input method is turned on in the current buffer, that input method
526 is used for reading a character. */)
527 (prompt
, inherit_input_method
)
528 Lisp_Object prompt
, inherit_input_method
;
531 message_with_string ("%s", prompt
, 0);
532 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
535 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
536 doc
: /* Read a character from the command input (keyboard or macro).
537 It is returned as a number. Non-character events are ignored.
539 If the optional argument PROMPT is non-nil, display that as a prompt.
540 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
541 input method is turned on in the current buffer, that input method
542 is used for reading a character. */)
543 (prompt
, inherit_input_method
)
544 Lisp_Object prompt
, inherit_input_method
;
547 message_with_string ("%s", prompt
, 0);
548 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
551 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
552 doc
: /* Don't use this yourself. */)
555 register Lisp_Object val
;
556 XSETINT (val
, getc (instream
));
562 /* Value is non-zero if the file asswociated with file descriptor FD
563 is a compiled Lisp file that's safe to load. Only files compiled
564 with Emacs are safe to load. Files compiled with XEmacs can lead
565 to a crash in Fbyte_code because of an incompatible change in the
576 /* Read the first few bytes from the file, and look for a line
577 specifying the byte compiler version used. */
578 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
583 /* Skip to the next newline, skipping over the initial `ELC'
584 with NUL bytes following it. */
585 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
589 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
594 lseek (fd
, 0, SEEK_SET
);
599 /* Callback for record_unwind_protect. Restore the old load list OLD,
600 after loading a file successfully. */
603 record_load_unwind (old
)
606 return Vloads_in_progress
= old
;
610 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
611 doc
: /* Execute a file of Lisp code named FILE.
612 First try FILE with `.elc' appended, then try with `.el',
613 then try FILE unmodified. Environment variable references in FILE
614 are replaced with their values by calling `substitute-in-file-name'.
615 This function searches the directories in `load-path'.
616 If optional second arg NOERROR is non-nil,
617 report no error if FILE doesn't exist.
618 Print messages at start and end of loading unless
619 optional third arg NOMESSAGE is non-nil.
620 If optional fourth arg NOSUFFIX is non-nil, don't try adding
621 suffixes `.elc' or `.el' to the specified name FILE.
622 If optional fifth arg MUST-SUFFIX is non-nil, insist on
623 the suffix `.elc' or `.el'; don't accept just FILE unless
624 it ends in one of those suffixes or includes a directory name.
625 Return t if file exists. */)
626 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
627 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
629 register FILE *stream
;
630 register int fd
= -1;
631 register Lisp_Object lispstream
;
632 int count
= specpdl_ptr
- specpdl
;
636 /* 1 means we printed the ".el is newer" message. */
638 /* 1 means we are loading a compiled file. */
649 /* If file name is magic, call the handler. */
650 /* This shouldn't be necessary any more now that `openp' handles it right.
651 handler = Ffind_file_name_handler (file, Qload);
653 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
655 /* Do this after the handler to avoid
656 the need to gcpro noerror, nomessage and nosuffix.
657 (Below here, we care only whether they are nil or not.)
658 The presence of this call is the result of a historical accident:
659 it used to be in every file-operations and when it got removed
660 everywhere, it accidentally stayed here. Since then, enough people
661 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
662 that it seemed risky to remove. */
663 file
= Fsubstitute_in_file_name (file
);
665 /* Avoid weird lossage with null string as arg,
666 since it would try to load a directory as a Lisp file */
667 if (XSTRING (file
)->size
> 0)
669 int size
= STRING_BYTES (XSTRING (file
));
674 if (! NILP (must_suffix
))
676 /* Don't insist on adding a suffix if FILE already ends with one. */
678 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
681 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
683 /* Don't insist on adding a suffix
684 if the argument includes a directory name. */
685 else if (! NILP (Ffile_name_directory (file
)))
689 fd
= openp (Vload_path
, file
,
690 (!NILP (nosuffix
) ? Qnil
691 : !NILP (must_suffix
) ? Vload_suffixes
692 : Fappend (2, (tmp
[0] = Vload_suffixes
,
693 tmp
[1] = default_suffixes
,
703 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
704 Fcons (file
, Qnil
)));
709 /* Tell startup.el whether or not we found the user's init file. */
710 if (EQ (Qt
, Vuser_init_file
))
711 Vuser_init_file
= found
;
713 /* If FD is -2, that means openp found a magic file. */
716 if (NILP (Fequal (found
, file
)))
717 /* If FOUND is a different file name from FILE,
718 find its handler even if we have already inhibited
719 the `load' operation on FILE. */
720 handler
= Ffind_file_name_handler (found
, Qt
);
722 handler
= Ffind_file_name_handler (found
, Qload
);
723 if (! NILP (handler
))
724 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
727 /* Check if we're stuck in a recursive load cycle.
729 2000-09-21: It's not possible to just check for the file loaded
730 being a member of Vloads_in_progress. This fails because of the
731 way the byte compiler currently works; `provide's are not
732 evaluted, see font-lock.el/jit-lock.el as an example. This
733 leads to a certain amount of ``normal'' recursion.
735 Also, just loading a file recursively is not always an error in
736 the general case; the second load may do something different. */
737 if (INTEGERP (Vrecursive_load_depth_limit
)
738 && XINT (Vrecursive_load_depth_limit
) > 0)
740 Lisp_Object len
= Flength (Vloads_in_progress
);
741 if (XFASTINT (len
) > XFASTINT (Vrecursive_load_depth_limit
))
742 Fsignal (Qerror
, Fcons (build_string ("Recursive load suspected"),
743 Fcons (found
, Vloads_in_progress
)));
744 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
745 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
748 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
750 /* Load .elc files directly, but not when they are
751 remote and have no handler! */
758 if (!safe_to_load_p (fd
))
761 if (!load_dangerous_libraries
)
762 error ("File `%s' was not compiled in Emacs",
763 XSTRING (found
)->data
);
764 else if (!NILP (nomessage
))
765 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
773 stat ((char *)XSTRING (found
)->data
, &s1
);
774 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
775 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
776 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
778 /* Make the progress messages mention that source is newer. */
781 /* If we won't print another message, mention this anyway. */
782 if (! NILP (nomessage
))
783 message_with_string ("Source file `%s' newer than byte-compiled file",
786 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
791 /* We are loading a source file (*.el). */
792 if (!NILP (Vload_source_file_function
))
798 val
= call4 (Vload_source_file_function
, found
, file
,
799 NILP (noerror
) ? Qnil
: Qt
,
800 NILP (nomessage
) ? Qnil
: Qt
);
801 return unbind_to (count
, val
);
807 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
808 #else /* not WINDOWSNT */
809 stream
= fdopen (fd
, fmode
);
810 #endif /* not WINDOWSNT */
814 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
817 if (! NILP (Vpurify_flag
))
818 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
820 if (NILP (nomessage
))
823 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
826 message_with_string ("Loading %s (source)...", file
, 1);
828 message_with_string ("Loading %s (compiled; note, source file is newer)...",
830 else /* The typical case; compiled file newer than source file. */
831 message_with_string ("Loading %s...", file
, 1);
835 lispstream
= Fcons (Qnil
, Qnil
);
836 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
837 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
838 record_unwind_protect (load_unwind
, lispstream
);
839 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
840 specbind (Qload_file_name
, found
);
841 specbind (Qinhibit_file_name_operation
, Qnil
);
843 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
845 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
846 unbind_to (count
, Qnil
);
848 /* Run any load-hooks for this file. */
849 temp
= Fassoc (file
, Vafter_load_alist
);
851 Fprogn (Fcdr (temp
));
854 if (saved_doc_string
)
855 free (saved_doc_string
);
856 saved_doc_string
= 0;
857 saved_doc_string_size
= 0;
859 if (prev_saved_doc_string
)
860 xfree (prev_saved_doc_string
);
861 prev_saved_doc_string
= 0;
862 prev_saved_doc_string_size
= 0;
864 if (!noninteractive
&& NILP (nomessage
))
867 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
870 message_with_string ("Loading %s (source)...done", file
, 1);
872 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
874 else /* The typical case; compiled file newer than source file. */
875 message_with_string ("Loading %s...done", file
, 1);
882 load_unwind (stream
) /* used as unwind-protect function in load */
885 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
886 | XFASTINT (XCDR (stream
))));
887 if (--load_in_progress
< 0) load_in_progress
= 0;
892 load_descriptor_unwind (oldlist
)
895 load_descriptor_list
= oldlist
;
899 /* Close all descriptors in use for Floads.
900 This is used when starting a subprocess. */
907 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
908 emacs_close (XFASTINT (XCAR (tail
)));
913 complete_filename_p (pathname
)
914 Lisp_Object pathname
;
916 register unsigned char *s
= XSTRING (pathname
)->data
;
917 return (IS_DIRECTORY_SEP (s
[0])
918 || (XSTRING (pathname
)->size
> 2
919 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
929 /* Search for a file whose name is STR, looking in directories
930 in the Lisp list PATH, and trying suffixes from SUFFIX.
931 On success, returns a file descriptor. On failure, returns -1.
933 SUFFIXES is a list of strings containing possible suffixes.
934 The empty suffix is automatically added iff the list is empty.
936 EXEC_ONLY nonzero means don't open the files,
937 just look for one that is executable. In this case,
938 returns 1 on success.
940 If STOREPTR is nonzero, it points to a slot where the name of
941 the file actually found should be stored as a Lisp string.
942 nil is stored there on failure.
944 If the file we find is remote, return -2
945 but store the found remote file name in *STOREPTR.
946 We do not check for remote files if EXEC_ONLY is nonzero. */
949 openp (path
, str
, suffixes
, storeptr
, exec_only
)
950 Lisp_Object path
, str
;
951 Lisp_Object suffixes
;
952 Lisp_Object
*storeptr
;
958 register char *fn
= buf
;
961 Lisp_Object filename
;
963 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
964 Lisp_Object string
, tail
;
965 int max_suffix_len
= 0;
967 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
969 CHECK_STRING_CAR (tail
);
970 max_suffix_len
= max (max_suffix_len
,
971 STRING_BYTES (XSTRING (XCAR (tail
))));
974 string
= filename
= Qnil
;
975 GCPRO5 (str
, string
, filename
, path
, suffixes
);
980 if (complete_filename_p (str
))
983 for (; CONSP (path
); path
= XCDR (path
))
985 filename
= Fexpand_file_name (str
, XCAR (path
));
986 if (!complete_filename_p (filename
))
987 /* If there are non-absolute elts in PATH (eg ".") */
988 /* Of course, this could conceivably lose if luser sets
989 default-directory to be something non-absolute... */
991 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
992 if (!complete_filename_p (filename
))
993 /* Give up on this path element! */
997 /* Calculate maximum size of any filename made from
998 this path element/specified file name and any possible suffix. */
999 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1000 if (fn_size
< want_size
)
1001 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1003 /* Loop over suffixes. */
1004 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1005 CONSP (tail
); tail
= XCDR (tail
))
1007 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1008 Lisp_Object handler
;
1010 /* Concatenate path element/specified name with the suffix.
1011 If the directory starts with /:, remove that. */
1012 if (XSTRING (filename
)->size
> 2
1013 && XSTRING (filename
)->data
[0] == '/'
1014 && XSTRING (filename
)->data
[1] == ':')
1016 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1017 STRING_BYTES (XSTRING (filename
)) - 2);
1018 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1022 strncpy (fn
, XSTRING (filename
)->data
,
1023 STRING_BYTES (XSTRING (filename
)));
1024 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1027 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1028 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1030 /* Check that the file exists and is not a directory. */
1031 /* We used to only check for handlers on non-absolute file names:
1035 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1036 It's not clear why that was the case and it breaks things like
1037 (load "/bar.el") where the file is actually "/bar.el.gz". */
1038 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1039 if (!NILP (handler
) && !exec_only
)
1043 string
= build_string (fn
);
1044 exists
= !NILP (Ffile_readable_p (string
));
1045 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1050 /* We succeeded; return this descriptor and filename. */
1052 *storeptr
= build_string (fn
);
1059 int exists
= (stat (fn
, &st
) >= 0
1060 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1063 /* Check that we can access or open it. */
1065 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1067 fd
= emacs_open (fn
, O_RDONLY
, 0);
1071 /* We succeeded; return this descriptor and filename. */
1073 *storeptr
= build_string (fn
);
1089 /* Merge the list we've accumulated of globals from the current input source
1090 into the load_history variable. The details depend on whether
1091 the source has an associated file name or not. */
1094 build_load_history (stream
, source
)
1098 register Lisp_Object tail
, prev
, newelt
;
1099 register Lisp_Object tem
, tem2
;
1100 register int foundit
, loading
;
1102 loading
= stream
|| !NARROWED
;
1104 tail
= Vload_history
;
1107 while (!NILP (tail
))
1111 /* Find the feature's previous assoc list... */
1112 if (!NILP (Fequal (source
, Fcar (tem
))))
1116 /* If we're loading, remove it. */
1120 Vload_history
= Fcdr (tail
);
1122 Fsetcdr (prev
, Fcdr (tail
));
1125 /* Otherwise, cons on new symbols that are not already members. */
1128 tem2
= Vcurrent_load_list
;
1130 while (CONSP (tem2
))
1132 newelt
= Fcar (tem2
);
1134 if (NILP (Fmemq (newelt
, tem
)))
1135 Fsetcar (tail
, Fcons (Fcar (tem
),
1136 Fcons (newelt
, Fcdr (tem
))));
1149 /* If we're loading, cons the new assoc onto the front of load-history,
1150 the most-recently-loaded position. Also do this if we didn't find
1151 an existing member for the current source. */
1152 if (loading
|| !foundit
)
1153 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1158 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1166 readevalloop_1 (old
)
1169 load_convert_to_unibyte
= ! NILP (old
);
1173 /* Signal an `end-of-file' error, if possible with file name
1177 end_of_file_error ()
1181 if (STRINGP (Vload_file_name
))
1182 data
= Fcons (Vload_file_name
, Qnil
);
1186 Fsignal (Qend_of_file
, data
);
1189 /* UNIBYTE specifies how to set load_convert_to_unibyte
1190 for this invocation.
1191 READFUN, if non-nil, is used instead of `read'. */
1194 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1195 Lisp_Object readcharfun
;
1197 Lisp_Object sourcename
;
1198 Lisp_Object (*evalfun
) ();
1200 Lisp_Object unibyte
, readfun
;
1203 register Lisp_Object val
;
1204 int count
= specpdl_ptr
- specpdl
;
1205 struct gcpro gcpro1
;
1206 struct buffer
*b
= 0;
1207 int continue_reading_p
;
1209 if (BUFFERP (readcharfun
))
1210 b
= XBUFFER (readcharfun
);
1211 else if (MARKERP (readcharfun
))
1212 b
= XMARKER (readcharfun
)->buffer
;
1214 specbind (Qstandard_input
, readcharfun
);
1215 specbind (Qcurrent_load_list
, Qnil
);
1216 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1217 load_convert_to_unibyte
= !NILP (unibyte
);
1219 readchar_backlog
= -1;
1221 GCPRO1 (sourcename
);
1223 LOADHIST_ATTACH (sourcename
);
1225 continue_reading_p
= 1;
1226 while (continue_reading_p
)
1228 if (b
!= 0 && NILP (b
->name
))
1229 error ("Reading from killed buffer");
1235 while ((c
= READCHAR
) != '\n' && c
!= -1);
1240 /* Ignore whitespace here, so we can detect eof. */
1241 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1244 if (!NILP (Vpurify_flag
) && c
== '(')
1246 int count1
= specpdl_ptr
- specpdl
;
1247 record_unwind_protect (unreadpure
, Qnil
);
1248 val
= read_list (-1, readcharfun
);
1249 unbind_to (count1
, Qnil
);
1254 read_objects
= Qnil
;
1255 if (!NILP (readfun
))
1257 val
= call1 (readfun
, readcharfun
);
1259 /* If READCHARFUN has set point to ZV, we should
1260 stop reading, even if the form read sets point
1261 to a different value when evaluated. */
1262 if (BUFFERP (readcharfun
))
1264 struct buffer
*b
= XBUFFER (readcharfun
);
1265 if (BUF_PT (b
) == BUF_ZV (b
))
1266 continue_reading_p
= 0;
1269 else if (! NILP (Vload_read_function
))
1270 val
= call1 (Vload_read_function
, readcharfun
);
1272 val
= read0 (readcharfun
);
1275 val
= (*evalfun
) (val
);
1279 Vvalues
= Fcons (val
, Vvalues
);
1280 if (EQ (Vstandard_output
, Qt
))
1287 build_load_history (stream
, sourcename
);
1290 unbind_to (count
, Qnil
);
1293 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1294 doc
: /* Execute the current buffer as Lisp code.
1295 Programs can pass two arguments, BUFFER and PRINTFLAG.
1296 BUFFER is the buffer to evaluate (nil means use current buffer).
1297 PRINTFLAG controls printing of output:
1298 nil means discard it; anything else is stream for print.
1300 If the optional third argument FILENAME is non-nil,
1301 it specifies the file name to use for `load-history'.
1302 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1303 for this invocation.
1305 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1306 `print' and related functions should work normally even if PRINTFLAG is nil.
1308 This function preserves the position of point. */)
1309 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1310 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1312 int count
= specpdl_ptr
- specpdl
;
1313 Lisp_Object tem
, buf
;
1316 buf
= Fcurrent_buffer ();
1318 buf
= Fget_buffer (buffer
);
1320 error ("No such buffer");
1322 if (NILP (printflag
) && NILP (do_allow_print
))
1327 if (NILP (filename
))
1328 filename
= XBUFFER (buf
)->filename
;
1330 specbind (Qstandard_output
, tem
);
1331 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1332 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1333 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1334 unbind_to (count
, Qnil
);
1339 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1340 doc
: /* Execute the region as Lisp code.
1341 When called from programs, expects two arguments,
1342 giving starting and ending indices in the current buffer
1343 of the text to be executed.
1344 Programs can pass third argument PRINTFLAG which controls output:
1345 nil means discard it; anything else is stream for printing it.
1346 Also the fourth argument READ-FUNCTION, if non-nil, is used
1347 instead of `read' to read each expression. It gets one argument
1348 which is the input stream for reading characters.
1350 This function does not move point. */)
1351 (start
, end
, printflag
, read_function
)
1352 Lisp_Object start
, end
, printflag
, read_function
;
1354 int count
= specpdl_ptr
- specpdl
;
1355 Lisp_Object tem
, cbuf
;
1357 cbuf
= Fcurrent_buffer ();
1359 if (NILP (printflag
))
1363 specbind (Qstandard_output
, tem
);
1365 if (NILP (printflag
))
1366 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1367 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1369 /* This both uses start and checks its type. */
1371 Fnarrow_to_region (make_number (BEGV
), end
);
1372 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1373 !NILP (printflag
), Qnil
, read_function
);
1375 return unbind_to (count
, Qnil
);
1379 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1380 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1381 If STREAM is nil, use the value of `standard-input' (which see).
1382 STREAM or the value of `standard-input' may be:
1383 a buffer (read from point and advance it)
1384 a marker (read from where it points and advance it)
1385 a function (call it with no arguments for each character,
1386 call it with a char as argument to push a char back)
1387 a string (takes text from string, starting at the beginning)
1388 t (read text line using minibuffer and use it, or read from
1389 standard input in batch mode). */)
1393 extern Lisp_Object
Fread_minibuffer ();
1396 stream
= Vstandard_input
;
1397 if (EQ (stream
, Qt
))
1398 stream
= Qread_char
;
1400 readchar_backlog
= -1;
1401 new_backquote_flag
= 0;
1402 read_objects
= Qnil
;
1404 if (EQ (stream
, Qread_char
))
1405 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1407 if (STRINGP (stream
))
1408 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1410 return read0 (stream
);
1413 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1414 doc
: /* Read one Lisp expression which is represented as text by STRING.
1415 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1416 START and END optionally delimit a substring of STRING from which to read;
1417 they default to 0 and (length STRING) respectively. */)
1418 (string
, start
, end
)
1419 Lisp_Object string
, start
, end
;
1421 int startval
, endval
;
1424 CHECK_STRING (string
);
1427 endval
= XSTRING (string
)->size
;
1431 endval
= XINT (end
);
1432 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1433 args_out_of_range (string
, end
);
1440 CHECK_NUMBER (start
);
1441 startval
= XINT (start
);
1442 if (startval
< 0 || startval
> endval
)
1443 args_out_of_range (string
, start
);
1446 read_from_string_index
= startval
;
1447 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1448 read_from_string_limit
= endval
;
1450 new_backquote_flag
= 0;
1451 read_objects
= Qnil
;
1453 tem
= read0 (string
);
1454 return Fcons (tem
, make_number (read_from_string_index
));
1457 /* Use this for recursive reads, in contexts where internal tokens
1462 Lisp_Object readcharfun
;
1464 register Lisp_Object val
;
1467 val
= read1 (readcharfun
, &c
, 0);
1469 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1476 static int read_buffer_size
;
1477 static char *read_buffer
;
1479 /* Read multibyte form and return it as a character. C is a first
1480 byte of multibyte form, and rest of them are read from
1484 read_multibyte (c
, readcharfun
)
1486 Lisp_Object readcharfun
;
1488 /* We need the actual character code of this multibyte
1490 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1495 while ((c
= READCHAR
) >= 0xA0
1496 && len
< MAX_MULTIBYTE_LENGTH
)
1499 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1500 return STRING_CHAR (str
, len
);
1501 /* The byte sequence is not valid as multibyte. Unread all bytes
1502 but the first one, and return the first byte. */
1508 /* Read a \-escape sequence, assuming we already read the `\'. */
1511 read_escape (readcharfun
, stringp
)
1512 Lisp_Object readcharfun
;
1515 register int c
= READCHAR
;
1519 error ("End of file");
1549 error ("Invalid escape character syntax");
1552 c
= read_escape (readcharfun
, 0);
1553 return c
| meta_modifier
;
1558 error ("Invalid escape character syntax");
1561 c
= read_escape (readcharfun
, 0);
1562 return c
| shift_modifier
;
1567 error ("Invalid escape character syntax");
1570 c
= read_escape (readcharfun
, 0);
1571 return c
| hyper_modifier
;
1576 error ("Invalid escape character syntax");
1579 c
= read_escape (readcharfun
, 0);
1580 return c
| alt_modifier
;
1585 error ("Invalid escape character syntax");
1588 c
= read_escape (readcharfun
, 0);
1589 return c
| super_modifier
;
1594 error ("Invalid escape character syntax");
1598 c
= read_escape (readcharfun
, 0);
1599 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1600 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1601 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1602 return c
| ctrl_modifier
;
1603 /* ASCII control chars are made from letters (both cases),
1604 as well as the non-letters within 0100...0137. */
1605 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1606 return (c
& (037 | ~0177));
1607 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1608 return (c
& (037 | ~0177));
1610 return c
| ctrl_modifier
;
1620 /* An octal escape, as in ANSI C. */
1622 register int i
= c
- '0';
1623 register int count
= 0;
1626 if ((c
= READCHAR
) >= '0' && c
<= '7')
1641 /* A hex escape, as in ANSI C. */
1647 if (c
>= '0' && c
<= '9')
1652 else if ((c
>= 'a' && c
<= 'f')
1653 || (c
>= 'A' && c
<= 'F'))
1656 if (c
>= 'a' && c
<= 'f')
1671 if (BASE_LEADING_CODE_P (c
))
1672 c
= read_multibyte (c
, readcharfun
);
1678 /* Read an integer in radix RADIX using READCHARFUN to read
1679 characters. RADIX must be in the interval [2..36]; if it isn't, a
1680 read error is signaled . Value is the integer read. Signals an
1681 error if encountering invalid read syntax or if RADIX is out of
1685 read_integer (readcharfun
, radix
)
1686 Lisp_Object readcharfun
;
1689 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1690 EMACS_INT number
= 0;
1692 if (radix
< 2 || radix
> 36)
1696 number
= ndigits
= invalid_p
= 0;
1712 if (c
>= '0' && c
<= '9')
1714 else if (c
>= 'a' && c
<= 'z')
1715 digit
= c
- 'a' + 10;
1716 else if (c
>= 'A' && c
<= 'Z')
1717 digit
= c
- 'A' + 10;
1724 if (digit
< 0 || digit
>= radix
)
1727 number
= radix
* number
+ digit
;
1733 if (ndigits
== 0 || invalid_p
)
1736 sprintf (buf
, "integer, radix %d", radix
);
1737 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1740 return make_number (sign
* number
);
1744 /* Convert unibyte text in read_buffer to multibyte.
1746 Initially, *P is a pointer after the end of the unibyte text, and
1747 the pointer *END points after the end of read_buffer.
1749 If read_buffer doesn't have enough room to hold the result
1750 of the conversion, reallocate it and adjust *P and *END.
1752 At the end, make *P point after the result of the conversion, and
1753 return in *NCHARS the number of characters in the converted
1757 to_multibyte (p
, end
, nchars
)
1763 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1764 if (read_buffer_size
< 2 * nbytes
)
1766 int offset
= *p
- read_buffer
;
1767 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1768 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1769 *p
= read_buffer
+ offset
;
1770 *end
= read_buffer
+ read_buffer_size
;
1773 if (nbytes
!= *nchars
)
1774 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1775 *p
- read_buffer
, nchars
);
1777 *p
= read_buffer
+ nbytes
;
1781 /* If the next token is ')' or ']' or '.', we store that character
1782 in *PCH and the return value is not interesting. Else, we store
1783 zero in *PCH and we read and return one lisp object.
1785 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1788 read1 (readcharfun
, pch
, first_in_list
)
1789 register Lisp_Object readcharfun
;
1794 int uninterned_symbol
= 0;
1802 end_of_file_error ();
1807 return read_list (0, readcharfun
);
1810 return read_vector (readcharfun
, 0);
1827 tmp
= read_vector (readcharfun
, 0);
1828 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1829 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1830 error ("Invalid size char-table");
1831 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1832 XCHAR_TABLE (tmp
)->top
= Qt
;
1841 tmp
= read_vector (readcharfun
, 0);
1842 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1843 error ("Invalid size char-table");
1844 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1845 XCHAR_TABLE (tmp
)->top
= Qnil
;
1848 Fsignal (Qinvalid_read_syntax
,
1849 Fcons (make_string ("#^^", 3), Qnil
));
1851 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1856 length
= read1 (readcharfun
, pch
, first_in_list
);
1860 Lisp_Object tmp
, val
;
1861 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1865 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1866 if (size_in_chars
!= XSTRING (tmp
)->size
1867 /* We used to print 1 char too many
1868 when the number of bits was a multiple of 8.
1869 Accept such input in case it came from an old version. */
1870 && ! (XFASTINT (length
)
1871 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1872 Fsignal (Qinvalid_read_syntax
,
1873 Fcons (make_string ("#&...", 5), Qnil
));
1875 val
= Fmake_bool_vector (length
, Qnil
);
1876 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1878 /* Clear the extraneous bits in the last byte. */
1879 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1880 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1881 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1884 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1889 /* Accept compiled functions at read-time so that we don't have to
1890 build them using function calls. */
1892 tmp
= read_vector (readcharfun
, 1);
1893 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1894 XVECTOR (tmp
)->contents
);
1899 struct gcpro gcpro1
;
1902 /* Read the string itself. */
1903 tmp
= read1 (readcharfun
, &ch
, 0);
1904 if (ch
!= 0 || !STRINGP (tmp
))
1905 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1907 /* Read the intervals and their properties. */
1910 Lisp_Object beg
, end
, plist
;
1912 beg
= read1 (readcharfun
, &ch
, 0);
1917 end
= read1 (readcharfun
, &ch
, 0);
1919 plist
= read1 (readcharfun
, &ch
, 0);
1921 Fsignal (Qinvalid_read_syntax
,
1922 Fcons (build_string ("invalid string property list"),
1924 Fset_text_properties (beg
, end
, plist
, tmp
);
1930 /* #@NUMBER is used to skip NUMBER following characters.
1931 That's used in .elc files to skip over doc strings
1932 and function definitions. */
1937 /* Read a decimal integer. */
1938 while ((c
= READCHAR
) >= 0
1939 && c
>= '0' && c
<= '9')
1947 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1949 /* If we are supposed to force doc strings into core right now,
1950 record the last string that we skipped,
1951 and record where in the file it comes from. */
1953 /* But first exchange saved_doc_string
1954 with prev_saved_doc_string, so we save two strings. */
1956 char *temp
= saved_doc_string
;
1957 int temp_size
= saved_doc_string_size
;
1958 file_offset temp_pos
= saved_doc_string_position
;
1959 int temp_len
= saved_doc_string_length
;
1961 saved_doc_string
= prev_saved_doc_string
;
1962 saved_doc_string_size
= prev_saved_doc_string_size
;
1963 saved_doc_string_position
= prev_saved_doc_string_position
;
1964 saved_doc_string_length
= prev_saved_doc_string_length
;
1966 prev_saved_doc_string
= temp
;
1967 prev_saved_doc_string_size
= temp_size
;
1968 prev_saved_doc_string_position
= temp_pos
;
1969 prev_saved_doc_string_length
= temp_len
;
1972 if (saved_doc_string_size
== 0)
1974 saved_doc_string_size
= nskip
+ 100;
1975 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1977 if (nskip
> saved_doc_string_size
)
1979 saved_doc_string_size
= nskip
+ 100;
1980 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1981 saved_doc_string_size
);
1984 saved_doc_string_position
= file_tell (instream
);
1986 /* Copy that many characters into saved_doc_string. */
1987 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1988 saved_doc_string
[i
] = c
= READCHAR
;
1990 saved_doc_string_length
= i
;
1994 /* Skip that many characters. */
1995 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2002 return Vload_file_name
;
2004 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2005 /* #:foo is the uninterned symbol named foo. */
2008 uninterned_symbol
= 1;
2012 /* Reader forms that can reuse previously read objects. */
2013 if (c
>= '0' && c
<= '9')
2018 /* Read a non-negative integer. */
2019 while (c
>= '0' && c
<= '9')
2025 /* #n=object returns object, but associates it with n for #n#. */
2028 /* Make a placeholder for #n# to use temporarily */
2029 Lisp_Object placeholder
;
2032 placeholder
= Fcons(Qnil
, Qnil
);
2033 cell
= Fcons (make_number (n
), placeholder
);
2034 read_objects
= Fcons (cell
, read_objects
);
2036 /* Read the object itself. */
2037 tem
= read0 (readcharfun
);
2039 /* Now put it everywhere the placeholder was... */
2040 substitute_object_in_subtree (tem
, placeholder
);
2042 /* ...and #n# will use the real value from now on. */
2043 Fsetcdr (cell
, tem
);
2047 /* #n# returns a previously read object. */
2050 tem
= Fassq (make_number (n
), read_objects
);
2053 /* Fall through to error message. */
2055 else if (c
== 'r' || c
== 'R')
2056 return read_integer (readcharfun
, n
);
2058 /* Fall through to error message. */
2060 else if (c
== 'x' || c
== 'X')
2061 return read_integer (readcharfun
, 16);
2062 else if (c
== 'o' || c
== 'O')
2063 return read_integer (readcharfun
, 8);
2064 else if (c
== 'b' || c
== 'B')
2065 return read_integer (readcharfun
, 2);
2068 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2071 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2076 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2086 new_backquote_flag
++;
2087 value
= read0 (readcharfun
);
2088 new_backquote_flag
--;
2090 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2094 if (new_backquote_flag
)
2096 Lisp_Object comma_type
= Qnil
;
2101 comma_type
= Qcomma_at
;
2103 comma_type
= Qcomma_dot
;
2106 if (ch
>= 0) UNREAD (ch
);
2107 comma_type
= Qcomma
;
2110 new_backquote_flag
--;
2111 value
= read0 (readcharfun
);
2112 new_backquote_flag
++;
2113 return Fcons (comma_type
, Fcons (value
, Qnil
));
2122 end_of_file_error ();
2125 c
= read_escape (readcharfun
, 0);
2126 else if (BASE_LEADING_CODE_P (c
))
2127 c
= read_multibyte (c
, readcharfun
);
2129 return make_number (c
);
2134 char *p
= read_buffer
;
2135 char *end
= read_buffer
+ read_buffer_size
;
2137 /* Nonzero if we saw an escape sequence specifying
2138 a multibyte character. */
2139 int force_multibyte
= 0;
2140 /* Nonzero if we saw an escape sequence specifying
2141 a single-byte character. */
2142 int force_singlebyte
= 0;
2146 while ((c
= READCHAR
) >= 0
2149 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2151 int offset
= p
- read_buffer
;
2152 read_buffer
= (char *) xrealloc (read_buffer
,
2153 read_buffer_size
*= 2);
2154 p
= read_buffer
+ offset
;
2155 end
= read_buffer
+ read_buffer_size
;
2160 c
= read_escape (readcharfun
, 1);
2162 /* C is -1 if \ newline has just been seen */
2165 if (p
== read_buffer
)
2170 /* If an escape specifies a non-ASCII single-byte character,
2171 this must be a unibyte string. */
2172 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2173 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2174 force_singlebyte
= 1;
2177 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2179 /* Any modifiers for a multibyte character are invalid. */
2180 if (c
& CHAR_MODIFIER_MASK
)
2181 error ("Invalid modifier in string");
2182 p
+= CHAR_STRING (c
, p
);
2183 force_multibyte
= 1;
2187 /* Allow `\C- ' and `\C-?'. */
2188 if (c
== (CHAR_CTL
| ' '))
2190 else if (c
== (CHAR_CTL
| '?'))
2195 /* Shift modifier is valid only with [A-Za-z]. */
2196 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2198 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2199 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2203 /* Move the meta bit to the right place for a string. */
2204 c
= (c
& ~CHAR_META
) | 0x80;
2206 error ("Invalid modifier in string");
2211 end_of_file_error ();
2213 /* If purifying, and string starts with \ newline,
2214 return zero instead. This is for doc strings
2215 that we are really going to find in etc/DOC.nn.nn */
2216 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2217 return make_number (0);
2219 if (force_multibyte
)
2220 to_multibyte (&p
, &end
, &nchars
);
2221 else if (force_singlebyte
)
2222 nchars
= p
- read_buffer
;
2223 else if (load_convert_to_unibyte
)
2226 to_multibyte (&p
, &end
, &nchars
);
2227 if (p
- read_buffer
!= nchars
)
2229 string
= make_multibyte_string (read_buffer
, nchars
,
2231 return Fstring_make_unibyte (string
);
2234 else if (EQ (readcharfun
, Qget_file_char
)
2235 || EQ (readcharfun
, Qlambda
))
2237 /* Nowadays, reading directly from a file is used only for
2238 compiled Emacs Lisp files, and those always use the
2239 Emacs internal encoding. Meanwhile, Qlambda is used
2240 for reading dynamic byte code (compiled with
2241 byte-compile-dynamic = t). */
2242 to_multibyte (&p
, &end
, &nchars
);
2245 /* In all other cases, if we read these bytes as
2246 separate characters, treat them as separate characters now. */
2247 nchars
= p
- read_buffer
;
2250 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2252 || (p
- read_buffer
!= nchars
)));
2253 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2255 || (p
- read_buffer
!= nchars
)));
2260 int next_char
= READCHAR
;
2263 if (next_char
<= 040
2264 || index ("\"'`,(", next_char
))
2270 /* Otherwise, we fall through! Note that the atom-reading loop
2271 below will now loop at least once, assuring that we will not
2272 try to UNREAD two characters in a row. */
2276 if (c
<= 040) goto retry
;
2278 char *p
= read_buffer
;
2282 char *end
= read_buffer
+ read_buffer_size
;
2285 && !(c
== '\"' || c
== '\'' || c
== ';'
2286 || c
== '(' || c
== ')'
2287 || c
== '[' || c
== ']' || c
== '#'))
2289 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2291 int offset
= p
- read_buffer
;
2292 read_buffer
= (char *) xrealloc (read_buffer
,
2293 read_buffer_size
*= 2);
2294 p
= read_buffer
+ offset
;
2295 end
= read_buffer
+ read_buffer_size
;
2302 end_of_file_error ();
2306 if (! SINGLE_BYTE_CHAR_P (c
))
2307 p
+= CHAR_STRING (c
, p
);
2316 int offset
= p
- read_buffer
;
2317 read_buffer
= (char *) xrealloc (read_buffer
,
2318 read_buffer_size
*= 2);
2319 p
= read_buffer
+ offset
;
2320 end
= read_buffer
+ read_buffer_size
;
2327 if (!quoted
&& !uninterned_symbol
)
2330 register Lisp_Object val
;
2332 if (*p1
== '+' || *p1
== '-') p1
++;
2333 /* Is it an integer? */
2336 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2337 /* Integers can have trailing decimal points. */
2338 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2340 /* It is an integer. */
2344 if (sizeof (int) == sizeof (EMACS_INT
))
2345 XSETINT (val
, atoi (read_buffer
));
2346 else if (sizeof (long) == sizeof (EMACS_INT
))
2347 XSETINT (val
, atol (read_buffer
));
2353 if (isfloat_string (read_buffer
))
2355 /* Compute NaN and infinities using 0.0 in a variable,
2356 to cope with compilers that think they are smarter
2362 /* Negate the value ourselves. This treats 0, NaNs,
2363 and infinity properly on IEEE floating point hosts,
2364 and works around a common bug where atof ("-0.0")
2366 int negative
= read_buffer
[0] == '-';
2368 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2369 returns 1, is if the input ends in e+INF or e+NaN. */
2376 value
= zero
/ zero
;
2379 value
= atof (read_buffer
+ negative
);
2383 return make_float (negative
? - value
: value
);
2387 if (uninterned_symbol
)
2388 return make_symbol (read_buffer
);
2390 return intern (read_buffer
);
2396 /* List of nodes we've seen during substitute_object_in_subtree. */
2397 static Lisp_Object seen_list
;
2400 substitute_object_in_subtree (object
, placeholder
)
2402 Lisp_Object placeholder
;
2404 Lisp_Object check_object
;
2406 /* We haven't seen any objects when we start. */
2409 /* Make all the substitutions. */
2411 = substitute_object_recurse (object
, placeholder
, object
);
2413 /* Clear seen_list because we're done with it. */
2416 /* The returned object here is expected to always eq the
2418 if (!EQ (check_object
, object
))
2419 error ("Unexpected mutation error in reader");
2422 /* Feval doesn't get called from here, so no gc protection is needed. */
2423 #define SUBSTITUTE(get_val, set_val) \
2425 Lisp_Object old_value = get_val; \
2426 Lisp_Object true_value \
2427 = substitute_object_recurse (object, placeholder,\
2430 if (!EQ (old_value, true_value)) \
2437 substitute_object_recurse (object
, placeholder
, subtree
)
2439 Lisp_Object placeholder
;
2440 Lisp_Object subtree
;
2442 /* If we find the placeholder, return the target object. */
2443 if (EQ (placeholder
, subtree
))
2446 /* If we've been to this node before, don't explore it again. */
2447 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2450 /* If this node can be the entry point to a cycle, remember that
2451 we've seen it. It can only be such an entry point if it was made
2452 by #n=, which means that we can find it as a value in
2454 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2455 seen_list
= Fcons (subtree
, seen_list
);
2457 /* Recurse according to subtree's type.
2458 Every branch must return a Lisp_Object. */
2459 switch (XTYPE (subtree
))
2461 case Lisp_Vectorlike
:
2464 int length
= XINT (Flength(subtree
));
2465 for (i
= 0; i
< length
; i
++)
2467 Lisp_Object idx
= make_number (i
);
2468 SUBSTITUTE (Faref (subtree
, idx
),
2469 Faset (subtree
, idx
, true_value
));
2476 SUBSTITUTE (Fcar_safe (subtree
),
2477 Fsetcar (subtree
, true_value
));
2478 SUBSTITUTE (Fcdr_safe (subtree
),
2479 Fsetcdr (subtree
, true_value
));
2485 /* Check for text properties in each interval.
2486 substitute_in_interval contains part of the logic. */
2488 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2489 Lisp_Object arg
= Fcons (object
, placeholder
);
2491 traverse_intervals_noorder (root_interval
,
2492 &substitute_in_interval
, arg
);
2497 /* Other types don't recurse any further. */
2503 /* Helper function for substitute_object_recurse. */
2505 substitute_in_interval (interval
, arg
)
2509 Lisp_Object object
= Fcar (arg
);
2510 Lisp_Object placeholder
= Fcdr (arg
);
2512 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2531 if (*cp
== '+' || *cp
== '-')
2534 if (*cp
>= '0' && *cp
<= '9')
2537 while (*cp
>= '0' && *cp
<= '9')
2545 if (*cp
>= '0' && *cp
<= '9')
2548 while (*cp
>= '0' && *cp
<= '9')
2551 if (*cp
== 'e' || *cp
== 'E')
2555 if (*cp
== '+' || *cp
== '-')
2559 if (*cp
>= '0' && *cp
<= '9')
2562 while (*cp
>= '0' && *cp
<= '9')
2565 else if (cp
== start
)
2567 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2572 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2578 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2579 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2580 || state
== (DOT_CHAR
|TRAIL_INT
)
2581 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2582 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2583 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2588 read_vector (readcharfun
, bytecodeflag
)
2589 Lisp_Object readcharfun
;
2594 register Lisp_Object
*ptr
;
2595 register Lisp_Object tem
, item
, vector
;
2596 register struct Lisp_Cons
*otem
;
2599 tem
= read_list (1, readcharfun
);
2600 len
= Flength (tem
);
2601 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2603 size
= XVECTOR (vector
)->size
;
2604 ptr
= XVECTOR (vector
)->contents
;
2605 for (i
= 0; i
< size
; i
++)
2608 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2609 bytecode object, the docstring containing the bytecode and
2610 constants values must be treated as unibyte and passed to
2611 Fread, to get the actual bytecode string and constants vector. */
2612 if (bytecodeflag
&& load_force_doc_strings
)
2614 if (i
== COMPILED_BYTECODE
)
2616 if (!STRINGP (item
))
2617 error ("invalid byte code");
2619 /* Delay handling the bytecode slot until we know whether
2620 it is lazily-loaded (we can tell by whether the
2621 constants slot is nil). */
2622 ptr
[COMPILED_CONSTANTS
] = item
;
2625 else if (i
== COMPILED_CONSTANTS
)
2627 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2631 /* Coerce string to unibyte (like string-as-unibyte,
2632 but without generating extra garbage and
2633 guaranteeing no change in the contents). */
2634 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2635 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2637 item
= Fread (bytestr
);
2639 error ("invalid byte code");
2641 otem
= XCONS (item
);
2642 bytestr
= XCAR (item
);
2647 /* Now handle the bytecode slot. */
2648 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2651 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2659 /* FLAG = 1 means check for ] to terminate rather than ) and .
2660 FLAG = -1 means check for starting with defun
2661 and make structure pure. */
2664 read_list (flag
, readcharfun
)
2666 register Lisp_Object readcharfun
;
2668 /* -1 means check next element for defun,
2669 0 means don't check,
2670 1 means already checked and found defun. */
2671 int defunflag
= flag
< 0 ? -1 : 0;
2672 Lisp_Object val
, tail
;
2673 register Lisp_Object elt
, tem
;
2674 struct gcpro gcpro1
, gcpro2
;
2675 /* 0 is the normal case.
2676 1 means this list is a doc reference; replace it with the number 0.
2677 2 means this list is a doc reference; replace it with the doc string. */
2678 int doc_reference
= 0;
2680 /* Initialize this to 1 if we are reading a list. */
2681 int first_in_list
= flag
<= 0;
2690 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2695 /* While building, if the list starts with #$, treat it specially. */
2696 if (EQ (elt
, Vload_file_name
)
2698 && !NILP (Vpurify_flag
))
2700 if (NILP (Vdoc_file_name
))
2701 /* We have not yet called Snarf-documentation, so assume
2702 this file is described in the DOC-MM.NN file
2703 and Snarf-documentation will fill in the right value later.
2704 For now, replace the whole list with 0. */
2707 /* We have already called Snarf-documentation, so make a relative
2708 file name for this file, so it can be found properly
2709 in the installed Lisp directory.
2710 We don't use Fexpand_file_name because that would make
2711 the directory absolute now. */
2712 elt
= concat2 (build_string ("../lisp/"),
2713 Ffile_name_nondirectory (elt
));
2715 else if (EQ (elt
, Vload_file_name
)
2717 && load_force_doc_strings
)
2726 Fsignal (Qinvalid_read_syntax
,
2727 Fcons (make_string (") or . in a vector", 18), Qnil
));
2735 XSETCDR (tail
, read0 (readcharfun
));
2737 val
= read0 (readcharfun
);
2738 read1 (readcharfun
, &ch
, 0);
2742 if (doc_reference
== 1)
2743 return make_number (0);
2744 if (doc_reference
== 2)
2746 /* Get a doc string from the file we are loading.
2747 If it's in saved_doc_string, get it from there. */
2748 int pos
= XINT (XCDR (val
));
2749 /* Position is negative for user variables. */
2750 if (pos
< 0) pos
= -pos
;
2751 if (pos
>= saved_doc_string_position
2752 && pos
< (saved_doc_string_position
2753 + saved_doc_string_length
))
2755 int start
= pos
- saved_doc_string_position
;
2758 /* Process quoting with ^A,
2759 and find the end of the string,
2760 which is marked with ^_ (037). */
2761 for (from
= start
, to
= start
;
2762 saved_doc_string
[from
] != 037;)
2764 int c
= saved_doc_string
[from
++];
2767 c
= saved_doc_string
[from
++];
2769 saved_doc_string
[to
++] = c
;
2771 saved_doc_string
[to
++] = 0;
2773 saved_doc_string
[to
++] = 037;
2776 saved_doc_string
[to
++] = c
;
2779 return make_string (saved_doc_string
+ start
,
2782 /* Look in prev_saved_doc_string the same way. */
2783 else if (pos
>= prev_saved_doc_string_position
2784 && pos
< (prev_saved_doc_string_position
2785 + prev_saved_doc_string_length
))
2787 int start
= pos
- prev_saved_doc_string_position
;
2790 /* Process quoting with ^A,
2791 and find the end of the string,
2792 which is marked with ^_ (037). */
2793 for (from
= start
, to
= start
;
2794 prev_saved_doc_string
[from
] != 037;)
2796 int c
= prev_saved_doc_string
[from
++];
2799 c
= prev_saved_doc_string
[from
++];
2801 prev_saved_doc_string
[to
++] = c
;
2803 prev_saved_doc_string
[to
++] = 0;
2805 prev_saved_doc_string
[to
++] = 037;
2808 prev_saved_doc_string
[to
++] = c
;
2811 return make_string (prev_saved_doc_string
+ start
,
2815 return get_doc_string (val
, 0, 0);
2820 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2822 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2824 tem
= (read_pure
&& flag
<= 0
2825 ? pure_cons (elt
, Qnil
)
2826 : Fcons (elt
, Qnil
));
2828 XSETCDR (tail
, tem
);
2833 defunflag
= EQ (elt
, Qdefun
);
2834 else if (defunflag
> 0)
2839 Lisp_Object Vobarray
;
2840 Lisp_Object initial_obarray
;
2842 /* oblookup stores the bucket number here, for the sake of Funintern. */
2844 int oblookup_last_bucket_number
;
2846 static int hash_string ();
2847 Lisp_Object
oblookup ();
2849 /* Get an error if OBARRAY is not an obarray.
2850 If it is one, return it. */
2853 check_obarray (obarray
)
2854 Lisp_Object obarray
;
2856 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2858 /* If Vobarray is now invalid, force it to be valid. */
2859 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2861 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2866 /* Intern the C string STR: return a symbol with that name,
2867 interned in the current obarray. */
2874 int len
= strlen (str
);
2875 Lisp_Object obarray
;
2878 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2879 obarray
= check_obarray (obarray
);
2880 tem
= oblookup (obarray
, str
, len
, len
);
2883 return Fintern (make_string (str
, len
), obarray
);
2886 /* Create an uninterned symbol with name STR. */
2892 int len
= strlen (str
);
2894 return Fmake_symbol ((!NILP (Vpurify_flag
)
2895 ? make_pure_string (str
, len
, len
, 0)
2896 : make_string (str
, len
)));
2899 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2900 doc
: /* Return the canonical symbol whose name is STRING.
2901 If there is none, one is created by this function and returned.
2902 A second optional argument specifies the obarray to use;
2903 it defaults to the value of `obarray'. */)
2905 Lisp_Object string
, obarray
;
2907 register Lisp_Object tem
, sym
, *ptr
;
2909 if (NILP (obarray
)) obarray
= Vobarray
;
2910 obarray
= check_obarray (obarray
);
2912 CHECK_STRING (string
);
2914 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2915 XSTRING (string
)->size
,
2916 STRING_BYTES (XSTRING (string
)));
2917 if (!INTEGERP (tem
))
2920 if (!NILP (Vpurify_flag
))
2921 string
= Fpurecopy (string
);
2922 sym
= Fmake_symbol (string
);
2924 if (EQ (obarray
, initial_obarray
))
2925 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2927 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2929 if ((XSTRING (string
)->data
[0] == ':')
2930 && EQ (obarray
, initial_obarray
))
2932 XSYMBOL (sym
)->constant
= 1;
2933 XSYMBOL (sym
)->value
= sym
;
2936 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2938 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2940 XSYMBOL (sym
)->next
= 0;
2945 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2946 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
2947 NAME may be a string or a symbol. If it is a symbol, that exact
2948 symbol is searched for.
2949 A second optional argument specifies the obarray to use;
2950 it defaults to the value of `obarray'. */)
2952 Lisp_Object name
, obarray
;
2954 register Lisp_Object tem
;
2955 struct Lisp_String
*string
;
2957 if (NILP (obarray
)) obarray
= Vobarray
;
2958 obarray
= check_obarray (obarray
);
2960 if (!SYMBOLP (name
))
2962 CHECK_STRING (name
);
2963 string
= XSTRING (name
);
2966 string
= XSYMBOL (name
)->name
;
2968 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2969 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2975 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2976 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
2977 The value is t if a symbol was found and deleted, nil otherwise.
2978 NAME may be a string or a symbol. If it is a symbol, that symbol
2979 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
2980 OBARRAY defaults to the value of the variable `obarray'. */)
2982 Lisp_Object name
, obarray
;
2984 register Lisp_Object string
, tem
;
2987 if (NILP (obarray
)) obarray
= Vobarray
;
2988 obarray
= check_obarray (obarray
);
2991 XSETSTRING (string
, XSYMBOL (name
)->name
);
2994 CHECK_STRING (name
);
2998 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2999 XSTRING (string
)->size
,
3000 STRING_BYTES (XSTRING (string
)));
3003 /* If arg was a symbol, don't delete anything but that symbol itself. */
3004 if (SYMBOLP (name
) && !EQ (name
, tem
))
3007 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3008 XSYMBOL (tem
)->constant
= 0;
3009 XSYMBOL (tem
)->indirect_variable
= 0;
3011 hash
= oblookup_last_bucket_number
;
3013 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3015 if (XSYMBOL (tem
)->next
)
3016 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3018 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3022 Lisp_Object tail
, following
;
3024 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3025 XSYMBOL (tail
)->next
;
3028 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3029 if (EQ (following
, tem
))
3031 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3040 /* Return the symbol in OBARRAY whose names matches the string
3041 of SIZE characters (SIZE_BYTE bytes) at PTR.
3042 If there is no such symbol in OBARRAY, return nil.
3044 Also store the bucket number in oblookup_last_bucket_number. */
3047 oblookup (obarray
, ptr
, size
, size_byte
)
3048 Lisp_Object obarray
;
3050 int size
, size_byte
;
3054 register Lisp_Object tail
;
3055 Lisp_Object bucket
, tem
;
3057 if (!VECTORP (obarray
)
3058 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3060 obarray
= check_obarray (obarray
);
3061 obsize
= XVECTOR (obarray
)->size
;
3063 /* This is sometimes needed in the middle of GC. */
3064 obsize
&= ~ARRAY_MARK_FLAG
;
3065 /* Combining next two lines breaks VMS C 2.3. */
3066 hash
= hash_string (ptr
, size_byte
);
3068 bucket
= XVECTOR (obarray
)->contents
[hash
];
3069 oblookup_last_bucket_number
= hash
;
3070 if (XFASTINT (bucket
) == 0)
3072 else if (!SYMBOLP (bucket
))
3073 error ("Bad data in guts of obarray"); /* Like CADR error message */
3075 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3077 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3078 && XSYMBOL (tail
)->name
->size
== size
3079 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3081 else if (XSYMBOL (tail
)->next
== 0)
3084 XSETINT (tem
, hash
);
3089 hash_string (ptr
, len
)
3093 register unsigned char *p
= ptr
;
3094 register unsigned char *end
= p
+ len
;
3095 register unsigned char c
;
3096 register int hash
= 0;
3101 if (c
>= 0140) c
-= 40;
3102 hash
= ((hash
<<3) + (hash
>>28) + c
);
3104 return hash
& 07777777777;
3108 map_obarray (obarray
, fn
, arg
)
3109 Lisp_Object obarray
;
3110 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3114 register Lisp_Object tail
;
3115 CHECK_VECTOR (obarray
);
3116 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3118 tail
= XVECTOR (obarray
)->contents
[i
];
3123 if (XSYMBOL (tail
)->next
== 0)
3125 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3131 mapatoms_1 (sym
, function
)
3132 Lisp_Object sym
, function
;
3134 call1 (function
, sym
);
3137 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3138 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3139 OBARRAY defaults to the value of `obarray'. */)
3141 Lisp_Object function
, obarray
;
3143 if (NILP (obarray
)) obarray
= Vobarray
;
3144 obarray
= check_obarray (obarray
);
3146 map_obarray (obarray
, mapatoms_1
, function
);
3150 #define OBARRAY_SIZE 1511
3155 Lisp_Object oblength
;
3159 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3161 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3162 Vobarray
= Fmake_vector (oblength
, make_number (0));
3163 initial_obarray
= Vobarray
;
3164 staticpro (&initial_obarray
);
3165 /* Intern nil in the obarray */
3166 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3167 XSYMBOL (Qnil
)->constant
= 1;
3169 /* These locals are to kludge around a pyramid compiler bug. */
3170 hash
= hash_string ("nil", 3);
3171 /* Separate statement here to avoid VAXC bug. */
3172 hash
%= OBARRAY_SIZE
;
3173 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3176 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3177 XSYMBOL (Qnil
)->function
= Qunbound
;
3178 XSYMBOL (Qunbound
)->value
= Qunbound
;
3179 XSYMBOL (Qunbound
)->function
= Qunbound
;
3182 XSYMBOL (Qnil
)->value
= Qnil
;
3183 XSYMBOL (Qnil
)->plist
= Qnil
;
3184 XSYMBOL (Qt
)->value
= Qt
;
3185 XSYMBOL (Qt
)->constant
= 1;
3187 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3190 Qvariable_documentation
= intern ("variable-documentation");
3191 staticpro (&Qvariable_documentation
);
3193 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3194 read_buffer
= (char *) xmalloc (read_buffer_size
);
3199 struct Lisp_Subr
*sname
;
3202 sym
= intern (sname
->symbol_name
);
3203 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3206 #ifdef NOTDEF /* use fset in subr.el now */
3208 defalias (sname
, string
)
3209 struct Lisp_Subr
*sname
;
3213 sym
= intern (string
);
3214 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3218 /* Define an "integer variable"; a symbol whose value is forwarded
3219 to a C variable of type int. Sample call: */
3220 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3222 defvar_int (namestring
, address
)
3226 Lisp_Object sym
, val
;
3227 sym
= intern (namestring
);
3228 val
= allocate_misc ();
3229 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3230 XINTFWD (val
)->intvar
= address
;
3231 SET_SYMBOL_VALUE (sym
, val
);
3234 /* Similar but define a variable whose value is T if address contains 1,
3235 NIL if address contains 0 */
3237 defvar_bool (namestring
, address
)
3241 Lisp_Object sym
, val
;
3242 sym
= intern (namestring
);
3243 val
= allocate_misc ();
3244 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3245 XBOOLFWD (val
)->boolvar
= address
;
3246 SET_SYMBOL_VALUE (sym
, val
);
3247 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3250 /* Similar but define a variable whose value is the Lisp Object stored
3251 at address. Two versions: with and without gc-marking of the C
3252 variable. The nopro version is used when that variable will be
3253 gc-marked for some other reason, since marking the same slot twice
3254 can cause trouble with strings. */
3256 defvar_lisp_nopro (namestring
, address
)
3258 Lisp_Object
*address
;
3260 Lisp_Object sym
, val
;
3261 sym
= intern (namestring
);
3262 val
= allocate_misc ();
3263 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3264 XOBJFWD (val
)->objvar
= address
;
3265 SET_SYMBOL_VALUE (sym
, val
);
3269 defvar_lisp (namestring
, address
)
3271 Lisp_Object
*address
;
3273 defvar_lisp_nopro (namestring
, address
);
3274 staticpro (address
);
3277 /* Similar but define a variable whose value is the Lisp Object stored in
3278 the current buffer. address is the address of the slot in the buffer
3279 that is current now. */
3282 defvar_per_buffer (namestring
, address
, type
, doc
)
3284 Lisp_Object
*address
;
3288 Lisp_Object sym
, val
;
3290 extern struct buffer buffer_local_symbols
;
3292 sym
= intern (namestring
);
3293 val
= allocate_misc ();
3294 offset
= (char *)address
- (char *)current_buffer
;
3296 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3297 XBUFFER_OBJFWD (val
)->offset
= offset
;
3298 SET_SYMBOL_VALUE (sym
, val
);
3299 PER_BUFFER_SYMBOL (offset
) = sym
;
3300 PER_BUFFER_TYPE (offset
) = type
;
3302 if (PER_BUFFER_IDX (offset
) == 0)
3303 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3304 slot of buffer_local_flags */
3309 /* Similar but define a variable whose value is the Lisp Object stored
3310 at a particular offset in the current kboard object. */
3313 defvar_kboard (namestring
, offset
)
3317 Lisp_Object sym
, val
;
3318 sym
= intern (namestring
);
3319 val
= allocate_misc ();
3320 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3321 XKBOARD_OBJFWD (val
)->offset
= offset
;
3322 SET_SYMBOL_VALUE (sym
, val
);
3325 /* Record the value of load-path used at the start of dumping
3326 so we can see if the site changed it later during dumping. */
3327 static Lisp_Object dump_path
;
3333 int turn_off_warning
= 0;
3335 /* Compute the default load-path. */
3337 normal
= PATH_LOADSEARCH
;
3338 Vload_path
= decode_env_path (0, normal
);
3340 if (NILP (Vpurify_flag
))
3341 normal
= PATH_LOADSEARCH
;
3343 normal
= PATH_DUMPLOADSEARCH
;
3345 /* In a dumped Emacs, we normally have to reset the value of
3346 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3347 uses ../lisp, instead of the path of the installed elisp
3348 libraries. However, if it appears that Vload_path was changed
3349 from the default before dumping, don't override that value. */
3352 if (! NILP (Fequal (dump_path
, Vload_path
)))
3354 Vload_path
= decode_env_path (0, normal
);
3355 if (!NILP (Vinstallation_directory
))
3357 /* Add to the path the lisp subdir of the
3358 installation dir, if it exists. */
3359 Lisp_Object tem
, tem1
;
3360 tem
= Fexpand_file_name (build_string ("lisp"),
3361 Vinstallation_directory
);
3362 tem1
= Ffile_exists_p (tem
);
3365 if (NILP (Fmember (tem
, Vload_path
)))
3367 turn_off_warning
= 1;
3368 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3372 /* That dir doesn't exist, so add the build-time
3373 Lisp dirs instead. */
3374 Vload_path
= nconc2 (Vload_path
, dump_path
);
3376 /* Add leim under the installation dir, if it exists. */
3377 tem
= Fexpand_file_name (build_string ("leim"),
3378 Vinstallation_directory
);
3379 tem1
= Ffile_exists_p (tem
);
3382 if (NILP (Fmember (tem
, Vload_path
)))
3383 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3386 /* Add site-list under the installation dir, if it exists. */
3387 tem
= Fexpand_file_name (build_string ("site-lisp"),
3388 Vinstallation_directory
);
3389 tem1
= Ffile_exists_p (tem
);
3392 if (NILP (Fmember (tem
, Vload_path
)))
3393 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3396 /* If Emacs was not built in the source directory,
3397 and it is run from where it was built, add to load-path
3398 the lisp, leim and site-lisp dirs under that directory. */
3400 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3404 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3405 Vinstallation_directory
);
3406 tem1
= Ffile_exists_p (tem
);
3408 /* Don't be fooled if they moved the entire source tree
3409 AFTER dumping Emacs. If the build directory is indeed
3410 different from the source dir, src/Makefile.in and
3411 src/Makefile will not be found together. */
3412 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3413 Vinstallation_directory
);
3414 tem2
= Ffile_exists_p (tem
);
3415 if (!NILP (tem1
) && NILP (tem2
))
3417 tem
= Fexpand_file_name (build_string ("lisp"),
3420 if (NILP (Fmember (tem
, Vload_path
)))
3421 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3423 tem
= Fexpand_file_name (build_string ("leim"),
3426 if (NILP (Fmember (tem
, Vload_path
)))
3427 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3429 tem
= Fexpand_file_name (build_string ("site-lisp"),
3432 if (NILP (Fmember (tem
, Vload_path
)))
3433 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3441 /* NORMAL refers to the lisp dir in the source directory. */
3442 /* We used to add ../lisp at the front here, but
3443 that caused trouble because it was copied from dump_path
3444 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3445 It should be unnecessary. */
3446 Vload_path
= decode_env_path (0, normal
);
3447 dump_path
= Vload_path
;
3452 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3453 almost never correct, thereby causing a warning to be printed out that
3454 confuses users. Since PATH_LOADSEARCH is always overridden by the
3455 EMACSLOADPATH environment variable below, disable the warning on NT. */
3457 /* Warn if dirs in the *standard* path don't exist. */
3458 if (!turn_off_warning
)
3460 Lisp_Object path_tail
;
3462 for (path_tail
= Vload_path
;
3464 path_tail
= XCDR (path_tail
))
3466 Lisp_Object dirfile
;
3467 dirfile
= Fcar (path_tail
);
3468 if (STRINGP (dirfile
))
3470 dirfile
= Fdirectory_file_name (dirfile
);
3471 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3472 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3477 #endif /* WINDOWSNT */
3479 /* If the EMACSLOADPATH environment variable is set, use its value.
3480 This doesn't apply if we're dumping. */
3482 if (NILP (Vpurify_flag
)
3483 && egetenv ("EMACSLOADPATH"))
3485 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3489 load_in_progress
= 0;
3490 Vload_file_name
= Qnil
;
3492 load_descriptor_list
= Qnil
;
3494 Vstandard_input
= Qt
;
3495 Vloads_in_progress
= Qnil
;
3498 /* Print a warning, using format string FORMAT, that directory DIRNAME
3499 does not exist. Print it on stderr and put it in *Message*. */
3502 dir_warning (format
, dirname
)
3504 Lisp_Object dirname
;
3507 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3509 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3510 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3511 /* Don't log the warning before we've initialized!! */
3513 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3520 defsubr (&Sread_from_string
);
3522 defsubr (&Sintern_soft
);
3523 defsubr (&Sunintern
);
3525 defsubr (&Seval_buffer
);
3526 defsubr (&Seval_region
);
3527 defsubr (&Sread_char
);
3528 defsubr (&Sread_char_exclusive
);
3529 defsubr (&Sread_event
);
3530 defsubr (&Sget_file_char
);
3531 defsubr (&Smapatoms
);
3533 DEFVAR_LISP ("obarray", &Vobarray
,
3534 doc
: /* Symbol table for use by `intern' and `read'.
3535 It is a vector whose length ought to be prime for best results.
3536 The vector's contents don't make sense if examined from Lisp programs;
3537 to find all the symbols in an obarray, use `mapatoms'. */);
3539 DEFVAR_LISP ("values", &Vvalues
,
3540 doc
: /* List of values of all expressions which were read, evaluated and printed.
3541 Order is reverse chronological. */);
3543 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3544 doc
: /* Stream for read to get input from.
3545 See documentation of `read' for possible values. */);
3546 Vstandard_input
= Qt
;
3548 DEFVAR_LISP ("load-path", &Vload_path
,
3549 doc
: /* *List of directories to search for files to load.
3550 Each element is a string (directory name) or nil (try default directory).
3551 Initialized based on EMACSLOADPATH environment variable, if any,
3552 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3554 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3555 doc
: /* *List of suffixes to try for files to load.
3556 This list should not include the empty string. */);
3557 Vload_suffixes
= Fcons (build_string (".elc"),
3558 Fcons (build_string (".el"), Qnil
));
3559 /* We don't use empty_string because it's not initialized yet. */
3560 default_suffixes
= Fcons (build_string (""), Qnil
);
3561 staticpro (&default_suffixes
);
3563 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3564 doc
: /* Non-nil iff inside of `load'. */);
3566 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3567 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3568 Each element looks like (FILENAME FORMS...).
3569 When `load' is run and the file-name argument is FILENAME,
3570 the FORMS in the corresponding element are executed at the end of loading.
3572 FILENAME must match exactly! Normally FILENAME is the name of a library,
3573 with no directory specified, since that is how `load' is normally called.
3574 An error in FORMS does not undo the load,
3575 but does prevent execution of the rest of the FORMS.
3576 FILENAME can also be a symbol (a feature) and FORMS are then executed
3577 when the corresponding call to `provide' is made. */);
3578 Vafter_load_alist
= Qnil
;
3580 DEFVAR_LISP ("load-history", &Vload_history
,
3581 doc
: /* Alist mapping source file names to symbols and features.
3582 Each alist element is a list that starts with a file name,
3583 except for one element (optional) that starts with nil and describes
3584 definitions evaluated from buffers not visiting files.
3585 The remaining elements of each list are symbols defined as functions
3586 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3587 and `(autoload . SYMBOL)'. */);
3588 Vload_history
= Qnil
;
3590 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3591 doc
: /* Full name of file being loaded by `load'. */);
3592 Vload_file_name
= Qnil
;
3594 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3595 doc
: /* File name, including directory, of user's initialization file.
3596 If the file loaded had extension `.elc' and there was a corresponding `.el'
3597 file, this variable contains the name of the .el file, suitable for use
3598 by functions like `custom-save-all' which edit the init file. */);
3599 Vuser_init_file
= Qnil
;
3601 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3602 doc
: /* Used for internal purposes by `load'. */);
3603 Vcurrent_load_list
= Qnil
;
3605 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3606 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3607 The default is nil, which means use the function `read'. */);
3608 Vload_read_function
= Qnil
;
3610 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3611 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3612 This function is for doing code conversion before reading the source file.
3613 If nil, loading is done without any code conversion.
3614 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3615 FULLNAME is the full name of FILE.
3616 See `load' for the meaning of the remaining arguments. */);
3617 Vload_source_file_function
= Qnil
;
3619 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3620 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3621 This is useful when the file being loaded is a temporary copy. */);
3622 load_force_doc_strings
= 0;
3624 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3625 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3626 This is normally bound by `load' and `eval-buffer' to control `read',
3627 and is not meant for users to change. */);
3628 load_convert_to_unibyte
= 0;
3630 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3631 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3632 You cannot count on them to still be there! */);
3634 = Fexpand_file_name (build_string ("../"),
3635 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3637 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3638 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3639 Vpreloaded_file_list
= Qnil
;
3641 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3642 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3643 Vbyte_boolean_vars
= Qnil
;
3645 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3646 doc
: /* Non-nil means load dangerous compiled Lisp files.
3647 Some versions of XEmacs use different byte codes than Emacs. These
3648 incompatible byte codes can make Emacs crash when it tries to execute
3650 load_dangerous_libraries
= 0;
3652 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3653 doc
: /* Regular expression matching safe to load compiled Lisp files.
3654 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3655 from the file, and matches them against this regular expression.
3656 When the regular expression matches, the file is considered to be safe
3657 to load. See also `load-dangerous-libraries'. */);
3658 Vbytecomp_version_regexp
3659 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3661 DEFVAR_LISP ("recursive-load-depth-limit", &Vrecursive_load_depth_limit
,
3662 doc
: /* Limit for depth of recursive loads.
3663 Value should be either an integer > 0 specifying the limit, or nil for
3665 Vrecursive_load_depth_limit
= make_number (50);
3667 /* Vsource_directory was initialized in init_lread. */
3669 load_descriptor_list
= Qnil
;
3670 staticpro (&load_descriptor_list
);
3672 Qcurrent_load_list
= intern ("current-load-list");
3673 staticpro (&Qcurrent_load_list
);
3675 Qstandard_input
= intern ("standard-input");
3676 staticpro (&Qstandard_input
);
3678 Qread_char
= intern ("read-char");
3679 staticpro (&Qread_char
);
3681 Qget_file_char
= intern ("get-file-char");
3682 staticpro (&Qget_file_char
);
3684 Qbackquote
= intern ("`");
3685 staticpro (&Qbackquote
);
3686 Qcomma
= intern (",");
3687 staticpro (&Qcomma
);
3688 Qcomma_at
= intern (",@");
3689 staticpro (&Qcomma_at
);
3690 Qcomma_dot
= intern (",.");
3691 staticpro (&Qcomma_dot
);
3693 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3694 staticpro (&Qinhibit_file_name_operation
);
3696 Qascii_character
= intern ("ascii-character");
3697 staticpro (&Qascii_character
);
3699 Qfunction
= intern ("function");
3700 staticpro (&Qfunction
);
3702 Qload
= intern ("load");
3705 Qload_file_name
= intern ("load-file-name");
3706 staticpro (&Qload_file_name
);
3708 staticpro (&dump_path
);
3710 staticpro (&read_objects
);
3711 read_objects
= Qnil
;
3712 staticpro (&seen_list
);
3714 Vloads_in_progress
= Qnil
;
3715 staticpro (&Vloads_in_progress
);