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
;
488 #ifdef HAVE_WINDOW_SYSTEM
489 if (display_hourglass_p
)
495 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
496 doc
: /* Read a character from the command input (keyboard or macro).
497 It is returned as a number.
498 If the user generates an event which is not a character (i.e. a mouse
499 click or function key event), `read-char' signals an error. As an
500 exception, switch-frame events are put off until non-ASCII events can
502 If you want to read non-character events, or ignore them, call
503 `read-event' or `read-char-exclusive' instead.
505 If the optional argument PROMPT is non-nil, display that as a prompt.
506 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
507 input method is turned on in the current buffer, that input method
508 is used for reading a character. */)
509 (prompt
, inherit_input_method
)
510 Lisp_Object prompt
, inherit_input_method
;
513 message_with_string ("%s", prompt
, 0);
514 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
517 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
518 doc
: /* Read an event object from the input stream.
519 If the optional argument PROMPT is non-nil, display that as a prompt.
520 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
521 input method is turned on in the current buffer, that input method
522 is used for reading a character. */)
523 (prompt
, inherit_input_method
)
524 Lisp_Object prompt
, inherit_input_method
;
527 message_with_string ("%s", prompt
, 0);
528 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
531 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
532 doc
: /* Read a character from the command input (keyboard or macro).
533 It is returned as a number. Non-character events are ignored.
535 If the optional argument PROMPT is non-nil, display that as a prompt.
536 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
537 input method is turned on in the current buffer, that input method
538 is used for reading a character. */)
539 (prompt
, inherit_input_method
)
540 Lisp_Object prompt
, inherit_input_method
;
543 message_with_string ("%s", prompt
, 0);
544 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
547 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
548 doc
: /* Don't use this yourself. */)
551 register Lisp_Object val
;
552 XSETINT (val
, getc (instream
));
558 /* Value is non-zero if the file asswociated with file descriptor FD
559 is a compiled Lisp file that's safe to load. Only files compiled
560 with Emacs are safe to load. Files compiled with XEmacs can lead
561 to a crash in Fbyte_code because of an incompatible change in the
572 /* Read the first few bytes from the file, and look for a line
573 specifying the byte compiler version used. */
574 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
579 /* Skip to the next newline, skipping over the initial `ELC'
580 with NUL bytes following it. */
581 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
585 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
590 lseek (fd
, 0, SEEK_SET
);
595 /* Callback for record_unwind_protect. Restore the old load list OLD,
596 after loading a file successfully. */
599 record_load_unwind (old
)
602 return Vloads_in_progress
= old
;
606 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
607 doc
: /* Execute a file of Lisp code named FILE.
608 First try FILE with `.elc' appended, then try with `.el',
609 then try FILE unmodified. Environment variable references in FILE
610 are replaced with their values by calling `substitute-in-file-name'.
611 This function searches the directories in `load-path'.
612 If optional second arg NOERROR is non-nil,
613 report no error if FILE doesn't exist.
614 Print messages at start and end of loading unless
615 optional third arg NOMESSAGE is non-nil.
616 If optional fourth arg NOSUFFIX is non-nil, don't try adding
617 suffixes `.elc' or `.el' to the specified name FILE.
618 If optional fifth arg MUST-SUFFIX is non-nil, insist on
619 the suffix `.elc' or `.el'; don't accept just FILE unless
620 it ends in one of those suffixes or includes a directory name.
621 Return t if file exists. */)
622 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
623 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
625 register FILE *stream
;
626 register int fd
= -1;
627 register Lisp_Object lispstream
;
628 int count
= specpdl_ptr
- specpdl
;
632 /* 1 means we printed the ".el is newer" message. */
634 /* 1 means we are loading a compiled file. */
645 /* If file name is magic, call the handler. */
646 /* This shouldn't be necessary any more now that `openp' handles it right.
647 handler = Ffind_file_name_handler (file, Qload);
649 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
651 /* Do this after the handler to avoid
652 the need to gcpro noerror, nomessage and nosuffix.
653 (Below here, we care only whether they are nil or not.)
654 The presence of this call is the result of a historical accident:
655 it used to be in every file-operations and when it got removed
656 everywhere, it accidentally stayed here. Since then, enough people
657 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
658 that it seemed risky to remove. */
659 file
= Fsubstitute_in_file_name (file
);
661 /* Avoid weird lossage with null string as arg,
662 since it would try to load a directory as a Lisp file */
663 if (XSTRING (file
)->size
> 0)
665 int size
= STRING_BYTES (XSTRING (file
));
670 if (! NILP (must_suffix
))
672 /* Don't insist on adding a suffix if FILE already ends with one. */
674 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
677 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
679 /* Don't insist on adding a suffix
680 if the argument includes a directory name. */
681 else if (! NILP (Ffile_name_directory (file
)))
685 fd
= openp (Vload_path
, file
,
686 (!NILP (nosuffix
) ? Qnil
687 : !NILP (must_suffix
) ? Vload_suffixes
688 : Fappend (2, (tmp
[0] = Vload_suffixes
,
689 tmp
[1] = default_suffixes
,
699 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
700 Fcons (file
, Qnil
)));
705 /* Tell startup.el whether or not we found the user's init file. */
706 if (EQ (Qt
, Vuser_init_file
))
707 Vuser_init_file
= found
;
709 /* If FD is -2, that means openp found a magic file. */
712 if (NILP (Fequal (found
, file
)))
713 /* If FOUND is a different file name from FILE,
714 find its handler even if we have already inhibited
715 the `load' operation on FILE. */
716 handler
= Ffind_file_name_handler (found
, Qt
);
718 handler
= Ffind_file_name_handler (found
, Qload
);
719 if (! NILP (handler
))
720 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
723 /* Check if we're stuck in a recursive load cycle.
725 2000-09-21: It's not possible to just check for the file loaded
726 being a member of Vloads_in_progress. This fails because of the
727 way the byte compiler currently works; `provide's are not
728 evaluted, see font-lock.el/jit-lock.el as an example. This
729 leads to a certain amount of ``normal'' recursion.
731 Also, just loading a file recursively is not always an error in
732 the general case; the second load may do something different. */
736 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
737 if (!NILP (Fequal (found
, XCAR (tem
))))
740 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
741 Fcons (found
, Vloads_in_progress
)));
742 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
743 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
746 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
748 /* Load .elc files directly, but not when they are
749 remote and have no handler! */
756 if (!safe_to_load_p (fd
))
759 if (!load_dangerous_libraries
)
760 error ("File `%s' was not compiled in Emacs",
761 XSTRING (found
)->data
);
762 else if (!NILP (nomessage
))
763 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
771 stat ((char *)XSTRING (found
)->data
, &s1
);
772 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
773 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
774 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
776 /* Make the progress messages mention that source is newer. */
779 /* If we won't print another message, mention this anyway. */
780 if (! NILP (nomessage
))
781 message_with_string ("Source file `%s' newer than byte-compiled file",
784 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
789 /* We are loading a source file (*.el). */
790 if (!NILP (Vload_source_file_function
))
796 val
= call4 (Vload_source_file_function
, found
, file
,
797 NILP (noerror
) ? Qnil
: Qt
,
798 NILP (nomessage
) ? Qnil
: Qt
);
799 return unbind_to (count
, val
);
805 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
806 #else /* not WINDOWSNT */
807 stream
= fdopen (fd
, fmode
);
808 #endif /* not WINDOWSNT */
812 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
815 if (! NILP (Vpurify_flag
))
816 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
818 if (NILP (nomessage
))
821 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
824 message_with_string ("Loading %s (source)...", file
, 1);
826 message_with_string ("Loading %s (compiled; note, source file is newer)...",
828 else /* The typical case; compiled file newer than source file. */
829 message_with_string ("Loading %s...", file
, 1);
833 lispstream
= Fcons (Qnil
, Qnil
);
834 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
835 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
836 record_unwind_protect (load_unwind
, lispstream
);
837 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
838 specbind (Qload_file_name
, found
);
839 specbind (Qinhibit_file_name_operation
, Qnil
);
841 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
843 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
844 unbind_to (count
, Qnil
);
846 /* Run any load-hooks for this file. */
847 temp
= Fassoc (file
, Vafter_load_alist
);
849 Fprogn (Fcdr (temp
));
852 if (saved_doc_string
)
853 free (saved_doc_string
);
854 saved_doc_string
= 0;
855 saved_doc_string_size
= 0;
857 if (prev_saved_doc_string
)
858 xfree (prev_saved_doc_string
);
859 prev_saved_doc_string
= 0;
860 prev_saved_doc_string_size
= 0;
862 if (!noninteractive
&& NILP (nomessage
))
865 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
868 message_with_string ("Loading %s (source)...done", file
, 1);
870 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
872 else /* The typical case; compiled file newer than source file. */
873 message_with_string ("Loading %s...done", file
, 1);
880 load_unwind (stream
) /* used as unwind-protect function in load */
883 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
884 | XFASTINT (XCDR (stream
))));
885 if (--load_in_progress
< 0) load_in_progress
= 0;
890 load_descriptor_unwind (oldlist
)
893 load_descriptor_list
= oldlist
;
897 /* Close all descriptors in use for Floads.
898 This is used when starting a subprocess. */
905 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
906 emacs_close (XFASTINT (XCAR (tail
)));
911 complete_filename_p (pathname
)
912 Lisp_Object pathname
;
914 register unsigned char *s
= XSTRING (pathname
)->data
;
915 return (IS_DIRECTORY_SEP (s
[0])
916 || (XSTRING (pathname
)->size
> 2
917 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
927 /* Search for a file whose name is STR, looking in directories
928 in the Lisp list PATH, and trying suffixes from SUFFIX.
929 On success, returns a file descriptor. On failure, returns -1.
931 SUFFIXES is a list of strings containing possible suffixes.
932 The empty suffix is automatically added iff the list is empty.
934 EXEC_ONLY nonzero means don't open the files,
935 just look for one that is executable. In this case,
936 returns 1 on success.
938 If STOREPTR is nonzero, it points to a slot where the name of
939 the file actually found should be stored as a Lisp string.
940 nil is stored there on failure.
942 If the file we find is remote, return -2
943 but store the found remote file name in *STOREPTR.
944 We do not check for remote files if EXEC_ONLY is nonzero. */
947 openp (path
, str
, suffixes
, storeptr
, exec_only
)
948 Lisp_Object path
, str
;
949 Lisp_Object suffixes
;
950 Lisp_Object
*storeptr
;
956 register char *fn
= buf
;
959 Lisp_Object filename
;
961 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
962 Lisp_Object string
, tail
;
963 int max_suffix_len
= 0;
965 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
967 CHECK_STRING_CAR (tail
);
968 max_suffix_len
= max (max_suffix_len
,
969 STRING_BYTES (XSTRING (XCAR (tail
))));
972 string
= filename
= Qnil
;
973 GCPRO5 (str
, string
, filename
, path
, suffixes
);
978 if (complete_filename_p (str
))
981 for (; CONSP (path
); path
= XCDR (path
))
983 filename
= Fexpand_file_name (str
, XCAR (path
));
984 if (!complete_filename_p (filename
))
985 /* If there are non-absolute elts in PATH (eg ".") */
986 /* Of course, this could conceivably lose if luser sets
987 default-directory to be something non-absolute... */
989 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
990 if (!complete_filename_p (filename
))
991 /* Give up on this path element! */
995 /* Calculate maximum size of any filename made from
996 this path element/specified file name and any possible suffix. */
997 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
998 if (fn_size
< want_size
)
999 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1001 /* Loop over suffixes. */
1002 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1003 CONSP (tail
); tail
= XCDR (tail
))
1005 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1006 Lisp_Object handler
;
1008 /* Concatenate path element/specified name with the suffix.
1009 If the directory starts with /:, remove that. */
1010 if (XSTRING (filename
)->size
> 2
1011 && XSTRING (filename
)->data
[0] == '/'
1012 && XSTRING (filename
)->data
[1] == ':')
1014 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1015 STRING_BYTES (XSTRING (filename
)) - 2);
1016 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1020 strncpy (fn
, XSTRING (filename
)->data
,
1021 STRING_BYTES (XSTRING (filename
)));
1022 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1025 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1026 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1028 /* Check that the file exists and is not a directory. */
1029 /* We used to only check for handlers on non-absolute file names:
1033 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1034 It's not clear why that was the case and it breaks things like
1035 (load "/bar.el") where the file is actually "/bar.el.gz". */
1036 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1037 if (!NILP (handler
) && !exec_only
)
1041 string
= build_string (fn
);
1042 exists
= !NILP (Ffile_readable_p (string
));
1043 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1048 /* We succeeded; return this descriptor and filename. */
1050 *storeptr
= build_string (fn
);
1057 int exists
= (stat (fn
, &st
) >= 0
1058 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1061 /* Check that we can access or open it. */
1063 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1065 fd
= emacs_open (fn
, O_RDONLY
, 0);
1069 /* We succeeded; return this descriptor and filename. */
1071 *storeptr
= build_string (fn
);
1087 /* Merge the list we've accumulated of globals from the current input source
1088 into the load_history variable. The details depend on whether
1089 the source has an associated file name or not. */
1092 build_load_history (stream
, source
)
1096 register Lisp_Object tail
, prev
, newelt
;
1097 register Lisp_Object tem
, tem2
;
1098 register int foundit
, loading
;
1100 loading
= stream
|| !NARROWED
;
1102 tail
= Vload_history
;
1105 while (!NILP (tail
))
1109 /* Find the feature's previous assoc list... */
1110 if (!NILP (Fequal (source
, Fcar (tem
))))
1114 /* If we're loading, remove it. */
1118 Vload_history
= Fcdr (tail
);
1120 Fsetcdr (prev
, Fcdr (tail
));
1123 /* Otherwise, cons on new symbols that are not already members. */
1126 tem2
= Vcurrent_load_list
;
1128 while (CONSP (tem2
))
1130 newelt
= Fcar (tem2
);
1132 if (NILP (Fmemq (newelt
, tem
)))
1133 Fsetcar (tail
, Fcons (Fcar (tem
),
1134 Fcons (newelt
, Fcdr (tem
))));
1147 /* If we're loading, cons the new assoc onto the front of load-history,
1148 the most-recently-loaded position. Also do this if we didn't find
1149 an existing member for the current source. */
1150 if (loading
|| !foundit
)
1151 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1156 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1164 readevalloop_1 (old
)
1167 load_convert_to_unibyte
= ! NILP (old
);
1171 /* Signal an `end-of-file' error, if possible with file name
1175 end_of_file_error ()
1179 if (STRINGP (Vload_file_name
))
1180 data
= Fcons (Vload_file_name
, Qnil
);
1184 Fsignal (Qend_of_file
, data
);
1187 /* UNIBYTE specifies how to set load_convert_to_unibyte
1188 for this invocation.
1189 READFUN, if non-nil, is used instead of `read'. */
1192 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1193 Lisp_Object readcharfun
;
1195 Lisp_Object sourcename
;
1196 Lisp_Object (*evalfun
) ();
1198 Lisp_Object unibyte
, readfun
;
1201 register Lisp_Object val
;
1202 int count
= specpdl_ptr
- specpdl
;
1203 struct gcpro gcpro1
;
1204 struct buffer
*b
= 0;
1205 int continue_reading_p
;
1207 if (BUFFERP (readcharfun
))
1208 b
= XBUFFER (readcharfun
);
1209 else if (MARKERP (readcharfun
))
1210 b
= XMARKER (readcharfun
)->buffer
;
1212 specbind (Qstandard_input
, readcharfun
);
1213 specbind (Qcurrent_load_list
, Qnil
);
1214 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1215 load_convert_to_unibyte
= !NILP (unibyte
);
1217 readchar_backlog
= -1;
1219 GCPRO1 (sourcename
);
1221 LOADHIST_ATTACH (sourcename
);
1223 continue_reading_p
= 1;
1224 while (continue_reading_p
)
1226 if (b
!= 0 && NILP (b
->name
))
1227 error ("Reading from killed buffer");
1233 while ((c
= READCHAR
) != '\n' && c
!= -1);
1238 /* Ignore whitespace here, so we can detect eof. */
1239 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1242 if (!NILP (Vpurify_flag
) && c
== '(')
1244 int count1
= specpdl_ptr
- specpdl
;
1245 record_unwind_protect (unreadpure
, Qnil
);
1246 val
= read_list (-1, readcharfun
);
1247 unbind_to (count1
, Qnil
);
1252 read_objects
= Qnil
;
1253 if (!NILP (readfun
))
1255 val
= call1 (readfun
, readcharfun
);
1257 /* If READCHARFUN has set point to ZV, we should
1258 stop reading, even if the form read sets point
1259 to a different value when evaluated. */
1260 if (BUFFERP (readcharfun
))
1262 struct buffer
*b
= XBUFFER (readcharfun
);
1263 if (BUF_PT (b
) == BUF_ZV (b
))
1264 continue_reading_p
= 0;
1267 else if (! NILP (Vload_read_function
))
1268 val
= call1 (Vload_read_function
, readcharfun
);
1270 val
= read0 (readcharfun
);
1273 val
= (*evalfun
) (val
);
1277 Vvalues
= Fcons (val
, Vvalues
);
1278 if (EQ (Vstandard_output
, Qt
))
1285 build_load_history (stream
, sourcename
);
1288 unbind_to (count
, Qnil
);
1291 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1292 doc
: /* Execute the current buffer as Lisp code.
1293 Programs can pass two arguments, BUFFER and PRINTFLAG.
1294 BUFFER is the buffer to evaluate (nil means use current buffer).
1295 PRINTFLAG controls printing of output:
1296 nil means discard it; anything else is stream for print.
1298 If the optional third argument FILENAME is non-nil,
1299 it specifies the file name to use for `load-history'.
1300 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1301 for this invocation.
1303 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1304 `print' and related functions should work normally even if PRINTFLAG is nil.
1306 This function preserves the position of point. */)
1307 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1308 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1310 int count
= specpdl_ptr
- specpdl
;
1311 Lisp_Object tem
, buf
;
1314 buf
= Fcurrent_buffer ();
1316 buf
= Fget_buffer (buffer
);
1318 error ("No such buffer");
1320 if (NILP (printflag
) && NILP (do_allow_print
))
1325 if (NILP (filename
))
1326 filename
= XBUFFER (buf
)->filename
;
1328 specbind (Qstandard_output
, tem
);
1329 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1330 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1331 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1332 unbind_to (count
, Qnil
);
1337 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1338 doc
: /* Execute the region as Lisp code.
1339 When called from programs, expects two arguments,
1340 giving starting and ending indices in the current buffer
1341 of the text to be executed.
1342 Programs can pass third argument PRINTFLAG which controls output:
1343 nil means discard it; anything else is stream for printing it.
1344 Also the fourth argument READ-FUNCTION, if non-nil, is used
1345 instead of `read' to read each expression. It gets one argument
1346 which is the input stream for reading characters.
1348 This function does not move point. */)
1349 (start
, end
, printflag
, read_function
)
1350 Lisp_Object start
, end
, printflag
, read_function
;
1352 int count
= specpdl_ptr
- specpdl
;
1353 Lisp_Object tem
, cbuf
;
1355 cbuf
= Fcurrent_buffer ();
1357 if (NILP (printflag
))
1361 specbind (Qstandard_output
, tem
);
1363 if (NILP (printflag
))
1364 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1365 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1367 /* This both uses start and checks its type. */
1369 Fnarrow_to_region (make_number (BEGV
), end
);
1370 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1371 !NILP (printflag
), Qnil
, read_function
);
1373 return unbind_to (count
, Qnil
);
1377 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1378 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1379 If STREAM is nil, use the value of `standard-input' (which see).
1380 STREAM or the value of `standard-input' may be:
1381 a buffer (read from point and advance it)
1382 a marker (read from where it points and advance it)
1383 a function (call it with no arguments for each character,
1384 call it with a char as argument to push a char back)
1385 a string (takes text from string, starting at the beginning)
1386 t (read text line using minibuffer and use it, or read from
1387 standard input in batch mode). */)
1391 extern Lisp_Object
Fread_minibuffer ();
1394 stream
= Vstandard_input
;
1395 if (EQ (stream
, Qt
))
1396 stream
= Qread_char
;
1398 readchar_backlog
= -1;
1399 new_backquote_flag
= 0;
1400 read_objects
= Qnil
;
1402 if (EQ (stream
, Qread_char
))
1403 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1405 if (STRINGP (stream
))
1406 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1408 return read0 (stream
);
1411 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1412 doc
: /* Read one Lisp expression which is represented as text by STRING.
1413 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1414 START and END optionally delimit a substring of STRING from which to read;
1415 they default to 0 and (length STRING) respectively. */)
1416 (string
, start
, end
)
1417 Lisp_Object string
, start
, end
;
1419 int startval
, endval
;
1422 CHECK_STRING (string
);
1425 endval
= XSTRING (string
)->size
;
1429 endval
= XINT (end
);
1430 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1431 args_out_of_range (string
, end
);
1438 CHECK_NUMBER (start
);
1439 startval
= XINT (start
);
1440 if (startval
< 0 || startval
> endval
)
1441 args_out_of_range (string
, start
);
1444 read_from_string_index
= startval
;
1445 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1446 read_from_string_limit
= endval
;
1448 new_backquote_flag
= 0;
1449 read_objects
= Qnil
;
1451 tem
= read0 (string
);
1452 return Fcons (tem
, make_number (read_from_string_index
));
1455 /* Use this for recursive reads, in contexts where internal tokens
1460 Lisp_Object readcharfun
;
1462 register Lisp_Object val
;
1465 val
= read1 (readcharfun
, &c
, 0);
1467 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1474 static int read_buffer_size
;
1475 static char *read_buffer
;
1477 /* Read multibyte form and return it as a character. C is a first
1478 byte of multibyte form, and rest of them are read from
1482 read_multibyte (c
, readcharfun
)
1484 Lisp_Object readcharfun
;
1486 /* We need the actual character code of this multibyte
1488 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1493 while ((c
= READCHAR
) >= 0xA0
1494 && len
< MAX_MULTIBYTE_LENGTH
)
1497 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1498 return STRING_CHAR (str
, len
);
1499 /* The byte sequence is not valid as multibyte. Unread all bytes
1500 but the first one, and return the first byte. */
1506 /* Read a \-escape sequence, assuming we already read the `\'.
1507 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1508 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1509 Otherwise store 0 into *BYTEREP. */
1512 read_escape (readcharfun
, stringp
, byterep
)
1513 Lisp_Object readcharfun
;
1517 register int c
= READCHAR
;
1524 end_of_file_error ();
1554 error ("Invalid escape character syntax");
1557 c
= read_escape (readcharfun
, 0, byterep
);
1558 return c
| meta_modifier
;
1563 error ("Invalid escape character syntax");
1566 c
= read_escape (readcharfun
, 0, byterep
);
1567 return c
| shift_modifier
;
1572 error ("Invalid escape character syntax");
1575 c
= read_escape (readcharfun
, 0, byterep
);
1576 return c
| hyper_modifier
;
1581 error ("Invalid escape character syntax");
1584 c
= read_escape (readcharfun
, 0, byterep
);
1585 return c
| alt_modifier
;
1590 error ("Invalid escape character syntax");
1593 c
= read_escape (readcharfun
, 0, byterep
);
1594 return c
| super_modifier
;
1599 error ("Invalid escape character syntax");
1603 c
= read_escape (readcharfun
, 0, byterep
);
1604 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1605 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1606 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1607 return c
| ctrl_modifier
;
1608 /* ASCII control chars are made from letters (both cases),
1609 as well as the non-letters within 0100...0137. */
1610 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1611 return (c
& (037 | ~0177));
1612 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1613 return (c
& (037 | ~0177));
1615 return c
| ctrl_modifier
;
1625 /* An octal escape, as in ANSI C. */
1627 register int i
= c
- '0';
1628 register int count
= 0;
1631 if ((c
= READCHAR
) >= '0' && c
<= '7')
1648 /* A hex escape, as in ANSI C. */
1654 if (c
>= '0' && c
<= '9')
1659 else if ((c
>= 'a' && c
<= 'f')
1660 || (c
>= 'A' && c
<= 'F'))
1663 if (c
>= 'a' && c
<= 'f')
1680 if (BASE_LEADING_CODE_P (c
))
1681 c
= read_multibyte (c
, readcharfun
);
1687 /* Read an integer in radix RADIX using READCHARFUN to read
1688 characters. RADIX must be in the interval [2..36]; if it isn't, a
1689 read error is signaled . Value is the integer read. Signals an
1690 error if encountering invalid read syntax or if RADIX is out of
1694 read_integer (readcharfun
, radix
)
1695 Lisp_Object readcharfun
;
1698 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1699 EMACS_INT number
= 0;
1701 if (radix
< 2 || radix
> 36)
1705 number
= ndigits
= invalid_p
= 0;
1721 if (c
>= '0' && c
<= '9')
1723 else if (c
>= 'a' && c
<= 'z')
1724 digit
= c
- 'a' + 10;
1725 else if (c
>= 'A' && c
<= 'Z')
1726 digit
= c
- 'A' + 10;
1733 if (digit
< 0 || digit
>= radix
)
1736 number
= radix
* number
+ digit
;
1742 if (ndigits
== 0 || invalid_p
)
1745 sprintf (buf
, "integer, radix %d", radix
);
1746 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1749 return make_number (sign
* number
);
1753 /* Convert unibyte text in read_buffer to multibyte.
1755 Initially, *P is a pointer after the end of the unibyte text, and
1756 the pointer *END points after the end of read_buffer.
1758 If read_buffer doesn't have enough room to hold the result
1759 of the conversion, reallocate it and adjust *P and *END.
1761 At the end, make *P point after the result of the conversion, and
1762 return in *NCHARS the number of characters in the converted
1766 to_multibyte (p
, end
, nchars
)
1772 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1773 if (read_buffer_size
< 2 * nbytes
)
1775 int offset
= *p
- read_buffer
;
1776 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1777 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1778 *p
= read_buffer
+ offset
;
1779 *end
= read_buffer
+ read_buffer_size
;
1782 if (nbytes
!= *nchars
)
1783 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1784 *p
- read_buffer
, nchars
);
1786 *p
= read_buffer
+ nbytes
;
1790 /* If the next token is ')' or ']' or '.', we store that character
1791 in *PCH and the return value is not interesting. Else, we store
1792 zero in *PCH and we read and return one lisp object.
1794 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1797 read1 (readcharfun
, pch
, first_in_list
)
1798 register Lisp_Object readcharfun
;
1803 int uninterned_symbol
= 0;
1811 end_of_file_error ();
1816 return read_list (0, readcharfun
);
1819 return read_vector (readcharfun
, 0);
1836 tmp
= read_vector (readcharfun
, 0);
1837 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1838 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1839 error ("Invalid size char-table");
1840 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1841 XCHAR_TABLE (tmp
)->top
= Qt
;
1850 tmp
= read_vector (readcharfun
, 0);
1851 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1852 error ("Invalid size char-table");
1853 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1854 XCHAR_TABLE (tmp
)->top
= Qnil
;
1857 Fsignal (Qinvalid_read_syntax
,
1858 Fcons (make_string ("#^^", 3), Qnil
));
1860 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1865 length
= read1 (readcharfun
, pch
, first_in_list
);
1869 Lisp_Object tmp
, val
;
1870 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1874 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1875 if (size_in_chars
!= XSTRING (tmp
)->size
1876 /* We used to print 1 char too many
1877 when the number of bits was a multiple of 8.
1878 Accept such input in case it came from an old version. */
1879 && ! (XFASTINT (length
)
1880 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1881 Fsignal (Qinvalid_read_syntax
,
1882 Fcons (make_string ("#&...", 5), Qnil
));
1884 val
= Fmake_bool_vector (length
, Qnil
);
1885 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1887 /* Clear the extraneous bits in the last byte. */
1888 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1889 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1890 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1893 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1898 /* Accept compiled functions at read-time so that we don't have to
1899 build them using function calls. */
1901 tmp
= read_vector (readcharfun
, 1);
1902 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1903 XVECTOR (tmp
)->contents
);
1908 struct gcpro gcpro1
;
1911 /* Read the string itself. */
1912 tmp
= read1 (readcharfun
, &ch
, 0);
1913 if (ch
!= 0 || !STRINGP (tmp
))
1914 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1916 /* Read the intervals and their properties. */
1919 Lisp_Object beg
, end
, plist
;
1921 beg
= read1 (readcharfun
, &ch
, 0);
1926 end
= read1 (readcharfun
, &ch
, 0);
1928 plist
= read1 (readcharfun
, &ch
, 0);
1930 Fsignal (Qinvalid_read_syntax
,
1931 Fcons (build_string ("invalid string property list"),
1933 Fset_text_properties (beg
, end
, plist
, tmp
);
1939 /* #@NUMBER is used to skip NUMBER following characters.
1940 That's used in .elc files to skip over doc strings
1941 and function definitions. */
1946 /* Read a decimal integer. */
1947 while ((c
= READCHAR
) >= 0
1948 && c
>= '0' && c
<= '9')
1956 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1958 /* If we are supposed to force doc strings into core right now,
1959 record the last string that we skipped,
1960 and record where in the file it comes from. */
1962 /* But first exchange saved_doc_string
1963 with prev_saved_doc_string, so we save two strings. */
1965 char *temp
= saved_doc_string
;
1966 int temp_size
= saved_doc_string_size
;
1967 file_offset temp_pos
= saved_doc_string_position
;
1968 int temp_len
= saved_doc_string_length
;
1970 saved_doc_string
= prev_saved_doc_string
;
1971 saved_doc_string_size
= prev_saved_doc_string_size
;
1972 saved_doc_string_position
= prev_saved_doc_string_position
;
1973 saved_doc_string_length
= prev_saved_doc_string_length
;
1975 prev_saved_doc_string
= temp
;
1976 prev_saved_doc_string_size
= temp_size
;
1977 prev_saved_doc_string_position
= temp_pos
;
1978 prev_saved_doc_string_length
= temp_len
;
1981 if (saved_doc_string_size
== 0)
1983 saved_doc_string_size
= nskip
+ 100;
1984 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1986 if (nskip
> saved_doc_string_size
)
1988 saved_doc_string_size
= nskip
+ 100;
1989 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1990 saved_doc_string_size
);
1993 saved_doc_string_position
= file_tell (instream
);
1995 /* Copy that many characters into saved_doc_string. */
1996 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1997 saved_doc_string
[i
] = c
= READCHAR
;
1999 saved_doc_string_length
= i
;
2003 /* Skip that many characters. */
2004 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2011 return Vload_file_name
;
2013 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2014 /* #:foo is the uninterned symbol named foo. */
2017 uninterned_symbol
= 1;
2021 /* Reader forms that can reuse previously read objects. */
2022 if (c
>= '0' && c
<= '9')
2027 /* Read a non-negative integer. */
2028 while (c
>= '0' && c
<= '9')
2034 /* #n=object returns object, but associates it with n for #n#. */
2037 /* Make a placeholder for #n# to use temporarily */
2038 Lisp_Object placeholder
;
2041 placeholder
= Fcons(Qnil
, Qnil
);
2042 cell
= Fcons (make_number (n
), placeholder
);
2043 read_objects
= Fcons (cell
, read_objects
);
2045 /* Read the object itself. */
2046 tem
= read0 (readcharfun
);
2048 /* Now put it everywhere the placeholder was... */
2049 substitute_object_in_subtree (tem
, placeholder
);
2051 /* ...and #n# will use the real value from now on. */
2052 Fsetcdr (cell
, tem
);
2056 /* #n# returns a previously read object. */
2059 tem
= Fassq (make_number (n
), read_objects
);
2062 /* Fall through to error message. */
2064 else if (c
== 'r' || c
== 'R')
2065 return read_integer (readcharfun
, n
);
2067 /* Fall through to error message. */
2069 else if (c
== 'x' || c
== 'X')
2070 return read_integer (readcharfun
, 16);
2071 else if (c
== 'o' || c
== 'O')
2072 return read_integer (readcharfun
, 8);
2073 else if (c
== 'b' || c
== 'B')
2074 return read_integer (readcharfun
, 2);
2077 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2080 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2085 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2095 new_backquote_flag
++;
2096 value
= read0 (readcharfun
);
2097 new_backquote_flag
--;
2099 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2103 if (new_backquote_flag
)
2105 Lisp_Object comma_type
= Qnil
;
2110 comma_type
= Qcomma_at
;
2112 comma_type
= Qcomma_dot
;
2115 if (ch
>= 0) UNREAD (ch
);
2116 comma_type
= Qcomma
;
2119 new_backquote_flag
--;
2120 value
= read0 (readcharfun
);
2121 new_backquote_flag
++;
2122 return Fcons (comma_type
, Fcons (value
, Qnil
));
2133 end_of_file_error ();
2136 c
= read_escape (readcharfun
, 0, &discard
);
2137 else if (BASE_LEADING_CODE_P (c
))
2138 c
= read_multibyte (c
, readcharfun
);
2140 return make_number (c
);
2145 char *p
= read_buffer
;
2146 char *end
= read_buffer
+ read_buffer_size
;
2148 /* 1 if we saw an escape sequence specifying
2149 a multibyte character, or a multibyte character. */
2150 int force_multibyte
= 0;
2151 /* 1 if we saw an escape sequence specifying
2152 a single-byte character. */
2153 int force_singlebyte
= 0;
2154 /* 1 if read_buffer contains multibyte text now. */
2155 int is_multibyte
= 0;
2159 while ((c
= READCHAR
) >= 0
2162 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2164 int offset
= p
- read_buffer
;
2165 read_buffer
= (char *) xrealloc (read_buffer
,
2166 read_buffer_size
*= 2);
2167 p
= read_buffer
+ offset
;
2168 end
= read_buffer
+ read_buffer_size
;
2175 c
= read_escape (readcharfun
, 1, &byterep
);
2177 /* C is -1 if \ newline has just been seen */
2180 if (p
== read_buffer
)
2186 force_singlebyte
= 1;
2187 else if (byterep
== 2)
2188 force_multibyte
= 1;
2191 /* A character that must be multibyte forces multibyte. */
2192 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2193 force_multibyte
= 1;
2195 /* If we just discovered the need to be multibyte,
2196 convert the text accumulated thus far. */
2197 if (force_multibyte
&& ! is_multibyte
)
2200 to_multibyte (&p
, &end
, &nchars
);
2203 /* Allow `\C- ' and `\C-?'. */
2204 if (c
== (CHAR_CTL
| ' '))
2206 else if (c
== (CHAR_CTL
| '?'))
2211 /* Shift modifier is valid only with [A-Za-z]. */
2212 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2214 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2215 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2219 /* Move the meta bit to the right place for a string. */
2220 c
= (c
& ~CHAR_META
) | 0x80;
2221 if (c
& CHAR_MODIFIER_MASK
)
2222 error ("Invalid modifier in string");
2225 p
+= CHAR_STRING (c
, p
);
2233 end_of_file_error ();
2235 /* If purifying, and string starts with \ newline,
2236 return zero instead. This is for doc strings
2237 that we are really going to find in etc/DOC.nn.nn */
2238 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2239 return make_number (0);
2241 if (is_multibyte
|| force_singlebyte
)
2243 else if (load_convert_to_unibyte
)
2246 to_multibyte (&p
, &end
, &nchars
);
2247 if (p
- read_buffer
!= nchars
)
2249 string
= make_multibyte_string (read_buffer
, nchars
,
2251 return Fstring_make_unibyte (string
);
2253 /* We can make a unibyte string directly. */
2256 else if (EQ (readcharfun
, Qget_file_char
)
2257 || EQ (readcharfun
, Qlambda
))
2259 /* Nowadays, reading directly from a file is used only for
2260 compiled Emacs Lisp files, and those always use the
2261 Emacs internal encoding. Meanwhile, Qlambda is used
2262 for reading dynamic byte code (compiled with
2263 byte-compile-dynamic = t). */
2264 to_multibyte (&p
, &end
, &nchars
);
2268 /* In all other cases, if we read these bytes as
2269 separate characters, treat them as separate characters now. */
2273 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2275 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2281 int next_char
= READCHAR
;
2284 if (next_char
<= 040
2285 || index ("\"'`,(", next_char
))
2291 /* Otherwise, we fall through! Note that the atom-reading loop
2292 below will now loop at least once, assuring that we will not
2293 try to UNREAD two characters in a row. */
2297 if (c
<= 040) goto retry
;
2299 char *p
= read_buffer
;
2303 char *end
= read_buffer
+ read_buffer_size
;
2306 && !(c
== '\"' || c
== '\'' || c
== ';'
2307 || c
== '(' || c
== ')'
2308 || c
== '[' || c
== ']' || c
== '#'))
2310 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2312 int offset
= p
- read_buffer
;
2313 read_buffer
= (char *) xrealloc (read_buffer
,
2314 read_buffer_size
*= 2);
2315 p
= read_buffer
+ offset
;
2316 end
= read_buffer
+ read_buffer_size
;
2323 end_of_file_error ();
2327 if (! SINGLE_BYTE_CHAR_P (c
))
2328 p
+= CHAR_STRING (c
, p
);
2337 int offset
= p
- read_buffer
;
2338 read_buffer
= (char *) xrealloc (read_buffer
,
2339 read_buffer_size
*= 2);
2340 p
= read_buffer
+ offset
;
2341 end
= read_buffer
+ read_buffer_size
;
2348 if (!quoted
&& !uninterned_symbol
)
2351 register Lisp_Object val
;
2353 if (*p1
== '+' || *p1
== '-') p1
++;
2354 /* Is it an integer? */
2357 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2358 /* Integers can have trailing decimal points. */
2359 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2361 /* It is an integer. */
2365 if (sizeof (int) == sizeof (EMACS_INT
))
2366 XSETINT (val
, atoi (read_buffer
));
2367 else if (sizeof (long) == sizeof (EMACS_INT
))
2368 XSETINT (val
, atol (read_buffer
));
2374 if (isfloat_string (read_buffer
))
2376 /* Compute NaN and infinities using 0.0 in a variable,
2377 to cope with compilers that think they are smarter
2383 /* Negate the value ourselves. This treats 0, NaNs,
2384 and infinity properly on IEEE floating point hosts,
2385 and works around a common bug where atof ("-0.0")
2387 int negative
= read_buffer
[0] == '-';
2389 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2390 returns 1, is if the input ends in e+INF or e+NaN. */
2397 value
= zero
/ zero
;
2400 value
= atof (read_buffer
+ negative
);
2404 return make_float (negative
? - value
: value
);
2408 if (uninterned_symbol
)
2409 return make_symbol (read_buffer
);
2411 return intern (read_buffer
);
2417 /* List of nodes we've seen during substitute_object_in_subtree. */
2418 static Lisp_Object seen_list
;
2421 substitute_object_in_subtree (object
, placeholder
)
2423 Lisp_Object placeholder
;
2425 Lisp_Object check_object
;
2427 /* We haven't seen any objects when we start. */
2430 /* Make all the substitutions. */
2432 = substitute_object_recurse (object
, placeholder
, object
);
2434 /* Clear seen_list because we're done with it. */
2437 /* The returned object here is expected to always eq the
2439 if (!EQ (check_object
, object
))
2440 error ("Unexpected mutation error in reader");
2443 /* Feval doesn't get called from here, so no gc protection is needed. */
2444 #define SUBSTITUTE(get_val, set_val) \
2446 Lisp_Object old_value = get_val; \
2447 Lisp_Object true_value \
2448 = substitute_object_recurse (object, placeholder,\
2451 if (!EQ (old_value, true_value)) \
2458 substitute_object_recurse (object
, placeholder
, subtree
)
2460 Lisp_Object placeholder
;
2461 Lisp_Object subtree
;
2463 /* If we find the placeholder, return the target object. */
2464 if (EQ (placeholder
, subtree
))
2467 /* If we've been to this node before, don't explore it again. */
2468 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2471 /* If this node can be the entry point to a cycle, remember that
2472 we've seen it. It can only be such an entry point if it was made
2473 by #n=, which means that we can find it as a value in
2475 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2476 seen_list
= Fcons (subtree
, seen_list
);
2478 /* Recurse according to subtree's type.
2479 Every branch must return a Lisp_Object. */
2480 switch (XTYPE (subtree
))
2482 case Lisp_Vectorlike
:
2485 int length
= XINT (Flength(subtree
));
2486 for (i
= 0; i
< length
; i
++)
2488 Lisp_Object idx
= make_number (i
);
2489 SUBSTITUTE (Faref (subtree
, idx
),
2490 Faset (subtree
, idx
, true_value
));
2497 SUBSTITUTE (Fcar_safe (subtree
),
2498 Fsetcar (subtree
, true_value
));
2499 SUBSTITUTE (Fcdr_safe (subtree
),
2500 Fsetcdr (subtree
, true_value
));
2506 /* Check for text properties in each interval.
2507 substitute_in_interval contains part of the logic. */
2509 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2510 Lisp_Object arg
= Fcons (object
, placeholder
);
2512 traverse_intervals_noorder (root_interval
,
2513 &substitute_in_interval
, arg
);
2518 /* Other types don't recurse any further. */
2524 /* Helper function for substitute_object_recurse. */
2526 substitute_in_interval (interval
, arg
)
2530 Lisp_Object object
= Fcar (arg
);
2531 Lisp_Object placeholder
= Fcdr (arg
);
2533 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2552 if (*cp
== '+' || *cp
== '-')
2555 if (*cp
>= '0' && *cp
<= '9')
2558 while (*cp
>= '0' && *cp
<= '9')
2566 if (*cp
>= '0' && *cp
<= '9')
2569 while (*cp
>= '0' && *cp
<= '9')
2572 if (*cp
== 'e' || *cp
== 'E')
2576 if (*cp
== '+' || *cp
== '-')
2580 if (*cp
>= '0' && *cp
<= '9')
2583 while (*cp
>= '0' && *cp
<= '9')
2586 else if (cp
== start
)
2588 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2593 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2599 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2600 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2601 || state
== (DOT_CHAR
|TRAIL_INT
)
2602 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2603 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2604 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2609 read_vector (readcharfun
, bytecodeflag
)
2610 Lisp_Object readcharfun
;
2615 register Lisp_Object
*ptr
;
2616 register Lisp_Object tem
, item
, vector
;
2617 register struct Lisp_Cons
*otem
;
2620 tem
= read_list (1, readcharfun
);
2621 len
= Flength (tem
);
2622 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2624 size
= XVECTOR (vector
)->size
;
2625 ptr
= XVECTOR (vector
)->contents
;
2626 for (i
= 0; i
< size
; i
++)
2629 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2630 bytecode object, the docstring containing the bytecode and
2631 constants values must be treated as unibyte and passed to
2632 Fread, to get the actual bytecode string and constants vector. */
2633 if (bytecodeflag
&& load_force_doc_strings
)
2635 if (i
== COMPILED_BYTECODE
)
2637 if (!STRINGP (item
))
2638 error ("invalid byte code");
2640 /* Delay handling the bytecode slot until we know whether
2641 it is lazily-loaded (we can tell by whether the
2642 constants slot is nil). */
2643 ptr
[COMPILED_CONSTANTS
] = item
;
2646 else if (i
== COMPILED_CONSTANTS
)
2648 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2652 /* Coerce string to unibyte (like string-as-unibyte,
2653 but without generating extra garbage and
2654 guaranteeing no change in the contents). */
2655 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2656 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2658 item
= Fread (bytestr
);
2660 error ("invalid byte code");
2662 otem
= XCONS (item
);
2663 bytestr
= XCAR (item
);
2668 /* Now handle the bytecode slot. */
2669 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2672 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2680 /* FLAG = 1 means check for ] to terminate rather than ) and .
2681 FLAG = -1 means check for starting with defun
2682 and make structure pure. */
2685 read_list (flag
, readcharfun
)
2687 register Lisp_Object readcharfun
;
2689 /* -1 means check next element for defun,
2690 0 means don't check,
2691 1 means already checked and found defun. */
2692 int defunflag
= flag
< 0 ? -1 : 0;
2693 Lisp_Object val
, tail
;
2694 register Lisp_Object elt
, tem
;
2695 struct gcpro gcpro1
, gcpro2
;
2696 /* 0 is the normal case.
2697 1 means this list is a doc reference; replace it with the number 0.
2698 2 means this list is a doc reference; replace it with the doc string. */
2699 int doc_reference
= 0;
2701 /* Initialize this to 1 if we are reading a list. */
2702 int first_in_list
= flag
<= 0;
2711 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2716 /* While building, if the list starts with #$, treat it specially. */
2717 if (EQ (elt
, Vload_file_name
)
2719 && !NILP (Vpurify_flag
))
2721 if (NILP (Vdoc_file_name
))
2722 /* We have not yet called Snarf-documentation, so assume
2723 this file is described in the DOC-MM.NN file
2724 and Snarf-documentation will fill in the right value later.
2725 For now, replace the whole list with 0. */
2728 /* We have already called Snarf-documentation, so make a relative
2729 file name for this file, so it can be found properly
2730 in the installed Lisp directory.
2731 We don't use Fexpand_file_name because that would make
2732 the directory absolute now. */
2733 elt
= concat2 (build_string ("../lisp/"),
2734 Ffile_name_nondirectory (elt
));
2736 else if (EQ (elt
, Vload_file_name
)
2738 && load_force_doc_strings
)
2747 Fsignal (Qinvalid_read_syntax
,
2748 Fcons (make_string (") or . in a vector", 18), Qnil
));
2756 XSETCDR (tail
, read0 (readcharfun
));
2758 val
= read0 (readcharfun
);
2759 read1 (readcharfun
, &ch
, 0);
2763 if (doc_reference
== 1)
2764 return make_number (0);
2765 if (doc_reference
== 2)
2767 /* Get a doc string from the file we are loading.
2768 If it's in saved_doc_string, get it from there. */
2769 int pos
= XINT (XCDR (val
));
2770 /* Position is negative for user variables. */
2771 if (pos
< 0) pos
= -pos
;
2772 if (pos
>= saved_doc_string_position
2773 && pos
< (saved_doc_string_position
2774 + saved_doc_string_length
))
2776 int start
= pos
- saved_doc_string_position
;
2779 /* Process quoting with ^A,
2780 and find the end of the string,
2781 which is marked with ^_ (037). */
2782 for (from
= start
, to
= start
;
2783 saved_doc_string
[from
] != 037;)
2785 int c
= saved_doc_string
[from
++];
2788 c
= saved_doc_string
[from
++];
2790 saved_doc_string
[to
++] = c
;
2792 saved_doc_string
[to
++] = 0;
2794 saved_doc_string
[to
++] = 037;
2797 saved_doc_string
[to
++] = c
;
2800 return make_string (saved_doc_string
+ start
,
2803 /* Look in prev_saved_doc_string the same way. */
2804 else if (pos
>= prev_saved_doc_string_position
2805 && pos
< (prev_saved_doc_string_position
2806 + prev_saved_doc_string_length
))
2808 int start
= pos
- prev_saved_doc_string_position
;
2811 /* Process quoting with ^A,
2812 and find the end of the string,
2813 which is marked with ^_ (037). */
2814 for (from
= start
, to
= start
;
2815 prev_saved_doc_string
[from
] != 037;)
2817 int c
= prev_saved_doc_string
[from
++];
2820 c
= prev_saved_doc_string
[from
++];
2822 prev_saved_doc_string
[to
++] = c
;
2824 prev_saved_doc_string
[to
++] = 0;
2826 prev_saved_doc_string
[to
++] = 037;
2829 prev_saved_doc_string
[to
++] = c
;
2832 return make_string (prev_saved_doc_string
+ start
,
2836 return get_doc_string (val
, 0, 0);
2841 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2843 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2845 tem
= (read_pure
&& flag
<= 0
2846 ? pure_cons (elt
, Qnil
)
2847 : Fcons (elt
, Qnil
));
2849 XSETCDR (tail
, tem
);
2854 defunflag
= EQ (elt
, Qdefun
);
2855 else if (defunflag
> 0)
2860 Lisp_Object Vobarray
;
2861 Lisp_Object initial_obarray
;
2863 /* oblookup stores the bucket number here, for the sake of Funintern. */
2865 int oblookup_last_bucket_number
;
2867 static int hash_string ();
2868 Lisp_Object
oblookup ();
2870 /* Get an error if OBARRAY is not an obarray.
2871 If it is one, return it. */
2874 check_obarray (obarray
)
2875 Lisp_Object obarray
;
2877 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2879 /* If Vobarray is now invalid, force it to be valid. */
2880 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2882 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2887 /* Intern the C string STR: return a symbol with that name,
2888 interned in the current obarray. */
2895 int len
= strlen (str
);
2896 Lisp_Object obarray
;
2899 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2900 obarray
= check_obarray (obarray
);
2901 tem
= oblookup (obarray
, str
, len
, len
);
2904 return Fintern (make_string (str
, len
), obarray
);
2907 /* Create an uninterned symbol with name STR. */
2913 int len
= strlen (str
);
2915 return Fmake_symbol ((!NILP (Vpurify_flag
)
2916 ? make_pure_string (str
, len
, len
, 0)
2917 : make_string (str
, len
)));
2920 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2921 doc
: /* Return the canonical symbol whose name is STRING.
2922 If there is none, one is created by this function and returned.
2923 A second optional argument specifies the obarray to use;
2924 it defaults to the value of `obarray'. */)
2926 Lisp_Object string
, obarray
;
2928 register Lisp_Object tem
, sym
, *ptr
;
2930 if (NILP (obarray
)) obarray
= Vobarray
;
2931 obarray
= check_obarray (obarray
);
2933 CHECK_STRING (string
);
2935 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2936 XSTRING (string
)->size
,
2937 STRING_BYTES (XSTRING (string
)));
2938 if (!INTEGERP (tem
))
2941 if (!NILP (Vpurify_flag
))
2942 string
= Fpurecopy (string
);
2943 sym
= Fmake_symbol (string
);
2945 if (EQ (obarray
, initial_obarray
))
2946 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2948 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2950 if ((XSTRING (string
)->data
[0] == ':')
2951 && EQ (obarray
, initial_obarray
))
2953 XSYMBOL (sym
)->constant
= 1;
2954 XSYMBOL (sym
)->value
= sym
;
2957 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2959 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2961 XSYMBOL (sym
)->next
= 0;
2966 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2967 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
2968 NAME may be a string or a symbol. If it is a symbol, that exact
2969 symbol is searched for.
2970 A second optional argument specifies the obarray to use;
2971 it defaults to the value of `obarray'. */)
2973 Lisp_Object name
, obarray
;
2975 register Lisp_Object tem
;
2976 struct Lisp_String
*string
;
2978 if (NILP (obarray
)) obarray
= Vobarray
;
2979 obarray
= check_obarray (obarray
);
2981 if (!SYMBOLP (name
))
2983 CHECK_STRING (name
);
2984 string
= XSTRING (name
);
2987 string
= XSYMBOL (name
)->name
;
2989 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2990 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2996 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2997 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
2998 The value is t if a symbol was found and deleted, nil otherwise.
2999 NAME may be a string or a symbol. If it is a symbol, that symbol
3000 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3001 OBARRAY defaults to the value of the variable `obarray'. */)
3003 Lisp_Object name
, obarray
;
3005 register Lisp_Object string
, tem
;
3008 if (NILP (obarray
)) obarray
= Vobarray
;
3009 obarray
= check_obarray (obarray
);
3012 XSETSTRING (string
, XSYMBOL (name
)->name
);
3015 CHECK_STRING (name
);
3019 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3020 XSTRING (string
)->size
,
3021 STRING_BYTES (XSTRING (string
)));
3024 /* If arg was a symbol, don't delete anything but that symbol itself. */
3025 if (SYMBOLP (name
) && !EQ (name
, tem
))
3028 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3029 XSYMBOL (tem
)->constant
= 0;
3030 XSYMBOL (tem
)->indirect_variable
= 0;
3032 hash
= oblookup_last_bucket_number
;
3034 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3036 if (XSYMBOL (tem
)->next
)
3037 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3039 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3043 Lisp_Object tail
, following
;
3045 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3046 XSYMBOL (tail
)->next
;
3049 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3050 if (EQ (following
, tem
))
3052 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3061 /* Return the symbol in OBARRAY whose names matches the string
3062 of SIZE characters (SIZE_BYTE bytes) at PTR.
3063 If there is no such symbol in OBARRAY, return nil.
3065 Also store the bucket number in oblookup_last_bucket_number. */
3068 oblookup (obarray
, ptr
, size
, size_byte
)
3069 Lisp_Object obarray
;
3071 int size
, size_byte
;
3075 register Lisp_Object tail
;
3076 Lisp_Object bucket
, tem
;
3078 if (!VECTORP (obarray
)
3079 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3081 obarray
= check_obarray (obarray
);
3082 obsize
= XVECTOR (obarray
)->size
;
3084 /* This is sometimes needed in the middle of GC. */
3085 obsize
&= ~ARRAY_MARK_FLAG
;
3086 /* Combining next two lines breaks VMS C 2.3. */
3087 hash
= hash_string (ptr
, size_byte
);
3089 bucket
= XVECTOR (obarray
)->contents
[hash
];
3090 oblookup_last_bucket_number
= hash
;
3091 if (XFASTINT (bucket
) == 0)
3093 else if (!SYMBOLP (bucket
))
3094 error ("Bad data in guts of obarray"); /* Like CADR error message */
3096 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3098 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3099 && XSYMBOL (tail
)->name
->size
== size
3100 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3102 else if (XSYMBOL (tail
)->next
== 0)
3105 XSETINT (tem
, hash
);
3110 hash_string (ptr
, len
)
3114 register unsigned char *p
= ptr
;
3115 register unsigned char *end
= p
+ len
;
3116 register unsigned char c
;
3117 register int hash
= 0;
3122 if (c
>= 0140) c
-= 40;
3123 hash
= ((hash
<<3) + (hash
>>28) + c
);
3125 return hash
& 07777777777;
3129 map_obarray (obarray
, fn
, arg
)
3130 Lisp_Object obarray
;
3131 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3135 register Lisp_Object tail
;
3136 CHECK_VECTOR (obarray
);
3137 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3139 tail
= XVECTOR (obarray
)->contents
[i
];
3144 if (XSYMBOL (tail
)->next
== 0)
3146 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3152 mapatoms_1 (sym
, function
)
3153 Lisp_Object sym
, function
;
3155 call1 (function
, sym
);
3158 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3159 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3160 OBARRAY defaults to the value of `obarray'. */)
3162 Lisp_Object function
, obarray
;
3164 if (NILP (obarray
)) obarray
= Vobarray
;
3165 obarray
= check_obarray (obarray
);
3167 map_obarray (obarray
, mapatoms_1
, function
);
3171 #define OBARRAY_SIZE 1511
3176 Lisp_Object oblength
;
3180 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3182 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3183 Vobarray
= Fmake_vector (oblength
, make_number (0));
3184 initial_obarray
= Vobarray
;
3185 staticpro (&initial_obarray
);
3186 /* Intern nil in the obarray */
3187 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3188 XSYMBOL (Qnil
)->constant
= 1;
3190 /* These locals are to kludge around a pyramid compiler bug. */
3191 hash
= hash_string ("nil", 3);
3192 /* Separate statement here to avoid VAXC bug. */
3193 hash
%= OBARRAY_SIZE
;
3194 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3197 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3198 XSYMBOL (Qnil
)->function
= Qunbound
;
3199 XSYMBOL (Qunbound
)->value
= Qunbound
;
3200 XSYMBOL (Qunbound
)->function
= Qunbound
;
3203 XSYMBOL (Qnil
)->value
= Qnil
;
3204 XSYMBOL (Qnil
)->plist
= Qnil
;
3205 XSYMBOL (Qt
)->value
= Qt
;
3206 XSYMBOL (Qt
)->constant
= 1;
3208 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3211 Qvariable_documentation
= intern ("variable-documentation");
3212 staticpro (&Qvariable_documentation
);
3214 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3215 read_buffer
= (char *) xmalloc (read_buffer_size
);
3220 struct Lisp_Subr
*sname
;
3223 sym
= intern (sname
->symbol_name
);
3224 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3227 #ifdef NOTDEF /* use fset in subr.el now */
3229 defalias (sname
, string
)
3230 struct Lisp_Subr
*sname
;
3234 sym
= intern (string
);
3235 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3239 /* Define an "integer variable"; a symbol whose value is forwarded
3240 to a C variable of type int. Sample call: */
3241 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3243 defvar_int (namestring
, address
)
3247 Lisp_Object sym
, val
;
3248 sym
= intern (namestring
);
3249 val
= allocate_misc ();
3250 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3251 XINTFWD (val
)->intvar
= address
;
3252 SET_SYMBOL_VALUE (sym
, val
);
3255 /* Similar but define a variable whose value is t if address contains 1,
3256 nil if address contains 0 */
3258 defvar_bool (namestring
, address
)
3262 Lisp_Object sym
, val
;
3263 sym
= intern (namestring
);
3264 val
= allocate_misc ();
3265 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3266 XBOOLFWD (val
)->boolvar
= address
;
3267 SET_SYMBOL_VALUE (sym
, val
);
3268 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3271 /* Similar but define a variable whose value is the Lisp Object stored
3272 at address. Two versions: with and without gc-marking of the C
3273 variable. The nopro version is used when that variable will be
3274 gc-marked for some other reason, since marking the same slot twice
3275 can cause trouble with strings. */
3277 defvar_lisp_nopro (namestring
, address
)
3279 Lisp_Object
*address
;
3281 Lisp_Object sym
, val
;
3282 sym
= intern (namestring
);
3283 val
= allocate_misc ();
3284 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3285 XOBJFWD (val
)->objvar
= address
;
3286 SET_SYMBOL_VALUE (sym
, val
);
3290 defvar_lisp (namestring
, address
)
3292 Lisp_Object
*address
;
3294 defvar_lisp_nopro (namestring
, address
);
3295 staticpro (address
);
3298 /* Similar but define a variable whose value is the Lisp Object stored in
3299 the current buffer. address is the address of the slot in the buffer
3300 that is current now. */
3303 defvar_per_buffer (namestring
, address
, type
, doc
)
3305 Lisp_Object
*address
;
3309 Lisp_Object sym
, val
;
3311 extern struct buffer buffer_local_symbols
;
3313 sym
= intern (namestring
);
3314 val
= allocate_misc ();
3315 offset
= (char *)address
- (char *)current_buffer
;
3317 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3318 XBUFFER_OBJFWD (val
)->offset
= offset
;
3319 SET_SYMBOL_VALUE (sym
, val
);
3320 PER_BUFFER_SYMBOL (offset
) = sym
;
3321 PER_BUFFER_TYPE (offset
) = type
;
3323 if (PER_BUFFER_IDX (offset
) == 0)
3324 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3325 slot of buffer_local_flags */
3330 /* Similar but define a variable whose value is the Lisp Object stored
3331 at a particular offset in the current kboard object. */
3334 defvar_kboard (namestring
, offset
)
3338 Lisp_Object sym
, val
;
3339 sym
= intern (namestring
);
3340 val
= allocate_misc ();
3341 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3342 XKBOARD_OBJFWD (val
)->offset
= offset
;
3343 SET_SYMBOL_VALUE (sym
, val
);
3346 /* Record the value of load-path used at the start of dumping
3347 so we can see if the site changed it later during dumping. */
3348 static Lisp_Object dump_path
;
3354 int turn_off_warning
= 0;
3356 /* Compute the default load-path. */
3358 normal
= PATH_LOADSEARCH
;
3359 Vload_path
= decode_env_path (0, normal
);
3361 if (NILP (Vpurify_flag
))
3362 normal
= PATH_LOADSEARCH
;
3364 normal
= PATH_DUMPLOADSEARCH
;
3366 /* In a dumped Emacs, we normally have to reset the value of
3367 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3368 uses ../lisp, instead of the path of the installed elisp
3369 libraries. However, if it appears that Vload_path was changed
3370 from the default before dumping, don't override that value. */
3373 if (! NILP (Fequal (dump_path
, Vload_path
)))
3375 Vload_path
= decode_env_path (0, normal
);
3376 if (!NILP (Vinstallation_directory
))
3378 Lisp_Object tem
, tem1
, sitelisp
;
3380 /* Remove site-lisp dirs from path temporarily and store
3381 them in sitelisp, then conc them on at the end so
3382 they're always first in path. */
3386 tem
= Fcar (Vload_path
);
3387 tem1
= Fstring_match (build_string ("site-lisp"),
3391 Vload_path
= Fcdr (Vload_path
);
3392 sitelisp
= Fcons (tem
, sitelisp
);
3398 /* Add to the path the lisp subdir of the
3399 installation dir, if it exists. */
3400 tem
= Fexpand_file_name (build_string ("lisp"),
3401 Vinstallation_directory
);
3402 tem1
= Ffile_exists_p (tem
);
3405 if (NILP (Fmember (tem
, Vload_path
)))
3407 turn_off_warning
= 1;
3408 Vload_path
= Fcons (tem
, Vload_path
);
3412 /* That dir doesn't exist, so add the build-time
3413 Lisp dirs instead. */
3414 Vload_path
= nconc2 (Vload_path
, dump_path
);
3416 /* Add leim under the installation dir, if it exists. */
3417 tem
= Fexpand_file_name (build_string ("leim"),
3418 Vinstallation_directory
);
3419 tem1
= Ffile_exists_p (tem
);
3422 if (NILP (Fmember (tem
, Vload_path
)))
3423 Vload_path
= Fcons (tem
, Vload_path
);
3426 /* Add site-list under the installation dir, if it exists. */
3427 tem
= Fexpand_file_name (build_string ("site-lisp"),
3428 Vinstallation_directory
);
3429 tem1
= Ffile_exists_p (tem
);
3432 if (NILP (Fmember (tem
, Vload_path
)))
3433 Vload_path
= Fcons (tem
, Vload_path
);
3436 /* If Emacs was not built in the source directory,
3437 and it is run from where it was built, add to load-path
3438 the lisp, leim and site-lisp dirs under that directory. */
3440 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3444 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3445 Vinstallation_directory
);
3446 tem1
= Ffile_exists_p (tem
);
3448 /* Don't be fooled if they moved the entire source tree
3449 AFTER dumping Emacs. If the build directory is indeed
3450 different from the source dir, src/Makefile.in and
3451 src/Makefile will not be found together. */
3452 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3453 Vinstallation_directory
);
3454 tem2
= Ffile_exists_p (tem
);
3455 if (!NILP (tem1
) && NILP (tem2
))
3457 tem
= Fexpand_file_name (build_string ("lisp"),
3460 if (NILP (Fmember (tem
, Vload_path
)))
3461 Vload_path
= Fcons (tem
, Vload_path
);
3463 tem
= Fexpand_file_name (build_string ("leim"),
3466 if (NILP (Fmember (tem
, Vload_path
)))
3467 Vload_path
= Fcons (tem
, Vload_path
);
3469 tem
= Fexpand_file_name (build_string ("site-lisp"),
3472 if (NILP (Fmember (tem
, Vload_path
)))
3473 Vload_path
= Fcons (tem
, Vload_path
);
3476 if (!NILP (sitelisp
))
3477 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3483 /* NORMAL refers to the lisp dir in the source directory. */
3484 /* We used to add ../lisp at the front here, but
3485 that caused trouble because it was copied from dump_path
3486 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3487 It should be unnecessary. */
3488 Vload_path
= decode_env_path (0, normal
);
3489 dump_path
= Vload_path
;
3494 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3495 almost never correct, thereby causing a warning to be printed out that
3496 confuses users. Since PATH_LOADSEARCH is always overridden by the
3497 EMACSLOADPATH environment variable below, disable the warning on NT. */
3499 /* Warn if dirs in the *standard* path don't exist. */
3500 if (!turn_off_warning
)
3502 Lisp_Object path_tail
;
3504 for (path_tail
= Vload_path
;
3506 path_tail
= XCDR (path_tail
))
3508 Lisp_Object dirfile
;
3509 dirfile
= Fcar (path_tail
);
3510 if (STRINGP (dirfile
))
3512 dirfile
= Fdirectory_file_name (dirfile
);
3513 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3514 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3519 #endif /* WINDOWSNT */
3521 /* If the EMACSLOADPATH environment variable is set, use its value.
3522 This doesn't apply if we're dumping. */
3524 if (NILP (Vpurify_flag
)
3525 && egetenv ("EMACSLOADPATH"))
3527 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3531 load_in_progress
= 0;
3532 Vload_file_name
= Qnil
;
3534 load_descriptor_list
= Qnil
;
3536 Vstandard_input
= Qt
;
3537 Vloads_in_progress
= Qnil
;
3540 /* Print a warning, using format string FORMAT, that directory DIRNAME
3541 does not exist. Print it on stderr and put it in *Message*. */
3544 dir_warning (format
, dirname
)
3546 Lisp_Object dirname
;
3549 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3551 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3552 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3553 /* Don't log the warning before we've initialized!! */
3555 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3562 defsubr (&Sread_from_string
);
3564 defsubr (&Sintern_soft
);
3565 defsubr (&Sunintern
);
3567 defsubr (&Seval_buffer
);
3568 defsubr (&Seval_region
);
3569 defsubr (&Sread_char
);
3570 defsubr (&Sread_char_exclusive
);
3571 defsubr (&Sread_event
);
3572 defsubr (&Sget_file_char
);
3573 defsubr (&Smapatoms
);
3575 DEFVAR_LISP ("obarray", &Vobarray
,
3576 doc
: /* Symbol table for use by `intern' and `read'.
3577 It is a vector whose length ought to be prime for best results.
3578 The vector's contents don't make sense if examined from Lisp programs;
3579 to find all the symbols in an obarray, use `mapatoms'. */);
3581 DEFVAR_LISP ("values", &Vvalues
,
3582 doc
: /* List of values of all expressions which were read, evaluated and printed.
3583 Order is reverse chronological. */);
3585 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3586 doc
: /* Stream for read to get input from.
3587 See documentation of `read' for possible values. */);
3588 Vstandard_input
= Qt
;
3590 DEFVAR_LISP ("load-path", &Vload_path
,
3591 doc
: /* *List of directories to search for files to load.
3592 Each element is a string (directory name) or nil (try default directory).
3593 Initialized based on EMACSLOADPATH environment variable, if any,
3594 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3596 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3597 doc
: /* *List of suffixes to try for files to load.
3598 This list should not include the empty string. */);
3599 Vload_suffixes
= Fcons (build_string (".elc"),
3600 Fcons (build_string (".el"), Qnil
));
3601 /* We don't use empty_string because it's not initialized yet. */
3602 default_suffixes
= Fcons (build_string (""), Qnil
);
3603 staticpro (&default_suffixes
);
3605 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3606 doc
: /* Non-nil iff inside of `load'. */);
3608 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3609 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3610 Each element looks like (FILENAME FORMS...).
3611 When `load' is run and the file-name argument is FILENAME,
3612 the FORMS in the corresponding element are executed at the end of loading.
3614 FILENAME must match exactly! Normally FILENAME is the name of a library,
3615 with no directory specified, since that is how `load' is normally called.
3616 An error in FORMS does not undo the load,
3617 but does prevent execution of the rest of the FORMS.
3618 FILENAME can also be a symbol (a feature) and FORMS are then executed
3619 when the corresponding call to `provide' is made. */);
3620 Vafter_load_alist
= Qnil
;
3622 DEFVAR_LISP ("load-history", &Vload_history
,
3623 doc
: /* Alist mapping source file names to symbols and features.
3624 Each alist element is a list that starts with a file name,
3625 except for one element (optional) that starts with nil and describes
3626 definitions evaluated from buffers not visiting files.
3627 The remaining elements of each list are symbols defined as functions
3628 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3629 and `(autoload . SYMBOL)'. */);
3630 Vload_history
= Qnil
;
3632 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3633 doc
: /* Full name of file being loaded by `load'. */);
3634 Vload_file_name
= Qnil
;
3636 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3637 doc
: /* File name, including directory, of user's initialization file.
3638 If the file loaded had extension `.elc' and there was a corresponding `.el'
3639 file, this variable contains the name of the .el file, suitable for use
3640 by functions like `custom-save-all' which edit the init file. */);
3641 Vuser_init_file
= Qnil
;
3643 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3644 doc
: /* Used for internal purposes by `load'. */);
3645 Vcurrent_load_list
= Qnil
;
3647 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3648 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3649 The default is nil, which means use the function `read'. */);
3650 Vload_read_function
= Qnil
;
3652 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3653 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3654 This function is for doing code conversion before reading the source file.
3655 If nil, loading is done without any code conversion.
3656 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3657 FULLNAME is the full name of FILE.
3658 See `load' for the meaning of the remaining arguments. */);
3659 Vload_source_file_function
= Qnil
;
3661 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3662 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3663 This is useful when the file being loaded is a temporary copy. */);
3664 load_force_doc_strings
= 0;
3666 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3667 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3668 This is normally bound by `load' and `eval-buffer' to control `read',
3669 and is not meant for users to change. */);
3670 load_convert_to_unibyte
= 0;
3672 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3673 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3674 You cannot count on them to still be there! */);
3676 = Fexpand_file_name (build_string ("../"),
3677 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3679 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3680 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3681 Vpreloaded_file_list
= Qnil
;
3683 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3684 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3685 Vbyte_boolean_vars
= Qnil
;
3687 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3688 doc
: /* Non-nil means load dangerous compiled Lisp files.
3689 Some versions of XEmacs use different byte codes than Emacs. These
3690 incompatible byte codes can make Emacs crash when it tries to execute
3692 load_dangerous_libraries
= 0;
3694 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3695 doc
: /* Regular expression matching safe to load compiled Lisp files.
3696 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3697 from the file, and matches them against this regular expression.
3698 When the regular expression matches, the file is considered to be safe
3699 to load. See also `load-dangerous-libraries'. */);
3700 Vbytecomp_version_regexp
3701 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3703 /* Vsource_directory was initialized in init_lread. */
3705 load_descriptor_list
= Qnil
;
3706 staticpro (&load_descriptor_list
);
3708 Qcurrent_load_list
= intern ("current-load-list");
3709 staticpro (&Qcurrent_load_list
);
3711 Qstandard_input
= intern ("standard-input");
3712 staticpro (&Qstandard_input
);
3714 Qread_char
= intern ("read-char");
3715 staticpro (&Qread_char
);
3717 Qget_file_char
= intern ("get-file-char");
3718 staticpro (&Qget_file_char
);
3720 Qbackquote
= intern ("`");
3721 staticpro (&Qbackquote
);
3722 Qcomma
= intern (",");
3723 staticpro (&Qcomma
);
3724 Qcomma_at
= intern (",@");
3725 staticpro (&Qcomma_at
);
3726 Qcomma_dot
= intern (",.");
3727 staticpro (&Qcomma_dot
);
3729 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3730 staticpro (&Qinhibit_file_name_operation
);
3732 Qascii_character
= intern ("ascii-character");
3733 staticpro (&Qascii_character
);
3735 Qfunction
= intern ("function");
3736 staticpro (&Qfunction
);
3738 Qload
= intern ("load");
3741 Qload_file_name
= intern ("load-file-name");
3742 staticpro (&Qload_file_name
);
3744 staticpro (&dump_path
);
3746 staticpro (&read_objects
);
3747 read_objects
= Qnil
;
3748 staticpro (&seen_list
);
3750 Vloads_in_progress
= Qnil
;
3751 staticpro (&Vloads_in_progress
);