1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 1999
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 for files to be loaded. */
95 Lisp_Object Vload_path
;
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_busy_cursor_p
)
431 cancel_busy_cursor ();
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_busy_cursor_p
)
493 start_busy_cursor ();
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.\n\
613 This function searches the directories in `load-path'.\n\
614 If optional second arg NOERROR is non-nil,\n\
615 report no error if FILE doesn't exist.\n\
616 Print messages at start and end of loading unless\n\
617 optional third arg NOMESSAGE is non-nil.\n\
618 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
619 suffixes `.elc' or `.el' to the specified name FILE.\n\
620 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
621 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
622 it ends in one of those suffixes or includes a directory name.\n\
623 Return t if file exists.")
624 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
625 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
627 register FILE *stream
;
628 register int fd
= -1;
629 register Lisp_Object lispstream
;
630 int count
= specpdl_ptr
- specpdl
;
634 /* 1 means we printed the ".el is newer" message. */
636 /* 1 means we are loading a compiled file. */
645 CHECK_STRING (file
, 0);
647 /* If file name is magic, call the handler. */
648 handler
= Ffind_file_name_handler (file
, Qload
);
650 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
652 /* Do this after the handler to avoid
653 the need to gcpro noerror, nomessage and nosuffix.
654 (Below here, we care only whether they are nil or not.) */
655 file
= Fsubstitute_in_file_name (file
);
657 /* Avoid weird lossage with null string as arg,
658 since it would try to load a directory as a Lisp file */
659 if (XSTRING (file
)->size
> 0)
661 int size
= STRING_BYTES (XSTRING (file
));
665 if (! NILP (must_suffix
))
667 /* Don't insist on adding a suffix if FILE already ends with one. */
669 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
672 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
674 /* Don't insist on adding a suffix
675 if the argument includes a directory name. */
676 else if (! NILP (Ffile_name_directory (file
)))
680 fd
= openp (Vload_path
, file
,
681 (!NILP (nosuffix
) ? ""
682 : ! NILP (must_suffix
) ? ".elc.gz:.elc:.el.gz:.el"
683 : ".elc:.elc.gz:.el.gz:.el:"),
692 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
693 Fcons (file
, Qnil
)));
698 /* Tell startup.el whether or not we found the user's init file. */
699 if (EQ (Qt
, Vuser_init_file
))
700 Vuser_init_file
= found
;
702 /* If FD is 0, that means openp found a magic file. */
705 if (NILP (Fequal (found
, file
)))
706 /* If FOUND is a different file name from FILE,
707 find its handler even if we have already inhibited
708 the `load' operation on FILE. */
709 handler
= Ffind_file_name_handler (found
, Qt
);
711 handler
= Ffind_file_name_handler (found
, Qload
);
712 if (! NILP (handler
))
713 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
716 /* Check if we're stuck in a recursive load cycle.
718 2000-09-21: It's not possible to just check for the file loaded
719 being a member of Vloads_in_progress. This fails because of the
720 way the byte compiler currently works; `provide's are not
721 evaluted, see font-lock.el/jit-lock.el as an example. This
722 leads to a certain amount of ``normal'' recursion.
724 Also, just loading a file recursively is not always an error in
725 the general case; the second load may do something different. */
726 if (INTEGERP (Vrecursive_load_depth_limit
)
727 && XINT (Vrecursive_load_depth_limit
) > 0)
729 Lisp_Object len
= Flength (Vloads_in_progress
);
730 if (XFASTINT (len
) > XFASTINT (Vrecursive_load_depth_limit
))
731 Fsignal (Qerror
, Fcons (build_string ("Recursive load suspected"),
732 Fcons (found
, Vloads_in_progress
)));
733 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
734 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
737 /* Load .elc files directly, but not when they are
738 remote and have no handler! */
739 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
746 if (!safe_to_load_p (fd
))
749 if (!load_dangerous_libraries
)
750 error ("File `%s' was not compiled in Emacs",
751 XSTRING (found
)->data
);
752 else if (!NILP (nomessage
))
753 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
761 stat ((char *)XSTRING (found
)->data
, &s1
);
762 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
763 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
764 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
766 /* Make the progress messages mention that source is newer. */
769 /* If we won't print another message, mention this anyway. */
770 if (! NILP (nomessage
))
771 message_with_string ("Source file `%s' newer than byte-compiled file",
774 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
780 /* We are loading a source file (*.el). */
781 if (!NILP (Vload_source_file_function
))
787 val
= call4 (Vload_source_file_function
, found
, file
,
788 NILP (noerror
) ? Qnil
: Qt
,
789 NILP (nomessage
) ? Qnil
: Qt
);
790 return unbind_to (count
, val
);
796 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
797 #else /* not WINDOWSNT */
798 stream
= fdopen (fd
, fmode
);
799 #endif /* not WINDOWSNT */
803 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
806 if (! NILP (Vpurify_flag
))
807 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
809 if (NILP (nomessage
))
812 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
815 message_with_string ("Loading %s (source)...", file
, 1);
817 message_with_string ("Loading %s (compiled; note, source file is newer)...",
819 else /* The typical case; compiled file newer than source file. */
820 message_with_string ("Loading %s...", file
, 1);
824 lispstream
= Fcons (Qnil
, Qnil
);
825 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
826 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
827 record_unwind_protect (load_unwind
, lispstream
);
828 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
829 specbind (Qload_file_name
, found
);
830 specbind (Qinhibit_file_name_operation
, Qnil
);
832 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
834 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
835 unbind_to (count
, Qnil
);
837 /* Run any load-hooks for this file. */
838 temp
= Fassoc (file
, Vafter_load_alist
);
840 Fprogn (Fcdr (temp
));
843 if (saved_doc_string
)
844 free (saved_doc_string
);
845 saved_doc_string
= 0;
846 saved_doc_string_size
= 0;
848 if (prev_saved_doc_string
)
849 xfree (prev_saved_doc_string
);
850 prev_saved_doc_string
= 0;
851 prev_saved_doc_string_size
= 0;
853 if (!noninteractive
&& NILP (nomessage
))
856 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
859 message_with_string ("Loading %s (source)...done", file
, 1);
861 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
863 else /* The typical case; compiled file newer than source file. */
864 message_with_string ("Loading %s...done", file
, 1);
871 load_unwind (stream
) /* used as unwind-protect function in load */
874 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
875 | XFASTINT (XCDR (stream
))));
876 if (--load_in_progress
< 0) load_in_progress
= 0;
881 load_descriptor_unwind (oldlist
)
884 load_descriptor_list
= oldlist
;
888 /* Close all descriptors in use for Floads.
889 This is used when starting a subprocess. */
896 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
897 emacs_close (XFASTINT (XCAR (tail
)));
902 complete_filename_p (pathname
)
903 Lisp_Object pathname
;
905 register unsigned char *s
= XSTRING (pathname
)->data
;
906 return (IS_DIRECTORY_SEP (s
[0])
907 || (XSTRING (pathname
)->size
> 2
908 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
918 /* Search for a file whose name is STR, looking in directories
919 in the Lisp list PATH, and trying suffixes from SUFFIX.
920 SUFFIX is a string containing possible suffixes separated by colons.
921 On success, returns a file descriptor. On failure, returns -1.
923 EXEC_ONLY nonzero means don't open the files,
924 just look for one that is executable. In this case,
925 returns 1 on success.
927 If STOREPTR is nonzero, it points to a slot where the name of
928 the file actually found should be stored as a Lisp string.
929 nil is stored there on failure.
931 If the file we find is remote, return 0
932 but store the found remote file name in *STOREPTR.
933 We do not check for remote files if EXEC_ONLY is nonzero. */
936 openp (path
, str
, suffix
, storeptr
, exec_only
)
937 Lisp_Object path
, str
;
939 Lisp_Object
*storeptr
;
945 register char *fn
= buf
;
948 Lisp_Object filename
;
950 struct gcpro gcpro1
, gcpro2
, gcpro3
;
953 string
= filename
= Qnil
;
954 GCPRO3 (str
, string
, filename
);
959 if (complete_filename_p (str
))
962 for (; !NILP (path
); path
= Fcdr (path
))
966 filename
= Fexpand_file_name (str
, Fcar (path
));
967 if (!complete_filename_p (filename
))
968 /* If there are non-absolute elts in PATH (eg ".") */
969 /* Of course, this could conceivably lose if luser sets
970 default-directory to be something non-absolute... */
972 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
973 if (!complete_filename_p (filename
))
974 /* Give up on this path element! */
978 /* Calculate maximum size of any filename made from
979 this path element/specified file name and any possible suffix. */
980 want_size
= strlen (suffix
) + STRING_BYTES (XSTRING (filename
)) + 1;
981 if (fn_size
< want_size
)
982 fn
= (char *) alloca (fn_size
= 100 + want_size
);
986 /* Loop over suffixes. */
989 char *esuffix
= (char *) index (nsuffix
, ':');
990 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
993 /* Concatenate path element/specified name with the suffix.
994 If the directory starts with /:, remove that. */
995 if (XSTRING (filename
)->size
> 2
996 && XSTRING (filename
)->data
[0] == '/'
997 && XSTRING (filename
)->data
[1] == ':')
999 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1000 STRING_BYTES (XSTRING (filename
)) - 2);
1001 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1005 strncpy (fn
, XSTRING (filename
)->data
,
1006 STRING_BYTES (XSTRING (filename
)));
1007 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1010 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1011 strncat (fn
, nsuffix
, lsuffix
);
1013 /* Check that the file exists and is not a directory. */
1017 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1018 if (! NILP (handler
) && ! exec_only
)
1022 string
= build_string (fn
);
1023 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
1024 : Ffile_readable_p (string
));
1026 && ! NILP (Ffile_directory_p (build_string (fn
))))
1031 /* We succeeded; return this descriptor and filename. */
1033 *storeptr
= build_string (fn
);
1040 int exists
= (stat (fn
, &st
) >= 0
1041 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1044 /* Check that we can access or open it. */
1046 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1048 fd
= emacs_open (fn
, O_RDONLY
, 0);
1052 /* We succeeded; return this descriptor and filename. */
1054 *storeptr
= build_string (fn
);
1061 /* Advance to next suffix. */
1064 nsuffix
+= lsuffix
+ 1;
1075 /* Merge the list we've accumulated of globals from the current input source
1076 into the load_history variable. The details depend on whether
1077 the source has an associated file name or not. */
1080 build_load_history (stream
, source
)
1084 register Lisp_Object tail
, prev
, newelt
;
1085 register Lisp_Object tem
, tem2
;
1086 register int foundit
, loading
;
1088 loading
= stream
|| !NARROWED
;
1090 tail
= Vload_history
;
1093 while (!NILP (tail
))
1097 /* Find the feature's previous assoc list... */
1098 if (!NILP (Fequal (source
, Fcar (tem
))))
1102 /* If we're loading, remove it. */
1106 Vload_history
= Fcdr (tail
);
1108 Fsetcdr (prev
, Fcdr (tail
));
1111 /* Otherwise, cons on new symbols that are not already members. */
1114 tem2
= Vcurrent_load_list
;
1116 while (CONSP (tem2
))
1118 newelt
= Fcar (tem2
);
1120 if (NILP (Fmemq (newelt
, tem
)))
1121 Fsetcar (tail
, Fcons (Fcar (tem
),
1122 Fcons (newelt
, Fcdr (tem
))));
1135 /* If we're loading, cons the new assoc onto the front of load-history,
1136 the most-recently-loaded position. Also do this if we didn't find
1137 an existing member for the current source. */
1138 if (loading
|| !foundit
)
1139 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1144 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1152 readevalloop_1 (old
)
1155 load_convert_to_unibyte
= ! NILP (old
);
1159 /* Signal an `end-of-file' error, if possible with file name
1163 end_of_file_error ()
1167 if (STRINGP (Vload_file_name
))
1168 data
= Fcons (Vload_file_name
, Qnil
);
1172 Fsignal (Qend_of_file
, data
);
1175 /* UNIBYTE specifies how to set load_convert_to_unibyte
1176 for this invocation.
1177 READFUN, if non-nil, is used instead of `read'. */
1180 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1181 Lisp_Object readcharfun
;
1183 Lisp_Object sourcename
;
1184 Lisp_Object (*evalfun
) ();
1186 Lisp_Object unibyte
, readfun
;
1189 register Lisp_Object val
;
1190 int count
= specpdl_ptr
- specpdl
;
1191 struct gcpro gcpro1
;
1192 struct buffer
*b
= 0;
1193 int continue_reading_p
;
1195 if (BUFFERP (readcharfun
))
1196 b
= XBUFFER (readcharfun
);
1197 else if (MARKERP (readcharfun
))
1198 b
= XMARKER (readcharfun
)->buffer
;
1200 specbind (Qstandard_input
, readcharfun
);
1201 specbind (Qcurrent_load_list
, Qnil
);
1202 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1203 load_convert_to_unibyte
= !NILP (unibyte
);
1205 readchar_backlog
= -1;
1207 GCPRO1 (sourcename
);
1209 LOADHIST_ATTACH (sourcename
);
1211 continue_reading_p
= 1;
1212 while (continue_reading_p
)
1214 if (b
!= 0 && NILP (b
->name
))
1215 error ("Reading from killed buffer");
1221 while ((c
= READCHAR
) != '\n' && c
!= -1);
1226 /* Ignore whitespace here, so we can detect eof. */
1227 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1230 if (!NILP (Vpurify_flag
) && c
== '(')
1232 int count1
= specpdl_ptr
- specpdl
;
1233 record_unwind_protect (unreadpure
, Qnil
);
1234 val
= read_list (-1, readcharfun
);
1235 unbind_to (count1
, Qnil
);
1240 read_objects
= Qnil
;
1241 if (!NILP (readfun
))
1243 val
= call1 (readfun
, readcharfun
);
1245 /* If READCHARFUN has set point to ZV, we should
1246 stop reading, even if the form read sets point
1247 to a different value when evaluated. */
1248 if (BUFFERP (readcharfun
))
1250 struct buffer
*b
= XBUFFER (readcharfun
);
1251 if (BUF_PT (b
) == BUF_ZV (b
))
1252 continue_reading_p
= 0;
1255 else if (! NILP (Vload_read_function
))
1256 val
= call1 (Vload_read_function
, readcharfun
);
1258 val
= read0 (readcharfun
);
1261 val
= (*evalfun
) (val
);
1265 Vvalues
= Fcons (val
, Vvalues
);
1266 if (EQ (Vstandard_output
, Qt
))
1273 build_load_history (stream
, sourcename
);
1276 unbind_to (count
, Qnil
);
1279 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1280 "Execute the current buffer as Lisp code.\n\
1281 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1282 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1283 PRINTFLAG controls printing of output:\n\
1284 nil means discard it; anything else is stream for print.\n\
1286 If the optional third argument FILENAME is non-nil,\n\
1287 it specifies the file name to use for `load-history'.\n\
1288 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\
1289 for this invocation.\n\
1291 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\
1292 `print' and related functions should work normally even if PRINTFLAG is nil.\n\
1294 This function preserves the position of point.")
1295 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1296 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1298 int count
= specpdl_ptr
- specpdl
;
1299 Lisp_Object tem
, buf
;
1302 buf
= Fcurrent_buffer ();
1304 buf
= Fget_buffer (buffer
);
1306 error ("No such buffer");
1308 if (NILP (printflag
) && NILP (do_allow_print
))
1313 if (NILP (filename
))
1314 filename
= XBUFFER (buf
)->filename
;
1316 specbind (Qstandard_output
, tem
);
1317 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1318 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1319 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1320 unbind_to (count
, Qnil
);
1326 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1327 "Execute the current buffer as Lisp code.\n\
1328 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1329 nil means discard it; anything else is stream for print.\n\
1331 If there is no error, point does not move. If there is an error,\n\
1332 point remains at the end of the last character read from the buffer.")
1334 Lisp_Object printflag
;
1336 int count
= specpdl_ptr
- specpdl
;
1337 Lisp_Object tem
, cbuf
;
1339 cbuf
= Fcurrent_buffer ()
1341 if (NILP (printflag
))
1345 specbind (Qstandard_output
, tem
);
1346 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1348 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1349 !NILP (printflag
), Qnil
, Qnil
);
1350 return unbind_to (count
, Qnil
);
1354 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1355 "Execute the region as Lisp code.\n\
1356 When called from programs, expects two arguments,\n\
1357 giving starting and ending indices in the current buffer\n\
1358 of the text to be executed.\n\
1359 Programs can pass third argument PRINTFLAG which controls output:\n\
1360 nil means discard it; anything else is stream for printing it.\n\
1361 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1362 instead of `read' to read each expression. It gets one argument\n\
1363 which is the input stream for reading characters.\n\
1365 This function does not move point.")
1366 (start
, end
, printflag
, read_function
)
1367 Lisp_Object start
, end
, printflag
, read_function
;
1369 int count
= specpdl_ptr
- specpdl
;
1370 Lisp_Object tem
, cbuf
;
1372 cbuf
= Fcurrent_buffer ();
1374 if (NILP (printflag
))
1378 specbind (Qstandard_output
, tem
);
1380 if (NILP (printflag
))
1381 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1382 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1384 /* This both uses start and checks its type. */
1386 Fnarrow_to_region (make_number (BEGV
), end
);
1387 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1388 !NILP (printflag
), Qnil
, read_function
);
1390 return unbind_to (count
, Qnil
);
1394 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1395 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1396 If STREAM is nil, use the value of `standard-input' (which see).\n\
1397 STREAM or the value of `standard-input' may be:\n\
1398 a buffer (read from point and advance it)\n\
1399 a marker (read from where it points and advance it)\n\
1400 a function (call it with no arguments for each character,\n\
1401 call it with a char as argument to push a char back)\n\
1402 a string (takes text from string, starting at the beginning)\n\
1403 t (read text line using minibuffer and use it, or read from\n\
1404 standard input in batch mode).")
1408 extern Lisp_Object
Fread_minibuffer ();
1411 stream
= Vstandard_input
;
1412 if (EQ (stream
, Qt
))
1413 stream
= Qread_char
;
1415 readchar_backlog
= -1;
1416 new_backquote_flag
= 0;
1417 read_objects
= Qnil
;
1419 if (EQ (stream
, Qread_char
))
1420 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1422 if (STRINGP (stream
))
1423 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1425 return read0 (stream
);
1428 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1429 "Read one Lisp expression which is represented as text by STRING.\n\
1430 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1431 START and END optionally delimit a substring of STRING from which to read;\n\
1432 they default to 0 and (length STRING) respectively.")
1433 (string
, start
, end
)
1434 Lisp_Object string
, start
, end
;
1436 int startval
, endval
;
1439 CHECK_STRING (string
,0);
1442 endval
= XSTRING (string
)->size
;
1445 CHECK_NUMBER (end
, 2);
1446 endval
= XINT (end
);
1447 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1448 args_out_of_range (string
, end
);
1455 CHECK_NUMBER (start
, 1);
1456 startval
= XINT (start
);
1457 if (startval
< 0 || startval
> endval
)
1458 args_out_of_range (string
, start
);
1461 read_from_string_index
= startval
;
1462 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1463 read_from_string_limit
= endval
;
1465 new_backquote_flag
= 0;
1466 read_objects
= Qnil
;
1468 tem
= read0 (string
);
1469 return Fcons (tem
, make_number (read_from_string_index
));
1472 /* Use this for recursive reads, in contexts where internal tokens
1477 Lisp_Object readcharfun
;
1479 register Lisp_Object val
;
1482 val
= read1 (readcharfun
, &c
, 0);
1484 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1491 static int read_buffer_size
;
1492 static char *read_buffer
;
1494 /* Read multibyte form and return it as a character. C is a first
1495 byte of multibyte form, and rest of them are read from
1499 read_multibyte (c
, readcharfun
)
1501 Lisp_Object readcharfun
;
1503 /* We need the actual character code of this multibyte
1505 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1509 while ((c
= READCHAR
) >= 0xA0
1510 && len
< MAX_MULTIBYTE_LENGTH
)
1513 return STRING_CHAR (str
, len
);
1516 /* Read a \-escape sequence, assuming we already read the `\'. */
1519 read_escape (readcharfun
, stringp
)
1520 Lisp_Object readcharfun
;
1523 register int c
= READCHAR
;
1527 error ("End of file");
1557 error ("Invalid escape character syntax");
1560 c
= read_escape (readcharfun
, 0);
1561 return c
| meta_modifier
;
1566 error ("Invalid escape character syntax");
1569 c
= read_escape (readcharfun
, 0);
1570 return c
| shift_modifier
;
1575 error ("Invalid escape character syntax");
1578 c
= read_escape (readcharfun
, 0);
1579 return c
| hyper_modifier
;
1584 error ("Invalid escape character syntax");
1587 c
= read_escape (readcharfun
, 0);
1588 return c
| alt_modifier
;
1593 error ("Invalid escape character syntax");
1596 c
= read_escape (readcharfun
, 0);
1597 return c
| super_modifier
;
1602 error ("Invalid escape character syntax");
1606 c
= read_escape (readcharfun
, 0);
1607 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1608 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1609 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1610 return c
| ctrl_modifier
;
1611 /* ASCII control chars are made from letters (both cases),
1612 as well as the non-letters within 0100...0137. */
1613 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1614 return (c
& (037 | ~0177));
1615 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1616 return (c
& (037 | ~0177));
1618 return c
| ctrl_modifier
;
1628 /* An octal escape, as in ANSI C. */
1630 register int i
= c
- '0';
1631 register int count
= 0;
1634 if ((c
= READCHAR
) >= '0' && c
<= '7')
1649 /* A hex escape, as in ANSI C. */
1655 if (c
>= '0' && c
<= '9')
1660 else if ((c
>= 'a' && c
<= 'f')
1661 || (c
>= 'A' && c
<= 'F'))
1664 if (c
>= 'a' && c
<= 'f')
1679 if (BASE_LEADING_CODE_P (c
))
1680 c
= read_multibyte (c
, readcharfun
);
1686 /* Read an integer in radix RADIX using READCHARFUN to read
1687 characters. RADIX must be in the interval [2..36]; if it isn't, a
1688 read error is signaled . Value is the integer read. Signals an
1689 error if encountering invalid read syntax or if RADIX is out of
1693 read_integer (readcharfun
, radix
)
1694 Lisp_Object readcharfun
;
1697 int number
= 0, ndigits
= 0, invalid_p
, c
, sign
= 0;
1699 if (radix
< 2 || radix
> 36)
1703 number
= ndigits
= invalid_p
= 0;
1719 if (c
>= '0' && c
<= '9')
1721 else if (c
>= 'a' && c
<= 'z')
1722 digit
= c
- 'a' + 10;
1723 else if (c
>= 'A' && c
<= 'Z')
1724 digit
= c
- 'A' + 10;
1731 if (digit
< 0 || digit
>= radix
)
1734 number
= radix
* number
+ digit
;
1740 if (ndigits
== 0 || invalid_p
)
1743 sprintf (buf
, "integer, radix %d", radix
);
1744 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1747 return make_number (sign
* number
);
1751 /* If the next token is ')' or ']' or '.', we store that character
1752 in *PCH and the return value is not interesting. Else, we store
1753 zero in *PCH and we read and return one lisp object.
1755 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1758 read1 (readcharfun
, pch
, first_in_list
)
1759 register Lisp_Object readcharfun
;
1764 int uninterned_symbol
= 0;
1772 end_of_file_error ();
1777 return read_list (0, readcharfun
);
1780 return read_vector (readcharfun
, 0);
1797 tmp
= read_vector (readcharfun
, 0);
1798 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1799 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1800 error ("Invalid size char-table");
1801 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1802 XCHAR_TABLE (tmp
)->top
= Qt
;
1811 tmp
= read_vector (readcharfun
, 0);
1812 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1813 error ("Invalid size char-table");
1814 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1815 XCHAR_TABLE (tmp
)->top
= Qnil
;
1818 Fsignal (Qinvalid_read_syntax
,
1819 Fcons (make_string ("#^^", 3), Qnil
));
1821 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1826 length
= read1 (readcharfun
, pch
, first_in_list
);
1830 Lisp_Object tmp
, val
;
1831 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1835 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1836 if (size_in_chars
!= XSTRING (tmp
)->size
1837 /* We used to print 1 char too many
1838 when the number of bits was a multiple of 8.
1839 Accept such input in case it came from an old version. */
1840 && ! (XFASTINT (length
)
1841 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1842 Fsignal (Qinvalid_read_syntax
,
1843 Fcons (make_string ("#&...", 5), Qnil
));
1845 val
= Fmake_bool_vector (length
, Qnil
);
1846 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1848 /* Clear the extraneous bits in the last byte. */
1849 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1850 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1851 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1854 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1859 /* Accept compiled functions at read-time so that we don't have to
1860 build them using function calls. */
1862 tmp
= read_vector (readcharfun
, 1);
1863 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1864 XVECTOR (tmp
)->contents
);
1869 struct gcpro gcpro1
;
1872 /* Read the string itself. */
1873 tmp
= read1 (readcharfun
, &ch
, 0);
1874 if (ch
!= 0 || !STRINGP (tmp
))
1875 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1877 /* Read the intervals and their properties. */
1880 Lisp_Object beg
, end
, plist
;
1882 beg
= read1 (readcharfun
, &ch
, 0);
1887 end
= read1 (readcharfun
, &ch
, 0);
1889 plist
= read1 (readcharfun
, &ch
, 0);
1891 Fsignal (Qinvalid_read_syntax
,
1892 Fcons (build_string ("invalid string property list"),
1894 Fset_text_properties (beg
, end
, plist
, tmp
);
1900 /* #@NUMBER is used to skip NUMBER following characters.
1901 That's used in .elc files to skip over doc strings
1902 and function definitions. */
1907 /* Read a decimal integer. */
1908 while ((c
= READCHAR
) >= 0
1909 && c
>= '0' && c
<= '9')
1917 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1919 /* If we are supposed to force doc strings into core right now,
1920 record the last string that we skipped,
1921 and record where in the file it comes from. */
1923 /* But first exchange saved_doc_string
1924 with prev_saved_doc_string, so we save two strings. */
1926 char *temp
= saved_doc_string
;
1927 int temp_size
= saved_doc_string_size
;
1928 file_offset temp_pos
= saved_doc_string_position
;
1929 int temp_len
= saved_doc_string_length
;
1931 saved_doc_string
= prev_saved_doc_string
;
1932 saved_doc_string_size
= prev_saved_doc_string_size
;
1933 saved_doc_string_position
= prev_saved_doc_string_position
;
1934 saved_doc_string_length
= prev_saved_doc_string_length
;
1936 prev_saved_doc_string
= temp
;
1937 prev_saved_doc_string_size
= temp_size
;
1938 prev_saved_doc_string_position
= temp_pos
;
1939 prev_saved_doc_string_length
= temp_len
;
1942 if (saved_doc_string_size
== 0)
1944 saved_doc_string_size
= nskip
+ 100;
1945 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1947 if (nskip
> saved_doc_string_size
)
1949 saved_doc_string_size
= nskip
+ 100;
1950 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1951 saved_doc_string_size
);
1954 saved_doc_string_position
= file_tell (instream
);
1956 /* Copy that many characters into saved_doc_string. */
1957 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1958 saved_doc_string
[i
] = c
= READCHAR
;
1960 saved_doc_string_length
= i
;
1964 /* Skip that many characters. */
1965 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1972 return Vload_file_name
;
1974 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1975 /* #:foo is the uninterned symbol named foo. */
1978 uninterned_symbol
= 1;
1982 /* Reader forms that can reuse previously read objects. */
1983 if (c
>= '0' && c
<= '9')
1988 /* Read a non-negative integer. */
1989 while (c
>= '0' && c
<= '9')
1995 /* #n=object returns object, but associates it with n for #n#. */
1998 /* Make a placeholder for #n# to use temporarily */
1999 Lisp_Object placeholder
;
2002 placeholder
= Fcons(Qnil
, Qnil
);
2003 cell
= Fcons (make_number (n
), placeholder
);
2004 read_objects
= Fcons (cell
, read_objects
);
2006 /* Read the object itself. */
2007 tem
= read0 (readcharfun
);
2009 /* Now put it everywhere the placeholder was... */
2010 substitute_object_in_subtree (tem
, placeholder
);
2012 /* ...and #n# will use the real value from now on. */
2013 Fsetcdr (cell
, tem
);
2017 /* #n# returns a previously read object. */
2020 tem
= Fassq (make_number (n
), read_objects
);
2023 /* Fall through to error message. */
2025 else if (c
== 'r' || c
== 'R')
2026 return read_integer (readcharfun
, n
);
2028 /* Fall through to error message. */
2030 else if (c
== 'x' || c
== 'X')
2031 return read_integer (readcharfun
, 16);
2032 else if (c
== 'o' || c
== 'O')
2033 return read_integer (readcharfun
, 8);
2034 else if (c
== 'b' || c
== 'B')
2035 return read_integer (readcharfun
, 2);
2038 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2041 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2046 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2056 new_backquote_flag
= 1;
2057 value
= read0 (readcharfun
);
2058 new_backquote_flag
= 0;
2060 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2064 if (new_backquote_flag
)
2066 Lisp_Object comma_type
= Qnil
;
2071 comma_type
= Qcomma_at
;
2073 comma_type
= Qcomma_dot
;
2076 if (ch
>= 0) UNREAD (ch
);
2077 comma_type
= Qcomma
;
2080 new_backquote_flag
= 0;
2081 value
= read0 (readcharfun
);
2082 new_backquote_flag
= 1;
2083 return Fcons (comma_type
, Fcons (value
, Qnil
));
2092 end_of_file_error ();
2095 c
= read_escape (readcharfun
, 0);
2096 else if (BASE_LEADING_CODE_P (c
))
2097 c
= read_multibyte (c
, readcharfun
);
2099 return make_number (c
);
2104 register char *p
= read_buffer
;
2105 register char *end
= read_buffer
+ read_buffer_size
;
2107 /* Nonzero if we saw an escape sequence specifying
2108 a multibyte character. */
2109 int force_multibyte
= 0;
2110 /* Nonzero if we saw an escape sequence specifying
2111 a single-byte character. */
2112 int force_singlebyte
= 0;
2116 while ((c
= READCHAR
) >= 0
2119 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2121 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2122 p
+= new - read_buffer
;
2123 read_buffer
+= new - read_buffer
;
2124 end
= read_buffer
+ read_buffer_size
;
2129 c
= read_escape (readcharfun
, 1);
2131 /* C is -1 if \ newline has just been seen */
2134 if (p
== read_buffer
)
2139 /* If an escape specifies a non-ASCII single-byte character,
2140 this must be a unibyte string. */
2141 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2142 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2143 force_singlebyte
= 1;
2146 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2148 /* Any modifiers for a multibyte character are invalid. */
2149 if (c
& CHAR_MODIFIER_MASK
)
2150 error ("Invalid modifier in string");
2151 p
+= CHAR_STRING (c
, p
);
2152 force_multibyte
= 1;
2156 /* Allow `\C- ' and `\C-?'. */
2157 if (c
== (CHAR_CTL
| ' '))
2159 else if (c
== (CHAR_CTL
| '?'))
2164 /* Shift modifier is valid only with [A-Za-z]. */
2165 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2167 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2168 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2172 /* Move the meta bit to the right place for a string. */
2173 c
= (c
& ~CHAR_META
) | 0x80;
2175 error ("Invalid modifier in string");
2180 end_of_file_error ();
2182 /* If purifying, and string starts with \ newline,
2183 return zero instead. This is for doc strings
2184 that we are really going to find in etc/DOC.nn.nn */
2185 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2186 return make_number (0);
2188 if (force_multibyte
)
2189 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2190 p
- read_buffer
, &nchars
);
2191 else if (force_singlebyte
)
2192 nchars
= p
- read_buffer
;
2193 else if (load_convert_to_unibyte
)
2196 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2197 p
- read_buffer
, &nchars
);
2198 if (p
- read_buffer
!= nchars
)
2200 string
= make_multibyte_string (read_buffer
, nchars
,
2202 return Fstring_make_unibyte (string
);
2205 else if (EQ (readcharfun
, Qget_file_char
)
2206 || EQ (readcharfun
, Qlambda
))
2207 /* Nowadays, reading directly from a file is used only for
2208 compiled Emacs Lisp files, and those always use the
2209 Emacs internal encoding. Meanwhile, Qlambda is used
2210 for reading dynamic byte code (compiled with
2211 byte-compile-dynamic = t). */
2212 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2213 p
- read_buffer
, &nchars
);
2215 /* In all other cases, if we read these bytes as
2216 separate characters, treat them as separate characters now. */
2217 nchars
= p
- read_buffer
;
2220 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2222 || (p
- read_buffer
!= nchars
)));
2223 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2225 || (p
- read_buffer
!= nchars
)));
2230 int next_char
= READCHAR
;
2233 if (next_char
<= 040
2234 || index ("\"'`,(", next_char
))
2240 /* Otherwise, we fall through! Note that the atom-reading loop
2241 below will now loop at least once, assuring that we will not
2242 try to UNREAD two characters in a row. */
2246 if (c
<= 040) goto retry
;
2248 char *p
= read_buffer
;
2252 char *end
= read_buffer
+ read_buffer_size
;
2255 && !(c
== '\"' || c
== '\'' || c
== ';'
2256 || c
== '(' || c
== ')'
2257 || c
== '[' || c
== ']' || c
== '#'))
2259 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2261 char *new = (char *) xrealloc (read_buffer
,
2262 read_buffer_size
*= 2);
2263 p
+= new - read_buffer
;
2264 read_buffer
+= new - read_buffer
;
2265 end
= read_buffer
+ read_buffer_size
;
2274 if (! SINGLE_BYTE_CHAR_P (c
))
2275 p
+= CHAR_STRING (c
, p
);
2284 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2285 p
+= new - read_buffer
;
2286 read_buffer
+= new - read_buffer
;
2287 /* end = read_buffer + read_buffer_size; */
2294 if (!quoted
&& !uninterned_symbol
)
2297 register Lisp_Object val
;
2299 if (*p1
== '+' || *p1
== '-') p1
++;
2300 /* Is it an integer? */
2303 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2304 /* Integers can have trailing decimal points. */
2305 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2307 /* It is an integer. */
2311 if (sizeof (int) == sizeof (EMACS_INT
))
2312 XSETINT (val
, atoi (read_buffer
));
2313 else if (sizeof (long) == sizeof (EMACS_INT
))
2314 XSETINT (val
, atol (read_buffer
));
2320 if (isfloat_string (read_buffer
))
2322 /* Compute NaN and infinities using 0.0 in a variable,
2323 to cope with compilers that think they are smarter
2329 /* Negate the value ourselves. This treats 0, NaNs,
2330 and infinity properly on IEEE floating point hosts,
2331 and works around a common bug where atof ("-0.0")
2333 int negative
= read_buffer
[0] == '-';
2335 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2336 returns 1, is if the input ends in e+INF or e+NaN. */
2343 value
= zero
/ zero
;
2346 value
= atof (read_buffer
+ negative
);
2350 return make_float (negative
? - value
: value
);
2354 if (uninterned_symbol
)
2355 return make_symbol (read_buffer
);
2357 return intern (read_buffer
);
2363 /* List of nodes we've seen during substitute_object_in_subtree. */
2364 static Lisp_Object seen_list
;
2367 substitute_object_in_subtree (object
, placeholder
)
2369 Lisp_Object placeholder
;
2371 Lisp_Object check_object
;
2373 /* We haven't seen any objects when we start. */
2376 /* Make all the substitutions. */
2378 = substitute_object_recurse (object
, placeholder
, object
);
2380 /* Clear seen_list because we're done with it. */
2383 /* The returned object here is expected to always eq the
2385 if (!EQ (check_object
, object
))
2386 error ("Unexpected mutation error in reader");
2389 /* Feval doesn't get called from here, so no gc protection is needed. */
2390 #define SUBSTITUTE(get_val, set_val) \
2392 Lisp_Object old_value = get_val; \
2393 Lisp_Object true_value \
2394 = substitute_object_recurse (object, placeholder,\
2397 if (!EQ (old_value, true_value)) \
2404 substitute_object_recurse (object
, placeholder
, subtree
)
2406 Lisp_Object placeholder
;
2407 Lisp_Object subtree
;
2409 /* If we find the placeholder, return the target object. */
2410 if (EQ (placeholder
, subtree
))
2413 /* If we've been to this node before, don't explore it again. */
2414 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2417 /* If this node can be the entry point to a cycle, remember that
2418 we've seen it. It can only be such an entry point if it was made
2419 by #n=, which means that we can find it as a value in
2421 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2422 seen_list
= Fcons (subtree
, seen_list
);
2424 /* Recurse according to subtree's type.
2425 Every branch must return a Lisp_Object. */
2426 switch (XTYPE (subtree
))
2428 case Lisp_Vectorlike
:
2431 int length
= XINT (Flength(subtree
));
2432 for (i
= 0; i
< length
; i
++)
2434 Lisp_Object idx
= make_number (i
);
2435 SUBSTITUTE (Faref (subtree
, idx
),
2436 Faset (subtree
, idx
, true_value
));
2443 SUBSTITUTE (Fcar_safe (subtree
),
2444 Fsetcar (subtree
, true_value
));
2445 SUBSTITUTE (Fcdr_safe (subtree
),
2446 Fsetcdr (subtree
, true_value
));
2452 /* Check for text properties in each interval.
2453 substitute_in_interval contains part of the logic. */
2455 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2456 Lisp_Object arg
= Fcons (object
, placeholder
);
2458 traverse_intervals (root_interval
, 1, 0,
2459 &substitute_in_interval
, arg
);
2464 /* Other types don't recurse any further. */
2470 /* Helper function for substitute_object_recurse. */
2472 substitute_in_interval (interval
, arg
)
2476 Lisp_Object object
= Fcar (arg
);
2477 Lisp_Object placeholder
= Fcdr (arg
);
2479 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2498 if (*cp
== '+' || *cp
== '-')
2501 if (*cp
>= '0' && *cp
<= '9')
2504 while (*cp
>= '0' && *cp
<= '9')
2512 if (*cp
>= '0' && *cp
<= '9')
2515 while (*cp
>= '0' && *cp
<= '9')
2518 if (*cp
== 'e' || *cp
== 'E')
2522 if (*cp
== '+' || *cp
== '-')
2526 if (*cp
>= '0' && *cp
<= '9')
2529 while (*cp
>= '0' && *cp
<= '9')
2532 else if (cp
== start
)
2534 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2539 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2545 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2546 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2547 || state
== (DOT_CHAR
|TRAIL_INT
)
2548 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2549 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2550 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2555 read_vector (readcharfun
, bytecodeflag
)
2556 Lisp_Object readcharfun
;
2561 register Lisp_Object
*ptr
;
2562 register Lisp_Object tem
, item
, vector
;
2563 register struct Lisp_Cons
*otem
;
2566 tem
= read_list (1, readcharfun
);
2567 len
= Flength (tem
);
2568 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2570 size
= XVECTOR (vector
)->size
;
2571 ptr
= XVECTOR (vector
)->contents
;
2572 for (i
= 0; i
< size
; i
++)
2575 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2576 bytecode object, the docstring containing the bytecode and
2577 constants values must be treated as unibyte and passed to
2578 Fread, to get the actual bytecode string and constants vector. */
2579 if (bytecodeflag
&& load_force_doc_strings
)
2581 if (i
== COMPILED_BYTECODE
)
2583 if (!STRINGP (item
))
2584 error ("invalid byte code");
2586 /* Delay handling the bytecode slot until we know whether
2587 it is lazily-loaded (we can tell by whether the
2588 constants slot is nil). */
2589 ptr
[COMPILED_CONSTANTS
] = item
;
2592 else if (i
== COMPILED_CONSTANTS
)
2594 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2598 /* Coerce string to unibyte (like string-as-unibyte,
2599 but without generating extra garbage and
2600 guaranteeing no change in the contents). */
2601 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2602 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2604 item
= Fread (bytestr
);
2606 error ("invalid byte code");
2608 otem
= XCONS (item
);
2609 bytestr
= XCAR (item
);
2614 /* Now handle the bytecode slot. */
2615 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2618 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2626 /* FLAG = 1 means check for ] to terminate rather than ) and .
2627 FLAG = -1 means check for starting with defun
2628 and make structure pure. */
2631 read_list (flag
, readcharfun
)
2633 register Lisp_Object readcharfun
;
2635 /* -1 means check next element for defun,
2636 0 means don't check,
2637 1 means already checked and found defun. */
2638 int defunflag
= flag
< 0 ? -1 : 0;
2639 Lisp_Object val
, tail
;
2640 register Lisp_Object elt
, tem
;
2641 struct gcpro gcpro1
, gcpro2
;
2642 /* 0 is the normal case.
2643 1 means this list is a doc reference; replace it with the number 0.
2644 2 means this list is a doc reference; replace it with the doc string. */
2645 int doc_reference
= 0;
2647 /* Initialize this to 1 if we are reading a list. */
2648 int first_in_list
= flag
<= 0;
2657 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2662 /* While building, if the list starts with #$, treat it specially. */
2663 if (EQ (elt
, Vload_file_name
)
2665 && !NILP (Vpurify_flag
))
2667 if (NILP (Vdoc_file_name
))
2668 /* We have not yet called Snarf-documentation, so assume
2669 this file is described in the DOC-MM.NN file
2670 and Snarf-documentation will fill in the right value later.
2671 For now, replace the whole list with 0. */
2674 /* We have already called Snarf-documentation, so make a relative
2675 file name for this file, so it can be found properly
2676 in the installed Lisp directory.
2677 We don't use Fexpand_file_name because that would make
2678 the directory absolute now. */
2679 elt
= concat2 (build_string ("../lisp/"),
2680 Ffile_name_nondirectory (elt
));
2682 else if (EQ (elt
, Vload_file_name
)
2684 && load_force_doc_strings
)
2693 Fsignal (Qinvalid_read_syntax
,
2694 Fcons (make_string (") or . in a vector", 18), Qnil
));
2702 XCDR (tail
) = read0 (readcharfun
);
2704 val
= read0 (readcharfun
);
2705 read1 (readcharfun
, &ch
, 0);
2709 if (doc_reference
== 1)
2710 return make_number (0);
2711 if (doc_reference
== 2)
2713 /* Get a doc string from the file we are loading.
2714 If it's in saved_doc_string, get it from there. */
2715 int pos
= XINT (XCDR (val
));
2716 /* Position is negative for user variables. */
2717 if (pos
< 0) pos
= -pos
;
2718 if (pos
>= saved_doc_string_position
2719 && pos
< (saved_doc_string_position
2720 + saved_doc_string_length
))
2722 int start
= pos
- saved_doc_string_position
;
2725 /* Process quoting with ^A,
2726 and find the end of the string,
2727 which is marked with ^_ (037). */
2728 for (from
= start
, to
= start
;
2729 saved_doc_string
[from
] != 037;)
2731 int c
= saved_doc_string
[from
++];
2734 c
= saved_doc_string
[from
++];
2736 saved_doc_string
[to
++] = c
;
2738 saved_doc_string
[to
++] = 0;
2740 saved_doc_string
[to
++] = 037;
2743 saved_doc_string
[to
++] = c
;
2746 return make_string (saved_doc_string
+ start
,
2749 /* Look in prev_saved_doc_string the same way. */
2750 else if (pos
>= prev_saved_doc_string_position
2751 && pos
< (prev_saved_doc_string_position
2752 + prev_saved_doc_string_length
))
2754 int start
= pos
- prev_saved_doc_string_position
;
2757 /* Process quoting with ^A,
2758 and find the end of the string,
2759 which is marked with ^_ (037). */
2760 for (from
= start
, to
= start
;
2761 prev_saved_doc_string
[from
] != 037;)
2763 int c
= prev_saved_doc_string
[from
++];
2766 c
= prev_saved_doc_string
[from
++];
2768 prev_saved_doc_string
[to
++] = c
;
2770 prev_saved_doc_string
[to
++] = 0;
2772 prev_saved_doc_string
[to
++] = 037;
2775 prev_saved_doc_string
[to
++] = c
;
2778 return make_string (prev_saved_doc_string
+ start
,
2782 return get_doc_string (val
, 0, 0);
2787 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2789 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2791 tem
= (read_pure
&& flag
<= 0
2792 ? pure_cons (elt
, Qnil
)
2793 : Fcons (elt
, Qnil
));
2800 defunflag
= EQ (elt
, Qdefun
);
2801 else if (defunflag
> 0)
2806 Lisp_Object Vobarray
;
2807 Lisp_Object initial_obarray
;
2809 /* oblookup stores the bucket number here, for the sake of Funintern. */
2811 int oblookup_last_bucket_number
;
2813 static int hash_string ();
2814 Lisp_Object
oblookup ();
2816 /* Get an error if OBARRAY is not an obarray.
2817 If it is one, return it. */
2820 check_obarray (obarray
)
2821 Lisp_Object obarray
;
2823 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2825 /* If Vobarray is now invalid, force it to be valid. */
2826 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2828 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2833 /* Intern the C string STR: return a symbol with that name,
2834 interned in the current obarray. */
2841 int len
= strlen (str
);
2842 Lisp_Object obarray
;
2845 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2846 obarray
= check_obarray (obarray
);
2847 tem
= oblookup (obarray
, str
, len
, len
);
2850 return Fintern (make_string (str
, len
), obarray
);
2853 /* Create an uninterned symbol with name STR. */
2859 int len
= strlen (str
);
2861 return Fmake_symbol ((!NILP (Vpurify_flag
)
2862 ? make_pure_string (str
, len
, len
, 0)
2863 : make_string (str
, len
)));
2866 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2867 "Return the canonical symbol whose name is STRING.\n\
2868 If there is none, one is created by this function and returned.\n\
2869 A second optional argument specifies the obarray to use;\n\
2870 it defaults to the value of `obarray'.")
2872 Lisp_Object string
, obarray
;
2874 register Lisp_Object tem
, sym
, *ptr
;
2876 if (NILP (obarray
)) obarray
= Vobarray
;
2877 obarray
= check_obarray (obarray
);
2879 CHECK_STRING (string
, 0);
2881 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2882 XSTRING (string
)->size
,
2883 STRING_BYTES (XSTRING (string
)));
2884 if (!INTEGERP (tem
))
2887 if (!NILP (Vpurify_flag
))
2888 string
= Fpurecopy (string
);
2889 sym
= Fmake_symbol (string
);
2890 XSYMBOL (sym
)->obarray
= obarray
;
2892 if ((XSTRING (string
)->data
[0] == ':')
2893 && EQ (obarray
, initial_obarray
))
2894 XSYMBOL (sym
)->value
= sym
;
2896 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2898 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2900 XSYMBOL (sym
)->next
= 0;
2905 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2906 "Return the canonical symbol named NAME, or nil if none exists.\n\
2907 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2908 symbol is searched for.\n\
2909 A second optional argument specifies the obarray to use;\n\
2910 it defaults to the value of `obarray'.")
2912 Lisp_Object name
, obarray
;
2914 register Lisp_Object tem
;
2915 struct Lisp_String
*string
;
2917 if (NILP (obarray
)) obarray
= Vobarray
;
2918 obarray
= check_obarray (obarray
);
2920 if (!SYMBOLP (name
))
2922 CHECK_STRING (name
, 0);
2923 string
= XSTRING (name
);
2926 string
= XSYMBOL (name
)->name
;
2928 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2929 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2935 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2936 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2937 The value is t if a symbol was found and deleted, nil otherwise.\n\
2938 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2939 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2940 OBARRAY defaults to the value of the variable `obarray'.")
2942 Lisp_Object name
, obarray
;
2944 register Lisp_Object string
, tem
;
2947 if (NILP (obarray
)) obarray
= Vobarray
;
2948 obarray
= check_obarray (obarray
);
2951 XSETSTRING (string
, XSYMBOL (name
)->name
);
2954 CHECK_STRING (name
, 0);
2958 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2959 XSTRING (string
)->size
,
2960 STRING_BYTES (XSTRING (string
)));
2963 /* If arg was a symbol, don't delete anything but that symbol itself. */
2964 if (SYMBOLP (name
) && !EQ (name
, tem
))
2967 XSYMBOL (tem
)->obarray
= Qnil
;
2969 hash
= oblookup_last_bucket_number
;
2971 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2973 if (XSYMBOL (tem
)->next
)
2974 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2976 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2980 Lisp_Object tail
, following
;
2982 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2983 XSYMBOL (tail
)->next
;
2986 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2987 if (EQ (following
, tem
))
2989 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2998 /* Return the symbol in OBARRAY whose names matches the string
2999 of SIZE characters (SIZE_BYTE bytes) at PTR.
3000 If there is no such symbol in OBARRAY, return nil.
3002 Also store the bucket number in oblookup_last_bucket_number. */
3005 oblookup (obarray
, ptr
, size
, size_byte
)
3006 Lisp_Object obarray
;
3008 int size
, size_byte
;
3012 register Lisp_Object tail
;
3013 Lisp_Object bucket
, tem
;
3015 if (!VECTORP (obarray
)
3016 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3018 obarray
= check_obarray (obarray
);
3019 obsize
= XVECTOR (obarray
)->size
;
3021 /* This is sometimes needed in the middle of GC. */
3022 obsize
&= ~ARRAY_MARK_FLAG
;
3023 /* Combining next two lines breaks VMS C 2.3. */
3024 hash
= hash_string (ptr
, size_byte
);
3026 bucket
= XVECTOR (obarray
)->contents
[hash
];
3027 oblookup_last_bucket_number
= hash
;
3028 if (XFASTINT (bucket
) == 0)
3030 else if (!SYMBOLP (bucket
))
3031 error ("Bad data in guts of obarray"); /* Like CADR error message */
3033 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3035 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3036 && XSYMBOL (tail
)->name
->size
== size
3037 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3039 else if (XSYMBOL (tail
)->next
== 0)
3042 XSETINT (tem
, hash
);
3047 hash_string (ptr
, len
)
3051 register unsigned char *p
= ptr
;
3052 register unsigned char *end
= p
+ len
;
3053 register unsigned char c
;
3054 register int hash
= 0;
3059 if (c
>= 0140) c
-= 40;
3060 hash
= ((hash
<<3) + (hash
>>28) + c
);
3062 return hash
& 07777777777;
3066 map_obarray (obarray
, fn
, arg
)
3067 Lisp_Object obarray
;
3068 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3072 register Lisp_Object tail
;
3073 CHECK_VECTOR (obarray
, 1);
3074 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3076 tail
= XVECTOR (obarray
)->contents
[i
];
3081 if (XSYMBOL (tail
)->next
== 0)
3083 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3089 mapatoms_1 (sym
, function
)
3090 Lisp_Object sym
, function
;
3092 call1 (function
, sym
);
3095 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3096 "Call FUNCTION on every symbol in OBARRAY.\n\
3097 OBARRAY defaults to the value of `obarray'.")
3099 Lisp_Object function
, obarray
;
3101 if (NILP (obarray
)) obarray
= Vobarray
;
3102 obarray
= check_obarray (obarray
);
3104 map_obarray (obarray
, mapatoms_1
, function
);
3108 #define OBARRAY_SIZE 1511
3113 Lisp_Object oblength
;
3117 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3119 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3120 Vobarray
= Fmake_vector (oblength
, make_number (0));
3121 initial_obarray
= Vobarray
;
3122 staticpro (&initial_obarray
);
3123 /* Intern nil in the obarray */
3124 XSYMBOL (Qnil
)->obarray
= Vobarray
;
3125 /* These locals are to kludge around a pyramid compiler bug. */
3126 hash
= hash_string ("nil", 3);
3127 /* Separate statement here to avoid VAXC bug. */
3128 hash
%= OBARRAY_SIZE
;
3129 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3132 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3133 XSYMBOL (Qnil
)->function
= Qunbound
;
3134 XSYMBOL (Qunbound
)->value
= Qunbound
;
3135 XSYMBOL (Qunbound
)->function
= Qunbound
;
3138 XSYMBOL (Qnil
)->value
= Qnil
;
3139 XSYMBOL (Qnil
)->plist
= Qnil
;
3140 XSYMBOL (Qt
)->value
= Qt
;
3142 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3145 Qvariable_documentation
= intern ("variable-documentation");
3146 staticpro (&Qvariable_documentation
);
3148 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3149 read_buffer
= (char *) xmalloc (read_buffer_size
);
3154 struct Lisp_Subr
*sname
;
3157 sym
= intern (sname
->symbol_name
);
3158 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3161 #ifdef NOTDEF /* use fset in subr.el now */
3163 defalias (sname
, string
)
3164 struct Lisp_Subr
*sname
;
3168 sym
= intern (string
);
3169 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3173 /* Define an "integer variable"; a symbol whose value is forwarded
3174 to a C variable of type int. Sample call: */
3175 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3177 defvar_int (namestring
, address
)
3181 Lisp_Object sym
, val
;
3182 sym
= intern (namestring
);
3183 val
= allocate_misc ();
3184 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3185 XINTFWD (val
)->intvar
= address
;
3186 XSYMBOL (sym
)->value
= val
;
3189 /* Similar but define a variable whose value is T if address contains 1,
3190 NIL if address contains 0 */
3192 defvar_bool (namestring
, address
)
3196 Lisp_Object sym
, val
;
3197 sym
= intern (namestring
);
3198 val
= allocate_misc ();
3199 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3200 XBOOLFWD (val
)->boolvar
= address
;
3201 XSYMBOL (sym
)->value
= val
;
3202 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3205 /* Similar but define a variable whose value is the Lisp Object stored
3206 at address. Two versions: with and without gc-marking of the C
3207 variable. The nopro version is used when that variable will be
3208 gc-marked for some other reason, since marking the same slot twice
3209 can cause trouble with strings. */
3211 defvar_lisp_nopro (namestring
, address
)
3213 Lisp_Object
*address
;
3215 Lisp_Object sym
, val
;
3216 sym
= intern (namestring
);
3217 val
= allocate_misc ();
3218 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3219 XOBJFWD (val
)->objvar
= address
;
3220 XSYMBOL (sym
)->value
= val
;
3224 defvar_lisp (namestring
, address
)
3226 Lisp_Object
*address
;
3228 defvar_lisp_nopro (namestring
, address
);
3229 staticpro (address
);
3232 /* Similar but define a variable whose value is the Lisp Object stored in
3233 the current buffer. address is the address of the slot in the buffer
3234 that is current now. */
3237 defvar_per_buffer (namestring
, address
, type
, doc
)
3239 Lisp_Object
*address
;
3243 Lisp_Object sym
, val
;
3245 extern struct buffer buffer_local_symbols
;
3247 sym
= intern (namestring
);
3248 val
= allocate_misc ();
3249 offset
= (char *)address
- (char *)current_buffer
;
3251 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3252 XBUFFER_OBJFWD (val
)->offset
= offset
;
3253 XSYMBOL (sym
)->value
= val
;
3254 PER_BUFFER_SYMBOL (offset
) = sym
;
3255 PER_BUFFER_TYPE (offset
) = type
;
3257 if (PER_BUFFER_IDX (offset
) == 0)
3258 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3259 slot of buffer_local_flags */
3264 /* Similar but define a variable whose value is the Lisp Object stored
3265 at a particular offset in the current kboard object. */
3268 defvar_kboard (namestring
, offset
)
3272 Lisp_Object sym
, val
;
3273 sym
= intern (namestring
);
3274 val
= allocate_misc ();
3275 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3276 XKBOARD_OBJFWD (val
)->offset
= offset
;
3277 XSYMBOL (sym
)->value
= val
;
3280 /* Record the value of load-path used at the start of dumping
3281 so we can see if the site changed it later during dumping. */
3282 static Lisp_Object dump_path
;
3288 int turn_off_warning
= 0;
3290 /* Compute the default load-path. */
3292 normal
= PATH_LOADSEARCH
;
3293 Vload_path
= decode_env_path (0, normal
);
3295 if (NILP (Vpurify_flag
))
3296 normal
= PATH_LOADSEARCH
;
3298 normal
= PATH_DUMPLOADSEARCH
;
3300 /* In a dumped Emacs, we normally have to reset the value of
3301 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3302 uses ../lisp, instead of the path of the installed elisp
3303 libraries. However, if it appears that Vload_path was changed
3304 from the default before dumping, don't override that value. */
3307 if (! NILP (Fequal (dump_path
, Vload_path
)))
3309 Vload_path
= decode_env_path (0, normal
);
3310 if (!NILP (Vinstallation_directory
))
3312 /* Add to the path the lisp subdir of the
3313 installation dir, if it exists. */
3314 Lisp_Object tem
, tem1
;
3315 tem
= Fexpand_file_name (build_string ("lisp"),
3316 Vinstallation_directory
);
3317 tem1
= Ffile_exists_p (tem
);
3320 if (NILP (Fmember (tem
, Vload_path
)))
3322 turn_off_warning
= 1;
3323 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3327 /* That dir doesn't exist, so add the build-time
3328 Lisp dirs instead. */
3329 Vload_path
= nconc2 (Vload_path
, dump_path
);
3331 /* Add leim under the installation dir, if it exists. */
3332 tem
= Fexpand_file_name (build_string ("leim"),
3333 Vinstallation_directory
);
3334 tem1
= Ffile_exists_p (tem
);
3337 if (NILP (Fmember (tem
, Vload_path
)))
3338 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3341 /* Add site-list under the installation dir, if it exists. */
3342 tem
= Fexpand_file_name (build_string ("site-lisp"),
3343 Vinstallation_directory
);
3344 tem1
= Ffile_exists_p (tem
);
3347 if (NILP (Fmember (tem
, Vload_path
)))
3348 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3351 /* If Emacs was not built in the source directory,
3352 and it is run from where it was built, add to load-path
3353 the lisp, leim and site-lisp dirs under that directory. */
3355 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3359 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3360 Vinstallation_directory
);
3361 tem1
= Ffile_exists_p (tem
);
3363 /* Don't be fooled if they moved the entire source tree
3364 AFTER dumping Emacs. If the build directory is indeed
3365 different from the source dir, src/Makefile.in and
3366 src/Makefile will not be found together. */
3367 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3368 Vinstallation_directory
);
3369 tem2
= Ffile_exists_p (tem
);
3370 if (!NILP (tem1
) && NILP (tem2
))
3372 tem
= Fexpand_file_name (build_string ("lisp"),
3375 if (NILP (Fmember (tem
, Vload_path
)))
3376 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3378 tem
= Fexpand_file_name (build_string ("leim"),
3381 if (NILP (Fmember (tem
, Vload_path
)))
3382 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3384 tem
= Fexpand_file_name (build_string ("site-lisp"),
3387 if (NILP (Fmember (tem
, Vload_path
)))
3388 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3396 /* NORMAL refers to the lisp dir in the source directory. */
3397 /* We used to add ../lisp at the front here, but
3398 that caused trouble because it was copied from dump_path
3399 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3400 It should be unnecessary. */
3401 Vload_path
= decode_env_path (0, normal
);
3402 dump_path
= Vload_path
;
3407 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3408 almost never correct, thereby causing a warning to be printed out that
3409 confuses users. Since PATH_LOADSEARCH is always overridden by the
3410 EMACSLOADPATH environment variable below, disable the warning on NT. */
3412 /* Warn if dirs in the *standard* path don't exist. */
3413 if (!turn_off_warning
)
3415 Lisp_Object path_tail
;
3417 for (path_tail
= Vload_path
;
3419 path_tail
= XCDR (path_tail
))
3421 Lisp_Object dirfile
;
3422 dirfile
= Fcar (path_tail
);
3423 if (STRINGP (dirfile
))
3425 dirfile
= Fdirectory_file_name (dirfile
);
3426 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3427 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3432 #endif /* WINDOWSNT */
3434 /* If the EMACSLOADPATH environment variable is set, use its value.
3435 This doesn't apply if we're dumping. */
3437 if (NILP (Vpurify_flag
)
3438 && egetenv ("EMACSLOADPATH"))
3440 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3444 load_in_progress
= 0;
3445 Vload_file_name
= Qnil
;
3447 load_descriptor_list
= Qnil
;
3449 Vstandard_input
= Qt
;
3450 Vloads_in_progress
= Qnil
;
3453 /* Print a warning, using format string FORMAT, that directory DIRNAME
3454 does not exist. Print it on stderr and put it in *Message*. */
3457 dir_warning (format
, dirname
)
3459 Lisp_Object dirname
;
3462 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3464 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3465 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3466 /* Don't log the warning before we've initialized!! */
3468 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3475 defsubr (&Sread_from_string
);
3477 defsubr (&Sintern_soft
);
3478 defsubr (&Sunintern
);
3480 defsubr (&Seval_buffer
);
3481 defsubr (&Seval_region
);
3482 defsubr (&Sread_char
);
3483 defsubr (&Sread_char_exclusive
);
3484 defsubr (&Sread_event
);
3485 defsubr (&Sget_file_char
);
3486 defsubr (&Smapatoms
);
3488 DEFVAR_LISP ("obarray", &Vobarray
,
3489 "Symbol table for use by `intern' and `read'.\n\
3490 It is a vector whose length ought to be prime for best results.\n\
3491 The vector's contents don't make sense if examined from Lisp programs;\n\
3492 to find all the symbols in an obarray, use `mapatoms'.");
3494 DEFVAR_LISP ("values", &Vvalues
,
3495 "List of values of all expressions which were read, evaluated and printed.\n\
3496 Order is reverse chronological.");
3498 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3499 "Stream for read to get input from.\n\
3500 See documentation of `read' for possible values.");
3501 Vstandard_input
= Qt
;
3503 DEFVAR_LISP ("load-path", &Vload_path
,
3504 "*List of directories to search for files to load.\n\
3505 Each element is a string (directory name) or nil (try default directory).\n\
3506 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3507 otherwise to default specified by file `epaths.h' when Emacs was built.");
3509 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3510 "Non-nil iff inside of `load'.");
3512 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3513 "An alist of expressions to be evalled when particular files are loaded.\n\
3514 Each element looks like (FILENAME FORMS...).\n\
3515 When `load' is run and the file-name argument is FILENAME,\n\
3516 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3517 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3518 with no directory specified, since that is how `load' is normally called.\n\
3519 An error in FORMS does not undo the load,\n\
3520 but does prevent execution of the rest of the FORMS.");
3521 Vafter_load_alist
= Qnil
;
3523 DEFVAR_LISP ("load-history", &Vload_history
,
3524 "Alist mapping source file names to symbols and features.\n\
3525 Each alist element is a list that starts with a file name,\n\
3526 except for one element (optional) that starts with nil and describes\n\
3527 definitions evaluated from buffers not visiting files.\n\
3528 The remaining elements of each list are symbols defined as functions\n\
3529 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
3530 and `(autoload . SYMBOL)'.");
3531 Vload_history
= Qnil
;
3533 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3534 "Full name of file being loaded by `load'.");
3535 Vload_file_name
= Qnil
;
3537 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3538 "File name, including directory, of user's initialization file.\n\
3539 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3540 file, this variable contains the name of the .el file, suitable for use\n\
3541 by functions like `custom-save-all' which edit the init file.");
3542 Vuser_init_file
= Qnil
;
3544 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3545 "Used for internal purposes by `load'.");
3546 Vcurrent_load_list
= Qnil
;
3548 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3549 "Function used by `load' and `eval-region' for reading expressions.\n\
3550 The default is nil, which means use the function `read'.");
3551 Vload_read_function
= Qnil
;
3553 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3554 "Function called in `load' for loading an Emacs lisp source file.\n\
3555 This function is for doing code conversion before reading the source file.\n\
3556 If nil, loading is done without any code conversion.\n\
3557 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3558 FULLNAME is the full name of FILE.\n\
3559 See `load' for the meaning of the remaining arguments.");
3560 Vload_source_file_function
= Qnil
;
3562 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3563 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3564 This is useful when the file being loaded is a temporary copy.");
3565 load_force_doc_strings
= 0;
3567 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3568 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3569 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3570 and is not meant for users to change.");
3571 load_convert_to_unibyte
= 0;
3573 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3574 "Directory in which Emacs sources were found when Emacs was built.\n\
3575 You cannot count on them to still be there!");
3577 = Fexpand_file_name (build_string ("../"),
3578 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3580 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3581 "List of files that were preloaded (when dumping Emacs).");
3582 Vpreloaded_file_list
= Qnil
;
3584 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3585 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3586 Vbyte_boolean_vars
= Qnil
;
3588 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3589 "Non-nil means load dangerous compiled Lisp files.\n\
3590 Some versions of XEmacs use different byte codes than Emacs. These\n\
3591 incompatible byte codes can make Emacs crash when it tries to execute\n\
3593 load_dangerous_libraries
= 0;
3595 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3596 "Regular expression matching safe to load compiled Lisp files.\n\
3597 When Emacs loads a compiled Lisp file, it reads the first 512 bytes\n\
3598 from the file, and matches them against this regular expression.\n\
3599 When the regular expression matches, the file is considered to be safe\n\
3600 to load. See also `load-dangerous-libraries'.");
3601 Vbytecomp_version_regexp
3602 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3604 DEFVAR_LISP ("recursive-load-depth-limit", &Vrecursive_load_depth_limit
,
3605 "Limit for depth of recursive loads.\n\
3606 Value should be either an integer > 0 specifying the limit, or nil for\n\
3608 Vrecursive_load_depth_limit
= make_number (10);
3610 /* Vsource_directory was initialized in init_lread. */
3612 load_descriptor_list
= Qnil
;
3613 staticpro (&load_descriptor_list
);
3615 Qcurrent_load_list
= intern ("current-load-list");
3616 staticpro (&Qcurrent_load_list
);
3618 Qstandard_input
= intern ("standard-input");
3619 staticpro (&Qstandard_input
);
3621 Qread_char
= intern ("read-char");
3622 staticpro (&Qread_char
);
3624 Qget_file_char
= intern ("get-file-char");
3625 staticpro (&Qget_file_char
);
3627 Qbackquote
= intern ("`");
3628 staticpro (&Qbackquote
);
3629 Qcomma
= intern (",");
3630 staticpro (&Qcomma
);
3631 Qcomma_at
= intern (",@");
3632 staticpro (&Qcomma_at
);
3633 Qcomma_dot
= intern (",.");
3634 staticpro (&Qcomma_dot
);
3636 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3637 staticpro (&Qinhibit_file_name_operation
);
3639 Qascii_character
= intern ("ascii-character");
3640 staticpro (&Qascii_character
);
3642 Qfunction
= intern ("function");
3643 staticpro (&Qfunction
);
3645 Qload
= intern ("load");
3648 Qload_file_name
= intern ("load-file-name");
3649 staticpro (&Qload_file_name
);
3651 staticpro (&dump_path
);
3653 staticpro (&read_objects
);
3654 read_objects
= Qnil
;
3655 staticpro (&seen_list
);
3657 Vloads_in_progress
= Qnil
;
3658 staticpro (&Vloads_in_progress
);