1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
36 #include "termhooks.h"
39 #include <sys/inode.h>
44 #include <unistd.h> /* to get X_OK */
61 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
79 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
80 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
81 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
82 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
83 Lisp_Object Qinhibit_file_name_operation
;
85 extern Lisp_Object Qevent_symbol_element_mask
;
86 extern Lisp_Object Qfile_exists_p
;
88 /* non-zero if inside `load' */
91 /* Directory in which the sources were found. */
92 Lisp_Object Vsource_directory
;
94 /* Search path and suffixes for files to be loaded. */
95 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
97 /* File name of user's init file. */
98 Lisp_Object Vuser_init_file
;
100 /* This is the user-visible association list that maps features to
101 lists of defs in their load files. */
102 Lisp_Object Vload_history
;
104 /* This is used to build the load history. */
105 Lisp_Object Vcurrent_load_list
;
107 /* List of files that were preloaded. */
108 Lisp_Object Vpreloaded_file_list
;
110 /* Name of file actually being read by `load'. */
111 Lisp_Object Vload_file_name
;
113 /* Function to use for reading, in `load' and friends. */
114 Lisp_Object Vload_read_function
;
116 /* The association list of objects read with the #n=object form.
117 Each member of the list has the form (n . object), and is used to
118 look up the object for the corresponding #n# construct.
119 It must be set to nil before all top-level calls to read0. */
120 Lisp_Object read_objects
;
122 /* Nonzero means load should forcibly load all dynamic doc strings. */
123 static int load_force_doc_strings
;
125 /* Nonzero means read should convert strings to unibyte. */
126 static int load_convert_to_unibyte
;
128 /* Function to use for loading an Emacs lisp source file (not
129 compiled) instead of readevalloop. */
130 Lisp_Object Vload_source_file_function
;
132 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
133 Lisp_Object Vbyte_boolean_vars
;
135 /* List of descriptors now open for Fload. */
136 static Lisp_Object load_descriptor_list
;
138 /* File for get_file_char to read from. Use by load. */
139 static FILE *instream
;
141 /* When nonzero, read conses in pure space */
142 static int read_pure
;
144 /* For use within read-from-string (this reader is non-reentrant!!) */
145 static int read_from_string_index
;
146 static int read_from_string_index_byte
;
147 static int read_from_string_limit
;
149 /* Number of bytes left to read in the buffer character
150 that `readchar' has already advanced over. */
151 static int readchar_backlog
;
153 /* This contains the last string skipped with #@. */
154 static char *saved_doc_string
;
155 /* Length of buffer allocated in saved_doc_string. */
156 static int saved_doc_string_size
;
157 /* Length of actual data in saved_doc_string. */
158 static int saved_doc_string_length
;
159 /* This is the file position that string came from. */
160 static file_offset saved_doc_string_position
;
162 /* This contains the previous string skipped with #@.
163 We copy it from saved_doc_string when a new string
164 is put in saved_doc_string. */
165 static char *prev_saved_doc_string
;
166 /* Length of buffer allocated in prev_saved_doc_string. */
167 static int prev_saved_doc_string_size
;
168 /* Length of actual data in prev_saved_doc_string. */
169 static int prev_saved_doc_string_length
;
170 /* This is the file position that string came from. */
171 static file_offset prev_saved_doc_string_position
;
173 /* Nonzero means inside a new-style backquote
174 with no surrounding parentheses.
175 Fread initializes this to zero, so we need not specbind it
176 or worry about what happens to it when there is an error. */
177 static int new_backquote_flag
;
179 /* A list of file names for files being loaded in Fload. Used to
180 check for recursive loads. */
182 static Lisp_Object Vloads_in_progress
;
184 /* Limit of the depth of recursive loads. */
186 Lisp_Object Vrecursive_load_depth_limit
;
188 /* Non-zero means load dangerous compiled Lisp files. */
190 int load_dangerous_libraries
;
192 /* A regular expression used to detect files compiled with Emacs. */
194 static Lisp_Object Vbytecomp_version_regexp
;
196 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
197 Lisp_Object (*) (), int,
198 Lisp_Object
, Lisp_Object
));
199 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
200 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
203 /* Handle unreading and rereading of characters.
204 Write READCHAR to read a character,
205 UNREAD(c) to unread c to be read again.
207 These macros actually read/unread a byte code, multibyte characters
208 are not handled here. The caller should manage them if necessary.
211 #define READCHAR readchar (readcharfun)
212 #define UNREAD(c) unreadchar (readcharfun, c)
215 readchar (readcharfun
)
216 Lisp_Object readcharfun
;
221 if (BUFFERP (readcharfun
))
223 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
225 int pt_byte
= BUF_PT_BYTE (inbuffer
);
226 int orig_pt_byte
= pt_byte
;
228 if (readchar_backlog
> 0)
229 /* We get the address of the byte just passed,
230 which is the last byte of the character.
231 The other bytes in this character are consecutive with it,
232 because the gap can't be in the middle of a character. */
233 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
234 - --readchar_backlog
);
236 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
239 readchar_backlog
= -1;
241 if (! NILP (inbuffer
->enable_multibyte_characters
))
243 /* Fetch the character code from the buffer. */
244 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
245 BUF_INC_POS (inbuffer
, pt_byte
);
246 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
250 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
253 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
257 if (MARKERP (readcharfun
))
259 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
261 int bytepos
= marker_byte_position (readcharfun
);
262 int orig_bytepos
= bytepos
;
264 if (readchar_backlog
> 0)
265 /* We get the address of the byte just passed,
266 which is the last byte of the character.
267 The other bytes in this character are consecutive with it,
268 because the gap can't be in the middle of a character. */
269 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
270 - --readchar_backlog
);
272 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
275 readchar_backlog
= -1;
277 if (! NILP (inbuffer
->enable_multibyte_characters
))
279 /* Fetch the character code from the buffer. */
280 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
281 BUF_INC_POS (inbuffer
, bytepos
);
282 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
286 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
290 XMARKER (readcharfun
)->bytepos
= bytepos
;
291 XMARKER (readcharfun
)->charpos
++;
296 if (EQ (readcharfun
, Qlambda
))
297 return read_bytecode_char (0);
299 if (EQ (readcharfun
, Qget_file_char
))
303 /* Interrupted reads have been observed while reading over the network */
304 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
313 if (STRINGP (readcharfun
))
315 if (read_from_string_index
>= read_from_string_limit
)
318 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
319 read_from_string_index
,
320 read_from_string_index_byte
);
325 tem
= call0 (readcharfun
);
332 /* Unread the character C in the way appropriate for the stream READCHARFUN.
333 If the stream is a user function, call it with the char as argument. */
336 unreadchar (readcharfun
, c
)
337 Lisp_Object readcharfun
;
341 /* Don't back up the pointer if we're unreading the end-of-input mark,
342 since readchar didn't advance it when we read it. */
344 else if (BUFFERP (readcharfun
))
346 struct buffer
*b
= XBUFFER (readcharfun
);
347 int bytepos
= BUF_PT_BYTE (b
);
349 if (readchar_backlog
>= 0)
354 if (! NILP (b
->enable_multibyte_characters
))
355 BUF_DEC_POS (b
, bytepos
);
359 BUF_PT_BYTE (b
) = bytepos
;
362 else if (MARKERP (readcharfun
))
364 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
365 int bytepos
= XMARKER (readcharfun
)->bytepos
;
367 if (readchar_backlog
>= 0)
371 XMARKER (readcharfun
)->charpos
--;
372 if (! NILP (b
->enable_multibyte_characters
))
373 BUF_DEC_POS (b
, bytepos
);
377 XMARKER (readcharfun
)->bytepos
= bytepos
;
380 else if (STRINGP (readcharfun
))
382 read_from_string_index
--;
383 read_from_string_index_byte
384 = string_char_to_byte (readcharfun
, read_from_string_index
);
386 else if (EQ (readcharfun
, Qlambda
))
387 read_bytecode_char (1);
388 else if (EQ (readcharfun
, Qget_file_char
))
389 ungetc (c
, instream
);
391 call1 (readcharfun
, make_number (c
));
394 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
395 static int read_multibyte ();
396 static Lisp_Object
substitute_object_recurse ();
397 static void substitute_object_in_subtree (), substitute_in_interval ();
400 /* Get a character from the tty. */
402 extern Lisp_Object
read_char ();
404 /* Read input events until we get one that's acceptable for our purposes.
406 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
407 until we get a character we like, and then stuffed into
410 If ASCII_REQUIRED is non-zero, we check function key events to see
411 if the unmodified version of the symbol has a Qascii_character
412 property, and use that character, if present.
414 If ERROR_NONASCII is non-zero, we signal an error if the input we
415 get isn't an ASCII character with modifiers. If it's zero but
416 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
419 If INPUT_METHOD is nonzero, we invoke the current input method
420 if the character warrants that. */
423 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
425 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
427 register Lisp_Object val
, delayed_switch_frame
;
429 #ifdef HAVE_WINDOW_SYSTEM
430 if (display_hourglass_p
)
434 delayed_switch_frame
= Qnil
;
436 /* Read until we get an acceptable event. */
438 val
= read_char (0, 0, 0,
439 (input_method
? Qnil
: Qt
),
445 /* switch-frame events are put off until after the next ASCII
446 character. This is better than signaling an error just because
447 the last characters were typed to a separate minibuffer frame,
448 for example. Eventually, some code which can deal with
449 switch-frame events will read it and process it. */
451 && EVENT_HAS_PARAMETERS (val
)
452 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
454 delayed_switch_frame
= val
;
460 /* Convert certain symbols to their ASCII equivalents. */
463 Lisp_Object tem
, tem1
;
464 tem
= Fget (val
, Qevent_symbol_element_mask
);
467 tem1
= Fget (Fcar (tem
), Qascii_character
);
468 /* Merge this symbol's modifier bits
469 with the ASCII equivalent of its basic code. */
471 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
475 /* If we don't have a character now, deal with it appropriately. */
480 Vunread_command_events
= Fcons (val
, Qnil
);
481 error ("Non-character input-event");
488 if (! NILP (delayed_switch_frame
))
489 unread_switch_frame
= delayed_switch_frame
;
491 #ifdef HAVE_WINDOW_SYSTEM
492 if (display_hourglass_p
)
498 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
499 "Read a character from the command input (keyboard or macro).\n\
500 It is returned as a number.\n\
501 If the user generates an event which is not a character (i.e. a mouse\n\
502 click or function key event), `read-char' signals an error. As an\n\
503 exception, switch-frame events are put off until non-ASCII events can\n\
505 If you want to read non-character events, or ignore them, call\n\
506 `read-event' or `read-char-exclusive' instead.\n\
508 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
509 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
510 input method is turned on in the current buffer, that input method\n\
511 is used for reading a character.")
512 (prompt
, inherit_input_method
)
513 Lisp_Object prompt
, inherit_input_method
;
516 message_with_string ("%s", prompt
, 0);
517 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
520 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
521 "Read an event object from the input stream.\n\
522 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
523 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
524 input method is turned on in the current buffer, that input method\n\
525 is used for reading a character.")
526 (prompt
, inherit_input_method
)
527 Lisp_Object prompt
, inherit_input_method
;
530 message_with_string ("%s", prompt
, 0);
531 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
534 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
535 "Read a character from the command input (keyboard or macro).\n\
536 It is returned as a number. Non-character events are ignored.\n\
538 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
539 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
540 input method is turned on in the current buffer, that input method\n\
541 is used for reading a character.")
542 (prompt
, inherit_input_method
)
543 Lisp_Object prompt
, inherit_input_method
;
546 message_with_string ("%s", prompt
, 0);
547 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
550 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
551 "Don't use this yourself.")
554 register Lisp_Object val
;
555 XSETINT (val
, getc (instream
));
561 /* Value is non-zero if the file asswociated with file descriptor FD
562 is a compiled Lisp file that's safe to load. Only files compiled
563 with Emacs are safe to load. Files compiled with XEmacs can lead
564 to a crash in Fbyte_code because of an incompatible change in the
575 /* Read the first few bytes from the file, and look for a line
576 specifying the byte compiler version used. */
577 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
582 /* Skip to the next newline, skipping over the initial `ELC'
583 with NUL bytes following it. */
584 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
588 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
593 lseek (fd
, 0, SEEK_SET
);
598 /* Callback for record_unwind_protect. Restore the old load list OLD,
599 after loading a file successfully. */
602 record_load_unwind (old
)
605 return Vloads_in_progress
= old
;
609 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
610 "Execute a file of Lisp code named FILE.\n\
611 First try FILE with `.elc' appended, then try with `.el',\n\
612 then try FILE unmodified. Environment variable references in FILE\n\
613 are replaced with their values by calling `substitute-in-file-name'.\n\
614 This function searches the directories in `load-path'.\n\
615 If optional second arg NOERROR is non-nil,\n\
616 report no error if FILE doesn't exist.\n\
617 Print messages at start and end of loading unless\n\
618 optional third arg NOMESSAGE is non-nil.\n\
619 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
620 suffixes `.elc' or `.el' to the specified name FILE.\n\
621 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
622 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
623 it ends in one of those suffixes or includes a directory name.\n\
624 Return t if file exists.")
625 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
626 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
628 register FILE *stream
;
629 register int fd
= -1;
630 register Lisp_Object lispstream
;
631 int count
= specpdl_ptr
- specpdl
;
635 /* 1 means we printed the ".el is newer" message. */
637 /* 1 means we are loading a compiled file. */
646 CHECK_STRING (file
, 0);
648 /* If file name is magic, call the handler. */
649 /* This shouldn't be necessary any more now that `openp' handles it right.
650 handler = Ffind_file_name_handler (file, Qload);
652 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
654 /* Do this after the handler to avoid
655 the need to gcpro noerror, nomessage and nosuffix.
656 (Below here, we care only whether they are nil or not.)
657 The presence of this call is the result of a historical accident:
658 it used to be in every file-operations and when it got removed
659 everywhere, it accidentally stayed here. Since then, enough people
660 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
661 that it seemed risky to remove. */
662 file
= Fsubstitute_in_file_name (file
);
664 /* Avoid weird lossage with null string as arg,
665 since it would try to load a directory as a Lisp file */
666 if (XSTRING (file
)->size
> 0)
668 int size
= STRING_BYTES (XSTRING (file
));
673 if (! NILP (must_suffix
))
675 /* Don't insist on adding a suffix if FILE already ends with one. */
677 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
680 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
682 /* Don't insist on adding a suffix
683 if the argument includes a directory name. */
684 else if (! NILP (Ffile_name_directory (file
)))
688 fd
= openp (Vload_path
, file
,
689 (!NILP (nosuffix
) ? Qnil
690 : !NILP (must_suffix
) ? Vload_suffixes
691 : Fappend (2, (tmp
[0] = Vload_suffixes
,
692 tmp
[1] = default_suffixes
,
702 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
703 Fcons (file
, Qnil
)));
708 /* Tell startup.el whether or not we found the user's init file. */
709 if (EQ (Qt
, Vuser_init_file
))
710 Vuser_init_file
= found
;
712 /* If FD is -2, that means openp found a magic file. */
715 if (NILP (Fequal (found
, file
)))
716 /* If FOUND is a different file name from FILE,
717 find its handler even if we have already inhibited
718 the `load' operation on FILE. */
719 handler
= Ffind_file_name_handler (found
, Qt
);
721 handler
= Ffind_file_name_handler (found
, Qload
);
722 if (! NILP (handler
))
723 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
726 /* Check if we're stuck in a recursive load cycle.
728 2000-09-21: It's not possible to just check for the file loaded
729 being a member of Vloads_in_progress. This fails because of the
730 way the byte compiler currently works; `provide's are not
731 evaluted, see font-lock.el/jit-lock.el as an example. This
732 leads to a certain amount of ``normal'' recursion.
734 Also, just loading a file recursively is not always an error in
735 the general case; the second load may do something different. */
736 if (INTEGERP (Vrecursive_load_depth_limit
)
737 && XINT (Vrecursive_load_depth_limit
) > 0)
739 Lisp_Object len
= Flength (Vloads_in_progress
);
740 if (XFASTINT (len
) > XFASTINT (Vrecursive_load_depth_limit
))
741 Fsignal (Qerror
, Fcons (build_string ("Recursive load suspected"),
742 Fcons (found
, Vloads_in_progress
)));
743 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
744 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
747 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
749 /* Load .elc files directly, but not when they are
750 remote and have no handler! */
757 if (!safe_to_load_p (fd
))
760 if (!load_dangerous_libraries
)
761 error ("File `%s' was not compiled in Emacs",
762 XSTRING (found
)->data
);
763 else if (!NILP (nomessage
))
764 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
772 stat ((char *)XSTRING (found
)->data
, &s1
);
773 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
774 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
775 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
777 /* Make the progress messages mention that source is newer. */
780 /* If we won't print another message, mention this anyway. */
781 if (! NILP (nomessage
))
782 message_with_string ("Source file `%s' newer than byte-compiled file",
785 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
790 /* We are loading a source file (*.el). */
791 if (!NILP (Vload_source_file_function
))
797 val
= call4 (Vload_source_file_function
, found
, file
,
798 NILP (noerror
) ? Qnil
: Qt
,
799 NILP (nomessage
) ? Qnil
: Qt
);
800 return unbind_to (count
, val
);
806 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
807 #else /* not WINDOWSNT */
808 stream
= fdopen (fd
, fmode
);
809 #endif /* not WINDOWSNT */
813 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
816 if (! NILP (Vpurify_flag
))
817 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
819 if (NILP (nomessage
))
822 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
825 message_with_string ("Loading %s (source)...", file
, 1);
827 message_with_string ("Loading %s (compiled; note, source file is newer)...",
829 else /* The typical case; compiled file newer than source file. */
830 message_with_string ("Loading %s...", file
, 1);
834 lispstream
= Fcons (Qnil
, Qnil
);
835 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
836 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
837 record_unwind_protect (load_unwind
, lispstream
);
838 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
839 specbind (Qload_file_name
, found
);
840 specbind (Qinhibit_file_name_operation
, Qnil
);
842 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
844 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
845 unbind_to (count
, Qnil
);
847 /* Run any load-hooks for this file. */
848 temp
= Fassoc (file
, Vafter_load_alist
);
850 Fprogn (Fcdr (temp
));
853 if (saved_doc_string
)
854 free (saved_doc_string
);
855 saved_doc_string
= 0;
856 saved_doc_string_size
= 0;
858 if (prev_saved_doc_string
)
859 xfree (prev_saved_doc_string
);
860 prev_saved_doc_string
= 0;
861 prev_saved_doc_string_size
= 0;
863 if (!noninteractive
&& NILP (nomessage
))
866 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
869 message_with_string ("Loading %s (source)...done", file
, 1);
871 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
873 else /* The typical case; compiled file newer than source file. */
874 message_with_string ("Loading %s...done", file
, 1);
881 load_unwind (stream
) /* used as unwind-protect function in load */
884 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
885 | XFASTINT (XCDR (stream
))));
886 if (--load_in_progress
< 0) load_in_progress
= 0;
891 load_descriptor_unwind (oldlist
)
894 load_descriptor_list
= oldlist
;
898 /* Close all descriptors in use for Floads.
899 This is used when starting a subprocess. */
906 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
907 emacs_close (XFASTINT (XCAR (tail
)));
912 complete_filename_p (pathname
)
913 Lisp_Object pathname
;
915 register unsigned char *s
= XSTRING (pathname
)->data
;
916 return (IS_DIRECTORY_SEP (s
[0])
917 || (XSTRING (pathname
)->size
> 2
918 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
928 /* Search for a file whose name is STR, looking in directories
929 in the Lisp list PATH, and trying suffixes from SUFFIX.
930 On success, returns a file descriptor. On failure, returns -1.
932 SUFFIXES is a list of strings containing possible suffixes.
933 The empty suffix is automatically added iff the list is empty.
935 EXEC_ONLY nonzero means don't open the files,
936 just look for one that is executable. In this case,
937 returns 1 on success.
939 If STOREPTR is nonzero, it points to a slot where the name of
940 the file actually found should be stored as a Lisp string.
941 nil is stored there on failure.
943 If the file we find is remote, return -2
944 but store the found remote file name in *STOREPTR.
945 We do not check for remote files if EXEC_ONLY is nonzero. */
948 openp (path
, str
, suffixes
, storeptr
, exec_only
)
949 Lisp_Object path
, str
;
950 Lisp_Object suffixes
;
951 Lisp_Object
*storeptr
;
957 register char *fn
= buf
;
960 Lisp_Object filename
;
962 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
963 Lisp_Object string
, tail
;
964 int max_suffix_len
= 0;
966 string
= filename
= Qnil
;
967 GCPRO5 (str
, string
, filename
, path
, suffixes
);
969 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
971 string
= XCAR (tail
);
972 CHECK_STRING (string
, 0);
973 if (! EQ (string
, XCAR (tail
)))
974 XSETCAR (tail
, string
);
975 max_suffix_len
= max (max_suffix_len
,
976 STRING_BYTES (XSTRING (string
)));
982 if (complete_filename_p (str
))
985 for (; CONSP (path
); path
= XCDR (path
))
987 filename
= Fexpand_file_name (str
, XCAR (path
));
988 if (!complete_filename_p (filename
))
989 /* If there are non-absolute elts in PATH (eg ".") */
990 /* Of course, this could conceivably lose if luser sets
991 default-directory to be something non-absolute... */
993 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
994 if (!complete_filename_p (filename
))
995 /* Give up on this path element! */
999 /* Calculate maximum size of any filename made from
1000 this path element/specified file name and any possible suffix. */
1001 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1002 if (fn_size
< want_size
)
1003 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1005 /* Loop over suffixes. */
1006 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1007 CONSP (tail
); tail
= XCDR (tail
))
1009 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1010 Lisp_Object handler
;
1012 /* Concatenate path element/specified name with the suffix.
1013 If the directory starts with /:, remove that. */
1014 if (XSTRING (filename
)->size
> 2
1015 && XSTRING (filename
)->data
[0] == '/'
1016 && XSTRING (filename
)->data
[1] == ':')
1018 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1019 STRING_BYTES (XSTRING (filename
)) - 2);
1020 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1024 strncpy (fn
, XSTRING (filename
)->data
,
1025 STRING_BYTES (XSTRING (filename
)));
1026 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1029 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1030 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1032 /* Check that the file exists and is not a directory. */
1033 /* We used to only check for handlers on non-absolute file names:
1037 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1038 It's not clear why that was the case and it breaks things like
1039 (load "/bar.el") where the file is actually "/bar.el.gz". */
1040 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1041 if (!NILP (handler
) && !exec_only
)
1045 string
= build_string (fn
);
1046 exists
= !NILP (Ffile_readable_p (string
));
1047 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1052 /* We succeeded; return this descriptor and filename. */
1054 *storeptr
= build_string (fn
);
1061 int exists
= (stat (fn
, &st
) >= 0
1062 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1065 /* Check that we can access or open it. */
1067 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1069 fd
= emacs_open (fn
, O_RDONLY
, 0);
1073 /* We succeeded; return this descriptor and filename. */
1075 *storeptr
= build_string (fn
);
1091 /* Merge the list we've accumulated of globals from the current input source
1092 into the load_history variable. The details depend on whether
1093 the source has an associated file name or not. */
1096 build_load_history (stream
, source
)
1100 register Lisp_Object tail
, prev
, newelt
;
1101 register Lisp_Object tem
, tem2
;
1102 register int foundit
, loading
;
1104 loading
= stream
|| !NARROWED
;
1106 tail
= Vload_history
;
1109 while (!NILP (tail
))
1113 /* Find the feature's previous assoc list... */
1114 if (!NILP (Fequal (source
, Fcar (tem
))))
1118 /* If we're loading, remove it. */
1122 Vload_history
= Fcdr (tail
);
1124 Fsetcdr (prev
, Fcdr (tail
));
1127 /* Otherwise, cons on new symbols that are not already members. */
1130 tem2
= Vcurrent_load_list
;
1132 while (CONSP (tem2
))
1134 newelt
= Fcar (tem2
);
1136 if (NILP (Fmemq (newelt
, tem
)))
1137 Fsetcar (tail
, Fcons (Fcar (tem
),
1138 Fcons (newelt
, Fcdr (tem
))));
1151 /* If we're loading, cons the new assoc onto the front of load-history,
1152 the most-recently-loaded position. Also do this if we didn't find
1153 an existing member for the current source. */
1154 if (loading
|| !foundit
)
1155 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1160 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1168 readevalloop_1 (old
)
1171 load_convert_to_unibyte
= ! NILP (old
);
1175 /* Signal an `end-of-file' error, if possible with file name
1179 end_of_file_error ()
1183 if (STRINGP (Vload_file_name
))
1184 data
= Fcons (Vload_file_name
, Qnil
);
1188 Fsignal (Qend_of_file
, data
);
1191 /* UNIBYTE specifies how to set load_convert_to_unibyte
1192 for this invocation.
1193 READFUN, if non-nil, is used instead of `read'. */
1196 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1197 Lisp_Object readcharfun
;
1199 Lisp_Object sourcename
;
1200 Lisp_Object (*evalfun
) ();
1202 Lisp_Object unibyte
, readfun
;
1205 register Lisp_Object val
;
1206 int count
= specpdl_ptr
- specpdl
;
1207 struct gcpro gcpro1
;
1208 struct buffer
*b
= 0;
1209 int continue_reading_p
;
1211 if (BUFFERP (readcharfun
))
1212 b
= XBUFFER (readcharfun
);
1213 else if (MARKERP (readcharfun
))
1214 b
= XMARKER (readcharfun
)->buffer
;
1216 specbind (Qstandard_input
, readcharfun
);
1217 specbind (Qcurrent_load_list
, Qnil
);
1218 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1219 load_convert_to_unibyte
= !NILP (unibyte
);
1221 readchar_backlog
= -1;
1223 GCPRO1 (sourcename
);
1225 LOADHIST_ATTACH (sourcename
);
1227 continue_reading_p
= 1;
1228 while (continue_reading_p
)
1230 if (b
!= 0 && NILP (b
->name
))
1231 error ("Reading from killed buffer");
1237 while ((c
= READCHAR
) != '\n' && c
!= -1);
1242 /* Ignore whitespace here, so we can detect eof. */
1243 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1246 if (!NILP (Vpurify_flag
) && c
== '(')
1248 int count1
= specpdl_ptr
- specpdl
;
1249 record_unwind_protect (unreadpure
, Qnil
);
1250 val
= read_list (-1, readcharfun
);
1251 unbind_to (count1
, Qnil
);
1256 read_objects
= Qnil
;
1257 if (!NILP (readfun
))
1259 val
= call1 (readfun
, readcharfun
);
1261 /* If READCHARFUN has set point to ZV, we should
1262 stop reading, even if the form read sets point
1263 to a different value when evaluated. */
1264 if (BUFFERP (readcharfun
))
1266 struct buffer
*b
= XBUFFER (readcharfun
);
1267 if (BUF_PT (b
) == BUF_ZV (b
))
1268 continue_reading_p
= 0;
1271 else if (! NILP (Vload_read_function
))
1272 val
= call1 (Vload_read_function
, readcharfun
);
1274 val
= read0 (readcharfun
);
1277 val
= (*evalfun
) (val
);
1281 Vvalues
= Fcons (val
, Vvalues
);
1282 if (EQ (Vstandard_output
, Qt
))
1289 build_load_history (stream
, sourcename
);
1292 unbind_to (count
, Qnil
);
1295 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1296 "Execute the current buffer as Lisp code.\n\
1297 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1298 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1299 PRINTFLAG controls printing of output:\n\
1300 nil means discard it; anything else is stream for print.\n\
1302 If the optional third argument FILENAME is non-nil,\n\
1303 it specifies the file name to use for `load-history'.\n\
1304 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\
1305 for this invocation.\n\
1307 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\
1308 `print' and related functions should work normally even if PRINTFLAG is nil.\n\
1310 This function preserves the position of point.")
1311 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1312 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1314 int count
= specpdl_ptr
- specpdl
;
1315 Lisp_Object tem
, buf
;
1318 buf
= Fcurrent_buffer ();
1320 buf
= Fget_buffer (buffer
);
1322 error ("No such buffer");
1324 if (NILP (printflag
) && NILP (do_allow_print
))
1329 if (NILP (filename
))
1330 filename
= XBUFFER (buf
)->filename
;
1332 specbind (Qstandard_output
, tem
);
1333 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1334 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1335 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1336 unbind_to (count
, Qnil
);
1342 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1343 "Execute the current buffer as Lisp code.\n\
1344 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1345 nil means discard it; anything else is stream for print.\n\
1347 If there is no error, point does not move. If there is an error,\n\
1348 point remains at the end of the last character read from the buffer.")
1350 Lisp_Object printflag
;
1352 int count
= specpdl_ptr
- specpdl
;
1353 Lisp_Object tem
, cbuf
;
1355 cbuf
= Fcurrent_buffer ()
1357 if (NILP (printflag
))
1361 specbind (Qstandard_output
, tem
);
1362 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1364 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1365 !NILP (printflag
), Qnil
, Qnil
);
1366 return unbind_to (count
, Qnil
);
1370 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1371 "Execute the region as Lisp code.\n\
1372 When called from programs, expects two arguments,\n\
1373 giving starting and ending indices in the current buffer\n\
1374 of the text to be executed.\n\
1375 Programs can pass third argument PRINTFLAG which controls output:\n\
1376 nil means discard it; anything else is stream for printing it.\n\
1377 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1378 instead of `read' to read each expression. It gets one argument\n\
1379 which is the input stream for reading characters.\n\
1381 This function does not move point.")
1382 (start
, end
, printflag
, read_function
)
1383 Lisp_Object start
, end
, printflag
, read_function
;
1385 int count
= specpdl_ptr
- specpdl
;
1386 Lisp_Object tem
, cbuf
;
1388 cbuf
= Fcurrent_buffer ();
1390 if (NILP (printflag
))
1394 specbind (Qstandard_output
, tem
);
1396 if (NILP (printflag
))
1397 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1398 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1400 /* This both uses start and checks its type. */
1402 Fnarrow_to_region (make_number (BEGV
), end
);
1403 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1404 !NILP (printflag
), Qnil
, read_function
);
1406 return unbind_to (count
, Qnil
);
1410 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1411 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1412 If STREAM is nil, use the value of `standard-input' (which see).\n\
1413 STREAM or the value of `standard-input' may be:\n\
1414 a buffer (read from point and advance it)\n\
1415 a marker (read from where it points and advance it)\n\
1416 a function (call it with no arguments for each character,\n\
1417 call it with a char as argument to push a char back)\n\
1418 a string (takes text from string, starting at the beginning)\n\
1419 t (read text line using minibuffer and use it, or read from\n\
1420 standard input in batch mode).")
1424 extern Lisp_Object
Fread_minibuffer ();
1427 stream
= Vstandard_input
;
1428 if (EQ (stream
, Qt
))
1429 stream
= Qread_char
;
1431 readchar_backlog
= -1;
1432 new_backquote_flag
= 0;
1433 read_objects
= Qnil
;
1435 if (EQ (stream
, Qread_char
))
1436 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1438 if (STRINGP (stream
))
1439 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1441 return read0 (stream
);
1444 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1445 "Read one Lisp expression which is represented as text by STRING.\n\
1446 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1447 START and END optionally delimit a substring of STRING from which to read;\n\
1448 they default to 0 and (length STRING) respectively.")
1449 (string
, start
, end
)
1450 Lisp_Object string
, start
, end
;
1452 int startval
, endval
;
1455 CHECK_STRING (string
,0);
1458 endval
= XSTRING (string
)->size
;
1461 CHECK_NUMBER (end
, 2);
1462 endval
= XINT (end
);
1463 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1464 args_out_of_range (string
, end
);
1471 CHECK_NUMBER (start
, 1);
1472 startval
= XINT (start
);
1473 if (startval
< 0 || startval
> endval
)
1474 args_out_of_range (string
, start
);
1477 read_from_string_index
= startval
;
1478 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1479 read_from_string_limit
= endval
;
1481 new_backquote_flag
= 0;
1482 read_objects
= Qnil
;
1484 tem
= read0 (string
);
1485 return Fcons (tem
, make_number (read_from_string_index
));
1488 /* Use this for recursive reads, in contexts where internal tokens
1493 Lisp_Object readcharfun
;
1495 register Lisp_Object val
;
1498 val
= read1 (readcharfun
, &c
, 0);
1500 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1507 static int read_buffer_size
;
1508 static char *read_buffer
;
1510 /* Read multibyte form and return it as a character. C is a first
1511 byte of multibyte form, and rest of them are read from
1515 read_multibyte (c
, readcharfun
)
1517 Lisp_Object readcharfun
;
1519 /* We need the actual character code of this multibyte
1521 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1526 while ((c
= READCHAR
) >= 0xA0
1527 && len
< MAX_MULTIBYTE_LENGTH
)
1530 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1531 return STRING_CHAR (str
, len
);
1532 /* The byte sequence is not valid as multibyte. Unread all bytes
1533 but the first one, and return the first byte. */
1539 /* Read a \-escape sequence, assuming we already read the `\'. */
1542 read_escape (readcharfun
, stringp
)
1543 Lisp_Object readcharfun
;
1546 register int c
= READCHAR
;
1550 error ("End of file");
1580 error ("Invalid escape character syntax");
1583 c
= read_escape (readcharfun
, 0);
1584 return c
| meta_modifier
;
1589 error ("Invalid escape character syntax");
1592 c
= read_escape (readcharfun
, 0);
1593 return c
| shift_modifier
;
1598 error ("Invalid escape character syntax");
1601 c
= read_escape (readcharfun
, 0);
1602 return c
| hyper_modifier
;
1607 error ("Invalid escape character syntax");
1610 c
= read_escape (readcharfun
, 0);
1611 return c
| alt_modifier
;
1616 error ("Invalid escape character syntax");
1619 c
= read_escape (readcharfun
, 0);
1620 return c
| super_modifier
;
1625 error ("Invalid escape character syntax");
1629 c
= read_escape (readcharfun
, 0);
1630 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1631 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1632 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1633 return c
| ctrl_modifier
;
1634 /* ASCII control chars are made from letters (both cases),
1635 as well as the non-letters within 0100...0137. */
1636 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1637 return (c
& (037 | ~0177));
1638 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1639 return (c
& (037 | ~0177));
1641 return c
| ctrl_modifier
;
1651 /* An octal escape, as in ANSI C. */
1653 register int i
= c
- '0';
1654 register int count
= 0;
1657 if ((c
= READCHAR
) >= '0' && c
<= '7')
1672 /* A hex escape, as in ANSI C. */
1678 if (c
>= '0' && c
<= '9')
1683 else if ((c
>= 'a' && c
<= 'f')
1684 || (c
>= 'A' && c
<= 'F'))
1687 if (c
>= 'a' && c
<= 'f')
1702 if (BASE_LEADING_CODE_P (c
))
1703 c
= read_multibyte (c
, readcharfun
);
1709 /* Read an integer in radix RADIX using READCHARFUN to read
1710 characters. RADIX must be in the interval [2..36]; if it isn't, a
1711 read error is signaled . Value is the integer read. Signals an
1712 error if encountering invalid read syntax or if RADIX is out of
1716 read_integer (readcharfun
, radix
)
1717 Lisp_Object readcharfun
;
1720 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1721 EMACS_INT number
= 0;
1723 if (radix
< 2 || radix
> 36)
1727 number
= ndigits
= invalid_p
= 0;
1743 if (c
>= '0' && c
<= '9')
1745 else if (c
>= 'a' && c
<= 'z')
1746 digit
= c
- 'a' + 10;
1747 else if (c
>= 'A' && c
<= 'Z')
1748 digit
= c
- 'A' + 10;
1755 if (digit
< 0 || digit
>= radix
)
1758 number
= radix
* number
+ digit
;
1764 if (ndigits
== 0 || invalid_p
)
1767 sprintf (buf
, "integer, radix %d", radix
);
1768 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1771 return make_number (sign
* number
);
1775 /* If the next token is ')' or ']' or '.', we store that character
1776 in *PCH and the return value is not interesting. Else, we store
1777 zero in *PCH and we read and return one lisp object.
1779 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1782 read1 (readcharfun
, pch
, first_in_list
)
1783 register Lisp_Object readcharfun
;
1788 int uninterned_symbol
= 0;
1796 end_of_file_error ();
1801 return read_list (0, readcharfun
);
1804 return read_vector (readcharfun
, 0);
1821 tmp
= read_vector (readcharfun
, 0);
1822 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1823 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1824 error ("Invalid size char-table");
1825 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1826 XCHAR_TABLE (tmp
)->top
= Qt
;
1835 tmp
= read_vector (readcharfun
, 0);
1836 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1837 error ("Invalid size char-table");
1838 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1839 XCHAR_TABLE (tmp
)->top
= Qnil
;
1842 Fsignal (Qinvalid_read_syntax
,
1843 Fcons (make_string ("#^^", 3), Qnil
));
1845 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1850 length
= read1 (readcharfun
, pch
, first_in_list
);
1854 Lisp_Object tmp
, val
;
1855 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1859 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1860 if (size_in_chars
!= XSTRING (tmp
)->size
1861 /* We used to print 1 char too many
1862 when the number of bits was a multiple of 8.
1863 Accept such input in case it came from an old version. */
1864 && ! (XFASTINT (length
)
1865 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1866 Fsignal (Qinvalid_read_syntax
,
1867 Fcons (make_string ("#&...", 5), Qnil
));
1869 val
= Fmake_bool_vector (length
, Qnil
);
1870 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1872 /* Clear the extraneous bits in the last byte. */
1873 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1874 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1875 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1878 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1883 /* Accept compiled functions at read-time so that we don't have to
1884 build them using function calls. */
1886 tmp
= read_vector (readcharfun
, 1);
1887 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1888 XVECTOR (tmp
)->contents
);
1893 struct gcpro gcpro1
;
1896 /* Read the string itself. */
1897 tmp
= read1 (readcharfun
, &ch
, 0);
1898 if (ch
!= 0 || !STRINGP (tmp
))
1899 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1901 /* Read the intervals and their properties. */
1904 Lisp_Object beg
, end
, plist
;
1906 beg
= read1 (readcharfun
, &ch
, 0);
1911 end
= read1 (readcharfun
, &ch
, 0);
1913 plist
= read1 (readcharfun
, &ch
, 0);
1915 Fsignal (Qinvalid_read_syntax
,
1916 Fcons (build_string ("invalid string property list"),
1918 Fset_text_properties (beg
, end
, plist
, tmp
);
1924 /* #@NUMBER is used to skip NUMBER following characters.
1925 That's used in .elc files to skip over doc strings
1926 and function definitions. */
1931 /* Read a decimal integer. */
1932 while ((c
= READCHAR
) >= 0
1933 && c
>= '0' && c
<= '9')
1941 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1943 /* If we are supposed to force doc strings into core right now,
1944 record the last string that we skipped,
1945 and record where in the file it comes from. */
1947 /* But first exchange saved_doc_string
1948 with prev_saved_doc_string, so we save two strings. */
1950 char *temp
= saved_doc_string
;
1951 int temp_size
= saved_doc_string_size
;
1952 file_offset temp_pos
= saved_doc_string_position
;
1953 int temp_len
= saved_doc_string_length
;
1955 saved_doc_string
= prev_saved_doc_string
;
1956 saved_doc_string_size
= prev_saved_doc_string_size
;
1957 saved_doc_string_position
= prev_saved_doc_string_position
;
1958 saved_doc_string_length
= prev_saved_doc_string_length
;
1960 prev_saved_doc_string
= temp
;
1961 prev_saved_doc_string_size
= temp_size
;
1962 prev_saved_doc_string_position
= temp_pos
;
1963 prev_saved_doc_string_length
= temp_len
;
1966 if (saved_doc_string_size
== 0)
1968 saved_doc_string_size
= nskip
+ 100;
1969 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1971 if (nskip
> saved_doc_string_size
)
1973 saved_doc_string_size
= nskip
+ 100;
1974 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1975 saved_doc_string_size
);
1978 saved_doc_string_position
= file_tell (instream
);
1980 /* Copy that many characters into saved_doc_string. */
1981 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1982 saved_doc_string
[i
] = c
= READCHAR
;
1984 saved_doc_string_length
= i
;
1988 /* Skip that many characters. */
1989 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1996 return Vload_file_name
;
1998 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1999 /* #:foo is the uninterned symbol named foo. */
2002 uninterned_symbol
= 1;
2006 /* Reader forms that can reuse previously read objects. */
2007 if (c
>= '0' && c
<= '9')
2012 /* Read a non-negative integer. */
2013 while (c
>= '0' && c
<= '9')
2019 /* #n=object returns object, but associates it with n for #n#. */
2022 /* Make a placeholder for #n# to use temporarily */
2023 Lisp_Object placeholder
;
2026 placeholder
= Fcons(Qnil
, Qnil
);
2027 cell
= Fcons (make_number (n
), placeholder
);
2028 read_objects
= Fcons (cell
, read_objects
);
2030 /* Read the object itself. */
2031 tem
= read0 (readcharfun
);
2033 /* Now put it everywhere the placeholder was... */
2034 substitute_object_in_subtree (tem
, placeholder
);
2036 /* ...and #n# will use the real value from now on. */
2037 Fsetcdr (cell
, tem
);
2041 /* #n# returns a previously read object. */
2044 tem
= Fassq (make_number (n
), read_objects
);
2047 /* Fall through to error message. */
2049 else if (c
== 'r' || c
== 'R')
2050 return read_integer (readcharfun
, n
);
2052 /* Fall through to error message. */
2054 else if (c
== 'x' || c
== 'X')
2055 return read_integer (readcharfun
, 16);
2056 else if (c
== 'o' || c
== 'O')
2057 return read_integer (readcharfun
, 8);
2058 else if (c
== 'b' || c
== 'B')
2059 return read_integer (readcharfun
, 2);
2062 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2065 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2070 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2080 new_backquote_flag
= 1;
2081 value
= read0 (readcharfun
);
2082 new_backquote_flag
= 0;
2084 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2088 if (new_backquote_flag
)
2090 Lisp_Object comma_type
= Qnil
;
2095 comma_type
= Qcomma_at
;
2097 comma_type
= Qcomma_dot
;
2100 if (ch
>= 0) UNREAD (ch
);
2101 comma_type
= Qcomma
;
2104 new_backquote_flag
= 0;
2105 value
= read0 (readcharfun
);
2106 new_backquote_flag
= 1;
2107 return Fcons (comma_type
, Fcons (value
, Qnil
));
2116 end_of_file_error ();
2119 c
= read_escape (readcharfun
, 0);
2120 else if (BASE_LEADING_CODE_P (c
))
2121 c
= read_multibyte (c
, readcharfun
);
2123 return make_number (c
);
2128 register char *p
= read_buffer
;
2129 register char *end
= read_buffer
+ read_buffer_size
;
2131 /* Nonzero if we saw an escape sequence specifying
2132 a multibyte character. */
2133 int force_multibyte
= 0;
2134 /* Nonzero if we saw an escape sequence specifying
2135 a single-byte character. */
2136 int force_singlebyte
= 0;
2140 while ((c
= READCHAR
) >= 0
2143 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2145 int offset
= p
- read_buffer
;
2146 read_buffer
= (char *) xrealloc (read_buffer
,
2147 read_buffer_size
*= 2);
2148 p
= read_buffer
+ offset
;
2149 end
= read_buffer
+ read_buffer_size
;
2154 c
= read_escape (readcharfun
, 1);
2156 /* C is -1 if \ newline has just been seen */
2159 if (p
== read_buffer
)
2164 /* If an escape specifies a non-ASCII single-byte character,
2165 this must be a unibyte string. */
2166 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2167 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2168 force_singlebyte
= 1;
2171 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2173 /* Any modifiers for a multibyte character are invalid. */
2174 if (c
& CHAR_MODIFIER_MASK
)
2175 error ("Invalid modifier in string");
2176 p
+= CHAR_STRING (c
, p
);
2177 force_multibyte
= 1;
2181 /* Allow `\C- ' and `\C-?'. */
2182 if (c
== (CHAR_CTL
| ' '))
2184 else if (c
== (CHAR_CTL
| '?'))
2189 /* Shift modifier is valid only with [A-Za-z]. */
2190 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2192 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2193 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2197 /* Move the meta bit to the right place for a string. */
2198 c
= (c
& ~CHAR_META
) | 0x80;
2200 error ("Invalid modifier in string");
2205 end_of_file_error ();
2207 /* If purifying, and string starts with \ newline,
2208 return zero instead. This is for doc strings
2209 that we are really going to find in etc/DOC.nn.nn */
2210 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2211 return make_number (0);
2213 if (force_multibyte
)
2214 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2215 p
- read_buffer
, &nchars
);
2216 else if (force_singlebyte
)
2217 nchars
= p
- read_buffer
;
2218 else if (load_convert_to_unibyte
)
2221 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2222 p
- read_buffer
, &nchars
);
2223 if (p
- read_buffer
!= nchars
)
2225 string
= make_multibyte_string (read_buffer
, nchars
,
2227 return Fstring_make_unibyte (string
);
2230 else if (EQ (readcharfun
, Qget_file_char
)
2231 || EQ (readcharfun
, Qlambda
))
2232 /* Nowadays, reading directly from a file is used only for
2233 compiled Emacs Lisp files, and those always use the
2234 Emacs internal encoding. Meanwhile, Qlambda is used
2235 for reading dynamic byte code (compiled with
2236 byte-compile-dynamic = t). */
2237 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2238 p
- read_buffer
, &nchars
);
2240 /* In all other cases, if we read these bytes as
2241 separate characters, treat them as separate characters now. */
2242 nchars
= p
- read_buffer
;
2245 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2247 || (p
- read_buffer
!= nchars
)));
2248 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2250 || (p
- read_buffer
!= nchars
)));
2255 int next_char
= READCHAR
;
2258 if (next_char
<= 040
2259 || index ("\"'`,(", next_char
))
2265 /* Otherwise, we fall through! Note that the atom-reading loop
2266 below will now loop at least once, assuring that we will not
2267 try to UNREAD two characters in a row. */
2271 if (c
<= 040) goto retry
;
2273 char *p
= read_buffer
;
2277 char *end
= read_buffer
+ read_buffer_size
;
2280 && !(c
== '\"' || c
== '\'' || c
== ';'
2281 || c
== '(' || c
== ')'
2282 || c
== '[' || c
== ']' || c
== '#'))
2284 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2286 int offset
= p
- read_buffer
;
2287 read_buffer
= (char *) xrealloc (read_buffer
,
2288 read_buffer_size
*= 2);
2289 p
= read_buffer
+ offset
;
2290 end
= read_buffer
+ read_buffer_size
;
2297 end_of_file_error ();
2301 if (! SINGLE_BYTE_CHAR_P (c
))
2302 p
+= CHAR_STRING (c
, p
);
2311 int offset
= p
- read_buffer
;
2312 read_buffer
= (char *) xrealloc (read_buffer
,
2313 read_buffer_size
*= 2);
2314 p
= read_buffer
+ offset
;
2315 end
= read_buffer
+ read_buffer_size
;
2322 if (!quoted
&& !uninterned_symbol
)
2325 register Lisp_Object val
;
2327 if (*p1
== '+' || *p1
== '-') p1
++;
2328 /* Is it an integer? */
2331 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2332 /* Integers can have trailing decimal points. */
2333 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2335 /* It is an integer. */
2339 if (sizeof (int) == sizeof (EMACS_INT
))
2340 XSETINT (val
, atoi (read_buffer
));
2341 else if (sizeof (long) == sizeof (EMACS_INT
))
2342 XSETINT (val
, atol (read_buffer
));
2348 if (isfloat_string (read_buffer
))
2350 /* Compute NaN and infinities using 0.0 in a variable,
2351 to cope with compilers that think they are smarter
2357 /* Negate the value ourselves. This treats 0, NaNs,
2358 and infinity properly on IEEE floating point hosts,
2359 and works around a common bug where atof ("-0.0")
2361 int negative
= read_buffer
[0] == '-';
2363 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2364 returns 1, is if the input ends in e+INF or e+NaN. */
2371 value
= zero
/ zero
;
2374 value
= atof (read_buffer
+ negative
);
2378 return make_float (negative
? - value
: value
);
2382 if (uninterned_symbol
)
2383 return make_symbol (read_buffer
);
2385 return intern (read_buffer
);
2391 /* List of nodes we've seen during substitute_object_in_subtree. */
2392 static Lisp_Object seen_list
;
2395 substitute_object_in_subtree (object
, placeholder
)
2397 Lisp_Object placeholder
;
2399 Lisp_Object check_object
;
2401 /* We haven't seen any objects when we start. */
2404 /* Make all the substitutions. */
2406 = substitute_object_recurse (object
, placeholder
, object
);
2408 /* Clear seen_list because we're done with it. */
2411 /* The returned object here is expected to always eq the
2413 if (!EQ (check_object
, object
))
2414 error ("Unexpected mutation error in reader");
2417 /* Feval doesn't get called from here, so no gc protection is needed. */
2418 #define SUBSTITUTE(get_val, set_val) \
2420 Lisp_Object old_value = get_val; \
2421 Lisp_Object true_value \
2422 = substitute_object_recurse (object, placeholder,\
2425 if (!EQ (old_value, true_value)) \
2432 substitute_object_recurse (object
, placeholder
, subtree
)
2434 Lisp_Object placeholder
;
2435 Lisp_Object subtree
;
2437 /* If we find the placeholder, return the target object. */
2438 if (EQ (placeholder
, subtree
))
2441 /* If we've been to this node before, don't explore it again. */
2442 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2445 /* If this node can be the entry point to a cycle, remember that
2446 we've seen it. It can only be such an entry point if it was made
2447 by #n=, which means that we can find it as a value in
2449 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2450 seen_list
= Fcons (subtree
, seen_list
);
2452 /* Recurse according to subtree's type.
2453 Every branch must return a Lisp_Object. */
2454 switch (XTYPE (subtree
))
2456 case Lisp_Vectorlike
:
2459 int length
= XINT (Flength(subtree
));
2460 for (i
= 0; i
< length
; i
++)
2462 Lisp_Object idx
= make_number (i
);
2463 SUBSTITUTE (Faref (subtree
, idx
),
2464 Faset (subtree
, idx
, true_value
));
2471 SUBSTITUTE (Fcar_safe (subtree
),
2472 Fsetcar (subtree
, true_value
));
2473 SUBSTITUTE (Fcdr_safe (subtree
),
2474 Fsetcdr (subtree
, true_value
));
2480 /* Check for text properties in each interval.
2481 substitute_in_interval contains part of the logic. */
2483 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2484 Lisp_Object arg
= Fcons (object
, placeholder
);
2486 traverse_intervals_noorder (root_interval
,
2487 &substitute_in_interval
, arg
);
2492 /* Other types don't recurse any further. */
2498 /* Helper function for substitute_object_recurse. */
2500 substitute_in_interval (interval
, arg
)
2504 Lisp_Object object
= Fcar (arg
);
2505 Lisp_Object placeholder
= Fcdr (arg
);
2507 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2526 if (*cp
== '+' || *cp
== '-')
2529 if (*cp
>= '0' && *cp
<= '9')
2532 while (*cp
>= '0' && *cp
<= '9')
2540 if (*cp
>= '0' && *cp
<= '9')
2543 while (*cp
>= '0' && *cp
<= '9')
2546 if (*cp
== 'e' || *cp
== 'E')
2550 if (*cp
== '+' || *cp
== '-')
2554 if (*cp
>= '0' && *cp
<= '9')
2557 while (*cp
>= '0' && *cp
<= '9')
2560 else if (cp
== start
)
2562 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2567 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2573 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2574 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2575 || state
== (DOT_CHAR
|TRAIL_INT
)
2576 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2577 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2578 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2583 read_vector (readcharfun
, bytecodeflag
)
2584 Lisp_Object readcharfun
;
2589 register Lisp_Object
*ptr
;
2590 register Lisp_Object tem
, item
, vector
;
2591 register struct Lisp_Cons
*otem
;
2594 tem
= read_list (1, readcharfun
);
2595 len
= Flength (tem
);
2596 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2598 size
= XVECTOR (vector
)->size
;
2599 ptr
= XVECTOR (vector
)->contents
;
2600 for (i
= 0; i
< size
; i
++)
2603 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2604 bytecode object, the docstring containing the bytecode and
2605 constants values must be treated as unibyte and passed to
2606 Fread, to get the actual bytecode string and constants vector. */
2607 if (bytecodeflag
&& load_force_doc_strings
)
2609 if (i
== COMPILED_BYTECODE
)
2611 if (!STRINGP (item
))
2612 error ("invalid byte code");
2614 /* Delay handling the bytecode slot until we know whether
2615 it is lazily-loaded (we can tell by whether the
2616 constants slot is nil). */
2617 ptr
[COMPILED_CONSTANTS
] = item
;
2620 else if (i
== COMPILED_CONSTANTS
)
2622 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2626 /* Coerce string to unibyte (like string-as-unibyte,
2627 but without generating extra garbage and
2628 guaranteeing no change in the contents). */
2629 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2630 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2632 item
= Fread (bytestr
);
2634 error ("invalid byte code");
2636 otem
= XCONS (item
);
2637 bytestr
= XCAR (item
);
2642 /* Now handle the bytecode slot. */
2643 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2646 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2654 /* FLAG = 1 means check for ] to terminate rather than ) and .
2655 FLAG = -1 means check for starting with defun
2656 and make structure pure. */
2659 read_list (flag
, readcharfun
)
2661 register Lisp_Object readcharfun
;
2663 /* -1 means check next element for defun,
2664 0 means don't check,
2665 1 means already checked and found defun. */
2666 int defunflag
= flag
< 0 ? -1 : 0;
2667 Lisp_Object val
, tail
;
2668 register Lisp_Object elt
, tem
;
2669 struct gcpro gcpro1
, gcpro2
;
2670 /* 0 is the normal case.
2671 1 means this list is a doc reference; replace it with the number 0.
2672 2 means this list is a doc reference; replace it with the doc string. */
2673 int doc_reference
= 0;
2675 /* Initialize this to 1 if we are reading a list. */
2676 int first_in_list
= flag
<= 0;
2685 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2690 /* While building, if the list starts with #$, treat it specially. */
2691 if (EQ (elt
, Vload_file_name
)
2693 && !NILP (Vpurify_flag
))
2695 if (NILP (Vdoc_file_name
))
2696 /* We have not yet called Snarf-documentation, so assume
2697 this file is described in the DOC-MM.NN file
2698 and Snarf-documentation will fill in the right value later.
2699 For now, replace the whole list with 0. */
2702 /* We have already called Snarf-documentation, so make a relative
2703 file name for this file, so it can be found properly
2704 in the installed Lisp directory.
2705 We don't use Fexpand_file_name because that would make
2706 the directory absolute now. */
2707 elt
= concat2 (build_string ("../lisp/"),
2708 Ffile_name_nondirectory (elt
));
2710 else if (EQ (elt
, Vload_file_name
)
2712 && load_force_doc_strings
)
2721 Fsignal (Qinvalid_read_syntax
,
2722 Fcons (make_string (") or . in a vector", 18), Qnil
));
2730 XSETCDR (tail
, read0 (readcharfun
));
2732 val
= read0 (readcharfun
);
2733 read1 (readcharfun
, &ch
, 0);
2737 if (doc_reference
== 1)
2738 return make_number (0);
2739 if (doc_reference
== 2)
2741 /* Get a doc string from the file we are loading.
2742 If it's in saved_doc_string, get it from there. */
2743 int pos
= XINT (XCDR (val
));
2744 /* Position is negative for user variables. */
2745 if (pos
< 0) pos
= -pos
;
2746 if (pos
>= saved_doc_string_position
2747 && pos
< (saved_doc_string_position
2748 + saved_doc_string_length
))
2750 int start
= pos
- saved_doc_string_position
;
2753 /* Process quoting with ^A,
2754 and find the end of the string,
2755 which is marked with ^_ (037). */
2756 for (from
= start
, to
= start
;
2757 saved_doc_string
[from
] != 037;)
2759 int c
= saved_doc_string
[from
++];
2762 c
= saved_doc_string
[from
++];
2764 saved_doc_string
[to
++] = c
;
2766 saved_doc_string
[to
++] = 0;
2768 saved_doc_string
[to
++] = 037;
2771 saved_doc_string
[to
++] = c
;
2774 return make_string (saved_doc_string
+ start
,
2777 /* Look in prev_saved_doc_string the same way. */
2778 else if (pos
>= prev_saved_doc_string_position
2779 && pos
< (prev_saved_doc_string_position
2780 + prev_saved_doc_string_length
))
2782 int start
= pos
- prev_saved_doc_string_position
;
2785 /* Process quoting with ^A,
2786 and find the end of the string,
2787 which is marked with ^_ (037). */
2788 for (from
= start
, to
= start
;
2789 prev_saved_doc_string
[from
] != 037;)
2791 int c
= prev_saved_doc_string
[from
++];
2794 c
= prev_saved_doc_string
[from
++];
2796 prev_saved_doc_string
[to
++] = c
;
2798 prev_saved_doc_string
[to
++] = 0;
2800 prev_saved_doc_string
[to
++] = 037;
2803 prev_saved_doc_string
[to
++] = c
;
2806 return make_string (prev_saved_doc_string
+ start
,
2810 return get_doc_string (val
, 0, 0);
2815 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2817 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2819 tem
= (read_pure
&& flag
<= 0
2820 ? pure_cons (elt
, Qnil
)
2821 : Fcons (elt
, Qnil
));
2823 XSETCDR (tail
, tem
);
2828 defunflag
= EQ (elt
, Qdefun
);
2829 else if (defunflag
> 0)
2834 Lisp_Object Vobarray
;
2835 Lisp_Object initial_obarray
;
2837 /* oblookup stores the bucket number here, for the sake of Funintern. */
2839 int oblookup_last_bucket_number
;
2841 static int hash_string ();
2842 Lisp_Object
oblookup ();
2844 /* Get an error if OBARRAY is not an obarray.
2845 If it is one, return it. */
2848 check_obarray (obarray
)
2849 Lisp_Object obarray
;
2851 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2853 /* If Vobarray is now invalid, force it to be valid. */
2854 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2856 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2861 /* Intern the C string STR: return a symbol with that name,
2862 interned in the current obarray. */
2869 int len
= strlen (str
);
2870 Lisp_Object obarray
;
2873 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2874 obarray
= check_obarray (obarray
);
2875 tem
= oblookup (obarray
, str
, len
, len
);
2878 return Fintern (make_string (str
, len
), obarray
);
2881 /* Create an uninterned symbol with name STR. */
2887 int len
= strlen (str
);
2889 return Fmake_symbol ((!NILP (Vpurify_flag
)
2890 ? make_pure_string (str
, len
, len
, 0)
2891 : make_string (str
, len
)));
2894 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2895 "Return the canonical symbol whose name is STRING.\n\
2896 If there is none, one is created by this function and returned.\n\
2897 A second optional argument specifies the obarray to use;\n\
2898 it defaults to the value of `obarray'.")
2900 Lisp_Object string
, obarray
;
2902 register Lisp_Object tem
, sym
, *ptr
;
2904 if (NILP (obarray
)) obarray
= Vobarray
;
2905 obarray
= check_obarray (obarray
);
2907 CHECK_STRING (string
, 0);
2909 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2910 XSTRING (string
)->size
,
2911 STRING_BYTES (XSTRING (string
)));
2912 if (!INTEGERP (tem
))
2915 if (!NILP (Vpurify_flag
))
2916 string
= Fpurecopy (string
);
2917 sym
= Fmake_symbol (string
);
2919 if (EQ (obarray
, initial_obarray
))
2920 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2922 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2924 if ((XSTRING (string
)->data
[0] == ':')
2925 && EQ (obarray
, initial_obarray
))
2927 XSYMBOL (sym
)->constant
= 1;
2928 XSYMBOL (sym
)->value
= sym
;
2931 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2933 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2935 XSYMBOL (sym
)->next
= 0;
2940 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2941 "Return the canonical symbol named NAME, or nil if none exists.\n\
2942 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2943 symbol is searched for.\n\
2944 A second optional argument specifies the obarray to use;\n\
2945 it defaults to the value of `obarray'.")
2947 Lisp_Object name
, obarray
;
2949 register Lisp_Object tem
;
2950 struct Lisp_String
*string
;
2952 if (NILP (obarray
)) obarray
= Vobarray
;
2953 obarray
= check_obarray (obarray
);
2955 if (!SYMBOLP (name
))
2957 CHECK_STRING (name
, 0);
2958 string
= XSTRING (name
);
2961 string
= XSYMBOL (name
)->name
;
2963 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2964 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2970 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2971 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2972 The value is t if a symbol was found and deleted, nil otherwise.\n\
2973 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2974 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2975 OBARRAY defaults to the value of the variable `obarray'.")
2977 Lisp_Object name
, obarray
;
2979 register Lisp_Object string
, tem
;
2982 if (NILP (obarray
)) obarray
= Vobarray
;
2983 obarray
= check_obarray (obarray
);
2986 XSETSTRING (string
, XSYMBOL (name
)->name
);
2989 CHECK_STRING (name
, 0);
2993 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2994 XSTRING (string
)->size
,
2995 STRING_BYTES (XSTRING (string
)));
2998 /* If arg was a symbol, don't delete anything but that symbol itself. */
2999 if (SYMBOLP (name
) && !EQ (name
, tem
))
3002 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3003 XSYMBOL (tem
)->constant
= 0;
3004 XSYMBOL (tem
)->indirect_variable
= 0;
3006 hash
= oblookup_last_bucket_number
;
3008 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3010 if (XSYMBOL (tem
)->next
)
3011 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3013 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3017 Lisp_Object tail
, following
;
3019 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3020 XSYMBOL (tail
)->next
;
3023 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3024 if (EQ (following
, tem
))
3026 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3035 /* Return the symbol in OBARRAY whose names matches the string
3036 of SIZE characters (SIZE_BYTE bytes) at PTR.
3037 If there is no such symbol in OBARRAY, return nil.
3039 Also store the bucket number in oblookup_last_bucket_number. */
3042 oblookup (obarray
, ptr
, size
, size_byte
)
3043 Lisp_Object obarray
;
3045 int size
, size_byte
;
3049 register Lisp_Object tail
;
3050 Lisp_Object bucket
, tem
;
3052 if (!VECTORP (obarray
)
3053 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3055 obarray
= check_obarray (obarray
);
3056 obsize
= XVECTOR (obarray
)->size
;
3058 /* This is sometimes needed in the middle of GC. */
3059 obsize
&= ~ARRAY_MARK_FLAG
;
3060 /* Combining next two lines breaks VMS C 2.3. */
3061 hash
= hash_string (ptr
, size_byte
);
3063 bucket
= XVECTOR (obarray
)->contents
[hash
];
3064 oblookup_last_bucket_number
= hash
;
3065 if (XFASTINT (bucket
) == 0)
3067 else if (!SYMBOLP (bucket
))
3068 error ("Bad data in guts of obarray"); /* Like CADR error message */
3070 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3072 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3073 && XSYMBOL (tail
)->name
->size
== size
3074 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3076 else if (XSYMBOL (tail
)->next
== 0)
3079 XSETINT (tem
, hash
);
3084 hash_string (ptr
, len
)
3088 register unsigned char *p
= ptr
;
3089 register unsigned char *end
= p
+ len
;
3090 register unsigned char c
;
3091 register int hash
= 0;
3096 if (c
>= 0140) c
-= 40;
3097 hash
= ((hash
<<3) + (hash
>>28) + c
);
3099 return hash
& 07777777777;
3103 map_obarray (obarray
, fn
, arg
)
3104 Lisp_Object obarray
;
3105 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3109 register Lisp_Object tail
;
3110 CHECK_VECTOR (obarray
, 1);
3111 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3113 tail
= XVECTOR (obarray
)->contents
[i
];
3118 if (XSYMBOL (tail
)->next
== 0)
3120 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3126 mapatoms_1 (sym
, function
)
3127 Lisp_Object sym
, function
;
3129 call1 (function
, sym
);
3132 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3133 "Call FUNCTION on every symbol in OBARRAY.\n\
3134 OBARRAY defaults to the value of `obarray'.")
3136 Lisp_Object function
, obarray
;
3138 if (NILP (obarray
)) obarray
= Vobarray
;
3139 obarray
= check_obarray (obarray
);
3141 map_obarray (obarray
, mapatoms_1
, function
);
3145 #define OBARRAY_SIZE 1511
3150 Lisp_Object oblength
;
3154 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3156 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3157 Vobarray
= Fmake_vector (oblength
, make_number (0));
3158 initial_obarray
= Vobarray
;
3159 staticpro (&initial_obarray
);
3160 /* Intern nil in the obarray */
3161 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3162 XSYMBOL (Qnil
)->constant
= 1;
3164 /* These locals are to kludge around a pyramid compiler bug. */
3165 hash
= hash_string ("nil", 3);
3166 /* Separate statement here to avoid VAXC bug. */
3167 hash
%= OBARRAY_SIZE
;
3168 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3171 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3172 XSYMBOL (Qnil
)->function
= Qunbound
;
3173 XSYMBOL (Qunbound
)->value
= Qunbound
;
3174 XSYMBOL (Qunbound
)->function
= Qunbound
;
3177 XSYMBOL (Qnil
)->value
= Qnil
;
3178 XSYMBOL (Qnil
)->plist
= Qnil
;
3179 XSYMBOL (Qt
)->value
= Qt
;
3180 XSYMBOL (Qt
)->constant
= 1;
3182 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3185 Qvariable_documentation
= intern ("variable-documentation");
3186 staticpro (&Qvariable_documentation
);
3188 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3189 read_buffer
= (char *) xmalloc (read_buffer_size
);
3194 struct Lisp_Subr
*sname
;
3197 sym
= intern (sname
->symbol_name
);
3198 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3201 #ifdef NOTDEF /* use fset in subr.el now */
3203 defalias (sname
, string
)
3204 struct Lisp_Subr
*sname
;
3208 sym
= intern (string
);
3209 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3213 /* Define an "integer variable"; a symbol whose value is forwarded
3214 to a C variable of type int. Sample call: */
3215 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3217 defvar_int (namestring
, address
)
3221 Lisp_Object sym
, val
;
3222 sym
= intern (namestring
);
3223 val
= allocate_misc ();
3224 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3225 XINTFWD (val
)->intvar
= address
;
3226 SET_SYMBOL_VALUE (sym
, val
);
3229 /* Similar but define a variable whose value is T if address contains 1,
3230 NIL if address contains 0 */
3232 defvar_bool (namestring
, address
)
3236 Lisp_Object sym
, val
;
3237 sym
= intern (namestring
);
3238 val
= allocate_misc ();
3239 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3240 XBOOLFWD (val
)->boolvar
= address
;
3241 SET_SYMBOL_VALUE (sym
, val
);
3242 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3245 /* Similar but define a variable whose value is the Lisp Object stored
3246 at address. Two versions: with and without gc-marking of the C
3247 variable. The nopro version is used when that variable will be
3248 gc-marked for some other reason, since marking the same slot twice
3249 can cause trouble with strings. */
3251 defvar_lisp_nopro (namestring
, address
)
3253 Lisp_Object
*address
;
3255 Lisp_Object sym
, val
;
3256 sym
= intern (namestring
);
3257 val
= allocate_misc ();
3258 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3259 XOBJFWD (val
)->objvar
= address
;
3260 SET_SYMBOL_VALUE (sym
, val
);
3264 defvar_lisp (namestring
, address
)
3266 Lisp_Object
*address
;
3268 defvar_lisp_nopro (namestring
, address
);
3269 staticpro (address
);
3272 /* Similar but define a variable whose value is the Lisp Object stored in
3273 the current buffer. address is the address of the slot in the buffer
3274 that is current now. */
3277 defvar_per_buffer (namestring
, address
, type
, doc
)
3279 Lisp_Object
*address
;
3283 Lisp_Object sym
, val
;
3285 extern struct buffer buffer_local_symbols
;
3287 sym
= intern (namestring
);
3288 val
= allocate_misc ();
3289 offset
= (char *)address
- (char *)current_buffer
;
3291 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3292 XBUFFER_OBJFWD (val
)->offset
= offset
;
3293 SET_SYMBOL_VALUE (sym
, val
);
3294 PER_BUFFER_SYMBOL (offset
) = sym
;
3295 PER_BUFFER_TYPE (offset
) = type
;
3297 if (PER_BUFFER_IDX (offset
) == 0)
3298 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3299 slot of buffer_local_flags */
3304 /* Similar but define a variable whose value is the Lisp Object stored
3305 at a particular offset in the current kboard object. */
3308 defvar_kboard (namestring
, offset
)
3312 Lisp_Object sym
, val
;
3313 sym
= intern (namestring
);
3314 val
= allocate_misc ();
3315 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3316 XKBOARD_OBJFWD (val
)->offset
= offset
;
3317 SET_SYMBOL_VALUE (sym
, val
);
3320 /* Record the value of load-path used at the start of dumping
3321 so we can see if the site changed it later during dumping. */
3322 static Lisp_Object dump_path
;
3328 int turn_off_warning
= 0;
3330 /* Compute the default load-path. */
3332 normal
= PATH_LOADSEARCH
;
3333 Vload_path
= decode_env_path (0, normal
);
3335 if (NILP (Vpurify_flag
))
3336 normal
= PATH_LOADSEARCH
;
3338 normal
= PATH_DUMPLOADSEARCH
;
3340 /* In a dumped Emacs, we normally have to reset the value of
3341 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3342 uses ../lisp, instead of the path of the installed elisp
3343 libraries. However, if it appears that Vload_path was changed
3344 from the default before dumping, don't override that value. */
3347 if (! NILP (Fequal (dump_path
, Vload_path
)))
3349 Vload_path
= decode_env_path (0, normal
);
3350 if (!NILP (Vinstallation_directory
))
3352 /* Add to the path the lisp subdir of the
3353 installation dir, if it exists. */
3354 Lisp_Object tem
, tem1
;
3355 tem
= Fexpand_file_name (build_string ("lisp"),
3356 Vinstallation_directory
);
3357 tem1
= Ffile_exists_p (tem
);
3360 if (NILP (Fmember (tem
, Vload_path
)))
3362 turn_off_warning
= 1;
3363 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3367 /* That dir doesn't exist, so add the build-time
3368 Lisp dirs instead. */
3369 Vload_path
= nconc2 (Vload_path
, dump_path
);
3371 /* Add leim under the installation dir, if it exists. */
3372 tem
= Fexpand_file_name (build_string ("leim"),
3373 Vinstallation_directory
);
3374 tem1
= Ffile_exists_p (tem
);
3377 if (NILP (Fmember (tem
, Vload_path
)))
3378 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3381 /* Add site-list under the installation dir, if it exists. */
3382 tem
= Fexpand_file_name (build_string ("site-lisp"),
3383 Vinstallation_directory
);
3384 tem1
= Ffile_exists_p (tem
);
3387 if (NILP (Fmember (tem
, Vload_path
)))
3388 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3391 /* If Emacs was not built in the source directory,
3392 and it is run from where it was built, add to load-path
3393 the lisp, leim and site-lisp dirs under that directory. */
3395 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3399 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3400 Vinstallation_directory
);
3401 tem1
= Ffile_exists_p (tem
);
3403 /* Don't be fooled if they moved the entire source tree
3404 AFTER dumping Emacs. If the build directory is indeed
3405 different from the source dir, src/Makefile.in and
3406 src/Makefile will not be found together. */
3407 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3408 Vinstallation_directory
);
3409 tem2
= Ffile_exists_p (tem
);
3410 if (!NILP (tem1
) && NILP (tem2
))
3412 tem
= Fexpand_file_name (build_string ("lisp"),
3415 if (NILP (Fmember (tem
, Vload_path
)))
3416 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3418 tem
= Fexpand_file_name (build_string ("leim"),
3421 if (NILP (Fmember (tem
, Vload_path
)))
3422 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3424 tem
= Fexpand_file_name (build_string ("site-lisp"),
3427 if (NILP (Fmember (tem
, Vload_path
)))
3428 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3436 /* NORMAL refers to the lisp dir in the source directory. */
3437 /* We used to add ../lisp at the front here, but
3438 that caused trouble because it was copied from dump_path
3439 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3440 It should be unnecessary. */
3441 Vload_path
= decode_env_path (0, normal
);
3442 dump_path
= Vload_path
;
3447 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3448 almost never correct, thereby causing a warning to be printed out that
3449 confuses users. Since PATH_LOADSEARCH is always overridden by the
3450 EMACSLOADPATH environment variable below, disable the warning on NT. */
3452 /* Warn if dirs in the *standard* path don't exist. */
3453 if (!turn_off_warning
)
3455 Lisp_Object path_tail
;
3457 for (path_tail
= Vload_path
;
3459 path_tail
= XCDR (path_tail
))
3461 Lisp_Object dirfile
;
3462 dirfile
= Fcar (path_tail
);
3463 if (STRINGP (dirfile
))
3465 dirfile
= Fdirectory_file_name (dirfile
);
3466 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3467 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3472 #endif /* WINDOWSNT */
3474 /* If the EMACSLOADPATH environment variable is set, use its value.
3475 This doesn't apply if we're dumping. */
3477 if (NILP (Vpurify_flag
)
3478 && egetenv ("EMACSLOADPATH"))
3480 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3484 load_in_progress
= 0;
3485 Vload_file_name
= Qnil
;
3487 load_descriptor_list
= Qnil
;
3489 Vstandard_input
= Qt
;
3490 Vloads_in_progress
= Qnil
;
3493 /* Print a warning, using format string FORMAT, that directory DIRNAME
3494 does not exist. Print it on stderr and put it in *Message*. */
3497 dir_warning (format
, dirname
)
3499 Lisp_Object dirname
;
3502 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3504 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3505 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3506 /* Don't log the warning before we've initialized!! */
3508 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3515 defsubr (&Sread_from_string
);
3517 defsubr (&Sintern_soft
);
3518 defsubr (&Sunintern
);
3520 defsubr (&Seval_buffer
);
3521 defsubr (&Seval_region
);
3522 defsubr (&Sread_char
);
3523 defsubr (&Sread_char_exclusive
);
3524 defsubr (&Sread_event
);
3525 defsubr (&Sget_file_char
);
3526 defsubr (&Smapatoms
);
3528 DEFVAR_LISP ("obarray", &Vobarray
,
3529 "Symbol table for use by `intern' and `read'.\n\
3530 It is a vector whose length ought to be prime for best results.\n\
3531 The vector's contents don't make sense if examined from Lisp programs;\n\
3532 to find all the symbols in an obarray, use `mapatoms'.");
3534 DEFVAR_LISP ("values", &Vvalues
,
3535 "List of values of all expressions which were read, evaluated and printed.\n\
3536 Order is reverse chronological.");
3538 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3539 "Stream for read to get input from.\n\
3540 See documentation of `read' for possible values.");
3541 Vstandard_input
= Qt
;
3543 DEFVAR_LISP ("load-path", &Vload_path
,
3544 "*List of directories to search for files to load.\n\
3545 Each element is a string (directory name) or nil (try default directory).\n\
3546 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3547 otherwise to default specified by file `epaths.h' when Emacs was built.");
3549 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3550 "*List of suffixes to try for files to load.\n\
3551 This list should not include the empty string.");
3552 Vload_suffixes
= Fcons (build_string (".elc"),
3553 Fcons (build_string (".el"), Qnil
));
3554 /* We don't use empty_string because it's not initialized yet. */
3555 default_suffixes
= Fcons (build_string (""), Qnil
);
3556 staticpro (&default_suffixes
);
3558 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3559 "Non-nil iff inside of `load'.");
3561 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3562 "An alist of expressions to be evalled when particular files are loaded.\n\
3563 Each element looks like (FILENAME FORMS...).\n\
3564 When `load' is run and the file-name argument is FILENAME,\n\
3565 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3566 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3567 with no directory specified, since that is how `load' is normally called.\n\
3568 An error in FORMS does not undo the load,\n\
3569 but does prevent execution of the rest of the FORMS.\n\
3570 FILENAME can also be a symbol (a feature) and FORMS are then executed\n\
3571 when the corresponding call to `provide' is made.");
3572 Vafter_load_alist
= Qnil
;
3574 DEFVAR_LISP ("load-history", &Vload_history
,
3575 "Alist mapping source file names to symbols and features.\n\
3576 Each alist element is a list that starts with a file name,\n\
3577 except for one element (optional) that starts with nil and describes\n\
3578 definitions evaluated from buffers not visiting files.\n\
3579 The remaining elements of each list are symbols defined as functions\n\
3580 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
3581 and `(autoload . SYMBOL)'.");
3582 Vload_history
= Qnil
;
3584 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3585 "Full name of file being loaded by `load'.");
3586 Vload_file_name
= Qnil
;
3588 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3589 "File name, including directory, of user's initialization file.\n\
3590 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3591 file, this variable contains the name of the .el file, suitable for use\n\
3592 by functions like `custom-save-all' which edit the init file.");
3593 Vuser_init_file
= Qnil
;
3595 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3596 "Used for internal purposes by `load'.");
3597 Vcurrent_load_list
= Qnil
;
3599 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3600 "Function used by `load' and `eval-region' for reading expressions.\n\
3601 The default is nil, which means use the function `read'.");
3602 Vload_read_function
= Qnil
;
3604 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3605 "Function called in `load' for loading an Emacs lisp source file.\n\
3606 This function is for doing code conversion before reading the source file.\n\
3607 If nil, loading is done without any code conversion.\n\
3608 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3609 FULLNAME is the full name of FILE.\n\
3610 See `load' for the meaning of the remaining arguments.");
3611 Vload_source_file_function
= Qnil
;
3613 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3614 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3615 This is useful when the file being loaded is a temporary copy.");
3616 load_force_doc_strings
= 0;
3618 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3619 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3620 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3621 and is not meant for users to change.");
3622 load_convert_to_unibyte
= 0;
3624 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3625 "Directory in which Emacs sources were found when Emacs was built.\n\
3626 You cannot count on them to still be there!");
3628 = Fexpand_file_name (build_string ("../"),
3629 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3631 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3632 "List of files that were preloaded (when dumping Emacs).");
3633 Vpreloaded_file_list
= Qnil
;
3635 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3636 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3637 Vbyte_boolean_vars
= Qnil
;
3639 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3640 "Non-nil means load dangerous compiled Lisp files.\n\
3641 Some versions of XEmacs use different byte codes than Emacs. These\n\
3642 incompatible byte codes can make Emacs crash when it tries to execute\n\
3644 load_dangerous_libraries
= 0;
3646 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3647 "Regular expression matching safe to load compiled Lisp files.\n\
3648 When Emacs loads a compiled Lisp file, it reads the first 512 bytes\n\
3649 from the file, and matches them against this regular expression.\n\
3650 When the regular expression matches, the file is considered to be safe\n\
3651 to load. See also `load-dangerous-libraries'.");
3652 Vbytecomp_version_regexp
3653 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3655 DEFVAR_LISP ("recursive-load-depth-limit", &Vrecursive_load_depth_limit
,
3656 "Limit for depth of recursive loads.\n\
3657 Value should be either an integer > 0 specifying the limit, or nil for\n\
3659 Vrecursive_load_depth_limit
= make_number (10);
3661 /* Vsource_directory was initialized in init_lread. */
3663 load_descriptor_list
= Qnil
;
3664 staticpro (&load_descriptor_list
);
3666 Qcurrent_load_list
= intern ("current-load-list");
3667 staticpro (&Qcurrent_load_list
);
3669 Qstandard_input
= intern ("standard-input");
3670 staticpro (&Qstandard_input
);
3672 Qread_char
= intern ("read-char");
3673 staticpro (&Qread_char
);
3675 Qget_file_char
= intern ("get-file-char");
3676 staticpro (&Qget_file_char
);
3678 Qbackquote
= intern ("`");
3679 staticpro (&Qbackquote
);
3680 Qcomma
= intern (",");
3681 staticpro (&Qcomma
);
3682 Qcomma_at
= intern (",@");
3683 staticpro (&Qcomma_at
);
3684 Qcomma_dot
= intern (",.");
3685 staticpro (&Qcomma_dot
);
3687 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3688 staticpro (&Qinhibit_file_name_operation
);
3690 Qascii_character
= intern ("ascii-character");
3691 staticpro (&Qascii_character
);
3693 Qfunction
= intern ("function");
3694 staticpro (&Qfunction
);
3696 Qload
= intern ("load");
3699 Qload_file_name
= intern ("load-file-name");
3700 staticpro (&Qload_file_name
);
3702 staticpro (&dump_path
);
3704 staticpro (&read_objects
);
3705 read_objects
= Qnil
;
3706 staticpro (&seen_list
);
3708 Vloads_in_progress
= Qnil
;
3709 staticpro (&Vloads_in_progress
);