1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
36 #include "termhooks.h"
39 #include <sys/inode.h>
44 #include <unistd.h> /* to get X_OK */
61 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
79 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
80 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
81 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
82 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
83 Lisp_Object Qinhibit_file_name_operation
;
85 extern Lisp_Object Qevent_symbol_element_mask
;
86 extern Lisp_Object Qfile_exists_p
;
88 /* non-zero if inside `load' */
91 /* Directory in which the sources were found. */
92 Lisp_Object Vsource_directory
;
94 /* Search path and suffixes for files to be loaded. */
95 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
97 /* File name of user's init file. */
98 Lisp_Object Vuser_init_file
;
100 /* This is the user-visible association list that maps features to
101 lists of defs in their load files. */
102 Lisp_Object Vload_history
;
104 /* This is used to build the load history. */
105 Lisp_Object Vcurrent_load_list
;
107 /* List of files that were preloaded. */
108 Lisp_Object Vpreloaded_file_list
;
110 /* Name of file actually being read by `load'. */
111 Lisp_Object Vload_file_name
;
113 /* Function to use for reading, in `load' and friends. */
114 Lisp_Object Vload_read_function
;
116 /* The association list of objects read with the #n=object form.
117 Each member of the list has the form (n . object), and is used to
118 look up the object for the corresponding #n# construct.
119 It must be set to nil before all top-level calls to read0. */
120 Lisp_Object read_objects
;
122 /* Nonzero means load should forcibly load all dynamic doc strings. */
123 static int load_force_doc_strings
;
125 /* Nonzero means read should convert strings to unibyte. */
126 static int load_convert_to_unibyte
;
128 /* Function to use for loading an Emacs lisp source file (not
129 compiled) instead of readevalloop. */
130 Lisp_Object Vload_source_file_function
;
132 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
133 Lisp_Object Vbyte_boolean_vars
;
135 /* List of descriptors now open for Fload. */
136 static Lisp_Object load_descriptor_list
;
138 /* File for get_file_char to read from. Use by load. */
139 static FILE *instream
;
141 /* When nonzero, read conses in pure space */
142 static int read_pure
;
144 /* For use within read-from-string (this reader is non-reentrant!!) */
145 static int read_from_string_index
;
146 static int read_from_string_index_byte
;
147 static int read_from_string_limit
;
149 /* Number of bytes left to read in the buffer character
150 that `readchar' has already advanced over. */
151 static int readchar_backlog
;
153 /* This contains the last string skipped with #@. */
154 static char *saved_doc_string
;
155 /* Length of buffer allocated in saved_doc_string. */
156 static int saved_doc_string_size
;
157 /* Length of actual data in saved_doc_string. */
158 static int saved_doc_string_length
;
159 /* This is the file position that string came from. */
160 static file_offset saved_doc_string_position
;
162 /* This contains the previous string skipped with #@.
163 We copy it from saved_doc_string when a new string
164 is put in saved_doc_string. */
165 static char *prev_saved_doc_string
;
166 /* Length of buffer allocated in prev_saved_doc_string. */
167 static int prev_saved_doc_string_size
;
168 /* Length of actual data in prev_saved_doc_string. */
169 static int prev_saved_doc_string_length
;
170 /* This is the file position that string came from. */
171 static file_offset prev_saved_doc_string_position
;
173 /* Nonzero means inside a new-style backquote
174 with no surrounding parentheses.
175 Fread initializes this to zero, so we need not specbind it
176 or worry about what happens to it when there is an error. */
177 static int new_backquote_flag
;
179 /* A list of file names for files being loaded in Fload. Used to
180 check for recursive loads. */
182 static Lisp_Object Vloads_in_progress
;
184 /* Limit of the depth of recursive loads. */
186 Lisp_Object Vrecursive_load_depth_limit
;
188 /* Non-zero means load dangerous compiled Lisp files. */
190 int load_dangerous_libraries
;
192 /* A regular expression used to detect files compiled with Emacs. */
194 static Lisp_Object Vbytecomp_version_regexp
;
196 static void to_multibyte
P_ ((char **, char **, int *));
197 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
198 Lisp_Object (*) (), int,
199 Lisp_Object
, Lisp_Object
));
200 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
201 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
204 /* Handle unreading and rereading of characters.
205 Write READCHAR to read a character,
206 UNREAD(c) to unread c to be read again.
208 These macros actually read/unread a byte code, multibyte characters
209 are not handled here. The caller should manage them if necessary.
212 #define READCHAR readchar (readcharfun)
213 #define UNREAD(c) unreadchar (readcharfun, c)
216 readchar (readcharfun
)
217 Lisp_Object readcharfun
;
222 if (BUFFERP (readcharfun
))
224 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
226 int pt_byte
= BUF_PT_BYTE (inbuffer
);
227 int orig_pt_byte
= pt_byte
;
229 if (readchar_backlog
> 0)
230 /* We get the address of the byte just passed,
231 which is the last byte of the character.
232 The other bytes in this character are consecutive with it,
233 because the gap can't be in the middle of a character. */
234 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
235 - --readchar_backlog
);
237 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
240 readchar_backlog
= -1;
242 if (! NILP (inbuffer
->enable_multibyte_characters
))
244 /* Fetch the character code from the buffer. */
245 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
246 BUF_INC_POS (inbuffer
, pt_byte
);
247 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
251 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
254 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
258 if (MARKERP (readcharfun
))
260 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
262 int bytepos
= marker_byte_position (readcharfun
);
263 int orig_bytepos
= bytepos
;
265 if (readchar_backlog
> 0)
266 /* We get the address of the byte just passed,
267 which is the last byte of the character.
268 The other bytes in this character are consecutive with it,
269 because the gap can't be in the middle of a character. */
270 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
271 - --readchar_backlog
);
273 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
276 readchar_backlog
= -1;
278 if (! NILP (inbuffer
->enable_multibyte_characters
))
280 /* Fetch the character code from the buffer. */
281 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
282 BUF_INC_POS (inbuffer
, bytepos
);
283 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
287 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
291 XMARKER (readcharfun
)->bytepos
= bytepos
;
292 XMARKER (readcharfun
)->charpos
++;
297 if (EQ (readcharfun
, Qlambda
))
298 return read_bytecode_char (0);
300 if (EQ (readcharfun
, Qget_file_char
))
304 /* Interrupted reads have been observed while reading over the network */
305 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
314 if (STRINGP (readcharfun
))
316 if (read_from_string_index
>= read_from_string_limit
)
319 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
320 read_from_string_index
,
321 read_from_string_index_byte
);
326 tem
= call0 (readcharfun
);
333 /* Unread the character C in the way appropriate for the stream READCHARFUN.
334 If the stream is a user function, call it with the char as argument. */
337 unreadchar (readcharfun
, c
)
338 Lisp_Object readcharfun
;
342 /* Don't back up the pointer if we're unreading the end-of-input mark,
343 since readchar didn't advance it when we read it. */
345 else if (BUFFERP (readcharfun
))
347 struct buffer
*b
= XBUFFER (readcharfun
);
348 int bytepos
= BUF_PT_BYTE (b
);
350 if (readchar_backlog
>= 0)
355 if (! NILP (b
->enable_multibyte_characters
))
356 BUF_DEC_POS (b
, bytepos
);
360 BUF_PT_BYTE (b
) = bytepos
;
363 else if (MARKERP (readcharfun
))
365 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
366 int bytepos
= XMARKER (readcharfun
)->bytepos
;
368 if (readchar_backlog
>= 0)
372 XMARKER (readcharfun
)->charpos
--;
373 if (! NILP (b
->enable_multibyte_characters
))
374 BUF_DEC_POS (b
, bytepos
);
378 XMARKER (readcharfun
)->bytepos
= bytepos
;
381 else if (STRINGP (readcharfun
))
383 read_from_string_index
--;
384 read_from_string_index_byte
385 = string_char_to_byte (readcharfun
, read_from_string_index
);
387 else if (EQ (readcharfun
, Qlambda
))
388 read_bytecode_char (1);
389 else if (EQ (readcharfun
, Qget_file_char
))
390 ungetc (c
, instream
);
392 call1 (readcharfun
, make_number (c
));
395 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
396 static int read_multibyte ();
397 static Lisp_Object
substitute_object_recurse ();
398 static void substitute_object_in_subtree (), substitute_in_interval ();
401 /* Get a character from the tty. */
403 extern Lisp_Object
read_char ();
405 /* Read input events until we get one that's acceptable for our purposes.
407 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
408 until we get a character we like, and then stuffed into
411 If ASCII_REQUIRED is non-zero, we check function key events to see
412 if the unmodified version of the symbol has a Qascii_character
413 property, and use that character, if present.
415 If ERROR_NONASCII is non-zero, we signal an error if the input we
416 get isn't an ASCII character with modifiers. If it's zero but
417 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
420 If INPUT_METHOD is nonzero, we invoke the current input method
421 if the character warrants that. */
424 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
426 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
428 register Lisp_Object val
, delayed_switch_frame
;
430 #ifdef HAVE_WINDOW_SYSTEM
431 if (display_hourglass_p
)
435 delayed_switch_frame
= Qnil
;
437 /* Read until we get an acceptable event. */
439 val
= read_char (0, 0, 0,
440 (input_method
? Qnil
: Qt
),
446 /* switch-frame events are put off until after the next ASCII
447 character. This is better than signaling an error just because
448 the last characters were typed to a separate minibuffer frame,
449 for example. Eventually, some code which can deal with
450 switch-frame events will read it and process it. */
452 && EVENT_HAS_PARAMETERS (val
)
453 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
455 delayed_switch_frame
= val
;
461 /* Convert certain symbols to their ASCII equivalents. */
464 Lisp_Object tem
, tem1
;
465 tem
= Fget (val
, Qevent_symbol_element_mask
);
468 tem1
= Fget (Fcar (tem
), Qascii_character
);
469 /* Merge this symbol's modifier bits
470 with the ASCII equivalent of its basic code. */
472 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
476 /* If we don't have a character now, deal with it appropriately. */
481 Vunread_command_events
= Fcons (val
, Qnil
);
482 error ("Non-character input-event");
489 if (! NILP (delayed_switch_frame
))
490 unread_switch_frame
= delayed_switch_frame
;
492 #ifdef HAVE_WINDOW_SYSTEM
493 if (display_hourglass_p
)
499 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
500 "Read a character from the command input (keyboard or macro).\n\
501 It is returned as a number.\n\
502 If the user generates an event which is not a character (i.e. a mouse\n\
503 click or function key event), `read-char' signals an error. As an\n\
504 exception, switch-frame events are put off until non-ASCII events can\n\
506 If you want to read non-character events, or ignore them, call\n\
507 `read-event' or `read-char-exclusive' instead.\n\
509 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
510 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
511 input method is turned on in the current buffer, that input method\n\
512 is used for reading a character.")
513 (prompt
, inherit_input_method
)
514 Lisp_Object prompt
, inherit_input_method
;
517 message_with_string ("%s", prompt
, 0);
518 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
521 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
522 "Read an event object from the input stream.\n\
523 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
524 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
525 input method is turned on in the current buffer, that input method\n\
526 is used for reading a character.")
527 (prompt
, inherit_input_method
)
528 Lisp_Object prompt
, inherit_input_method
;
531 message_with_string ("%s", prompt
, 0);
532 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
535 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
536 "Read a character from the command input (keyboard or macro).\n\
537 It is returned as a number. Non-character events are ignored.\n\
539 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
540 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
541 input method is turned on in the current buffer, that input method\n\
542 is used for reading a character.")
543 (prompt
, inherit_input_method
)
544 Lisp_Object prompt
, inherit_input_method
;
547 message_with_string ("%s", prompt
, 0);
548 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
551 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
552 "Don't use this yourself.")
555 register Lisp_Object val
;
556 XSETINT (val
, getc (instream
));
562 /* Value is non-zero if the file asswociated with file descriptor FD
563 is a compiled Lisp file that's safe to load. Only files compiled
564 with Emacs are safe to load. Files compiled with XEmacs can lead
565 to a crash in Fbyte_code because of an incompatible change in the
576 /* Read the first few bytes from the file, and look for a line
577 specifying the byte compiler version used. */
578 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
583 /* Skip to the next newline, skipping over the initial `ELC'
584 with NUL bytes following it. */
585 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
589 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
594 lseek (fd
, 0, SEEK_SET
);
599 /* Callback for record_unwind_protect. Restore the old load list OLD,
600 after loading a file successfully. */
603 record_load_unwind (old
)
606 return Vloads_in_progress
= old
;
610 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
611 "Execute a file of Lisp code named FILE.\n\
612 First try FILE with `.elc' appended, then try with `.el',\n\
613 then try FILE unmodified. Environment variable references in FILE\n\
614 are replaced with their values by calling `substitute-in-file-name'.\n\
615 This function searches the directories in `load-path'.\n\
616 If optional second arg NOERROR is non-nil,\n\
617 report no error if FILE doesn't exist.\n\
618 Print messages at start and end of loading unless\n\
619 optional third arg NOMESSAGE is non-nil.\n\
620 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
621 suffixes `.elc' or `.el' to the specified name FILE.\n\
622 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
623 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
624 it ends in one of those suffixes or includes a directory name.\n\
625 Return t if file exists.")
626 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
627 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
629 register FILE *stream
;
630 register int fd
= -1;
631 register Lisp_Object lispstream
;
632 int count
= specpdl_ptr
- specpdl
;
636 /* 1 means we printed the ".el is newer" message. */
638 /* 1 means we are loading a compiled file. */
649 /* If file name is magic, call the handler. */
650 /* This shouldn't be necessary any more now that `openp' handles it right.
651 handler = Ffind_file_name_handler (file, Qload);
653 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
655 /* Do this after the handler to avoid
656 the need to gcpro noerror, nomessage and nosuffix.
657 (Below here, we care only whether they are nil or not.)
658 The presence of this call is the result of a historical accident:
659 it used to be in every file-operations and when it got removed
660 everywhere, it accidentally stayed here. Since then, enough people
661 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
662 that it seemed risky to remove. */
663 file
= Fsubstitute_in_file_name (file
);
665 /* Avoid weird lossage with null string as arg,
666 since it would try to load a directory as a Lisp file */
667 if (XSTRING (file
)->size
> 0)
669 int size
= STRING_BYTES (XSTRING (file
));
674 if (! NILP (must_suffix
))
676 /* Don't insist on adding a suffix if FILE already ends with one. */
678 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
681 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
683 /* Don't insist on adding a suffix
684 if the argument includes a directory name. */
685 else if (! NILP (Ffile_name_directory (file
)))
689 fd
= openp (Vload_path
, file
,
690 (!NILP (nosuffix
) ? Qnil
691 : !NILP (must_suffix
) ? Vload_suffixes
692 : Fappend (2, (tmp
[0] = Vload_suffixes
,
693 tmp
[1] = default_suffixes
,
703 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
704 Fcons (file
, Qnil
)));
709 /* Tell startup.el whether or not we found the user's init file. */
710 if (EQ (Qt
, Vuser_init_file
))
711 Vuser_init_file
= found
;
713 /* If FD is -2, that means openp found a magic file. */
716 if (NILP (Fequal (found
, file
)))
717 /* If FOUND is a different file name from FILE,
718 find its handler even if we have already inhibited
719 the `load' operation on FILE. */
720 handler
= Ffind_file_name_handler (found
, Qt
);
722 handler
= Ffind_file_name_handler (found
, Qload
);
723 if (! NILP (handler
))
724 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
727 /* Check if we're stuck in a recursive load cycle.
729 2000-09-21: It's not possible to just check for the file loaded
730 being a member of Vloads_in_progress. This fails because of the
731 way the byte compiler currently works; `provide's are not
732 evaluted, see font-lock.el/jit-lock.el as an example. This
733 leads to a certain amount of ``normal'' recursion.
735 Also, just loading a file recursively is not always an error in
736 the general case; the second load may do something different. */
737 if (INTEGERP (Vrecursive_load_depth_limit
)
738 && XINT (Vrecursive_load_depth_limit
) > 0)
740 Lisp_Object len
= Flength (Vloads_in_progress
);
741 if (XFASTINT (len
) > XFASTINT (Vrecursive_load_depth_limit
))
742 Fsignal (Qerror
, Fcons (build_string ("Recursive load suspected"),
743 Fcons (found
, Vloads_in_progress
)));
744 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
745 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
748 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
750 /* Load .elc files directly, but not when they are
751 remote and have no handler! */
758 if (!safe_to_load_p (fd
))
761 if (!load_dangerous_libraries
)
762 error ("File `%s' was not compiled in Emacs",
763 XSTRING (found
)->data
);
764 else if (!NILP (nomessage
))
765 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
773 stat ((char *)XSTRING (found
)->data
, &s1
);
774 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
775 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
776 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
778 /* Make the progress messages mention that source is newer. */
781 /* If we won't print another message, mention this anyway. */
782 if (! NILP (nomessage
))
783 message_with_string ("Source file `%s' newer than byte-compiled file",
786 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
791 /* We are loading a source file (*.el). */
792 if (!NILP (Vload_source_file_function
))
798 val
= call4 (Vload_source_file_function
, found
, file
,
799 NILP (noerror
) ? Qnil
: Qt
,
800 NILP (nomessage
) ? Qnil
: Qt
);
801 return unbind_to (count
, val
);
807 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
808 #else /* not WINDOWSNT */
809 stream
= fdopen (fd
, fmode
);
810 #endif /* not WINDOWSNT */
814 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
817 if (! NILP (Vpurify_flag
))
818 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
820 if (NILP (nomessage
))
823 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
826 message_with_string ("Loading %s (source)...", file
, 1);
828 message_with_string ("Loading %s (compiled; note, source file is newer)...",
830 else /* The typical case; compiled file newer than source file. */
831 message_with_string ("Loading %s...", file
, 1);
835 lispstream
= Fcons (Qnil
, Qnil
);
836 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
837 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
838 record_unwind_protect (load_unwind
, lispstream
);
839 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
840 specbind (Qload_file_name
, found
);
841 specbind (Qinhibit_file_name_operation
, Qnil
);
843 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
845 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
846 unbind_to (count
, Qnil
);
848 /* Run any load-hooks for this file. */
849 temp
= Fassoc (file
, Vafter_load_alist
);
851 Fprogn (Fcdr (temp
));
854 if (saved_doc_string
)
855 free (saved_doc_string
);
856 saved_doc_string
= 0;
857 saved_doc_string_size
= 0;
859 if (prev_saved_doc_string
)
860 xfree (prev_saved_doc_string
);
861 prev_saved_doc_string
= 0;
862 prev_saved_doc_string_size
= 0;
864 if (!noninteractive
&& NILP (nomessage
))
867 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
870 message_with_string ("Loading %s (source)...done", file
, 1);
872 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
874 else /* The typical case; compiled file newer than source file. */
875 message_with_string ("Loading %s...done", file
, 1);
882 load_unwind (stream
) /* used as unwind-protect function in load */
885 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
886 | XFASTINT (XCDR (stream
))));
887 if (--load_in_progress
< 0) load_in_progress
= 0;
892 load_descriptor_unwind (oldlist
)
895 load_descriptor_list
= oldlist
;
899 /* Close all descriptors in use for Floads.
900 This is used when starting a subprocess. */
907 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
908 emacs_close (XFASTINT (XCAR (tail
)));
913 complete_filename_p (pathname
)
914 Lisp_Object pathname
;
916 register unsigned char *s
= XSTRING (pathname
)->data
;
917 return (IS_DIRECTORY_SEP (s
[0])
918 || (XSTRING (pathname
)->size
> 2
919 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
929 /* Search for a file whose name is STR, looking in directories
930 in the Lisp list PATH, and trying suffixes from SUFFIX.
931 On success, returns a file descriptor. On failure, returns -1.
933 SUFFIXES is a list of strings containing possible suffixes.
934 The empty suffix is automatically added iff the list is empty.
936 EXEC_ONLY nonzero means don't open the files,
937 just look for one that is executable. In this case,
938 returns 1 on success.
940 If STOREPTR is nonzero, it points to a slot where the name of
941 the file actually found should be stored as a Lisp string.
942 nil is stored there on failure.
944 If the file we find is remote, return -2
945 but store the found remote file name in *STOREPTR.
946 We do not check for remote files if EXEC_ONLY is nonzero. */
949 openp (path
, str
, suffixes
, storeptr
, exec_only
)
950 Lisp_Object path
, str
;
951 Lisp_Object suffixes
;
952 Lisp_Object
*storeptr
;
958 register char *fn
= buf
;
961 Lisp_Object filename
;
963 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
964 Lisp_Object string
, tail
;
965 int max_suffix_len
= 0;
967 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
969 CHECK_STRING_CAR (tail
);
970 max_suffix_len
= max (max_suffix_len
,
971 STRING_BYTES (XSTRING (XCAR (tail
))));
974 string
= filename
= Qnil
;
975 GCPRO5 (str
, string
, filename
, path
, suffixes
);
980 if (complete_filename_p (str
))
983 for (; CONSP (path
); path
= XCDR (path
))
985 filename
= Fexpand_file_name (str
, XCAR (path
));
986 if (!complete_filename_p (filename
))
987 /* If there are non-absolute elts in PATH (eg ".") */
988 /* Of course, this could conceivably lose if luser sets
989 default-directory to be something non-absolute... */
991 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
992 if (!complete_filename_p (filename
))
993 /* Give up on this path element! */
997 /* Calculate maximum size of any filename made from
998 this path element/specified file name and any possible suffix. */
999 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1000 if (fn_size
< want_size
)
1001 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1003 /* Loop over suffixes. */
1004 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1005 CONSP (tail
); tail
= XCDR (tail
))
1007 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1008 Lisp_Object handler
;
1010 /* Concatenate path element/specified name with the suffix.
1011 If the directory starts with /:, remove that. */
1012 if (XSTRING (filename
)->size
> 2
1013 && XSTRING (filename
)->data
[0] == '/'
1014 && XSTRING (filename
)->data
[1] == ':')
1016 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1017 STRING_BYTES (XSTRING (filename
)) - 2);
1018 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1022 strncpy (fn
, XSTRING (filename
)->data
,
1023 STRING_BYTES (XSTRING (filename
)));
1024 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1027 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1028 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1030 /* Check that the file exists and is not a directory. */
1031 /* We used to only check for handlers on non-absolute file names:
1035 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1036 It's not clear why that was the case and it breaks things like
1037 (load "/bar.el") where the file is actually "/bar.el.gz". */
1038 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1039 if (!NILP (handler
) && !exec_only
)
1043 string
= build_string (fn
);
1044 exists
= !NILP (Ffile_readable_p (string
));
1045 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1050 /* We succeeded; return this descriptor and filename. */
1052 *storeptr
= build_string (fn
);
1059 int exists
= (stat (fn
, &st
) >= 0
1060 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1063 /* Check that we can access or open it. */
1065 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1067 fd
= emacs_open (fn
, O_RDONLY
, 0);
1071 /* We succeeded; return this descriptor and filename. */
1073 *storeptr
= build_string (fn
);
1089 /* Merge the list we've accumulated of globals from the current input source
1090 into the load_history variable. The details depend on whether
1091 the source has an associated file name or not. */
1094 build_load_history (stream
, source
)
1098 register Lisp_Object tail
, prev
, newelt
;
1099 register Lisp_Object tem
, tem2
;
1100 register int foundit
, loading
;
1102 loading
= stream
|| !NARROWED
;
1104 tail
= Vload_history
;
1107 while (!NILP (tail
))
1111 /* Find the feature's previous assoc list... */
1112 if (!NILP (Fequal (source
, Fcar (tem
))))
1116 /* If we're loading, remove it. */
1120 Vload_history
= Fcdr (tail
);
1122 Fsetcdr (prev
, Fcdr (tail
));
1125 /* Otherwise, cons on new symbols that are not already members. */
1128 tem2
= Vcurrent_load_list
;
1130 while (CONSP (tem2
))
1132 newelt
= Fcar (tem2
);
1134 if (NILP (Fmemq (newelt
, tem
)))
1135 Fsetcar (tail
, Fcons (Fcar (tem
),
1136 Fcons (newelt
, Fcdr (tem
))));
1149 /* If we're loading, cons the new assoc onto the front of load-history,
1150 the most-recently-loaded position. Also do this if we didn't find
1151 an existing member for the current source. */
1152 if (loading
|| !foundit
)
1153 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1158 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1166 readevalloop_1 (old
)
1169 load_convert_to_unibyte
= ! NILP (old
);
1173 /* Signal an `end-of-file' error, if possible with file name
1177 end_of_file_error ()
1181 if (STRINGP (Vload_file_name
))
1182 data
= Fcons (Vload_file_name
, Qnil
);
1186 Fsignal (Qend_of_file
, data
);
1189 /* UNIBYTE specifies how to set load_convert_to_unibyte
1190 for this invocation.
1191 READFUN, if non-nil, is used instead of `read'. */
1194 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1195 Lisp_Object readcharfun
;
1197 Lisp_Object sourcename
;
1198 Lisp_Object (*evalfun
) ();
1200 Lisp_Object unibyte
, readfun
;
1203 register Lisp_Object val
;
1204 int count
= specpdl_ptr
- specpdl
;
1205 struct gcpro gcpro1
;
1206 struct buffer
*b
= 0;
1207 int continue_reading_p
;
1209 if (BUFFERP (readcharfun
))
1210 b
= XBUFFER (readcharfun
);
1211 else if (MARKERP (readcharfun
))
1212 b
= XMARKER (readcharfun
)->buffer
;
1214 specbind (Qstandard_input
, readcharfun
);
1215 specbind (Qcurrent_load_list
, Qnil
);
1216 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1217 load_convert_to_unibyte
= !NILP (unibyte
);
1219 readchar_backlog
= -1;
1221 GCPRO1 (sourcename
);
1223 LOADHIST_ATTACH (sourcename
);
1225 continue_reading_p
= 1;
1226 while (continue_reading_p
)
1228 if (b
!= 0 && NILP (b
->name
))
1229 error ("Reading from killed buffer");
1235 while ((c
= READCHAR
) != '\n' && c
!= -1);
1240 /* Ignore whitespace here, so we can detect eof. */
1241 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1244 if (!NILP (Vpurify_flag
) && c
== '(')
1246 int count1
= specpdl_ptr
- specpdl
;
1247 record_unwind_protect (unreadpure
, Qnil
);
1248 val
= read_list (-1, readcharfun
);
1249 unbind_to (count1
, Qnil
);
1254 read_objects
= Qnil
;
1255 if (!NILP (readfun
))
1257 val
= call1 (readfun
, readcharfun
);
1259 /* If READCHARFUN has set point to ZV, we should
1260 stop reading, even if the form read sets point
1261 to a different value when evaluated. */
1262 if (BUFFERP (readcharfun
))
1264 struct buffer
*b
= XBUFFER (readcharfun
);
1265 if (BUF_PT (b
) == BUF_ZV (b
))
1266 continue_reading_p
= 0;
1269 else if (! NILP (Vload_read_function
))
1270 val
= call1 (Vload_read_function
, readcharfun
);
1272 val
= read0 (readcharfun
);
1275 val
= (*evalfun
) (val
);
1279 Vvalues
= Fcons (val
, Vvalues
);
1280 if (EQ (Vstandard_output
, Qt
))
1287 build_load_history (stream
, sourcename
);
1290 unbind_to (count
, Qnil
);
1293 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1294 "Execute the current buffer as Lisp code.\n\
1295 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1296 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1297 PRINTFLAG controls printing of output:\n\
1298 nil means discard it; anything else is stream for print.\n\
1300 If the optional third argument FILENAME is non-nil,\n\
1301 it specifies the file name to use for `load-history'.\n\
1302 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\
1303 for this invocation.\n\
1305 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\
1306 `print' and related functions should work normally even if PRINTFLAG is nil.\n\
1308 This function preserves the position of point.")
1309 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1310 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1312 int count
= specpdl_ptr
- specpdl
;
1313 Lisp_Object tem
, buf
;
1316 buf
= Fcurrent_buffer ();
1318 buf
= Fget_buffer (buffer
);
1320 error ("No such buffer");
1322 if (NILP (printflag
) && NILP (do_allow_print
))
1327 if (NILP (filename
))
1328 filename
= XBUFFER (buf
)->filename
;
1330 specbind (Qstandard_output
, tem
);
1331 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1332 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1333 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1334 unbind_to (count
, Qnil
);
1340 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1341 "Execute the current buffer as Lisp code.\n\
1342 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1343 nil means discard it; anything else is stream for print.\n\
1345 If there is no error, point does not move. If there is an error,\n\
1346 point remains at the end of the last character read from the buffer.")
1348 Lisp_Object printflag
;
1350 int count
= specpdl_ptr
- specpdl
;
1351 Lisp_Object tem
, cbuf
;
1353 cbuf
= Fcurrent_buffer ()
1355 if (NILP (printflag
))
1359 specbind (Qstandard_output
, tem
);
1360 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1362 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1363 !NILP (printflag
), Qnil
, Qnil
);
1364 return unbind_to (count
, Qnil
);
1368 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1369 "Execute the region as Lisp code.\n\
1370 When called from programs, expects two arguments,\n\
1371 giving starting and ending indices in the current buffer\n\
1372 of the text to be executed.\n\
1373 Programs can pass third argument PRINTFLAG which controls output:\n\
1374 nil means discard it; anything else is stream for printing it.\n\
1375 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1376 instead of `read' to read each expression. It gets one argument\n\
1377 which is the input stream for reading characters.\n\
1379 This function does not move point.")
1380 (start
, end
, printflag
, read_function
)
1381 Lisp_Object start
, end
, printflag
, read_function
;
1383 int count
= specpdl_ptr
- specpdl
;
1384 Lisp_Object tem
, cbuf
;
1386 cbuf
= Fcurrent_buffer ();
1388 if (NILP (printflag
))
1392 specbind (Qstandard_output
, tem
);
1394 if (NILP (printflag
))
1395 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1396 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1398 /* This both uses start and checks its type. */
1400 Fnarrow_to_region (make_number (BEGV
), end
);
1401 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1402 !NILP (printflag
), Qnil
, read_function
);
1404 return unbind_to (count
, Qnil
);
1408 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1409 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1410 If STREAM is nil, use the value of `standard-input' (which see).\n\
1411 STREAM or the value of `standard-input' may be:\n\
1412 a buffer (read from point and advance it)\n\
1413 a marker (read from where it points and advance it)\n\
1414 a function (call it with no arguments for each character,\n\
1415 call it with a char as argument to push a char back)\n\
1416 a string (takes text from string, starting at the beginning)\n\
1417 t (read text line using minibuffer and use it, or read from\n\
1418 standard input in batch mode).")
1422 extern Lisp_Object
Fread_minibuffer ();
1425 stream
= Vstandard_input
;
1426 if (EQ (stream
, Qt
))
1427 stream
= Qread_char
;
1429 readchar_backlog
= -1;
1430 new_backquote_flag
= 0;
1431 read_objects
= Qnil
;
1433 if (EQ (stream
, Qread_char
))
1434 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1436 if (STRINGP (stream
))
1437 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1439 return read0 (stream
);
1442 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1443 "Read one Lisp expression which is represented as text by STRING.\n\
1444 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1445 START and END optionally delimit a substring of STRING from which to read;\n\
1446 they default to 0 and (length STRING) respectively.")
1447 (string
, start
, end
)
1448 Lisp_Object string
, start
, end
;
1450 int startval
, endval
;
1453 CHECK_STRING (string
);
1456 endval
= XSTRING (string
)->size
;
1460 endval
= XINT (end
);
1461 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1462 args_out_of_range (string
, end
);
1469 CHECK_NUMBER (start
);
1470 startval
= XINT (start
);
1471 if (startval
< 0 || startval
> endval
)
1472 args_out_of_range (string
, start
);
1475 read_from_string_index
= startval
;
1476 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1477 read_from_string_limit
= endval
;
1479 new_backquote_flag
= 0;
1480 read_objects
= Qnil
;
1482 tem
= read0 (string
);
1483 return Fcons (tem
, make_number (read_from_string_index
));
1486 /* Use this for recursive reads, in contexts where internal tokens
1491 Lisp_Object readcharfun
;
1493 register Lisp_Object val
;
1496 val
= read1 (readcharfun
, &c
, 0);
1498 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1505 static int read_buffer_size
;
1506 static char *read_buffer
;
1508 /* Read multibyte form and return it as a character. C is a first
1509 byte of multibyte form, and rest of them are read from
1513 read_multibyte (c
, readcharfun
)
1515 Lisp_Object readcharfun
;
1517 /* We need the actual character code of this multibyte
1519 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1524 while ((c
= READCHAR
) >= 0xA0
1525 && len
< MAX_MULTIBYTE_LENGTH
)
1528 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1529 return STRING_CHAR (str
, len
);
1530 /* The byte sequence is not valid as multibyte. Unread all bytes
1531 but the first one, and return the first byte. */
1537 /* Read a \-escape sequence, assuming we already read the `\'. */
1540 read_escape (readcharfun
, stringp
)
1541 Lisp_Object readcharfun
;
1544 register int c
= READCHAR
;
1548 error ("End of file");
1578 error ("Invalid escape character syntax");
1581 c
= read_escape (readcharfun
, 0);
1582 return c
| meta_modifier
;
1587 error ("Invalid escape character syntax");
1590 c
= read_escape (readcharfun
, 0);
1591 return c
| shift_modifier
;
1596 error ("Invalid escape character syntax");
1599 c
= read_escape (readcharfun
, 0);
1600 return c
| hyper_modifier
;
1605 error ("Invalid escape character syntax");
1608 c
= read_escape (readcharfun
, 0);
1609 return c
| alt_modifier
;
1614 error ("Invalid escape character syntax");
1617 c
= read_escape (readcharfun
, 0);
1618 return c
| super_modifier
;
1623 error ("Invalid escape character syntax");
1627 c
= read_escape (readcharfun
, 0);
1628 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1629 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1630 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1631 return c
| ctrl_modifier
;
1632 /* ASCII control chars are made from letters (both cases),
1633 as well as the non-letters within 0100...0137. */
1634 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1635 return (c
& (037 | ~0177));
1636 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1637 return (c
& (037 | ~0177));
1639 return c
| ctrl_modifier
;
1649 /* An octal escape, as in ANSI C. */
1651 register int i
= c
- '0';
1652 register int count
= 0;
1655 if ((c
= READCHAR
) >= '0' && c
<= '7')
1670 /* A hex escape, as in ANSI C. */
1676 if (c
>= '0' && c
<= '9')
1681 else if ((c
>= 'a' && c
<= 'f')
1682 || (c
>= 'A' && c
<= 'F'))
1685 if (c
>= 'a' && c
<= 'f')
1700 if (BASE_LEADING_CODE_P (c
))
1701 c
= read_multibyte (c
, readcharfun
);
1707 /* Read an integer in radix RADIX using READCHARFUN to read
1708 characters. RADIX must be in the interval [2..36]; if it isn't, a
1709 read error is signaled . Value is the integer read. Signals an
1710 error if encountering invalid read syntax or if RADIX is out of
1714 read_integer (readcharfun
, radix
)
1715 Lisp_Object readcharfun
;
1718 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1719 EMACS_INT number
= 0;
1721 if (radix
< 2 || radix
> 36)
1725 number
= ndigits
= invalid_p
= 0;
1741 if (c
>= '0' && c
<= '9')
1743 else if (c
>= 'a' && c
<= 'z')
1744 digit
= c
- 'a' + 10;
1745 else if (c
>= 'A' && c
<= 'Z')
1746 digit
= c
- 'A' + 10;
1753 if (digit
< 0 || digit
>= radix
)
1756 number
= radix
* number
+ digit
;
1762 if (ndigits
== 0 || invalid_p
)
1765 sprintf (buf
, "integer, radix %d", radix
);
1766 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1769 return make_number (sign
* number
);
1773 /* Convert unibyte text in read_buffer to multibyte.
1775 Initially, *P is a pointer after the end of the unibyte text, and
1776 the pointer *END points after the end of read_buffer.
1778 If read_buffer doesn't have enough room to hold the result
1779 of the conversion, reallocate it and adjust *P and *END.
1781 At the end, make *P point after the result of the conversion, and
1782 return in *NCHARS the number of characters in the converted
1786 to_multibyte (p
, end
, nchars
)
1792 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1793 if (read_buffer_size
< 2 * nbytes
)
1795 int offset
= *p
- read_buffer
;
1796 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1797 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1798 *p
= read_buffer
+ offset
;
1799 *end
= read_buffer
+ read_buffer_size
;
1802 if (nbytes
!= *nchars
)
1803 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1804 *p
- read_buffer
, nchars
);
1806 *p
= read_buffer
+ nbytes
;
1810 /* If the next token is ')' or ']' or '.', we store that character
1811 in *PCH and the return value is not interesting. Else, we store
1812 zero in *PCH and we read and return one lisp object.
1814 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1817 read1 (readcharfun
, pch
, first_in_list
)
1818 register Lisp_Object readcharfun
;
1823 int uninterned_symbol
= 0;
1831 end_of_file_error ();
1836 return read_list (0, readcharfun
);
1839 return read_vector (readcharfun
, 0);
1856 tmp
= read_vector (readcharfun
, 0);
1857 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1858 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1859 error ("Invalid size char-table");
1860 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1861 XCHAR_TABLE (tmp
)->top
= Qt
;
1870 tmp
= read_vector (readcharfun
, 0);
1871 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1872 error ("Invalid size char-table");
1873 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1874 XCHAR_TABLE (tmp
)->top
= Qnil
;
1877 Fsignal (Qinvalid_read_syntax
,
1878 Fcons (make_string ("#^^", 3), Qnil
));
1880 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1885 length
= read1 (readcharfun
, pch
, first_in_list
);
1889 Lisp_Object tmp
, val
;
1890 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1894 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1895 if (size_in_chars
!= XSTRING (tmp
)->size
1896 /* We used to print 1 char too many
1897 when the number of bits was a multiple of 8.
1898 Accept such input in case it came from an old version. */
1899 && ! (XFASTINT (length
)
1900 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1901 Fsignal (Qinvalid_read_syntax
,
1902 Fcons (make_string ("#&...", 5), Qnil
));
1904 val
= Fmake_bool_vector (length
, Qnil
);
1905 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1907 /* Clear the extraneous bits in the last byte. */
1908 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1909 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1910 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1913 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1918 /* Accept compiled functions at read-time so that we don't have to
1919 build them using function calls. */
1921 tmp
= read_vector (readcharfun
, 1);
1922 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1923 XVECTOR (tmp
)->contents
);
1928 struct gcpro gcpro1
;
1931 /* Read the string itself. */
1932 tmp
= read1 (readcharfun
, &ch
, 0);
1933 if (ch
!= 0 || !STRINGP (tmp
))
1934 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1936 /* Read the intervals and their properties. */
1939 Lisp_Object beg
, end
, plist
;
1941 beg
= read1 (readcharfun
, &ch
, 0);
1946 end
= read1 (readcharfun
, &ch
, 0);
1948 plist
= read1 (readcharfun
, &ch
, 0);
1950 Fsignal (Qinvalid_read_syntax
,
1951 Fcons (build_string ("invalid string property list"),
1953 Fset_text_properties (beg
, end
, plist
, tmp
);
1959 /* #@NUMBER is used to skip NUMBER following characters.
1960 That's used in .elc files to skip over doc strings
1961 and function definitions. */
1966 /* Read a decimal integer. */
1967 while ((c
= READCHAR
) >= 0
1968 && c
>= '0' && c
<= '9')
1976 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1978 /* If we are supposed to force doc strings into core right now,
1979 record the last string that we skipped,
1980 and record where in the file it comes from. */
1982 /* But first exchange saved_doc_string
1983 with prev_saved_doc_string, so we save two strings. */
1985 char *temp
= saved_doc_string
;
1986 int temp_size
= saved_doc_string_size
;
1987 file_offset temp_pos
= saved_doc_string_position
;
1988 int temp_len
= saved_doc_string_length
;
1990 saved_doc_string
= prev_saved_doc_string
;
1991 saved_doc_string_size
= prev_saved_doc_string_size
;
1992 saved_doc_string_position
= prev_saved_doc_string_position
;
1993 saved_doc_string_length
= prev_saved_doc_string_length
;
1995 prev_saved_doc_string
= temp
;
1996 prev_saved_doc_string_size
= temp_size
;
1997 prev_saved_doc_string_position
= temp_pos
;
1998 prev_saved_doc_string_length
= temp_len
;
2001 if (saved_doc_string_size
== 0)
2003 saved_doc_string_size
= nskip
+ 100;
2004 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2006 if (nskip
> saved_doc_string_size
)
2008 saved_doc_string_size
= nskip
+ 100;
2009 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2010 saved_doc_string_size
);
2013 saved_doc_string_position
= file_tell (instream
);
2015 /* Copy that many characters into saved_doc_string. */
2016 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2017 saved_doc_string
[i
] = c
= READCHAR
;
2019 saved_doc_string_length
= i
;
2023 /* Skip that many characters. */
2024 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2031 return Vload_file_name
;
2033 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2034 /* #:foo is the uninterned symbol named foo. */
2037 uninterned_symbol
= 1;
2041 /* Reader forms that can reuse previously read objects. */
2042 if (c
>= '0' && c
<= '9')
2047 /* Read a non-negative integer. */
2048 while (c
>= '0' && c
<= '9')
2054 /* #n=object returns object, but associates it with n for #n#. */
2057 /* Make a placeholder for #n# to use temporarily */
2058 Lisp_Object placeholder
;
2061 placeholder
= Fcons(Qnil
, Qnil
);
2062 cell
= Fcons (make_number (n
), placeholder
);
2063 read_objects
= Fcons (cell
, read_objects
);
2065 /* Read the object itself. */
2066 tem
= read0 (readcharfun
);
2068 /* Now put it everywhere the placeholder was... */
2069 substitute_object_in_subtree (tem
, placeholder
);
2071 /* ...and #n# will use the real value from now on. */
2072 Fsetcdr (cell
, tem
);
2076 /* #n# returns a previously read object. */
2079 tem
= Fassq (make_number (n
), read_objects
);
2082 /* Fall through to error message. */
2084 else if (c
== 'r' || c
== 'R')
2085 return read_integer (readcharfun
, n
);
2087 /* Fall through to error message. */
2089 else if (c
== 'x' || c
== 'X')
2090 return read_integer (readcharfun
, 16);
2091 else if (c
== 'o' || c
== 'O')
2092 return read_integer (readcharfun
, 8);
2093 else if (c
== 'b' || c
== 'B')
2094 return read_integer (readcharfun
, 2);
2097 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2100 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2105 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2115 new_backquote_flag
= 1;
2116 value
= read0 (readcharfun
);
2117 new_backquote_flag
= 0;
2119 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2123 if (new_backquote_flag
)
2125 Lisp_Object comma_type
= Qnil
;
2130 comma_type
= Qcomma_at
;
2132 comma_type
= Qcomma_dot
;
2135 if (ch
>= 0) UNREAD (ch
);
2136 comma_type
= Qcomma
;
2139 new_backquote_flag
= 0;
2140 value
= read0 (readcharfun
);
2141 new_backquote_flag
= 1;
2142 return Fcons (comma_type
, Fcons (value
, Qnil
));
2151 end_of_file_error ();
2154 c
= read_escape (readcharfun
, 0);
2155 else if (BASE_LEADING_CODE_P (c
))
2156 c
= read_multibyte (c
, readcharfun
);
2158 return make_number (c
);
2163 char *p
= read_buffer
;
2164 char *end
= read_buffer
+ read_buffer_size
;
2166 /* Nonzero if we saw an escape sequence specifying
2167 a multibyte character. */
2168 int force_multibyte
= 0;
2169 /* Nonzero if we saw an escape sequence specifying
2170 a single-byte character. */
2171 int force_singlebyte
= 0;
2175 while ((c
= READCHAR
) >= 0
2178 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2180 int offset
= p
- read_buffer
;
2181 read_buffer
= (char *) xrealloc (read_buffer
,
2182 read_buffer_size
*= 2);
2183 p
= read_buffer
+ offset
;
2184 end
= read_buffer
+ read_buffer_size
;
2189 c
= read_escape (readcharfun
, 1);
2191 /* C is -1 if \ newline has just been seen */
2194 if (p
== read_buffer
)
2199 /* If an escape specifies a non-ASCII single-byte character,
2200 this must be a unibyte string. */
2201 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2202 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2203 force_singlebyte
= 1;
2206 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2208 /* Any modifiers for a multibyte character are invalid. */
2209 if (c
& CHAR_MODIFIER_MASK
)
2210 error ("Invalid modifier in string");
2211 p
+= CHAR_STRING (c
, p
);
2212 force_multibyte
= 1;
2216 /* Allow `\C- ' and `\C-?'. */
2217 if (c
== (CHAR_CTL
| ' '))
2219 else if (c
== (CHAR_CTL
| '?'))
2224 /* Shift modifier is valid only with [A-Za-z]. */
2225 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2227 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2228 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2232 /* Move the meta bit to the right place for a string. */
2233 c
= (c
& ~CHAR_META
) | 0x80;
2235 error ("Invalid modifier in string");
2240 end_of_file_error ();
2242 /* If purifying, and string starts with \ newline,
2243 return zero instead. This is for doc strings
2244 that we are really going to find in etc/DOC.nn.nn */
2245 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2246 return make_number (0);
2248 if (force_multibyte
)
2249 to_multibyte (&p
, &end
, &nchars
);
2250 else if (force_singlebyte
)
2251 nchars
= p
- read_buffer
;
2252 else if (load_convert_to_unibyte
)
2255 to_multibyte (&p
, &end
, &nchars
);
2256 if (p
- read_buffer
!= nchars
)
2258 string
= make_multibyte_string (read_buffer
, nchars
,
2260 return Fstring_make_unibyte (string
);
2263 else if (EQ (readcharfun
, Qget_file_char
)
2264 || EQ (readcharfun
, Qlambda
))
2266 /* Nowadays, reading directly from a file is used only for
2267 compiled Emacs Lisp files, and those always use the
2268 Emacs internal encoding. Meanwhile, Qlambda is used
2269 for reading dynamic byte code (compiled with
2270 byte-compile-dynamic = t). */
2271 to_multibyte (&p
, &end
, &nchars
);
2274 /* In all other cases, if we read these bytes as
2275 separate characters, treat them as separate characters now. */
2276 nchars
= p
- read_buffer
;
2279 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2281 || (p
- read_buffer
!= nchars
)));
2282 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2284 || (p
- read_buffer
!= nchars
)));
2289 int next_char
= READCHAR
;
2292 if (next_char
<= 040
2293 || index ("\"'`,(", next_char
))
2299 /* Otherwise, we fall through! Note that the atom-reading loop
2300 below will now loop at least once, assuring that we will not
2301 try to UNREAD two characters in a row. */
2305 if (c
<= 040) goto retry
;
2307 char *p
= read_buffer
;
2311 char *end
= read_buffer
+ read_buffer_size
;
2314 && !(c
== '\"' || c
== '\'' || c
== ';'
2315 || c
== '(' || c
== ')'
2316 || c
== '[' || c
== ']' || c
== '#'))
2318 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2320 int offset
= p
- read_buffer
;
2321 read_buffer
= (char *) xrealloc (read_buffer
,
2322 read_buffer_size
*= 2);
2323 p
= read_buffer
+ offset
;
2324 end
= read_buffer
+ read_buffer_size
;
2331 end_of_file_error ();
2335 if (! SINGLE_BYTE_CHAR_P (c
))
2336 p
+= CHAR_STRING (c
, p
);
2345 int offset
= p
- read_buffer
;
2346 read_buffer
= (char *) xrealloc (read_buffer
,
2347 read_buffer_size
*= 2);
2348 p
= read_buffer
+ offset
;
2349 end
= read_buffer
+ read_buffer_size
;
2356 if (!quoted
&& !uninterned_symbol
)
2359 register Lisp_Object val
;
2361 if (*p1
== '+' || *p1
== '-') p1
++;
2362 /* Is it an integer? */
2365 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2366 /* Integers can have trailing decimal points. */
2367 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2369 /* It is an integer. */
2373 if (sizeof (int) == sizeof (EMACS_INT
))
2374 XSETINT (val
, atoi (read_buffer
));
2375 else if (sizeof (long) == sizeof (EMACS_INT
))
2376 XSETINT (val
, atol (read_buffer
));
2382 if (isfloat_string (read_buffer
))
2384 /* Compute NaN and infinities using 0.0 in a variable,
2385 to cope with compilers that think they are smarter
2391 /* Negate the value ourselves. This treats 0, NaNs,
2392 and infinity properly on IEEE floating point hosts,
2393 and works around a common bug where atof ("-0.0")
2395 int negative
= read_buffer
[0] == '-';
2397 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2398 returns 1, is if the input ends in e+INF or e+NaN. */
2405 value
= zero
/ zero
;
2408 value
= atof (read_buffer
+ negative
);
2412 return make_float (negative
? - value
: value
);
2416 if (uninterned_symbol
)
2417 return make_symbol (read_buffer
);
2419 return intern (read_buffer
);
2425 /* List of nodes we've seen during substitute_object_in_subtree. */
2426 static Lisp_Object seen_list
;
2429 substitute_object_in_subtree (object
, placeholder
)
2431 Lisp_Object placeholder
;
2433 Lisp_Object check_object
;
2435 /* We haven't seen any objects when we start. */
2438 /* Make all the substitutions. */
2440 = substitute_object_recurse (object
, placeholder
, object
);
2442 /* Clear seen_list because we're done with it. */
2445 /* The returned object here is expected to always eq the
2447 if (!EQ (check_object
, object
))
2448 error ("Unexpected mutation error in reader");
2451 /* Feval doesn't get called from here, so no gc protection is needed. */
2452 #define SUBSTITUTE(get_val, set_val) \
2454 Lisp_Object old_value = get_val; \
2455 Lisp_Object true_value \
2456 = substitute_object_recurse (object, placeholder,\
2459 if (!EQ (old_value, true_value)) \
2466 substitute_object_recurse (object
, placeholder
, subtree
)
2468 Lisp_Object placeholder
;
2469 Lisp_Object subtree
;
2471 /* If we find the placeholder, return the target object. */
2472 if (EQ (placeholder
, subtree
))
2475 /* If we've been to this node before, don't explore it again. */
2476 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2479 /* If this node can be the entry point to a cycle, remember that
2480 we've seen it. It can only be such an entry point if it was made
2481 by #n=, which means that we can find it as a value in
2483 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2484 seen_list
= Fcons (subtree
, seen_list
);
2486 /* Recurse according to subtree's type.
2487 Every branch must return a Lisp_Object. */
2488 switch (XTYPE (subtree
))
2490 case Lisp_Vectorlike
:
2493 int length
= XINT (Flength(subtree
));
2494 for (i
= 0; i
< length
; i
++)
2496 Lisp_Object idx
= make_number (i
);
2497 SUBSTITUTE (Faref (subtree
, idx
),
2498 Faset (subtree
, idx
, true_value
));
2505 SUBSTITUTE (Fcar_safe (subtree
),
2506 Fsetcar (subtree
, true_value
));
2507 SUBSTITUTE (Fcdr_safe (subtree
),
2508 Fsetcdr (subtree
, true_value
));
2514 /* Check for text properties in each interval.
2515 substitute_in_interval contains part of the logic. */
2517 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2518 Lisp_Object arg
= Fcons (object
, placeholder
);
2520 traverse_intervals_noorder (root_interval
,
2521 &substitute_in_interval
, arg
);
2526 /* Other types don't recurse any further. */
2532 /* Helper function for substitute_object_recurse. */
2534 substitute_in_interval (interval
, arg
)
2538 Lisp_Object object
= Fcar (arg
);
2539 Lisp_Object placeholder
= Fcdr (arg
);
2541 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2560 if (*cp
== '+' || *cp
== '-')
2563 if (*cp
>= '0' && *cp
<= '9')
2566 while (*cp
>= '0' && *cp
<= '9')
2574 if (*cp
>= '0' && *cp
<= '9')
2577 while (*cp
>= '0' && *cp
<= '9')
2580 if (*cp
== 'e' || *cp
== 'E')
2584 if (*cp
== '+' || *cp
== '-')
2588 if (*cp
>= '0' && *cp
<= '9')
2591 while (*cp
>= '0' && *cp
<= '9')
2594 else if (cp
== start
)
2596 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2601 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2607 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2608 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2609 || state
== (DOT_CHAR
|TRAIL_INT
)
2610 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2611 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2612 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2617 read_vector (readcharfun
, bytecodeflag
)
2618 Lisp_Object readcharfun
;
2623 register Lisp_Object
*ptr
;
2624 register Lisp_Object tem
, item
, vector
;
2625 register struct Lisp_Cons
*otem
;
2628 tem
= read_list (1, readcharfun
);
2629 len
= Flength (tem
);
2630 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2632 size
= XVECTOR (vector
)->size
;
2633 ptr
= XVECTOR (vector
)->contents
;
2634 for (i
= 0; i
< size
; i
++)
2637 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2638 bytecode object, the docstring containing the bytecode and
2639 constants values must be treated as unibyte and passed to
2640 Fread, to get the actual bytecode string and constants vector. */
2641 if (bytecodeflag
&& load_force_doc_strings
)
2643 if (i
== COMPILED_BYTECODE
)
2645 if (!STRINGP (item
))
2646 error ("invalid byte code");
2648 /* Delay handling the bytecode slot until we know whether
2649 it is lazily-loaded (we can tell by whether the
2650 constants slot is nil). */
2651 ptr
[COMPILED_CONSTANTS
] = item
;
2654 else if (i
== COMPILED_CONSTANTS
)
2656 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2660 /* Coerce string to unibyte (like string-as-unibyte,
2661 but without generating extra garbage and
2662 guaranteeing no change in the contents). */
2663 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2664 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2666 item
= Fread (bytestr
);
2668 error ("invalid byte code");
2670 otem
= XCONS (item
);
2671 bytestr
= XCAR (item
);
2676 /* Now handle the bytecode slot. */
2677 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2680 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2688 /* FLAG = 1 means check for ] to terminate rather than ) and .
2689 FLAG = -1 means check for starting with defun
2690 and make structure pure. */
2693 read_list (flag
, readcharfun
)
2695 register Lisp_Object readcharfun
;
2697 /* -1 means check next element for defun,
2698 0 means don't check,
2699 1 means already checked and found defun. */
2700 int defunflag
= flag
< 0 ? -1 : 0;
2701 Lisp_Object val
, tail
;
2702 register Lisp_Object elt
, tem
;
2703 struct gcpro gcpro1
, gcpro2
;
2704 /* 0 is the normal case.
2705 1 means this list is a doc reference; replace it with the number 0.
2706 2 means this list is a doc reference; replace it with the doc string. */
2707 int doc_reference
= 0;
2709 /* Initialize this to 1 if we are reading a list. */
2710 int first_in_list
= flag
<= 0;
2719 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2724 /* While building, if the list starts with #$, treat it specially. */
2725 if (EQ (elt
, Vload_file_name
)
2727 && !NILP (Vpurify_flag
))
2729 if (NILP (Vdoc_file_name
))
2730 /* We have not yet called Snarf-documentation, so assume
2731 this file is described in the DOC-MM.NN file
2732 and Snarf-documentation will fill in the right value later.
2733 For now, replace the whole list with 0. */
2736 /* We have already called Snarf-documentation, so make a relative
2737 file name for this file, so it can be found properly
2738 in the installed Lisp directory.
2739 We don't use Fexpand_file_name because that would make
2740 the directory absolute now. */
2741 elt
= concat2 (build_string ("../lisp/"),
2742 Ffile_name_nondirectory (elt
));
2744 else if (EQ (elt
, Vload_file_name
)
2746 && load_force_doc_strings
)
2755 Fsignal (Qinvalid_read_syntax
,
2756 Fcons (make_string (") or . in a vector", 18), Qnil
));
2764 XSETCDR (tail
, read0 (readcharfun
));
2766 val
= read0 (readcharfun
);
2767 read1 (readcharfun
, &ch
, 0);
2771 if (doc_reference
== 1)
2772 return make_number (0);
2773 if (doc_reference
== 2)
2775 /* Get a doc string from the file we are loading.
2776 If it's in saved_doc_string, get it from there. */
2777 int pos
= XINT (XCDR (val
));
2778 /* Position is negative for user variables. */
2779 if (pos
< 0) pos
= -pos
;
2780 if (pos
>= saved_doc_string_position
2781 && pos
< (saved_doc_string_position
2782 + saved_doc_string_length
))
2784 int start
= pos
- saved_doc_string_position
;
2787 /* Process quoting with ^A,
2788 and find the end of the string,
2789 which is marked with ^_ (037). */
2790 for (from
= start
, to
= start
;
2791 saved_doc_string
[from
] != 037;)
2793 int c
= saved_doc_string
[from
++];
2796 c
= saved_doc_string
[from
++];
2798 saved_doc_string
[to
++] = c
;
2800 saved_doc_string
[to
++] = 0;
2802 saved_doc_string
[to
++] = 037;
2805 saved_doc_string
[to
++] = c
;
2808 return make_string (saved_doc_string
+ start
,
2811 /* Look in prev_saved_doc_string the same way. */
2812 else if (pos
>= prev_saved_doc_string_position
2813 && pos
< (prev_saved_doc_string_position
2814 + prev_saved_doc_string_length
))
2816 int start
= pos
- prev_saved_doc_string_position
;
2819 /* Process quoting with ^A,
2820 and find the end of the string,
2821 which is marked with ^_ (037). */
2822 for (from
= start
, to
= start
;
2823 prev_saved_doc_string
[from
] != 037;)
2825 int c
= prev_saved_doc_string
[from
++];
2828 c
= prev_saved_doc_string
[from
++];
2830 prev_saved_doc_string
[to
++] = c
;
2832 prev_saved_doc_string
[to
++] = 0;
2834 prev_saved_doc_string
[to
++] = 037;
2837 prev_saved_doc_string
[to
++] = c
;
2840 return make_string (prev_saved_doc_string
+ start
,
2844 return get_doc_string (val
, 0, 0);
2849 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2851 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2853 tem
= (read_pure
&& flag
<= 0
2854 ? pure_cons (elt
, Qnil
)
2855 : Fcons (elt
, Qnil
));
2857 XSETCDR (tail
, tem
);
2862 defunflag
= EQ (elt
, Qdefun
);
2863 else if (defunflag
> 0)
2868 Lisp_Object Vobarray
;
2869 Lisp_Object initial_obarray
;
2871 /* oblookup stores the bucket number here, for the sake of Funintern. */
2873 int oblookup_last_bucket_number
;
2875 static int hash_string ();
2876 Lisp_Object
oblookup ();
2878 /* Get an error if OBARRAY is not an obarray.
2879 If it is one, return it. */
2882 check_obarray (obarray
)
2883 Lisp_Object obarray
;
2885 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2887 /* If Vobarray is now invalid, force it to be valid. */
2888 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2890 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2895 /* Intern the C string STR: return a symbol with that name,
2896 interned in the current obarray. */
2903 int len
= strlen (str
);
2904 Lisp_Object obarray
;
2907 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2908 obarray
= check_obarray (obarray
);
2909 tem
= oblookup (obarray
, str
, len
, len
);
2912 return Fintern (make_string (str
, len
), obarray
);
2915 /* Create an uninterned symbol with name STR. */
2921 int len
= strlen (str
);
2923 return Fmake_symbol ((!NILP (Vpurify_flag
)
2924 ? make_pure_string (str
, len
, len
, 0)
2925 : make_string (str
, len
)));
2928 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2929 "Return the canonical symbol whose name is STRING.\n\
2930 If there is none, one is created by this function and returned.\n\
2931 A second optional argument specifies the obarray to use;\n\
2932 it defaults to the value of `obarray'.")
2934 Lisp_Object string
, obarray
;
2936 register Lisp_Object tem
, sym
, *ptr
;
2938 if (NILP (obarray
)) obarray
= Vobarray
;
2939 obarray
= check_obarray (obarray
);
2941 CHECK_STRING (string
);
2943 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2944 XSTRING (string
)->size
,
2945 STRING_BYTES (XSTRING (string
)));
2946 if (!INTEGERP (tem
))
2949 if (!NILP (Vpurify_flag
))
2950 string
= Fpurecopy (string
);
2951 sym
= Fmake_symbol (string
);
2953 if (EQ (obarray
, initial_obarray
))
2954 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
2956 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
2958 if ((XSTRING (string
)->data
[0] == ':')
2959 && EQ (obarray
, initial_obarray
))
2961 XSYMBOL (sym
)->constant
= 1;
2962 XSYMBOL (sym
)->value
= sym
;
2965 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2967 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2969 XSYMBOL (sym
)->next
= 0;
2974 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2975 "Return the canonical symbol named NAME, or nil if none exists.\n\
2976 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2977 symbol is searched for.\n\
2978 A second optional argument specifies the obarray to use;\n\
2979 it defaults to the value of `obarray'.")
2981 Lisp_Object name
, obarray
;
2983 register Lisp_Object tem
;
2984 struct Lisp_String
*string
;
2986 if (NILP (obarray
)) obarray
= Vobarray
;
2987 obarray
= check_obarray (obarray
);
2989 if (!SYMBOLP (name
))
2991 CHECK_STRING (name
);
2992 string
= XSTRING (name
);
2995 string
= XSYMBOL (name
)->name
;
2997 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2998 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3004 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3005 "Delete the symbol named NAME, if any, from OBARRAY.\n\
3006 The value is t if a symbol was found and deleted, nil otherwise.\n\
3007 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
3008 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
3009 OBARRAY defaults to the value of the variable `obarray'.")
3011 Lisp_Object name
, obarray
;
3013 register Lisp_Object string
, tem
;
3016 if (NILP (obarray
)) obarray
= Vobarray
;
3017 obarray
= check_obarray (obarray
);
3020 XSETSTRING (string
, XSYMBOL (name
)->name
);
3023 CHECK_STRING (name
);
3027 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3028 XSTRING (string
)->size
,
3029 STRING_BYTES (XSTRING (string
)));
3032 /* If arg was a symbol, don't delete anything but that symbol itself. */
3033 if (SYMBOLP (name
) && !EQ (name
, tem
))
3036 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3037 XSYMBOL (tem
)->constant
= 0;
3038 XSYMBOL (tem
)->indirect_variable
= 0;
3040 hash
= oblookup_last_bucket_number
;
3042 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3044 if (XSYMBOL (tem
)->next
)
3045 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3047 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3051 Lisp_Object tail
, following
;
3053 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3054 XSYMBOL (tail
)->next
;
3057 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3058 if (EQ (following
, tem
))
3060 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3069 /* Return the symbol in OBARRAY whose names matches the string
3070 of SIZE characters (SIZE_BYTE bytes) at PTR.
3071 If there is no such symbol in OBARRAY, return nil.
3073 Also store the bucket number in oblookup_last_bucket_number. */
3076 oblookup (obarray
, ptr
, size
, size_byte
)
3077 Lisp_Object obarray
;
3079 int size
, size_byte
;
3083 register Lisp_Object tail
;
3084 Lisp_Object bucket
, tem
;
3086 if (!VECTORP (obarray
)
3087 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3089 obarray
= check_obarray (obarray
);
3090 obsize
= XVECTOR (obarray
)->size
;
3092 /* This is sometimes needed in the middle of GC. */
3093 obsize
&= ~ARRAY_MARK_FLAG
;
3094 /* Combining next two lines breaks VMS C 2.3. */
3095 hash
= hash_string (ptr
, size_byte
);
3097 bucket
= XVECTOR (obarray
)->contents
[hash
];
3098 oblookup_last_bucket_number
= hash
;
3099 if (XFASTINT (bucket
) == 0)
3101 else if (!SYMBOLP (bucket
))
3102 error ("Bad data in guts of obarray"); /* Like CADR error message */
3104 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3106 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3107 && XSYMBOL (tail
)->name
->size
== size
3108 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3110 else if (XSYMBOL (tail
)->next
== 0)
3113 XSETINT (tem
, hash
);
3118 hash_string (ptr
, len
)
3122 register unsigned char *p
= ptr
;
3123 register unsigned char *end
= p
+ len
;
3124 register unsigned char c
;
3125 register int hash
= 0;
3130 if (c
>= 0140) c
-= 40;
3131 hash
= ((hash
<<3) + (hash
>>28) + c
);
3133 return hash
& 07777777777;
3137 map_obarray (obarray
, fn
, arg
)
3138 Lisp_Object obarray
;
3139 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3143 register Lisp_Object tail
;
3144 CHECK_VECTOR (obarray
);
3145 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3147 tail
= XVECTOR (obarray
)->contents
[i
];
3152 if (XSYMBOL (tail
)->next
== 0)
3154 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3160 mapatoms_1 (sym
, function
)
3161 Lisp_Object sym
, function
;
3163 call1 (function
, sym
);
3166 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3167 "Call FUNCTION on every symbol in OBARRAY.\n\
3168 OBARRAY defaults to the value of `obarray'.")
3170 Lisp_Object function
, obarray
;
3172 if (NILP (obarray
)) obarray
= Vobarray
;
3173 obarray
= check_obarray (obarray
);
3175 map_obarray (obarray
, mapatoms_1
, function
);
3179 #define OBARRAY_SIZE 1511
3184 Lisp_Object oblength
;
3188 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3190 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3191 Vobarray
= Fmake_vector (oblength
, make_number (0));
3192 initial_obarray
= Vobarray
;
3193 staticpro (&initial_obarray
);
3194 /* Intern nil in the obarray */
3195 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3196 XSYMBOL (Qnil
)->constant
= 1;
3198 /* These locals are to kludge around a pyramid compiler bug. */
3199 hash
= hash_string ("nil", 3);
3200 /* Separate statement here to avoid VAXC bug. */
3201 hash
%= OBARRAY_SIZE
;
3202 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3205 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3206 XSYMBOL (Qnil
)->function
= Qunbound
;
3207 XSYMBOL (Qunbound
)->value
= Qunbound
;
3208 XSYMBOL (Qunbound
)->function
= Qunbound
;
3211 XSYMBOL (Qnil
)->value
= Qnil
;
3212 XSYMBOL (Qnil
)->plist
= Qnil
;
3213 XSYMBOL (Qt
)->value
= Qt
;
3214 XSYMBOL (Qt
)->constant
= 1;
3216 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3219 Qvariable_documentation
= intern ("variable-documentation");
3220 staticpro (&Qvariable_documentation
);
3222 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3223 read_buffer
= (char *) xmalloc (read_buffer_size
);
3228 struct Lisp_Subr
*sname
;
3231 sym
= intern (sname
->symbol_name
);
3232 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3235 #ifdef NOTDEF /* use fset in subr.el now */
3237 defalias (sname
, string
)
3238 struct Lisp_Subr
*sname
;
3242 sym
= intern (string
);
3243 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3247 /* Define an "integer variable"; a symbol whose value is forwarded
3248 to a C variable of type int. Sample call: */
3249 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3251 defvar_int (namestring
, address
)
3255 Lisp_Object sym
, val
;
3256 sym
= intern (namestring
);
3257 val
= allocate_misc ();
3258 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3259 XINTFWD (val
)->intvar
= address
;
3260 SET_SYMBOL_VALUE (sym
, val
);
3263 /* Similar but define a variable whose value is T if address contains 1,
3264 NIL if address contains 0 */
3266 defvar_bool (namestring
, address
)
3270 Lisp_Object sym
, val
;
3271 sym
= intern (namestring
);
3272 val
= allocate_misc ();
3273 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3274 XBOOLFWD (val
)->boolvar
= address
;
3275 SET_SYMBOL_VALUE (sym
, val
);
3276 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3279 /* Similar but define a variable whose value is the Lisp Object stored
3280 at address. Two versions: with and without gc-marking of the C
3281 variable. The nopro version is used when that variable will be
3282 gc-marked for some other reason, since marking the same slot twice
3283 can cause trouble with strings. */
3285 defvar_lisp_nopro (namestring
, address
)
3287 Lisp_Object
*address
;
3289 Lisp_Object sym
, val
;
3290 sym
= intern (namestring
);
3291 val
= allocate_misc ();
3292 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3293 XOBJFWD (val
)->objvar
= address
;
3294 SET_SYMBOL_VALUE (sym
, val
);
3298 defvar_lisp (namestring
, address
)
3300 Lisp_Object
*address
;
3302 defvar_lisp_nopro (namestring
, address
);
3303 staticpro (address
);
3306 /* Similar but define a variable whose value is the Lisp Object stored in
3307 the current buffer. address is the address of the slot in the buffer
3308 that is current now. */
3311 defvar_per_buffer (namestring
, address
, type
, doc
)
3313 Lisp_Object
*address
;
3317 Lisp_Object sym
, val
;
3319 extern struct buffer buffer_local_symbols
;
3321 sym
= intern (namestring
);
3322 val
= allocate_misc ();
3323 offset
= (char *)address
- (char *)current_buffer
;
3325 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3326 XBUFFER_OBJFWD (val
)->offset
= offset
;
3327 SET_SYMBOL_VALUE (sym
, val
);
3328 PER_BUFFER_SYMBOL (offset
) = sym
;
3329 PER_BUFFER_TYPE (offset
) = type
;
3331 if (PER_BUFFER_IDX (offset
) == 0)
3332 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3333 slot of buffer_local_flags */
3338 /* Similar but define a variable whose value is the Lisp Object stored
3339 at a particular offset in the current kboard object. */
3342 defvar_kboard (namestring
, offset
)
3346 Lisp_Object sym
, val
;
3347 sym
= intern (namestring
);
3348 val
= allocate_misc ();
3349 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3350 XKBOARD_OBJFWD (val
)->offset
= offset
;
3351 SET_SYMBOL_VALUE (sym
, val
);
3354 /* Record the value of load-path used at the start of dumping
3355 so we can see if the site changed it later during dumping. */
3356 static Lisp_Object dump_path
;
3362 int turn_off_warning
= 0;
3364 /* Compute the default load-path. */
3366 normal
= PATH_LOADSEARCH
;
3367 Vload_path
= decode_env_path (0, normal
);
3369 if (NILP (Vpurify_flag
))
3370 normal
= PATH_LOADSEARCH
;
3372 normal
= PATH_DUMPLOADSEARCH
;
3374 /* In a dumped Emacs, we normally have to reset the value of
3375 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3376 uses ../lisp, instead of the path of the installed elisp
3377 libraries. However, if it appears that Vload_path was changed
3378 from the default before dumping, don't override that value. */
3381 if (! NILP (Fequal (dump_path
, Vload_path
)))
3383 Vload_path
= decode_env_path (0, normal
);
3384 if (!NILP (Vinstallation_directory
))
3386 /* Add to the path the lisp subdir of the
3387 installation dir, if it exists. */
3388 Lisp_Object tem
, tem1
;
3389 tem
= Fexpand_file_name (build_string ("lisp"),
3390 Vinstallation_directory
);
3391 tem1
= Ffile_exists_p (tem
);
3394 if (NILP (Fmember (tem
, Vload_path
)))
3396 turn_off_warning
= 1;
3397 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3401 /* That dir doesn't exist, so add the build-time
3402 Lisp dirs instead. */
3403 Vload_path
= nconc2 (Vload_path
, dump_path
);
3405 /* Add leim under the installation dir, if it exists. */
3406 tem
= Fexpand_file_name (build_string ("leim"),
3407 Vinstallation_directory
);
3408 tem1
= Ffile_exists_p (tem
);
3411 if (NILP (Fmember (tem
, Vload_path
)))
3412 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3415 /* Add site-list under the installation dir, if it exists. */
3416 tem
= Fexpand_file_name (build_string ("site-lisp"),
3417 Vinstallation_directory
);
3418 tem1
= Ffile_exists_p (tem
);
3421 if (NILP (Fmember (tem
, Vload_path
)))
3422 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3425 /* If Emacs was not built in the source directory,
3426 and it is run from where it was built, add to load-path
3427 the lisp, leim and site-lisp dirs under that directory. */
3429 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3433 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3434 Vinstallation_directory
);
3435 tem1
= Ffile_exists_p (tem
);
3437 /* Don't be fooled if they moved the entire source tree
3438 AFTER dumping Emacs. If the build directory is indeed
3439 different from the source dir, src/Makefile.in and
3440 src/Makefile will not be found together. */
3441 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3442 Vinstallation_directory
);
3443 tem2
= Ffile_exists_p (tem
);
3444 if (!NILP (tem1
) && NILP (tem2
))
3446 tem
= Fexpand_file_name (build_string ("lisp"),
3449 if (NILP (Fmember (tem
, Vload_path
)))
3450 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3452 tem
= Fexpand_file_name (build_string ("leim"),
3455 if (NILP (Fmember (tem
, Vload_path
)))
3456 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3458 tem
= Fexpand_file_name (build_string ("site-lisp"),
3461 if (NILP (Fmember (tem
, Vload_path
)))
3462 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3470 /* NORMAL refers to the lisp dir in the source directory. */
3471 /* We used to add ../lisp at the front here, but
3472 that caused trouble because it was copied from dump_path
3473 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3474 It should be unnecessary. */
3475 Vload_path
= decode_env_path (0, normal
);
3476 dump_path
= Vload_path
;
3481 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3482 almost never correct, thereby causing a warning to be printed out that
3483 confuses users. Since PATH_LOADSEARCH is always overridden by the
3484 EMACSLOADPATH environment variable below, disable the warning on NT. */
3486 /* Warn if dirs in the *standard* path don't exist. */
3487 if (!turn_off_warning
)
3489 Lisp_Object path_tail
;
3491 for (path_tail
= Vload_path
;
3493 path_tail
= XCDR (path_tail
))
3495 Lisp_Object dirfile
;
3496 dirfile
= Fcar (path_tail
);
3497 if (STRINGP (dirfile
))
3499 dirfile
= Fdirectory_file_name (dirfile
);
3500 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3501 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3506 #endif /* WINDOWSNT */
3508 /* If the EMACSLOADPATH environment variable is set, use its value.
3509 This doesn't apply if we're dumping. */
3511 if (NILP (Vpurify_flag
)
3512 && egetenv ("EMACSLOADPATH"))
3514 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3518 load_in_progress
= 0;
3519 Vload_file_name
= Qnil
;
3521 load_descriptor_list
= Qnil
;
3523 Vstandard_input
= Qt
;
3524 Vloads_in_progress
= Qnil
;
3527 /* Print a warning, using format string FORMAT, that directory DIRNAME
3528 does not exist. Print it on stderr and put it in *Message*. */
3531 dir_warning (format
, dirname
)
3533 Lisp_Object dirname
;
3536 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3538 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3539 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3540 /* Don't log the warning before we've initialized!! */
3542 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3549 defsubr (&Sread_from_string
);
3551 defsubr (&Sintern_soft
);
3552 defsubr (&Sunintern
);
3554 defsubr (&Seval_buffer
);
3555 defsubr (&Seval_region
);
3556 defsubr (&Sread_char
);
3557 defsubr (&Sread_char_exclusive
);
3558 defsubr (&Sread_event
);
3559 defsubr (&Sget_file_char
);
3560 defsubr (&Smapatoms
);
3562 DEFVAR_LISP ("obarray", &Vobarray
,
3563 "Symbol table for use by `intern' and `read'.\n\
3564 It is a vector whose length ought to be prime for best results.\n\
3565 The vector's contents don't make sense if examined from Lisp programs;\n\
3566 to find all the symbols in an obarray, use `mapatoms'.");
3568 DEFVAR_LISP ("values", &Vvalues
,
3569 "List of values of all expressions which were read, evaluated and printed.\n\
3570 Order is reverse chronological.");
3572 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3573 "Stream for read to get input from.\n\
3574 See documentation of `read' for possible values.");
3575 Vstandard_input
= Qt
;
3577 DEFVAR_LISP ("load-path", &Vload_path
,
3578 "*List of directories to search for files to load.\n\
3579 Each element is a string (directory name) or nil (try default directory).\n\
3580 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3581 otherwise to default specified by file `epaths.h' when Emacs was built.");
3583 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3584 "*List of suffixes to try for files to load.\n\
3585 This list should not include the empty string.");
3586 Vload_suffixes
= Fcons (build_string (".elc"),
3587 Fcons (build_string (".el"), Qnil
));
3588 /* We don't use empty_string because it's not initialized yet. */
3589 default_suffixes
= Fcons (build_string (""), Qnil
);
3590 staticpro (&default_suffixes
);
3592 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3593 "Non-nil iff inside of `load'.");
3595 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3596 "An alist of expressions to be evalled when particular files are loaded.\n\
3597 Each element looks like (FILENAME FORMS...).\n\
3598 When `load' is run and the file-name argument is FILENAME,\n\
3599 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3600 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3601 with no directory specified, since that is how `load' is normally called.\n\
3602 An error in FORMS does not undo the load,\n\
3603 but does prevent execution of the rest of the FORMS.\n\
3604 FILENAME can also be a symbol (a feature) and FORMS are then executed\n\
3605 when the corresponding call to `provide' is made.");
3606 Vafter_load_alist
= Qnil
;
3608 DEFVAR_LISP ("load-history", &Vload_history
,
3609 "Alist mapping source file names to symbols and features.\n\
3610 Each alist element is a list that starts with a file name,\n\
3611 except for one element (optional) that starts with nil and describes\n\
3612 definitions evaluated from buffers not visiting files.\n\
3613 The remaining elements of each list are symbols defined as functions\n\
3614 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
3615 and `(autoload . SYMBOL)'.");
3616 Vload_history
= Qnil
;
3618 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3619 "Full name of file being loaded by `load'.");
3620 Vload_file_name
= Qnil
;
3622 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3623 "File name, including directory, of user's initialization file.\n\
3624 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3625 file, this variable contains the name of the .el file, suitable for use\n\
3626 by functions like `custom-save-all' which edit the init file.");
3627 Vuser_init_file
= Qnil
;
3629 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3630 "Used for internal purposes by `load'.");
3631 Vcurrent_load_list
= Qnil
;
3633 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3634 "Function used by `load' and `eval-region' for reading expressions.\n\
3635 The default is nil, which means use the function `read'.");
3636 Vload_read_function
= Qnil
;
3638 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3639 "Function called in `load' for loading an Emacs lisp source file.\n\
3640 This function is for doing code conversion before reading the source file.\n\
3641 If nil, loading is done without any code conversion.\n\
3642 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3643 FULLNAME is the full name of FILE.\n\
3644 See `load' for the meaning of the remaining arguments.");
3645 Vload_source_file_function
= Qnil
;
3647 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3648 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3649 This is useful when the file being loaded is a temporary copy.");
3650 load_force_doc_strings
= 0;
3652 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3653 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3654 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3655 and is not meant for users to change.");
3656 load_convert_to_unibyte
= 0;
3658 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3659 "Directory in which Emacs sources were found when Emacs was built.\n\
3660 You cannot count on them to still be there!");
3662 = Fexpand_file_name (build_string ("../"),
3663 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3665 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3666 "List of files that were preloaded (when dumping Emacs).");
3667 Vpreloaded_file_list
= Qnil
;
3669 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3670 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3671 Vbyte_boolean_vars
= Qnil
;
3673 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3674 "Non-nil means load dangerous compiled Lisp files.\n\
3675 Some versions of XEmacs use different byte codes than Emacs. These\n\
3676 incompatible byte codes can make Emacs crash when it tries to execute\n\
3678 load_dangerous_libraries
= 0;
3680 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3681 "Regular expression matching safe to load compiled Lisp files.\n\
3682 When Emacs loads a compiled Lisp file, it reads the first 512 bytes\n\
3683 from the file, and matches them against this regular expression.\n\
3684 When the regular expression matches, the file is considered to be safe\n\
3685 to load. See also `load-dangerous-libraries'.");
3686 Vbytecomp_version_regexp
3687 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3689 DEFVAR_LISP ("recursive-load-depth-limit", &Vrecursive_load_depth_limit
,
3690 "Limit for depth of recursive loads.\n\
3691 Value should be either an integer > 0 specifying the limit, or nil for\n\
3693 Vrecursive_load_depth_limit
= make_number (50);
3695 /* Vsource_directory was initialized in init_lread. */
3697 load_descriptor_list
= Qnil
;
3698 staticpro (&load_descriptor_list
);
3700 Qcurrent_load_list
= intern ("current-load-list");
3701 staticpro (&Qcurrent_load_list
);
3703 Qstandard_input
= intern ("standard-input");
3704 staticpro (&Qstandard_input
);
3706 Qread_char
= intern ("read-char");
3707 staticpro (&Qread_char
);
3709 Qget_file_char
= intern ("get-file-char");
3710 staticpro (&Qget_file_char
);
3712 Qbackquote
= intern ("`");
3713 staticpro (&Qbackquote
);
3714 Qcomma
= intern (",");
3715 staticpro (&Qcomma
);
3716 Qcomma_at
= intern (",@");
3717 staticpro (&Qcomma_at
);
3718 Qcomma_dot
= intern (",.");
3719 staticpro (&Qcomma_dot
);
3721 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3722 staticpro (&Qinhibit_file_name_operation
);
3724 Qascii_character
= intern ("ascii-character");
3725 staticpro (&Qascii_character
);
3727 Qfunction
= intern ("function");
3728 staticpro (&Qfunction
);
3730 Qload
= intern ("load");
3733 Qload_file_name
= intern ("load-file-name");
3734 staticpro (&Qload_file_name
);
3736 staticpro (&dump_path
);
3738 staticpro (&read_objects
);
3739 read_objects
= Qnil
;
3740 staticpro (&seen_list
);
3742 Vloads_in_progress
= Qnil
;
3743 staticpro (&Vloads_in_progress
);