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. Environment variable references in FILE
645 are replaced with their values by calling `substitute-in-file-name'.
646 This function searches the directories in `load-path'.
647 If optional second arg NOERROR is non-nil,
648 report no error if FILE doesn't exist.
649 Print messages at start and end of loading unless
650 optional third arg NOMESSAGE is non-nil.
651 If optional fourth arg NOSUFFIX is non-nil, don't try adding
652 suffixes `.elc' or `.el' to the specified name FILE.
653 If optional fifth arg MUST-SUFFIX is non-nil, insist on
654 the suffix `.elc' or `.el'; don't accept just FILE unless
655 it ends in one of those suffixes or includes a directory name.
656 Return t if file exists. */)
657 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
658 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
660 register FILE *stream
;
661 register int fd
= -1;
662 register Lisp_Object lispstream
;
663 int count
= specpdl_ptr
- specpdl
;
666 Lisp_Object found
, efound
;
667 /* 1 means we printed the ".el is newer" message. */
669 /* 1 means we are loading a compiled file. */
680 /* If file name is magic, call the handler. */
681 /* This shouldn't be necessary any more now that `openp' handles it right.
682 handler = Ffind_file_name_handler (file, Qload);
684 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
686 /* Do this after the handler to avoid
687 the need to gcpro noerror, nomessage and nosuffix.
688 (Below here, we care only whether they are nil or not.)
689 The presence of this call is the result of a historical accident:
690 it used to be in every file-operations and when it got removed
691 everywhere, it accidentally stayed here. Since then, enough people
692 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
693 that it seemed risky to remove. */
694 file
= Fsubstitute_in_file_name (file
);
696 /* Avoid weird lossage with null string as arg,
697 since it would try to load a directory as a Lisp file */
698 if (XSTRING (file
)->size
> 0)
700 int size
= STRING_BYTES (XSTRING (file
));
705 if (! NILP (must_suffix
))
707 /* Don't insist on adding a suffix if FILE already ends with one. */
709 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
712 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
714 /* Don't insist on adding a suffix
715 if the argument includes a directory name. */
716 else if (! NILP (Ffile_name_directory (file
)))
720 fd
= openp (Vload_path
, file
,
721 (!NILP (nosuffix
) ? Qnil
722 : !NILP (must_suffix
) ? Vload_suffixes
723 : Fappend (2, (tmp
[0] = Vload_suffixes
,
724 tmp
[1] = default_suffixes
,
734 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
735 Fcons (file
, Qnil
)));
740 /* Tell startup.el whether or not we found the user's init file. */
741 if (EQ (Qt
, Vuser_init_file
))
742 Vuser_init_file
= found
;
744 /* If FD is -2, that means openp found a magic file. */
747 if (NILP (Fequal (found
, file
)))
748 /* If FOUND is a different file name from FILE,
749 find its handler even if we have already inhibited
750 the `load' operation on FILE. */
751 handler
= Ffind_file_name_handler (found
, Qt
);
753 handler
= Ffind_file_name_handler (found
, Qload
);
754 if (! NILP (handler
))
755 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
758 /* Check if we're stuck in a recursive load cycle.
760 2000-09-21: It's not possible to just check for the file loaded
761 being a member of Vloads_in_progress. This fails because of the
762 way the byte compiler currently works; `provide's are not
763 evaluted, see font-lock.el/jit-lock.el as an example. This
764 leads to a certain amount of ``normal'' recursion.
766 Also, just loading a file recursively is not always an error in
767 the general case; the second load may do something different. */
771 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
772 if (!NILP (Fequal (found
, XCAR (tem
))))
775 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
776 Fcons (found
, Vloads_in_progress
)));
777 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
778 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
781 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
783 /* Load .elc files directly, but not when they are
784 remote and have no handler! */
791 if (!safe_to_load_p (fd
))
794 if (!load_dangerous_libraries
)
795 error ("File `%s' was not compiled in Emacs",
796 XSTRING (found
)->data
);
797 else if (!NILP (nomessage
))
798 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
804 efound
= ENCODE_FILE (found
);
809 stat ((char *)XSTRING (efound
)->data
, &s1
);
810 XSTRING (efound
)->data
[STRING_BYTES (XSTRING (efound
)) - 1] = 0;
811 result
= stat ((char *)XSTRING (efound
)->data
, &s2
);
812 XSTRING (efound
)->data
[STRING_BYTES (XSTRING (efound
)) - 1] = 'c';
815 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
817 /* Make the progress messages mention that source is newer. */
820 /* If we won't print another message, mention this anyway. */
821 if (!NILP (nomessage
))
824 file
= Fsubstring (found
, make_number (0), make_number (-1));
825 message_with_string ("Source file `%s' newer than byte-compiled file",
833 /* We are loading a source file (*.el). */
834 if (!NILP (Vload_source_file_function
))
840 val
= call4 (Vload_source_file_function
, found
, file
,
841 NILP (noerror
) ? Qnil
: Qt
,
842 NILP (nomessage
) ? Qnil
: Qt
);
843 return unbind_to (count
, val
);
850 efound
= ENCODE_FILE (found
);
851 stream
= fopen ((char *) XSTRING (efound
)->data
, fmode
);
853 #else /* not WINDOWSNT */
854 stream
= fdopen (fd
, fmode
);
855 #endif /* not WINDOWSNT */
859 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
862 if (! NILP (Vpurify_flag
))
863 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
865 if (NILP (nomessage
))
868 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
871 message_with_string ("Loading %s (source)...", file
, 1);
873 message_with_string ("Loading %s (compiled; note, source file is newer)...",
875 else /* The typical case; compiled file newer than source file. */
876 message_with_string ("Loading %s...", file
, 1);
880 lispstream
= Fcons (Qnil
, Qnil
);
881 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
882 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
883 record_unwind_protect (load_unwind
, lispstream
);
884 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
885 specbind (Qload_file_name
, found
);
886 specbind (Qinhibit_file_name_operation
, Qnil
);
888 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
890 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
891 unbind_to (count
, Qnil
);
893 /* Run any load-hooks for this file. */
894 temp
= Fassoc (file
, Vafter_load_alist
);
896 Fprogn (Fcdr (temp
));
899 if (saved_doc_string
)
900 free (saved_doc_string
);
901 saved_doc_string
= 0;
902 saved_doc_string_size
= 0;
904 if (prev_saved_doc_string
)
905 xfree (prev_saved_doc_string
);
906 prev_saved_doc_string
= 0;
907 prev_saved_doc_string_size
= 0;
909 if (!noninteractive
&& NILP (nomessage
))
912 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
915 message_with_string ("Loading %s (source)...done", file
, 1);
917 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
919 else /* The typical case; compiled file newer than source file. */
920 message_with_string ("Loading %s...done", file
, 1);
927 load_unwind (stream
) /* used as unwind-protect function in load */
930 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
931 | XFASTINT (XCDR (stream
))));
932 if (--load_in_progress
< 0) load_in_progress
= 0;
937 load_descriptor_unwind (oldlist
)
940 load_descriptor_list
= oldlist
;
944 /* Close all descriptors in use for Floads.
945 This is used when starting a subprocess. */
952 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
953 emacs_close (XFASTINT (XCAR (tail
)));
958 complete_filename_p (pathname
)
959 Lisp_Object pathname
;
961 register unsigned char *s
= XSTRING (pathname
)->data
;
962 return (IS_DIRECTORY_SEP (s
[0])
963 || (XSTRING (pathname
)->size
> 2
964 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
974 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
975 doc
: /* Search for FILENAME through PATH.
976 If SUFFIXES is non-nil, it should be a list of suffixes to append to
977 file name when searching.
978 If non-nil, PREDICATE is used instead of `file-readable-p'.
979 PREDICATE can also be an integer to pass to the access(2) function,
980 in which case file-name-handlers are ignored. */)
981 (filename
, path
, suffixes
, predicate
)
982 Lisp_Object filename
, path
, suffixes
, predicate
;
985 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
986 if (NILP (predicate
) && fd
> 0)
992 /* Search for a file whose name is STR, looking in directories
993 in the Lisp list PATH, and trying suffixes from SUFFIX.
994 On success, returns a file descriptor. On failure, returns -1.
996 SUFFIXES is a list of strings containing possible suffixes.
997 The empty suffix is automatically added iff the list is empty.
999 PREDICATE non-nil means don't open the files,
1000 just look for one that satisfies the predicate. In this case,
1001 returns 1 on success. The predicate can be a lisp function or
1002 an integer to pass to `access' (in which case file-name-handlers
1005 If STOREPTR is nonzero, it points to a slot where the name of
1006 the file actually found should be stored as a Lisp string.
1007 nil is stored there on failure.
1009 If the file we find is remote, return -2
1010 but store the found remote file name in *STOREPTR. */
1013 openp (path
, str
, suffixes
, storeptr
, predicate
)
1014 Lisp_Object path
, str
;
1015 Lisp_Object suffixes
;
1016 Lisp_Object
*storeptr
;
1017 Lisp_Object predicate
;
1022 register char *fn
= buf
;
1025 Lisp_Object filename
;
1027 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1028 Lisp_Object string
, tail
, encoded_fn
;
1029 int max_suffix_len
= 0;
1031 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1033 CHECK_STRING_CAR (tail
);
1034 max_suffix_len
= max (max_suffix_len
,
1035 STRING_BYTES (XSTRING (XCAR (tail
))));
1038 string
= filename
= Qnil
;
1039 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1044 if (complete_filename_p (str
))
1047 for (; CONSP (path
); path
= XCDR (path
))
1049 filename
= Fexpand_file_name (str
, XCAR (path
));
1050 if (!complete_filename_p (filename
))
1051 /* If there are non-absolute elts in PATH (eg ".") */
1052 /* Of course, this could conceivably lose if luser sets
1053 default-directory to be something non-absolute... */
1055 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1056 if (!complete_filename_p (filename
))
1057 /* Give up on this path element! */
1061 /* Calculate maximum size of any filename made from
1062 this path element/specified file name and any possible suffix. */
1063 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1064 if (fn_size
< want_size
)
1065 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1067 /* Loop over suffixes. */
1068 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1069 CONSP (tail
); tail
= XCDR (tail
))
1071 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1072 Lisp_Object handler
;
1075 /* Concatenate path element/specified name with the suffix.
1076 If the directory starts with /:, remove that. */
1077 if (XSTRING (filename
)->size
> 2
1078 && XSTRING (filename
)->data
[0] == '/'
1079 && XSTRING (filename
)->data
[1] == ':')
1081 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1082 STRING_BYTES (XSTRING (filename
)) - 2);
1083 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1087 strncpy (fn
, XSTRING (filename
)->data
,
1088 STRING_BYTES (XSTRING (filename
)));
1089 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1092 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1093 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1095 /* Check that the file exists and is not a directory. */
1096 /* We used to only check for handlers on non-absolute file names:
1100 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1101 It's not clear why that was the case and it breaks things like
1102 (load "/bar.el") where the file is actually "/bar.el.gz". */
1103 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1104 string
= build_string (fn
);
1105 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1107 if (NILP (predicate
))
1108 exists
= !NILP (Ffile_readable_p (string
));
1110 exists
= !NILP (call1 (predicate
, string
));
1111 if (exists
&& !NILP (Ffile_directory_p (string
)))
1116 /* We succeeded; return this descriptor and filename. */
1127 encoded_fn
= ENCODE_FILE (string
);
1128 pfn
= XSTRING (encoded_fn
)->data
;
1129 exists
= (stat (pfn
, &st
) >= 0
1130 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1133 /* Check that we can access or open it. */
1134 if (NATNUMP (predicate
))
1135 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1137 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1141 /* We succeeded; return this descriptor and filename. */
1159 /* Merge the list we've accumulated of globals from the current input source
1160 into the load_history variable. The details depend on whether
1161 the source has an associated file name or not. */
1164 build_load_history (stream
, source
)
1168 register Lisp_Object tail
, prev
, newelt
;
1169 register Lisp_Object tem
, tem2
;
1170 register int foundit
, loading
;
1172 loading
= stream
|| !NARROWED
;
1174 tail
= Vload_history
;
1177 while (CONSP (tail
))
1181 /* Find the feature's previous assoc list... */
1182 if (!NILP (Fequal (source
, Fcar (tem
))))
1186 /* If we're loading, remove it. */
1190 Vload_history
= XCDR (tail
);
1192 Fsetcdr (prev
, XCDR (tail
));
1195 /* Otherwise, cons on new symbols that are not already members. */
1198 tem2
= Vcurrent_load_list
;
1200 while (CONSP (tem2
))
1202 newelt
= XCAR (tem2
);
1204 if (NILP (Fmemq (newelt
, tem
)))
1205 Fsetcar (tail
, Fcons (XCAR (tem
),
1206 Fcons (newelt
, XCDR (tem
))));
1219 /* If we're loading, cons the new assoc onto the front of load-history,
1220 the most-recently-loaded position. Also do this if we didn't find
1221 an existing member for the current source. */
1222 if (loading
|| !foundit
)
1223 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1228 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1236 readevalloop_1 (old
)
1239 load_convert_to_unibyte
= ! NILP (old
);
1243 /* Signal an `end-of-file' error, if possible with file name
1247 end_of_file_error ()
1251 if (STRINGP (Vload_file_name
))
1252 data
= Fcons (Vload_file_name
, Qnil
);
1256 Fsignal (Qend_of_file
, data
);
1259 /* UNIBYTE specifies how to set load_convert_to_unibyte
1260 for this invocation.
1261 READFUN, if non-nil, is used instead of `read'. */
1264 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1265 Lisp_Object readcharfun
;
1267 Lisp_Object sourcename
;
1268 Lisp_Object (*evalfun
) ();
1270 Lisp_Object unibyte
, readfun
;
1273 register Lisp_Object val
;
1274 int count
= specpdl_ptr
- specpdl
;
1275 struct gcpro gcpro1
;
1276 struct buffer
*b
= 0;
1277 int continue_reading_p
;
1279 if (BUFFERP (readcharfun
))
1280 b
= XBUFFER (readcharfun
);
1281 else if (MARKERP (readcharfun
))
1282 b
= XMARKER (readcharfun
)->buffer
;
1284 specbind (Qstandard_input
, readcharfun
);
1285 specbind (Qcurrent_load_list
, Qnil
);
1286 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1287 load_convert_to_unibyte
= !NILP (unibyte
);
1289 readchar_backlog
= -1;
1291 GCPRO1 (sourcename
);
1293 LOADHIST_ATTACH (sourcename
);
1295 continue_reading_p
= 1;
1296 while (continue_reading_p
)
1298 if (b
!= 0 && NILP (b
->name
))
1299 error ("Reading from killed buffer");
1305 while ((c
= READCHAR
) != '\n' && c
!= -1);
1310 /* Ignore whitespace here, so we can detect eof. */
1311 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1314 if (!NILP (Vpurify_flag
) && c
== '(')
1316 int count1
= specpdl_ptr
- specpdl
;
1317 record_unwind_protect (unreadpure
, Qnil
);
1318 val
= read_list (-1, readcharfun
);
1319 unbind_to (count1
, Qnil
);
1324 read_objects
= Qnil
;
1325 if (!NILP (readfun
))
1327 val
= call1 (readfun
, readcharfun
);
1329 /* If READCHARFUN has set point to ZV, we should
1330 stop reading, even if the form read sets point
1331 to a different value when evaluated. */
1332 if (BUFFERP (readcharfun
))
1334 struct buffer
*b
= XBUFFER (readcharfun
);
1335 if (BUF_PT (b
) == BUF_ZV (b
))
1336 continue_reading_p
= 0;
1339 else if (! NILP (Vload_read_function
))
1340 val
= call1 (Vload_read_function
, readcharfun
);
1342 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1345 val
= (*evalfun
) (val
);
1349 Vvalues
= Fcons (val
, Vvalues
);
1350 if (EQ (Vstandard_output
, Qt
))
1357 build_load_history (stream
, sourcename
);
1360 unbind_to (count
, Qnil
);
1363 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1364 doc
: /* Execute the current buffer as Lisp code.
1365 Programs can pass two arguments, BUFFER and PRINTFLAG.
1366 BUFFER is the buffer to evaluate (nil means use current buffer).
1367 PRINTFLAG controls printing of output:
1368 nil means discard it; anything else is stream for print.
1370 If the optional third argument FILENAME is non-nil,
1371 it specifies the file name to use for `load-history'.
1372 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1373 for this invocation.
1375 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1376 `print' and related functions should work normally even if PRINTFLAG is nil.
1378 This function preserves the position of point. */)
1379 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1380 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1382 int count
= specpdl_ptr
- specpdl
;
1383 Lisp_Object tem
, buf
;
1386 buf
= Fcurrent_buffer ();
1388 buf
= Fget_buffer (buffer
);
1390 error ("No such buffer");
1392 if (NILP (printflag
) && NILP (do_allow_print
))
1397 if (NILP (filename
))
1398 filename
= XBUFFER (buf
)->filename
;
1400 specbind (Qstandard_output
, tem
);
1401 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1402 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1403 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1404 unbind_to (count
, Qnil
);
1409 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1410 doc
: /* Execute the region as Lisp code.
1411 When called from programs, expects two arguments,
1412 giving starting and ending indices in the current buffer
1413 of the text to be executed.
1414 Programs can pass third argument PRINTFLAG which controls output:
1415 nil means discard it; anything else is stream for printing it.
1416 Also the fourth argument READ-FUNCTION, if non-nil, is used
1417 instead of `read' to read each expression. It gets one argument
1418 which is the input stream for reading characters.
1420 This function does not move point. */)
1421 (start
, end
, printflag
, read_function
)
1422 Lisp_Object start
, end
, printflag
, read_function
;
1424 int count
= specpdl_ptr
- specpdl
;
1425 Lisp_Object tem
, cbuf
;
1427 cbuf
= Fcurrent_buffer ();
1429 if (NILP (printflag
))
1433 specbind (Qstandard_output
, tem
);
1435 if (NILP (printflag
))
1436 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1437 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1439 /* This both uses start and checks its type. */
1441 Fnarrow_to_region (make_number (BEGV
), end
);
1442 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1443 !NILP (printflag
), Qnil
, read_function
);
1445 return unbind_to (count
, Qnil
);
1449 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1450 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1451 If STREAM is nil, use the value of `standard-input' (which see).
1452 STREAM or the value of `standard-input' may be:
1453 a buffer (read from point and advance it)
1454 a marker (read from where it points and advance it)
1455 a function (call it with no arguments for each character,
1456 call it with a char as argument to push a char back)
1457 a string (takes text from string, starting at the beginning)
1458 t (read text line using minibuffer and use it, or read from
1459 standard input in batch mode). */)
1463 extern Lisp_Object
Fread_minibuffer ();
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
= XSTRING (stream
)->size
;
1515 endval
= XINT (end
);
1516 if (endval
< 0 || endval
> XSTRING (stream
)->size
)
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
!= XSTRING (tmp
)->size
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 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1973 Fsignal (Qinvalid_read_syntax
,
1974 Fcons (make_string ("#&...", 5), Qnil
));
1976 val
= Fmake_bool_vector (length
, Qnil
);
1977 bcopy (XSTRING (tmp
)->data
, 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
++)
2103 return Vload_file_name
;
2105 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2106 /* #:foo is the uninterned symbol named foo. */
2109 uninterned_symbol
= 1;
2113 /* Reader forms that can reuse previously read objects. */
2114 if (c
>= '0' && c
<= '9')
2119 /* Read a non-negative integer. */
2120 while (c
>= '0' && c
<= '9')
2126 /* #n=object returns object, but associates it with n for #n#. */
2129 /* Make a placeholder for #n# to use temporarily */
2130 Lisp_Object placeholder
;
2133 placeholder
= Fcons(Qnil
, Qnil
);
2134 cell
= Fcons (make_number (n
), placeholder
);
2135 read_objects
= Fcons (cell
, read_objects
);
2137 /* Read the object itself. */
2138 tem
= read0 (readcharfun
);
2140 /* Now put it everywhere the placeholder was... */
2141 substitute_object_in_subtree (tem
, placeholder
);
2143 /* ...and #n# will use the real value from now on. */
2144 Fsetcdr (cell
, tem
);
2148 /* #n# returns a previously read object. */
2151 tem
= Fassq (make_number (n
), read_objects
);
2154 /* Fall through to error message. */
2156 else if (c
== 'r' || c
== 'R')
2157 return read_integer (readcharfun
, n
);
2159 /* Fall through to error message. */
2161 else if (c
== 'x' || c
== 'X')
2162 return read_integer (readcharfun
, 16);
2163 else if (c
== 'o' || c
== 'O')
2164 return read_integer (readcharfun
, 8);
2165 else if (c
== 'b' || c
== 'B')
2166 return read_integer (readcharfun
, 2);
2169 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2172 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2177 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2187 new_backquote_flag
++;
2188 value
= read0 (readcharfun
);
2189 new_backquote_flag
--;
2191 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2195 if (new_backquote_flag
)
2197 Lisp_Object comma_type
= Qnil
;
2202 comma_type
= Qcomma_at
;
2204 comma_type
= Qcomma_dot
;
2207 if (ch
>= 0) UNREAD (ch
);
2208 comma_type
= Qcomma
;
2211 new_backquote_flag
--;
2212 value
= read0 (readcharfun
);
2213 new_backquote_flag
++;
2214 return Fcons (comma_type
, Fcons (value
, Qnil
));
2225 end_of_file_error ();
2228 c
= read_escape (readcharfun
, 0, &discard
);
2229 else if (BASE_LEADING_CODE_P (c
))
2230 c
= read_multibyte (c
, readcharfun
);
2232 return make_number (c
);
2237 char *p
= read_buffer
;
2238 char *end
= read_buffer
+ read_buffer_size
;
2240 /* 1 if we saw an escape sequence specifying
2241 a multibyte character, or a multibyte character. */
2242 int force_multibyte
= 0;
2243 /* 1 if we saw an escape sequence specifying
2244 a single-byte character. */
2245 int force_singlebyte
= 0;
2246 /* 1 if read_buffer contains multibyte text now. */
2247 int is_multibyte
= 0;
2251 while ((c
= READCHAR
) >= 0
2254 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2256 int offset
= p
- read_buffer
;
2257 read_buffer
= (char *) xrealloc (read_buffer
,
2258 read_buffer_size
*= 2);
2259 p
= read_buffer
+ offset
;
2260 end
= read_buffer
+ read_buffer_size
;
2267 c
= read_escape (readcharfun
, 1, &byterep
);
2269 /* C is -1 if \ newline has just been seen */
2272 if (p
== read_buffer
)
2278 force_singlebyte
= 1;
2279 else if (byterep
== 2)
2280 force_multibyte
= 1;
2283 /* A character that must be multibyte forces multibyte. */
2284 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2285 force_multibyte
= 1;
2287 /* If we just discovered the need to be multibyte,
2288 convert the text accumulated thus far. */
2289 if (force_multibyte
&& ! is_multibyte
)
2292 to_multibyte (&p
, &end
, &nchars
);
2295 /* Allow `\C- ' and `\C-?'. */
2296 if (c
== (CHAR_CTL
| ' '))
2298 else if (c
== (CHAR_CTL
| '?'))
2303 /* Shift modifier is valid only with [A-Za-z]. */
2304 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2306 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2307 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2311 /* Move the meta bit to the right place for a string. */
2312 c
= (c
& ~CHAR_META
) | 0x80;
2313 if (c
& CHAR_MODIFIER_MASK
)
2314 error ("Invalid modifier in string");
2317 p
+= CHAR_STRING (c
, p
);
2325 end_of_file_error ();
2327 /* If purifying, and string starts with \ newline,
2328 return zero instead. This is for doc strings
2329 that we are really going to find in etc/DOC.nn.nn */
2330 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2331 return make_number (0);
2333 if (is_multibyte
|| force_singlebyte
)
2335 else if (load_convert_to_unibyte
)
2338 to_multibyte (&p
, &end
, &nchars
);
2339 if (p
- read_buffer
!= nchars
)
2341 string
= make_multibyte_string (read_buffer
, nchars
,
2343 return Fstring_make_unibyte (string
);
2345 /* We can make a unibyte string directly. */
2348 else if (EQ (readcharfun
, Qget_file_char
)
2349 || EQ (readcharfun
, Qlambda
))
2351 /* Nowadays, reading directly from a file is used only for
2352 compiled Emacs Lisp files, and those always use the
2353 Emacs internal encoding. Meanwhile, Qlambda is used
2354 for reading dynamic byte code (compiled with
2355 byte-compile-dynamic = t). So make the string multibyte
2356 if the string contains any multibyte sequences.
2357 (to_multibyte is a no-op if not.) */
2358 to_multibyte (&p
, &end
, &nchars
);
2359 is_multibyte
= (p
- read_buffer
) != nchars
;
2362 /* In all other cases, if we read these bytes as
2363 separate characters, treat them as separate characters now. */
2366 /* We want readchar_count to be the number of characters, not
2367 bytes. Hence we adjust for multibyte characters in the
2368 string. ... But it doesn't seem to be necessary, because
2369 READCHAR *does* read multibyte characters from buffers. */
2370 /* readchar_count -= (p - read_buffer) - nchars; */
2372 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2374 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2380 int next_char
= READCHAR
;
2383 if (next_char
<= 040
2384 || index ("\"'`,(", next_char
))
2390 /* Otherwise, we fall through! Note that the atom-reading loop
2391 below will now loop at least once, assuring that we will not
2392 try to UNREAD two characters in a row. */
2396 if (c
<= 040) goto retry
;
2398 char *p
= read_buffer
;
2402 char *end
= read_buffer
+ read_buffer_size
;
2405 && !(c
== '\"' || c
== '\'' || c
== ';'
2406 || c
== '(' || c
== ')'
2407 || c
== '[' || c
== ']' || c
== '#'))
2409 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2411 int offset
= p
- read_buffer
;
2412 read_buffer
= (char *) xrealloc (read_buffer
,
2413 read_buffer_size
*= 2);
2414 p
= read_buffer
+ offset
;
2415 end
= read_buffer
+ read_buffer_size
;
2422 end_of_file_error ();
2426 if (! SINGLE_BYTE_CHAR_P (c
))
2427 p
+= CHAR_STRING (c
, p
);
2436 int offset
= p
- read_buffer
;
2437 read_buffer
= (char *) xrealloc (read_buffer
,
2438 read_buffer_size
*= 2);
2439 p
= read_buffer
+ offset
;
2440 end
= read_buffer
+ read_buffer_size
;
2447 if (!quoted
&& !uninterned_symbol
)
2450 register Lisp_Object val
;
2452 if (*p1
== '+' || *p1
== '-') p1
++;
2453 /* Is it an integer? */
2456 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2457 /* Integers can have trailing decimal points. */
2458 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2460 /* It is an integer. */
2464 if (sizeof (int) == sizeof (EMACS_INT
))
2465 XSETINT (val
, atoi (read_buffer
));
2466 else if (sizeof (long) == sizeof (EMACS_INT
))
2467 XSETINT (val
, atol (read_buffer
));
2473 if (isfloat_string (read_buffer
))
2475 /* Compute NaN and infinities using 0.0 in a variable,
2476 to cope with compilers that think they are smarter
2482 /* Negate the value ourselves. This treats 0, NaNs,
2483 and infinity properly on IEEE floating point hosts,
2484 and works around a common bug where atof ("-0.0")
2486 int negative
= read_buffer
[0] == '-';
2488 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2489 returns 1, is if the input ends in e+INF or e+NaN. */
2496 value
= zero
/ zero
;
2499 value
= atof (read_buffer
+ negative
);
2503 return make_float (negative
? - value
: value
);
2507 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2508 : intern (read_buffer
);
2509 if (EQ (Vread_with_symbol_positions
, Qt
)
2510 || EQ (Vread_with_symbol_positions
, readcharfun
))
2511 Vread_symbol_positions_list
=
2512 /* Kind of a hack; this will probably fail if characters
2513 in the symbol name were escaped. Not really a big
2515 Fcons (Fcons (result
,
2516 make_number (readchar_count
2517 - XFASTINT (Flength (Fsymbol_name (result
))))),
2518 Vread_symbol_positions_list
);
2526 /* List of nodes we've seen during substitute_object_in_subtree. */
2527 static Lisp_Object seen_list
;
2530 substitute_object_in_subtree (object
, placeholder
)
2532 Lisp_Object placeholder
;
2534 Lisp_Object check_object
;
2536 /* We haven't seen any objects when we start. */
2539 /* Make all the substitutions. */
2541 = substitute_object_recurse (object
, placeholder
, object
);
2543 /* Clear seen_list because we're done with it. */
2546 /* The returned object here is expected to always eq the
2548 if (!EQ (check_object
, object
))
2549 error ("Unexpected mutation error in reader");
2552 /* Feval doesn't get called from here, so no gc protection is needed. */
2553 #define SUBSTITUTE(get_val, set_val) \
2555 Lisp_Object old_value = get_val; \
2556 Lisp_Object true_value \
2557 = substitute_object_recurse (object, placeholder,\
2560 if (!EQ (old_value, true_value)) \
2567 substitute_object_recurse (object
, placeholder
, subtree
)
2569 Lisp_Object placeholder
;
2570 Lisp_Object subtree
;
2572 /* If we find the placeholder, return the target object. */
2573 if (EQ (placeholder
, subtree
))
2576 /* If we've been to this node before, don't explore it again. */
2577 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2580 /* If this node can be the entry point to a cycle, remember that
2581 we've seen it. It can only be such an entry point if it was made
2582 by #n=, which means that we can find it as a value in
2584 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2585 seen_list
= Fcons (subtree
, seen_list
);
2587 /* Recurse according to subtree's type.
2588 Every branch must return a Lisp_Object. */
2589 switch (XTYPE (subtree
))
2591 case Lisp_Vectorlike
:
2594 int length
= XINT (Flength(subtree
));
2595 for (i
= 0; i
< length
; i
++)
2597 Lisp_Object idx
= make_number (i
);
2598 SUBSTITUTE (Faref (subtree
, idx
),
2599 Faset (subtree
, idx
, true_value
));
2606 SUBSTITUTE (Fcar_safe (subtree
),
2607 Fsetcar (subtree
, true_value
));
2608 SUBSTITUTE (Fcdr_safe (subtree
),
2609 Fsetcdr (subtree
, true_value
));
2615 /* Check for text properties in each interval.
2616 substitute_in_interval contains part of the logic. */
2618 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2619 Lisp_Object arg
= Fcons (object
, placeholder
);
2621 traverse_intervals_noorder (root_interval
,
2622 &substitute_in_interval
, arg
);
2627 /* Other types don't recurse any further. */
2633 /* Helper function for substitute_object_recurse. */
2635 substitute_in_interval (interval
, arg
)
2639 Lisp_Object object
= Fcar (arg
);
2640 Lisp_Object placeholder
= Fcdr (arg
);
2642 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2661 if (*cp
== '+' || *cp
== '-')
2664 if (*cp
>= '0' && *cp
<= '9')
2667 while (*cp
>= '0' && *cp
<= '9')
2675 if (*cp
>= '0' && *cp
<= '9')
2678 while (*cp
>= '0' && *cp
<= '9')
2681 if (*cp
== 'e' || *cp
== 'E')
2685 if (*cp
== '+' || *cp
== '-')
2689 if (*cp
>= '0' && *cp
<= '9')
2692 while (*cp
>= '0' && *cp
<= '9')
2695 else if (cp
== start
)
2697 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2702 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2708 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2709 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2710 || state
== (DOT_CHAR
|TRAIL_INT
)
2711 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2712 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2713 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2718 read_vector (readcharfun
, bytecodeflag
)
2719 Lisp_Object readcharfun
;
2724 register Lisp_Object
*ptr
;
2725 register Lisp_Object tem
, item
, vector
;
2726 register struct Lisp_Cons
*otem
;
2729 tem
= read_list (1, readcharfun
);
2730 len
= Flength (tem
);
2731 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2733 size
= XVECTOR (vector
)->size
;
2734 ptr
= XVECTOR (vector
)->contents
;
2735 for (i
= 0; i
< size
; i
++)
2738 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2739 bytecode object, the docstring containing the bytecode and
2740 constants values must be treated as unibyte and passed to
2741 Fread, to get the actual bytecode string and constants vector. */
2742 if (bytecodeflag
&& load_force_doc_strings
)
2744 if (i
== COMPILED_BYTECODE
)
2746 if (!STRINGP (item
))
2747 error ("invalid byte code");
2749 /* Delay handling the bytecode slot until we know whether
2750 it is lazily-loaded (we can tell by whether the
2751 constants slot is nil). */
2752 ptr
[COMPILED_CONSTANTS
] = item
;
2755 else if (i
== COMPILED_CONSTANTS
)
2757 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2761 /* Coerce string to unibyte (like string-as-unibyte,
2762 but without generating extra garbage and
2763 guaranteeing no change in the contents). */
2764 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2765 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2767 item
= Fread (bytestr
);
2769 error ("invalid byte code");
2771 otem
= XCONS (item
);
2772 bytestr
= XCAR (item
);
2777 /* Now handle the bytecode slot. */
2778 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2781 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2789 /* FLAG = 1 means check for ] to terminate rather than ) and .
2790 FLAG = -1 means check for starting with defun
2791 and make structure pure. */
2794 read_list (flag
, readcharfun
)
2796 register Lisp_Object readcharfun
;
2798 /* -1 means check next element for defun,
2799 0 means don't check,
2800 1 means already checked and found defun. */
2801 int defunflag
= flag
< 0 ? -1 : 0;
2802 Lisp_Object val
, tail
;
2803 register Lisp_Object elt
, tem
;
2804 struct gcpro gcpro1
, gcpro2
;
2805 /* 0 is the normal case.
2806 1 means this list is a doc reference; replace it with the number 0.
2807 2 means this list is a doc reference; replace it with the doc string. */
2808 int doc_reference
= 0;
2810 /* Initialize this to 1 if we are reading a list. */
2811 int first_in_list
= flag
<= 0;
2820 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2825 /* While building, if the list starts with #$, treat it specially. */
2826 if (EQ (elt
, Vload_file_name
)
2828 && !NILP (Vpurify_flag
))
2830 if (NILP (Vdoc_file_name
))
2831 /* We have not yet called Snarf-documentation, so assume
2832 this file is described in the DOC-MM.NN file
2833 and Snarf-documentation will fill in the right value later.
2834 For now, replace the whole list with 0. */
2837 /* We have already called Snarf-documentation, so make a relative
2838 file name for this file, so it can be found properly
2839 in the installed Lisp directory.
2840 We don't use Fexpand_file_name because that would make
2841 the directory absolute now. */
2842 elt
= concat2 (build_string ("../lisp/"),
2843 Ffile_name_nondirectory (elt
));
2845 else if (EQ (elt
, Vload_file_name
)
2847 && load_force_doc_strings
)
2856 Fsignal (Qinvalid_read_syntax
,
2857 Fcons (make_string (") or . in a vector", 18), Qnil
));
2865 XSETCDR (tail
, read0 (readcharfun
));
2867 val
= read0 (readcharfun
);
2868 read1 (readcharfun
, &ch
, 0);
2872 if (doc_reference
== 1)
2873 return make_number (0);
2874 if (doc_reference
== 2)
2876 /* Get a doc string from the file we are loading.
2877 If it's in saved_doc_string, get it from there. */
2878 int pos
= XINT (XCDR (val
));
2879 /* Position is negative for user variables. */
2880 if (pos
< 0) pos
= -pos
;
2881 if (pos
>= saved_doc_string_position
2882 && pos
< (saved_doc_string_position
2883 + saved_doc_string_length
))
2885 int start
= pos
- saved_doc_string_position
;
2888 /* Process quoting with ^A,
2889 and find the end of the string,
2890 which is marked with ^_ (037). */
2891 for (from
= start
, to
= start
;
2892 saved_doc_string
[from
] != 037;)
2894 int c
= saved_doc_string
[from
++];
2897 c
= saved_doc_string
[from
++];
2899 saved_doc_string
[to
++] = c
;
2901 saved_doc_string
[to
++] = 0;
2903 saved_doc_string
[to
++] = 037;
2906 saved_doc_string
[to
++] = c
;
2909 return make_string (saved_doc_string
+ start
,
2912 /* Look in prev_saved_doc_string the same way. */
2913 else if (pos
>= prev_saved_doc_string_position
2914 && pos
< (prev_saved_doc_string_position
2915 + prev_saved_doc_string_length
))
2917 int start
= pos
- prev_saved_doc_string_position
;
2920 /* Process quoting with ^A,
2921 and find the end of the string,
2922 which is marked with ^_ (037). */
2923 for (from
= start
, to
= start
;
2924 prev_saved_doc_string
[from
] != 037;)
2926 int c
= prev_saved_doc_string
[from
++];
2929 c
= prev_saved_doc_string
[from
++];
2931 prev_saved_doc_string
[to
++] = c
;
2933 prev_saved_doc_string
[to
++] = 0;
2935 prev_saved_doc_string
[to
++] = 037;
2938 prev_saved_doc_string
[to
++] = c
;
2941 return make_string (prev_saved_doc_string
+ start
,
2945 return get_doc_string (val
, 0, 0);
2950 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2952 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2954 tem
= (read_pure
&& flag
<= 0
2955 ? pure_cons (elt
, Qnil
)
2956 : Fcons (elt
, Qnil
));
2958 XSETCDR (tail
, tem
);
2963 defunflag
= EQ (elt
, Qdefun
);
2964 else if (defunflag
> 0)
2969 Lisp_Object Vobarray
;
2970 Lisp_Object initial_obarray
;
2972 /* oblookup stores the bucket number here, for the sake of Funintern. */
2974 int oblookup_last_bucket_number
;
2976 static int hash_string ();
2977 Lisp_Object
oblookup ();
2979 /* Get an error if OBARRAY is not an obarray.
2980 If it is one, return it. */
2983 check_obarray (obarray
)
2984 Lisp_Object obarray
;
2986 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2988 /* If Vobarray is now invalid, force it to be valid. */
2989 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2991 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2996 /* Intern the C string STR: return a symbol with that name,
2997 interned in the current obarray. */
3004 int len
= strlen (str
);
3005 Lisp_Object obarray
;
3008 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3009 obarray
= check_obarray (obarray
);
3010 tem
= oblookup (obarray
, str
, len
, len
);
3013 return Fintern (make_string (str
, len
), obarray
);
3016 /* Create an uninterned symbol with name STR. */
3022 int len
= strlen (str
);
3024 return Fmake_symbol ((!NILP (Vpurify_flag
)
3025 ? make_pure_string (str
, len
, len
, 0)
3026 : make_string (str
, len
)));
3029 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3030 doc
: /* Return the canonical symbol whose name is STRING.
3031 If there is none, one is created by this function and returned.
3032 A second optional argument specifies the obarray to use;
3033 it defaults to the value of `obarray'. */)
3035 Lisp_Object string
, obarray
;
3037 register Lisp_Object tem
, sym
, *ptr
;
3039 if (NILP (obarray
)) obarray
= Vobarray
;
3040 obarray
= check_obarray (obarray
);
3042 CHECK_STRING (string
);
3044 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3045 XSTRING (string
)->size
,
3046 STRING_BYTES (XSTRING (string
)));
3047 if (!INTEGERP (tem
))
3050 if (!NILP (Vpurify_flag
))
3051 string
= Fpurecopy (string
);
3052 sym
= Fmake_symbol (string
);
3054 if (EQ (obarray
, initial_obarray
))
3055 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3057 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3059 if ((XSTRING (string
)->data
[0] == ':')
3060 && EQ (obarray
, initial_obarray
))
3062 XSYMBOL (sym
)->constant
= 1;
3063 XSYMBOL (sym
)->value
= sym
;
3066 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3068 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3070 XSYMBOL (sym
)->next
= 0;
3075 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3076 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3077 NAME may be a string or a symbol. If it is a symbol, that exact
3078 symbol is searched for.
3079 A second optional argument specifies the obarray to use;
3080 it defaults to the value of `obarray'. */)
3082 Lisp_Object name
, obarray
;
3084 register Lisp_Object tem
;
3085 struct Lisp_String
*string
;
3087 if (NILP (obarray
)) obarray
= Vobarray
;
3088 obarray
= check_obarray (obarray
);
3090 if (!SYMBOLP (name
))
3092 CHECK_STRING (name
);
3093 string
= XSTRING (name
);
3096 string
= XSTRING (SYMBOL_NAME (name
));
3098 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
3099 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3105 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3106 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3107 The value is t if a symbol was found and deleted, nil otherwise.
3108 NAME may be a string or a symbol. If it is a symbol, that symbol
3109 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3110 OBARRAY defaults to the value of the variable `obarray'. */)
3112 Lisp_Object name
, obarray
;
3114 register Lisp_Object string
, tem
;
3117 if (NILP (obarray
)) obarray
= Vobarray
;
3118 obarray
= check_obarray (obarray
);
3121 string
= SYMBOL_NAME (name
);
3124 CHECK_STRING (name
);
3128 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3129 XSTRING (string
)->size
,
3130 STRING_BYTES (XSTRING (string
)));
3133 /* If arg was a symbol, don't delete anything but that symbol itself. */
3134 if (SYMBOLP (name
) && !EQ (name
, tem
))
3137 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3138 XSYMBOL (tem
)->constant
= 0;
3139 XSYMBOL (tem
)->indirect_variable
= 0;
3141 hash
= oblookup_last_bucket_number
;
3143 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3145 if (XSYMBOL (tem
)->next
)
3146 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3148 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3152 Lisp_Object tail
, following
;
3154 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3155 XSYMBOL (tail
)->next
;
3158 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3159 if (EQ (following
, tem
))
3161 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3170 /* Return the symbol in OBARRAY whose names matches the string
3171 of SIZE characters (SIZE_BYTE bytes) at PTR.
3172 If there is no such symbol in OBARRAY, return nil.
3174 Also store the bucket number in oblookup_last_bucket_number. */
3177 oblookup (obarray
, ptr
, size
, size_byte
)
3178 Lisp_Object obarray
;
3180 int size
, size_byte
;
3184 register Lisp_Object tail
;
3185 Lisp_Object bucket
, tem
;
3187 if (!VECTORP (obarray
)
3188 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3190 obarray
= check_obarray (obarray
);
3191 obsize
= XVECTOR (obarray
)->size
;
3193 /* This is sometimes needed in the middle of GC. */
3194 obsize
&= ~ARRAY_MARK_FLAG
;
3195 /* Combining next two lines breaks VMS C 2.3. */
3196 hash
= hash_string (ptr
, size_byte
);
3198 bucket
= XVECTOR (obarray
)->contents
[hash
];
3199 oblookup_last_bucket_number
= hash
;
3200 if (XFASTINT (bucket
) == 0)
3202 else if (!SYMBOLP (bucket
))
3203 error ("Bad data in guts of obarray"); /* Like CADR error message */
3205 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3207 if (STRING_BYTES (XSTRING (SYMBOL_NAME (tail
))) == size_byte
3208 && XSTRING (SYMBOL_NAME (tail
))->size
== size
3209 && !bcmp (XSTRING (SYMBOL_NAME (tail
))->data
, ptr
, size_byte
))
3211 else if (XSYMBOL (tail
)->next
== 0)
3214 XSETINT (tem
, hash
);
3219 hash_string (ptr
, len
)
3223 register unsigned char *p
= ptr
;
3224 register unsigned char *end
= p
+ len
;
3225 register unsigned char c
;
3226 register int hash
= 0;
3231 if (c
>= 0140) c
-= 40;
3232 hash
= ((hash
<<3) + (hash
>>28) + c
);
3234 return hash
& 07777777777;
3238 map_obarray (obarray
, fn
, arg
)
3239 Lisp_Object obarray
;
3240 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3244 register Lisp_Object tail
;
3245 CHECK_VECTOR (obarray
);
3246 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3248 tail
= XVECTOR (obarray
)->contents
[i
];
3253 if (XSYMBOL (tail
)->next
== 0)
3255 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3261 mapatoms_1 (sym
, function
)
3262 Lisp_Object sym
, function
;
3264 call1 (function
, sym
);
3267 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3268 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3269 OBARRAY defaults to the value of `obarray'. */)
3271 Lisp_Object function
, obarray
;
3273 if (NILP (obarray
)) obarray
= Vobarray
;
3274 obarray
= check_obarray (obarray
);
3276 map_obarray (obarray
, mapatoms_1
, function
);
3280 #define OBARRAY_SIZE 1511
3285 Lisp_Object oblength
;
3289 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3291 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3292 Vobarray
= Fmake_vector (oblength
, make_number (0));
3293 initial_obarray
= Vobarray
;
3294 staticpro (&initial_obarray
);
3295 /* Intern nil in the obarray */
3296 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3297 XSYMBOL (Qnil
)->constant
= 1;
3299 /* These locals are to kludge around a pyramid compiler bug. */
3300 hash
= hash_string ("nil", 3);
3301 /* Separate statement here to avoid VAXC bug. */
3302 hash
%= OBARRAY_SIZE
;
3303 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3306 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3307 XSYMBOL (Qnil
)->function
= Qunbound
;
3308 XSYMBOL (Qunbound
)->value
= Qunbound
;
3309 XSYMBOL (Qunbound
)->function
= Qunbound
;
3312 XSYMBOL (Qnil
)->value
= Qnil
;
3313 XSYMBOL (Qnil
)->plist
= Qnil
;
3314 XSYMBOL (Qt
)->value
= Qt
;
3315 XSYMBOL (Qt
)->constant
= 1;
3317 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3320 Qvariable_documentation
= intern ("variable-documentation");
3321 staticpro (&Qvariable_documentation
);
3323 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3324 read_buffer
= (char *) xmalloc (read_buffer_size
);
3329 struct Lisp_Subr
*sname
;
3332 sym
= intern (sname
->symbol_name
);
3333 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3336 #ifdef NOTDEF /* use fset in subr.el now */
3338 defalias (sname
, string
)
3339 struct Lisp_Subr
*sname
;
3343 sym
= intern (string
);
3344 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3348 /* Define an "integer variable"; a symbol whose value is forwarded
3349 to a C variable of type int. Sample call: */
3350 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3352 defvar_int (namestring
, address
)
3356 Lisp_Object sym
, val
;
3357 sym
= intern (namestring
);
3358 val
= allocate_misc ();
3359 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3360 XINTFWD (val
)->intvar
= address
;
3361 SET_SYMBOL_VALUE (sym
, val
);
3364 /* Similar but define a variable whose value is t if address contains 1,
3365 nil if address contains 0 */
3367 defvar_bool (namestring
, address
)
3371 Lisp_Object sym
, val
;
3372 sym
= intern (namestring
);
3373 val
= allocate_misc ();
3374 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3375 XBOOLFWD (val
)->boolvar
= address
;
3376 SET_SYMBOL_VALUE (sym
, val
);
3377 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3380 /* Similar but define a variable whose value is the Lisp Object stored
3381 at address. Two versions: with and without gc-marking of the C
3382 variable. The nopro version is used when that variable will be
3383 gc-marked for some other reason, since marking the same slot twice
3384 can cause trouble with strings. */
3386 defvar_lisp_nopro (namestring
, address
)
3388 Lisp_Object
*address
;
3390 Lisp_Object sym
, val
;
3391 sym
= intern (namestring
);
3392 val
= allocate_misc ();
3393 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3394 XOBJFWD (val
)->objvar
= address
;
3395 SET_SYMBOL_VALUE (sym
, val
);
3399 defvar_lisp (namestring
, address
)
3401 Lisp_Object
*address
;
3403 defvar_lisp_nopro (namestring
, address
);
3404 staticpro (address
);
3407 /* Similar but define a variable whose value is the Lisp Object stored in
3408 the current buffer. address is the address of the slot in the buffer
3409 that is current now. */
3412 defvar_per_buffer (namestring
, address
, type
, doc
)
3414 Lisp_Object
*address
;
3418 Lisp_Object sym
, val
;
3420 extern struct buffer buffer_local_symbols
;
3422 sym
= intern (namestring
);
3423 val
= allocate_misc ();
3424 offset
= (char *)address
- (char *)current_buffer
;
3426 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3427 XBUFFER_OBJFWD (val
)->offset
= offset
;
3428 SET_SYMBOL_VALUE (sym
, val
);
3429 PER_BUFFER_SYMBOL (offset
) = sym
;
3430 PER_BUFFER_TYPE (offset
) = type
;
3432 if (PER_BUFFER_IDX (offset
) == 0)
3433 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3434 slot of buffer_local_flags */
3439 /* Similar but define a variable whose value is the Lisp Object stored
3440 at a particular offset in the current kboard object. */
3443 defvar_kboard (namestring
, offset
)
3447 Lisp_Object sym
, val
;
3448 sym
= intern (namestring
);
3449 val
= allocate_misc ();
3450 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3451 XKBOARD_OBJFWD (val
)->offset
= offset
;
3452 SET_SYMBOL_VALUE (sym
, val
);
3455 /* Record the value of load-path used at the start of dumping
3456 so we can see if the site changed it later during dumping. */
3457 static Lisp_Object dump_path
;
3463 int turn_off_warning
= 0;
3465 /* Compute the default load-path. */
3467 normal
= PATH_LOADSEARCH
;
3468 Vload_path
= decode_env_path (0, normal
);
3470 if (NILP (Vpurify_flag
))
3471 normal
= PATH_LOADSEARCH
;
3473 normal
= PATH_DUMPLOADSEARCH
;
3475 /* In a dumped Emacs, we normally have to reset the value of
3476 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3477 uses ../lisp, instead of the path of the installed elisp
3478 libraries. However, if it appears that Vload_path was changed
3479 from the default before dumping, don't override that value. */
3482 if (! NILP (Fequal (dump_path
, Vload_path
)))
3484 Vload_path
= decode_env_path (0, normal
);
3485 if (!NILP (Vinstallation_directory
))
3487 Lisp_Object tem
, tem1
, sitelisp
;
3489 /* Remove site-lisp dirs from path temporarily and store
3490 them in sitelisp, then conc them on at the end so
3491 they're always first in path. */
3495 tem
= Fcar (Vload_path
);
3496 tem1
= Fstring_match (build_string ("site-lisp"),
3500 Vload_path
= Fcdr (Vload_path
);
3501 sitelisp
= Fcons (tem
, sitelisp
);
3507 /* Add to the path the lisp subdir of the
3508 installation dir, if it exists. */
3509 tem
= Fexpand_file_name (build_string ("lisp"),
3510 Vinstallation_directory
);
3511 tem1
= Ffile_exists_p (tem
);
3514 if (NILP (Fmember (tem
, Vload_path
)))
3516 turn_off_warning
= 1;
3517 Vload_path
= Fcons (tem
, Vload_path
);
3521 /* That dir doesn't exist, so add the build-time
3522 Lisp dirs instead. */
3523 Vload_path
= nconc2 (Vload_path
, dump_path
);
3525 /* Add leim under the installation dir, if it exists. */
3526 tem
= Fexpand_file_name (build_string ("leim"),
3527 Vinstallation_directory
);
3528 tem1
= Ffile_exists_p (tem
);
3531 if (NILP (Fmember (tem
, Vload_path
)))
3532 Vload_path
= Fcons (tem
, Vload_path
);
3535 /* Add site-list under the installation dir, if it exists. */
3536 tem
= Fexpand_file_name (build_string ("site-lisp"),
3537 Vinstallation_directory
);
3538 tem1
= Ffile_exists_p (tem
);
3541 if (NILP (Fmember (tem
, Vload_path
)))
3542 Vload_path
= Fcons (tem
, Vload_path
);
3545 /* If Emacs was not built in the source directory,
3546 and it is run from where it was built, add to load-path
3547 the lisp, leim and site-lisp dirs under that directory. */
3549 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3553 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3554 Vinstallation_directory
);
3555 tem1
= Ffile_exists_p (tem
);
3557 /* Don't be fooled if they moved the entire source tree
3558 AFTER dumping Emacs. If the build directory is indeed
3559 different from the source dir, src/Makefile.in and
3560 src/Makefile will not be found together. */
3561 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3562 Vinstallation_directory
);
3563 tem2
= Ffile_exists_p (tem
);
3564 if (!NILP (tem1
) && NILP (tem2
))
3566 tem
= Fexpand_file_name (build_string ("lisp"),
3569 if (NILP (Fmember (tem
, Vload_path
)))
3570 Vload_path
= Fcons (tem
, Vload_path
);
3572 tem
= Fexpand_file_name (build_string ("leim"),
3575 if (NILP (Fmember (tem
, Vload_path
)))
3576 Vload_path
= Fcons (tem
, Vload_path
);
3578 tem
= Fexpand_file_name (build_string ("site-lisp"),
3581 if (NILP (Fmember (tem
, Vload_path
)))
3582 Vload_path
= Fcons (tem
, Vload_path
);
3585 if (!NILP (sitelisp
))
3586 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3592 /* NORMAL refers to the lisp dir in the source directory. */
3593 /* We used to add ../lisp at the front here, but
3594 that caused trouble because it was copied from dump_path
3595 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3596 It should be unnecessary. */
3597 Vload_path
= decode_env_path (0, normal
);
3598 dump_path
= Vload_path
;
3603 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3604 almost never correct, thereby causing a warning to be printed out that
3605 confuses users. Since PATH_LOADSEARCH is always overridden by the
3606 EMACSLOADPATH environment variable below, disable the warning on NT. */
3608 /* Warn if dirs in the *standard* path don't exist. */
3609 if (!turn_off_warning
)
3611 Lisp_Object path_tail
;
3613 for (path_tail
= Vload_path
;
3615 path_tail
= XCDR (path_tail
))
3617 Lisp_Object dirfile
;
3618 dirfile
= Fcar (path_tail
);
3619 if (STRINGP (dirfile
))
3621 dirfile
= Fdirectory_file_name (dirfile
);
3622 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3623 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3628 #endif /* WINDOWSNT */
3630 /* If the EMACSLOADPATH environment variable is set, use its value.
3631 This doesn't apply if we're dumping. */
3633 if (NILP (Vpurify_flag
)
3634 && egetenv ("EMACSLOADPATH"))
3636 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3640 load_in_progress
= 0;
3641 Vload_file_name
= Qnil
;
3643 load_descriptor_list
= Qnil
;
3645 Vstandard_input
= Qt
;
3646 Vloads_in_progress
= Qnil
;
3649 /* Print a warning, using format string FORMAT, that directory DIRNAME
3650 does not exist. Print it on stderr and put it in *Message*. */
3653 dir_warning (format
, dirname
)
3655 Lisp_Object dirname
;
3658 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3660 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3661 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3662 /* Don't log the warning before we've initialized!! */
3664 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3671 defsubr (&Sread_from_string
);
3673 defsubr (&Sintern_soft
);
3674 defsubr (&Sunintern
);
3676 defsubr (&Seval_buffer
);
3677 defsubr (&Seval_region
);
3678 defsubr (&Sread_char
);
3679 defsubr (&Sread_char_exclusive
);
3680 defsubr (&Sread_event
);
3681 defsubr (&Sget_file_char
);
3682 defsubr (&Smapatoms
);
3683 defsubr (&Slocate_file_internal
);
3685 DEFVAR_LISP ("obarray", &Vobarray
,
3686 doc
: /* Symbol table for use by `intern' and `read'.
3687 It is a vector whose length ought to be prime for best results.
3688 The vector's contents don't make sense if examined from Lisp programs;
3689 to find all the symbols in an obarray, use `mapatoms'. */);
3691 DEFVAR_LISP ("values", &Vvalues
,
3692 doc
: /* List of values of all expressions which were read, evaluated and printed.
3693 Order is reverse chronological. */);
3695 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3696 doc
: /* Stream for read to get input from.
3697 See documentation of `read' for possible values. */);
3698 Vstandard_input
= Qt
;
3700 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3701 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3703 If this variable is a buffer, then only forms read from that buffer
3704 will be added to `read-symbol-positions-list'.
3705 If this variable is t, then all read forms will be added.
3706 The effect of all other values other than nil are not currently
3707 defined, although they may be in the future.
3709 The positions are relative to the last call to `read' or
3710 `read-from-string'. It is probably a bad idea to set this variable at
3711 the toplevel; bind it instead. */);
3712 Vread_with_symbol_positions
= Qnil
;
3714 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3715 doc
: /* An list mapping read symbols to their positions.
3716 This variable is modified during calls to `read' or
3717 `read-from-string', but only when `read-with-symbol-positions' is
3720 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3721 CHAR-POSITION is an integer giving the offset of that occurence of the
3722 symbol from the position where `read' or `read-from-string' started.
3724 Note that a symbol will appear multiple times in this list, if it was
3725 read multiple times. The list is in the same order as the symbols
3727 Vread_symbol_positions_list
= Qnil
;
3729 DEFVAR_LISP ("load-path", &Vload_path
,
3730 doc
: /* *List of directories to search for files to load.
3731 Each element is a string (directory name) or nil (try default directory).
3732 Initialized based on EMACSLOADPATH environment variable, if any,
3733 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3735 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3736 doc
: /* *List of suffixes to try for files to load.
3737 This list should not include the empty string. */);
3738 Vload_suffixes
= Fcons (build_string (".elc"),
3739 Fcons (build_string (".el"), Qnil
));
3740 /* We don't use empty_string because it's not initialized yet. */
3741 default_suffixes
= Fcons (build_string (""), Qnil
);
3742 staticpro (&default_suffixes
);
3744 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3745 doc
: /* Non-nil iff inside of `load'. */);
3747 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3748 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3749 Each element looks like (FILENAME FORMS...).
3750 When `load' is run and the file-name argument is FILENAME,
3751 the FORMS in the corresponding element are executed at the end of loading.
3753 FILENAME must match exactly! Normally FILENAME is the name of a library,
3754 with no directory specified, since that is how `load' is normally called.
3755 An error in FORMS does not undo the load,
3756 but does prevent execution of the rest of the FORMS.
3757 FILENAME can also be a symbol (a feature) and FORMS are then executed
3758 when the corresponding call to `provide' is made. */);
3759 Vafter_load_alist
= Qnil
;
3761 DEFVAR_LISP ("load-history", &Vload_history
,
3762 doc
: /* Alist mapping source file names to symbols and features.
3763 Each alist element is a list that starts with a file name,
3764 except for one element (optional) that starts with nil and describes
3765 definitions evaluated from buffers not visiting files.
3766 The remaining elements of each list are symbols defined as functions
3767 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3768 and `(autoload . SYMBOL)'. */);
3769 Vload_history
= Qnil
;
3771 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3772 doc
: /* Full name of file being loaded by `load'. */);
3773 Vload_file_name
= Qnil
;
3775 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3776 doc
: /* File name, including directory, of user's initialization file.
3777 If the file loaded had extension `.elc' and there was a corresponding `.el'
3778 file, this variable contains the name of the .el file, suitable for use
3779 by functions like `custom-save-all' which edit the init file. */);
3780 Vuser_init_file
= Qnil
;
3782 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3783 doc
: /* Used for internal purposes by `load'. */);
3784 Vcurrent_load_list
= Qnil
;
3786 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3787 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3788 The default is nil, which means use the function `read'. */);
3789 Vload_read_function
= Qnil
;
3791 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3792 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3793 This function is for doing code conversion before reading the source file.
3794 If nil, loading is done without any code conversion.
3795 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3796 FULLNAME is the full name of FILE.
3797 See `load' for the meaning of the remaining arguments. */);
3798 Vload_source_file_function
= Qnil
;
3800 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3801 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3802 This is useful when the file being loaded is a temporary copy. */);
3803 load_force_doc_strings
= 0;
3805 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3806 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3807 This is normally bound by `load' and `eval-buffer' to control `read',
3808 and is not meant for users to change. */);
3809 load_convert_to_unibyte
= 0;
3811 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3812 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3813 You cannot count on them to still be there! */);
3815 = Fexpand_file_name (build_string ("../"),
3816 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3818 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3819 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3820 Vpreloaded_file_list
= Qnil
;
3822 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3823 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3824 Vbyte_boolean_vars
= Qnil
;
3826 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3827 doc
: /* Non-nil means load dangerous compiled Lisp files.
3828 Some versions of XEmacs use different byte codes than Emacs. These
3829 incompatible byte codes can make Emacs crash when it tries to execute
3831 load_dangerous_libraries
= 0;
3833 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3834 doc
: /* Regular expression matching safe to load compiled Lisp files.
3835 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3836 from the file, and matches them against this regular expression.
3837 When the regular expression matches, the file is considered to be safe
3838 to load. See also `load-dangerous-libraries'. */);
3839 Vbytecomp_version_regexp
3840 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3842 /* Vsource_directory was initialized in init_lread. */
3844 load_descriptor_list
= Qnil
;
3845 staticpro (&load_descriptor_list
);
3847 Qcurrent_load_list
= intern ("current-load-list");
3848 staticpro (&Qcurrent_load_list
);
3850 Qstandard_input
= intern ("standard-input");
3851 staticpro (&Qstandard_input
);
3853 Qread_char
= intern ("read-char");
3854 staticpro (&Qread_char
);
3856 Qget_file_char
= intern ("get-file-char");
3857 staticpro (&Qget_file_char
);
3859 Qbackquote
= intern ("`");
3860 staticpro (&Qbackquote
);
3861 Qcomma
= intern (",");
3862 staticpro (&Qcomma
);
3863 Qcomma_at
= intern (",@");
3864 staticpro (&Qcomma_at
);
3865 Qcomma_dot
= intern (",.");
3866 staticpro (&Qcomma_dot
);
3868 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3869 staticpro (&Qinhibit_file_name_operation
);
3871 Qascii_character
= intern ("ascii-character");
3872 staticpro (&Qascii_character
);
3874 Qfunction
= intern ("function");
3875 staticpro (&Qfunction
);
3877 Qload
= intern ("load");
3880 Qload_file_name
= intern ("load-file-name");
3881 staticpro (&Qload_file_name
);
3883 staticpro (&dump_path
);
3885 staticpro (&read_objects
);
3886 read_objects
= Qnil
;
3887 staticpro (&seen_list
);
3889 Vloads_in_progress
= Qnil
;
3890 staticpro (&Vloads_in_progress
);