1 /* Lisp parsing and input streams.
2 Copyright (C) 1985,86,87,88,89,93,94,95,97,98,99,2000,01,03,2004
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
38 #include "termhooks.h"
42 #include <sys/inode.h>
47 #include <unistd.h> /* to get X_OK */
64 #endif /* HAVE_SETLOCALE */
74 #define file_offset off_t
75 #define file_tell ftello
77 #define file_offset long
78 #define file_tell ftell
85 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
86 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
87 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
88 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
89 Lisp_Object Qinhibit_file_name_operation
;
91 /* Used instead of Qget_file_char while loading *.elc files compiled
92 by Emacs 21 or older. */
93 static Lisp_Object Qget_emacs_mule_file_char
;
95 static Lisp_Object Qload_force_doc_strings
;
97 extern Lisp_Object Qevent_symbol_element_mask
;
98 extern Lisp_Object Qfile_exists_p
;
100 /* non-zero if inside `load' */
101 int load_in_progress
;
103 /* Directory in which the sources were found. */
104 Lisp_Object Vsource_directory
;
106 /* Search path and suffixes for files to be loaded. */
107 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
109 /* File name of user's init file. */
110 Lisp_Object Vuser_init_file
;
112 /* This is the user-visible association list that maps features to
113 lists of defs in their load files. */
114 Lisp_Object Vload_history
;
116 /* This is used to build the load history. */
117 Lisp_Object Vcurrent_load_list
;
119 /* List of files that were preloaded. */
120 Lisp_Object Vpreloaded_file_list
;
122 /* Name of file actually being read by `load'. */
123 Lisp_Object Vload_file_name
;
125 /* Function to use for reading, in `load' and friends. */
126 Lisp_Object Vload_read_function
;
128 /* The association list of objects read with the #n=object form.
129 Each member of the list has the form (n . object), and is used to
130 look up the object for the corresponding #n# construct.
131 It must be set to nil before all top-level calls to read0. */
132 Lisp_Object read_objects
;
134 /* Nonzero means load should forcibly load all dynamic doc strings. */
135 static int load_force_doc_strings
;
137 /* Nonzero means read should convert strings to unibyte. */
138 static int load_convert_to_unibyte
;
140 /* Nonzero means READCHAR should read bytes one by one (not character)
141 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
142 This is set to 1 by read1 temporarily while handling #@NUMBER. */
143 static int load_each_byte
;
145 /* Function to use for loading an Emacs lisp source file (not
146 compiled) instead of readevalloop. */
147 Lisp_Object Vload_source_file_function
;
149 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
150 Lisp_Object Vbyte_boolean_vars
;
152 /* Whether or not to add a `read-positions' property to symbols
154 Lisp_Object Vread_with_symbol_positions
;
156 /* List of (SYMBOL . POSITION) accumulated so far. */
157 Lisp_Object Vread_symbol_positions_list
;
159 /* List of descriptors now open for Fload. */
160 static Lisp_Object load_descriptor_list
;
162 /* File for get_file_char to read from. Use by load. */
163 static FILE *instream
;
165 /* When nonzero, read conses in pure space */
166 static int read_pure
;
168 /* For use within read-from-string (this reader is non-reentrant!!) */
169 static int read_from_string_index
;
170 static int read_from_string_index_byte
;
171 static int read_from_string_limit
;
173 /* Number of characters read in the current call to Fread or
174 Fread_from_string. */
175 static int readchar_count
;
177 /* This contains the last string skipped with #@. */
178 static char *saved_doc_string
;
179 /* Length of buffer allocated in saved_doc_string. */
180 static int saved_doc_string_size
;
181 /* Length of actual data in saved_doc_string. */
182 static int saved_doc_string_length
;
183 /* This is the file position that string came from. */
184 static file_offset saved_doc_string_position
;
186 /* This contains the previous string skipped with #@.
187 We copy it from saved_doc_string when a new string
188 is put in saved_doc_string. */
189 static char *prev_saved_doc_string
;
190 /* Length of buffer allocated in prev_saved_doc_string. */
191 static int prev_saved_doc_string_size
;
192 /* Length of actual data in prev_saved_doc_string. */
193 static int prev_saved_doc_string_length
;
194 /* This is the file position that string came from. */
195 static file_offset prev_saved_doc_string_position
;
197 /* Nonzero means inside a new-style backquote
198 with no surrounding parentheses.
199 Fread initializes this to zero, so we need not specbind it
200 or worry about what happens to it when there is an error. */
201 static int new_backquote_flag
;
203 /* A list of file names for files being loaded in Fload. Used to
204 check for recursive loads. */
206 static Lisp_Object Vloads_in_progress
;
208 /* Non-zero means load dangerous compiled Lisp files. */
210 int load_dangerous_libraries
;
212 /* A regular expression used to detect files compiled with Emacs. */
214 static Lisp_Object Vbytecomp_version_regexp
;
216 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
219 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
220 Lisp_Object (*) (), int,
221 Lisp_Object
, Lisp_Object
));
222 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
223 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
226 /* Functions that read one byte from the current source READCHARFUN
227 or unreads one byte. If the integer argument C is -1, it returns
228 one read byte, or -1 when there's no more byte in the source. If C
229 is 0 or positive, it unreads C, and the return value is not
232 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
233 static int readbyte_from_file
P_ ((int, Lisp_Object
));
234 static int readbyte_from_string
P_ ((int, Lisp_Object
));
236 /* Handle unreading and rereading of characters.
237 Write READCHAR to read a character,
238 UNREAD(c) to unread c to be read again.
240 These macros correctly read/unread multibyte characters. */
242 #define READCHAR readchar (readcharfun)
243 #define UNREAD(c) unreadchar (readcharfun, c)
245 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
246 Qlambda, or a cons, we use this to keep an unread character because
247 a file stream can't handle multibyte-char unreading. The value -1
248 means that there's no unread character. */
249 static int unread_char
;
252 readchar (readcharfun
)
253 Lisp_Object readcharfun
;
257 int (*readbyte
) P_ ((int, Lisp_Object
));
258 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
260 int emacs_mule_encoding
= 0;
264 if (BUFFERP (readcharfun
))
266 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
268 int pt_byte
= BUF_PT_BYTE (inbuffer
);
270 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
273 if (! NILP (inbuffer
->enable_multibyte_characters
))
275 /* Fetch the character code from the buffer. */
276 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
277 BUF_INC_POS (inbuffer
, pt_byte
);
278 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
282 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
283 if (! ASCII_BYTE_P (c
))
284 c
= BYTE8_TO_CHAR (c
);
287 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
291 if (MARKERP (readcharfun
))
293 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
295 int bytepos
= marker_byte_position (readcharfun
);
297 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
300 if (! NILP (inbuffer
->enable_multibyte_characters
))
302 /* Fetch the character code from the buffer. */
303 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
304 BUF_INC_POS (inbuffer
, bytepos
);
305 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
309 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
310 if (! ASCII_BYTE_P (c
))
311 c
= BYTE8_TO_CHAR (c
);
315 XMARKER (readcharfun
)->bytepos
= bytepos
;
316 XMARKER (readcharfun
)->charpos
++;
321 if (EQ (readcharfun
, Qlambda
))
323 readbyte
= readbyte_for_lambda
;
327 if (EQ (readcharfun
, Qget_file_char
))
329 readbyte
= readbyte_from_file
;
333 if (STRINGP (readcharfun
))
335 if (read_from_string_index
>= read_from_string_limit
)
338 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
339 read_from_string_index
,
340 read_from_string_index_byte
);
345 if (CONSP (readcharfun
))
347 /* This is the case that read_vector is reading from a unibyte
348 string that contains a byte sequence previously skipped
349 because of #@NUMBER. The car part of readcharfun is that
350 string, and the cdr part is a value of readcharfun given to
352 readbyte
= readbyte_from_string
;
353 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
354 emacs_mule_encoding
= 1;
358 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
360 readbyte
= readbyte_from_file
;
361 emacs_mule_encoding
= 1;
365 tem
= call0 (readcharfun
);
372 if (unread_char
>= 0)
378 c
= (*readbyte
) (-1, readcharfun
);
379 if (c
< 0 || ASCII_BYTE_P (c
) || load_each_byte
)
381 if (emacs_mule_encoding
)
382 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
385 len
= BYTES_BY_CHAR_HEAD (c
);
388 c
= (*readbyte
) (-1, readcharfun
);
389 if (c
< 0 || ! TRAILING_CODE_P (c
))
392 (*readbyte
) (buf
[i
], readcharfun
);
393 return BYTE8_TO_CHAR (buf
[0]);
397 return STRING_CHAR (buf
, i
);
400 /* Unread the character C in the way appropriate for the stream READCHARFUN.
401 If the stream is a user function, call it with the char as argument. */
404 unreadchar (readcharfun
, c
)
405 Lisp_Object readcharfun
;
410 /* Don't back up the pointer if we're unreading the end-of-input mark,
411 since readchar didn't advance it when we read it. */
413 else if (BUFFERP (readcharfun
))
415 struct buffer
*b
= XBUFFER (readcharfun
);
416 int bytepos
= BUF_PT_BYTE (b
);
419 if (! NILP (b
->enable_multibyte_characters
))
420 BUF_DEC_POS (b
, bytepos
);
424 BUF_PT_BYTE (b
) = bytepos
;
426 else if (MARKERP (readcharfun
))
428 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
429 int bytepos
= XMARKER (readcharfun
)->bytepos
;
431 XMARKER (readcharfun
)->charpos
--;
432 if (! NILP (b
->enable_multibyte_characters
))
433 BUF_DEC_POS (b
, bytepos
);
437 XMARKER (readcharfun
)->bytepos
= bytepos
;
439 else if (STRINGP (readcharfun
))
441 read_from_string_index
--;
442 read_from_string_index_byte
443 = string_char_to_byte (readcharfun
, read_from_string_index
);
445 else if (CONSP (readcharfun
))
449 else if (EQ (readcharfun
, Qlambda
))
453 else if (EQ (readcharfun
, Qget_file_char
)
454 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
457 ungetc (c
, instream
);
462 call1 (readcharfun
, make_number (c
));
466 readbyte_for_lambda (c
, readcharfun
)
468 Lisp_Object readcharfun
;
470 return read_bytecode_char (c
>= 0);
475 readbyte_from_file (c
, readcharfun
)
477 Lisp_Object readcharfun
;
481 ungetc (c
, instream
);
487 /* Interrupted reads have been observed while reading over the network */
488 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
494 return (c
== EOF
? -1 : c
);
498 readbyte_from_string (c
, readcharfun
)
500 Lisp_Object readcharfun
;
502 Lisp_Object string
= XCAR (readcharfun
);
506 read_from_string_index
--;
507 read_from_string_index_byte
508 = string_char_to_byte (string
, read_from_string_index
);
511 if (read_from_string_index
>= read_from_string_limit
)
514 FETCH_STRING_CHAR_ADVANCE (c
, string
,
515 read_from_string_index
,
516 read_from_string_index_byte
);
521 /* Read one non-ASCII character from INSTREAM. The character is
522 encoded in `emacs-mule' and the first byte is already read in
525 extern char emacs_mule_bytes
[256];
528 read_emacs_mule_char (c
, readbyte
, readcharfun
)
530 int (*readbyte
) P_ ((int, Lisp_Object
));
531 Lisp_Object readcharfun
;
533 /* Emacs-mule coding uses at most 4-byte for one character. */
534 unsigned char buf
[4];
535 int len
= emacs_mule_bytes
[c
];
536 struct charset
*charset
;
541 /* C is not a valid leading-code of `emacs-mule'. */
542 return BYTE8_TO_CHAR (c
);
548 c
= (*readbyte
) (-1, readcharfun
);
552 (*readbyte
) (buf
[i
], readcharfun
);
553 return BYTE8_TO_CHAR (buf
[0]);
560 charset
= emacs_mule_charset
[buf
[0]];
561 code
= buf
[1] & 0x7F;
565 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
566 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
568 charset
= emacs_mule_charset
[buf
[1]];
569 code
= buf
[2] & 0x7F;
573 charset
= emacs_mule_charset
[buf
[0]];
574 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
579 charset
= emacs_mule_charset
[buf
[1]];
580 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
582 c
= DECODE_CHAR (charset
, code
);
584 Fsignal (Qinvalid_read_syntax
,
585 Fcons (build_string ("invalid multibyte form"), Qnil
));
590 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
592 static Lisp_Object read0
P_ ((Lisp_Object
));
593 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
595 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
596 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
598 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
600 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
602 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
605 /* Get a character from the tty. */
607 extern Lisp_Object
read_char ();
609 /* Read input events until we get one that's acceptable for our purposes.
611 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
612 until we get a character we like, and then stuffed into
615 If ASCII_REQUIRED is non-zero, we check function key events to see
616 if the unmodified version of the symbol has a Qascii_character
617 property, and use that character, if present.
619 If ERROR_NONASCII is non-zero, we signal an error if the input we
620 get isn't an ASCII character with modifiers. If it's zero but
621 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
624 If INPUT_METHOD is nonzero, we invoke the current input method
625 if the character warrants that. */
628 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
630 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
632 register Lisp_Object val
, delayed_switch_frame
;
634 #ifdef HAVE_WINDOW_SYSTEM
635 if (display_hourglass_p
)
639 delayed_switch_frame
= Qnil
;
641 /* Read until we get an acceptable event. */
643 val
= read_char (0, 0, 0,
644 (input_method
? Qnil
: Qt
),
650 /* switch-frame events are put off until after the next ASCII
651 character. This is better than signaling an error just because
652 the last characters were typed to a separate minibuffer frame,
653 for example. Eventually, some code which can deal with
654 switch-frame events will read it and process it. */
656 && EVENT_HAS_PARAMETERS (val
)
657 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
659 delayed_switch_frame
= val
;
665 /* Convert certain symbols to their ASCII equivalents. */
668 Lisp_Object tem
, tem1
;
669 tem
= Fget (val
, Qevent_symbol_element_mask
);
672 tem1
= Fget (Fcar (tem
), Qascii_character
);
673 /* Merge this symbol's modifier bits
674 with the ASCII equivalent of its basic code. */
676 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
680 /* If we don't have a character now, deal with it appropriately. */
685 Vunread_command_events
= Fcons (val
, Qnil
);
686 error ("Non-character input-event");
693 if (! NILP (delayed_switch_frame
))
694 unread_switch_frame
= delayed_switch_frame
;
698 #ifdef HAVE_WINDOW_SYSTEM
699 if (display_hourglass_p
)
708 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
709 doc
: /* Read a character from the command input (keyboard or macro).
710 It is returned as a number.
711 If the user generates an event which is not a character (i.e. a mouse
712 click or function key event), `read-char' signals an error. As an
713 exception, switch-frame events are put off until non-ASCII events can
715 If you want to read non-character events, or ignore them, call
716 `read-event' or `read-char-exclusive' instead.
718 If the optional argument PROMPT is non-nil, display that as a prompt.
719 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
720 input method is turned on in the current buffer, that input method
721 is used for reading a character. */)
722 (prompt
, inherit_input_method
)
723 Lisp_Object prompt
, inherit_input_method
;
726 message_with_string ("%s", prompt
, 0);
727 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
730 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
731 doc
: /* Read an event object from the input stream.
732 If the optional argument PROMPT is non-nil, display that as a prompt.
733 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734 input method is turned on in the current buffer, that input method
735 is used for reading a character. */)
736 (prompt
, inherit_input_method
)
737 Lisp_Object prompt
, inherit_input_method
;
740 message_with_string ("%s", prompt
, 0);
741 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
744 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
745 doc
: /* Read a character from the command input (keyboard or macro).
746 It is returned as a number. Non-character events are ignored.
748 If the optional argument PROMPT is non-nil, display that as a prompt.
749 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
750 input method is turned on in the current buffer, that input method
751 is used for reading a character. */)
752 (prompt
, inherit_input_method
)
753 Lisp_Object prompt
, inherit_input_method
;
756 message_with_string ("%s", prompt
, 0);
757 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
760 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
761 doc
: /* Don't use this yourself. */)
764 register Lisp_Object val
;
765 XSETINT (val
, getc (instream
));
771 /* Value is a version number of byte compiled code if the file
772 asswociated with file descriptor FD is a compiled Lisp file that's
773 safe to load. Only files compiled with Emacs are safe to load.
774 Files compiled with XEmacs can lead to a crash in Fbyte_code
775 because of an incompatible change in the byte compiler. */
786 /* Read the first few bytes from the file, and look for a line
787 specifying the byte compiler version used. */
788 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
793 /* Skip to the next newline, skipping over the initial `ELC'
794 with NUL bytes following it, but note the version. */
795 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
800 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
807 lseek (fd
, 0, SEEK_SET
);
812 /* Callback for record_unwind_protect. Restore the old load list OLD,
813 after loading a file successfully. */
816 record_load_unwind (old
)
819 return Vloads_in_progress
= old
;
822 /* This handler function is used via internal_condition_case_1. */
825 load_error_handler (data
)
831 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
832 doc
: /* Execute a file of Lisp code named FILE.
833 First try FILE with `.elc' appended, then try with `.el',
834 then try FILE unmodified (the exact suffixes are determined by
835 `load-suffixes'). Environment variable references in FILE
836 are replaced with their values by calling `substitute-in-file-name'.
837 This function searches the directories in `load-path'.
838 If optional second arg NOERROR is non-nil,
839 report no error if FILE doesn't exist.
840 Print messages at start and end of loading unless
841 optional third arg NOMESSAGE is non-nil.
842 If optional fourth arg NOSUFFIX is non-nil, don't try adding
843 suffixes `.elc' or `.el' to the specified name FILE.
844 If optional fifth arg MUST-SUFFIX is non-nil, insist on
845 the suffix `.elc' or `.el'; don't accept just FILE unless
846 it ends in one of those suffixes or includes a directory name.
847 Return t if file exists. */)
848 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
849 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
851 register FILE *stream
;
852 register int fd
= -1;
853 register Lisp_Object lispstream
;
854 int count
= SPECPDL_INDEX ();
857 Lisp_Object found
, efound
;
858 /* 1 means we printed the ".el is newer" message. */
860 /* 1 means we are loading a compiled file. */
873 /* If file name is magic, call the handler. */
874 /* This shouldn't be necessary any more now that `openp' handles it right.
875 handler = Ffind_file_name_handler (file, Qload);
877 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
879 /* Do this after the handler to avoid
880 the need to gcpro noerror, nomessage and nosuffix.
881 (Below here, we care only whether they are nil or not.)
882 The presence of this call is the result of a historical accident:
883 it used to be in every file-operations and when it got removed
884 everywhere, it accidentally stayed here. Since then, enough people
885 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
886 that it seemed risky to remove. */
887 if (! NILP (noerror
))
889 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
890 Qt
, load_error_handler
);
895 file
= Fsubstitute_in_file_name (file
);
898 /* Avoid weird lossage with null string as arg,
899 since it would try to load a directory as a Lisp file */
900 if (SCHARS (file
) > 0)
902 int size
= SBYTES (file
);
907 if (! NILP (must_suffix
))
909 /* Don't insist on adding a suffix if FILE already ends with one. */
911 && !strcmp (SDATA (file
) + size
- 3, ".el"))
914 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
916 /* Don't insist on adding a suffix
917 if the argument includes a directory name. */
918 else if (! NILP (Ffile_name_directory (file
)))
922 fd
= openp (Vload_path
, file
,
923 (!NILP (nosuffix
) ? Qnil
924 : !NILP (must_suffix
) ? Vload_suffixes
925 : Fappend (2, (tmp
[0] = Vload_suffixes
,
926 tmp
[1] = default_suffixes
,
935 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
936 Fcons (file
, Qnil
)));
941 /* Tell startup.el whether or not we found the user's init file. */
942 if (EQ (Qt
, Vuser_init_file
))
943 Vuser_init_file
= found
;
945 /* If FD is -2, that means openp found a magic file. */
948 if (NILP (Fequal (found
, file
)))
949 /* If FOUND is a different file name from FILE,
950 find its handler even if we have already inhibited
951 the `load' operation on FILE. */
952 handler
= Ffind_file_name_handler (found
, Qt
);
954 handler
= Ffind_file_name_handler (found
, Qload
);
955 if (! NILP (handler
))
956 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
959 /* Check if we're stuck in a recursive load cycle.
961 2000-09-21: It's not possible to just check for the file loaded
962 being a member of Vloads_in_progress. This fails because of the
963 way the byte compiler currently works; `provide's are not
964 evaluted, see font-lock.el/jit-lock.el as an example. This
965 leads to a certain amount of ``normal'' recursion.
967 Also, just loading a file recursively is not always an error in
968 the general case; the second load may do something different. */
972 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
973 if (!NILP (Fequal (found
, XCAR (tem
))))
976 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
977 Fcons (found
, Vloads_in_progress
)));
978 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
979 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
983 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
985 || (version
= safe_to_load_p (fd
)) > 0)
986 /* Load .elc files directly, but not when they are
987 remote and have no handler! */
995 && ! (version
= safe_to_load_p (fd
)))
998 if (!load_dangerous_libraries
)
1002 error ("File `%s' was not compiled in Emacs",
1005 else if (!NILP (nomessage
))
1006 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1012 efound
= ENCODE_FILE (found
);
1017 stat ((char *)SDATA (efound
), &s1
);
1018 SSET (efound
, SBYTES (efound
) - 1, 0);
1019 result
= stat ((char *)SDATA (efound
), &s2
);
1020 SSET (efound
, SBYTES (efound
) - 1, 'c');
1023 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1025 /* Make the progress messages mention that source is newer. */
1028 /* If we won't print another message, mention this anyway. */
1029 if (!NILP (nomessage
))
1032 file
= Fsubstring (found
, make_number (0), make_number (-1));
1033 message_with_string ("Source file `%s' newer than byte-compiled file",
1041 /* We are loading a source file (*.el). */
1042 if (!NILP (Vload_source_file_function
))
1048 val
= call4 (Vload_source_file_function
, found
, file
,
1049 NILP (noerror
) ? Qnil
: Qt
,
1050 NILP (nomessage
) ? Qnil
: Qt
);
1051 return unbind_to (count
, val
);
1058 efound
= ENCODE_FILE (found
);
1059 stream
= fopen ((char *) SDATA (efound
), fmode
);
1061 #else /* not WINDOWSNT */
1062 stream
= fdopen (fd
, fmode
);
1063 #endif /* not WINDOWSNT */
1067 error ("Failure to create stdio stream for %s", SDATA (file
));
1070 if (! NILP (Vpurify_flag
))
1071 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1073 if (NILP (nomessage
))
1076 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1079 message_with_string ("Loading %s (source)...", file
, 1);
1081 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1083 else /* The typical case; compiled file newer than source file. */
1084 message_with_string ("Loading %s...", file
, 1);
1088 lispstream
= Fcons (Qnil
, Qnil
);
1089 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
1090 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
1091 record_unwind_protect (load_unwind
, lispstream
);
1092 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1093 specbind (Qload_file_name
, found
);
1094 specbind (Qinhibit_file_name_operation
, Qnil
);
1095 load_descriptor_list
1096 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1098 if (! version
|| version
>= 22)
1099 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
1102 /* We can't handle a file which was compiled with
1103 byte-compile-dynamic by older version of Emacs. */
1104 specbind (Qload_force_doc_strings
, Qt
);
1105 readevalloop (Qget_emacs_mule_file_char
, stream
, file
, Feval
, 0,
1108 unbind_to (count
, Qnil
);
1110 /* Run any load-hooks for this file. */
1111 temp
= Fassoc (file
, Vafter_load_alist
);
1113 Fprogn (Fcdr (temp
));
1116 if (saved_doc_string
)
1117 free (saved_doc_string
);
1118 saved_doc_string
= 0;
1119 saved_doc_string_size
= 0;
1121 if (prev_saved_doc_string
)
1122 xfree (prev_saved_doc_string
);
1123 prev_saved_doc_string
= 0;
1124 prev_saved_doc_string_size
= 0;
1126 if (!noninteractive
&& NILP (nomessage
))
1129 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1132 message_with_string ("Loading %s (source)...done", file
, 1);
1134 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1136 else /* The typical case; compiled file newer than source file. */
1137 message_with_string ("Loading %s...done", file
, 1);
1140 if (!NILP (Fequal (build_string ("obsolete"),
1141 Ffile_name_nondirectory
1142 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1143 message_with_string ("Package %s is obsolete", file
, 1);
1149 load_unwind (stream
) /* used as unwind-protect function in load */
1152 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
1153 | XFASTINT (XCDR (stream
))));
1154 if (--load_in_progress
< 0) load_in_progress
= 0;
1159 load_descriptor_unwind (oldlist
)
1160 Lisp_Object oldlist
;
1162 load_descriptor_list
= oldlist
;
1166 /* Close all descriptors in use for Floads.
1167 This is used when starting a subprocess. */
1174 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1175 emacs_close (XFASTINT (XCAR (tail
)));
1180 complete_filename_p (pathname
)
1181 Lisp_Object pathname
;
1183 register const unsigned char *s
= SDATA (pathname
);
1184 return (IS_DIRECTORY_SEP (s
[0])
1185 || (SCHARS (pathname
) > 2
1186 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1196 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1197 doc
: /* Search for FILENAME through PATH.
1198 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1199 file name when searching.
1200 If non-nil, PREDICATE is used instead of `file-readable-p'.
1201 PREDICATE can also be an integer to pass to the access(2) function,
1202 in which case file-name-handlers are ignored. */)
1203 (filename
, path
, suffixes
, predicate
)
1204 Lisp_Object filename
, path
, suffixes
, predicate
;
1207 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1208 if (NILP (predicate
) && fd
> 0)
1214 /* Search for a file whose name is STR, looking in directories
1215 in the Lisp list PATH, and trying suffixes from SUFFIX.
1216 On success, returns a file descriptor. On failure, returns -1.
1218 SUFFIXES is a list of strings containing possible suffixes.
1219 The empty suffix is automatically added iff the list is empty.
1221 PREDICATE non-nil means don't open the files,
1222 just look for one that satisfies the predicate. In this case,
1223 returns 1 on success. The predicate can be a lisp function or
1224 an integer to pass to `access' (in which case file-name-handlers
1227 If STOREPTR is nonzero, it points to a slot where the name of
1228 the file actually found should be stored as a Lisp string.
1229 nil is stored there on failure.
1231 If the file we find is remote, return -2
1232 but store the found remote file name in *STOREPTR. */
1235 openp (path
, str
, suffixes
, storeptr
, predicate
)
1236 Lisp_Object path
, str
;
1237 Lisp_Object suffixes
;
1238 Lisp_Object
*storeptr
;
1239 Lisp_Object predicate
;
1244 register char *fn
= buf
;
1247 Lisp_Object filename
;
1249 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1250 Lisp_Object string
, tail
, encoded_fn
;
1251 int max_suffix_len
= 0;
1255 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1257 CHECK_STRING_CAR (tail
);
1258 max_suffix_len
= max (max_suffix_len
,
1259 SBYTES (XCAR (tail
)));
1262 string
= filename
= Qnil
;
1263 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1268 if (complete_filename_p (str
))
1271 for (; CONSP (path
); path
= XCDR (path
))
1273 filename
= Fexpand_file_name (str
, XCAR (path
));
1274 if (!complete_filename_p (filename
))
1275 /* If there are non-absolute elts in PATH (eg ".") */
1276 /* Of course, this could conceivably lose if luser sets
1277 default-directory to be something non-absolute... */
1279 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1280 if (!complete_filename_p (filename
))
1281 /* Give up on this path element! */
1285 /* Calculate maximum size of any filename made from
1286 this path element/specified file name and any possible suffix. */
1287 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1288 if (fn_size
< want_size
)
1289 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1291 /* Loop over suffixes. */
1292 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1293 CONSP (tail
); tail
= XCDR (tail
))
1295 int lsuffix
= SBYTES (XCAR (tail
));
1296 Lisp_Object handler
;
1299 /* Concatenate path element/specified name with the suffix.
1300 If the directory starts with /:, remove that. */
1301 if (SCHARS (filename
) > 2
1302 && SREF (filename
, 0) == '/'
1303 && SREF (filename
, 1) == ':')
1305 strncpy (fn
, SDATA (filename
) + 2,
1306 SBYTES (filename
) - 2);
1307 fn
[SBYTES (filename
) - 2] = 0;
1311 strncpy (fn
, SDATA (filename
),
1313 fn
[SBYTES (filename
)] = 0;
1316 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1317 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1319 /* Check that the file exists and is not a directory. */
1320 /* We used to only check for handlers on non-absolute file names:
1324 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1325 It's not clear why that was the case and it breaks things like
1326 (load "/bar.el") where the file is actually "/bar.el.gz". */
1327 string
= build_string (fn
);
1328 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1329 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1331 if (NILP (predicate
))
1332 exists
= !NILP (Ffile_readable_p (string
));
1334 exists
= !NILP (call1 (predicate
, string
));
1335 if (exists
&& !NILP (Ffile_directory_p (string
)))
1340 /* We succeeded; return this descriptor and filename. */
1351 encoded_fn
= ENCODE_FILE (string
);
1352 pfn
= SDATA (encoded_fn
);
1353 exists
= (stat (pfn
, &st
) >= 0
1354 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1357 /* Check that we can access or open it. */
1358 if (NATNUMP (predicate
))
1359 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1361 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1365 /* We succeeded; return this descriptor and filename. */
1383 /* Merge the list we've accumulated of globals from the current input source
1384 into the load_history variable. The details depend on whether
1385 the source has an associated file name or not. */
1388 build_load_history (stream
, source
)
1392 register Lisp_Object tail
, prev
, newelt
;
1393 register Lisp_Object tem
, tem2
;
1394 register int foundit
, loading
;
1396 loading
= stream
|| !NARROWED
;
1398 tail
= Vload_history
;
1401 while (CONSP (tail
))
1405 /* Find the feature's previous assoc list... */
1406 if (!NILP (Fequal (source
, Fcar (tem
))))
1410 /* If we're loading, remove it. */
1414 Vload_history
= XCDR (tail
);
1416 Fsetcdr (prev
, XCDR (tail
));
1419 /* Otherwise, cons on new symbols that are not already members. */
1422 tem2
= Vcurrent_load_list
;
1424 while (CONSP (tem2
))
1426 newelt
= XCAR (tem2
);
1428 if (NILP (Fmember (newelt
, tem
)))
1429 Fsetcar (tail
, Fcons (XCAR (tem
),
1430 Fcons (newelt
, XCDR (tem
))));
1443 /* If we're loading, cons the new assoc onto the front of load-history,
1444 the most-recently-loaded position. Also do this if we didn't find
1445 an existing member for the current source. */
1446 if (loading
|| !foundit
)
1447 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1452 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1460 readevalloop_1 (old
)
1463 load_convert_to_unibyte
= ! NILP (old
);
1467 /* Signal an `end-of-file' error, if possible with file name
1471 end_of_file_error ()
1475 if (STRINGP (Vload_file_name
))
1476 data
= Fcons (Vload_file_name
, Qnil
);
1480 Fsignal (Qend_of_file
, data
);
1483 /* UNIBYTE specifies how to set load_convert_to_unibyte
1484 for this invocation.
1485 READFUN, if non-nil, is used instead of `read'. */
1488 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1489 Lisp_Object readcharfun
;
1491 Lisp_Object sourcename
;
1492 Lisp_Object (*evalfun
) ();
1494 Lisp_Object unibyte
, readfun
;
1497 register Lisp_Object val
;
1498 int count
= SPECPDL_INDEX ();
1499 struct gcpro gcpro1
;
1500 struct buffer
*b
= 0;
1501 int continue_reading_p
;
1503 if (BUFFERP (readcharfun
))
1504 b
= XBUFFER (readcharfun
);
1505 else if (MARKERP (readcharfun
))
1506 b
= XMARKER (readcharfun
)->buffer
;
1508 specbind (Qstandard_input
, readcharfun
);
1509 specbind (Qcurrent_load_list
, Qnil
);
1510 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1511 load_convert_to_unibyte
= !NILP (unibyte
);
1513 GCPRO1 (sourcename
);
1515 LOADHIST_ATTACH (sourcename
);
1517 continue_reading_p
= 1;
1518 while (continue_reading_p
)
1520 if (b
!= 0 && NILP (b
->name
))
1521 error ("Reading from killed buffer");
1527 while ((c
= READCHAR
) != '\n' && c
!= -1);
1532 /* Ignore whitespace here, so we can detect eof. */
1533 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1536 if (!NILP (Vpurify_flag
) && c
== '(')
1538 int count1
= SPECPDL_INDEX ();
1539 record_unwind_protect (unreadpure
, Qnil
);
1540 val
= read_list (-1, readcharfun
);
1541 unbind_to (count1
, Qnil
);
1546 read_objects
= Qnil
;
1547 if (!NILP (readfun
))
1549 val
= call1 (readfun
, readcharfun
);
1551 /* If READCHARFUN has set point to ZV, we should
1552 stop reading, even if the form read sets point
1553 to a different value when evaluated. */
1554 if (BUFFERP (readcharfun
))
1556 struct buffer
*b
= XBUFFER (readcharfun
);
1557 if (BUF_PT (b
) == BUF_ZV (b
))
1558 continue_reading_p
= 0;
1561 else if (! NILP (Vload_read_function
))
1562 val
= call1 (Vload_read_function
, readcharfun
);
1564 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1567 val
= (*evalfun
) (val
);
1571 Vvalues
= Fcons (val
, Vvalues
);
1572 if (EQ (Vstandard_output
, Qt
))
1579 build_load_history (stream
, sourcename
);
1582 unbind_to (count
, Qnil
);
1585 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1586 doc
: /* Execute the current buffer as Lisp code.
1587 Programs can pass two arguments, BUFFER and PRINTFLAG.
1588 BUFFER is the buffer to evaluate (nil means use current buffer).
1589 PRINTFLAG controls printing of output:
1590 nil means discard it; anything else is stream for print.
1592 If the optional third argument FILENAME is non-nil,
1593 it specifies the file name to use for `load-history'.
1594 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1595 for this invocation.
1597 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1598 `print' and related functions should work normally even if PRINTFLAG is nil.
1600 This function preserves the position of point. */)
1601 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1602 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1604 int count
= SPECPDL_INDEX ();
1605 Lisp_Object tem
, buf
;
1608 buf
= Fcurrent_buffer ();
1610 buf
= Fget_buffer (buffer
);
1612 error ("No such buffer");
1614 if (NILP (printflag
) && NILP (do_allow_print
))
1619 if (NILP (filename
))
1620 filename
= XBUFFER (buf
)->filename
;
1622 specbind (Qstandard_output
, tem
);
1623 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1624 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1625 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1626 unbind_to (count
, Qnil
);
1631 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1632 doc
: /* Execute the region as Lisp code.
1633 When called from programs, expects two arguments,
1634 giving starting and ending indices in the current buffer
1635 of the text to be executed.
1636 Programs can pass third argument PRINTFLAG which controls output:
1637 nil means discard it; anything else is stream for printing it.
1638 Also the fourth argument READ-FUNCTION, if non-nil, is used
1639 instead of `read' to read each expression. It gets one argument
1640 which is the input stream for reading characters.
1642 This function does not move point. */)
1643 (start
, end
, printflag
, read_function
)
1644 Lisp_Object start
, end
, printflag
, read_function
;
1646 int count
= SPECPDL_INDEX ();
1647 Lisp_Object tem
, cbuf
;
1649 cbuf
= Fcurrent_buffer ();
1651 if (NILP (printflag
))
1655 specbind (Qstandard_output
, tem
);
1657 if (NILP (printflag
))
1658 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1659 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1661 /* This both uses start and checks its type. */
1663 Fnarrow_to_region (make_number (BEGV
), end
);
1664 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1665 !NILP (printflag
), Qnil
, read_function
);
1667 return unbind_to (count
, Qnil
);
1671 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1672 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1673 If STREAM is nil, use the value of `standard-input' (which see).
1674 STREAM or the value of `standard-input' may be:
1675 a buffer (read from point and advance it)
1676 a marker (read from where it points and advance it)
1677 a function (call it with no arguments for each character,
1678 call it with a char as argument to push a char back)
1679 a string (takes text from string, starting at the beginning)
1680 t (read text line using minibuffer and use it, or read from
1681 standard input in batch mode). */)
1686 stream
= Vstandard_input
;
1687 if (EQ (stream
, Qt
))
1688 stream
= Qread_char
;
1689 if (EQ (stream
, Qread_char
))
1690 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1692 return read_internal_start (stream
, Qnil
, Qnil
);
1695 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1696 doc
: /* Read one Lisp expression which is represented as text by STRING.
1697 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1698 START and END optionally delimit a substring of STRING from which to read;
1699 they default to 0 and (length STRING) respectively. */)
1700 (string
, start
, end
)
1701 Lisp_Object string
, start
, end
;
1704 CHECK_STRING (string
);
1705 /* read_internal_start sets read_from_string_index. */
1706 ret
= read_internal_start (string
, start
, end
);
1707 return Fcons (ret
, make_number (read_from_string_index
));
1710 /* Function to set up the global context we need in toplevel read
1713 read_internal_start (stream
, start
, end
)
1715 Lisp_Object start
; /* Only used when stream is a string. */
1716 Lisp_Object end
; /* Only used when stream is a string. */
1721 new_backquote_flag
= 0;
1722 read_objects
= Qnil
;
1723 if (EQ (Vread_with_symbol_positions
, Qt
)
1724 || EQ (Vread_with_symbol_positions
, stream
))
1725 Vread_symbol_positions_list
= Qnil
;
1727 if (STRINGP (stream
)
1728 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1730 int startval
, endval
;
1733 if (STRINGP (stream
))
1736 string
= XCAR (stream
);
1739 endval
= SCHARS (string
);
1743 endval
= XINT (end
);
1744 if (endval
< 0 || endval
> SCHARS (string
))
1745 args_out_of_range (string
, end
);
1752 CHECK_NUMBER (start
);
1753 startval
= XINT (start
);
1754 if (startval
< 0 || startval
> endval
)
1755 args_out_of_range (string
, start
);
1757 read_from_string_index
= startval
;
1758 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1759 read_from_string_limit
= endval
;
1762 retval
= read0 (stream
);
1763 if (EQ (Vread_with_symbol_positions
, Qt
)
1764 || EQ (Vread_with_symbol_positions
, stream
))
1765 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1769 /* Use this for recursive reads, in contexts where internal tokens
1774 Lisp_Object readcharfun
;
1776 register Lisp_Object val
;
1779 val
= read1 (readcharfun
, &c
, 0);
1781 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1788 static int read_buffer_size
;
1789 static char *read_buffer
;
1791 /* Read a \-escape sequence, assuming we already read the `\'.
1792 If the escape sequence forces unibyte, return eight-bit char. */
1795 read_escape (readcharfun
, stringp
)
1796 Lisp_Object readcharfun
;
1799 register int c
= READCHAR
;
1804 end_of_file_error ();
1834 error ("Invalid escape character syntax");
1837 c
= read_escape (readcharfun
, 0);
1838 return c
| meta_modifier
;
1843 error ("Invalid escape character syntax");
1846 c
= read_escape (readcharfun
, 0);
1847 return c
| shift_modifier
;
1852 error ("Invalid escape character syntax");
1855 c
= read_escape (readcharfun
, 0);
1856 return c
| hyper_modifier
;
1861 error ("Invalid escape character syntax");
1864 c
= read_escape (readcharfun
, 0);
1865 return c
| alt_modifier
;
1877 c
= read_escape (readcharfun
, 0);
1878 return c
| super_modifier
;
1883 error ("Invalid escape character syntax");
1887 c
= read_escape (readcharfun
, 0);
1888 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1889 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1890 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1891 return c
| ctrl_modifier
;
1892 /* ASCII control chars are made from letters (both cases),
1893 as well as the non-letters within 0100...0137. */
1894 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1895 return (c
& (037 | ~0177));
1896 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1897 return (c
& (037 | ~0177));
1899 return c
| ctrl_modifier
;
1909 /* An octal escape, as in ANSI C. */
1911 register int i
= c
- '0';
1912 register int count
= 0;
1915 if ((c
= READCHAR
) >= '0' && c
<= '7')
1927 if (i
>= 0x80 && i
< 0x100)
1928 i
= BYTE8_TO_CHAR (i
);
1933 /* A hex escape, as in ANSI C. */
1940 if (c
>= '0' && c
<= '9')
1945 else if ((c
>= 'a' && c
<= 'f')
1946 || (c
>= 'A' && c
<= 'F'))
1949 if (c
>= 'a' && c
<= 'f')
1962 if (count
< 3 && i
>= 0x80)
1963 return BYTE8_TO_CHAR (i
);
1973 /* Read an integer in radix RADIX using READCHARFUN to read
1974 characters. RADIX must be in the interval [2..36]; if it isn't, a
1975 read error is signaled . Value is the integer read. Signals an
1976 error if encountering invalid read syntax or if RADIX is out of
1980 read_integer (readcharfun
, radix
)
1981 Lisp_Object readcharfun
;
1984 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1985 EMACS_INT number
= 0;
1987 if (radix
< 2 || radix
> 36)
1991 number
= ndigits
= invalid_p
= 0;
2007 if (c
>= '0' && c
<= '9')
2009 else if (c
>= 'a' && c
<= 'z')
2010 digit
= c
- 'a' + 10;
2011 else if (c
>= 'A' && c
<= 'Z')
2012 digit
= c
- 'A' + 10;
2019 if (digit
< 0 || digit
>= radix
)
2022 number
= radix
* number
+ digit
;
2028 if (ndigits
== 0 || invalid_p
)
2031 sprintf (buf
, "integer, radix %d", radix
);
2032 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
2035 return make_number (sign
* number
);
2039 /* If the next token is ')' or ']' or '.', we store that character
2040 in *PCH and the return value is not interesting. Else, we store
2041 zero in *PCH and we read and return one lisp object.
2043 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2046 read1 (readcharfun
, pch
, first_in_list
)
2047 register Lisp_Object readcharfun
;
2052 int uninterned_symbol
= 0;
2061 end_of_file_error ();
2066 return read_list (0, readcharfun
);
2069 return read_vector (readcharfun
, 0);
2086 tmp
= read_vector (readcharfun
, 0);
2087 if (XVECTOR (tmp
)->size
< VECSIZE (struct Lisp_Char_Table
))
2088 error ("Invalid size char-table");
2089 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2100 tmp
= read_vector (readcharfun
, 0);
2101 if (!INTEGERP (AREF (tmp
, 0)))
2102 error ("Invalid depth in char-table");
2103 depth
= XINT (AREF (tmp
, 0));
2104 if (depth
< 1 || depth
> 3)
2105 error ("Invalid depth in char-table");
2106 size
= XVECTOR (tmp
)->size
- 2;
2107 if (chartab_size
[depth
] != size
)
2108 error ("Invalid size char-table");
2109 XSETSUB_CHAR_TABLE (tmp
, XSUB_CHAR_TABLE (tmp
));
2112 Fsignal (Qinvalid_read_syntax
,
2113 Fcons (make_string ("#^^", 3), Qnil
));
2115 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2120 length
= read1 (readcharfun
, pch
, first_in_list
);
2124 Lisp_Object tmp
, val
;
2126 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2127 / BOOL_VECTOR_BITS_PER_CHAR
);
2130 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2131 if (STRING_MULTIBYTE (tmp
)
2132 || (size_in_chars
!= SCHARS (tmp
)
2133 /* We used to print 1 char too many
2134 when the number of bits was a multiple of 8.
2135 Accept such input in case it came from an old
2137 && ! (XFASTINT (length
)
2138 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2139 Fsignal (Qinvalid_read_syntax
,
2140 Fcons (make_string ("#&...", 5), Qnil
));
2142 val
= Fmake_bool_vector (length
, Qnil
);
2143 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2145 /* Clear the extraneous bits in the last byte. */
2146 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2147 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2148 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2151 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2156 /* Accept compiled functions at read-time so that we don't have to
2157 build them using function calls. */
2159 tmp
= read_vector (readcharfun
, 1);
2160 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2161 XVECTOR (tmp
)->contents
);
2166 struct gcpro gcpro1
;
2169 /* Read the string itself. */
2170 tmp
= read1 (readcharfun
, &ch
, 0);
2171 if (ch
!= 0 || !STRINGP (tmp
))
2172 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2174 /* Read the intervals and their properties. */
2177 Lisp_Object beg
, end
, plist
;
2179 beg
= read1 (readcharfun
, &ch
, 0);
2184 end
= read1 (readcharfun
, &ch
, 0);
2186 plist
= read1 (readcharfun
, &ch
, 0);
2188 Fsignal (Qinvalid_read_syntax
,
2189 Fcons (build_string ("invalid string property list"),
2191 Fset_text_properties (beg
, end
, plist
, tmp
);
2197 /* #@NUMBER is used to skip NUMBER following characters.
2198 That's used in .elc files to skip over doc strings
2199 and function definitions. */
2205 /* Read a decimal integer. */
2206 while ((c
= READCHAR
) >= 0
2207 && c
>= '0' && c
<= '9')
2215 if (load_force_doc_strings
2216 && (EQ (readcharfun
, Qget_file_char
)
2217 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2219 /* If we are supposed to force doc strings into core right now,
2220 record the last string that we skipped,
2221 and record where in the file it comes from. */
2223 /* But first exchange saved_doc_string
2224 with prev_saved_doc_string, so we save two strings. */
2226 char *temp
= saved_doc_string
;
2227 int temp_size
= saved_doc_string_size
;
2228 file_offset temp_pos
= saved_doc_string_position
;
2229 int temp_len
= saved_doc_string_length
;
2231 saved_doc_string
= prev_saved_doc_string
;
2232 saved_doc_string_size
= prev_saved_doc_string_size
;
2233 saved_doc_string_position
= prev_saved_doc_string_position
;
2234 saved_doc_string_length
= prev_saved_doc_string_length
;
2236 prev_saved_doc_string
= temp
;
2237 prev_saved_doc_string_size
= temp_size
;
2238 prev_saved_doc_string_position
= temp_pos
;
2239 prev_saved_doc_string_length
= temp_len
;
2242 if (saved_doc_string_size
== 0)
2244 saved_doc_string_size
= nskip
+ 100;
2245 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2247 if (nskip
> saved_doc_string_size
)
2249 saved_doc_string_size
= nskip
+ 100;
2250 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2251 saved_doc_string_size
);
2254 saved_doc_string_position
= file_tell (instream
);
2256 /* Copy that many characters into saved_doc_string. */
2257 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2258 saved_doc_string
[i
] = c
= READCHAR
;
2260 saved_doc_string_length
= i
;
2264 /* Skip that many characters. */
2265 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2274 /* #! appears at the beginning of an executable file.
2275 Skip the first line. */
2276 while (c
!= '\n' && c
>= 0)
2281 return Vload_file_name
;
2283 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2284 /* #:foo is the uninterned symbol named foo. */
2287 uninterned_symbol
= 1;
2291 /* Reader forms that can reuse previously read objects. */
2292 if (c
>= '0' && c
<= '9')
2297 /* Read a non-negative integer. */
2298 while (c
>= '0' && c
<= '9')
2304 /* #n=object returns object, but associates it with n for #n#. */
2307 /* Make a placeholder for #n# to use temporarily */
2308 Lisp_Object placeholder
;
2311 placeholder
= Fcons(Qnil
, Qnil
);
2312 cell
= Fcons (make_number (n
), placeholder
);
2313 read_objects
= Fcons (cell
, read_objects
);
2315 /* Read the object itself. */
2316 tem
= read0 (readcharfun
);
2318 /* Now put it everywhere the placeholder was... */
2319 substitute_object_in_subtree (tem
, placeholder
);
2321 /* ...and #n# will use the real value from now on. */
2322 Fsetcdr (cell
, tem
);
2326 /* #n# returns a previously read object. */
2329 tem
= Fassq (make_number (n
), read_objects
);
2332 /* Fall through to error message. */
2334 else if (c
== 'r' || c
== 'R')
2335 return read_integer (readcharfun
, n
);
2337 /* Fall through to error message. */
2339 else if (c
== 'x' || c
== 'X')
2340 return read_integer (readcharfun
, 16);
2341 else if (c
== 'o' || c
== 'O')
2342 return read_integer (readcharfun
, 8);
2343 else if (c
== 'b' || c
== 'B')
2344 return read_integer (readcharfun
, 2);
2347 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2350 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2355 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2365 new_backquote_flag
++;
2366 value
= read0 (readcharfun
);
2367 new_backquote_flag
--;
2369 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2373 if (new_backquote_flag
)
2375 Lisp_Object comma_type
= Qnil
;
2380 comma_type
= Qcomma_at
;
2382 comma_type
= Qcomma_dot
;
2385 if (ch
>= 0) UNREAD (ch
);
2386 comma_type
= Qcomma
;
2389 new_backquote_flag
--;
2390 value
= read0 (readcharfun
);
2391 new_backquote_flag
++;
2392 return Fcons (comma_type
, Fcons (value
, Qnil
));
2405 end_of_file_error ();
2407 /* Accept `single space' syntax like (list ? x) where the
2408 whitespace character is SPC or TAB.
2409 Other literal whitespace like NL, CR, and FF are not accepted,
2410 as there are well-established escape sequences for these. */
2411 if (c
== ' ' || c
== '\t')
2412 return make_number (c
);
2415 c
= read_escape (readcharfun
, 0);
2416 modifiers
= c
& CHAR_MODIFIER_MASK
;
2417 c
&= ~CHAR_MODIFIER_MASK
;
2418 if (CHAR_BYTE8_P (c
))
2419 c
= CHAR_TO_BYTE8 (c
);
2422 next_char
= READCHAR
;
2423 if (next_char
== '.')
2425 /* Only a dotted-pair dot is valid after a char constant. */
2426 int next_next_char
= READCHAR
;
2427 UNREAD (next_next_char
);
2429 ok
= (next_next_char
<= 040
2430 || (next_next_char
< 0200
2431 && (index ("\"';([#?", next_next_char
)
2432 || (!first_in_list
&& next_next_char
== '`')
2433 || (new_backquote_flag
&& next_next_char
== ','))));
2437 ok
= (next_char
<= 040
2438 || (next_char
< 0200
2439 && (index ("\"';()[]#?", next_char
)
2440 || (!first_in_list
&& next_char
== '`')
2441 || (new_backquote_flag
&& next_char
== ','))));
2445 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2447 return make_number (c
);
2452 char *p
= read_buffer
;
2453 char *end
= read_buffer
+ read_buffer_size
;
2455 /* Nonzero if we saw an escape sequence specifying
2456 a multibyte character. */
2457 int force_multibyte
= 0;
2458 /* Nonzero if we saw an escape sequence specifying
2459 a single-byte character. */
2460 int force_singlebyte
= 0;
2464 while ((c
= READCHAR
) >= 0
2467 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2469 int offset
= p
- read_buffer
;
2470 read_buffer
= (char *) xrealloc (read_buffer
,
2471 read_buffer_size
*= 2);
2472 p
= read_buffer
+ offset
;
2473 end
= read_buffer
+ read_buffer_size
;
2480 c
= read_escape (readcharfun
, 1);
2482 /* C is -1 if \ newline has just been seen */
2485 if (p
== read_buffer
)
2490 modifiers
= c
& CHAR_MODIFIER_MASK
;
2491 c
= c
& ~CHAR_MODIFIER_MASK
;
2493 if (CHAR_BYTE8_P (c
))
2494 force_singlebyte
= 1;
2495 else if (! ASCII_CHAR_P (c
))
2496 force_multibyte
= 1;
2497 else /* i.e. ASCII_CHAR_P (c) */
2499 /* Allow `\C- ' and `\C-?'. */
2500 if (modifiers
== CHAR_CTL
)
2503 c
= 0, modifiers
= 0;
2505 c
= 127, modifiers
= 0;
2507 if (modifiers
& CHAR_SHIFT
)
2509 /* Shift modifier is valid only with [A-Za-z]. */
2510 if (c
>= 'A' && c
<= 'Z')
2511 modifiers
&= ~CHAR_SHIFT
;
2512 else if (c
>= 'a' && c
<= 'z')
2513 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2516 if (modifiers
& CHAR_META
)
2518 /* Move the meta bit to the right place for a
2520 modifiers
&= ~CHAR_META
;
2521 c
= BYTE8_TO_CHAR (c
| 0x80);
2522 force_singlebyte
= 1;
2526 /* Any modifiers remaining are invalid. */
2528 error ("Invalid modifier in string");
2529 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2533 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2534 if (CHAR_BYTE8_P (c
))
2535 force_singlebyte
= 1;
2536 else if (! ASCII_CHAR_P (c
))
2537 force_multibyte
= 1;
2543 end_of_file_error ();
2545 /* If purifying, and string starts with \ newline,
2546 return zero instead. This is for doc strings
2547 that we are really going to find in etc/DOC.nn.nn */
2548 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2549 return make_number (0);
2551 if (force_multibyte
)
2552 /* READ_BUFFER already contains valid multibyte forms. */
2554 else if (force_singlebyte
)
2556 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2557 p
= read_buffer
+ nchars
;
2560 /* Otherwise, READ_BUFFER contains only ASCII. */
2563 /* We want readchar_count to be the number of characters, not
2564 bytes. Hence we adjust for multibyte characters in the
2565 string. ... But it doesn't seem to be necessary, because
2566 READCHAR *does* read multibyte characters from buffers. */
2567 /* readchar_count -= (p - read_buffer) - nchars; */
2569 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2571 || (p
- read_buffer
!= nchars
)));
2572 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2574 || (p
- read_buffer
!= nchars
)));
2579 int next_char
= READCHAR
;
2582 if (next_char
<= 040
2583 || (next_char
< 0200
2584 && index ("\"';([#?", next_char
)
2585 || (!first_in_list
&& next_char
== '`')
2586 || (new_backquote_flag
&& next_char
== ',')))
2592 /* Otherwise, we fall through! Note that the atom-reading loop
2593 below will now loop at least once, assuring that we will not
2594 try to UNREAD two characters in a row. */
2598 if (c
<= 040) goto retry
;
2600 char *p
= read_buffer
;
2604 char *end
= read_buffer
+ read_buffer_size
;
2608 || (!index ("\"';()[]#", c
)
2609 && !(!first_in_list
&& c
== '`')
2610 && !(new_backquote_flag
&& c
== ','))))
2612 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2614 int offset
= p
- read_buffer
;
2615 read_buffer
= (char *) xrealloc (read_buffer
,
2616 read_buffer_size
*= 2);
2617 p
= read_buffer
+ offset
;
2618 end
= read_buffer
+ read_buffer_size
;
2625 end_of_file_error ();
2629 p
+= CHAR_STRING (c
, p
);
2635 int offset
= p
- read_buffer
;
2636 read_buffer
= (char *) xrealloc (read_buffer
,
2637 read_buffer_size
*= 2);
2638 p
= read_buffer
+ offset
;
2639 end
= read_buffer
+ read_buffer_size
;
2646 if (!quoted
&& !uninterned_symbol
)
2649 register Lisp_Object val
;
2651 if (*p1
== '+' || *p1
== '-') p1
++;
2652 /* Is it an integer? */
2655 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2656 /* Integers can have trailing decimal points. */
2657 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2659 /* It is an integer. */
2663 /* Fixme: if we have strtol, use that, and check
2665 if (sizeof (int) == sizeof (EMACS_INT
))
2666 XSETINT (val
, atoi (read_buffer
));
2667 else if (sizeof (long) == sizeof (EMACS_INT
))
2668 XSETINT (val
, atol (read_buffer
));
2674 if (isfloat_string (read_buffer
))
2676 /* Compute NaN and infinities using 0.0 in a variable,
2677 to cope with compilers that think they are smarter
2683 /* Negate the value ourselves. This treats 0, NaNs,
2684 and infinity properly on IEEE floating point hosts,
2685 and works around a common bug where atof ("-0.0")
2687 int negative
= read_buffer
[0] == '-';
2689 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2690 returns 1, is if the input ends in e+INF or e+NaN. */
2697 value
= zero
/ zero
;
2700 value
= atof (read_buffer
+ negative
);
2704 return make_float (negative
? - value
: value
);
2708 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2709 : intern (read_buffer
);
2710 if (EQ (Vread_with_symbol_positions
, Qt
)
2711 || EQ (Vread_with_symbol_positions
, readcharfun
))
2712 Vread_symbol_positions_list
=
2713 /* Kind of a hack; this will probably fail if characters
2714 in the symbol name were escaped. Not really a big
2716 Fcons (Fcons (result
,
2717 make_number (readchar_count
2718 - XFASTINT (Flength (Fsymbol_name (result
))))),
2719 Vread_symbol_positions_list
);
2727 /* List of nodes we've seen during substitute_object_in_subtree. */
2728 static Lisp_Object seen_list
;
2731 substitute_object_in_subtree (object
, placeholder
)
2733 Lisp_Object placeholder
;
2735 Lisp_Object check_object
;
2737 /* We haven't seen any objects when we start. */
2740 /* Make all the substitutions. */
2742 = substitute_object_recurse (object
, placeholder
, object
);
2744 /* Clear seen_list because we're done with it. */
2747 /* The returned object here is expected to always eq the
2749 if (!EQ (check_object
, object
))
2750 error ("Unexpected mutation error in reader");
2753 /* Feval doesn't get called from here, so no gc protection is needed. */
2754 #define SUBSTITUTE(get_val, set_val) \
2756 Lisp_Object old_value = get_val; \
2757 Lisp_Object true_value \
2758 = substitute_object_recurse (object, placeholder,\
2761 if (!EQ (old_value, true_value)) \
2768 substitute_object_recurse (object
, placeholder
, subtree
)
2770 Lisp_Object placeholder
;
2771 Lisp_Object subtree
;
2773 /* If we find the placeholder, return the target object. */
2774 if (EQ (placeholder
, subtree
))
2777 /* If we've been to this node before, don't explore it again. */
2778 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2781 /* If this node can be the entry point to a cycle, remember that
2782 we've seen it. It can only be such an entry point if it was made
2783 by #n=, which means that we can find it as a value in
2785 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2786 seen_list
= Fcons (subtree
, seen_list
);
2788 /* Recurse according to subtree's type.
2789 Every branch must return a Lisp_Object. */
2790 switch (XTYPE (subtree
))
2792 case Lisp_Vectorlike
:
2795 int length
= XINT (Flength(subtree
));
2796 for (i
= 0; i
< length
; i
++)
2798 Lisp_Object idx
= make_number (i
);
2799 SUBSTITUTE (Faref (subtree
, idx
),
2800 Faset (subtree
, idx
, true_value
));
2807 SUBSTITUTE (Fcar_safe (subtree
),
2808 Fsetcar (subtree
, true_value
));
2809 SUBSTITUTE (Fcdr_safe (subtree
),
2810 Fsetcdr (subtree
, true_value
));
2816 /* Check for text properties in each interval.
2817 substitute_in_interval contains part of the logic. */
2819 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2820 Lisp_Object arg
= Fcons (object
, placeholder
);
2822 traverse_intervals_noorder (root_interval
,
2823 &substitute_in_interval
, arg
);
2828 /* Other types don't recurse any further. */
2834 /* Helper function for substitute_object_recurse. */
2836 substitute_in_interval (interval
, arg
)
2840 Lisp_Object object
= Fcar (arg
);
2841 Lisp_Object placeholder
= Fcdr (arg
);
2843 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2862 if (*cp
== '+' || *cp
== '-')
2865 if (*cp
>= '0' && *cp
<= '9')
2868 while (*cp
>= '0' && *cp
<= '9')
2876 if (*cp
>= '0' && *cp
<= '9')
2879 while (*cp
>= '0' && *cp
<= '9')
2882 if (*cp
== 'e' || *cp
== 'E')
2886 if (*cp
== '+' || *cp
== '-')
2890 if (*cp
>= '0' && *cp
<= '9')
2893 while (*cp
>= '0' && *cp
<= '9')
2896 else if (cp
== start
)
2898 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2903 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2909 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2910 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2911 || state
== (DOT_CHAR
|TRAIL_INT
)
2912 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2913 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2914 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2919 read_vector (readcharfun
, bytecodeflag
)
2920 Lisp_Object readcharfun
;
2925 register Lisp_Object
*ptr
;
2926 register Lisp_Object tem
, item
, vector
;
2927 register struct Lisp_Cons
*otem
;
2930 tem
= read_list (1, readcharfun
);
2931 len
= Flength (tem
);
2932 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2934 size
= XVECTOR (vector
)->size
;
2935 ptr
= XVECTOR (vector
)->contents
;
2936 for (i
= 0; i
< size
; i
++)
2939 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2940 bytecode object, the docstring containing the bytecode and
2941 constants values must be treated as unibyte and passed to
2942 Fread, to get the actual bytecode string and constants vector. */
2943 if (bytecodeflag
&& load_force_doc_strings
)
2945 if (i
== COMPILED_BYTECODE
)
2947 if (!STRINGP (item
))
2948 error ("invalid byte code");
2950 /* Delay handling the bytecode slot until we know whether
2951 it is lazily-loaded (we can tell by whether the
2952 constants slot is nil). */
2953 ptr
[COMPILED_CONSTANTS
] = item
;
2956 else if (i
== COMPILED_CONSTANTS
)
2958 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2962 /* Coerce string to unibyte (like string-as-unibyte,
2963 but without generating extra garbage and
2964 guaranteeing no change in the contents). */
2965 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2966 STRING_SET_UNIBYTE (bytestr
);
2968 item
= Fread (Fcons (bytestr
, readcharfun
));
2970 error ("invalid byte code");
2972 otem
= XCONS (item
);
2973 bytestr
= XCAR (item
);
2978 /* Now handle the bytecode slot. */
2979 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2981 else if (i
== COMPILED_DOC_STRING
2983 && ! STRING_MULTIBYTE (item
))
2985 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
2986 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
2988 item
= Fstring_as_multibyte (item
);
2991 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2999 /* FLAG = 1 means check for ] to terminate rather than ) and .
3000 FLAG = -1 means check for starting with defun
3001 and make structure pure. */
3004 read_list (flag
, readcharfun
)
3006 register Lisp_Object readcharfun
;
3008 /* -1 means check next element for defun,
3009 0 means don't check,
3010 1 means already checked and found defun. */
3011 int defunflag
= flag
< 0 ? -1 : 0;
3012 Lisp_Object val
, tail
;
3013 register Lisp_Object elt
, tem
;
3014 struct gcpro gcpro1
, gcpro2
;
3015 /* 0 is the normal case.
3016 1 means this list is a doc reference; replace it with the number 0.
3017 2 means this list is a doc reference; replace it with the doc string. */
3018 int doc_reference
= 0;
3020 /* Initialize this to 1 if we are reading a list. */
3021 int first_in_list
= flag
<= 0;
3030 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3035 /* While building, if the list starts with #$, treat it specially. */
3036 if (EQ (elt
, Vload_file_name
)
3038 && !NILP (Vpurify_flag
))
3040 if (NILP (Vdoc_file_name
))
3041 /* We have not yet called Snarf-documentation, so assume
3042 this file is described in the DOC-MM.NN file
3043 and Snarf-documentation will fill in the right value later.
3044 For now, replace the whole list with 0. */
3047 /* We have already called Snarf-documentation, so make a relative
3048 file name for this file, so it can be found properly
3049 in the installed Lisp directory.
3050 We don't use Fexpand_file_name because that would make
3051 the directory absolute now. */
3052 elt
= concat2 (build_string ("../lisp/"),
3053 Ffile_name_nondirectory (elt
));
3055 else if (EQ (elt
, Vload_file_name
)
3057 && load_force_doc_strings
)
3066 Fsignal (Qinvalid_read_syntax
,
3067 Fcons (make_string (") or . in a vector", 18), Qnil
));
3075 XSETCDR (tail
, read0 (readcharfun
));
3077 val
= read0 (readcharfun
);
3078 read1 (readcharfun
, &ch
, 0);
3082 if (doc_reference
== 1)
3083 return make_number (0);
3084 if (doc_reference
== 2)
3086 /* Get a doc string from the file we are loading.
3087 If it's in saved_doc_string, get it from there.
3089 Here, we don't know if the string is a
3090 bytecode string or a doc string. As a
3091 bytecode string must be unibyte, we always
3092 return a unibyte string. If it is actually a
3093 doc string, caller must make it
3096 int pos
= XINT (XCDR (val
));
3097 /* Position is negative for user variables. */
3098 if (pos
< 0) pos
= -pos
;
3099 if (pos
>= saved_doc_string_position
3100 && pos
< (saved_doc_string_position
3101 + saved_doc_string_length
))
3103 int start
= pos
- saved_doc_string_position
;
3106 /* Process quoting with ^A,
3107 and find the end of the string,
3108 which is marked with ^_ (037). */
3109 for (from
= start
, to
= start
;
3110 saved_doc_string
[from
] != 037;)
3112 int c
= saved_doc_string
[from
++];
3115 c
= saved_doc_string
[from
++];
3117 saved_doc_string
[to
++] = c
;
3119 saved_doc_string
[to
++] = 0;
3121 saved_doc_string
[to
++] = 037;
3124 saved_doc_string
[to
++] = c
;
3127 return make_unibyte_string (saved_doc_string
+ start
,
3130 /* Look in prev_saved_doc_string the same way. */
3131 else if (pos
>= prev_saved_doc_string_position
3132 && pos
< (prev_saved_doc_string_position
3133 + prev_saved_doc_string_length
))
3135 int start
= pos
- prev_saved_doc_string_position
;
3138 /* Process quoting with ^A,
3139 and find the end of the string,
3140 which is marked with ^_ (037). */
3141 for (from
= start
, to
= start
;
3142 prev_saved_doc_string
[from
] != 037;)
3144 int c
= prev_saved_doc_string
[from
++];
3147 c
= prev_saved_doc_string
[from
++];
3149 prev_saved_doc_string
[to
++] = c
;
3151 prev_saved_doc_string
[to
++] = 0;
3153 prev_saved_doc_string
[to
++] = 037;
3156 prev_saved_doc_string
[to
++] = c
;
3159 return make_unibyte_string (prev_saved_doc_string
3164 return get_doc_string (val
, 1, 0);
3169 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3171 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3173 tem
= (read_pure
&& flag
<= 0
3174 ? pure_cons (elt
, Qnil
)
3175 : Fcons (elt
, Qnil
));
3177 XSETCDR (tail
, tem
);
3182 defunflag
= EQ (elt
, Qdefun
);
3183 else if (defunflag
> 0)
3188 Lisp_Object Vobarray
;
3189 Lisp_Object initial_obarray
;
3191 /* oblookup stores the bucket number here, for the sake of Funintern. */
3193 int oblookup_last_bucket_number
;
3195 static int hash_string ();
3197 /* Get an error if OBARRAY is not an obarray.
3198 If it is one, return it. */
3201 check_obarray (obarray
)
3202 Lisp_Object obarray
;
3204 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3206 /* If Vobarray is now invalid, force it to be valid. */
3207 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3209 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3214 /* Intern the C string STR: return a symbol with that name,
3215 interned in the current obarray. */
3222 int len
= strlen (str
);
3223 Lisp_Object obarray
;
3226 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3227 obarray
= check_obarray (obarray
);
3228 tem
= oblookup (obarray
, str
, len
, len
);
3231 return Fintern (make_string (str
, len
), obarray
);
3234 /* Create an uninterned symbol with name STR. */
3240 int len
= strlen (str
);
3242 return Fmake_symbol ((!NILP (Vpurify_flag
)
3243 ? make_pure_string (str
, len
, len
, 0)
3244 : make_string (str
, len
)));
3247 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3248 doc
: /* Return the canonical symbol whose name is STRING.
3249 If there is none, one is created by this function and returned.
3250 A second optional argument specifies the obarray to use;
3251 it defaults to the value of `obarray'. */)
3253 Lisp_Object string
, obarray
;
3255 register Lisp_Object tem
, sym
, *ptr
;
3257 if (NILP (obarray
)) obarray
= Vobarray
;
3258 obarray
= check_obarray (obarray
);
3260 CHECK_STRING (string
);
3262 tem
= oblookup (obarray
, SDATA (string
),
3265 if (!INTEGERP (tem
))
3268 if (!NILP (Vpurify_flag
))
3269 string
= Fpurecopy (string
);
3270 sym
= Fmake_symbol (string
);
3272 if (EQ (obarray
, initial_obarray
))
3273 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3275 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3277 if ((SREF (string
, 0) == ':')
3278 && EQ (obarray
, initial_obarray
))
3280 XSYMBOL (sym
)->constant
= 1;
3281 XSYMBOL (sym
)->value
= sym
;
3284 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3286 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3288 XSYMBOL (sym
)->next
= 0;
3293 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3294 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3295 NAME may be a string or a symbol. If it is a symbol, that exact
3296 symbol is searched for.
3297 A second optional argument specifies the obarray to use;
3298 it defaults to the value of `obarray'. */)
3300 Lisp_Object name
, obarray
;
3302 register Lisp_Object tem
, string
;
3304 if (NILP (obarray
)) obarray
= Vobarray
;
3305 obarray
= check_obarray (obarray
);
3307 if (!SYMBOLP (name
))
3309 CHECK_STRING (name
);
3313 string
= SYMBOL_NAME (name
);
3315 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3316 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3322 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3323 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3324 The value is t if a symbol was found and deleted, nil otherwise.
3325 NAME may be a string or a symbol. If it is a symbol, that symbol
3326 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3327 OBARRAY defaults to the value of the variable `obarray'. */)
3329 Lisp_Object name
, obarray
;
3331 register Lisp_Object string
, tem
;
3334 if (NILP (obarray
)) obarray
= Vobarray
;
3335 obarray
= check_obarray (obarray
);
3338 string
= SYMBOL_NAME (name
);
3341 CHECK_STRING (name
);
3345 tem
= oblookup (obarray
, SDATA (string
),
3350 /* If arg was a symbol, don't delete anything but that symbol itself. */
3351 if (SYMBOLP (name
) && !EQ (name
, tem
))
3354 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3355 XSYMBOL (tem
)->constant
= 0;
3356 XSYMBOL (tem
)->indirect_variable
= 0;
3358 hash
= oblookup_last_bucket_number
;
3360 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3362 if (XSYMBOL (tem
)->next
)
3363 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3365 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3369 Lisp_Object tail
, following
;
3371 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3372 XSYMBOL (tail
)->next
;
3375 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3376 if (EQ (following
, tem
))
3378 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3387 /* Return the symbol in OBARRAY whose names matches the string
3388 of SIZE characters (SIZE_BYTE bytes) at PTR.
3389 If there is no such symbol in OBARRAY, return nil.
3391 Also store the bucket number in oblookup_last_bucket_number. */
3394 oblookup (obarray
, ptr
, size
, size_byte
)
3395 Lisp_Object obarray
;
3396 register const char *ptr
;
3397 int size
, size_byte
;
3401 register Lisp_Object tail
;
3402 Lisp_Object bucket
, tem
;
3404 if (!VECTORP (obarray
)
3405 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3407 obarray
= check_obarray (obarray
);
3408 obsize
= XVECTOR (obarray
)->size
;
3410 /* This is sometimes needed in the middle of GC. */
3411 obsize
&= ~ARRAY_MARK_FLAG
;
3412 /* Combining next two lines breaks VMS C 2.3. */
3413 hash
= hash_string (ptr
, size_byte
);
3415 bucket
= XVECTOR (obarray
)->contents
[hash
];
3416 oblookup_last_bucket_number
= hash
;
3417 if (XFASTINT (bucket
) == 0)
3419 else if (!SYMBOLP (bucket
))
3420 error ("Bad data in guts of obarray"); /* Like CADR error message */
3422 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3424 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3425 && SCHARS (SYMBOL_NAME (tail
)) == size
3426 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3428 else if (XSYMBOL (tail
)->next
== 0)
3431 XSETINT (tem
, hash
);
3436 hash_string (ptr
, len
)
3437 const unsigned char *ptr
;
3440 register const unsigned char *p
= ptr
;
3441 register const unsigned char *end
= p
+ len
;
3442 register unsigned char c
;
3443 register int hash
= 0;
3448 if (c
>= 0140) c
-= 40;
3449 hash
= ((hash
<<3) + (hash
>>28) + c
);
3451 return hash
& 07777777777;
3455 map_obarray (obarray
, fn
, arg
)
3456 Lisp_Object obarray
;
3457 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3461 register Lisp_Object tail
;
3462 CHECK_VECTOR (obarray
);
3463 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3465 tail
= XVECTOR (obarray
)->contents
[i
];
3470 if (XSYMBOL (tail
)->next
== 0)
3472 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3478 mapatoms_1 (sym
, function
)
3479 Lisp_Object sym
, function
;
3481 call1 (function
, sym
);
3484 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3485 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3486 OBARRAY defaults to the value of `obarray'. */)
3488 Lisp_Object function
, obarray
;
3490 if (NILP (obarray
)) obarray
= Vobarray
;
3491 obarray
= check_obarray (obarray
);
3493 map_obarray (obarray
, mapatoms_1
, function
);
3497 #define OBARRAY_SIZE 1511
3502 Lisp_Object oblength
;
3506 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3508 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3509 Vobarray
= Fmake_vector (oblength
, make_number (0));
3510 initial_obarray
= Vobarray
;
3511 staticpro (&initial_obarray
);
3512 /* Intern nil in the obarray */
3513 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3514 XSYMBOL (Qnil
)->constant
= 1;
3516 /* These locals are to kludge around a pyramid compiler bug. */
3517 hash
= hash_string ("nil", 3);
3518 /* Separate statement here to avoid VAXC bug. */
3519 hash
%= OBARRAY_SIZE
;
3520 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3523 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3524 XSYMBOL (Qnil
)->function
= Qunbound
;
3525 XSYMBOL (Qunbound
)->value
= Qunbound
;
3526 XSYMBOL (Qunbound
)->function
= Qunbound
;
3529 XSYMBOL (Qnil
)->value
= Qnil
;
3530 XSYMBOL (Qnil
)->plist
= Qnil
;
3531 XSYMBOL (Qt
)->value
= Qt
;
3532 XSYMBOL (Qt
)->constant
= 1;
3534 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3537 Qvariable_documentation
= intern ("variable-documentation");
3538 staticpro (&Qvariable_documentation
);
3540 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3541 read_buffer
= (char *) xmalloc (read_buffer_size
);
3546 struct Lisp_Subr
*sname
;
3549 sym
= intern (sname
->symbol_name
);
3550 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3553 #ifdef NOTDEF /* use fset in subr.el now */
3555 defalias (sname
, string
)
3556 struct Lisp_Subr
*sname
;
3560 sym
= intern (string
);
3561 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3565 /* Define an "integer variable"; a symbol whose value is forwarded
3566 to a C variable of type int. Sample call: */
3567 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3569 defvar_int (namestring
, address
)
3573 Lisp_Object sym
, val
;
3574 sym
= intern (namestring
);
3575 val
= allocate_misc ();
3576 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3577 XINTFWD (val
)->intvar
= address
;
3578 SET_SYMBOL_VALUE (sym
, val
);
3581 /* Similar but define a variable whose value is t if address contains 1,
3582 nil if address contains 0 */
3584 defvar_bool (namestring
, address
)
3588 Lisp_Object sym
, val
;
3589 sym
= intern (namestring
);
3590 val
= allocate_misc ();
3591 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3592 XBOOLFWD (val
)->boolvar
= address
;
3593 SET_SYMBOL_VALUE (sym
, val
);
3594 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3597 /* Similar but define a variable whose value is the Lisp Object stored
3598 at address. Two versions: with and without gc-marking of the C
3599 variable. The nopro version is used when that variable will be
3600 gc-marked for some other reason, since marking the same slot twice
3601 can cause trouble with strings. */
3603 defvar_lisp_nopro (namestring
, address
)
3605 Lisp_Object
*address
;
3607 Lisp_Object sym
, val
;
3608 sym
= intern (namestring
);
3609 val
= allocate_misc ();
3610 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3611 XOBJFWD (val
)->objvar
= address
;
3612 SET_SYMBOL_VALUE (sym
, val
);
3616 defvar_lisp (namestring
, address
)
3618 Lisp_Object
*address
;
3620 defvar_lisp_nopro (namestring
, address
);
3621 staticpro (address
);
3624 /* Similar but define a variable whose value is the Lisp Object stored in
3625 the current buffer. address is the address of the slot in the buffer
3626 that is current now. */
3629 defvar_per_buffer (namestring
, address
, type
, doc
)
3631 Lisp_Object
*address
;
3635 Lisp_Object sym
, val
;
3638 sym
= intern (namestring
);
3639 val
= allocate_misc ();
3640 offset
= (char *)address
- (char *)current_buffer
;
3642 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3643 XBUFFER_OBJFWD (val
)->offset
= offset
;
3644 SET_SYMBOL_VALUE (sym
, val
);
3645 PER_BUFFER_SYMBOL (offset
) = sym
;
3646 PER_BUFFER_TYPE (offset
) = type
;
3648 if (PER_BUFFER_IDX (offset
) == 0)
3649 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3650 slot of buffer_local_flags */
3655 /* Similar but define a variable whose value is the Lisp Object stored
3656 at a particular offset in the current kboard object. */
3659 defvar_kboard (namestring
, offset
)
3663 Lisp_Object sym
, val
;
3664 sym
= intern (namestring
);
3665 val
= allocate_misc ();
3666 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3667 XKBOARD_OBJFWD (val
)->offset
= offset
;
3668 SET_SYMBOL_VALUE (sym
, val
);
3671 /* Record the value of load-path used at the start of dumping
3672 so we can see if the site changed it later during dumping. */
3673 static Lisp_Object dump_path
;
3679 int turn_off_warning
= 0;
3681 /* Compute the default load-path. */
3683 normal
= PATH_LOADSEARCH
;
3684 Vload_path
= decode_env_path (0, normal
);
3686 if (NILP (Vpurify_flag
))
3687 normal
= PATH_LOADSEARCH
;
3689 normal
= PATH_DUMPLOADSEARCH
;
3691 /* In a dumped Emacs, we normally have to reset the value of
3692 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3693 uses ../lisp, instead of the path of the installed elisp
3694 libraries. However, if it appears that Vload_path was changed
3695 from the default before dumping, don't override that value. */
3698 if (! NILP (Fequal (dump_path
, Vload_path
)))
3700 Vload_path
= decode_env_path (0, normal
);
3701 if (!NILP (Vinstallation_directory
))
3703 Lisp_Object tem
, tem1
, sitelisp
;
3705 /* Remove site-lisp dirs from path temporarily and store
3706 them in sitelisp, then conc them on at the end so
3707 they're always first in path. */
3711 tem
= Fcar (Vload_path
);
3712 tem1
= Fstring_match (build_string ("site-lisp"),
3716 Vload_path
= Fcdr (Vload_path
);
3717 sitelisp
= Fcons (tem
, sitelisp
);
3723 /* Add to the path the lisp subdir of the
3724 installation dir, if it exists. */
3725 tem
= Fexpand_file_name (build_string ("lisp"),
3726 Vinstallation_directory
);
3727 tem1
= Ffile_exists_p (tem
);
3730 if (NILP (Fmember (tem
, Vload_path
)))
3732 turn_off_warning
= 1;
3733 Vload_path
= Fcons (tem
, Vload_path
);
3737 /* That dir doesn't exist, so add the build-time
3738 Lisp dirs instead. */
3739 Vload_path
= nconc2 (Vload_path
, dump_path
);
3741 /* Add leim under the installation dir, if it exists. */
3742 tem
= Fexpand_file_name (build_string ("leim"),
3743 Vinstallation_directory
);
3744 tem1
= Ffile_exists_p (tem
);
3747 if (NILP (Fmember (tem
, Vload_path
)))
3748 Vload_path
= Fcons (tem
, Vload_path
);
3751 /* Add site-list under the installation dir, if it exists. */
3752 tem
= Fexpand_file_name (build_string ("site-lisp"),
3753 Vinstallation_directory
);
3754 tem1
= Ffile_exists_p (tem
);
3757 if (NILP (Fmember (tem
, Vload_path
)))
3758 Vload_path
= Fcons (tem
, Vload_path
);
3761 /* If Emacs was not built in the source directory,
3762 and it is run from where it was built, add to load-path
3763 the lisp, leim and site-lisp dirs under that directory. */
3765 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3769 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3770 Vinstallation_directory
);
3771 tem1
= Ffile_exists_p (tem
);
3773 /* Don't be fooled if they moved the entire source tree
3774 AFTER dumping Emacs. If the build directory is indeed
3775 different from the source dir, src/Makefile.in and
3776 src/Makefile will not be found together. */
3777 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3778 Vinstallation_directory
);
3779 tem2
= Ffile_exists_p (tem
);
3780 if (!NILP (tem1
) && NILP (tem2
))
3782 tem
= Fexpand_file_name (build_string ("lisp"),
3785 if (NILP (Fmember (tem
, Vload_path
)))
3786 Vload_path
= Fcons (tem
, Vload_path
);
3788 tem
= Fexpand_file_name (build_string ("leim"),
3791 if (NILP (Fmember (tem
, Vload_path
)))
3792 Vload_path
= Fcons (tem
, Vload_path
);
3794 tem
= Fexpand_file_name (build_string ("site-lisp"),
3797 if (NILP (Fmember (tem
, Vload_path
)))
3798 Vload_path
= Fcons (tem
, Vload_path
);
3801 if (!NILP (sitelisp
))
3802 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3808 /* NORMAL refers to the lisp dir in the source directory. */
3809 /* We used to add ../lisp at the front here, but
3810 that caused trouble because it was copied from dump_path
3811 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3812 It should be unnecessary. */
3813 Vload_path
= decode_env_path (0, normal
);
3814 dump_path
= Vload_path
;
3818 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3819 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3820 almost never correct, thereby causing a warning to be printed out that
3821 confuses users. Since PATH_LOADSEARCH is always overridden by the
3822 EMACSLOADPATH environment variable below, disable the warning on NT.
3823 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3824 the "standard" paths may not exist and would be overridden by
3825 EMACSLOADPATH as on NT. Since this depends on how the executable
3826 was build and packaged, turn off the warnings in general */
3828 /* Warn if dirs in the *standard* path don't exist. */
3829 if (!turn_off_warning
)
3831 Lisp_Object path_tail
;
3833 for (path_tail
= Vload_path
;
3835 path_tail
= XCDR (path_tail
))
3837 Lisp_Object dirfile
;
3838 dirfile
= Fcar (path_tail
);
3839 if (STRINGP (dirfile
))
3841 dirfile
= Fdirectory_file_name (dirfile
);
3842 if (access (SDATA (dirfile
), 0) < 0)
3843 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3848 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3850 /* If the EMACSLOADPATH environment variable is set, use its value.
3851 This doesn't apply if we're dumping. */
3853 if (NILP (Vpurify_flag
)
3854 && egetenv ("EMACSLOADPATH"))
3856 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3860 load_in_progress
= 0;
3861 Vload_file_name
= Qnil
;
3863 load_descriptor_list
= Qnil
;
3865 Vstandard_input
= Qt
;
3866 Vloads_in_progress
= Qnil
;
3869 /* Print a warning, using format string FORMAT, that directory DIRNAME
3870 does not exist. Print it on stderr and put it in *Message*. */
3873 dir_warning (format
, dirname
)
3875 Lisp_Object dirname
;
3878 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3880 fprintf (stderr
, format
, SDATA (dirname
));
3881 sprintf (buffer
, format
, SDATA (dirname
));
3882 /* Don't log the warning before we've initialized!! */
3884 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3891 defsubr (&Sread_from_string
);
3893 defsubr (&Sintern_soft
);
3894 defsubr (&Sunintern
);
3896 defsubr (&Seval_buffer
);
3897 defsubr (&Seval_region
);
3898 defsubr (&Sread_char
);
3899 defsubr (&Sread_char_exclusive
);
3900 defsubr (&Sread_event
);
3901 defsubr (&Sget_file_char
);
3902 defsubr (&Smapatoms
);
3903 defsubr (&Slocate_file_internal
);
3905 DEFVAR_LISP ("obarray", &Vobarray
,
3906 doc
: /* Symbol table for use by `intern' and `read'.
3907 It is a vector whose length ought to be prime for best results.
3908 The vector's contents don't make sense if examined from Lisp programs;
3909 to find all the symbols in an obarray, use `mapatoms'. */);
3911 DEFVAR_LISP ("values", &Vvalues
,
3912 doc
: /* List of values of all expressions which were read, evaluated and printed.
3913 Order is reverse chronological. */);
3915 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3916 doc
: /* Stream for read to get input from.
3917 See documentation of `read' for possible values. */);
3918 Vstandard_input
= Qt
;
3920 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3921 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3923 If this variable is a buffer, then only forms read from that buffer
3924 will be added to `read-symbol-positions-list'.
3925 If this variable is t, then all read forms will be added.
3926 The effect of all other values other than nil are not currently
3927 defined, although they may be in the future.
3929 The positions are relative to the last call to `read' or
3930 `read-from-string'. It is probably a bad idea to set this variable at
3931 the toplevel; bind it instead. */);
3932 Vread_with_symbol_positions
= Qnil
;
3934 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3935 doc
: /* A list mapping read symbols to their positions.
3936 This variable is modified during calls to `read' or
3937 `read-from-string', but only when `read-with-symbol-positions' is
3940 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3941 CHAR-POSITION is an integer giving the offset of that occurrence of the
3942 symbol from the position where `read' or `read-from-string' started.
3944 Note that a symbol will appear multiple times in this list, if it was
3945 read multiple times. The list is in the same order as the symbols
3947 Vread_symbol_positions_list
= Qnil
;
3949 DEFVAR_LISP ("load-path", &Vload_path
,
3950 doc
: /* *List of directories to search for files to load.
3951 Each element is a string (directory name) or nil (try default directory).
3952 Initialized based on EMACSLOADPATH environment variable, if any,
3953 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3955 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3956 doc
: /* *List of suffixes to try for files to load.
3957 This list should not include the empty string. */);
3958 Vload_suffixes
= Fcons (build_string (".elc"),
3959 Fcons (build_string (".el"), Qnil
));
3960 /* We don't use empty_string because it's not initialized yet. */
3961 default_suffixes
= Fcons (build_string (""), Qnil
);
3962 staticpro (&default_suffixes
);
3964 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3965 doc
: /* Non-nil iff inside of `load'. */);
3967 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3968 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3969 Each element looks like (FILENAME FORMS...).
3970 When `load' is run and the file-name argument is FILENAME,
3971 the FORMS in the corresponding element are executed at the end of loading.
3973 FILENAME must match exactly! Normally FILENAME is the name of a library,
3974 with no directory specified, since that is how `load' is normally called.
3975 An error in FORMS does not undo the load,
3976 but does prevent execution of the rest of the FORMS.
3977 FILENAME can also be a symbol (a feature) and FORMS are then executed
3978 when the corresponding call to `provide' is made. */);
3979 Vafter_load_alist
= Qnil
;
3981 DEFVAR_LISP ("load-history", &Vload_history
,
3982 doc
: /* Alist mapping source file names to symbols and features.
3983 Each alist element is a list that starts with a file name,
3984 except for one element (optional) that starts with nil and describes
3985 definitions evaluated from buffers not visiting files.
3986 The remaining elements of each list are symbols defined as functions,
3987 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3988 `(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3989 An element `(t . SYMBOL)' precedes an entry that is just SYMBOL,
3990 and means that SYMBOL was an autoload before this file redefined it
3992 Vload_history
= Qnil
;
3994 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3995 doc
: /* Full name of file being loaded by `load'. */);
3996 Vload_file_name
= Qnil
;
3998 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3999 doc
: /* File name, including directory, of user's initialization file.
4000 If the file loaded had extension `.elc' and there was a corresponding `.el'
4001 file, this variable contains the name of the .el file, suitable for use
4002 by functions like `custom-save-all' which edit the init file. */);
4003 Vuser_init_file
= Qnil
;
4005 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4006 doc
: /* Used for internal purposes by `load'. */);
4007 Vcurrent_load_list
= Qnil
;
4009 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4010 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4011 The default is nil, which means use the function `read'. */);
4012 Vload_read_function
= Qnil
;
4014 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4015 doc
: /* Function called in `load' for loading an Emacs lisp source file.
4016 This function is for doing code conversion before reading the source file.
4017 If nil, loading is done without any code conversion.
4018 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4019 FULLNAME is the full name of FILE.
4020 See `load' for the meaning of the remaining arguments. */);
4021 Vload_source_file_function
= Qnil
;
4023 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4024 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4025 This is useful when the file being loaded is a temporary copy. */);
4026 load_force_doc_strings
= 0;
4028 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4029 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4030 This is normally bound by `load' and `eval-buffer' to control `read',
4031 and is not meant for users to change. */);
4032 load_convert_to_unibyte
= 0;
4034 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4035 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4036 You cannot count on them to still be there! */);
4038 = Fexpand_file_name (build_string ("../"),
4039 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4041 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4042 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4043 Vpreloaded_file_list
= Qnil
;
4045 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4046 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4047 Vbyte_boolean_vars
= Qnil
;
4049 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4050 doc
: /* Non-nil means load dangerous compiled Lisp files.
4051 Some versions of XEmacs use different byte codes than Emacs. These
4052 incompatible byte codes can make Emacs crash when it tries to execute
4054 load_dangerous_libraries
= 0;
4056 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4057 doc
: /* Regular expression matching safe to load compiled Lisp files.
4058 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4059 from the file, and matches them against this regular expression.
4060 When the regular expression matches, the file is considered to be safe
4061 to load. See also `load-dangerous-libraries'. */);
4062 Vbytecomp_version_regexp
4063 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4065 /* Vsource_directory was initialized in init_lread. */
4067 load_descriptor_list
= Qnil
;
4068 staticpro (&load_descriptor_list
);
4070 Qcurrent_load_list
= intern ("current-load-list");
4071 staticpro (&Qcurrent_load_list
);
4073 Qstandard_input
= intern ("standard-input");
4074 staticpro (&Qstandard_input
);
4076 Qread_char
= intern ("read-char");
4077 staticpro (&Qread_char
);
4079 Qget_file_char
= intern ("get-file-char");
4080 staticpro (&Qget_file_char
);
4082 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4083 staticpro (&Qget_emacs_mule_file_char
);
4085 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4086 staticpro (&Qload_force_doc_strings
);
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 staticpro (&dump_path
);
4114 staticpro (&read_objects
);
4115 read_objects
= Qnil
;
4116 staticpro (&seen_list
);
4118 Vloads_in_progress
= Qnil
;
4119 staticpro (&Vloads_in_progress
);
4122 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4123 (do not change this comment) */