1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
31 #include "intervals.h"
37 #include "termhooks.h"
41 #include <sys/inode.h>
46 #include <unistd.h> /* to get X_OK */
63 #endif /* HAVE_SETLOCALE */
73 #define file_offset off_t
74 #define file_tell ftello
76 #define file_offset long
77 #define file_tell ftell
84 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
85 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
86 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
87 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
88 Lisp_Object Qinhibit_file_name_operation
;
89 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
91 extern Lisp_Object Qevent_symbol_element_mask
;
92 extern Lisp_Object Qfile_exists_p
;
94 /* non-zero iff inside `load' */
97 /* Directory in which the sources were found. */
98 Lisp_Object Vsource_directory
;
100 /* Search path and suffixes for files to be loaded. */
101 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
103 /* File name of user's init file. */
104 Lisp_Object Vuser_init_file
;
106 /* This is the user-visible association list that maps features to
107 lists of defs in their load files. */
108 Lisp_Object Vload_history
;
110 /* This is used to build the load history. */
111 Lisp_Object Vcurrent_load_list
;
113 /* List of files that were preloaded. */
114 Lisp_Object Vpreloaded_file_list
;
116 /* Name of file actually being read by `load'. */
117 Lisp_Object Vload_file_name
;
119 /* Function to use for reading, in `load' and friends. */
120 Lisp_Object Vload_read_function
;
122 /* The association list of objects read with the #n=object form.
123 Each member of the list has the form (n . object), and is used to
124 look up the object for the corresponding #n# construct.
125 It must be set to nil before all top-level calls to read0. */
126 Lisp_Object read_objects
;
128 /* Nonzero means load should forcibly load all dynamic doc strings. */
129 static int load_force_doc_strings
;
131 /* Nonzero means read should convert strings to unibyte. */
132 static int load_convert_to_unibyte
;
134 /* Function to use for loading an Emacs lisp source file (not
135 compiled) instead of readevalloop. */
136 Lisp_Object Vload_source_file_function
;
138 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
139 Lisp_Object Vbyte_boolean_vars
;
141 /* Whether or not to add a `read-positions' property to symbols
143 Lisp_Object Vread_with_symbol_positions
;
145 /* List of (SYMBOL . POSITION) accumulated so far. */
146 Lisp_Object Vread_symbol_positions_list
;
148 /* List of descriptors now open for Fload. */
149 static Lisp_Object load_descriptor_list
;
151 /* File for get_file_char to read from. Use by load. */
152 static FILE *instream
;
154 /* When nonzero, read conses in pure space */
155 static int read_pure
;
157 /* For use within read-from-string (this reader is non-reentrant!!) */
158 static int read_from_string_index
;
159 static int read_from_string_index_byte
;
160 static int read_from_string_limit
;
162 /* Number of bytes left to read in the buffer character
163 that `readchar' has already advanced over. */
164 static int readchar_backlog
;
165 /* Number of characters read in the current call to Fread or
166 Fread_from_string. */
167 static int readchar_count
;
169 /* This contains the last string skipped with #@. */
170 static char *saved_doc_string
;
171 /* Length of buffer allocated in saved_doc_string. */
172 static int saved_doc_string_size
;
173 /* Length of actual data in saved_doc_string. */
174 static int saved_doc_string_length
;
175 /* This is the file position that string came from. */
176 static file_offset saved_doc_string_position
;
178 /* This contains the previous string skipped with #@.
179 We copy it from saved_doc_string when a new string
180 is put in saved_doc_string. */
181 static char *prev_saved_doc_string
;
182 /* Length of buffer allocated in prev_saved_doc_string. */
183 static int prev_saved_doc_string_size
;
184 /* Length of actual data in prev_saved_doc_string. */
185 static int prev_saved_doc_string_length
;
186 /* This is the file position that string came from. */
187 static file_offset prev_saved_doc_string_position
;
189 /* Nonzero means inside a new-style backquote
190 with no surrounding parentheses.
191 Fread initializes this to zero, so we need not specbind it
192 or worry about what happens to it when there is an error. */
193 static int new_backquote_flag
;
195 /* A list of file names for files being loaded in Fload. Used to
196 check for recursive loads. */
198 static Lisp_Object Vloads_in_progress
;
200 /* Non-zero means load dangerous compiled Lisp files. */
202 int load_dangerous_libraries
;
204 /* A regular expression used to detect files compiled with Emacs. */
206 static Lisp_Object Vbytecomp_version_regexp
;
208 static void to_multibyte
P_ ((char **, char **, int *));
209 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
210 Lisp_Object (*) (), int,
211 Lisp_Object
, Lisp_Object
,
212 Lisp_Object
, Lisp_Object
));
213 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
214 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
217 /* Handle unreading and rereading of characters.
218 Write READCHAR to read a character,
219 UNREAD(c) to unread c to be read again.
221 The READCHAR and UNREAD macros are meant for reading/unreading a
222 byte code; they do not handle multibyte characters. The caller
223 should manage them if necessary.
225 [ Actually that seems to be a lie; READCHAR will definitely read
226 multibyte characters from buffer sources, at least. Is the
227 comment just out of date?
228 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
231 #define READCHAR readchar (readcharfun)
232 #define UNREAD(c) unreadchar (readcharfun, c)
235 readchar (readcharfun
)
236 Lisp_Object readcharfun
;
243 if (BUFFERP (readcharfun
))
245 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
247 int pt_byte
= BUF_PT_BYTE (inbuffer
);
248 int orig_pt_byte
= pt_byte
;
250 if (readchar_backlog
> 0)
251 /* We get the address of the byte just passed,
252 which is the last byte of the character.
253 The other bytes in this character are consecutive with it,
254 because the gap can't be in the middle of a character. */
255 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
256 - --readchar_backlog
);
258 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
261 readchar_backlog
= -1;
263 if (! NILP (inbuffer
->enable_multibyte_characters
))
265 /* Fetch the character code from the buffer. */
266 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
267 BUF_INC_POS (inbuffer
, pt_byte
);
268 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
272 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
275 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
279 if (MARKERP (readcharfun
))
281 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
283 int bytepos
= marker_byte_position (readcharfun
);
284 int orig_bytepos
= bytepos
;
286 if (readchar_backlog
> 0)
287 /* We get the address of the byte just passed,
288 which is the last byte of the character.
289 The other bytes in this character are consecutive with it,
290 because the gap can't be in the middle of a character. */
291 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
292 - --readchar_backlog
);
294 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
297 readchar_backlog
= -1;
299 if (! NILP (inbuffer
->enable_multibyte_characters
))
301 /* Fetch the character code from the buffer. */
302 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
303 BUF_INC_POS (inbuffer
, bytepos
);
304 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
308 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
312 XMARKER (readcharfun
)->bytepos
= bytepos
;
313 XMARKER (readcharfun
)->charpos
++;
318 if (EQ (readcharfun
, Qlambda
))
319 return read_bytecode_char (0);
321 if (EQ (readcharfun
, Qget_file_char
))
325 /* Interrupted reads have been observed while reading over the network */
326 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
336 if (STRINGP (readcharfun
))
338 if (read_from_string_index
>= read_from_string_limit
)
341 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
342 read_from_string_index
,
343 read_from_string_index_byte
);
348 tem
= call0 (readcharfun
);
355 /* Unread the character C in the way appropriate for the stream READCHARFUN.
356 If the stream is a user function, call it with the char as argument. */
359 unreadchar (readcharfun
, c
)
360 Lisp_Object readcharfun
;
365 /* Don't back up the pointer if we're unreading the end-of-input mark,
366 since readchar didn't advance it when we read it. */
368 else if (BUFFERP (readcharfun
))
370 struct buffer
*b
= XBUFFER (readcharfun
);
371 int bytepos
= BUF_PT_BYTE (b
);
373 if (readchar_backlog
>= 0)
378 if (! NILP (b
->enable_multibyte_characters
))
379 BUF_DEC_POS (b
, bytepos
);
383 BUF_PT_BYTE (b
) = bytepos
;
386 else if (MARKERP (readcharfun
))
388 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
389 int bytepos
= XMARKER (readcharfun
)->bytepos
;
391 if (readchar_backlog
>= 0)
395 XMARKER (readcharfun
)->charpos
--;
396 if (! NILP (b
->enable_multibyte_characters
))
397 BUF_DEC_POS (b
, bytepos
);
401 XMARKER (readcharfun
)->bytepos
= bytepos
;
404 else if (STRINGP (readcharfun
))
406 read_from_string_index
--;
407 read_from_string_index_byte
408 = string_char_to_byte (readcharfun
, read_from_string_index
);
410 else if (EQ (readcharfun
, Qlambda
))
411 read_bytecode_char (1);
412 else if (EQ (readcharfun
, Qget_file_char
))
413 ungetc (c
, instream
);
415 call1 (readcharfun
, make_number (c
));
418 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
420 static Lisp_Object read0
P_ ((Lisp_Object
));
421 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
423 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
424 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
425 static int read_multibyte
P_ ((int, Lisp_Object
));
427 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
429 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
431 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
434 /* Get a character from the tty. */
436 extern Lisp_Object
read_char ();
438 /* Read input events until we get one that's acceptable for our purposes.
440 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
441 until we get a character we like, and then stuffed into
444 If ASCII_REQUIRED is non-zero, we check function key events to see
445 if the unmodified version of the symbol has a Qascii_character
446 property, and use that character, if present.
448 If ERROR_NONASCII is non-zero, we signal an error if the input we
449 get isn't an ASCII character with modifiers. If it's zero but
450 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
453 If INPUT_METHOD is nonzero, we invoke the current input method
454 if the character warrants that. */
457 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
459 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
461 register Lisp_Object val
, delayed_switch_frame
;
463 #ifdef HAVE_WINDOW_SYSTEM
464 if (display_hourglass_p
)
468 delayed_switch_frame
= Qnil
;
470 /* Read until we get an acceptable event. */
472 val
= read_char (0, 0, 0,
473 (input_method
? Qnil
: Qt
),
479 /* switch-frame events are put off until after the next ASCII
480 character. This is better than signaling an error just because
481 the last characters were typed to a separate minibuffer frame,
482 for example. Eventually, some code which can deal with
483 switch-frame events will read it and process it. */
485 && EVENT_HAS_PARAMETERS (val
)
486 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
488 delayed_switch_frame
= val
;
494 /* Convert certain symbols to their ASCII equivalents. */
497 Lisp_Object tem
, tem1
;
498 tem
= Fget (val
, Qevent_symbol_element_mask
);
501 tem1
= Fget (Fcar (tem
), Qascii_character
);
502 /* Merge this symbol's modifier bits
503 with the ASCII equivalent of its basic code. */
505 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
509 /* If we don't have a character now, deal with it appropriately. */
514 Vunread_command_events
= Fcons (val
, Qnil
);
515 error ("Non-character input-event");
522 if (! NILP (delayed_switch_frame
))
523 unread_switch_frame
= delayed_switch_frame
;
527 #ifdef HAVE_WINDOW_SYSTEM
528 if (display_hourglass_p
)
537 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
538 doc
: /* Read a character from the command input (keyboard or macro).
539 It is returned as a number.
540 If the user generates an event which is not a character (i.e. a mouse
541 click or function key event), `read-char' signals an error. As an
542 exception, switch-frame events are put off until non-ASCII events can
544 If you want to read non-character events, or ignore them, call
545 `read-event' or `read-char-exclusive' instead.
547 If the optional argument PROMPT is non-nil, display that as a prompt.
548 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
549 input method is turned on in the current buffer, that input method
550 is used for reading a character. */)
551 (prompt
, inherit_input_method
)
552 Lisp_Object prompt
, inherit_input_method
;
555 message_with_string ("%s", prompt
, 0);
556 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
559 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
560 doc
: /* Read an event object from the input stream.
561 If the optional argument PROMPT is non-nil, display that as a prompt.
562 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
563 input method is turned on in the current buffer, that input method
564 is used for reading a character. */)
565 (prompt
, inherit_input_method
)
566 Lisp_Object prompt
, inherit_input_method
;
569 message_with_string ("%s", prompt
, 0);
570 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
573 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
574 doc
: /* Read a character from the command input (keyboard or macro).
575 It is returned as a number. Non-character events are ignored.
577 If the optional argument PROMPT is non-nil, display that as a prompt.
578 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
579 input method is turned on in the current buffer, that input method
580 is used for reading a character. */)
581 (prompt
, inherit_input_method
)
582 Lisp_Object prompt
, inherit_input_method
;
585 message_with_string ("%s", prompt
, 0);
586 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
589 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
590 doc
: /* Don't use this yourself. */)
593 register Lisp_Object val
;
594 XSETINT (val
, getc (instream
));
600 /* Value is non-zero if the file asswociated with file descriptor FD
601 is a compiled Lisp file that's safe to load. Only files compiled
602 with Emacs are safe to load. Files compiled with XEmacs can lead
603 to a crash in Fbyte_code because of an incompatible change in the
614 /* Read the first few bytes from the file, and look for a line
615 specifying the byte compiler version used. */
616 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
621 /* Skip to the next newline, skipping over the initial `ELC'
622 with NUL bytes following it. */
623 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
627 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
632 lseek (fd
, 0, SEEK_SET
);
637 /* Callback for record_unwind_protect. Restore the old load list OLD,
638 after loading a file successfully. */
641 record_load_unwind (old
)
644 return Vloads_in_progress
= old
;
647 /* This handler function is used via internal_condition_case_1. */
650 load_error_handler (data
)
656 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
657 doc
: /* Return the suffixes that `load' should try if a suffix is \
659 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
662 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
663 while (CONSP (suffixes
))
665 Lisp_Object exts
= Vload_file_rep_suffixes
;
666 suffix
= XCAR (suffixes
);
667 suffixes
= XCDR (suffixes
);
672 lst
= Fcons (concat2 (suffix
, ext
), lst
);
675 return Fnreverse (lst
);
678 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
679 doc
: /* Execute a file of Lisp code named FILE.
680 First try FILE with `.elc' appended, then try with `.el',
681 then try FILE unmodified (the exact suffixes in the exact order are
682 determined by `load-suffixes'). Environment variable references in
683 FILE are replaced with their values by calling `substitute-in-file-name'.
684 This function searches the directories in `load-path'.
686 If optional second arg NOERROR is non-nil,
687 report no error if FILE doesn't exist.
688 Print messages at start and end of loading unless
689 optional third arg NOMESSAGE is non-nil.
690 If optional fourth arg NOSUFFIX is non-nil, don't try adding
691 suffixes `.elc' or `.el' to the specified name FILE.
692 If optional fifth arg MUST-SUFFIX is non-nil, insist on
693 the suffix `.elc' or `.el'; don't accept just FILE unless
694 it ends in one of those suffixes or includes a directory name.
696 If this function fails to find a file, it may look for different
697 representations of that file before trying another file.
698 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
699 to the file name. Emacs uses this feature mainly to find compressed
700 versions of files when Auto Compression mode is enabled.
702 The exact suffixes that this function tries out, in the exact order,
703 are given by the value of the variable `load-file-rep-suffixes' if
704 NOSUFFIX is non-nil and by the return value of the function
705 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
706 MUST-SUFFIX are nil, this function first tries out the latter suffixes
709 Loading a file records its definitions, and its `provide' and
710 `require' calls, in an element of `load-history' whose
711 car is the file name loaded. See `load-history'.
713 Return t if the file exists and loads successfully. */)
714 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
715 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
717 register FILE *stream
;
718 register int fd
= -1;
719 int count
= SPECPDL_INDEX ();
721 struct gcpro gcpro1
, gcpro2
;
722 Lisp_Object found
, efound
;
723 /* 1 means we printed the ".el is newer" message. */
725 /* 1 means we are loading a compiled file. */
736 /* If file name is magic, call the handler. */
737 /* This shouldn't be necessary any more now that `openp' handles it right.
738 handler = Ffind_file_name_handler (file, Qload);
740 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
742 /* Do this after the handler to avoid
743 the need to gcpro noerror, nomessage and nosuffix.
744 (Below here, we care only whether they are nil or not.)
745 The presence of this call is the result of a historical accident:
746 it used to be in every file-operations and when it got removed
747 everywhere, it accidentally stayed here. Since then, enough people
748 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
749 that it seemed risky to remove. */
750 if (! NILP (noerror
))
752 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
753 Qt
, load_error_handler
);
758 file
= Fsubstitute_in_file_name (file
);
761 /* Avoid weird lossage with null string as arg,
762 since it would try to load a directory as a Lisp file */
763 if (SCHARS (file
) > 0)
765 int size
= SBYTES (file
);
769 GCPRO2 (file
, found
);
771 if (! NILP (must_suffix
))
773 /* Don't insist on adding a suffix if FILE already ends with one. */
775 && !strcmp (SDATA (file
) + size
- 3, ".el"))
778 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
780 /* Don't insist on adding a suffix
781 if the argument includes a directory name. */
782 else if (! NILP (Ffile_name_directory (file
)))
786 fd
= openp (Vload_path
, file
,
787 (!NILP (nosuffix
) ? Qnil
788 : !NILP (must_suffix
) ? Fget_load_suffixes ()
789 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
790 tmp
[1] = Vload_file_rep_suffixes
,
799 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
800 Fcons (file
, Qnil
)));
805 /* Tell startup.el whether or not we found the user's init file. */
806 if (EQ (Qt
, Vuser_init_file
))
807 Vuser_init_file
= found
;
809 /* If FD is -2, that means openp found a magic file. */
812 if (NILP (Fequal (found
, file
)))
813 /* If FOUND is a different file name from FILE,
814 find its handler even if we have already inhibited
815 the `load' operation on FILE. */
816 handler
= Ffind_file_name_handler (found
, Qt
);
818 handler
= Ffind_file_name_handler (found
, Qload
);
819 if (! NILP (handler
))
820 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
823 /* Check if we're stuck in a recursive load cycle.
825 2000-09-21: It's not possible to just check for the file loaded
826 being a member of Vloads_in_progress. This fails because of the
827 way the byte compiler currently works; `provide's are not
828 evaluted, see font-lock.el/jit-lock.el as an example. This
829 leads to a certain amount of ``normal'' recursion.
831 Also, just loading a file recursively is not always an error in
832 the general case; the second load may do something different. */
836 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
837 if (!NILP (Fequal (found
, XCAR (tem
))))
843 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
844 Fcons (found
, Vloads_in_progress
)));
846 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
847 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
850 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
852 /* Load .elc files directly, but not when they are
853 remote and have no handler! */
860 GCPRO2 (file
, found
);
862 if (!safe_to_load_p (fd
))
865 if (!load_dangerous_libraries
)
869 error ("File `%s' was not compiled in Emacs",
872 else if (!NILP (nomessage
))
873 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
878 efound
= ENCODE_FILE (found
);
883 stat ((char *)SDATA (efound
), &s1
);
884 SSET (efound
, SBYTES (efound
) - 1, 0);
885 result
= stat ((char *)SDATA (efound
), &s2
);
886 SSET (efound
, SBYTES (efound
) - 1, 'c');
888 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
890 /* Make the progress messages mention that source is newer. */
893 /* If we won't print another message, mention this anyway. */
894 if (!NILP (nomessage
))
896 Lisp_Object msg_file
;
897 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
898 message_with_string ("Source file `%s' newer than byte-compiled file",
907 /* We are loading a source file (*.el). */
908 if (!NILP (Vload_source_file_function
))
914 val
= call4 (Vload_source_file_function
, found
, file
,
915 NILP (noerror
) ? Qnil
: Qt
,
916 NILP (nomessage
) ? Qnil
: Qt
);
917 return unbind_to (count
, val
);
921 GCPRO2 (file
, found
);
925 efound
= ENCODE_FILE (found
);
926 stream
= fopen ((char *) SDATA (efound
), fmode
);
927 #else /* not WINDOWSNT */
928 stream
= fdopen (fd
, fmode
);
929 #endif /* not WINDOWSNT */
933 error ("Failure to create stdio stream for %s", SDATA (file
));
936 if (! NILP (Vpurify_flag
))
937 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
939 if (NILP (nomessage
))
942 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
945 message_with_string ("Loading %s (source)...", file
, 1);
947 message_with_string ("Loading %s (compiled; note, source file is newer)...",
949 else /* The typical case; compiled file newer than source file. */
950 message_with_string ("Loading %s...", file
, 1);
953 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
954 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
955 specbind (Qload_file_name
, found
);
956 specbind (Qinhibit_file_name_operation
, Qnil
);
958 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
960 readevalloop (Qget_file_char
, stream
, (! NILP (Vpurify_flag
) ? file
: found
),
961 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
962 unbind_to (count
, Qnil
);
964 /* Run any load-hooks for this file. */
965 temp
= Fassoc (file
, Vafter_load_alist
);
967 Fprogn (Fcdr (temp
));
970 if (saved_doc_string
)
971 free (saved_doc_string
);
972 saved_doc_string
= 0;
973 saved_doc_string_size
= 0;
975 if (prev_saved_doc_string
)
976 xfree (prev_saved_doc_string
);
977 prev_saved_doc_string
= 0;
978 prev_saved_doc_string_size
= 0;
980 if (!noninteractive
&& NILP (nomessage
))
983 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
986 message_with_string ("Loading %s (source)...done", file
, 1);
988 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
990 else /* The typical case; compiled file newer than source file. */
991 message_with_string ("Loading %s...done", file
, 1);
994 if (!NILP (Fequal (build_string ("obsolete"),
995 Ffile_name_nondirectory
996 (Fdirectory_file_name (Ffile_name_directory (found
))))))
997 message_with_string ("Package %s is obsolete", file
, 1);
1003 load_unwind (arg
) /* used as unwind-protect function in load */
1006 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1009 if (--load_in_progress
< 0) load_in_progress
= 0;
1014 load_descriptor_unwind (oldlist
)
1015 Lisp_Object oldlist
;
1017 load_descriptor_list
= oldlist
;
1021 /* Close all descriptors in use for Floads.
1022 This is used when starting a subprocess. */
1029 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1030 emacs_close (XFASTINT (XCAR (tail
)));
1035 complete_filename_p (pathname
)
1036 Lisp_Object pathname
;
1038 register const unsigned char *s
= SDATA (pathname
);
1039 return (IS_DIRECTORY_SEP (s
[0])
1040 || (SCHARS (pathname
) > 2
1041 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1051 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1052 doc
: /* Search for FILENAME through PATH.
1053 Returns the file's name in absolute form, or nil if not found.
1054 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1055 file name when searching.
1056 If non-nil, PREDICATE is used instead of `file-readable-p'.
1057 PREDICATE can also be an integer to pass to the access(2) function,
1058 in which case file-name-handlers are ignored. */)
1059 (filename
, path
, suffixes
, predicate
)
1060 Lisp_Object filename
, path
, suffixes
, predicate
;
1063 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1064 if (NILP (predicate
) && fd
> 0)
1070 /* Search for a file whose name is STR, looking in directories
1071 in the Lisp list PATH, and trying suffixes from SUFFIX.
1072 On success, returns a file descriptor. On failure, returns -1.
1074 SUFFIXES is a list of strings containing possible suffixes.
1075 The empty suffix is automatically added iff the list is empty.
1077 PREDICATE non-nil means don't open the files,
1078 just look for one that satisfies the predicate. In this case,
1079 returns 1 on success. The predicate can be a lisp function or
1080 an integer to pass to `access' (in which case file-name-handlers
1083 If STOREPTR is nonzero, it points to a slot where the name of
1084 the file actually found should be stored as a Lisp string.
1085 nil is stored there on failure.
1087 If the file we find is remote, return -2
1088 but store the found remote file name in *STOREPTR. */
1091 openp (path
, str
, suffixes
, storeptr
, predicate
)
1092 Lisp_Object path
, str
;
1093 Lisp_Object suffixes
;
1094 Lisp_Object
*storeptr
;
1095 Lisp_Object predicate
;
1100 register char *fn
= buf
;
1103 Lisp_Object filename
;
1105 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1106 Lisp_Object string
, tail
, encoded_fn
;
1107 int max_suffix_len
= 0;
1111 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1113 CHECK_STRING_CAR (tail
);
1114 max_suffix_len
= max (max_suffix_len
,
1115 SBYTES (XCAR (tail
)));
1118 string
= filename
= encoded_fn
= Qnil
;
1119 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1124 if (complete_filename_p (str
))
1127 for (; CONSP (path
); path
= XCDR (path
))
1129 filename
= Fexpand_file_name (str
, XCAR (path
));
1130 if (!complete_filename_p (filename
))
1131 /* If there are non-absolute elts in PATH (eg ".") */
1132 /* Of course, this could conceivably lose if luser sets
1133 default-directory to be something non-absolute... */
1135 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1136 if (!complete_filename_p (filename
))
1137 /* Give up on this path element! */
1141 /* Calculate maximum size of any filename made from
1142 this path element/specified file name and any possible suffix. */
1143 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1144 if (fn_size
< want_size
)
1145 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1147 /* Loop over suffixes. */
1148 for (tail
= NILP (suffixes
) ? Fcons (build_string (""), Qnil
) : suffixes
;
1149 CONSP (tail
); tail
= XCDR (tail
))
1151 int lsuffix
= SBYTES (XCAR (tail
));
1152 Lisp_Object handler
;
1155 /* Concatenate path element/specified name with the suffix.
1156 If the directory starts with /:, remove that. */
1157 if (SCHARS (filename
) > 2
1158 && SREF (filename
, 0) == '/'
1159 && SREF (filename
, 1) == ':')
1161 strncpy (fn
, SDATA (filename
) + 2,
1162 SBYTES (filename
) - 2);
1163 fn
[SBYTES (filename
) - 2] = 0;
1167 strncpy (fn
, SDATA (filename
),
1169 fn
[SBYTES (filename
)] = 0;
1172 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1173 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1175 /* Check that the file exists and is not a directory. */
1176 /* We used to only check for handlers on non-absolute file names:
1180 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1181 It's not clear why that was the case and it breaks things like
1182 (load "/bar.el") where the file is actually "/bar.el.gz". */
1183 string
= build_string (fn
);
1184 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1185 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1187 if (NILP (predicate
))
1188 exists
= !NILP (Ffile_readable_p (string
));
1190 exists
= !NILP (call1 (predicate
, string
));
1191 if (exists
&& !NILP (Ffile_directory_p (string
)))
1196 /* We succeeded; return this descriptor and filename. */
1207 encoded_fn
= ENCODE_FILE (string
);
1208 pfn
= SDATA (encoded_fn
);
1209 exists
= (stat (pfn
, &st
) >= 0
1210 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1213 /* Check that we can access or open it. */
1214 if (NATNUMP (predicate
))
1215 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1217 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1221 /* We succeeded; return this descriptor and filename. */
1239 /* Merge the list we've accumulated of globals from the current input source
1240 into the load_history variable. The details depend on whether
1241 the source has an associated file name or not.
1243 FILENAME is the file name that we are loading from.
1244 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1247 build_load_history (filename
, entire
)
1248 Lisp_Object filename
;
1251 register Lisp_Object tail
, prev
, newelt
;
1252 register Lisp_Object tem
, tem2
;
1253 register int foundit
= 0;
1255 tail
= Vload_history
;
1258 while (CONSP (tail
))
1262 /* Find the feature's previous assoc list... */
1263 if (!NILP (Fequal (filename
, Fcar (tem
))))
1267 /* If we're loading the entire file, remove old data. */
1271 Vload_history
= XCDR (tail
);
1273 Fsetcdr (prev
, XCDR (tail
));
1276 /* Otherwise, cons on new symbols that are not already members. */
1279 tem2
= Vcurrent_load_list
;
1281 while (CONSP (tem2
))
1283 newelt
= XCAR (tem2
);
1285 if (NILP (Fmember (newelt
, tem
)))
1286 Fsetcar (tail
, Fcons (XCAR (tem
),
1287 Fcons (newelt
, XCDR (tem
))));
1300 /* If we're loading an entire file, cons the new assoc onto the
1301 front of load-history, the most-recently-loaded position. Also
1302 do this if we didn't find an existing member for the file. */
1303 if (entire
|| !foundit
)
1304 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1309 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1317 readevalloop_1 (old
)
1320 load_convert_to_unibyte
= ! NILP (old
);
1324 /* Signal an `end-of-file' error, if possible with file name
1328 end_of_file_error ()
1332 if (STRINGP (Vload_file_name
))
1333 data
= Fcons (Vload_file_name
, Qnil
);
1337 Fsignal (Qend_of_file
, data
);
1340 /* UNIBYTE specifies how to set load_convert_to_unibyte
1341 for this invocation.
1342 READFUN, if non-nil, is used instead of `read'.
1343 START, END is region in current buffer (from eval-region). */
1346 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1347 printflag
, unibyte
, readfun
, start
, end
)
1348 Lisp_Object readcharfun
;
1350 Lisp_Object sourcename
;
1351 Lisp_Object (*evalfun
) ();
1353 Lisp_Object unibyte
, readfun
;
1354 Lisp_Object start
, end
;
1357 register Lisp_Object val
;
1358 int count
= SPECPDL_INDEX ();
1359 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1360 struct buffer
*b
= 0;
1362 int continue_reading_p
;
1363 /* Nonzero if reading an entire buffer. */
1364 int whole_buffer
= 0;
1365 /* 1 on the first time around. */
1368 if (MARKERP (readcharfun
))
1371 start
= readcharfun
;
1374 if (BUFFERP (readcharfun
))
1375 b
= XBUFFER (readcharfun
);
1376 else if (MARKERP (readcharfun
))
1377 b
= XMARKER (readcharfun
)->buffer
;
1379 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1380 specbind (Qcurrent_load_list
, Qnil
);
1381 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1382 load_convert_to_unibyte
= !NILP (unibyte
);
1384 readchar_backlog
= -1;
1386 GCPRO4 (sourcename
, readfun
, start
, end
);
1388 LOADHIST_ATTACH (sourcename
);
1390 continue_reading_p
= 1;
1391 while (continue_reading_p
)
1393 int count1
= SPECPDL_INDEX ();
1395 if (b
!= 0 && NILP (b
->name
))
1396 error ("Reading from killed buffer");
1400 /* Switch to the buffer we are reading from. */
1401 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1402 set_buffer_internal (b
);
1404 /* Save point in it. */
1405 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1406 /* Save ZV in it. */
1407 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1408 /* Those get unbound after we read one expression. */
1410 /* Set point and ZV around stuff to be read. */
1413 Fnarrow_to_region (make_number (BEGV
), end
);
1415 /* Just for cleanliness, convert END to a marker
1416 if it is an integer. */
1418 end
= Fpoint_max_marker ();
1421 /* On the first cycle, we can easily test here
1422 whether we are reading the whole buffer. */
1423 if (b
&& first_sexp
)
1424 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1431 while ((c
= READCHAR
) != '\n' && c
!= -1);
1436 unbind_to (count1
, Qnil
);
1440 /* Ignore whitespace here, so we can detect eof. */
1441 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1444 if (!NILP (Vpurify_flag
) && c
== '(')
1446 record_unwind_protect (unreadpure
, Qnil
);
1447 val
= read_list (-1, readcharfun
);
1452 read_objects
= Qnil
;
1453 if (!NILP (readfun
))
1455 val
= call1 (readfun
, readcharfun
);
1457 /* If READCHARFUN has set point to ZV, we should
1458 stop reading, even if the form read sets point
1459 to a different value when evaluated. */
1460 if (BUFFERP (readcharfun
))
1462 struct buffer
*b
= XBUFFER (readcharfun
);
1463 if (BUF_PT (b
) == BUF_ZV (b
))
1464 continue_reading_p
= 0;
1467 else if (! NILP (Vload_read_function
))
1468 val
= call1 (Vload_read_function
, readcharfun
);
1470 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1473 if (!NILP (start
) && continue_reading_p
)
1474 start
= Fpoint_marker ();
1476 /* Restore saved point and BEGV. */
1477 unbind_to (count1
, Qnil
);
1479 /* Now eval what we just read. */
1480 val
= (*evalfun
) (val
);
1484 Vvalues
= Fcons (val
, Vvalues
);
1485 if (EQ (Vstandard_output
, Qt
))
1494 build_load_history (sourcename
,
1495 stream
|| whole_buffer
);
1499 unbind_to (count
, Qnil
);
1502 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1503 doc
: /* Execute the current buffer as Lisp code.
1504 Programs can pass two arguments, BUFFER and PRINTFLAG.
1505 BUFFER is the buffer to evaluate (nil means use current buffer).
1506 PRINTFLAG controls printing of output:
1507 nil means discard it; anything else is stream for print.
1509 If the optional third argument FILENAME is non-nil,
1510 it specifies the file name to use for `load-history'.
1511 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1512 for this invocation.
1514 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1515 `print' and related functions should work normally even if PRINTFLAG is nil.
1517 This function preserves the position of point. */)
1518 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1519 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1521 int count
= SPECPDL_INDEX ();
1522 Lisp_Object tem
, buf
;
1525 buf
= Fcurrent_buffer ();
1527 buf
= Fget_buffer (buffer
);
1529 error ("No such buffer");
1531 if (NILP (printflag
) && NILP (do_allow_print
))
1536 if (NILP (filename
))
1537 filename
= XBUFFER (buf
)->filename
;
1539 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1540 specbind (Qstandard_output
, tem
);
1541 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1542 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1543 readevalloop (buf
, 0, filename
, Feval
,
1544 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1545 unbind_to (count
, Qnil
);
1550 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1551 doc
: /* Execute the region as Lisp code.
1552 When called from programs, expects two arguments,
1553 giving starting and ending indices in the current buffer
1554 of the text to be executed.
1555 Programs can pass third argument PRINTFLAG which controls output:
1556 nil means discard it; anything else is stream for printing it.
1557 Also the fourth argument READ-FUNCTION, if non-nil, is used
1558 instead of `read' to read each expression. It gets one argument
1559 which is the input stream for reading characters.
1561 This function does not move point. */)
1562 (start
, end
, printflag
, read_function
)
1563 Lisp_Object start
, end
, printflag
, read_function
;
1565 int count
= SPECPDL_INDEX ();
1566 Lisp_Object tem
, cbuf
;
1568 cbuf
= Fcurrent_buffer ();
1570 if (NILP (printflag
))
1574 specbind (Qstandard_output
, tem
);
1575 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1577 /* readevalloop calls functions which check the type of start and end. */
1578 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1579 !NILP (printflag
), Qnil
, read_function
,
1582 return unbind_to (count
, Qnil
);
1586 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1587 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1588 If STREAM is nil, use the value of `standard-input' (which see).
1589 STREAM or the value of `standard-input' may be:
1590 a buffer (read from point and advance it)
1591 a marker (read from where it points and advance it)
1592 a function (call it with no arguments for each character,
1593 call it with a char as argument to push a char back)
1594 a string (takes text from string, starting at the beginning)
1595 t (read text line using minibuffer and use it, or read from
1596 standard input in batch mode). */)
1601 stream
= Vstandard_input
;
1602 if (EQ (stream
, Qt
))
1603 stream
= Qread_char
;
1604 if (EQ (stream
, Qread_char
))
1605 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1607 return read_internal_start (stream
, Qnil
, Qnil
);
1610 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1611 doc
: /* Read one Lisp expression which is represented as text by STRING.
1612 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1613 START and END optionally delimit a substring of STRING from which to read;
1614 they default to 0 and (length STRING) respectively. */)
1615 (string
, start
, end
)
1616 Lisp_Object string
, start
, end
;
1619 CHECK_STRING (string
);
1620 /* read_internal_start sets read_from_string_index. */
1621 ret
= read_internal_start (string
, start
, end
);
1622 return Fcons (ret
, make_number (read_from_string_index
));
1625 /* Function to set up the global context we need in toplevel read
1628 read_internal_start (stream
, start
, end
)
1630 Lisp_Object start
; /* Only used when stream is a string. */
1631 Lisp_Object end
; /* Only used when stream is a string. */
1635 readchar_backlog
= -1;
1637 new_backquote_flag
= 0;
1638 read_objects
= Qnil
;
1639 if (EQ (Vread_with_symbol_positions
, Qt
)
1640 || EQ (Vread_with_symbol_positions
, stream
))
1641 Vread_symbol_positions_list
= Qnil
;
1643 if (STRINGP (stream
))
1645 int startval
, endval
;
1647 endval
= SCHARS (stream
);
1651 endval
= XINT (end
);
1652 if (endval
< 0 || endval
> SCHARS (stream
))
1653 args_out_of_range (stream
, end
);
1660 CHECK_NUMBER (start
);
1661 startval
= XINT (start
);
1662 if (startval
< 0 || startval
> endval
)
1663 args_out_of_range (stream
, start
);
1665 read_from_string_index
= startval
;
1666 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1667 read_from_string_limit
= endval
;
1670 retval
= read0 (stream
);
1671 if (EQ (Vread_with_symbol_positions
, Qt
)
1672 || EQ (Vread_with_symbol_positions
, stream
))
1673 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1677 /* Use this for recursive reads, in contexts where internal tokens
1682 Lisp_Object readcharfun
;
1684 register Lisp_Object val
;
1687 val
= read1 (readcharfun
, &c
, 0);
1689 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1696 static int read_buffer_size
;
1697 static char *read_buffer
;
1699 /* Read multibyte form and return it as a character. C is a first
1700 byte of multibyte form, and rest of them are read from
1704 read_multibyte (c
, readcharfun
)
1706 Lisp_Object readcharfun
;
1708 /* We need the actual character code of this multibyte
1710 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1718 while ((c
= READCHAR
) >= 0xA0
1719 && len
< MAX_MULTIBYTE_LENGTH
)
1725 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1726 return STRING_CHAR (str
, len
);
1727 /* The byte sequence is not valid as multibyte. Unread all bytes
1728 but the first one, and return the first byte. */
1734 /* Read a \-escape sequence, assuming we already read the `\'.
1735 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1736 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1737 Otherwise store 0 into *BYTEREP. */
1740 read_escape (readcharfun
, stringp
, byterep
)
1741 Lisp_Object readcharfun
;
1745 register int c
= READCHAR
;
1752 end_of_file_error ();
1782 error ("Invalid escape character syntax");
1785 c
= read_escape (readcharfun
, 0, byterep
);
1786 return c
| meta_modifier
;
1791 error ("Invalid escape character syntax");
1794 c
= read_escape (readcharfun
, 0, byterep
);
1795 return c
| shift_modifier
;
1800 error ("Invalid escape character syntax");
1803 c
= read_escape (readcharfun
, 0, byterep
);
1804 return c
| hyper_modifier
;
1809 error ("Invalid escape character syntax");
1812 c
= read_escape (readcharfun
, 0, byterep
);
1813 return c
| alt_modifier
;
1824 c
= read_escape (readcharfun
, 0, byterep
);
1825 return c
| super_modifier
;
1830 error ("Invalid escape character syntax");
1834 c
= read_escape (readcharfun
, 0, byterep
);
1835 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1836 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1837 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1838 return c
| ctrl_modifier
;
1839 /* ASCII control chars are made from letters (both cases),
1840 as well as the non-letters within 0100...0137. */
1841 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1842 return (c
& (037 | ~0177));
1843 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1844 return (c
& (037 | ~0177));
1846 return c
| ctrl_modifier
;
1856 /* An octal escape, as in ANSI C. */
1858 register int i
= c
- '0';
1859 register int count
= 0;
1862 if ((c
= READCHAR
) >= '0' && c
<= '7')
1879 /* A hex escape, as in ANSI C. */
1885 if (c
>= '0' && c
<= '9')
1890 else if ((c
>= 'a' && c
<= 'f')
1891 || (c
>= 'A' && c
<= 'F'))
1894 if (c
>= 'a' && c
<= 'f')
1911 if (BASE_LEADING_CODE_P (c
))
1912 c
= read_multibyte (c
, readcharfun
);
1918 /* Read an integer in radix RADIX using READCHARFUN to read
1919 characters. RADIX must be in the interval [2..36]; if it isn't, a
1920 read error is signaled . Value is the integer read. Signals an
1921 error if encountering invalid read syntax or if RADIX is out of
1925 read_integer (readcharfun
, radix
)
1926 Lisp_Object readcharfun
;
1929 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1930 EMACS_INT number
= 0;
1932 if (radix
< 2 || radix
> 36)
1936 number
= ndigits
= invalid_p
= 0;
1952 if (c
>= '0' && c
<= '9')
1954 else if (c
>= 'a' && c
<= 'z')
1955 digit
= c
- 'a' + 10;
1956 else if (c
>= 'A' && c
<= 'Z')
1957 digit
= c
- 'A' + 10;
1964 if (digit
< 0 || digit
>= radix
)
1967 number
= radix
* number
+ digit
;
1973 if (ndigits
== 0 || invalid_p
)
1976 sprintf (buf
, "integer, radix %d", radix
);
1977 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1980 return make_number (sign
* number
);
1984 /* Convert unibyte text in read_buffer to multibyte.
1986 Initially, *P is a pointer after the end of the unibyte text, and
1987 the pointer *END points after the end of read_buffer.
1989 If read_buffer doesn't have enough room to hold the result
1990 of the conversion, reallocate it and adjust *P and *END.
1992 At the end, make *P point after the result of the conversion, and
1993 return in *NCHARS the number of characters in the converted
1997 to_multibyte (p
, end
, nchars
)
2003 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
2004 if (read_buffer_size
< 2 * nbytes
)
2006 int offset
= *p
- read_buffer
;
2007 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
2008 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
2009 *p
= read_buffer
+ offset
;
2010 *end
= read_buffer
+ read_buffer_size
;
2013 if (nbytes
!= *nchars
)
2014 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
2015 *p
- read_buffer
, nchars
);
2017 *p
= read_buffer
+ nbytes
;
2021 /* If the next token is ')' or ']' or '.', we store that character
2022 in *PCH and the return value is not interesting. Else, we store
2023 zero in *PCH and we read and return one lisp object.
2025 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2028 read1 (readcharfun
, pch
, first_in_list
)
2029 register Lisp_Object readcharfun
;
2034 int uninterned_symbol
= 0;
2042 end_of_file_error ();
2047 return read_list (0, readcharfun
);
2050 return read_vector (readcharfun
, 0);
2067 tmp
= read_vector (readcharfun
, 0);
2068 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
2069 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
2070 error ("Invalid size char-table");
2071 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2072 XCHAR_TABLE (tmp
)->top
= Qt
;
2081 tmp
= read_vector (readcharfun
, 0);
2082 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2083 error ("Invalid size char-table");
2084 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2085 XCHAR_TABLE (tmp
)->top
= Qnil
;
2088 Fsignal (Qinvalid_read_syntax
,
2089 Fcons (make_string ("#^^", 3), Qnil
));
2091 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2096 length
= read1 (readcharfun
, pch
, first_in_list
);
2100 Lisp_Object tmp
, val
;
2102 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2103 / BOOL_VECTOR_BITS_PER_CHAR
);
2106 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2107 if (size_in_chars
!= SCHARS (tmp
)
2108 /* We used to print 1 char too many
2109 when the number of bits was a multiple of 8.
2110 Accept such input in case it came from an old version. */
2111 && ! (XFASTINT (length
)
2112 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2113 Fsignal (Qinvalid_read_syntax
,
2114 Fcons (make_string ("#&...", 5), Qnil
));
2116 val
= Fmake_bool_vector (length
, Qnil
);
2117 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2119 /* Clear the extraneous bits in the last byte. */
2120 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2121 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2122 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2125 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2130 /* Accept compiled functions at read-time so that we don't have to
2131 build them using function calls. */
2133 tmp
= read_vector (readcharfun
, 1);
2134 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2135 XVECTOR (tmp
)->contents
);
2140 struct gcpro gcpro1
;
2143 /* Read the string itself. */
2144 tmp
= read1 (readcharfun
, &ch
, 0);
2145 if (ch
!= 0 || !STRINGP (tmp
))
2146 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2148 /* Read the intervals and their properties. */
2151 Lisp_Object beg
, end
, plist
;
2153 beg
= read1 (readcharfun
, &ch
, 0);
2158 end
= read1 (readcharfun
, &ch
, 0);
2160 plist
= read1 (readcharfun
, &ch
, 0);
2162 Fsignal (Qinvalid_read_syntax
,
2163 Fcons (build_string ("invalid string property list"),
2165 Fset_text_properties (beg
, end
, plist
, tmp
);
2171 /* #@NUMBER is used to skip NUMBER following characters.
2172 That's used in .elc files to skip over doc strings
2173 and function definitions. */
2178 /* Read a decimal integer. */
2179 while ((c
= READCHAR
) >= 0
2180 && c
>= '0' && c
<= '9')
2188 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2190 /* If we are supposed to force doc strings into core right now,
2191 record the last string that we skipped,
2192 and record where in the file it comes from. */
2194 /* But first exchange saved_doc_string
2195 with prev_saved_doc_string, so we save two strings. */
2197 char *temp
= saved_doc_string
;
2198 int temp_size
= saved_doc_string_size
;
2199 file_offset temp_pos
= saved_doc_string_position
;
2200 int temp_len
= saved_doc_string_length
;
2202 saved_doc_string
= prev_saved_doc_string
;
2203 saved_doc_string_size
= prev_saved_doc_string_size
;
2204 saved_doc_string_position
= prev_saved_doc_string_position
;
2205 saved_doc_string_length
= prev_saved_doc_string_length
;
2207 prev_saved_doc_string
= temp
;
2208 prev_saved_doc_string_size
= temp_size
;
2209 prev_saved_doc_string_position
= temp_pos
;
2210 prev_saved_doc_string_length
= temp_len
;
2213 if (saved_doc_string_size
== 0)
2215 saved_doc_string_size
= nskip
+ 100;
2216 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2218 if (nskip
> saved_doc_string_size
)
2220 saved_doc_string_size
= nskip
+ 100;
2221 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2222 saved_doc_string_size
);
2225 saved_doc_string_position
= file_tell (instream
);
2227 /* Copy that many characters into saved_doc_string. */
2228 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2229 saved_doc_string
[i
] = c
= READCHAR
;
2231 saved_doc_string_length
= i
;
2235 /* Skip that many characters. */
2236 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2244 /* #! appears at the beginning of an executable file.
2245 Skip the first line. */
2246 while (c
!= '\n' && c
>= 0)
2251 return Vload_file_name
;
2253 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2254 /* #:foo is the uninterned symbol named foo. */
2257 uninterned_symbol
= 1;
2261 /* Reader forms that can reuse previously read objects. */
2262 if (c
>= '0' && c
<= '9')
2267 /* Read a non-negative integer. */
2268 while (c
>= '0' && c
<= '9')
2274 /* #n=object returns object, but associates it with n for #n#. */
2277 /* Make a placeholder for #n# to use temporarily */
2278 Lisp_Object placeholder
;
2281 placeholder
= Fcons(Qnil
, Qnil
);
2282 cell
= Fcons (make_number (n
), placeholder
);
2283 read_objects
= Fcons (cell
, read_objects
);
2285 /* Read the object itself. */
2286 tem
= read0 (readcharfun
);
2288 /* Now put it everywhere the placeholder was... */
2289 substitute_object_in_subtree (tem
, placeholder
);
2291 /* ...and #n# will use the real value from now on. */
2292 Fsetcdr (cell
, tem
);
2296 /* #n# returns a previously read object. */
2299 tem
= Fassq (make_number (n
), read_objects
);
2302 /* Fall through to error message. */
2304 else if (c
== 'r' || c
== 'R')
2305 return read_integer (readcharfun
, n
);
2307 /* Fall through to error message. */
2309 else if (c
== 'x' || c
== 'X')
2310 return read_integer (readcharfun
, 16);
2311 else if (c
== 'o' || c
== 'O')
2312 return read_integer (readcharfun
, 8);
2313 else if (c
== 'b' || c
== 'B')
2314 return read_integer (readcharfun
, 2);
2317 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2320 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2325 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2335 new_backquote_flag
++;
2336 value
= read0 (readcharfun
);
2337 new_backquote_flag
--;
2339 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2343 if (new_backquote_flag
)
2345 Lisp_Object comma_type
= Qnil
;
2350 comma_type
= Qcomma_at
;
2352 comma_type
= Qcomma_dot
;
2355 if (ch
>= 0) UNREAD (ch
);
2356 comma_type
= Qcomma
;
2359 new_backquote_flag
--;
2360 value
= read0 (readcharfun
);
2361 new_backquote_flag
++;
2362 return Fcons (comma_type
, Fcons (value
, Qnil
));
2375 end_of_file_error ();
2377 /* Accept `single space' syntax like (list ? x) where the
2378 whitespace character is SPC or TAB.
2379 Other literal whitespace like NL, CR, and FF are not accepted,
2380 as there are well-established escape sequences for these. */
2381 if (c
== ' ' || c
== '\t')
2382 return make_number (c
);
2385 c
= read_escape (readcharfun
, 0, &discard
);
2386 else if (BASE_LEADING_CODE_P (c
))
2387 c
= read_multibyte (c
, readcharfun
);
2389 next_char
= READCHAR
;
2390 if (next_char
== '.')
2392 /* Only a dotted-pair dot is valid after a char constant. */
2393 int next_next_char
= READCHAR
;
2394 UNREAD (next_next_char
);
2396 ok
= (next_next_char
<= 040
2397 || (next_next_char
< 0200
2398 && (index ("\"';([#?", next_next_char
)
2399 || (!first_in_list
&& next_next_char
== '`')
2400 || (new_backquote_flag
&& next_next_char
== ','))));
2404 ok
= (next_char
<= 040
2405 || (next_char
< 0200
2406 && (index ("\"';()[]#?", next_char
)
2407 || (!first_in_list
&& next_char
== '`')
2408 || (new_backquote_flag
&& next_char
== ','))));
2412 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2414 return make_number (c
);
2419 char *p
= read_buffer
;
2420 char *end
= read_buffer
+ read_buffer_size
;
2422 /* 1 if we saw an escape sequence specifying
2423 a multibyte character, or a multibyte character. */
2424 int force_multibyte
= 0;
2425 /* 1 if we saw an escape sequence specifying
2426 a single-byte character. */
2427 int force_singlebyte
= 0;
2428 /* 1 if read_buffer contains multibyte text now. */
2429 int is_multibyte
= 0;
2433 while ((c
= READCHAR
) >= 0
2436 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2438 int offset
= p
- read_buffer
;
2439 read_buffer
= (char *) xrealloc (read_buffer
,
2440 read_buffer_size
*= 2);
2441 p
= read_buffer
+ offset
;
2442 end
= read_buffer
+ read_buffer_size
;
2449 c
= read_escape (readcharfun
, 1, &byterep
);
2451 /* C is -1 if \ newline has just been seen */
2454 if (p
== read_buffer
)
2460 force_singlebyte
= 1;
2461 else if (byterep
== 2)
2462 force_multibyte
= 1;
2465 /* A character that must be multibyte forces multibyte. */
2466 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2467 force_multibyte
= 1;
2469 /* If we just discovered the need to be multibyte,
2470 convert the text accumulated thus far. */
2471 if (force_multibyte
&& ! is_multibyte
)
2474 to_multibyte (&p
, &end
, &nchars
);
2477 /* Allow `\C- ' and `\C-?'. */
2478 if (c
== (CHAR_CTL
| ' '))
2480 else if (c
== (CHAR_CTL
| '?'))
2485 /* Shift modifier is valid only with [A-Za-z]. */
2486 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2488 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2489 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2493 /* Move the meta bit to the right place for a string. */
2494 c
= (c
& ~CHAR_META
) | 0x80;
2495 if (c
& CHAR_MODIFIER_MASK
)
2496 error ("Invalid modifier in string");
2499 p
+= CHAR_STRING (c
, p
);
2507 end_of_file_error ();
2509 /* If purifying, and string starts with \ newline,
2510 return zero instead. This is for doc strings
2511 that we are really going to find in etc/DOC.nn.nn */
2512 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2513 return make_number (0);
2515 if (is_multibyte
|| force_singlebyte
)
2517 else if (load_convert_to_unibyte
)
2520 to_multibyte (&p
, &end
, &nchars
);
2521 if (p
- read_buffer
!= nchars
)
2523 string
= make_multibyte_string (read_buffer
, nchars
,
2525 return Fstring_make_unibyte (string
);
2527 /* We can make a unibyte string directly. */
2530 else if (EQ (readcharfun
, Qget_file_char
)
2531 || EQ (readcharfun
, Qlambda
))
2533 /* Nowadays, reading directly from a file is used only for
2534 compiled Emacs Lisp files, and those always use the
2535 Emacs internal encoding. Meanwhile, Qlambda is used
2536 for reading dynamic byte code (compiled with
2537 byte-compile-dynamic = t). So make the string multibyte
2538 if the string contains any multibyte sequences.
2539 (to_multibyte is a no-op if not.) */
2540 to_multibyte (&p
, &end
, &nchars
);
2541 is_multibyte
= (p
- read_buffer
) != nchars
;
2544 /* In all other cases, if we read these bytes as
2545 separate characters, treat them as separate characters now. */
2548 /* We want readchar_count to be the number of characters, not
2549 bytes. Hence we adjust for multibyte characters in the
2550 string. ... But it doesn't seem to be necessary, because
2551 READCHAR *does* read multibyte characters from buffers. */
2552 /* readchar_count -= (p - read_buffer) - nchars; */
2554 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2556 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2562 int next_char
= READCHAR
;
2565 if (next_char
<= 040
2566 || (next_char
< 0200
2567 && (index ("\"';([#?", next_char
)
2568 || (!first_in_list
&& next_char
== '`')
2569 || (new_backquote_flag
&& next_char
== ','))))
2575 /* Otherwise, we fall through! Note that the atom-reading loop
2576 below will now loop at least once, assuring that we will not
2577 try to UNREAD two characters in a row. */
2581 if (c
<= 040) goto retry
;
2583 char *p
= read_buffer
;
2587 char *end
= read_buffer
+ read_buffer_size
;
2591 || (!index ("\"';()[]#", c
)
2592 && !(!first_in_list
&& c
== '`')
2593 && !(new_backquote_flag
&& c
== ','))))
2595 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2597 int offset
= p
- read_buffer
;
2598 read_buffer
= (char *) xrealloc (read_buffer
,
2599 read_buffer_size
*= 2);
2600 p
= read_buffer
+ offset
;
2601 end
= read_buffer
+ read_buffer_size
;
2608 end_of_file_error ();
2612 if (! SINGLE_BYTE_CHAR_P (c
))
2613 p
+= CHAR_STRING (c
, p
);
2622 int offset
= p
- read_buffer
;
2623 read_buffer
= (char *) xrealloc (read_buffer
,
2624 read_buffer_size
*= 2);
2625 p
= read_buffer
+ offset
;
2626 end
= read_buffer
+ read_buffer_size
;
2633 if (!quoted
&& !uninterned_symbol
)
2636 register Lisp_Object val
;
2638 if (*p1
== '+' || *p1
== '-') p1
++;
2639 /* Is it an integer? */
2642 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2643 /* Integers can have trailing decimal points. */
2644 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2646 /* It is an integer. */
2650 if (sizeof (int) == sizeof (EMACS_INT
))
2651 XSETINT (val
, atoi (read_buffer
));
2652 else if (sizeof (long) == sizeof (EMACS_INT
))
2653 XSETINT (val
, atol (read_buffer
));
2659 if (isfloat_string (read_buffer
))
2661 /* Compute NaN and infinities using 0.0 in a variable,
2662 to cope with compilers that think they are smarter
2668 /* Negate the value ourselves. This treats 0, NaNs,
2669 and infinity properly on IEEE floating point hosts,
2670 and works around a common bug where atof ("-0.0")
2672 int negative
= read_buffer
[0] == '-';
2674 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2675 returns 1, is if the input ends in e+INF or e+NaN. */
2682 value
= zero
/ zero
;
2684 /* If that made a "negative" NaN, negate it. */
2688 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2691 u_minus_zero
.d
= - 0.0;
2692 for (i
= 0; i
< sizeof (double); i
++)
2693 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2699 /* Now VALUE is a positive NaN. */
2702 value
= atof (read_buffer
+ negative
);
2706 return make_float (negative
? - value
: value
);
2710 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2711 : intern (read_buffer
);
2712 if (EQ (Vread_with_symbol_positions
, Qt
)
2713 || EQ (Vread_with_symbol_positions
, readcharfun
))
2714 Vread_symbol_positions_list
=
2715 /* Kind of a hack; this will probably fail if characters
2716 in the symbol name were escaped. Not really a big
2718 Fcons (Fcons (result
,
2719 make_number (readchar_count
2720 - XFASTINT (Flength (Fsymbol_name (result
))))),
2721 Vread_symbol_positions_list
);
2729 /* List of nodes we've seen during substitute_object_in_subtree. */
2730 static Lisp_Object seen_list
;
2733 substitute_object_in_subtree (object
, placeholder
)
2735 Lisp_Object placeholder
;
2737 Lisp_Object check_object
;
2739 /* We haven't seen any objects when we start. */
2742 /* Make all the substitutions. */
2744 = substitute_object_recurse (object
, placeholder
, object
);
2746 /* Clear seen_list because we're done with it. */
2749 /* The returned object here is expected to always eq the
2751 if (!EQ (check_object
, object
))
2752 error ("Unexpected mutation error in reader");
2755 /* Feval doesn't get called from here, so no gc protection is needed. */
2756 #define SUBSTITUTE(get_val, set_val) \
2758 Lisp_Object old_value = get_val; \
2759 Lisp_Object true_value \
2760 = substitute_object_recurse (object, placeholder,\
2763 if (!EQ (old_value, true_value)) \
2770 substitute_object_recurse (object
, placeholder
, subtree
)
2772 Lisp_Object placeholder
;
2773 Lisp_Object subtree
;
2775 /* If we find the placeholder, return the target object. */
2776 if (EQ (placeholder
, subtree
))
2779 /* If we've been to this node before, don't explore it again. */
2780 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2783 /* If this node can be the entry point to a cycle, remember that
2784 we've seen it. It can only be such an entry point if it was made
2785 by #n=, which means that we can find it as a value in
2787 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2788 seen_list
= Fcons (subtree
, seen_list
);
2790 /* Recurse according to subtree's type.
2791 Every branch must return a Lisp_Object. */
2792 switch (XTYPE (subtree
))
2794 case Lisp_Vectorlike
:
2797 int length
= XINT (Flength(subtree
));
2798 for (i
= 0; i
< length
; i
++)
2800 Lisp_Object idx
= make_number (i
);
2801 SUBSTITUTE (Faref (subtree
, idx
),
2802 Faset (subtree
, idx
, true_value
));
2809 SUBSTITUTE (Fcar_safe (subtree
),
2810 Fsetcar (subtree
, true_value
));
2811 SUBSTITUTE (Fcdr_safe (subtree
),
2812 Fsetcdr (subtree
, true_value
));
2818 /* Check for text properties in each interval.
2819 substitute_in_interval contains part of the logic. */
2821 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2822 Lisp_Object arg
= Fcons (object
, placeholder
);
2824 traverse_intervals_noorder (root_interval
,
2825 &substitute_in_interval
, arg
);
2830 /* Other types don't recurse any further. */
2836 /* Helper function for substitute_object_recurse. */
2838 substitute_in_interval (interval
, arg
)
2842 Lisp_Object object
= Fcar (arg
);
2843 Lisp_Object placeholder
= Fcdr (arg
);
2845 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2864 if (*cp
== '+' || *cp
== '-')
2867 if (*cp
>= '0' && *cp
<= '9')
2870 while (*cp
>= '0' && *cp
<= '9')
2878 if (*cp
>= '0' && *cp
<= '9')
2881 while (*cp
>= '0' && *cp
<= '9')
2884 if (*cp
== 'e' || *cp
== 'E')
2888 if (*cp
== '+' || *cp
== '-')
2892 if (*cp
>= '0' && *cp
<= '9')
2895 while (*cp
>= '0' && *cp
<= '9')
2898 else if (cp
== start
)
2900 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2905 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2911 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2912 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2913 || state
== (DOT_CHAR
|TRAIL_INT
)
2914 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2915 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2916 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2921 read_vector (readcharfun
, bytecodeflag
)
2922 Lisp_Object readcharfun
;
2927 register Lisp_Object
*ptr
;
2928 register Lisp_Object tem
, item
, vector
;
2929 register struct Lisp_Cons
*otem
;
2932 tem
= read_list (1, readcharfun
);
2933 len
= Flength (tem
);
2934 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2936 size
= XVECTOR (vector
)->size
;
2937 ptr
= XVECTOR (vector
)->contents
;
2938 for (i
= 0; i
< size
; i
++)
2941 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2942 bytecode object, the docstring containing the bytecode and
2943 constants values must be treated as unibyte and passed to
2944 Fread, to get the actual bytecode string and constants vector. */
2945 if (bytecodeflag
&& load_force_doc_strings
)
2947 if (i
== COMPILED_BYTECODE
)
2949 if (!STRINGP (item
))
2950 error ("Invalid byte code");
2952 /* Delay handling the bytecode slot until we know whether
2953 it is lazily-loaded (we can tell by whether the
2954 constants slot is nil). */
2955 ptr
[COMPILED_CONSTANTS
] = item
;
2958 else if (i
== COMPILED_CONSTANTS
)
2960 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2964 /* Coerce string to unibyte (like string-as-unibyte,
2965 but without generating extra garbage and
2966 guaranteeing no change in the contents). */
2967 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2968 STRING_SET_UNIBYTE (bytestr
);
2970 item
= Fread (bytestr
);
2972 error ("Invalid byte code");
2974 otem
= XCONS (item
);
2975 bytestr
= XCAR (item
);
2980 /* Now handle the bytecode slot. */
2981 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2984 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2992 /* FLAG = 1 means check for ] to terminate rather than ) and .
2993 FLAG = -1 means check for starting with defun
2994 and make structure pure. */
2997 read_list (flag
, readcharfun
)
2999 register Lisp_Object readcharfun
;
3001 /* -1 means check next element for defun,
3002 0 means don't check,
3003 1 means already checked and found defun. */
3004 int defunflag
= flag
< 0 ? -1 : 0;
3005 Lisp_Object val
, tail
;
3006 register Lisp_Object elt
, tem
;
3007 struct gcpro gcpro1
, gcpro2
;
3008 /* 0 is the normal case.
3009 1 means this list is a doc reference; replace it with the number 0.
3010 2 means this list is a doc reference; replace it with the doc string. */
3011 int doc_reference
= 0;
3013 /* Initialize this to 1 if we are reading a list. */
3014 int first_in_list
= flag
<= 0;
3023 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3028 /* While building, if the list starts with #$, treat it specially. */
3029 if (EQ (elt
, Vload_file_name
)
3031 && !NILP (Vpurify_flag
))
3033 if (NILP (Vdoc_file_name
))
3034 /* We have not yet called Snarf-documentation, so assume
3035 this file is described in the DOC-MM.NN file
3036 and Snarf-documentation will fill in the right value later.
3037 For now, replace the whole list with 0. */
3040 /* We have already called Snarf-documentation, so make a relative
3041 file name for this file, so it can be found properly
3042 in the installed Lisp directory.
3043 We don't use Fexpand_file_name because that would make
3044 the directory absolute now. */
3045 elt
= concat2 (build_string ("../lisp/"),
3046 Ffile_name_nondirectory (elt
));
3048 else if (EQ (elt
, Vload_file_name
)
3050 && load_force_doc_strings
)
3059 Fsignal (Qinvalid_read_syntax
,
3060 Fcons (make_string (") or . in a vector", 18), Qnil
));
3068 XSETCDR (tail
, read0 (readcharfun
));
3070 val
= read0 (readcharfun
);
3071 read1 (readcharfun
, &ch
, 0);
3075 if (doc_reference
== 1)
3076 return make_number (0);
3077 if (doc_reference
== 2)
3079 /* Get a doc string from the file we are loading.
3080 If it's in saved_doc_string, get it from there. */
3081 int pos
= XINT (XCDR (val
));
3082 /* Position is negative for user variables. */
3083 if (pos
< 0) pos
= -pos
;
3084 if (pos
>= saved_doc_string_position
3085 && pos
< (saved_doc_string_position
3086 + saved_doc_string_length
))
3088 int start
= pos
- saved_doc_string_position
;
3091 /* Process quoting with ^A,
3092 and find the end of the string,
3093 which is marked with ^_ (037). */
3094 for (from
= start
, to
= start
;
3095 saved_doc_string
[from
] != 037;)
3097 int c
= saved_doc_string
[from
++];
3100 c
= saved_doc_string
[from
++];
3102 saved_doc_string
[to
++] = c
;
3104 saved_doc_string
[to
++] = 0;
3106 saved_doc_string
[to
++] = 037;
3109 saved_doc_string
[to
++] = c
;
3112 return make_string (saved_doc_string
+ start
,
3115 /* Look in prev_saved_doc_string the same way. */
3116 else if (pos
>= prev_saved_doc_string_position
3117 && pos
< (prev_saved_doc_string_position
3118 + prev_saved_doc_string_length
))
3120 int start
= pos
- prev_saved_doc_string_position
;
3123 /* Process quoting with ^A,
3124 and find the end of the string,
3125 which is marked with ^_ (037). */
3126 for (from
= start
, to
= start
;
3127 prev_saved_doc_string
[from
] != 037;)
3129 int c
= prev_saved_doc_string
[from
++];
3132 c
= prev_saved_doc_string
[from
++];
3134 prev_saved_doc_string
[to
++] = c
;
3136 prev_saved_doc_string
[to
++] = 0;
3138 prev_saved_doc_string
[to
++] = 037;
3141 prev_saved_doc_string
[to
++] = c
;
3144 return make_string (prev_saved_doc_string
+ start
,
3148 return get_doc_string (val
, 0, 0);
3153 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3155 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3157 tem
= (read_pure
&& flag
<= 0
3158 ? pure_cons (elt
, Qnil
)
3159 : Fcons (elt
, Qnil
));
3161 XSETCDR (tail
, tem
);
3166 defunflag
= EQ (elt
, Qdefun
);
3167 else if (defunflag
> 0)
3172 Lisp_Object Vobarray
;
3173 Lisp_Object initial_obarray
;
3175 /* oblookup stores the bucket number here, for the sake of Funintern. */
3177 int oblookup_last_bucket_number
;
3179 static int hash_string ();
3181 /* Get an error if OBARRAY is not an obarray.
3182 If it is one, return it. */
3185 check_obarray (obarray
)
3186 Lisp_Object obarray
;
3188 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3190 /* If Vobarray is now invalid, force it to be valid. */
3191 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3193 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3198 /* Intern the C string STR: return a symbol with that name,
3199 interned in the current obarray. */
3206 int len
= strlen (str
);
3207 Lisp_Object obarray
;
3210 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3211 obarray
= check_obarray (obarray
);
3212 tem
= oblookup (obarray
, str
, len
, len
);
3215 return Fintern (make_string (str
, len
), obarray
);
3218 /* Create an uninterned symbol with name STR. */
3224 int len
= strlen (str
);
3226 return Fmake_symbol ((!NILP (Vpurify_flag
)
3227 ? make_pure_string (str
, len
, len
, 0)
3228 : make_string (str
, len
)));
3231 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3232 doc
: /* Return the canonical symbol whose name is STRING.
3233 If there is none, one is created by this function and returned.
3234 A second optional argument specifies the obarray to use;
3235 it defaults to the value of `obarray'. */)
3237 Lisp_Object string
, obarray
;
3239 register Lisp_Object tem
, sym
, *ptr
;
3241 if (NILP (obarray
)) obarray
= Vobarray
;
3242 obarray
= check_obarray (obarray
);
3244 CHECK_STRING (string
);
3246 tem
= oblookup (obarray
, SDATA (string
),
3249 if (!INTEGERP (tem
))
3252 if (!NILP (Vpurify_flag
))
3253 string
= Fpurecopy (string
);
3254 sym
= Fmake_symbol (string
);
3256 if (EQ (obarray
, initial_obarray
))
3257 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3259 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3261 if ((SREF (string
, 0) == ':')
3262 && EQ (obarray
, initial_obarray
))
3264 XSYMBOL (sym
)->constant
= 1;
3265 XSYMBOL (sym
)->value
= sym
;
3268 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3270 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3272 XSYMBOL (sym
)->next
= 0;
3277 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3278 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3279 NAME may be a string or a symbol. If it is a symbol, that exact
3280 symbol is searched for.
3281 A second optional argument specifies the obarray to use;
3282 it defaults to the value of `obarray'. */)
3284 Lisp_Object name
, obarray
;
3286 register Lisp_Object tem
, string
;
3288 if (NILP (obarray
)) obarray
= Vobarray
;
3289 obarray
= check_obarray (obarray
);
3291 if (!SYMBOLP (name
))
3293 CHECK_STRING (name
);
3297 string
= SYMBOL_NAME (name
);
3299 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3300 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3306 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3307 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3308 The value is t if a symbol was found and deleted, nil otherwise.
3309 NAME may be a string or a symbol. If it is a symbol, that symbol
3310 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3311 OBARRAY defaults to the value of the variable `obarray'. */)
3313 Lisp_Object name
, obarray
;
3315 register Lisp_Object string
, tem
;
3318 if (NILP (obarray
)) obarray
= Vobarray
;
3319 obarray
= check_obarray (obarray
);
3322 string
= SYMBOL_NAME (name
);
3325 CHECK_STRING (name
);
3329 tem
= oblookup (obarray
, SDATA (string
),
3334 /* If arg was a symbol, don't delete anything but that symbol itself. */
3335 if (SYMBOLP (name
) && !EQ (name
, tem
))
3338 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3339 XSYMBOL (tem
)->constant
= 0;
3340 XSYMBOL (tem
)->indirect_variable
= 0;
3342 hash
= oblookup_last_bucket_number
;
3344 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3346 if (XSYMBOL (tem
)->next
)
3347 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3349 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3353 Lisp_Object tail
, following
;
3355 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3356 XSYMBOL (tail
)->next
;
3359 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3360 if (EQ (following
, tem
))
3362 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3371 /* Return the symbol in OBARRAY whose names matches the string
3372 of SIZE characters (SIZE_BYTE bytes) at PTR.
3373 If there is no such symbol in OBARRAY, return nil.
3375 Also store the bucket number in oblookup_last_bucket_number. */
3378 oblookup (obarray
, ptr
, size
, size_byte
)
3379 Lisp_Object obarray
;
3380 register const char *ptr
;
3381 int size
, size_byte
;
3385 register Lisp_Object tail
;
3386 Lisp_Object bucket
, tem
;
3388 if (!VECTORP (obarray
)
3389 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3391 obarray
= check_obarray (obarray
);
3392 obsize
= XVECTOR (obarray
)->size
;
3394 /* This is sometimes needed in the middle of GC. */
3395 obsize
&= ~ARRAY_MARK_FLAG
;
3396 /* Combining next two lines breaks VMS C 2.3. */
3397 hash
= hash_string (ptr
, size_byte
);
3399 bucket
= XVECTOR (obarray
)->contents
[hash
];
3400 oblookup_last_bucket_number
= hash
;
3401 if (EQ (bucket
, make_number (0)))
3403 else if (!SYMBOLP (bucket
))
3404 error ("Bad data in guts of obarray"); /* Like CADR error message */
3406 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3408 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3409 && SCHARS (SYMBOL_NAME (tail
)) == size
3410 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3412 else if (XSYMBOL (tail
)->next
== 0)
3415 XSETINT (tem
, hash
);
3420 hash_string (ptr
, len
)
3421 const unsigned char *ptr
;
3424 register const unsigned char *p
= ptr
;
3425 register const unsigned char *end
= p
+ len
;
3426 register unsigned char c
;
3427 register int hash
= 0;
3432 if (c
>= 0140) c
-= 40;
3433 hash
= ((hash
<<3) + (hash
>>28) + c
);
3435 return hash
& 07777777777;
3439 map_obarray (obarray
, fn
, arg
)
3440 Lisp_Object obarray
;
3441 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3445 register Lisp_Object tail
;
3446 CHECK_VECTOR (obarray
);
3447 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3449 tail
= XVECTOR (obarray
)->contents
[i
];
3454 if (XSYMBOL (tail
)->next
== 0)
3456 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3462 mapatoms_1 (sym
, function
)
3463 Lisp_Object sym
, function
;
3465 call1 (function
, sym
);
3468 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3469 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3470 OBARRAY defaults to the value of `obarray'. */)
3472 Lisp_Object function
, obarray
;
3474 if (NILP (obarray
)) obarray
= Vobarray
;
3475 obarray
= check_obarray (obarray
);
3477 map_obarray (obarray
, mapatoms_1
, function
);
3481 #define OBARRAY_SIZE 1511
3486 Lisp_Object oblength
;
3490 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3492 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3493 Vobarray
= Fmake_vector (oblength
, make_number (0));
3494 initial_obarray
= Vobarray
;
3495 staticpro (&initial_obarray
);
3496 /* Intern nil in the obarray */
3497 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3498 XSYMBOL (Qnil
)->constant
= 1;
3500 /* These locals are to kludge around a pyramid compiler bug. */
3501 hash
= hash_string ("nil", 3);
3502 /* Separate statement here to avoid VAXC bug. */
3503 hash
%= OBARRAY_SIZE
;
3504 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3507 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3508 XSYMBOL (Qnil
)->function
= Qunbound
;
3509 XSYMBOL (Qunbound
)->value
= Qunbound
;
3510 XSYMBOL (Qunbound
)->function
= Qunbound
;
3513 XSYMBOL (Qnil
)->value
= Qnil
;
3514 XSYMBOL (Qnil
)->plist
= Qnil
;
3515 XSYMBOL (Qt
)->value
= Qt
;
3516 XSYMBOL (Qt
)->constant
= 1;
3518 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3521 Qvariable_documentation
= intern ("variable-documentation");
3522 staticpro (&Qvariable_documentation
);
3524 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3525 read_buffer
= (char *) xmalloc (read_buffer_size
);
3530 struct Lisp_Subr
*sname
;
3533 sym
= intern (sname
->symbol_name
);
3534 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3537 #ifdef NOTDEF /* use fset in subr.el now */
3539 defalias (sname
, string
)
3540 struct Lisp_Subr
*sname
;
3544 sym
= intern (string
);
3545 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3549 /* Define an "integer variable"; a symbol whose value is forwarded
3550 to a C variable of type int. Sample call: */
3551 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3553 defvar_int (namestring
, address
)
3557 Lisp_Object sym
, val
;
3558 sym
= intern (namestring
);
3559 val
= allocate_misc ();
3560 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3561 XINTFWD (val
)->intvar
= address
;
3562 SET_SYMBOL_VALUE (sym
, val
);
3565 /* Similar but define a variable whose value is t if address contains 1,
3566 nil if address contains 0 */
3568 defvar_bool (namestring
, address
)
3572 Lisp_Object sym
, val
;
3573 sym
= intern (namestring
);
3574 val
= allocate_misc ();
3575 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3576 XBOOLFWD (val
)->boolvar
= address
;
3577 SET_SYMBOL_VALUE (sym
, val
);
3578 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3581 /* Similar but define a variable whose value is the Lisp Object stored
3582 at address. Two versions: with and without gc-marking of the C
3583 variable. The nopro version is used when that variable will be
3584 gc-marked for some other reason, since marking the same slot twice
3585 can cause trouble with strings. */
3587 defvar_lisp_nopro (namestring
, address
)
3589 Lisp_Object
*address
;
3591 Lisp_Object sym
, val
;
3592 sym
= intern (namestring
);
3593 val
= allocate_misc ();
3594 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3595 XOBJFWD (val
)->objvar
= address
;
3596 SET_SYMBOL_VALUE (sym
, val
);
3600 defvar_lisp (namestring
, address
)
3602 Lisp_Object
*address
;
3604 defvar_lisp_nopro (namestring
, address
);
3605 staticpro (address
);
3608 /* Similar but define a variable whose value is the Lisp Object stored in
3609 the current buffer. address is the address of the slot in the buffer
3610 that is current now. */
3613 defvar_per_buffer (namestring
, address
, type
, doc
)
3615 Lisp_Object
*address
;
3619 Lisp_Object sym
, val
;
3622 sym
= intern (namestring
);
3623 val
= allocate_misc ();
3624 offset
= (char *)address
- (char *)current_buffer
;
3626 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3627 XBUFFER_OBJFWD (val
)->offset
= offset
;
3628 SET_SYMBOL_VALUE (sym
, val
);
3629 PER_BUFFER_SYMBOL (offset
) = sym
;
3630 PER_BUFFER_TYPE (offset
) = type
;
3632 if (PER_BUFFER_IDX (offset
) == 0)
3633 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3634 slot of buffer_local_flags */
3639 /* Similar but define a variable whose value is the Lisp Object stored
3640 at a particular offset in the current kboard object. */
3643 defvar_kboard (namestring
, offset
)
3647 Lisp_Object sym
, val
;
3648 sym
= intern (namestring
);
3649 val
= allocate_misc ();
3650 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3651 XKBOARD_OBJFWD (val
)->offset
= offset
;
3652 SET_SYMBOL_VALUE (sym
, val
);
3655 /* Record the value of load-path used at the start of dumping
3656 so we can see if the site changed it later during dumping. */
3657 static Lisp_Object dump_path
;
3663 int turn_off_warning
= 0;
3665 /* Compute the default load-path. */
3667 normal
= PATH_LOADSEARCH
;
3668 Vload_path
= decode_env_path (0, normal
);
3670 if (NILP (Vpurify_flag
))
3671 normal
= PATH_LOADSEARCH
;
3673 normal
= PATH_DUMPLOADSEARCH
;
3675 /* In a dumped Emacs, we normally have to reset the value of
3676 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3677 uses ../lisp, instead of the path of the installed elisp
3678 libraries. However, if it appears that Vload_path was changed
3679 from the default before dumping, don't override that value. */
3682 if (! NILP (Fequal (dump_path
, Vload_path
)))
3684 Vload_path
= decode_env_path (0, normal
);
3685 if (!NILP (Vinstallation_directory
))
3687 Lisp_Object tem
, tem1
, sitelisp
;
3689 /* Remove site-lisp dirs from path temporarily and store
3690 them in sitelisp, then conc them on at the end so
3691 they're always first in path. */
3695 tem
= Fcar (Vload_path
);
3696 tem1
= Fstring_match (build_string ("site-lisp"),
3700 Vload_path
= Fcdr (Vload_path
);
3701 sitelisp
= Fcons (tem
, sitelisp
);
3707 /* Add to the path the lisp subdir of the
3708 installation dir, if it exists. */
3709 tem
= Fexpand_file_name (build_string ("lisp"),
3710 Vinstallation_directory
);
3711 tem1
= Ffile_exists_p (tem
);
3714 if (NILP (Fmember (tem
, Vload_path
)))
3716 turn_off_warning
= 1;
3717 Vload_path
= Fcons (tem
, Vload_path
);
3721 /* That dir doesn't exist, so add the build-time
3722 Lisp dirs instead. */
3723 Vload_path
= nconc2 (Vload_path
, dump_path
);
3725 /* Add leim under the installation dir, if it exists. */
3726 tem
= Fexpand_file_name (build_string ("leim"),
3727 Vinstallation_directory
);
3728 tem1
= Ffile_exists_p (tem
);
3731 if (NILP (Fmember (tem
, Vload_path
)))
3732 Vload_path
= Fcons (tem
, Vload_path
);
3735 /* Add site-list under the installation dir, if it exists. */
3736 tem
= Fexpand_file_name (build_string ("site-lisp"),
3737 Vinstallation_directory
);
3738 tem1
= Ffile_exists_p (tem
);
3741 if (NILP (Fmember (tem
, Vload_path
)))
3742 Vload_path
= Fcons (tem
, Vload_path
);
3745 /* If Emacs was not built in the source directory,
3746 and it is run from where it was built, add to load-path
3747 the lisp, leim and site-lisp dirs under that directory. */
3749 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3753 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3754 Vinstallation_directory
);
3755 tem1
= Ffile_exists_p (tem
);
3757 /* Don't be fooled if they moved the entire source tree
3758 AFTER dumping Emacs. If the build directory is indeed
3759 different from the source dir, src/Makefile.in and
3760 src/Makefile will not be found together. */
3761 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3762 Vinstallation_directory
);
3763 tem2
= Ffile_exists_p (tem
);
3764 if (!NILP (tem1
) && NILP (tem2
))
3766 tem
= Fexpand_file_name (build_string ("lisp"),
3769 if (NILP (Fmember (tem
, Vload_path
)))
3770 Vload_path
= Fcons (tem
, Vload_path
);
3772 tem
= Fexpand_file_name (build_string ("leim"),
3775 if (NILP (Fmember (tem
, Vload_path
)))
3776 Vload_path
= Fcons (tem
, Vload_path
);
3778 tem
= Fexpand_file_name (build_string ("site-lisp"),
3781 if (NILP (Fmember (tem
, Vload_path
)))
3782 Vload_path
= Fcons (tem
, Vload_path
);
3785 if (!NILP (sitelisp
))
3786 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3792 /* NORMAL refers to the lisp dir in the source directory. */
3793 /* We used to add ../lisp at the front here, but
3794 that caused trouble because it was copied from dump_path
3795 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3796 It should be unnecessary. */
3797 Vload_path
= decode_env_path (0, normal
);
3798 dump_path
= Vload_path
;
3802 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3803 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3804 almost never correct, thereby causing a warning to be printed out that
3805 confuses users. Since PATH_LOADSEARCH is always overridden by the
3806 EMACSLOADPATH environment variable below, disable the warning on NT.
3807 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3808 the "standard" paths may not exist and would be overridden by
3809 EMACSLOADPATH as on NT. Since this depends on how the executable
3810 was build and packaged, turn off the warnings in general */
3812 /* Warn if dirs in the *standard* path don't exist. */
3813 if (!turn_off_warning
)
3815 Lisp_Object path_tail
;
3817 for (path_tail
= Vload_path
;
3819 path_tail
= XCDR (path_tail
))
3821 Lisp_Object dirfile
;
3822 dirfile
= Fcar (path_tail
);
3823 if (STRINGP (dirfile
))
3825 dirfile
= Fdirectory_file_name (dirfile
);
3826 if (access (SDATA (dirfile
), 0) < 0)
3827 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3832 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3834 /* If the EMACSLOADPATH environment variable is set, use its value.
3835 This doesn't apply if we're dumping. */
3837 if (NILP (Vpurify_flag
)
3838 && egetenv ("EMACSLOADPATH"))
3840 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3844 load_in_progress
= 0;
3845 Vload_file_name
= Qnil
;
3847 load_descriptor_list
= Qnil
;
3849 Vstandard_input
= Qt
;
3850 Vloads_in_progress
= Qnil
;
3853 /* Print a warning, using format string FORMAT, that directory DIRNAME
3854 does not exist. Print it on stderr and put it in *Message*. */
3857 dir_warning (format
, dirname
)
3859 Lisp_Object dirname
;
3862 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3864 fprintf (stderr
, format
, SDATA (dirname
));
3865 sprintf (buffer
, format
, SDATA (dirname
));
3866 /* Don't log the warning before we've initialized!! */
3868 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3875 defsubr (&Sread_from_string
);
3877 defsubr (&Sintern_soft
);
3878 defsubr (&Sunintern
);
3879 defsubr (&Sget_load_suffixes
);
3881 defsubr (&Seval_buffer
);
3882 defsubr (&Seval_region
);
3883 defsubr (&Sread_char
);
3884 defsubr (&Sread_char_exclusive
);
3885 defsubr (&Sread_event
);
3886 defsubr (&Sget_file_char
);
3887 defsubr (&Smapatoms
);
3888 defsubr (&Slocate_file_internal
);
3890 DEFVAR_LISP ("obarray", &Vobarray
,
3891 doc
: /* Symbol table for use by `intern' and `read'.
3892 It is a vector whose length ought to be prime for best results.
3893 The vector's contents don't make sense if examined from Lisp programs;
3894 to find all the symbols in an obarray, use `mapatoms'. */);
3896 DEFVAR_LISP ("values", &Vvalues
,
3897 doc
: /* List of values of all expressions which were read, evaluated and printed.
3898 Order is reverse chronological. */);
3900 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3901 doc
: /* Stream for read to get input from.
3902 See documentation of `read' for possible values. */);
3903 Vstandard_input
= Qt
;
3905 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3906 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3908 If this variable is a buffer, then only forms read from that buffer
3909 will be added to `read-symbol-positions-list'.
3910 If this variable is t, then all read forms will be added.
3911 The effect of all other values other than nil are not currently
3912 defined, although they may be in the future.
3914 The positions are relative to the last call to `read' or
3915 `read-from-string'. It is probably a bad idea to set this variable at
3916 the toplevel; bind it instead. */);
3917 Vread_with_symbol_positions
= Qnil
;
3919 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3920 doc
: /* A list mapping read symbols to their positions.
3921 This variable is modified during calls to `read' or
3922 `read-from-string', but only when `read-with-symbol-positions' is
3925 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3926 CHAR-POSITION is an integer giving the offset of that occurrence of the
3927 symbol from the position where `read' or `read-from-string' started.
3929 Note that a symbol will appear multiple times in this list, if it was
3930 read multiple times. The list is in the same order as the symbols
3932 Vread_symbol_positions_list
= Qnil
;
3934 DEFVAR_LISP ("load-path", &Vload_path
,
3935 doc
: /* *List of directories to search for files to load.
3936 Each element is a string (directory name) or nil (try default directory).
3937 Initialized based on EMACSLOADPATH environment variable, if any,
3938 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3940 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3941 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
3942 This list should not include the empty string.
3943 `load' and related functions try to append these suffixes, in order,
3944 to the specified file name if a Lisp suffix is allowed or required. */);
3945 Vload_suffixes
= Fcons (build_string (".elc"),
3946 Fcons (build_string (".el"), Qnil
));
3947 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
3948 doc
: /* List of suffixes that indicate representations of \
3950 This list should normally start with the empty string.
3952 Enabling Auto Compression mode appends the suffixes in
3953 `jka-compr-load-suffixes' to this list and disabling Auto Compression
3954 mode removes them again. `load' and related functions use this list to
3955 determine whether they should look for compressed versions of a file
3956 and, if so, which suffixes they should try to append to the file name
3957 in order to do so. However, if you want to customize which suffixes
3958 the loading functions recognize as compression suffixes, you should
3959 customize `jka-compr-load-suffixes' rather than the present variable. */);
3960 /* We don't use empty_string because it's not initialized yet. */
3961 Vload_file_rep_suffixes
= Fcons (build_string (""), Qnil
);
3963 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3964 doc
: /* Non-nil iff inside of `load'. */);
3966 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3967 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3968 Each element looks like (FILENAME FORMS...).
3969 When `load' is run and the file-name argument is FILENAME,
3970 the FORMS in the corresponding element are executed at the end of loading.
3972 FILENAME must match exactly! Normally FILENAME is the name of a library,
3973 with no directory specified, since that is how `load' is normally called.
3974 An error in FORMS does not undo the load,
3975 but does prevent execution of the rest of the FORMS.
3976 FILENAME can also be a symbol (a feature) and FORMS are then executed
3977 when the corresponding call to `provide' is made. */);
3978 Vafter_load_alist
= Qnil
;
3980 DEFVAR_LISP ("load-history", &Vload_history
,
3981 doc
: /* Alist mapping file names to symbols and features.
3982 Each alist element is a list that starts with a file name,
3983 except for one element (optional) that starts with nil and describes
3984 definitions evaluated from buffers not visiting files.
3985 The remaining elements of each list are symbols defined as variables
3986 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3987 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3988 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3989 and means that SYMBOL was an autoload before this file redefined it
3992 During preloading, the file name recorded is relative to the main Lisp
3993 directory. These file names are converted to absolute at startup. */);
3994 Vload_history
= Qnil
;
3996 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3997 doc
: /* Full name of file being loaded by `load'. */);
3998 Vload_file_name
= Qnil
;
4000 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4001 doc
: /* File name, including directory, of user's initialization file.
4002 If the file loaded had extension `.elc', and the corresponding source file
4003 exists, this variable contains the name of source file, suitable for use
4004 by functions like `custom-save-all' which edit the init file. */);
4005 Vuser_init_file
= Qnil
;
4007 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4008 doc
: /* Used for internal purposes by `load'. */);
4009 Vcurrent_load_list
= Qnil
;
4011 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4012 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4013 The default is nil, which means use the function `read'. */);
4014 Vload_read_function
= Qnil
;
4016 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4017 doc
: /* Function called in `load' for loading an Emacs lisp source file.
4018 This function is for doing code conversion before reading the source file.
4019 If nil, loading is done without any code conversion.
4020 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4021 FULLNAME is the full name of FILE.
4022 See `load' for the meaning of the remaining arguments. */);
4023 Vload_source_file_function
= Qnil
;
4025 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4026 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4027 This is useful when the file being loaded is a temporary copy. */);
4028 load_force_doc_strings
= 0;
4030 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4031 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4032 This is normally bound by `load' and `eval-buffer' to control `read',
4033 and is not meant for users to change. */);
4034 load_convert_to_unibyte
= 0;
4036 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4037 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4038 You cannot count on them to still be there! */);
4040 = Fexpand_file_name (build_string ("../"),
4041 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4043 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4044 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4045 Vpreloaded_file_list
= Qnil
;
4047 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4048 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4049 Vbyte_boolean_vars
= Qnil
;
4051 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4052 doc
: /* Non-nil means load dangerous compiled Lisp files.
4053 Some versions of XEmacs use different byte codes than Emacs. These
4054 incompatible byte codes can make Emacs crash when it tries to execute
4056 load_dangerous_libraries
= 0;
4058 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4059 doc
: /* Regular expression matching safe to load compiled Lisp files.
4060 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4061 from the file, and matches them against this regular expression.
4062 When the regular expression matches, the file is considered to be safe
4063 to load. See also `load-dangerous-libraries'. */);
4064 Vbytecomp_version_regexp
4065 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4067 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4068 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4069 Veval_buffer_list
= Qnil
;
4071 /* Vsource_directory was initialized in init_lread. */
4073 load_descriptor_list
= Qnil
;
4074 staticpro (&load_descriptor_list
);
4076 Qcurrent_load_list
= intern ("current-load-list");
4077 staticpro (&Qcurrent_load_list
);
4079 Qstandard_input
= intern ("standard-input");
4080 staticpro (&Qstandard_input
);
4082 Qread_char
= intern ("read-char");
4083 staticpro (&Qread_char
);
4085 Qget_file_char
= intern ("get-file-char");
4086 staticpro (&Qget_file_char
);
4088 Qbackquote
= intern ("`");
4089 staticpro (&Qbackquote
);
4090 Qcomma
= intern (",");
4091 staticpro (&Qcomma
);
4092 Qcomma_at
= intern (",@");
4093 staticpro (&Qcomma_at
);
4094 Qcomma_dot
= intern (",.");
4095 staticpro (&Qcomma_dot
);
4097 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4098 staticpro (&Qinhibit_file_name_operation
);
4100 Qascii_character
= intern ("ascii-character");
4101 staticpro (&Qascii_character
);
4103 Qfunction
= intern ("function");
4104 staticpro (&Qfunction
);
4106 Qload
= intern ("load");
4109 Qload_file_name
= intern ("load-file-name");
4110 staticpro (&Qload_file_name
);
4112 Qeval_buffer_list
= intern ("eval-buffer-list");
4113 staticpro (&Qeval_buffer_list
);
4115 staticpro (&dump_path
);
4117 staticpro (&read_objects
);
4118 read_objects
= Qnil
;
4119 staticpro (&seen_list
);
4122 Vloads_in_progress
= Qnil
;
4123 staticpro (&Vloads_in_progress
);
4126 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4127 (do not change this comment) */