1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
36 #include "termhooks.h"
39 #include <sys/inode.h>
44 #include <unistd.h> /* to get X_OK */
61 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
79 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
80 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
81 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
82 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
83 Lisp_Object Qinhibit_file_name_operation
;
85 extern Lisp_Object Qevent_symbol_element_mask
;
86 extern Lisp_Object Qfile_exists_p
;
88 /* non-zero if inside `load' */
91 /* Directory in which the sources were found. */
92 Lisp_Object Vsource_directory
;
94 /* Search path and suffixes for files to be loaded. */
95 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
97 /* File name of user's init file. */
98 Lisp_Object Vuser_init_file
;
100 /* This is the user-visible association list that maps features to
101 lists of defs in their load files. */
102 Lisp_Object Vload_history
;
104 /* This is used to build the load history. */
105 Lisp_Object Vcurrent_load_list
;
107 /* List of files that were preloaded. */
108 Lisp_Object Vpreloaded_file_list
;
110 /* Name of file actually being read by `load'. */
111 Lisp_Object Vload_file_name
;
113 /* Function to use for reading, in `load' and friends. */
114 Lisp_Object Vload_read_function
;
116 /* The association list of objects read with the #n=object form.
117 Each member of the list has the form (n . object), and is used to
118 look up the object for the corresponding #n# construct.
119 It must be set to nil before all top-level calls to read0. */
120 Lisp_Object read_objects
;
122 /* Nonzero means load should forcibly load all dynamic doc strings. */
123 static int load_force_doc_strings
;
125 /* Nonzero means read should convert strings to unibyte. */
126 static int load_convert_to_unibyte
;
128 /* Function to use for loading an Emacs lisp source file (not
129 compiled) instead of readevalloop. */
130 Lisp_Object Vload_source_file_function
;
132 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
133 Lisp_Object Vbyte_boolean_vars
;
135 /* List of descriptors now open for Fload. */
136 static Lisp_Object load_descriptor_list
;
138 /* File for get_file_char to read from. Use by load. */
139 static FILE *instream
;
141 /* When nonzero, read conses in pure space */
142 static int read_pure
;
144 /* For use within read-from-string (this reader is non-reentrant!!) */
145 static int read_from_string_index
;
146 static int read_from_string_index_byte
;
147 static int read_from_string_limit
;
149 /* Number of bytes left to read in the buffer character
150 that `readchar' has already advanced over. */
151 static int readchar_backlog
;
153 /* This contains the last string skipped with #@. */
154 static char *saved_doc_string
;
155 /* Length of buffer allocated in saved_doc_string. */
156 static int saved_doc_string_size
;
157 /* Length of actual data in saved_doc_string. */
158 static int saved_doc_string_length
;
159 /* This is the file position that string came from. */
160 static file_offset saved_doc_string_position
;
162 /* This contains the previous string skipped with #@.
163 We copy it from saved_doc_string when a new string
164 is put in saved_doc_string. */
165 static char *prev_saved_doc_string
;
166 /* Length of buffer allocated in prev_saved_doc_string. */
167 static int prev_saved_doc_string_size
;
168 /* Length of actual data in prev_saved_doc_string. */
169 static int prev_saved_doc_string_length
;
170 /* This is the file position that string came from. */
171 static file_offset prev_saved_doc_string_position
;
173 /* Nonzero means inside a new-style backquote
174 with no surrounding parentheses.
175 Fread initializes this to zero, so we need not specbind it
176 or worry about what happens to it when there is an error. */
177 static int new_backquote_flag
;
179 /* A list of file names for files being loaded in Fload. Used to
180 check for recursive loads. */
182 static Lisp_Object Vloads_in_progress
;
184 /* Non-zero means load dangerous compiled Lisp files. */
186 int load_dangerous_libraries
;
188 /* A regular expression used to detect files compiled with Emacs. */
190 static Lisp_Object Vbytecomp_version_regexp
;
192 static void to_multibyte
P_ ((char **, char **, int *));
193 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
194 Lisp_Object (*) (), int,
195 Lisp_Object
, Lisp_Object
));
196 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
197 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
200 /* Handle unreading and rereading of characters.
201 Write READCHAR to read a character,
202 UNREAD(c) to unread c to be read again.
204 These macros actually read/unread a byte code, multibyte characters
205 are not handled here. The caller should manage them if necessary.
208 #define READCHAR readchar (readcharfun)
209 #define UNREAD(c) unreadchar (readcharfun, c)
212 readchar (readcharfun
)
213 Lisp_Object readcharfun
;
218 if (BUFFERP (readcharfun
))
220 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
222 int pt_byte
= BUF_PT_BYTE (inbuffer
);
223 int orig_pt_byte
= pt_byte
;
225 if (readchar_backlog
> 0)
226 /* We get the address of the byte just passed,
227 which is the last byte of the character.
228 The other bytes in this character are consecutive with it,
229 because the gap can't be in the middle of a character. */
230 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
231 - --readchar_backlog
);
233 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
236 readchar_backlog
= -1;
238 if (! NILP (inbuffer
->enable_multibyte_characters
))
240 /* Fetch the character code from the buffer. */
241 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
242 BUF_INC_POS (inbuffer
, pt_byte
);
243 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
247 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
250 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
254 if (MARKERP (readcharfun
))
256 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
258 int bytepos
= marker_byte_position (readcharfun
);
259 int orig_bytepos
= bytepos
;
261 if (readchar_backlog
> 0)
262 /* We get the address of the byte just passed,
263 which is the last byte of the character.
264 The other bytes in this character are consecutive with it,
265 because the gap can't be in the middle of a character. */
266 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
267 - --readchar_backlog
);
269 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
272 readchar_backlog
= -1;
274 if (! NILP (inbuffer
->enable_multibyte_characters
))
276 /* Fetch the character code from the buffer. */
277 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
278 BUF_INC_POS (inbuffer
, bytepos
);
279 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
283 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
287 XMARKER (readcharfun
)->bytepos
= bytepos
;
288 XMARKER (readcharfun
)->charpos
++;
293 if (EQ (readcharfun
, Qlambda
))
294 return read_bytecode_char (0);
296 if (EQ (readcharfun
, Qget_file_char
))
300 /* Interrupted reads have been observed while reading over the network */
301 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
310 if (STRINGP (readcharfun
))
312 if (read_from_string_index
>= read_from_string_limit
)
315 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
316 read_from_string_index
,
317 read_from_string_index_byte
);
322 tem
= call0 (readcharfun
);
329 /* Unread the character C in the way appropriate for the stream READCHARFUN.
330 If the stream is a user function, call it with the char as argument. */
333 unreadchar (readcharfun
, c
)
334 Lisp_Object readcharfun
;
338 /* Don't back up the pointer if we're unreading the end-of-input mark,
339 since readchar didn't advance it when we read it. */
341 else if (BUFFERP (readcharfun
))
343 struct buffer
*b
= XBUFFER (readcharfun
);
344 int bytepos
= BUF_PT_BYTE (b
);
346 if (readchar_backlog
>= 0)
351 if (! NILP (b
->enable_multibyte_characters
))
352 BUF_DEC_POS (b
, bytepos
);
356 BUF_PT_BYTE (b
) = bytepos
;
359 else if (MARKERP (readcharfun
))
361 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
362 int bytepos
= XMARKER (readcharfun
)->bytepos
;
364 if (readchar_backlog
>= 0)
368 XMARKER (readcharfun
)->charpos
--;
369 if (! NILP (b
->enable_multibyte_characters
))
370 BUF_DEC_POS (b
, bytepos
);
374 XMARKER (readcharfun
)->bytepos
= bytepos
;
377 else if (STRINGP (readcharfun
))
379 read_from_string_index
--;
380 read_from_string_index_byte
381 = string_char_to_byte (readcharfun
, read_from_string_index
);
383 else if (EQ (readcharfun
, Qlambda
))
384 read_bytecode_char (1);
385 else if (EQ (readcharfun
, Qget_file_char
))
386 ungetc (c
, instream
);
388 call1 (readcharfun
, make_number (c
));
391 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
392 static int read_multibyte ();
393 static Lisp_Object
substitute_object_recurse ();
394 static void substitute_object_in_subtree (), substitute_in_interval ();
397 /* Get a character from the tty. */
399 extern Lisp_Object
read_char ();
401 /* Read input events until we get one that's acceptable for our purposes.
403 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
404 until we get a character we like, and then stuffed into
407 If ASCII_REQUIRED is non-zero, we check function key events to see
408 if the unmodified version of the symbol has a Qascii_character
409 property, and use that character, if present.
411 If ERROR_NONASCII is non-zero, we signal an error if the input we
412 get isn't an ASCII character with modifiers. If it's zero but
413 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
416 If INPUT_METHOD is nonzero, we invoke the current input method
417 if the character warrants that. */
420 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
422 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
424 register Lisp_Object val
, delayed_switch_frame
;
426 #ifdef HAVE_WINDOW_SYSTEM
427 if (display_hourglass_p
)
431 delayed_switch_frame
= Qnil
;
433 /* Read until we get an acceptable event. */
435 val
= read_char (0, 0, 0,
436 (input_method
? Qnil
: Qt
),
442 /* switch-frame events are put off until after the next ASCII
443 character. This is better than signaling an error just because
444 the last characters were typed to a separate minibuffer frame,
445 for example. Eventually, some code which can deal with
446 switch-frame events will read it and process it. */
448 && EVENT_HAS_PARAMETERS (val
)
449 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
451 delayed_switch_frame
= val
;
457 /* Convert certain symbols to their ASCII equivalents. */
460 Lisp_Object tem
, tem1
;
461 tem
= Fget (val
, Qevent_symbol_element_mask
);
464 tem1
= Fget (Fcar (tem
), Qascii_character
);
465 /* Merge this symbol's modifier bits
466 with the ASCII equivalent of its basic code. */
468 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
472 /* If we don't have a character now, deal with it appropriately. */
477 Vunread_command_events
= Fcons (val
, Qnil
);
478 error ("Non-character input-event");
485 if (! NILP (delayed_switch_frame
))
486 unread_switch_frame
= delayed_switch_frame
;
490 #ifdef HAVE_WINDOW_SYSTEM
491 if (display_hourglass_p
)
500 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
501 doc
: /* Read a character from the command input (keyboard or macro).
502 It is returned as a number.
503 If the user generates an event which is not a character (i.e. a mouse
504 click or function key event), `read-char' signals an error. As an
505 exception, switch-frame events are put off until non-ASCII events can
507 If you want to read non-character events, or ignore them, call
508 `read-event' or `read-char-exclusive' instead.
510 If the optional argument PROMPT is non-nil, display that as a prompt.
511 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
512 input method is turned on in the current buffer, that input method
513 is used for reading a character. */)
514 (prompt
, inherit_input_method
)
515 Lisp_Object prompt
, inherit_input_method
;
518 message_with_string ("%s", prompt
, 0);
519 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
522 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
523 doc
: /* Read an event object from the input stream.
524 If the optional argument PROMPT is non-nil, display that as a prompt.
525 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
526 input method is turned on in the current buffer, that input method
527 is used for reading a character. */)
528 (prompt
, inherit_input_method
)
529 Lisp_Object prompt
, inherit_input_method
;
532 message_with_string ("%s", prompt
, 0);
533 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
536 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
537 doc
: /* Read a character from the command input (keyboard or macro).
538 It is returned as a number. Non-character events are ignored.
540 If the optional argument PROMPT is non-nil, display that as a prompt.
541 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
542 input method is turned on in the current buffer, that input method
543 is used for reading a character. */)
544 (prompt
, inherit_input_method
)
545 Lisp_Object prompt
, inherit_input_method
;
548 message_with_string ("%s", prompt
, 0);
549 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
552 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
553 doc
: /* Don't use this yourself. */)
556 register Lisp_Object val
;
557 XSETINT (val
, getc (instream
));
563 /* Value is non-zero if the file asswociated with file descriptor FD
564 is a compiled Lisp file that's safe to load. Only files compiled
565 with Emacs are safe to load. Files compiled with XEmacs can lead
566 to a crash in Fbyte_code because of an incompatible change in the
577 /* Read the first few bytes from the file, and look for a line
578 specifying the byte compiler version used. */
579 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
584 /* Skip to the next newline, skipping over the initial `ELC'
585 with NUL bytes following it. */
586 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
590 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
595 lseek (fd
, 0, SEEK_SET
);
600 /* Callback for record_unwind_protect. Restore the old load list OLD,
601 after loading a file successfully. */
604 record_load_unwind (old
)
607 return Vloads_in_progress
= old
;
611 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
612 doc
: /* Execute a file of Lisp code named FILE.
613 First try FILE with `.elc' appended, then try with `.el',
614 then try FILE unmodified. Environment variable references in FILE
615 are replaced with their values by calling `substitute-in-file-name'.
616 This function searches the directories in `load-path'.
617 If optional second arg NOERROR is non-nil,
618 report no error if FILE doesn't exist.
619 Print messages at start and end of loading unless
620 optional third arg NOMESSAGE is non-nil.
621 If optional fourth arg NOSUFFIX is non-nil, don't try adding
622 suffixes `.elc' or `.el' to the specified name FILE.
623 If optional fifth arg MUST-SUFFIX is non-nil, insist on
624 the suffix `.elc' or `.el'; don't accept just FILE unless
625 it ends in one of those suffixes or includes a directory name.
626 Return t if file exists. */)
627 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
628 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
630 register FILE *stream
;
631 register int fd
= -1;
632 register Lisp_Object lispstream
;
633 int count
= specpdl_ptr
- specpdl
;
637 /* 1 means we printed the ".el is newer" message. */
639 /* 1 means we are loading a compiled file. */
650 /* If file name is magic, call the handler. */
651 /* This shouldn't be necessary any more now that `openp' handles it right.
652 handler = Ffind_file_name_handler (file, Qload);
654 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
656 /* Do this after the handler to avoid
657 the need to gcpro noerror, nomessage and nosuffix.
658 (Below here, we care only whether they are nil or not.)
659 The presence of this call is the result of a historical accident:
660 it used to be in every file-operations and when it got removed
661 everywhere, it accidentally stayed here. Since then, enough people
662 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
663 that it seemed risky to remove. */
664 file
= Fsubstitute_in_file_name (file
);
666 /* Avoid weird lossage with null string as arg,
667 since it would try to load a directory as a Lisp file */
668 if (XSTRING (file
)->size
> 0)
670 int size
= STRING_BYTES (XSTRING (file
));
675 if (! NILP (must_suffix
))
677 /* Don't insist on adding a suffix if FILE already ends with one. */
679 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
682 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
684 /* Don't insist on adding a suffix
685 if the argument includes a directory name. */
686 else if (! NILP (Ffile_name_directory (file
)))
690 fd
= openp (Vload_path
, file
,
691 (!NILP (nosuffix
) ? Qnil
692 : !NILP (must_suffix
) ? Vload_suffixes
693 : Fappend (2, (tmp
[0] = Vload_suffixes
,
694 tmp
[1] = default_suffixes
,
704 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
705 Fcons (file
, Qnil
)));
710 /* Tell startup.el whether or not we found the user's init file. */
711 if (EQ (Qt
, Vuser_init_file
))
712 Vuser_init_file
= found
;
714 /* If FD is -2, that means openp found a magic file. */
717 if (NILP (Fequal (found
, file
)))
718 /* If FOUND is a different file name from FILE,
719 find its handler even if we have already inhibited
720 the `load' operation on FILE. */
721 handler
= Ffind_file_name_handler (found
, Qt
);
723 handler
= Ffind_file_name_handler (found
, Qload
);
724 if (! NILP (handler
))
725 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
728 /* Check if we're stuck in a recursive load cycle.
730 2000-09-21: It's not possible to just check for the file loaded
731 being a member of Vloads_in_progress. This fails because of the
732 way the byte compiler currently works; `provide's are not
733 evaluted, see font-lock.el/jit-lock.el as an example. This
734 leads to a certain amount of ``normal'' recursion.
736 Also, just loading a file recursively is not always an error in
737 the general case; the second load may do something different. */
741 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
742 if (!NILP (Fequal (found
, XCAR (tem
))))
745 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
746 Fcons (found
, Vloads_in_progress
)));
747 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
748 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
751 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
753 /* Load .elc files directly, but not when they are
754 remote and have no handler! */
761 if (!safe_to_load_p (fd
))
764 if (!load_dangerous_libraries
)
765 error ("File `%s' was not compiled in Emacs",
766 XSTRING (found
)->data
);
767 else if (!NILP (nomessage
))
768 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
776 stat ((char *)XSTRING (found
)->data
, &s1
);
777 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
778 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
779 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
781 /* Make the progress messages mention that source is newer. */
784 /* If we won't print another message, mention this anyway. */
785 if (! NILP (nomessage
))
786 message_with_string ("Source file `%s' newer than byte-compiled file",
789 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
794 /* We are loading a source file (*.el). */
795 if (!NILP (Vload_source_file_function
))
801 val
= call4 (Vload_source_file_function
, found
, file
,
802 NILP (noerror
) ? Qnil
: Qt
,
803 NILP (nomessage
) ? Qnil
: Qt
);
804 return unbind_to (count
, val
);
810 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
811 #else /* not WINDOWSNT */
812 stream
= fdopen (fd
, fmode
);
813 #endif /* not WINDOWSNT */
817 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
820 if (! NILP (Vpurify_flag
))
821 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
823 if (NILP (nomessage
))
826 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
829 message_with_string ("Loading %s (source)...", file
, 1);
831 message_with_string ("Loading %s (compiled; note, source file is newer)...",
833 else /* The typical case; compiled file newer than source file. */
834 message_with_string ("Loading %s...", file
, 1);
838 lispstream
= Fcons (Qnil
, Qnil
);
839 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
840 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
841 record_unwind_protect (load_unwind
, lispstream
);
842 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
843 specbind (Qload_file_name
, found
);
844 specbind (Qinhibit_file_name_operation
, Qnil
);
846 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
848 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
849 unbind_to (count
, Qnil
);
851 /* Run any load-hooks for this file. */
852 temp
= Fassoc (file
, Vafter_load_alist
);
854 Fprogn (Fcdr (temp
));
857 if (saved_doc_string
)
858 free (saved_doc_string
);
859 saved_doc_string
= 0;
860 saved_doc_string_size
= 0;
862 if (prev_saved_doc_string
)
863 xfree (prev_saved_doc_string
);
864 prev_saved_doc_string
= 0;
865 prev_saved_doc_string_size
= 0;
867 if (!noninteractive
&& NILP (nomessage
))
870 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
873 message_with_string ("Loading %s (source)...done", file
, 1);
875 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
877 else /* The typical case; compiled file newer than source file. */
878 message_with_string ("Loading %s...done", file
, 1);
885 load_unwind (stream
) /* used as unwind-protect function in load */
888 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
889 | XFASTINT (XCDR (stream
))));
890 if (--load_in_progress
< 0) load_in_progress
= 0;
895 load_descriptor_unwind (oldlist
)
898 load_descriptor_list
= oldlist
;
902 /* Close all descriptors in use for Floads.
903 This is used when starting a subprocess. */
910 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
911 emacs_close (XFASTINT (XCAR (tail
)));
916 complete_filename_p (pathname
)
917 Lisp_Object pathname
;
919 register unsigned char *s
= XSTRING (pathname
)->data
;
920 return (IS_DIRECTORY_SEP (s
[0])
921 || (XSTRING (pathname
)->size
> 2
922 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
932 /* Search for a file whose name is STR, looking in directories
933 in the Lisp list PATH, and trying suffixes from SUFFIX.
934 On success, returns a file descriptor. On failure, returns -1.
936 SUFFIXES is a list of strings containing possible suffixes.
937 The empty suffix is automatically added iff the list is empty.
939 EXEC_ONLY nonzero means don't open the files,
940 just look for one that is executable. In this case,
941 returns 1 on success.
943 If STOREPTR is nonzero, it points to a slot where the name of
944 the file actually found should be stored as a Lisp string.
945 nil is stored there on failure.
947 If the file we find is remote, return -2
948 but store the found remote file name in *STOREPTR.
949 We do not check for remote files if EXEC_ONLY is nonzero. */
952 openp (path
, str
, suffixes
, storeptr
, exec_only
)
953 Lisp_Object path
, str
;
954 Lisp_Object suffixes
;
955 Lisp_Object
*storeptr
;
961 register char *fn
= buf
;
964 Lisp_Object filename
;
966 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
967 Lisp_Object string
, tail
;
968 int max_suffix_len
= 0;
970 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
972 CHECK_STRING_CAR (tail
);
973 max_suffix_len
= max (max_suffix_len
,
974 STRING_BYTES (XSTRING (XCAR (tail
))));
977 string
= filename
= Qnil
;
978 GCPRO5 (str
, string
, filename
, path
, suffixes
);
983 if (complete_filename_p (str
))
986 for (; CONSP (path
); path
= XCDR (path
))
988 filename
= Fexpand_file_name (str
, XCAR (path
));
989 if (!complete_filename_p (filename
))
990 /* If there are non-absolute elts in PATH (eg ".") */
991 /* Of course, this could conceivably lose if luser sets
992 default-directory to be something non-absolute... */
994 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
995 if (!complete_filename_p (filename
))
996 /* Give up on this path element! */
1000 /* Calculate maximum size of any filename made from
1001 this path element/specified file name and any possible suffix. */
1002 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1003 if (fn_size
< want_size
)
1004 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1006 /* Loop over suffixes. */
1007 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1008 CONSP (tail
); tail
= XCDR (tail
))
1010 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1011 Lisp_Object handler
;
1013 /* Concatenate path element/specified name with the suffix.
1014 If the directory starts with /:, remove that. */
1015 if (XSTRING (filename
)->size
> 2
1016 && XSTRING (filename
)->data
[0] == '/'
1017 && XSTRING (filename
)->data
[1] == ':')
1019 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1020 STRING_BYTES (XSTRING (filename
)) - 2);
1021 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1025 strncpy (fn
, XSTRING (filename
)->data
,
1026 STRING_BYTES (XSTRING (filename
)));
1027 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1030 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1031 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1033 /* Check that the file exists and is not a directory. */
1034 /* We used to only check for handlers on non-absolute file names:
1038 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1039 It's not clear why that was the case and it breaks things like
1040 (load "/bar.el") where the file is actually "/bar.el.gz". */
1041 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1042 if (!NILP (handler
) && !exec_only
)
1046 string
= build_string (fn
);
1047 exists
= !NILP (Ffile_readable_p (string
));
1048 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1053 /* We succeeded; return this descriptor and filename. */
1055 *storeptr
= build_string (fn
);
1062 int exists
= (stat (fn
, &st
) >= 0
1063 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1066 /* Check that we can access or open it. */
1068 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1070 fd
= emacs_open (fn
, O_RDONLY
, 0);
1074 /* We succeeded; return this descriptor and filename. */
1076 *storeptr
= build_string (fn
);
1092 /* Merge the list we've accumulated of globals from the current input source
1093 into the load_history variable. The details depend on whether
1094 the source has an associated file name or not. */
1097 build_load_history (stream
, source
)
1101 register Lisp_Object tail
, prev
, newelt
;
1102 register Lisp_Object tem
, tem2
;
1103 register int foundit
, loading
;
1105 loading
= stream
|| !NARROWED
;
1107 tail
= Vload_history
;
1110 while (!NILP (tail
))
1114 /* Find the feature's previous assoc list... */
1115 if (!NILP (Fequal (source
, Fcar (tem
))))
1119 /* If we're loading, remove it. */
1123 Vload_history
= Fcdr (tail
);
1125 Fsetcdr (prev
, Fcdr (tail
));
1128 /* Otherwise, cons on new symbols that are not already members. */
1131 tem2
= Vcurrent_load_list
;
1133 while (CONSP (tem2
))
1135 newelt
= Fcar (tem2
);
1137 if (NILP (Fmemq (newelt
, tem
)))
1138 Fsetcar (tail
, Fcons (Fcar (tem
),
1139 Fcons (newelt
, Fcdr (tem
))));
1152 /* If we're loading, cons the new assoc onto the front of load-history,
1153 the most-recently-loaded position. Also do this if we didn't find
1154 an existing member for the current source. */
1155 if (loading
|| !foundit
)
1156 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1161 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1169 readevalloop_1 (old
)
1172 load_convert_to_unibyte
= ! NILP (old
);
1176 /* Signal an `end-of-file' error, if possible with file name
1180 end_of_file_error ()
1184 if (STRINGP (Vload_file_name
))
1185 data
= Fcons (Vload_file_name
, Qnil
);
1189 Fsignal (Qend_of_file
, data
);
1192 /* UNIBYTE specifies how to set load_convert_to_unibyte
1193 for this invocation.
1194 READFUN, if non-nil, is used instead of `read'. */
1197 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1198 Lisp_Object readcharfun
;
1200 Lisp_Object sourcename
;
1201 Lisp_Object (*evalfun
) ();
1203 Lisp_Object unibyte
, readfun
;
1206 register Lisp_Object val
;
1207 int count
= specpdl_ptr
- specpdl
;
1208 struct gcpro gcpro1
;
1209 struct buffer
*b
= 0;
1210 int continue_reading_p
;
1212 if (BUFFERP (readcharfun
))
1213 b
= XBUFFER (readcharfun
);
1214 else if (MARKERP (readcharfun
))
1215 b
= XMARKER (readcharfun
)->buffer
;
1217 specbind (Qstandard_input
, readcharfun
);
1218 specbind (Qcurrent_load_list
, Qnil
);
1219 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1220 load_convert_to_unibyte
= !NILP (unibyte
);
1222 readchar_backlog
= -1;
1224 GCPRO1 (sourcename
);
1226 LOADHIST_ATTACH (sourcename
);
1228 continue_reading_p
= 1;
1229 while (continue_reading_p
)
1231 if (b
!= 0 && NILP (b
->name
))
1232 error ("Reading from killed buffer");
1238 while ((c
= READCHAR
) != '\n' && c
!= -1);
1243 /* Ignore whitespace here, so we can detect eof. */
1244 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1247 if (!NILP (Vpurify_flag
) && c
== '(')
1249 int count1
= specpdl_ptr
- specpdl
;
1250 record_unwind_protect (unreadpure
, Qnil
);
1251 val
= read_list (-1, readcharfun
);
1252 unbind_to (count1
, Qnil
);
1257 read_objects
= Qnil
;
1258 if (!NILP (readfun
))
1260 val
= call1 (readfun
, readcharfun
);
1262 /* If READCHARFUN has set point to ZV, we should
1263 stop reading, even if the form read sets point
1264 to a different value when evaluated. */
1265 if (BUFFERP (readcharfun
))
1267 struct buffer
*b
= XBUFFER (readcharfun
);
1268 if (BUF_PT (b
) == BUF_ZV (b
))
1269 continue_reading_p
= 0;
1272 else if (! NILP (Vload_read_function
))
1273 val
= call1 (Vload_read_function
, readcharfun
);
1275 val
= read0 (readcharfun
);
1278 val
= (*evalfun
) (val
);
1282 Vvalues
= Fcons (val
, Vvalues
);
1283 if (EQ (Vstandard_output
, Qt
))
1290 build_load_history (stream
, sourcename
);
1293 unbind_to (count
, Qnil
);
1296 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1297 doc
: /* Execute the current buffer as Lisp code.
1298 Programs can pass two arguments, BUFFER and PRINTFLAG.
1299 BUFFER is the buffer to evaluate (nil means use current buffer).
1300 PRINTFLAG controls printing of output:
1301 nil means discard it; anything else is stream for print.
1303 If the optional third argument FILENAME is non-nil,
1304 it specifies the file name to use for `load-history'.
1305 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1306 for this invocation.
1308 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1309 `print' and related functions should work normally even if PRINTFLAG is nil.
1311 This function preserves the position of point. */)
1312 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1313 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1315 int count
= specpdl_ptr
- specpdl
;
1316 Lisp_Object tem
, buf
;
1319 buf
= Fcurrent_buffer ();
1321 buf
= Fget_buffer (buffer
);
1323 error ("No such buffer");
1325 if (NILP (printflag
) && NILP (do_allow_print
))
1330 if (NILP (filename
))
1331 filename
= XBUFFER (buf
)->filename
;
1333 specbind (Qstandard_output
, tem
);
1334 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1335 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1336 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1337 unbind_to (count
, Qnil
);
1342 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1343 doc
: /* Execute the region as Lisp code.
1344 When called from programs, expects two arguments,
1345 giving starting and ending indices in the current buffer
1346 of the text to be executed.
1347 Programs can pass third argument PRINTFLAG which controls output:
1348 nil means discard it; anything else is stream for printing it.
1349 Also the fourth argument READ-FUNCTION, if non-nil, is used
1350 instead of `read' to read each expression. It gets one argument
1351 which is the input stream for reading characters.
1353 This function does not move point. */)
1354 (start
, end
, printflag
, read_function
)
1355 Lisp_Object start
, end
, printflag
, read_function
;
1357 int count
= specpdl_ptr
- specpdl
;
1358 Lisp_Object tem
, cbuf
;
1360 cbuf
= Fcurrent_buffer ();
1362 if (NILP (printflag
))
1366 specbind (Qstandard_output
, tem
);
1368 if (NILP (printflag
))
1369 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1370 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1372 /* This both uses start and checks its type. */
1374 Fnarrow_to_region (make_number (BEGV
), end
);
1375 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1376 !NILP (printflag
), Qnil
, read_function
);
1378 return unbind_to (count
, Qnil
);
1382 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1383 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1384 If STREAM is nil, use the value of `standard-input' (which see).
1385 STREAM or the value of `standard-input' may be:
1386 a buffer (read from point and advance it)
1387 a marker (read from where it points and advance it)
1388 a function (call it with no arguments for each character,
1389 call it with a char as argument to push a char back)
1390 a string (takes text from string, starting at the beginning)
1391 t (read text line using minibuffer and use it, or read from
1392 standard input in batch mode). */)
1396 extern Lisp_Object
Fread_minibuffer ();
1399 stream
= Vstandard_input
;
1400 if (EQ (stream
, Qt
))
1401 stream
= Qread_char
;
1403 readchar_backlog
= -1;
1404 new_backquote_flag
= 0;
1405 read_objects
= Qnil
;
1407 if (EQ (stream
, Qread_char
))
1408 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1410 if (STRINGP (stream
))
1411 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1413 return read0 (stream
);
1416 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1417 doc
: /* Read one Lisp expression which is represented as text by STRING.
1418 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1419 START and END optionally delimit a substring of STRING from which to read;
1420 they default to 0 and (length STRING) respectively. */)
1421 (string
, start
, end
)
1422 Lisp_Object string
, start
, end
;
1424 int startval
, endval
;
1427 CHECK_STRING (string
);
1430 endval
= XSTRING (string
)->size
;
1434 endval
= XINT (end
);
1435 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1436 args_out_of_range (string
, end
);
1443 CHECK_NUMBER (start
);
1444 startval
= XINT (start
);
1445 if (startval
< 0 || startval
> endval
)
1446 args_out_of_range (string
, start
);
1449 read_from_string_index
= startval
;
1450 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1451 read_from_string_limit
= endval
;
1453 new_backquote_flag
= 0;
1454 read_objects
= Qnil
;
1456 tem
= read0 (string
);
1457 return Fcons (tem
, make_number (read_from_string_index
));
1460 /* Use this for recursive reads, in contexts where internal tokens
1465 Lisp_Object readcharfun
;
1467 register Lisp_Object val
;
1470 val
= read1 (readcharfun
, &c
, 0);
1472 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1479 static int read_buffer_size
;
1480 static char *read_buffer
;
1482 /* Read multibyte form and return it as a character. C is a first
1483 byte of multibyte form, and rest of them are read from
1487 read_multibyte (c
, readcharfun
)
1489 Lisp_Object readcharfun
;
1491 /* We need the actual character code of this multibyte
1493 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1498 while ((c
= READCHAR
) >= 0xA0
1499 && len
< MAX_MULTIBYTE_LENGTH
)
1502 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1503 return STRING_CHAR (str
, len
);
1504 /* The byte sequence is not valid as multibyte. Unread all bytes
1505 but the first one, and return the first byte. */
1511 /* Read a \-escape sequence, assuming we already read the `\'.
1512 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1513 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1514 Otherwise store 0 into *BYTEREP. */
1517 read_escape (readcharfun
, stringp
, byterep
)
1518 Lisp_Object readcharfun
;
1522 register int c
= READCHAR
;
1529 end_of_file_error ();
1559 error ("Invalid escape character syntax");
1562 c
= read_escape (readcharfun
, 0, byterep
);
1563 return c
| meta_modifier
;
1568 error ("Invalid escape character syntax");
1571 c
= read_escape (readcharfun
, 0, byterep
);
1572 return c
| shift_modifier
;
1577 error ("Invalid escape character syntax");
1580 c
= read_escape (readcharfun
, 0, byterep
);
1581 return c
| hyper_modifier
;
1586 error ("Invalid escape character syntax");
1589 c
= read_escape (readcharfun
, 0, byterep
);
1590 return c
| alt_modifier
;
1595 error ("Invalid escape character syntax");
1598 c
= read_escape (readcharfun
, 0, byterep
);
1599 return c
| super_modifier
;
1604 error ("Invalid escape character syntax");
1608 c
= read_escape (readcharfun
, 0, byterep
);
1609 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1610 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1611 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1612 return c
| ctrl_modifier
;
1613 /* ASCII control chars are made from letters (both cases),
1614 as well as the non-letters within 0100...0137. */
1615 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1616 return (c
& (037 | ~0177));
1617 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1618 return (c
& (037 | ~0177));
1620 return c
| ctrl_modifier
;
1630 /* An octal escape, as in ANSI C. */
1632 register int i
= c
- '0';
1633 register int count
= 0;
1636 if ((c
= READCHAR
) >= '0' && c
<= '7')
1653 /* A hex escape, as in ANSI C. */
1659 if (c
>= '0' && c
<= '9')
1664 else if ((c
>= 'a' && c
<= 'f')
1665 || (c
>= 'A' && c
<= 'F'))
1668 if (c
>= 'a' && c
<= 'f')
1685 if (BASE_LEADING_CODE_P (c
))
1686 c
= read_multibyte (c
, readcharfun
);
1692 /* Read an integer in radix RADIX using READCHARFUN to read
1693 characters. RADIX must be in the interval [2..36]; if it isn't, a
1694 read error is signaled . Value is the integer read. Signals an
1695 error if encountering invalid read syntax or if RADIX is out of
1699 read_integer (readcharfun
, radix
)
1700 Lisp_Object readcharfun
;
1703 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1704 EMACS_INT number
= 0;
1706 if (radix
< 2 || radix
> 36)
1710 number
= ndigits
= invalid_p
= 0;
1726 if (c
>= '0' && c
<= '9')
1728 else if (c
>= 'a' && c
<= 'z')
1729 digit
= c
- 'a' + 10;
1730 else if (c
>= 'A' && c
<= 'Z')
1731 digit
= c
- 'A' + 10;
1738 if (digit
< 0 || digit
>= radix
)
1741 number
= radix
* number
+ digit
;
1747 if (ndigits
== 0 || invalid_p
)
1750 sprintf (buf
, "integer, radix %d", radix
);
1751 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1754 return make_number (sign
* number
);
1758 /* Convert unibyte text in read_buffer to multibyte.
1760 Initially, *P is a pointer after the end of the unibyte text, and
1761 the pointer *END points after the end of read_buffer.
1763 If read_buffer doesn't have enough room to hold the result
1764 of the conversion, reallocate it and adjust *P and *END.
1766 At the end, make *P point after the result of the conversion, and
1767 return in *NCHARS the number of characters in the converted
1771 to_multibyte (p
, end
, nchars
)
1777 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1778 if (read_buffer_size
< 2 * nbytes
)
1780 int offset
= *p
- read_buffer
;
1781 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1782 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1783 *p
= read_buffer
+ offset
;
1784 *end
= read_buffer
+ read_buffer_size
;
1787 if (nbytes
!= *nchars
)
1788 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1789 *p
- read_buffer
, nchars
);
1791 *p
= read_buffer
+ nbytes
;
1795 /* If the next token is ')' or ']' or '.', we store that character
1796 in *PCH and the return value is not interesting. Else, we store
1797 zero in *PCH and we read and return one lisp object.
1799 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1802 read1 (readcharfun
, pch
, first_in_list
)
1803 register Lisp_Object readcharfun
;
1808 int uninterned_symbol
= 0;
1816 end_of_file_error ();
1821 return read_list (0, readcharfun
);
1824 return read_vector (readcharfun
, 0);
1841 tmp
= read_vector (readcharfun
, 0);
1842 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1843 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1844 error ("Invalid size char-table");
1845 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1846 XCHAR_TABLE (tmp
)->top
= Qt
;
1855 tmp
= read_vector (readcharfun
, 0);
1856 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1857 error ("Invalid size char-table");
1858 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1859 XCHAR_TABLE (tmp
)->top
= Qnil
;
1862 Fsignal (Qinvalid_read_syntax
,
1863 Fcons (make_string ("#^^", 3), Qnil
));
1865 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1870 length
= read1 (readcharfun
, pch
, first_in_list
);
1874 Lisp_Object tmp
, val
;
1875 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1879 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1880 if (size_in_chars
!= XSTRING (tmp
)->size
1881 /* We used to print 1 char too many
1882 when the number of bits was a multiple of 8.
1883 Accept such input in case it came from an old version. */
1884 && ! (XFASTINT (length
)
1885 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1886 Fsignal (Qinvalid_read_syntax
,
1887 Fcons (make_string ("#&...", 5), Qnil
));
1889 val
= Fmake_bool_vector (length
, Qnil
);
1890 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1892 /* Clear the extraneous bits in the last byte. */
1893 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1894 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1895 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1898 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1903 /* Accept compiled functions at read-time so that we don't have to
1904 build them using function calls. */
1906 tmp
= read_vector (readcharfun
, 1);
1907 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1908 XVECTOR (tmp
)->contents
);
1913 struct gcpro gcpro1
;
1916 /* Read the string itself. */
1917 tmp
= read1 (readcharfun
, &ch
, 0);
1918 if (ch
!= 0 || !STRINGP (tmp
))
1919 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1921 /* Read the intervals and their properties. */
1924 Lisp_Object beg
, end
, plist
;
1926 beg
= read1 (readcharfun
, &ch
, 0);
1931 end
= read1 (readcharfun
, &ch
, 0);
1933 plist
= read1 (readcharfun
, &ch
, 0);
1935 Fsignal (Qinvalid_read_syntax
,
1936 Fcons (build_string ("invalid string property list"),
1938 Fset_text_properties (beg
, end
, plist
, tmp
);
1944 /* #@NUMBER is used to skip NUMBER following characters.
1945 That's used in .elc files to skip over doc strings
1946 and function definitions. */
1951 /* Read a decimal integer. */
1952 while ((c
= READCHAR
) >= 0
1953 && c
>= '0' && c
<= '9')
1961 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1963 /* If we are supposed to force doc strings into core right now,
1964 record the last string that we skipped,
1965 and record where in the file it comes from. */
1967 /* But first exchange saved_doc_string
1968 with prev_saved_doc_string, so we save two strings. */
1970 char *temp
= saved_doc_string
;
1971 int temp_size
= saved_doc_string_size
;
1972 file_offset temp_pos
= saved_doc_string_position
;
1973 int temp_len
= saved_doc_string_length
;
1975 saved_doc_string
= prev_saved_doc_string
;
1976 saved_doc_string_size
= prev_saved_doc_string_size
;
1977 saved_doc_string_position
= prev_saved_doc_string_position
;
1978 saved_doc_string_length
= prev_saved_doc_string_length
;
1980 prev_saved_doc_string
= temp
;
1981 prev_saved_doc_string_size
= temp_size
;
1982 prev_saved_doc_string_position
= temp_pos
;
1983 prev_saved_doc_string_length
= temp_len
;
1986 if (saved_doc_string_size
== 0)
1988 saved_doc_string_size
= nskip
+ 100;
1989 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1991 if (nskip
> saved_doc_string_size
)
1993 saved_doc_string_size
= nskip
+ 100;
1994 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1995 saved_doc_string_size
);
1998 saved_doc_string_position
= file_tell (instream
);
2000 /* Copy that many characters into saved_doc_string. */
2001 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2002 saved_doc_string
[i
] = c
= READCHAR
;
2004 saved_doc_string_length
= i
;
2008 /* Skip that many characters. */
2009 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2016 return Vload_file_name
;
2018 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2019 /* #:foo is the uninterned symbol named foo. */
2022 uninterned_symbol
= 1;
2026 /* Reader forms that can reuse previously read objects. */
2027 if (c
>= '0' && c
<= '9')
2032 /* Read a non-negative integer. */
2033 while (c
>= '0' && c
<= '9')
2039 /* #n=object returns object, but associates it with n for #n#. */
2042 /* Make a placeholder for #n# to use temporarily */
2043 Lisp_Object placeholder
;
2046 placeholder
= Fcons(Qnil
, Qnil
);
2047 cell
= Fcons (make_number (n
), placeholder
);
2048 read_objects
= Fcons (cell
, read_objects
);
2050 /* Read the object itself. */
2051 tem
= read0 (readcharfun
);
2053 /* Now put it everywhere the placeholder was... */
2054 substitute_object_in_subtree (tem
, placeholder
);
2056 /* ...and #n# will use the real value from now on. */
2057 Fsetcdr (cell
, tem
);
2061 /* #n# returns a previously read object. */
2064 tem
= Fassq (make_number (n
), read_objects
);
2067 /* Fall through to error message. */
2069 else if (c
== 'r' || c
== 'R')
2070 return read_integer (readcharfun
, n
);
2072 /* Fall through to error message. */
2074 else if (c
== 'x' || c
== 'X')
2075 return read_integer (readcharfun
, 16);
2076 else if (c
== 'o' || c
== 'O')
2077 return read_integer (readcharfun
, 8);
2078 else if (c
== 'b' || c
== 'B')
2079 return read_integer (readcharfun
, 2);
2082 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2085 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2090 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2100 new_backquote_flag
++;
2101 value
= read0 (readcharfun
);
2102 new_backquote_flag
--;
2104 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2108 if (new_backquote_flag
)
2110 Lisp_Object comma_type
= Qnil
;
2115 comma_type
= Qcomma_at
;
2117 comma_type
= Qcomma_dot
;
2120 if (ch
>= 0) UNREAD (ch
);
2121 comma_type
= Qcomma
;
2124 new_backquote_flag
--;
2125 value
= read0 (readcharfun
);
2126 new_backquote_flag
++;
2127 return Fcons (comma_type
, Fcons (value
, Qnil
));
2138 end_of_file_error ();
2141 c
= read_escape (readcharfun
, 0, &discard
);
2142 else if (BASE_LEADING_CODE_P (c
))
2143 c
= read_multibyte (c
, readcharfun
);
2145 return make_number (c
);
2150 char *p
= read_buffer
;
2151 char *end
= read_buffer
+ read_buffer_size
;
2153 /* 1 if we saw an escape sequence specifying
2154 a multibyte character, or a multibyte character. */
2155 int force_multibyte
= 0;
2156 /* 1 if we saw an escape sequence specifying
2157 a single-byte character. */
2158 int force_singlebyte
= 0;
2159 /* 1 if read_buffer contains multibyte text now. */
2160 int is_multibyte
= 0;
2164 while ((c
= READCHAR
) >= 0
2167 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2169 int offset
= p
- read_buffer
;
2170 read_buffer
= (char *) xrealloc (read_buffer
,
2171 read_buffer_size
*= 2);
2172 p
= read_buffer
+ offset
;
2173 end
= read_buffer
+ read_buffer_size
;
2180 c
= read_escape (readcharfun
, 1, &byterep
);
2182 /* C is -1 if \ newline has just been seen */
2185 if (p
== read_buffer
)
2191 force_singlebyte
= 1;
2192 else if (byterep
== 2)
2193 force_multibyte
= 1;
2196 /* A character that must be multibyte forces multibyte. */
2197 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2198 force_multibyte
= 1;
2200 /* If we just discovered the need to be multibyte,
2201 convert the text accumulated thus far. */
2202 if (force_multibyte
&& ! is_multibyte
)
2205 to_multibyte (&p
, &end
, &nchars
);
2208 /* Allow `\C- ' and `\C-?'. */
2209 if (c
== (CHAR_CTL
| ' '))
2211 else if (c
== (CHAR_CTL
| '?'))
2216 /* Shift modifier is valid only with [A-Za-z]. */
2217 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2219 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2220 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2224 /* Move the meta bit to the right place for a string. */
2225 c
= (c
& ~CHAR_META
) | 0x80;
2226 if (c
& CHAR_MODIFIER_MASK
)
2227 error ("Invalid modifier in string");
2230 p
+= CHAR_STRING (c
, p
);
2238 end_of_file_error ();
2240 /* If purifying, and string starts with \ newline,
2241 return zero instead. This is for doc strings
2242 that we are really going to find in etc/DOC.nn.nn */
2243 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2244 return make_number (0);
2246 if (is_multibyte
|| force_singlebyte
)
2248 else if (load_convert_to_unibyte
)
2251 to_multibyte (&p
, &end
, &nchars
);
2252 if (p
- read_buffer
!= nchars
)
2254 string
= make_multibyte_string (read_buffer
, nchars
,
2256 return Fstring_make_unibyte (string
);
2258 /* We can make a unibyte string directly. */
2261 else if (EQ (readcharfun
, Qget_file_char
)
2262 || EQ (readcharfun
, Qlambda
))
2264 /* Nowadays, reading directly from a file is used only for
2265 compiled Emacs Lisp files, and those always use the
2266 Emacs internal encoding. Meanwhile, Qlambda is used
2267 for reading dynamic byte code (compiled with
2268 byte-compile-dynamic = t). So make the string multibyte
2269 if the string contains any multibyte sequences.
2270 (to_multibyte is a no-op if not.) */
2271 to_multibyte (&p
, &end
, &nchars
);
2272 is_multibyte
= (p
- read_buffer
) != nchars
;
2275 /* In all other cases, if we read these bytes as
2276 separate characters, treat them as separate characters now. */
2280 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2282 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2288 int next_char
= READCHAR
;
2291 if (next_char
<= 040
2292 || index ("\"'`,(", next_char
))
2298 /* Otherwise, we fall through! Note that the atom-reading loop
2299 below will now loop at least once, assuring that we will not
2300 try to UNREAD two characters in a row. */
2304 if (c
<= 040) goto retry
;
2306 char *p
= read_buffer
;
2310 char *end
= read_buffer
+ read_buffer_size
;
2313 && !(c
== '\"' || c
== '\'' || c
== ';'
2314 || c
== '(' || c
== ')'
2315 || c
== '[' || c
== ']' || c
== '#'))
2317 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2319 int offset
= p
- read_buffer
;
2320 read_buffer
= (char *) xrealloc (read_buffer
,
2321 read_buffer_size
*= 2);
2322 p
= read_buffer
+ offset
;
2323 end
= read_buffer
+ read_buffer_size
;
2330 end_of_file_error ();
2334 if (! SINGLE_BYTE_CHAR_P (c
))
2335 p
+= CHAR_STRING (c
, p
);
2344 int offset
= p
- read_buffer
;
2345 read_buffer
= (char *) xrealloc (read_buffer
,
2346 read_buffer_size
*= 2);
2347 p
= read_buffer
+ offset
;
2348 end
= read_buffer
+ read_buffer_size
;
2355 if (!quoted
&& !uninterned_symbol
)
2358 register Lisp_Object val
;
2360 if (*p1
== '+' || *p1
== '-') p1
++;
2361 /* Is it an integer? */
2364 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2365 /* Integers can have trailing decimal points. */
2366 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2368 /* It is an integer. */
2372 if (sizeof (int) == sizeof (EMACS_INT
))
2373 XSETINT (val
, atoi (read_buffer
));
2374 else if (sizeof (long) == sizeof (EMACS_INT
))
2375 XSETINT (val
, atol (read_buffer
));
2381 if (isfloat_string (read_buffer
))
2383 /* Compute NaN and infinities using 0.0 in a variable,
2384 to cope with compilers that think they are smarter
2390 /* Negate the value ourselves. This treats 0, NaNs,
2391 and infinity properly on IEEE floating point hosts,
2392 and works around a common bug where atof ("-0.0")
2394 int negative
= read_buffer
[0] == '-';
2396 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2397 returns 1, is if the input ends in e+INF or e+NaN. */
2404 value
= zero
/ zero
;
2407 value
= atof (read_buffer
+ negative
);
2411 return make_float (negative
? - value
: value
);
2415 if (uninterned_symbol
)
2416 return make_symbol (read_buffer
);
2418 return intern (read_buffer
);
2424 /* List of nodes we've seen during substitute_object_in_subtree. */
2425 static Lisp_Object seen_list
;
2428 substitute_object_in_subtree (object
, placeholder
)
2430 Lisp_Object placeholder
;
2432 Lisp_Object check_object
;
2434 /* We haven't seen any objects when we start. */
2437 /* Make all the substitutions. */
2439 = substitute_object_recurse (object
, placeholder
, object
);
2441 /* Clear seen_list because we're done with it. */
2444 /* The returned object here is expected to always eq the
2446 if (!EQ (check_object
, object
))
2447 error ("Unexpected mutation error in reader");
2450 /* Feval doesn't get called from here, so no gc protection is needed. */
2451 #define SUBSTITUTE(get_val, set_val) \
2453 Lisp_Object old_value = get_val; \
2454 Lisp_Object true_value \
2455 = substitute_object_recurse (object, placeholder,\
2458 if (!EQ (old_value, true_value)) \
2465 substitute_object_recurse (object
, placeholder
, subtree
)
2467 Lisp_Object placeholder
;
2468 Lisp_Object subtree
;
2470 /* If we find the placeholder, return the target object. */
2471 if (EQ (placeholder
, subtree
))
2474 /* If we've been to this node before, don't explore it again. */
2475 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2478 /* If this node can be the entry point to a cycle, remember that
2479 we've seen it. It can only be such an entry point if it was made
2480 by #n=, which means that we can find it as a value in
2482 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2483 seen_list
= Fcons (subtree
, seen_list
);
2485 /* Recurse according to subtree's type.
2486 Every branch must return a Lisp_Object. */
2487 switch (XTYPE (subtree
))
2489 case Lisp_Vectorlike
:
2492 int length
= XINT (Flength(subtree
));
2493 for (i
= 0; i
< length
; i
++)
2495 Lisp_Object idx
= make_number (i
);
2496 SUBSTITUTE (Faref (subtree
, idx
),
2497 Faset (subtree
, idx
, true_value
));
2504 SUBSTITUTE (Fcar_safe (subtree
),
2505 Fsetcar (subtree
, true_value
));
2506 SUBSTITUTE (Fcdr_safe (subtree
),
2507 Fsetcdr (subtree
, true_value
));
2513 /* Check for text properties in each interval.
2514 substitute_in_interval contains part of the logic. */
2516 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2517 Lisp_Object arg
= Fcons (object
, placeholder
);
2519 traverse_intervals_noorder (root_interval
,
2520 &substitute_in_interval
, arg
);
2525 /* Other types don't recurse any further. */
2531 /* Helper function for substitute_object_recurse. */
2533 substitute_in_interval (interval
, arg
)
2537 Lisp_Object object
= Fcar (arg
);
2538 Lisp_Object placeholder
= Fcdr (arg
);
2540 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2559 if (*cp
== '+' || *cp
== '-')
2562 if (*cp
>= '0' && *cp
<= '9')
2565 while (*cp
>= '0' && *cp
<= '9')
2573 if (*cp
>= '0' && *cp
<= '9')
2576 while (*cp
>= '0' && *cp
<= '9')
2579 if (*cp
== 'e' || *cp
== 'E')
2583 if (*cp
== '+' || *cp
== '-')
2587 if (*cp
>= '0' && *cp
<= '9')
2590 while (*cp
>= '0' && *cp
<= '9')
2593 else if (cp
== start
)
2595 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2600 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2606 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2607 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2608 || state
== (DOT_CHAR
|TRAIL_INT
)
2609 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2610 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2611 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2616 read_vector (readcharfun
, bytecodeflag
)
2617 Lisp_Object readcharfun
;
2622 register Lisp_Object
*ptr
;
2623 register Lisp_Object tem
, item
, vector
;
2624 register struct Lisp_Cons
*otem
;
2627 tem
= read_list (1, readcharfun
);
2628 len
= Flength (tem
);
2629 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2631 size
= XVECTOR (vector
)->size
;
2632 ptr
= XVECTOR (vector
)->contents
;
2633 for (i
= 0; i
< size
; i
++)
2636 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2637 bytecode object, the docstring containing the bytecode and
2638 constants values must be treated as unibyte and passed to
2639 Fread, to get the actual bytecode string and constants vector. */
2640 if (bytecodeflag
&& load_force_doc_strings
)
2642 if (i
== COMPILED_BYTECODE
)
2644 if (!STRINGP (item
))
2645 error ("invalid byte code");
2647 /* Delay handling the bytecode slot until we know whether
2648 it is lazily-loaded (we can tell by whether the
2649 constants slot is nil). */
2650 ptr
[COMPILED_CONSTANTS
] = item
;
2653 else if (i
== COMPILED_CONSTANTS
)
2655 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2659 /* Coerce string to unibyte (like string-as-unibyte,
2660 but without generating extra garbage and
2661 guaranteeing no change in the contents). */
2662 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2663 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2665 item
= Fread (bytestr
);
2667 error ("invalid byte code");
2669 otem
= XCONS (item
);
2670 bytestr
= XCAR (item
);
2675 /* Now handle the bytecode slot. */
2676 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2679 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2687 /* FLAG = 1 means check for ] to terminate rather than ) and .
2688 FLAG = -1 means check for starting with defun
2689 and make structure pure. */
2692 read_list (flag
, readcharfun
)
2694 register Lisp_Object readcharfun
;
2696 /* -1 means check next element for defun,
2697 0 means don't check,
2698 1 means already checked and found defun. */
2699 int defunflag
= flag
< 0 ? -1 : 0;
2700 Lisp_Object val
, tail
;
2701 register Lisp_Object elt
, tem
;
2702 struct gcpro gcpro1
, gcpro2
;
2703 /* 0 is the normal case.
2704 1 means this list is a doc reference; replace it with the number 0.
2705 2 means this list is a doc reference; replace it with the doc string. */
2706 int doc_reference
= 0;
2708 /* Initialize this to 1 if we are reading a list. */
2709 int first_in_list
= flag
<= 0;
2718 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2723 /* While building, if the list starts with #$, treat it specially. */
2724 if (EQ (elt
, Vload_file_name
)
2726 && !NILP (Vpurify_flag
))
2728 if (NILP (Vdoc_file_name
))
2729 /* We have not yet called Snarf-documentation, so assume
2730 this file is described in the DOC-MM.NN file
2731 and Snarf-documentation will fill in the right value later.
2732 For now, replace the whole list with 0. */
2735 /* We have already called Snarf-documentation, so make a relative
2736 file name for this file, so it can be found properly
2737 in the installed Lisp directory.
2738 We don't use Fexpand_file_name because that would make
2739 the directory absolute now. */
2740 elt
= concat2 (build_string ("../lisp/"),
2741 Ffile_name_nondirectory (elt
));
2743 else if (EQ (elt
, Vload_file_name
)
2745 && load_force_doc_strings
)
2754 Fsignal (Qinvalid_read_syntax
,
2755 Fcons (make_string (") or . in a vector", 18), Qnil
));
2763 XSETCDR (tail
, read0 (readcharfun
));
2765 val
= read0 (readcharfun
);
2766 read1 (readcharfun
, &ch
, 0);
2770 if (doc_reference
== 1)
2771 return make_number (0);
2772 if (doc_reference
== 2)
2774 /* Get a doc string from the file we are loading.
2775 If it's in saved_doc_string, get it from there. */
2776 int pos
= XINT (XCDR (val
));
2777 /* Position is negative for user variables. */
2778 if (pos
< 0) pos
= -pos
;
2779 if (pos
>= saved_doc_string_position
2780 && pos
< (saved_doc_string_position
2781 + saved_doc_string_length
))
2783 int start
= pos
- saved_doc_string_position
;
2786 /* Process quoting with ^A,
2787 and find the end of the string,
2788 which is marked with ^_ (037). */
2789 for (from
= start
, to
= start
;
2790 saved_doc_string
[from
] != 037;)
2792 int c
= saved_doc_string
[from
++];
2795 c
= saved_doc_string
[from
++];
2797 saved_doc_string
[to
++] = c
;
2799 saved_doc_string
[to
++] = 0;
2801 saved_doc_string
[to
++] = 037;
2804 saved_doc_string
[to
++] = c
;
2807 return make_string (saved_doc_string
+ start
,
2810 /* Look in prev_saved_doc_string the same way. */
2811 else if (pos
>= prev_saved_doc_string_position
2812 && pos
< (prev_saved_doc_string_position
2813 + prev_saved_doc_string_length
))
2815 int start
= pos
- prev_saved_doc_string_position
;
2818 /* Process quoting with ^A,
2819 and find the end of the string,
2820 which is marked with ^_ (037). */
2821 for (from
= start
, to
= start
;
2822 prev_saved_doc_string
[from
] != 037;)
2824 int c
= prev_saved_doc_string
[from
++];
2827 c
= prev_saved_doc_string
[from
++];
2829 prev_saved_doc_string
[to
++] = c
;
2831 prev_saved_doc_string
[to
++] = 0;
2833 prev_saved_doc_string
[to
++] = 037;
2836 prev_saved_doc_string
[to
++] = c
;
2839 return make_string (prev_saved_doc_string
+ start
,
2843 return get_doc_string (val
, 0, 0);
2848 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2850 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2852 tem
= (read_pure
&& flag
<= 0
2853 ? pure_cons (elt
, Qnil
)
2854 : Fcons (elt
, Qnil
));
2856 XSETCDR (tail
, tem
);
2861 defunflag
= EQ (elt
, Qdefun
);
2862 else if (defunflag
> 0)
2867 Lisp_Object Vobarray
;
2868 Lisp_Object initial_obarray
;
2870 /* oblookup stores the bucket number here, for the sake of Funintern. */
2872 int oblookup_last_bucket_number
;
2874 static int hash_string ();
2875 Lisp_Object
oblookup ();
2877 /* Get an error if OBARRAY is not an obarray.
2878 If it is one, return it. */
2881 check_obarray (obarray
)
2882 Lisp_Object obarray
;
2884 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2886 /* If Vobarray is now invalid, force it to be valid. */
2887 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2889 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2894 /* Intern the C string STR: return a symbol with that name,
2895 interned in the current obarray. */
2902 int len
= strlen (str
);
2903 Lisp_Object obarray
;
2906 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2907 obarray
= check_obarray (obarray
);
2908 tem
= oblookup (obarray
, str
, len
, len
);
2911 return Fintern (make_string (str
, len
), obarray
);
2914 /* Create an uninterned symbol with name STR. */
2920 int len
= strlen (str
);
2922 return Fmake_symbol ((!NILP (Vpurify_flag
)
2923 ? make_pure_string (str
, len
, len
, 0)
2924 : make_string (str
, len
)));
2927 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2928 doc
: /* Return the canonical symbol whose name is STRING.
2929 If there is none, one is created by this function and returned.
2930 A second optional argument specifies the obarray to use;
2931 it defaults to the value of `obarray'. */)
2933 Lisp_Object string
, obarray
;
2935 register Lisp_Object tem
, sym
, *ptr
;
2937 if (NILP (obarray
)) obarray
= Vobarray
;
2938 obarray
= check_obarray (obarray
);
2940 CHECK_STRING (string
);
2942 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2943 XSTRING (string
)->size
,
2944 STRING_BYTES (XSTRING (string
)));
2945 if (!INTEGERP (tem
))
2948 if (!NILP (Vpurify_flag
))
2949 string
= Fpurecopy (string
);
2950 sym
= Fmake_symbol (string
);
2952 if (EQ (obarray
, initial_obarray
))
2953 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2955 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2957 if ((XSTRING (string
)->data
[0] == ':')
2958 && EQ (obarray
, initial_obarray
))
2960 XSYMBOL (sym
)->constant
= 1;
2961 XSYMBOL (sym
)->value
= sym
;
2964 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2966 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2968 XSYMBOL (sym
)->next
= 0;
2973 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2974 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
2975 NAME may be a string or a symbol. If it is a symbol, that exact
2976 symbol is searched for.
2977 A second optional argument specifies the obarray to use;
2978 it defaults to the value of `obarray'. */)
2980 Lisp_Object name
, obarray
;
2982 register Lisp_Object tem
;
2983 struct Lisp_String
*string
;
2985 if (NILP (obarray
)) obarray
= Vobarray
;
2986 obarray
= check_obarray (obarray
);
2988 if (!SYMBOLP (name
))
2990 CHECK_STRING (name
);
2991 string
= XSTRING (name
);
2994 string
= XSYMBOL (name
)->name
;
2996 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2997 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3003 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3004 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3005 The value is t if a symbol was found and deleted, nil otherwise.
3006 NAME may be a string or a symbol. If it is a symbol, that symbol
3007 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3008 OBARRAY defaults to the value of the variable `obarray'. */)
3010 Lisp_Object name
, obarray
;
3012 register Lisp_Object string
, tem
;
3015 if (NILP (obarray
)) obarray
= Vobarray
;
3016 obarray
= check_obarray (obarray
);
3019 XSETSTRING (string
, XSYMBOL (name
)->name
);
3022 CHECK_STRING (name
);
3026 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3027 XSTRING (string
)->size
,
3028 STRING_BYTES (XSTRING (string
)));
3031 /* If arg was a symbol, don't delete anything but that symbol itself. */
3032 if (SYMBOLP (name
) && !EQ (name
, tem
))
3035 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3036 XSYMBOL (tem
)->constant
= 0;
3037 XSYMBOL (tem
)->indirect_variable
= 0;
3039 hash
= oblookup_last_bucket_number
;
3041 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3043 if (XSYMBOL (tem
)->next
)
3044 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3046 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3050 Lisp_Object tail
, following
;
3052 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3053 XSYMBOL (tail
)->next
;
3056 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3057 if (EQ (following
, tem
))
3059 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3068 /* Return the symbol in OBARRAY whose names matches the string
3069 of SIZE characters (SIZE_BYTE bytes) at PTR.
3070 If there is no such symbol in OBARRAY, return nil.
3072 Also store the bucket number in oblookup_last_bucket_number. */
3075 oblookup (obarray
, ptr
, size
, size_byte
)
3076 Lisp_Object obarray
;
3078 int size
, size_byte
;
3082 register Lisp_Object tail
;
3083 Lisp_Object bucket
, tem
;
3085 if (!VECTORP (obarray
)
3086 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3088 obarray
= check_obarray (obarray
);
3089 obsize
= XVECTOR (obarray
)->size
;
3091 /* This is sometimes needed in the middle of GC. */
3092 obsize
&= ~ARRAY_MARK_FLAG
;
3093 /* Combining next two lines breaks VMS C 2.3. */
3094 hash
= hash_string (ptr
, size_byte
);
3096 bucket
= XVECTOR (obarray
)->contents
[hash
];
3097 oblookup_last_bucket_number
= hash
;
3098 if (XFASTINT (bucket
) == 0)
3100 else if (!SYMBOLP (bucket
))
3101 error ("Bad data in guts of obarray"); /* Like CADR error message */
3103 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3105 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3106 && XSYMBOL (tail
)->name
->size
== size
3107 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3109 else if (XSYMBOL (tail
)->next
== 0)
3112 XSETINT (tem
, hash
);
3117 hash_string (ptr
, len
)
3121 register unsigned char *p
= ptr
;
3122 register unsigned char *end
= p
+ len
;
3123 register unsigned char c
;
3124 register int hash
= 0;
3129 if (c
>= 0140) c
-= 40;
3130 hash
= ((hash
<<3) + (hash
>>28) + c
);
3132 return hash
& 07777777777;
3136 map_obarray (obarray
, fn
, arg
)
3137 Lisp_Object obarray
;
3138 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3142 register Lisp_Object tail
;
3143 CHECK_VECTOR (obarray
);
3144 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3146 tail
= XVECTOR (obarray
)->contents
[i
];
3151 if (XSYMBOL (tail
)->next
== 0)
3153 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3159 mapatoms_1 (sym
, function
)
3160 Lisp_Object sym
, function
;
3162 call1 (function
, sym
);
3165 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3166 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3167 OBARRAY defaults to the value of `obarray'. */)
3169 Lisp_Object function
, obarray
;
3171 if (NILP (obarray
)) obarray
= Vobarray
;
3172 obarray
= check_obarray (obarray
);
3174 map_obarray (obarray
, mapatoms_1
, function
);
3178 #define OBARRAY_SIZE 1511
3183 Lisp_Object oblength
;
3187 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3189 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3190 Vobarray
= Fmake_vector (oblength
, make_number (0));
3191 initial_obarray
= Vobarray
;
3192 staticpro (&initial_obarray
);
3193 /* Intern nil in the obarray */
3194 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3195 XSYMBOL (Qnil
)->constant
= 1;
3197 /* These locals are to kludge around a pyramid compiler bug. */
3198 hash
= hash_string ("nil", 3);
3199 /* Separate statement here to avoid VAXC bug. */
3200 hash
%= OBARRAY_SIZE
;
3201 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3204 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3205 XSYMBOL (Qnil
)->function
= Qunbound
;
3206 XSYMBOL (Qunbound
)->value
= Qunbound
;
3207 XSYMBOL (Qunbound
)->function
= Qunbound
;
3210 XSYMBOL (Qnil
)->value
= Qnil
;
3211 XSYMBOL (Qnil
)->plist
= Qnil
;
3212 XSYMBOL (Qt
)->value
= Qt
;
3213 XSYMBOL (Qt
)->constant
= 1;
3215 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3218 Qvariable_documentation
= intern ("variable-documentation");
3219 staticpro (&Qvariable_documentation
);
3221 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3222 read_buffer
= (char *) xmalloc (read_buffer_size
);
3227 struct Lisp_Subr
*sname
;
3230 sym
= intern (sname
->symbol_name
);
3231 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3234 #ifdef NOTDEF /* use fset in subr.el now */
3236 defalias (sname
, string
)
3237 struct Lisp_Subr
*sname
;
3241 sym
= intern (string
);
3242 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3246 /* Define an "integer variable"; a symbol whose value is forwarded
3247 to a C variable of type int. Sample call: */
3248 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3250 defvar_int (namestring
, address
)
3254 Lisp_Object sym
, val
;
3255 sym
= intern (namestring
);
3256 val
= allocate_misc ();
3257 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3258 XINTFWD (val
)->intvar
= address
;
3259 SET_SYMBOL_VALUE (sym
, val
);
3262 /* Similar but define a variable whose value is t if address contains 1,
3263 nil if address contains 0 */
3265 defvar_bool (namestring
, address
)
3269 Lisp_Object sym
, val
;
3270 sym
= intern (namestring
);
3271 val
= allocate_misc ();
3272 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3273 XBOOLFWD (val
)->boolvar
= address
;
3274 SET_SYMBOL_VALUE (sym
, val
);
3275 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3278 /* Similar but define a variable whose value is the Lisp Object stored
3279 at address. Two versions: with and without gc-marking of the C
3280 variable. The nopro version is used when that variable will be
3281 gc-marked for some other reason, since marking the same slot twice
3282 can cause trouble with strings. */
3284 defvar_lisp_nopro (namestring
, address
)
3286 Lisp_Object
*address
;
3288 Lisp_Object sym
, val
;
3289 sym
= intern (namestring
);
3290 val
= allocate_misc ();
3291 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3292 XOBJFWD (val
)->objvar
= address
;
3293 SET_SYMBOL_VALUE (sym
, val
);
3297 defvar_lisp (namestring
, address
)
3299 Lisp_Object
*address
;
3301 defvar_lisp_nopro (namestring
, address
);
3302 staticpro (address
);
3305 /* Similar but define a variable whose value is the Lisp Object stored in
3306 the current buffer. address is the address of the slot in the buffer
3307 that is current now. */
3310 defvar_per_buffer (namestring
, address
, type
, doc
)
3312 Lisp_Object
*address
;
3316 Lisp_Object sym
, val
;
3318 extern struct buffer buffer_local_symbols
;
3320 sym
= intern (namestring
);
3321 val
= allocate_misc ();
3322 offset
= (char *)address
- (char *)current_buffer
;
3324 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3325 XBUFFER_OBJFWD (val
)->offset
= offset
;
3326 SET_SYMBOL_VALUE (sym
, val
);
3327 PER_BUFFER_SYMBOL (offset
) = sym
;
3328 PER_BUFFER_TYPE (offset
) = type
;
3330 if (PER_BUFFER_IDX (offset
) == 0)
3331 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3332 slot of buffer_local_flags */
3337 /* Similar but define a variable whose value is the Lisp Object stored
3338 at a particular offset in the current kboard object. */
3341 defvar_kboard (namestring
, offset
)
3345 Lisp_Object sym
, val
;
3346 sym
= intern (namestring
);
3347 val
= allocate_misc ();
3348 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3349 XKBOARD_OBJFWD (val
)->offset
= offset
;
3350 SET_SYMBOL_VALUE (sym
, val
);
3353 /* Record the value of load-path used at the start of dumping
3354 so we can see if the site changed it later during dumping. */
3355 static Lisp_Object dump_path
;
3361 int turn_off_warning
= 0;
3363 /* Compute the default load-path. */
3365 normal
= PATH_LOADSEARCH
;
3366 Vload_path
= decode_env_path (0, normal
);
3368 if (NILP (Vpurify_flag
))
3369 normal
= PATH_LOADSEARCH
;
3371 normal
= PATH_DUMPLOADSEARCH
;
3373 /* In a dumped Emacs, we normally have to reset the value of
3374 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3375 uses ../lisp, instead of the path of the installed elisp
3376 libraries. However, if it appears that Vload_path was changed
3377 from the default before dumping, don't override that value. */
3380 if (! NILP (Fequal (dump_path
, Vload_path
)))
3382 Vload_path
= decode_env_path (0, normal
);
3383 if (!NILP (Vinstallation_directory
))
3385 Lisp_Object tem
, tem1
, sitelisp
;
3387 /* Remove site-lisp dirs from path temporarily and store
3388 them in sitelisp, then conc them on at the end so
3389 they're always first in path. */
3393 tem
= Fcar (Vload_path
);
3394 tem1
= Fstring_match (build_string ("site-lisp"),
3398 Vload_path
= Fcdr (Vload_path
);
3399 sitelisp
= Fcons (tem
, sitelisp
);
3405 /* Add to the path the lisp subdir of the
3406 installation dir, if it exists. */
3407 tem
= Fexpand_file_name (build_string ("lisp"),
3408 Vinstallation_directory
);
3409 tem1
= Ffile_exists_p (tem
);
3412 if (NILP (Fmember (tem
, Vload_path
)))
3414 turn_off_warning
= 1;
3415 Vload_path
= Fcons (tem
, Vload_path
);
3419 /* That dir doesn't exist, so add the build-time
3420 Lisp dirs instead. */
3421 Vload_path
= nconc2 (Vload_path
, dump_path
);
3423 /* Add leim under the installation dir, if it exists. */
3424 tem
= Fexpand_file_name (build_string ("leim"),
3425 Vinstallation_directory
);
3426 tem1
= Ffile_exists_p (tem
);
3429 if (NILP (Fmember (tem
, Vload_path
)))
3430 Vload_path
= Fcons (tem
, Vload_path
);
3433 /* Add site-list under the installation dir, if it exists. */
3434 tem
= Fexpand_file_name (build_string ("site-lisp"),
3435 Vinstallation_directory
);
3436 tem1
= Ffile_exists_p (tem
);
3439 if (NILP (Fmember (tem
, Vload_path
)))
3440 Vload_path
= Fcons (tem
, Vload_path
);
3443 /* If Emacs was not built in the source directory,
3444 and it is run from where it was built, add to load-path
3445 the lisp, leim and site-lisp dirs under that directory. */
3447 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3451 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3452 Vinstallation_directory
);
3453 tem1
= Ffile_exists_p (tem
);
3455 /* Don't be fooled if they moved the entire source tree
3456 AFTER dumping Emacs. If the build directory is indeed
3457 different from the source dir, src/Makefile.in and
3458 src/Makefile will not be found together. */
3459 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3460 Vinstallation_directory
);
3461 tem2
= Ffile_exists_p (tem
);
3462 if (!NILP (tem1
) && NILP (tem2
))
3464 tem
= Fexpand_file_name (build_string ("lisp"),
3467 if (NILP (Fmember (tem
, Vload_path
)))
3468 Vload_path
= Fcons (tem
, Vload_path
);
3470 tem
= Fexpand_file_name (build_string ("leim"),
3473 if (NILP (Fmember (tem
, Vload_path
)))
3474 Vload_path
= Fcons (tem
, Vload_path
);
3476 tem
= Fexpand_file_name (build_string ("site-lisp"),
3479 if (NILP (Fmember (tem
, Vload_path
)))
3480 Vload_path
= Fcons (tem
, Vload_path
);
3483 if (!NILP (sitelisp
))
3484 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3490 /* NORMAL refers to the lisp dir in the source directory. */
3491 /* We used to add ../lisp at the front here, but
3492 that caused trouble because it was copied from dump_path
3493 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3494 It should be unnecessary. */
3495 Vload_path
= decode_env_path (0, normal
);
3496 dump_path
= Vload_path
;
3501 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3502 almost never correct, thereby causing a warning to be printed out that
3503 confuses users. Since PATH_LOADSEARCH is always overridden by the
3504 EMACSLOADPATH environment variable below, disable the warning on NT. */
3506 /* Warn if dirs in the *standard* path don't exist. */
3507 if (!turn_off_warning
)
3509 Lisp_Object path_tail
;
3511 for (path_tail
= Vload_path
;
3513 path_tail
= XCDR (path_tail
))
3515 Lisp_Object dirfile
;
3516 dirfile
= Fcar (path_tail
);
3517 if (STRINGP (dirfile
))
3519 dirfile
= Fdirectory_file_name (dirfile
);
3520 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3521 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3526 #endif /* WINDOWSNT */
3528 /* If the EMACSLOADPATH environment variable is set, use its value.
3529 This doesn't apply if we're dumping. */
3531 if (NILP (Vpurify_flag
)
3532 && egetenv ("EMACSLOADPATH"))
3534 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3538 load_in_progress
= 0;
3539 Vload_file_name
= Qnil
;
3541 load_descriptor_list
= Qnil
;
3543 Vstandard_input
= Qt
;
3544 Vloads_in_progress
= Qnil
;
3547 /* Print a warning, using format string FORMAT, that directory DIRNAME
3548 does not exist. Print it on stderr and put it in *Message*. */
3551 dir_warning (format
, dirname
)
3553 Lisp_Object dirname
;
3556 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3558 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3559 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3560 /* Don't log the warning before we've initialized!! */
3562 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3569 defsubr (&Sread_from_string
);
3571 defsubr (&Sintern_soft
);
3572 defsubr (&Sunintern
);
3574 defsubr (&Seval_buffer
);
3575 defsubr (&Seval_region
);
3576 defsubr (&Sread_char
);
3577 defsubr (&Sread_char_exclusive
);
3578 defsubr (&Sread_event
);
3579 defsubr (&Sget_file_char
);
3580 defsubr (&Smapatoms
);
3582 DEFVAR_LISP ("obarray", &Vobarray
,
3583 doc
: /* Symbol table for use by `intern' and `read'.
3584 It is a vector whose length ought to be prime for best results.
3585 The vector's contents don't make sense if examined from Lisp programs;
3586 to find all the symbols in an obarray, use `mapatoms'. */);
3588 DEFVAR_LISP ("values", &Vvalues
,
3589 doc
: /* List of values of all expressions which were read, evaluated and printed.
3590 Order is reverse chronological. */);
3592 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3593 doc
: /* Stream for read to get input from.
3594 See documentation of `read' for possible values. */);
3595 Vstandard_input
= Qt
;
3597 DEFVAR_LISP ("load-path", &Vload_path
,
3598 doc
: /* *List of directories to search for files to load.
3599 Each element is a string (directory name) or nil (try default directory).
3600 Initialized based on EMACSLOADPATH environment variable, if any,
3601 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3603 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3604 doc
: /* *List of suffixes to try for files to load.
3605 This list should not include the empty string. */);
3606 Vload_suffixes
= Fcons (build_string (".elc"),
3607 Fcons (build_string (".el"), Qnil
));
3608 /* We don't use empty_string because it's not initialized yet. */
3609 default_suffixes
= Fcons (build_string (""), Qnil
);
3610 staticpro (&default_suffixes
);
3612 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3613 doc
: /* Non-nil iff inside of `load'. */);
3615 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3616 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3617 Each element looks like (FILENAME FORMS...).
3618 When `load' is run and the file-name argument is FILENAME,
3619 the FORMS in the corresponding element are executed at the end of loading.
3621 FILENAME must match exactly! Normally FILENAME is the name of a library,
3622 with no directory specified, since that is how `load' is normally called.
3623 An error in FORMS does not undo the load,
3624 but does prevent execution of the rest of the FORMS.
3625 FILENAME can also be a symbol (a feature) and FORMS are then executed
3626 when the corresponding call to `provide' is made. */);
3627 Vafter_load_alist
= Qnil
;
3629 DEFVAR_LISP ("load-history", &Vload_history
,
3630 doc
: /* Alist mapping source file names to symbols and features.
3631 Each alist element is a list that starts with a file name,
3632 except for one element (optional) that starts with nil and describes
3633 definitions evaluated from buffers not visiting files.
3634 The remaining elements of each list are symbols defined as functions
3635 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3636 and `(autoload . SYMBOL)'. */);
3637 Vload_history
= Qnil
;
3639 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3640 doc
: /* Full name of file being loaded by `load'. */);
3641 Vload_file_name
= Qnil
;
3643 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3644 doc
: /* File name, including directory, of user's initialization file.
3645 If the file loaded had extension `.elc' and there was a corresponding `.el'
3646 file, this variable contains the name of the .el file, suitable for use
3647 by functions like `custom-save-all' which edit the init file. */);
3648 Vuser_init_file
= Qnil
;
3650 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3651 doc
: /* Used for internal purposes by `load'. */);
3652 Vcurrent_load_list
= Qnil
;
3654 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3655 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3656 The default is nil, which means use the function `read'. */);
3657 Vload_read_function
= Qnil
;
3659 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3660 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3661 This function is for doing code conversion before reading the source file.
3662 If nil, loading is done without any code conversion.
3663 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3664 FULLNAME is the full name of FILE.
3665 See `load' for the meaning of the remaining arguments. */);
3666 Vload_source_file_function
= Qnil
;
3668 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3669 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3670 This is useful when the file being loaded is a temporary copy. */);
3671 load_force_doc_strings
= 0;
3673 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3674 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3675 This is normally bound by `load' and `eval-buffer' to control `read',
3676 and is not meant for users to change. */);
3677 load_convert_to_unibyte
= 0;
3679 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3680 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3681 You cannot count on them to still be there! */);
3683 = Fexpand_file_name (build_string ("../"),
3684 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3686 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3687 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3688 Vpreloaded_file_list
= Qnil
;
3690 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3691 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3692 Vbyte_boolean_vars
= Qnil
;
3694 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3695 doc
: /* Non-nil means load dangerous compiled Lisp files.
3696 Some versions of XEmacs use different byte codes than Emacs. These
3697 incompatible byte codes can make Emacs crash when it tries to execute
3699 load_dangerous_libraries
= 0;
3701 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3702 doc
: /* Regular expression matching safe to load compiled Lisp files.
3703 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3704 from the file, and matches them against this regular expression.
3705 When the regular expression matches, the file is considered to be safe
3706 to load. See also `load-dangerous-libraries'. */);
3707 Vbytecomp_version_regexp
3708 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3710 /* Vsource_directory was initialized in init_lread. */
3712 load_descriptor_list
= Qnil
;
3713 staticpro (&load_descriptor_list
);
3715 Qcurrent_load_list
= intern ("current-load-list");
3716 staticpro (&Qcurrent_load_list
);
3718 Qstandard_input
= intern ("standard-input");
3719 staticpro (&Qstandard_input
);
3721 Qread_char
= intern ("read-char");
3722 staticpro (&Qread_char
);
3724 Qget_file_char
= intern ("get-file-char");
3725 staticpro (&Qget_file_char
);
3727 Qbackquote
= intern ("`");
3728 staticpro (&Qbackquote
);
3729 Qcomma
= intern (",");
3730 staticpro (&Qcomma
);
3731 Qcomma_at
= intern (",@");
3732 staticpro (&Qcomma_at
);
3733 Qcomma_dot
= intern (",.");
3734 staticpro (&Qcomma_dot
);
3736 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3737 staticpro (&Qinhibit_file_name_operation
);
3739 Qascii_character
= intern ("ascii-character");
3740 staticpro (&Qascii_character
);
3742 Qfunction
= intern ("function");
3743 staticpro (&Qfunction
);
3745 Qload
= intern ("load");
3748 Qload_file_name
= intern ("load-file-name");
3749 staticpro (&Qload_file_name
);
3751 staticpro (&dump_path
);
3753 staticpro (&read_objects
);
3754 read_objects
= Qnil
;
3755 staticpro (&seen_list
);
3757 Vloads_in_progress
= Qnil
;
3758 staticpro (&Vloads_in_progress
);