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"
40 #include <sys/inode.h>
45 #include <unistd.h> /* to get X_OK */
62 #endif /* HAVE_SETLOCALE */
69 #define file_offset off_t
70 #define file_tell ftello
72 #define file_offset long
73 #define file_tell ftell
80 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
81 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
82 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
83 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
84 Lisp_Object Qinhibit_file_name_operation
;
86 extern Lisp_Object Qevent_symbol_element_mask
;
87 extern Lisp_Object Qfile_exists_p
;
89 /* non-zero if inside `load' */
92 /* Directory in which the sources were found. */
93 Lisp_Object Vsource_directory
;
95 /* Search path and suffixes for files to be loaded. */
96 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
98 /* File name of user's init file. */
99 Lisp_Object Vuser_init_file
;
101 /* This is the user-visible association list that maps features to
102 lists of defs in their load files. */
103 Lisp_Object Vload_history
;
105 /* This is used to build the load history. */
106 Lisp_Object Vcurrent_load_list
;
108 /* List of files that were preloaded. */
109 Lisp_Object Vpreloaded_file_list
;
111 /* Name of file actually being read by `load'. */
112 Lisp_Object Vload_file_name
;
114 /* Function to use for reading, in `load' and friends. */
115 Lisp_Object Vload_read_function
;
117 /* The association list of objects read with the #n=object form.
118 Each member of the list has the form (n . object), and is used to
119 look up the object for the corresponding #n# construct.
120 It must be set to nil before all top-level calls to read0. */
121 Lisp_Object read_objects
;
123 /* Nonzero means load should forcibly load all dynamic doc strings. */
124 static int load_force_doc_strings
;
126 /* Nonzero means read should convert strings to unibyte. */
127 static int load_convert_to_unibyte
;
129 /* Function to use for loading an Emacs lisp source file (not
130 compiled) instead of readevalloop. */
131 Lisp_Object Vload_source_file_function
;
133 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
134 Lisp_Object Vbyte_boolean_vars
;
136 /* Whether or not to add a `read-positions' property to symbols
138 Lisp_Object Vread_with_symbol_positions
;
140 /* List of (SYMBOL . POSITION) accumulated so far. */
141 Lisp_Object Vread_symbol_positions_list
;
143 /* List of descriptors now open for Fload. */
144 static Lisp_Object load_descriptor_list
;
146 /* File for get_file_char to read from. Use by load. */
147 static FILE *instream
;
149 /* When nonzero, read conses in pure space */
150 static int read_pure
;
152 /* For use within read-from-string (this reader is non-reentrant!!) */
153 static int read_from_string_index
;
154 static int read_from_string_index_byte
;
155 static int read_from_string_limit
;
157 /* Number of bytes left to read in the buffer character
158 that `readchar' has already advanced over. */
159 static int readchar_backlog
;
160 /* Number of characters read in the current call to Fread or
161 Fread_from_string. */
162 static int readchar_count
;
164 /* This contains the last string skipped with #@. */
165 static char *saved_doc_string
;
166 /* Length of buffer allocated in saved_doc_string. */
167 static int saved_doc_string_size
;
168 /* Length of actual data in saved_doc_string. */
169 static int saved_doc_string_length
;
170 /* This is the file position that string came from. */
171 static file_offset saved_doc_string_position
;
173 /* This contains the previous string skipped with #@.
174 We copy it from saved_doc_string when a new string
175 is put in saved_doc_string. */
176 static char *prev_saved_doc_string
;
177 /* Length of buffer allocated in prev_saved_doc_string. */
178 static int prev_saved_doc_string_size
;
179 /* Length of actual data in prev_saved_doc_string. */
180 static int prev_saved_doc_string_length
;
181 /* This is the file position that string came from. */
182 static file_offset prev_saved_doc_string_position
;
184 /* Nonzero means inside a new-style backquote
185 with no surrounding parentheses.
186 Fread initializes this to zero, so we need not specbind it
187 or worry about what happens to it when there is an error. */
188 static int new_backquote_flag
;
190 /* A list of file names for files being loaded in Fload. Used to
191 check for recursive loads. */
193 static Lisp_Object Vloads_in_progress
;
195 /* Non-zero means load dangerous compiled Lisp files. */
197 int load_dangerous_libraries
;
199 /* A regular expression used to detect files compiled with Emacs. */
201 static Lisp_Object Vbytecomp_version_regexp
;
203 static void to_multibyte
P_ ((char **, char **, int *));
204 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
205 Lisp_Object (*) (), int,
206 Lisp_Object
, Lisp_Object
));
207 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
208 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
211 /* Handle unreading and rereading of characters.
212 Write READCHAR to read a character,
213 UNREAD(c) to unread c to be read again.
215 The READCHAR and UNREAD macros are meant for reading/unreading a
216 byte code; they do not handle multibyte characters. The caller
217 should manage them if necessary.
219 [ Actually that seems to be a lie; READCHAR will definitely read
220 multibyte characters from buffer sources, at least. Is the
221 comment just out of date?
222 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
225 #define READCHAR readchar (readcharfun)
226 #define UNREAD(c) unreadchar (readcharfun, c)
229 readchar (readcharfun
)
230 Lisp_Object readcharfun
;
237 if (BUFFERP (readcharfun
))
239 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
241 int pt_byte
= BUF_PT_BYTE (inbuffer
);
242 int orig_pt_byte
= pt_byte
;
244 if (readchar_backlog
> 0)
245 /* We get the address of the byte just passed,
246 which is the last byte of the character.
247 The other bytes in this character are consecutive with it,
248 because the gap can't be in the middle of a character. */
249 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
250 - --readchar_backlog
);
252 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
255 readchar_backlog
= -1;
257 if (! NILP (inbuffer
->enable_multibyte_characters
))
259 /* Fetch the character code from the buffer. */
260 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
261 BUF_INC_POS (inbuffer
, pt_byte
);
262 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
266 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
269 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
273 if (MARKERP (readcharfun
))
275 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
277 int bytepos
= marker_byte_position (readcharfun
);
278 int orig_bytepos
= bytepos
;
280 if (readchar_backlog
> 0)
281 /* We get the address of the byte just passed,
282 which is the last byte of the character.
283 The other bytes in this character are consecutive with it,
284 because the gap can't be in the middle of a character. */
285 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
286 - --readchar_backlog
);
288 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
291 readchar_backlog
= -1;
293 if (! NILP (inbuffer
->enable_multibyte_characters
))
295 /* Fetch the character code from the buffer. */
296 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
297 BUF_INC_POS (inbuffer
, bytepos
);
298 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
302 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
306 XMARKER (readcharfun
)->bytepos
= bytepos
;
307 XMARKER (readcharfun
)->charpos
++;
312 if (EQ (readcharfun
, Qlambda
))
313 return read_bytecode_char (0);
315 if (EQ (readcharfun
, Qget_file_char
))
319 /* Interrupted reads have been observed while reading over the network */
320 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
329 if (STRINGP (readcharfun
))
331 if (read_from_string_index
>= read_from_string_limit
)
334 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
335 read_from_string_index
,
336 read_from_string_index_byte
);
341 tem
= call0 (readcharfun
);
348 /* Unread the character C in the way appropriate for the stream READCHARFUN.
349 If the stream is a user function, call it with the char as argument. */
352 unreadchar (readcharfun
, c
)
353 Lisp_Object readcharfun
;
358 /* Don't back up the pointer if we're unreading the end-of-input mark,
359 since readchar didn't advance it when we read it. */
361 else if (BUFFERP (readcharfun
))
363 struct buffer
*b
= XBUFFER (readcharfun
);
364 int bytepos
= BUF_PT_BYTE (b
);
366 if (readchar_backlog
>= 0)
371 if (! NILP (b
->enable_multibyte_characters
))
372 BUF_DEC_POS (b
, bytepos
);
376 BUF_PT_BYTE (b
) = bytepos
;
379 else if (MARKERP (readcharfun
))
381 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
382 int bytepos
= XMARKER (readcharfun
)->bytepos
;
384 if (readchar_backlog
>= 0)
388 XMARKER (readcharfun
)->charpos
--;
389 if (! NILP (b
->enable_multibyte_characters
))
390 BUF_DEC_POS (b
, bytepos
);
394 XMARKER (readcharfun
)->bytepos
= bytepos
;
397 else if (STRINGP (readcharfun
))
399 read_from_string_index
--;
400 read_from_string_index_byte
401 = string_char_to_byte (readcharfun
, read_from_string_index
);
403 else if (EQ (readcharfun
, Qlambda
))
404 read_bytecode_char (1);
405 else if (EQ (readcharfun
, Qget_file_char
))
406 ungetc (c
, instream
);
408 call1 (readcharfun
, make_number (c
));
411 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
413 static Lisp_Object read0
P_ ((Lisp_Object
));
414 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
416 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
417 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
418 static int read_multibyte
P_ ((int, Lisp_Object
));
420 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
422 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
424 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
427 /* Get a character from the tty. */
429 extern Lisp_Object
read_char ();
431 /* Read input events until we get one that's acceptable for our purposes.
433 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
434 until we get a character we like, and then stuffed into
437 If ASCII_REQUIRED is non-zero, we check function key events to see
438 if the unmodified version of the symbol has a Qascii_character
439 property, and use that character, if present.
441 If ERROR_NONASCII is non-zero, we signal an error if the input we
442 get isn't an ASCII character with modifiers. If it's zero but
443 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
446 If INPUT_METHOD is nonzero, we invoke the current input method
447 if the character warrants that. */
450 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
452 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
454 register Lisp_Object val
, delayed_switch_frame
;
456 #ifdef HAVE_WINDOW_SYSTEM
457 if (display_hourglass_p
)
461 delayed_switch_frame
= Qnil
;
463 /* Read until we get an acceptable event. */
465 val
= read_char (0, 0, 0,
466 (input_method
? Qnil
: Qt
),
472 /* switch-frame events are put off until after the next ASCII
473 character. This is better than signaling an error just because
474 the last characters were typed to a separate minibuffer frame,
475 for example. Eventually, some code which can deal with
476 switch-frame events will read it and process it. */
478 && EVENT_HAS_PARAMETERS (val
)
479 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
481 delayed_switch_frame
= val
;
487 /* Convert certain symbols to their ASCII equivalents. */
490 Lisp_Object tem
, tem1
;
491 tem
= Fget (val
, Qevent_symbol_element_mask
);
494 tem1
= Fget (Fcar (tem
), Qascii_character
);
495 /* Merge this symbol's modifier bits
496 with the ASCII equivalent of its basic code. */
498 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
502 /* If we don't have a character now, deal with it appropriately. */
507 Vunread_command_events
= Fcons (val
, Qnil
);
508 error ("Non-character input-event");
515 if (! NILP (delayed_switch_frame
))
516 unread_switch_frame
= delayed_switch_frame
;
520 #ifdef HAVE_WINDOW_SYSTEM
521 if (display_hourglass_p
)
530 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
531 doc
: /* Read a character from the command input (keyboard or macro).
532 It is returned as a number.
533 If the user generates an event which is not a character (i.e. a mouse
534 click or function key event), `read-char' signals an error. As an
535 exception, switch-frame events are put off until non-ASCII events can
537 If you want to read non-character events, or ignore them, call
538 `read-event' or `read-char-exclusive' instead.
540 If the optional argument PROMPT is non-nil, display that as a prompt.
541 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
542 input method is turned on in the current buffer, that input method
543 is used for reading a character. */)
544 (prompt
, inherit_input_method
)
545 Lisp_Object prompt
, inherit_input_method
;
548 message_with_string ("%s", prompt
, 0);
549 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
552 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
553 doc
: /* Read an event object from the input stream.
554 If the optional argument PROMPT is non-nil, display that as a prompt.
555 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
556 input method is turned on in the current buffer, that input method
557 is used for reading a character. */)
558 (prompt
, inherit_input_method
)
559 Lisp_Object prompt
, inherit_input_method
;
562 message_with_string ("%s", prompt
, 0);
563 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
566 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
567 doc
: /* Read a character from the command input (keyboard or macro).
568 It is returned as a number. Non-character events are ignored.
570 If the optional argument PROMPT is non-nil, display that as a prompt.
571 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
572 input method is turned on in the current buffer, that input method
573 is used for reading a character. */)
574 (prompt
, inherit_input_method
)
575 Lisp_Object prompt
, inherit_input_method
;
578 message_with_string ("%s", prompt
, 0);
579 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
582 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
583 doc
: /* Don't use this yourself. */)
586 register Lisp_Object val
;
587 XSETINT (val
, getc (instream
));
593 /* Value is non-zero if the file asswociated with file descriptor FD
594 is a compiled Lisp file that's safe to load. Only files compiled
595 with Emacs are safe to load. Files compiled with XEmacs can lead
596 to a crash in Fbyte_code because of an incompatible change in the
607 /* Read the first few bytes from the file, and look for a line
608 specifying the byte compiler version used. */
609 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
614 /* Skip to the next newline, skipping over the initial `ELC'
615 with NUL bytes following it. */
616 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
620 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
625 lseek (fd
, 0, SEEK_SET
);
630 /* Callback for record_unwind_protect. Restore the old load list OLD,
631 after loading a file successfully. */
634 record_load_unwind (old
)
637 return Vloads_in_progress
= old
;
641 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
642 doc
: /* Execute a file of Lisp code named FILE.
643 First try FILE with `.elc' appended, then try with `.el',
644 then try FILE unmodified (the exact suffixes are determined by
645 `load-suffixes'). Environment variable references in FILE
646 are replaced with their values by calling `substitute-in-file-name'.
647 This function searches the directories in `load-path'.
648 If optional second arg NOERROR is non-nil,
649 report no error if FILE doesn't exist.
650 Print messages at start and end of loading unless
651 optional third arg NOMESSAGE is non-nil.
652 If optional fourth arg NOSUFFIX is non-nil, don't try adding
653 suffixes `.elc' or `.el' to the specified name FILE.
654 If optional fifth arg MUST-SUFFIX is non-nil, insist on
655 the suffix `.elc' or `.el'; don't accept just FILE unless
656 it ends in one of those suffixes or includes a directory name.
657 Return t if file exists. */)
658 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
659 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
661 register FILE *stream
;
662 register int fd
= -1;
663 register Lisp_Object lispstream
;
664 int count
= SPECPDL_INDEX ();
667 Lisp_Object found
, efound
;
668 /* 1 means we printed the ".el is newer" message. */
670 /* 1 means we are loading a compiled file. */
681 /* If file name is magic, call the handler. */
682 /* This shouldn't be necessary any more now that `openp' handles it right.
683 handler = Ffind_file_name_handler (file, Qload);
685 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
687 /* Do this after the handler to avoid
688 the need to gcpro noerror, nomessage and nosuffix.
689 (Below here, we care only whether they are nil or not.)
690 The presence of this call is the result of a historical accident:
691 it used to be in every file-operations and when it got removed
692 everywhere, it accidentally stayed here. Since then, enough people
693 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
694 that it seemed risky to remove. */
695 file
= Fsubstitute_in_file_name (file
);
697 /* Avoid weird lossage with null string as arg,
698 since it would try to load a directory as a Lisp file */
699 if (SCHARS (file
) > 0)
701 int size
= SBYTES (file
);
706 if (! NILP (must_suffix
))
708 /* Don't insist on adding a suffix if FILE already ends with one. */
710 && !strcmp (SDATA (file
) + size
- 3, ".el"))
713 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
715 /* Don't insist on adding a suffix
716 if the argument includes a directory name. */
717 else if (! NILP (Ffile_name_directory (file
)))
721 fd
= openp (Vload_path
, file
,
722 (!NILP (nosuffix
) ? Qnil
723 : !NILP (must_suffix
) ? Vload_suffixes
724 : Fappend (2, (tmp
[0] = Vload_suffixes
,
725 tmp
[1] = default_suffixes
,
735 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
736 Fcons (file
, Qnil
)));
741 /* Tell startup.el whether or not we found the user's init file. */
742 if (EQ (Qt
, Vuser_init_file
))
743 Vuser_init_file
= found
;
745 /* If FD is -2, that means openp found a magic file. */
748 if (NILP (Fequal (found
, file
)))
749 /* If FOUND is a different file name from FILE,
750 find its handler even if we have already inhibited
751 the `load' operation on FILE. */
752 handler
= Ffind_file_name_handler (found
, Qt
);
754 handler
= Ffind_file_name_handler (found
, Qload
);
755 if (! NILP (handler
))
756 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
759 /* Check if we're stuck in a recursive load cycle.
761 2000-09-21: It's not possible to just check for the file loaded
762 being a member of Vloads_in_progress. This fails because of the
763 way the byte compiler currently works; `provide's are not
764 evaluted, see font-lock.el/jit-lock.el as an example. This
765 leads to a certain amount of ``normal'' recursion.
767 Also, just loading a file recursively is not always an error in
768 the general case; the second load may do something different. */
772 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
773 if (!NILP (Fequal (found
, XCAR (tem
))))
776 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
777 Fcons (found
, Vloads_in_progress
)));
778 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
779 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
782 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
784 /* Load .elc files directly, but not when they are
785 remote and have no handler! */
792 if (!safe_to_load_p (fd
))
795 if (!load_dangerous_libraries
)
796 error ("File `%s' was not compiled in Emacs",
798 else if (!NILP (nomessage
))
799 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
805 efound
= ENCODE_FILE (found
);
810 stat ((char *)SDATA (efound
), &s1
);
811 SSET (efound
, SBYTES (efound
) - 1, 0);
812 result
= stat ((char *)SDATA (efound
), &s2
);
813 SSET (efound
, SBYTES (efound
) - 1, 'c');
816 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
818 /* Make the progress messages mention that source is newer. */
821 /* If we won't print another message, mention this anyway. */
822 if (!NILP (nomessage
))
825 file
= Fsubstring (found
, make_number (0), make_number (-1));
826 message_with_string ("Source file `%s' newer than byte-compiled file",
827 file
, STRING_MULTIBYTE (file
));
834 /* We are loading a source file (*.el). */
835 if (!NILP (Vload_source_file_function
))
841 val
= call4 (Vload_source_file_function
, found
, file
,
842 NILP (noerror
) ? Qnil
: Qt
,
843 NILP (nomessage
) ? Qnil
: Qt
);
844 return unbind_to (count
, val
);
851 efound
= ENCODE_FILE (found
);
852 stream
= fopen ((char *) SDATA (efound
), fmode
);
854 #else /* not WINDOWSNT */
855 stream
= fdopen (fd
, fmode
);
856 #endif /* not WINDOWSNT */
860 error ("Failure to create stdio stream for %s", SDATA (file
));
863 if (! NILP (Vpurify_flag
))
864 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
866 if (NILP (nomessage
))
869 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
872 message_with_string ("Loading %s (source)...", file
, 1);
874 message_with_string ("Loading %s (compiled; note, source file is newer)...",
876 else /* The typical case; compiled file newer than source file. */
877 message_with_string ("Loading %s...", file
, 1);
881 lispstream
= Fcons (Qnil
, Qnil
);
882 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
883 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
884 record_unwind_protect (load_unwind
, lispstream
);
885 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
886 specbind (Qload_file_name
, found
);
887 specbind (Qinhibit_file_name_operation
, Qnil
);
889 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
891 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
892 unbind_to (count
, Qnil
);
894 /* Run any load-hooks for this file. */
895 temp
= Fassoc (file
, Vafter_load_alist
);
897 Fprogn (Fcdr (temp
));
900 if (saved_doc_string
)
901 free (saved_doc_string
);
902 saved_doc_string
= 0;
903 saved_doc_string_size
= 0;
905 if (prev_saved_doc_string
)
906 xfree (prev_saved_doc_string
);
907 prev_saved_doc_string
= 0;
908 prev_saved_doc_string_size
= 0;
910 if (!noninteractive
&& NILP (nomessage
))
913 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
916 message_with_string ("Loading %s (source)...done", file
, 1);
918 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
920 else /* The typical case; compiled file newer than source file. */
921 message_with_string ("Loading %s...done", file
, 1);
928 load_unwind (stream
) /* used as unwind-protect function in load */
931 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
932 | XFASTINT (XCDR (stream
))));
933 if (--load_in_progress
< 0) load_in_progress
= 0;
938 load_descriptor_unwind (oldlist
)
941 load_descriptor_list
= oldlist
;
945 /* Close all descriptors in use for Floads.
946 This is used when starting a subprocess. */
953 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
954 emacs_close (XFASTINT (XCAR (tail
)));
959 complete_filename_p (pathname
)
960 Lisp_Object pathname
;
962 register const unsigned char *s
= SDATA (pathname
);
963 return (IS_DIRECTORY_SEP (s
[0])
964 || (SCHARS (pathname
) > 2
965 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
975 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
976 doc
: /* Search for FILENAME through PATH.
977 If SUFFIXES is non-nil, it should be a list of suffixes to append to
978 file name when searching.
979 If non-nil, PREDICATE is used instead of `file-readable-p'.
980 PREDICATE can also be an integer to pass to the access(2) function,
981 in which case file-name-handlers are ignored. */)
982 (filename
, path
, suffixes
, predicate
)
983 Lisp_Object filename
, path
, suffixes
, predicate
;
986 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
987 if (NILP (predicate
) && fd
> 0)
993 /* Search for a file whose name is STR, looking in directories
994 in the Lisp list PATH, and trying suffixes from SUFFIX.
995 On success, returns a file descriptor. On failure, returns -1.
997 SUFFIXES is a list of strings containing possible suffixes.
998 The empty suffix is automatically added iff the list is empty.
1000 PREDICATE non-nil means don't open the files,
1001 just look for one that satisfies the predicate. In this case,
1002 returns 1 on success. The predicate can be a lisp function or
1003 an integer to pass to `access' (in which case file-name-handlers
1006 If STOREPTR is nonzero, it points to a slot where the name of
1007 the file actually found should be stored as a Lisp string.
1008 nil is stored there on failure.
1010 If the file we find is remote, return -2
1011 but store the found remote file name in *STOREPTR. */
1014 openp (path
, str
, suffixes
, storeptr
, predicate
)
1015 Lisp_Object path
, str
;
1016 Lisp_Object suffixes
;
1017 Lisp_Object
*storeptr
;
1018 Lisp_Object predicate
;
1023 register char *fn
= buf
;
1026 Lisp_Object filename
;
1028 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1029 Lisp_Object string
, tail
, encoded_fn
;
1030 int max_suffix_len
= 0;
1032 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1034 CHECK_STRING_CAR (tail
);
1035 max_suffix_len
= max (max_suffix_len
,
1036 SBYTES (XCAR (tail
)));
1039 string
= filename
= Qnil
;
1040 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1045 if (complete_filename_p (str
))
1048 for (; CONSP (path
); path
= XCDR (path
))
1050 filename
= Fexpand_file_name (str
, XCAR (path
));
1051 if (!complete_filename_p (filename
))
1052 /* If there are non-absolute elts in PATH (eg ".") */
1053 /* Of course, this could conceivably lose if luser sets
1054 default-directory to be something non-absolute... */
1056 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1057 if (!complete_filename_p (filename
))
1058 /* Give up on this path element! */
1062 /* Calculate maximum size of any filename made from
1063 this path element/specified file name and any possible suffix. */
1064 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1065 if (fn_size
< want_size
)
1066 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1068 /* Loop over suffixes. */
1069 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1070 CONSP (tail
); tail
= XCDR (tail
))
1072 int lsuffix
= SBYTES (XCAR (tail
));
1073 Lisp_Object handler
;
1076 /* Concatenate path element/specified name with the suffix.
1077 If the directory starts with /:, remove that. */
1078 if (SCHARS (filename
) > 2
1079 && SREF (filename
, 0) == '/'
1080 && SREF (filename
, 1) == ':')
1082 strncpy (fn
, SDATA (filename
) + 2,
1083 SBYTES (filename
) - 2);
1084 fn
[SBYTES (filename
) - 2] = 0;
1088 strncpy (fn
, SDATA (filename
),
1090 fn
[SBYTES (filename
)] = 0;
1093 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1094 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1096 /* Check that the file exists and is not a directory. */
1097 /* We used to only check for handlers on non-absolute file names:
1101 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1102 It's not clear why that was the case and it breaks things like
1103 (load "/bar.el") where the file is actually "/bar.el.gz". */
1104 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1105 string
= build_string (fn
);
1106 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1108 if (NILP (predicate
))
1109 exists
= !NILP (Ffile_readable_p (string
));
1111 exists
= !NILP (call1 (predicate
, string
));
1112 if (exists
&& !NILP (Ffile_directory_p (string
)))
1117 /* We succeeded; return this descriptor and filename. */
1128 encoded_fn
= ENCODE_FILE (string
);
1129 pfn
= SDATA (encoded_fn
);
1130 exists
= (stat (pfn
, &st
) >= 0
1131 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1134 /* Check that we can access or open it. */
1135 if (NATNUMP (predicate
))
1136 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1138 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1142 /* We succeeded; return this descriptor and filename. */
1160 /* Merge the list we've accumulated of globals from the current input source
1161 into the load_history variable. The details depend on whether
1162 the source has an associated file name or not. */
1165 build_load_history (stream
, source
)
1169 register Lisp_Object tail
, prev
, newelt
;
1170 register Lisp_Object tem
, tem2
;
1171 register int foundit
, loading
;
1173 loading
= stream
|| !NARROWED
;
1175 tail
= Vload_history
;
1178 while (CONSP (tail
))
1182 /* Find the feature's previous assoc list... */
1183 if (!NILP (Fequal (source
, Fcar (tem
))))
1187 /* If we're loading, remove it. */
1191 Vload_history
= XCDR (tail
);
1193 Fsetcdr (prev
, XCDR (tail
));
1196 /* Otherwise, cons on new symbols that are not already members. */
1199 tem2
= Vcurrent_load_list
;
1201 while (CONSP (tem2
))
1203 newelt
= XCAR (tem2
);
1205 if (NILP (Fmember (newelt
, tem
)))
1206 Fsetcar (tail
, Fcons (XCAR (tem
),
1207 Fcons (newelt
, XCDR (tem
))));
1220 /* If we're loading, cons the new assoc onto the front of load-history,
1221 the most-recently-loaded position. Also do this if we didn't find
1222 an existing member for the current source. */
1223 if (loading
|| !foundit
)
1224 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1229 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1237 readevalloop_1 (old
)
1240 load_convert_to_unibyte
= ! NILP (old
);
1244 /* Signal an `end-of-file' error, if possible with file name
1248 end_of_file_error ()
1252 if (STRINGP (Vload_file_name
))
1253 data
= Fcons (Vload_file_name
, Qnil
);
1257 Fsignal (Qend_of_file
, data
);
1260 /* UNIBYTE specifies how to set load_convert_to_unibyte
1261 for this invocation.
1262 READFUN, if non-nil, is used instead of `read'. */
1265 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1266 Lisp_Object readcharfun
;
1268 Lisp_Object sourcename
;
1269 Lisp_Object (*evalfun
) ();
1271 Lisp_Object unibyte
, readfun
;
1274 register Lisp_Object val
;
1275 int count
= SPECPDL_INDEX ();
1276 struct gcpro gcpro1
;
1277 struct buffer
*b
= 0;
1278 int continue_reading_p
;
1280 if (BUFFERP (readcharfun
))
1281 b
= XBUFFER (readcharfun
);
1282 else if (MARKERP (readcharfun
))
1283 b
= XMARKER (readcharfun
)->buffer
;
1285 specbind (Qstandard_input
, readcharfun
);
1286 specbind (Qcurrent_load_list
, Qnil
);
1287 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1288 load_convert_to_unibyte
= !NILP (unibyte
);
1290 readchar_backlog
= -1;
1292 GCPRO1 (sourcename
);
1294 LOADHIST_ATTACH (sourcename
);
1296 continue_reading_p
= 1;
1297 while (continue_reading_p
)
1299 if (b
!= 0 && NILP (b
->name
))
1300 error ("Reading from killed buffer");
1306 while ((c
= READCHAR
) != '\n' && c
!= -1);
1311 /* Ignore whitespace here, so we can detect eof. */
1312 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1315 if (!NILP (Vpurify_flag
) && c
== '(')
1317 int count1
= SPECPDL_INDEX ();
1318 record_unwind_protect (unreadpure
, Qnil
);
1319 val
= read_list (-1, readcharfun
);
1320 unbind_to (count1
, Qnil
);
1325 read_objects
= Qnil
;
1326 if (!NILP (readfun
))
1328 val
= call1 (readfun
, readcharfun
);
1330 /* If READCHARFUN has set point to ZV, we should
1331 stop reading, even if the form read sets point
1332 to a different value when evaluated. */
1333 if (BUFFERP (readcharfun
))
1335 struct buffer
*b
= XBUFFER (readcharfun
);
1336 if (BUF_PT (b
) == BUF_ZV (b
))
1337 continue_reading_p
= 0;
1340 else if (! NILP (Vload_read_function
))
1341 val
= call1 (Vload_read_function
, readcharfun
);
1343 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1346 val
= (*evalfun
) (val
);
1350 Vvalues
= Fcons (val
, Vvalues
);
1351 if (EQ (Vstandard_output
, Qt
))
1358 build_load_history (stream
, sourcename
);
1361 unbind_to (count
, Qnil
);
1364 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1365 doc
: /* Execute the current buffer as Lisp code.
1366 Programs can pass two arguments, BUFFER and PRINTFLAG.
1367 BUFFER is the buffer to evaluate (nil means use current buffer).
1368 PRINTFLAG controls printing of output:
1369 nil means discard it; anything else is stream for print.
1371 If the optional third argument FILENAME is non-nil,
1372 it specifies the file name to use for `load-history'.
1373 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1374 for this invocation.
1376 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1377 `print' and related functions should work normally even if PRINTFLAG is nil.
1379 This function preserves the position of point. */)
1380 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1381 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1383 int count
= SPECPDL_INDEX ();
1384 Lisp_Object tem
, buf
;
1387 buf
= Fcurrent_buffer ();
1389 buf
= Fget_buffer (buffer
);
1391 error ("No such buffer");
1393 if (NILP (printflag
) && NILP (do_allow_print
))
1398 if (NILP (filename
))
1399 filename
= XBUFFER (buf
)->filename
;
1401 specbind (Qstandard_output
, tem
);
1402 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1403 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1404 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1405 unbind_to (count
, Qnil
);
1410 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1411 doc
: /* Execute the region as Lisp code.
1412 When called from programs, expects two arguments,
1413 giving starting and ending indices in the current buffer
1414 of the text to be executed.
1415 Programs can pass third argument PRINTFLAG which controls output:
1416 nil means discard it; anything else is stream for printing it.
1417 Also the fourth argument READ-FUNCTION, if non-nil, is used
1418 instead of `read' to read each expression. It gets one argument
1419 which is the input stream for reading characters.
1421 This function does not move point. */)
1422 (start
, end
, printflag
, read_function
)
1423 Lisp_Object start
, end
, printflag
, read_function
;
1425 int count
= SPECPDL_INDEX ();
1426 Lisp_Object tem
, cbuf
;
1428 cbuf
= Fcurrent_buffer ();
1430 if (NILP (printflag
))
1434 specbind (Qstandard_output
, tem
);
1436 if (NILP (printflag
))
1437 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1438 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1440 /* This both uses start and checks its type. */
1442 Fnarrow_to_region (make_number (BEGV
), end
);
1443 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1444 !NILP (printflag
), Qnil
, read_function
);
1446 return unbind_to (count
, Qnil
);
1450 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1451 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1452 If STREAM is nil, use the value of `standard-input' (which see).
1453 STREAM or the value of `standard-input' may be:
1454 a buffer (read from point and advance it)
1455 a marker (read from where it points and advance it)
1456 a function (call it with no arguments for each character,
1457 call it with a char as argument to push a char back)
1458 a string (takes text from string, starting at the beginning)
1459 t (read text line using minibuffer and use it, or read from
1460 standard input in batch mode). */)
1465 stream
= Vstandard_input
;
1466 if (EQ (stream
, Qt
))
1467 stream
= Qread_char
;
1468 if (EQ (stream
, Qread_char
))
1469 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1471 return read_internal_start (stream
, Qnil
, Qnil
);
1474 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1475 doc
: /* Read one Lisp expression which is represented as text by STRING.
1476 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1477 START and END optionally delimit a substring of STRING from which to read;
1478 they default to 0 and (length STRING) respectively. */)
1479 (string
, start
, end
)
1480 Lisp_Object string
, start
, end
;
1483 CHECK_STRING (string
);
1484 /* read_internal_start sets read_from_string_index. */
1485 ret
= read_internal_start (string
, start
, end
);
1486 return Fcons (ret
, make_number (read_from_string_index
));
1489 /* Function to set up the global context we need in toplevel read
1492 read_internal_start (stream
, start
, end
)
1494 Lisp_Object start
; /* Only used when stream is a string. */
1495 Lisp_Object end
; /* Only used when stream is a string. */
1499 readchar_backlog
= -1;
1501 new_backquote_flag
= 0;
1502 read_objects
= Qnil
;
1503 if (EQ (Vread_with_symbol_positions
, Qt
)
1504 || EQ (Vread_with_symbol_positions
, stream
))
1505 Vread_symbol_positions_list
= Qnil
;
1507 if (STRINGP (stream
))
1509 int startval
, endval
;
1511 endval
= SCHARS (stream
);
1515 endval
= XINT (end
);
1516 if (endval
< 0 || endval
> SCHARS (stream
))
1517 args_out_of_range (stream
, end
);
1524 CHECK_NUMBER (start
);
1525 startval
= XINT (start
);
1526 if (startval
< 0 || startval
> endval
)
1527 args_out_of_range (stream
, start
);
1529 read_from_string_index
= startval
;
1530 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1531 read_from_string_limit
= endval
;
1534 retval
= read0 (stream
);
1535 if (EQ (Vread_with_symbol_positions
, Qt
)
1536 || EQ (Vread_with_symbol_positions
, stream
))
1537 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1541 /* Use this for recursive reads, in contexts where internal tokens
1546 Lisp_Object readcharfun
;
1548 register Lisp_Object val
;
1551 val
= read1 (readcharfun
, &c
, 0);
1553 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1560 static int read_buffer_size
;
1561 static char *read_buffer
;
1563 /* Read multibyte form and return it as a character. C is a first
1564 byte of multibyte form, and rest of them are read from
1568 read_multibyte (c
, readcharfun
)
1570 Lisp_Object readcharfun
;
1572 /* We need the actual character code of this multibyte
1574 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1582 while ((c
= READCHAR
) >= 0xA0
1583 && len
< MAX_MULTIBYTE_LENGTH
)
1589 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1590 return STRING_CHAR (str
, len
);
1591 /* The byte sequence is not valid as multibyte. Unread all bytes
1592 but the first one, and return the first byte. */
1598 /* Read a \-escape sequence, assuming we already read the `\'.
1599 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1600 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1601 Otherwise store 0 into *BYTEREP. */
1604 read_escape (readcharfun
, stringp
, byterep
)
1605 Lisp_Object readcharfun
;
1609 register int c
= READCHAR
;
1616 end_of_file_error ();
1646 error ("Invalid escape character syntax");
1649 c
= read_escape (readcharfun
, 0, byterep
);
1650 return c
| meta_modifier
;
1655 error ("Invalid escape character syntax");
1658 c
= read_escape (readcharfun
, 0, byterep
);
1659 return c
| shift_modifier
;
1664 error ("Invalid escape character syntax");
1667 c
= read_escape (readcharfun
, 0, byterep
);
1668 return c
| hyper_modifier
;
1673 error ("Invalid escape character syntax");
1676 c
= read_escape (readcharfun
, 0, byterep
);
1677 return c
| alt_modifier
;
1682 error ("Invalid escape character syntax");
1685 c
= read_escape (readcharfun
, 0, byterep
);
1686 return c
| super_modifier
;
1691 error ("Invalid escape character syntax");
1695 c
= read_escape (readcharfun
, 0, byterep
);
1696 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1697 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1698 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1699 return c
| ctrl_modifier
;
1700 /* ASCII control chars are made from letters (both cases),
1701 as well as the non-letters within 0100...0137. */
1702 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1703 return (c
& (037 | ~0177));
1704 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1705 return (c
& (037 | ~0177));
1707 return c
| ctrl_modifier
;
1717 /* An octal escape, as in ANSI C. */
1719 register int i
= c
- '0';
1720 register int count
= 0;
1723 if ((c
= READCHAR
) >= '0' && c
<= '7')
1740 /* A hex escape, as in ANSI C. */
1746 if (c
>= '0' && c
<= '9')
1751 else if ((c
>= 'a' && c
<= 'f')
1752 || (c
>= 'A' && c
<= 'F'))
1755 if (c
>= 'a' && c
<= 'f')
1772 if (BASE_LEADING_CODE_P (c
))
1773 c
= read_multibyte (c
, readcharfun
);
1779 /* Read an integer in radix RADIX using READCHARFUN to read
1780 characters. RADIX must be in the interval [2..36]; if it isn't, a
1781 read error is signaled . Value is the integer read. Signals an
1782 error if encountering invalid read syntax or if RADIX is out of
1786 read_integer (readcharfun
, radix
)
1787 Lisp_Object readcharfun
;
1790 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1791 EMACS_INT number
= 0;
1793 if (radix
< 2 || radix
> 36)
1797 number
= ndigits
= invalid_p
= 0;
1813 if (c
>= '0' && c
<= '9')
1815 else if (c
>= 'a' && c
<= 'z')
1816 digit
= c
- 'a' + 10;
1817 else if (c
>= 'A' && c
<= 'Z')
1818 digit
= c
- 'A' + 10;
1825 if (digit
< 0 || digit
>= radix
)
1828 number
= radix
* number
+ digit
;
1834 if (ndigits
== 0 || invalid_p
)
1837 sprintf (buf
, "integer, radix %d", radix
);
1838 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1841 return make_number (sign
* number
);
1845 /* Convert unibyte text in read_buffer to multibyte.
1847 Initially, *P is a pointer after the end of the unibyte text, and
1848 the pointer *END points after the end of read_buffer.
1850 If read_buffer doesn't have enough room to hold the result
1851 of the conversion, reallocate it and adjust *P and *END.
1853 At the end, make *P point after the result of the conversion, and
1854 return in *NCHARS the number of characters in the converted
1858 to_multibyte (p
, end
, nchars
)
1864 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1865 if (read_buffer_size
< 2 * nbytes
)
1867 int offset
= *p
- read_buffer
;
1868 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1869 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1870 *p
= read_buffer
+ offset
;
1871 *end
= read_buffer
+ read_buffer_size
;
1874 if (nbytes
!= *nchars
)
1875 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1876 *p
- read_buffer
, nchars
);
1878 *p
= read_buffer
+ nbytes
;
1882 /* If the next token is ')' or ']' or '.', we store that character
1883 in *PCH and the return value is not interesting. Else, we store
1884 zero in *PCH and we read and return one lisp object.
1886 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1889 read1 (readcharfun
, pch
, first_in_list
)
1890 register Lisp_Object readcharfun
;
1895 int uninterned_symbol
= 0;
1903 end_of_file_error ();
1908 return read_list (0, readcharfun
);
1911 return read_vector (readcharfun
, 0);
1928 tmp
= read_vector (readcharfun
, 0);
1929 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1930 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1931 error ("Invalid size char-table");
1932 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1933 XCHAR_TABLE (tmp
)->top
= Qt
;
1942 tmp
= read_vector (readcharfun
, 0);
1943 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1944 error ("Invalid size char-table");
1945 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1946 XCHAR_TABLE (tmp
)->top
= Qnil
;
1949 Fsignal (Qinvalid_read_syntax
,
1950 Fcons (make_string ("#^^", 3), Qnil
));
1952 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1957 length
= read1 (readcharfun
, pch
, first_in_list
);
1961 Lisp_Object tmp
, val
;
1962 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1966 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1967 if (size_in_chars
!= SCHARS (tmp
)
1968 /* We used to print 1 char too many
1969 when the number of bits was a multiple of 8.
1970 Accept such input in case it came from an old version. */
1971 && ! (XFASTINT (length
)
1972 == (SCHARS (tmp
) - 1) * BITS_PER_CHAR
))
1973 Fsignal (Qinvalid_read_syntax
,
1974 Fcons (make_string ("#&...", 5), Qnil
));
1976 val
= Fmake_bool_vector (length
, Qnil
);
1977 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
1979 /* Clear the extraneous bits in the last byte. */
1980 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1981 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1982 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1985 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1990 /* Accept compiled functions at read-time so that we don't have to
1991 build them using function calls. */
1993 tmp
= read_vector (readcharfun
, 1);
1994 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1995 XVECTOR (tmp
)->contents
);
2000 struct gcpro gcpro1
;
2003 /* Read the string itself. */
2004 tmp
= read1 (readcharfun
, &ch
, 0);
2005 if (ch
!= 0 || !STRINGP (tmp
))
2006 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2008 /* Read the intervals and their properties. */
2011 Lisp_Object beg
, end
, plist
;
2013 beg
= read1 (readcharfun
, &ch
, 0);
2018 end
= read1 (readcharfun
, &ch
, 0);
2020 plist
= read1 (readcharfun
, &ch
, 0);
2022 Fsignal (Qinvalid_read_syntax
,
2023 Fcons (build_string ("invalid string property list"),
2025 Fset_text_properties (beg
, end
, plist
, tmp
);
2031 /* #@NUMBER is used to skip NUMBER following characters.
2032 That's used in .elc files to skip over doc strings
2033 and function definitions. */
2038 /* Read a decimal integer. */
2039 while ((c
= READCHAR
) >= 0
2040 && c
>= '0' && c
<= '9')
2048 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2050 /* If we are supposed to force doc strings into core right now,
2051 record the last string that we skipped,
2052 and record where in the file it comes from. */
2054 /* But first exchange saved_doc_string
2055 with prev_saved_doc_string, so we save two strings. */
2057 char *temp
= saved_doc_string
;
2058 int temp_size
= saved_doc_string_size
;
2059 file_offset temp_pos
= saved_doc_string_position
;
2060 int temp_len
= saved_doc_string_length
;
2062 saved_doc_string
= prev_saved_doc_string
;
2063 saved_doc_string_size
= prev_saved_doc_string_size
;
2064 saved_doc_string_position
= prev_saved_doc_string_position
;
2065 saved_doc_string_length
= prev_saved_doc_string_length
;
2067 prev_saved_doc_string
= temp
;
2068 prev_saved_doc_string_size
= temp_size
;
2069 prev_saved_doc_string_position
= temp_pos
;
2070 prev_saved_doc_string_length
= temp_len
;
2073 if (saved_doc_string_size
== 0)
2075 saved_doc_string_size
= nskip
+ 100;
2076 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2078 if (nskip
> saved_doc_string_size
)
2080 saved_doc_string_size
= nskip
+ 100;
2081 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2082 saved_doc_string_size
);
2085 saved_doc_string_position
= file_tell (instream
);
2087 /* Copy that many characters into saved_doc_string. */
2088 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2089 saved_doc_string
[i
] = c
= READCHAR
;
2091 saved_doc_string_length
= i
;
2095 /* Skip that many characters. */
2096 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2104 /* #! appears at the beginning of an executable file.
2105 Skip the first line. */
2111 return Vload_file_name
;
2113 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2114 /* #:foo is the uninterned symbol named foo. */
2117 uninterned_symbol
= 1;
2121 /* Reader forms that can reuse previously read objects. */
2122 if (c
>= '0' && c
<= '9')
2127 /* Read a non-negative integer. */
2128 while (c
>= '0' && c
<= '9')
2134 /* #n=object returns object, but associates it with n for #n#. */
2137 /* Make a placeholder for #n# to use temporarily */
2138 Lisp_Object placeholder
;
2141 placeholder
= Fcons(Qnil
, Qnil
);
2142 cell
= Fcons (make_number (n
), placeholder
);
2143 read_objects
= Fcons (cell
, read_objects
);
2145 /* Read the object itself. */
2146 tem
= read0 (readcharfun
);
2148 /* Now put it everywhere the placeholder was... */
2149 substitute_object_in_subtree (tem
, placeholder
);
2151 /* ...and #n# will use the real value from now on. */
2152 Fsetcdr (cell
, tem
);
2156 /* #n# returns a previously read object. */
2159 tem
= Fassq (make_number (n
), read_objects
);
2162 /* Fall through to error message. */
2164 else if (c
== 'r' || c
== 'R')
2165 return read_integer (readcharfun
, n
);
2167 /* Fall through to error message. */
2169 else if (c
== 'x' || c
== 'X')
2170 return read_integer (readcharfun
, 16);
2171 else if (c
== 'o' || c
== 'O')
2172 return read_integer (readcharfun
, 8);
2173 else if (c
== 'b' || c
== 'B')
2174 return read_integer (readcharfun
, 2);
2177 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2180 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2185 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2195 new_backquote_flag
++;
2196 value
= read0 (readcharfun
);
2197 new_backquote_flag
--;
2199 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2203 if (new_backquote_flag
)
2205 Lisp_Object comma_type
= Qnil
;
2210 comma_type
= Qcomma_at
;
2212 comma_type
= Qcomma_dot
;
2215 if (ch
>= 0) UNREAD (ch
);
2216 comma_type
= Qcomma
;
2219 new_backquote_flag
--;
2220 value
= read0 (readcharfun
);
2221 new_backquote_flag
++;
2222 return Fcons (comma_type
, Fcons (value
, Qnil
));
2233 end_of_file_error ();
2236 c
= read_escape (readcharfun
, 0, &discard
);
2237 else if (BASE_LEADING_CODE_P (c
))
2238 c
= read_multibyte (c
, readcharfun
);
2240 return make_number (c
);
2245 char *p
= read_buffer
;
2246 char *end
= read_buffer
+ read_buffer_size
;
2248 /* 1 if we saw an escape sequence specifying
2249 a multibyte character, or a multibyte character. */
2250 int force_multibyte
= 0;
2251 /* 1 if we saw an escape sequence specifying
2252 a single-byte character. */
2253 int force_singlebyte
= 0;
2254 /* 1 if read_buffer contains multibyte text now. */
2255 int is_multibyte
= 0;
2259 while ((c
= READCHAR
) >= 0
2262 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2264 int offset
= p
- read_buffer
;
2265 read_buffer
= (char *) xrealloc (read_buffer
,
2266 read_buffer_size
*= 2);
2267 p
= read_buffer
+ offset
;
2268 end
= read_buffer
+ read_buffer_size
;
2275 c
= read_escape (readcharfun
, 1, &byterep
);
2277 /* C is -1 if \ newline has just been seen */
2280 if (p
== read_buffer
)
2286 force_singlebyte
= 1;
2287 else if (byterep
== 2)
2288 force_multibyte
= 1;
2291 /* A character that must be multibyte forces multibyte. */
2292 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2293 force_multibyte
= 1;
2295 /* If we just discovered the need to be multibyte,
2296 convert the text accumulated thus far. */
2297 if (force_multibyte
&& ! is_multibyte
)
2300 to_multibyte (&p
, &end
, &nchars
);
2303 /* Allow `\C- ' and `\C-?'. */
2304 if (c
== (CHAR_CTL
| ' '))
2306 else if (c
== (CHAR_CTL
| '?'))
2311 /* Shift modifier is valid only with [A-Za-z]. */
2312 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2314 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2315 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2319 /* Move the meta bit to the right place for a string. */
2320 c
= (c
& ~CHAR_META
) | 0x80;
2321 if (c
& CHAR_MODIFIER_MASK
)
2322 error ("Invalid modifier in string");
2325 p
+= CHAR_STRING (c
, p
);
2333 end_of_file_error ();
2335 /* If purifying, and string starts with \ newline,
2336 return zero instead. This is for doc strings
2337 that we are really going to find in etc/DOC.nn.nn */
2338 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2339 return make_number (0);
2341 if (is_multibyte
|| force_singlebyte
)
2343 else if (load_convert_to_unibyte
)
2346 to_multibyte (&p
, &end
, &nchars
);
2347 if (p
- read_buffer
!= nchars
)
2349 string
= make_multibyte_string (read_buffer
, nchars
,
2351 return Fstring_make_unibyte (string
);
2353 /* We can make a unibyte string directly. */
2356 else if (EQ (readcharfun
, Qget_file_char
)
2357 || EQ (readcharfun
, Qlambda
))
2359 /* Nowadays, reading directly from a file is used only for
2360 compiled Emacs Lisp files, and those always use the
2361 Emacs internal encoding. Meanwhile, Qlambda is used
2362 for reading dynamic byte code (compiled with
2363 byte-compile-dynamic = t). So make the string multibyte
2364 if the string contains any multibyte sequences.
2365 (to_multibyte is a no-op if not.) */
2366 to_multibyte (&p
, &end
, &nchars
);
2367 is_multibyte
= (p
- read_buffer
) != nchars
;
2370 /* In all other cases, if we read these bytes as
2371 separate characters, treat them as separate characters now. */
2374 /* We want readchar_count to be the number of characters, not
2375 bytes. Hence we adjust for multibyte characters in the
2376 string. ... But it doesn't seem to be necessary, because
2377 READCHAR *does* read multibyte characters from buffers. */
2378 /* readchar_count -= (p - read_buffer) - nchars; */
2380 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2382 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2388 int next_char
= READCHAR
;
2391 if (next_char
<= 040
2392 || index ("\"'`,(", next_char
))
2398 /* Otherwise, we fall through! Note that the atom-reading loop
2399 below will now loop at least once, assuring that we will not
2400 try to UNREAD two characters in a row. */
2404 if (c
<= 040) goto retry
;
2406 char *p
= read_buffer
;
2410 char *end
= read_buffer
+ read_buffer_size
;
2413 && !(c
== '\"' || c
== '\'' || c
== ';'
2414 || c
== '(' || c
== ')'
2415 || c
== '[' || c
== ']' || c
== '#'))
2417 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2419 int offset
= p
- read_buffer
;
2420 read_buffer
= (char *) xrealloc (read_buffer
,
2421 read_buffer_size
*= 2);
2422 p
= read_buffer
+ offset
;
2423 end
= read_buffer
+ read_buffer_size
;
2430 end_of_file_error ();
2434 if (! SINGLE_BYTE_CHAR_P (c
))
2435 p
+= CHAR_STRING (c
, p
);
2444 int offset
= p
- read_buffer
;
2445 read_buffer
= (char *) xrealloc (read_buffer
,
2446 read_buffer_size
*= 2);
2447 p
= read_buffer
+ offset
;
2448 end
= read_buffer
+ read_buffer_size
;
2455 if (!quoted
&& !uninterned_symbol
)
2458 register Lisp_Object val
;
2460 if (*p1
== '+' || *p1
== '-') p1
++;
2461 /* Is it an integer? */
2464 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2465 /* Integers can have trailing decimal points. */
2466 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2468 /* It is an integer. */
2472 if (sizeof (int) == sizeof (EMACS_INT
))
2473 XSETINT (val
, atoi (read_buffer
));
2474 else if (sizeof (long) == sizeof (EMACS_INT
))
2475 XSETINT (val
, atol (read_buffer
));
2481 if (isfloat_string (read_buffer
))
2483 /* Compute NaN and infinities using 0.0 in a variable,
2484 to cope with compilers that think they are smarter
2490 /* Negate the value ourselves. This treats 0, NaNs,
2491 and infinity properly on IEEE floating point hosts,
2492 and works around a common bug where atof ("-0.0")
2494 int negative
= read_buffer
[0] == '-';
2496 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2497 returns 1, is if the input ends in e+INF or e+NaN. */
2504 value
= zero
/ zero
;
2507 value
= atof (read_buffer
+ negative
);
2511 return make_float (negative
? - value
: value
);
2515 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2516 : intern (read_buffer
);
2517 if (EQ (Vread_with_symbol_positions
, Qt
)
2518 || EQ (Vread_with_symbol_positions
, readcharfun
))
2519 Vread_symbol_positions_list
=
2520 /* Kind of a hack; this will probably fail if characters
2521 in the symbol name were escaped. Not really a big
2523 Fcons (Fcons (result
,
2524 make_number (readchar_count
2525 - XFASTINT (Flength (Fsymbol_name (result
))))),
2526 Vread_symbol_positions_list
);
2534 /* List of nodes we've seen during substitute_object_in_subtree. */
2535 static Lisp_Object seen_list
;
2538 substitute_object_in_subtree (object
, placeholder
)
2540 Lisp_Object placeholder
;
2542 Lisp_Object check_object
;
2544 /* We haven't seen any objects when we start. */
2547 /* Make all the substitutions. */
2549 = substitute_object_recurse (object
, placeholder
, object
);
2551 /* Clear seen_list because we're done with it. */
2554 /* The returned object here is expected to always eq the
2556 if (!EQ (check_object
, object
))
2557 error ("Unexpected mutation error in reader");
2560 /* Feval doesn't get called from here, so no gc protection is needed. */
2561 #define SUBSTITUTE(get_val, set_val) \
2563 Lisp_Object old_value = get_val; \
2564 Lisp_Object true_value \
2565 = substitute_object_recurse (object, placeholder,\
2568 if (!EQ (old_value, true_value)) \
2575 substitute_object_recurse (object
, placeholder
, subtree
)
2577 Lisp_Object placeholder
;
2578 Lisp_Object subtree
;
2580 /* If we find the placeholder, return the target object. */
2581 if (EQ (placeholder
, subtree
))
2584 /* If we've been to this node before, don't explore it again. */
2585 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2588 /* If this node can be the entry point to a cycle, remember that
2589 we've seen it. It can only be such an entry point if it was made
2590 by #n=, which means that we can find it as a value in
2592 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2593 seen_list
= Fcons (subtree
, seen_list
);
2595 /* Recurse according to subtree's type.
2596 Every branch must return a Lisp_Object. */
2597 switch (XTYPE (subtree
))
2599 case Lisp_Vectorlike
:
2602 int length
= XINT (Flength(subtree
));
2603 for (i
= 0; i
< length
; i
++)
2605 Lisp_Object idx
= make_number (i
);
2606 SUBSTITUTE (Faref (subtree
, idx
),
2607 Faset (subtree
, idx
, true_value
));
2614 SUBSTITUTE (Fcar_safe (subtree
),
2615 Fsetcar (subtree
, true_value
));
2616 SUBSTITUTE (Fcdr_safe (subtree
),
2617 Fsetcdr (subtree
, true_value
));
2623 /* Check for text properties in each interval.
2624 substitute_in_interval contains part of the logic. */
2626 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2627 Lisp_Object arg
= Fcons (object
, placeholder
);
2629 traverse_intervals_noorder (root_interval
,
2630 &substitute_in_interval
, arg
);
2635 /* Other types don't recurse any further. */
2641 /* Helper function for substitute_object_recurse. */
2643 substitute_in_interval (interval
, arg
)
2647 Lisp_Object object
= Fcar (arg
);
2648 Lisp_Object placeholder
= Fcdr (arg
);
2650 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2669 if (*cp
== '+' || *cp
== '-')
2672 if (*cp
>= '0' && *cp
<= '9')
2675 while (*cp
>= '0' && *cp
<= '9')
2683 if (*cp
>= '0' && *cp
<= '9')
2686 while (*cp
>= '0' && *cp
<= '9')
2689 if (*cp
== 'e' || *cp
== 'E')
2693 if (*cp
== '+' || *cp
== '-')
2697 if (*cp
>= '0' && *cp
<= '9')
2700 while (*cp
>= '0' && *cp
<= '9')
2703 else if (cp
== start
)
2705 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2710 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2716 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2717 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2718 || state
== (DOT_CHAR
|TRAIL_INT
)
2719 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2720 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2721 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2726 read_vector (readcharfun
, bytecodeflag
)
2727 Lisp_Object readcharfun
;
2732 register Lisp_Object
*ptr
;
2733 register Lisp_Object tem
, item
, vector
;
2734 register struct Lisp_Cons
*otem
;
2737 tem
= read_list (1, readcharfun
);
2738 len
= Flength (tem
);
2739 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2741 size
= XVECTOR (vector
)->size
;
2742 ptr
= XVECTOR (vector
)->contents
;
2743 for (i
= 0; i
< size
; i
++)
2746 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2747 bytecode object, the docstring containing the bytecode and
2748 constants values must be treated as unibyte and passed to
2749 Fread, to get the actual bytecode string and constants vector. */
2750 if (bytecodeflag
&& load_force_doc_strings
)
2752 if (i
== COMPILED_BYTECODE
)
2754 if (!STRINGP (item
))
2755 error ("invalid byte code");
2757 /* Delay handling the bytecode slot until we know whether
2758 it is lazily-loaded (we can tell by whether the
2759 constants slot is nil). */
2760 ptr
[COMPILED_CONSTANTS
] = item
;
2763 else if (i
== COMPILED_CONSTANTS
)
2765 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2769 /* Coerce string to unibyte (like string-as-unibyte,
2770 but without generating extra garbage and
2771 guaranteeing no change in the contents). */
2772 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2773 STRING_SET_UNIBYTE (bytestr
);
2775 item
= Fread (bytestr
);
2777 error ("invalid byte code");
2779 otem
= XCONS (item
);
2780 bytestr
= XCAR (item
);
2785 /* Now handle the bytecode slot. */
2786 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2789 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2797 /* FLAG = 1 means check for ] to terminate rather than ) and .
2798 FLAG = -1 means check for starting with defun
2799 and make structure pure. */
2802 read_list (flag
, readcharfun
)
2804 register Lisp_Object readcharfun
;
2806 /* -1 means check next element for defun,
2807 0 means don't check,
2808 1 means already checked and found defun. */
2809 int defunflag
= flag
< 0 ? -1 : 0;
2810 Lisp_Object val
, tail
;
2811 register Lisp_Object elt
, tem
;
2812 struct gcpro gcpro1
, gcpro2
;
2813 /* 0 is the normal case.
2814 1 means this list is a doc reference; replace it with the number 0.
2815 2 means this list is a doc reference; replace it with the doc string. */
2816 int doc_reference
= 0;
2818 /* Initialize this to 1 if we are reading a list. */
2819 int first_in_list
= flag
<= 0;
2828 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2833 /* While building, if the list starts with #$, treat it specially. */
2834 if (EQ (elt
, Vload_file_name
)
2836 && !NILP (Vpurify_flag
))
2838 if (NILP (Vdoc_file_name
))
2839 /* We have not yet called Snarf-documentation, so assume
2840 this file is described in the DOC-MM.NN file
2841 and Snarf-documentation will fill in the right value later.
2842 For now, replace the whole list with 0. */
2845 /* We have already called Snarf-documentation, so make a relative
2846 file name for this file, so it can be found properly
2847 in the installed Lisp directory.
2848 We don't use Fexpand_file_name because that would make
2849 the directory absolute now. */
2850 elt
= concat2 (build_string ("../lisp/"),
2851 Ffile_name_nondirectory (elt
));
2853 else if (EQ (elt
, Vload_file_name
)
2855 && load_force_doc_strings
)
2864 Fsignal (Qinvalid_read_syntax
,
2865 Fcons (make_string (") or . in a vector", 18), Qnil
));
2873 XSETCDR (tail
, read0 (readcharfun
));
2875 val
= read0 (readcharfun
);
2876 read1 (readcharfun
, &ch
, 0);
2880 if (doc_reference
== 1)
2881 return make_number (0);
2882 if (doc_reference
== 2)
2884 /* Get a doc string from the file we are loading.
2885 If it's in saved_doc_string, get it from there. */
2886 int pos
= XINT (XCDR (val
));
2887 /* Position is negative for user variables. */
2888 if (pos
< 0) pos
= -pos
;
2889 if (pos
>= saved_doc_string_position
2890 && pos
< (saved_doc_string_position
2891 + saved_doc_string_length
))
2893 int start
= pos
- saved_doc_string_position
;
2896 /* Process quoting with ^A,
2897 and find the end of the string,
2898 which is marked with ^_ (037). */
2899 for (from
= start
, to
= start
;
2900 saved_doc_string
[from
] != 037;)
2902 int c
= saved_doc_string
[from
++];
2905 c
= saved_doc_string
[from
++];
2907 saved_doc_string
[to
++] = c
;
2909 saved_doc_string
[to
++] = 0;
2911 saved_doc_string
[to
++] = 037;
2914 saved_doc_string
[to
++] = c
;
2917 return make_string (saved_doc_string
+ start
,
2920 /* Look in prev_saved_doc_string the same way. */
2921 else if (pos
>= prev_saved_doc_string_position
2922 && pos
< (prev_saved_doc_string_position
2923 + prev_saved_doc_string_length
))
2925 int start
= pos
- prev_saved_doc_string_position
;
2928 /* Process quoting with ^A,
2929 and find the end of the string,
2930 which is marked with ^_ (037). */
2931 for (from
= start
, to
= start
;
2932 prev_saved_doc_string
[from
] != 037;)
2934 int c
= prev_saved_doc_string
[from
++];
2937 c
= prev_saved_doc_string
[from
++];
2939 prev_saved_doc_string
[to
++] = c
;
2941 prev_saved_doc_string
[to
++] = 0;
2943 prev_saved_doc_string
[to
++] = 037;
2946 prev_saved_doc_string
[to
++] = c
;
2949 return make_string (prev_saved_doc_string
+ start
,
2953 return get_doc_string (val
, 0, 0);
2958 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2960 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2962 tem
= (read_pure
&& flag
<= 0
2963 ? pure_cons (elt
, Qnil
)
2964 : Fcons (elt
, Qnil
));
2966 XSETCDR (tail
, tem
);
2971 defunflag
= EQ (elt
, Qdefun
);
2972 else if (defunflag
> 0)
2977 Lisp_Object Vobarray
;
2978 Lisp_Object initial_obarray
;
2980 /* oblookup stores the bucket number here, for the sake of Funintern. */
2982 int oblookup_last_bucket_number
;
2984 static int hash_string ();
2986 /* Get an error if OBARRAY is not an obarray.
2987 If it is one, return it. */
2990 check_obarray (obarray
)
2991 Lisp_Object obarray
;
2993 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2995 /* If Vobarray is now invalid, force it to be valid. */
2996 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2998 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3003 /* Intern the C string STR: return a symbol with that name,
3004 interned in the current obarray. */
3011 int len
= strlen (str
);
3012 Lisp_Object obarray
;
3015 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3016 obarray
= check_obarray (obarray
);
3017 tem
= oblookup (obarray
, str
, len
, len
);
3020 return Fintern (make_string (str
, len
), obarray
);
3023 /* Create an uninterned symbol with name STR. */
3029 int len
= strlen (str
);
3031 return Fmake_symbol ((!NILP (Vpurify_flag
)
3032 ? make_pure_string (str
, len
, len
, 0)
3033 : make_string (str
, len
)));
3036 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3037 doc
: /* Return the canonical symbol whose name is STRING.
3038 If there is none, one is created by this function and returned.
3039 A second optional argument specifies the obarray to use;
3040 it defaults to the value of `obarray'. */)
3042 Lisp_Object string
, obarray
;
3044 register Lisp_Object tem
, sym
, *ptr
;
3046 if (NILP (obarray
)) obarray
= Vobarray
;
3047 obarray
= check_obarray (obarray
);
3049 CHECK_STRING (string
);
3051 tem
= oblookup (obarray
, SDATA (string
),
3054 if (!INTEGERP (tem
))
3057 if (!NILP (Vpurify_flag
))
3058 string
= Fpurecopy (string
);
3059 sym
= Fmake_symbol (string
);
3061 if (EQ (obarray
, initial_obarray
))
3062 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3064 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3066 if ((SREF (string
, 0) == ':')
3067 && EQ (obarray
, initial_obarray
))
3069 XSYMBOL (sym
)->constant
= 1;
3070 XSYMBOL (sym
)->value
= sym
;
3073 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3075 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3077 XSYMBOL (sym
)->next
= 0;
3082 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3083 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3084 NAME may be a string or a symbol. If it is a symbol, that exact
3085 symbol is searched for.
3086 A second optional argument specifies the obarray to use;
3087 it defaults to the value of `obarray'. */)
3089 Lisp_Object name
, obarray
;
3091 register Lisp_Object tem
, string
;
3093 if (NILP (obarray
)) obarray
= Vobarray
;
3094 obarray
= check_obarray (obarray
);
3096 if (!SYMBOLP (name
))
3098 CHECK_STRING (name
);
3102 string
= SYMBOL_NAME (name
);
3104 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3105 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3111 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3112 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3113 The value is t if a symbol was found and deleted, nil otherwise.
3114 NAME may be a string or a symbol. If it is a symbol, that symbol
3115 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3116 OBARRAY defaults to the value of the variable `obarray'. */)
3118 Lisp_Object name
, obarray
;
3120 register Lisp_Object string
, tem
;
3123 if (NILP (obarray
)) obarray
= Vobarray
;
3124 obarray
= check_obarray (obarray
);
3127 string
= SYMBOL_NAME (name
);
3130 CHECK_STRING (name
);
3134 tem
= oblookup (obarray
, SDATA (string
),
3139 /* If arg was a symbol, don't delete anything but that symbol itself. */
3140 if (SYMBOLP (name
) && !EQ (name
, tem
))
3143 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3144 XSYMBOL (tem
)->constant
= 0;
3145 XSYMBOL (tem
)->indirect_variable
= 0;
3147 hash
= oblookup_last_bucket_number
;
3149 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3151 if (XSYMBOL (tem
)->next
)
3152 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3154 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3158 Lisp_Object tail
, following
;
3160 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3161 XSYMBOL (tail
)->next
;
3164 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3165 if (EQ (following
, tem
))
3167 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3176 /* Return the symbol in OBARRAY whose names matches the string
3177 of SIZE characters (SIZE_BYTE bytes) at PTR.
3178 If there is no such symbol in OBARRAY, return nil.
3180 Also store the bucket number in oblookup_last_bucket_number. */
3183 oblookup (obarray
, ptr
, size
, size_byte
)
3184 Lisp_Object obarray
;
3185 register const char *ptr
;
3186 int size
, size_byte
;
3190 register Lisp_Object tail
;
3191 Lisp_Object bucket
, tem
;
3193 if (!VECTORP (obarray
)
3194 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3196 obarray
= check_obarray (obarray
);
3197 obsize
= XVECTOR (obarray
)->size
;
3199 /* This is sometimes needed in the middle of GC. */
3200 obsize
&= ~ARRAY_MARK_FLAG
;
3201 /* Combining next two lines breaks VMS C 2.3. */
3202 hash
= hash_string (ptr
, size_byte
);
3204 bucket
= XVECTOR (obarray
)->contents
[hash
];
3205 oblookup_last_bucket_number
= hash
;
3206 if (XFASTINT (bucket
) == 0)
3208 else if (!SYMBOLP (bucket
))
3209 error ("Bad data in guts of obarray"); /* Like CADR error message */
3211 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3213 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3214 && SCHARS (SYMBOL_NAME (tail
)) == size
3215 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3217 else if (XSYMBOL (tail
)->next
== 0)
3220 XSETINT (tem
, hash
);
3225 hash_string (ptr
, len
)
3226 const unsigned char *ptr
;
3229 register const unsigned char *p
= ptr
;
3230 register const unsigned char *end
= p
+ len
;
3231 register unsigned char c
;
3232 register int hash
= 0;
3237 if (c
>= 0140) c
-= 40;
3238 hash
= ((hash
<<3) + (hash
>>28) + c
);
3240 return hash
& 07777777777;
3244 map_obarray (obarray
, fn
, arg
)
3245 Lisp_Object obarray
;
3246 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3250 register Lisp_Object tail
;
3251 CHECK_VECTOR (obarray
);
3252 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3254 tail
= XVECTOR (obarray
)->contents
[i
];
3259 if (XSYMBOL (tail
)->next
== 0)
3261 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3267 mapatoms_1 (sym
, function
)
3268 Lisp_Object sym
, function
;
3270 call1 (function
, sym
);
3273 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3274 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3275 OBARRAY defaults to the value of `obarray'. */)
3277 Lisp_Object function
, obarray
;
3279 if (NILP (obarray
)) obarray
= Vobarray
;
3280 obarray
= check_obarray (obarray
);
3282 map_obarray (obarray
, mapatoms_1
, function
);
3286 #define OBARRAY_SIZE 1511
3291 Lisp_Object oblength
;
3295 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3297 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3298 Vobarray
= Fmake_vector (oblength
, make_number (0));
3299 initial_obarray
= Vobarray
;
3300 staticpro (&initial_obarray
);
3301 /* Intern nil in the obarray */
3302 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3303 XSYMBOL (Qnil
)->constant
= 1;
3305 /* These locals are to kludge around a pyramid compiler bug. */
3306 hash
= hash_string ("nil", 3);
3307 /* Separate statement here to avoid VAXC bug. */
3308 hash
%= OBARRAY_SIZE
;
3309 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3312 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3313 XSYMBOL (Qnil
)->function
= Qunbound
;
3314 XSYMBOL (Qunbound
)->value
= Qunbound
;
3315 XSYMBOL (Qunbound
)->function
= Qunbound
;
3318 XSYMBOL (Qnil
)->value
= Qnil
;
3319 XSYMBOL (Qnil
)->plist
= Qnil
;
3320 XSYMBOL (Qt
)->value
= Qt
;
3321 XSYMBOL (Qt
)->constant
= 1;
3323 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3326 Qvariable_documentation
= intern ("variable-documentation");
3327 staticpro (&Qvariable_documentation
);
3329 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3330 read_buffer
= (char *) xmalloc (read_buffer_size
);
3335 struct Lisp_Subr
*sname
;
3338 sym
= intern (sname
->symbol_name
);
3339 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3342 #ifdef NOTDEF /* use fset in subr.el now */
3344 defalias (sname
, string
)
3345 struct Lisp_Subr
*sname
;
3349 sym
= intern (string
);
3350 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3354 /* Define an "integer variable"; a symbol whose value is forwarded
3355 to a C variable of type int. Sample call: */
3356 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3358 defvar_int (namestring
, address
)
3362 Lisp_Object sym
, val
;
3363 sym
= intern (namestring
);
3364 val
= allocate_misc ();
3365 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3366 XINTFWD (val
)->intvar
= address
;
3367 SET_SYMBOL_VALUE (sym
, val
);
3370 /* Similar but define a variable whose value is t if address contains 1,
3371 nil if address contains 0 */
3373 defvar_bool (namestring
, address
)
3377 Lisp_Object sym
, val
;
3378 sym
= intern (namestring
);
3379 val
= allocate_misc ();
3380 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3381 XBOOLFWD (val
)->boolvar
= address
;
3382 SET_SYMBOL_VALUE (sym
, val
);
3383 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3386 /* Similar but define a variable whose value is the Lisp Object stored
3387 at address. Two versions: with and without gc-marking of the C
3388 variable. The nopro version is used when that variable will be
3389 gc-marked for some other reason, since marking the same slot twice
3390 can cause trouble with strings. */
3392 defvar_lisp_nopro (namestring
, address
)
3394 Lisp_Object
*address
;
3396 Lisp_Object sym
, val
;
3397 sym
= intern (namestring
);
3398 val
= allocate_misc ();
3399 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3400 XOBJFWD (val
)->objvar
= address
;
3401 SET_SYMBOL_VALUE (sym
, val
);
3405 defvar_lisp (namestring
, address
)
3407 Lisp_Object
*address
;
3409 defvar_lisp_nopro (namestring
, address
);
3410 staticpro (address
);
3413 /* Similar but define a variable whose value is the Lisp Object stored in
3414 the current buffer. address is the address of the slot in the buffer
3415 that is current now. */
3418 defvar_per_buffer (namestring
, address
, type
, doc
)
3420 Lisp_Object
*address
;
3424 Lisp_Object sym
, val
;
3426 extern struct buffer buffer_local_symbols
;
3428 sym
= intern (namestring
);
3429 val
= allocate_misc ();
3430 offset
= (char *)address
- (char *)current_buffer
;
3432 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3433 XBUFFER_OBJFWD (val
)->offset
= offset
;
3434 SET_SYMBOL_VALUE (sym
, val
);
3435 PER_BUFFER_SYMBOL (offset
) = sym
;
3436 PER_BUFFER_TYPE (offset
) = type
;
3438 if (PER_BUFFER_IDX (offset
) == 0)
3439 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3440 slot of buffer_local_flags */
3445 /* Similar but define a variable whose value is the Lisp Object stored
3446 at a particular offset in the current kboard object. */
3449 defvar_kboard (namestring
, offset
)
3453 Lisp_Object sym
, val
;
3454 sym
= intern (namestring
);
3455 val
= allocate_misc ();
3456 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3457 XKBOARD_OBJFWD (val
)->offset
= offset
;
3458 SET_SYMBOL_VALUE (sym
, val
);
3461 /* Record the value of load-path used at the start of dumping
3462 so we can see if the site changed it later during dumping. */
3463 static Lisp_Object dump_path
;
3469 int turn_off_warning
= 0;
3471 /* Compute the default load-path. */
3473 normal
= PATH_LOADSEARCH
;
3474 Vload_path
= decode_env_path (0, normal
);
3476 if (NILP (Vpurify_flag
))
3477 normal
= PATH_LOADSEARCH
;
3479 normal
= PATH_DUMPLOADSEARCH
;
3481 /* In a dumped Emacs, we normally have to reset the value of
3482 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3483 uses ../lisp, instead of the path of the installed elisp
3484 libraries. However, if it appears that Vload_path was changed
3485 from the default before dumping, don't override that value. */
3488 if (! NILP (Fequal (dump_path
, Vload_path
)))
3490 Vload_path
= decode_env_path (0, normal
);
3491 if (!NILP (Vinstallation_directory
))
3493 Lisp_Object tem
, tem1
, sitelisp
;
3495 /* Remove site-lisp dirs from path temporarily and store
3496 them in sitelisp, then conc them on at the end so
3497 they're always first in path. */
3501 tem
= Fcar (Vload_path
);
3502 tem1
= Fstring_match (build_string ("site-lisp"),
3506 Vload_path
= Fcdr (Vload_path
);
3507 sitelisp
= Fcons (tem
, sitelisp
);
3513 /* Add to the path the lisp subdir of the
3514 installation dir, if it exists. */
3515 tem
= Fexpand_file_name (build_string ("lisp"),
3516 Vinstallation_directory
);
3517 tem1
= Ffile_exists_p (tem
);
3520 if (NILP (Fmember (tem
, Vload_path
)))
3522 turn_off_warning
= 1;
3523 Vload_path
= Fcons (tem
, Vload_path
);
3527 /* That dir doesn't exist, so add the build-time
3528 Lisp dirs instead. */
3529 Vload_path
= nconc2 (Vload_path
, dump_path
);
3531 /* Add leim under the installation dir, if it exists. */
3532 tem
= Fexpand_file_name (build_string ("leim"),
3533 Vinstallation_directory
);
3534 tem1
= Ffile_exists_p (tem
);
3537 if (NILP (Fmember (tem
, Vload_path
)))
3538 Vload_path
= Fcons (tem
, Vload_path
);
3541 /* Add site-list under the installation dir, if it exists. */
3542 tem
= Fexpand_file_name (build_string ("site-lisp"),
3543 Vinstallation_directory
);
3544 tem1
= Ffile_exists_p (tem
);
3547 if (NILP (Fmember (tem
, Vload_path
)))
3548 Vload_path
= Fcons (tem
, Vload_path
);
3551 /* If Emacs was not built in the source directory,
3552 and it is run from where it was built, add to load-path
3553 the lisp, leim and site-lisp dirs under that directory. */
3555 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3559 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3560 Vinstallation_directory
);
3561 tem1
= Ffile_exists_p (tem
);
3563 /* Don't be fooled if they moved the entire source tree
3564 AFTER dumping Emacs. If the build directory is indeed
3565 different from the source dir, src/Makefile.in and
3566 src/Makefile will not be found together. */
3567 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3568 Vinstallation_directory
);
3569 tem2
= Ffile_exists_p (tem
);
3570 if (!NILP (tem1
) && NILP (tem2
))
3572 tem
= Fexpand_file_name (build_string ("lisp"),
3575 if (NILP (Fmember (tem
, Vload_path
)))
3576 Vload_path
= Fcons (tem
, Vload_path
);
3578 tem
= Fexpand_file_name (build_string ("leim"),
3581 if (NILP (Fmember (tem
, Vload_path
)))
3582 Vload_path
= Fcons (tem
, Vload_path
);
3584 tem
= Fexpand_file_name (build_string ("site-lisp"),
3587 if (NILP (Fmember (tem
, Vload_path
)))
3588 Vload_path
= Fcons (tem
, Vload_path
);
3591 if (!NILP (sitelisp
))
3592 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3598 /* NORMAL refers to the lisp dir in the source directory. */
3599 /* We used to add ../lisp at the front here, but
3600 that caused trouble because it was copied from dump_path
3601 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3602 It should be unnecessary. */
3603 Vload_path
= decode_env_path (0, normal
);
3604 dump_path
= Vload_path
;
3609 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3610 almost never correct, thereby causing a warning to be printed out that
3611 confuses users. Since PATH_LOADSEARCH is always overridden by the
3612 EMACSLOADPATH environment variable below, disable the warning on NT. */
3614 /* Warn if dirs in the *standard* path don't exist. */
3615 if (!turn_off_warning
)
3617 Lisp_Object path_tail
;
3619 for (path_tail
= Vload_path
;
3621 path_tail
= XCDR (path_tail
))
3623 Lisp_Object dirfile
;
3624 dirfile
= Fcar (path_tail
);
3625 if (STRINGP (dirfile
))
3627 dirfile
= Fdirectory_file_name (dirfile
);
3628 if (access (SDATA (dirfile
), 0) < 0)
3629 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3634 #endif /* WINDOWSNT */
3636 /* If the EMACSLOADPATH environment variable is set, use its value.
3637 This doesn't apply if we're dumping. */
3639 if (NILP (Vpurify_flag
)
3640 && egetenv ("EMACSLOADPATH"))
3642 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3646 load_in_progress
= 0;
3647 Vload_file_name
= Qnil
;
3649 load_descriptor_list
= Qnil
;
3651 Vstandard_input
= Qt
;
3652 Vloads_in_progress
= Qnil
;
3655 /* Print a warning, using format string FORMAT, that directory DIRNAME
3656 does not exist. Print it on stderr and put it in *Message*. */
3659 dir_warning (format
, dirname
)
3661 Lisp_Object dirname
;
3664 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3666 fprintf (stderr
, format
, SDATA (dirname
));
3667 sprintf (buffer
, format
, SDATA (dirname
));
3668 /* Don't log the warning before we've initialized!! */
3670 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3677 defsubr (&Sread_from_string
);
3679 defsubr (&Sintern_soft
);
3680 defsubr (&Sunintern
);
3682 defsubr (&Seval_buffer
);
3683 defsubr (&Seval_region
);
3684 defsubr (&Sread_char
);
3685 defsubr (&Sread_char_exclusive
);
3686 defsubr (&Sread_event
);
3687 defsubr (&Sget_file_char
);
3688 defsubr (&Smapatoms
);
3689 defsubr (&Slocate_file_internal
);
3691 DEFVAR_LISP ("obarray", &Vobarray
,
3692 doc
: /* Symbol table for use by `intern' and `read'.
3693 It is a vector whose length ought to be prime for best results.
3694 The vector's contents don't make sense if examined from Lisp programs;
3695 to find all the symbols in an obarray, use `mapatoms'. */);
3697 DEFVAR_LISP ("values", &Vvalues
,
3698 doc
: /* List of values of all expressions which were read, evaluated and printed.
3699 Order is reverse chronological. */);
3701 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3702 doc
: /* Stream for read to get input from.
3703 See documentation of `read' for possible values. */);
3704 Vstandard_input
= Qt
;
3706 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3707 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3709 If this variable is a buffer, then only forms read from that buffer
3710 will be added to `read-symbol-positions-list'.
3711 If this variable is t, then all read forms will be added.
3712 The effect of all other values other than nil are not currently
3713 defined, although they may be in the future.
3715 The positions are relative to the last call to `read' or
3716 `read-from-string'. It is probably a bad idea to set this variable at
3717 the toplevel; bind it instead. */);
3718 Vread_with_symbol_positions
= Qnil
;
3720 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3721 doc
: /* A list mapping read symbols to their positions.
3722 This variable is modified during calls to `read' or
3723 `read-from-string', but only when `read-with-symbol-positions' is
3726 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3727 CHAR-POSITION is an integer giving the offset of that occurrence of the
3728 symbol from the position where `read' or `read-from-string' started.
3730 Note that a symbol will appear multiple times in this list, if it was
3731 read multiple times. The list is in the same order as the symbols
3733 Vread_symbol_positions_list
= Qnil
;
3735 DEFVAR_LISP ("load-path", &Vload_path
,
3736 doc
: /* *List of directories to search for files to load.
3737 Each element is a string (directory name) or nil (try default directory).
3738 Initialized based on EMACSLOADPATH environment variable, if any,
3739 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3741 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3742 doc
: /* *List of suffixes to try for files to load.
3743 This list should not include the empty string. */);
3744 Vload_suffixes
= Fcons (build_string (".elc"),
3745 Fcons (build_string (".el"), Qnil
));
3746 /* We don't use empty_string because it's not initialized yet. */
3747 default_suffixes
= Fcons (build_string (""), Qnil
);
3748 staticpro (&default_suffixes
);
3750 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3751 doc
: /* Non-nil iff inside of `load'. */);
3753 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3754 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3755 Each element looks like (FILENAME FORMS...).
3756 When `load' is run and the file-name argument is FILENAME,
3757 the FORMS in the corresponding element are executed at the end of loading.
3759 FILENAME must match exactly! Normally FILENAME is the name of a library,
3760 with no directory specified, since that is how `load' is normally called.
3761 An error in FORMS does not undo the load,
3762 but does prevent execution of the rest of the FORMS.
3763 FILENAME can also be a symbol (a feature) and FORMS are then executed
3764 when the corresponding call to `provide' is made. */);
3765 Vafter_load_alist
= Qnil
;
3767 DEFVAR_LISP ("load-history", &Vload_history
,
3768 doc
: /* Alist mapping source file names to symbols and features.
3769 Each alist element is a list that starts with a file name,
3770 except for one element (optional) that starts with nil and describes
3771 definitions evaluated from buffers not visiting files.
3772 The remaining elements of each list are symbols defined as functions,
3773 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3774 `(defvar . VARIABLE), and `(autoload . SYMBOL)'. */);
3775 Vload_history
= Qnil
;
3777 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3778 doc
: /* Full name of file being loaded by `load'. */);
3779 Vload_file_name
= Qnil
;
3781 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3782 doc
: /* File name, including directory, of user's initialization file.
3783 If the file loaded had extension `.elc' and there was a corresponding `.el'
3784 file, this variable contains the name of the .el file, suitable for use
3785 by functions like `custom-save-all' which edit the init file. */);
3786 Vuser_init_file
= Qnil
;
3788 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3789 doc
: /* Used for internal purposes by `load'. */);
3790 Vcurrent_load_list
= Qnil
;
3792 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3793 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3794 The default is nil, which means use the function `read'. */);
3795 Vload_read_function
= Qnil
;
3797 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3798 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3799 This function is for doing code conversion before reading the source file.
3800 If nil, loading is done without any code conversion.
3801 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3802 FULLNAME is the full name of FILE.
3803 See `load' for the meaning of the remaining arguments. */);
3804 Vload_source_file_function
= Qnil
;
3806 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3807 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3808 This is useful when the file being loaded is a temporary copy. */);
3809 load_force_doc_strings
= 0;
3811 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3812 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3813 This is normally bound by `load' and `eval-buffer' to control `read',
3814 and is not meant for users to change. */);
3815 load_convert_to_unibyte
= 0;
3817 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3818 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3819 You cannot count on them to still be there! */);
3821 = Fexpand_file_name (build_string ("../"),
3822 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3824 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3825 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3826 Vpreloaded_file_list
= Qnil
;
3828 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3829 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3830 Vbyte_boolean_vars
= Qnil
;
3832 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3833 doc
: /* Non-nil means load dangerous compiled Lisp files.
3834 Some versions of XEmacs use different byte codes than Emacs. These
3835 incompatible byte codes can make Emacs crash when it tries to execute
3837 load_dangerous_libraries
= 0;
3839 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3840 doc
: /* Regular expression matching safe to load compiled Lisp files.
3841 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3842 from the file, and matches them against this regular expression.
3843 When the regular expression matches, the file is considered to be safe
3844 to load. See also `load-dangerous-libraries'. */);
3845 Vbytecomp_version_regexp
3846 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3848 /* Vsource_directory was initialized in init_lread. */
3850 load_descriptor_list
= Qnil
;
3851 staticpro (&load_descriptor_list
);
3853 Qcurrent_load_list
= intern ("current-load-list");
3854 staticpro (&Qcurrent_load_list
);
3856 Qstandard_input
= intern ("standard-input");
3857 staticpro (&Qstandard_input
);
3859 Qread_char
= intern ("read-char");
3860 staticpro (&Qread_char
);
3862 Qget_file_char
= intern ("get-file-char");
3863 staticpro (&Qget_file_char
);
3865 Qbackquote
= intern ("`");
3866 staticpro (&Qbackquote
);
3867 Qcomma
= intern (",");
3868 staticpro (&Qcomma
);
3869 Qcomma_at
= intern (",@");
3870 staticpro (&Qcomma_at
);
3871 Qcomma_dot
= intern (",.");
3872 staticpro (&Qcomma_dot
);
3874 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3875 staticpro (&Qinhibit_file_name_operation
);
3877 Qascii_character
= intern ("ascii-character");
3878 staticpro (&Qascii_character
);
3880 Qfunction
= intern ("function");
3881 staticpro (&Qfunction
);
3883 Qload
= intern ("load");
3886 Qload_file_name
= intern ("load-file-name");
3887 staticpro (&Qload_file_name
);
3889 staticpro (&dump_path
);
3891 staticpro (&read_objects
);
3892 read_objects
= Qnil
;
3893 staticpro (&seen_list
);
3895 Vloads_in_progress
= Qnil
;
3896 staticpro (&Vloads_in_progress
);