1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
31 #include "intervals.h"
33 #include "character.h"
39 #include "termhooks.h"
43 #include <sys/inode.h>
48 #include <unistd.h> /* to get X_OK */
65 #endif /* HAVE_SETLOCALE */
75 #define file_offset off_t
76 #define file_tell ftello
78 #define file_offset long
79 #define file_tell ftell
86 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
87 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
88 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
89 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
90 Lisp_Object Qinhibit_file_name_operation
;
91 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
93 /* Used instead of Qget_file_char while loading *.elc files compiled
94 by Emacs 21 or older. */
95 static Lisp_Object Qget_emacs_mule_file_char
;
97 static Lisp_Object Qload_force_doc_strings
;
99 extern Lisp_Object Qevent_symbol_element_mask
;
100 extern Lisp_Object Qfile_exists_p
;
102 /* non-zero iff inside `load' */
103 int load_in_progress
;
105 /* Directory in which the sources were found. */
106 Lisp_Object Vsource_directory
;
108 /* Search path and suffixes for files to be loaded. */
109 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
111 /* File name of user's init file. */
112 Lisp_Object Vuser_init_file
;
114 /* This is the user-visible association list that maps features to
115 lists of defs in their load files. */
116 Lisp_Object Vload_history
;
118 /* This is used to build the load history. */
119 Lisp_Object Vcurrent_load_list
;
121 /* List of files that were preloaded. */
122 Lisp_Object Vpreloaded_file_list
;
124 /* Name of file actually being read by `load'. */
125 Lisp_Object Vload_file_name
;
127 /* Function to use for reading, in `load' and friends. */
128 Lisp_Object Vload_read_function
;
130 /* The association list of objects read with the #n=object form.
131 Each member of the list has the form (n . object), and is used to
132 look up the object for the corresponding #n# construct.
133 It must be set to nil before all top-level calls to read0. */
134 Lisp_Object read_objects
;
136 /* Nonzero means load should forcibly load all dynamic doc strings. */
137 static int load_force_doc_strings
;
139 /* Nonzero means read should convert strings to unibyte. */
140 static int load_convert_to_unibyte
;
142 /* Nonzero means READCHAR should read bytes one by one (not character)
143 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
144 This is set to 1 by read1 temporarily while handling #@NUMBER. */
145 static int load_each_byte
;
147 /* Function to use for loading an Emacs lisp source file (not
148 compiled) instead of readevalloop. */
149 Lisp_Object Vload_source_file_function
;
151 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
152 Lisp_Object Vbyte_boolean_vars
;
154 /* Whether or not to add a `read-positions' property to symbols
156 Lisp_Object Vread_with_symbol_positions
;
158 /* List of (SYMBOL . POSITION) accumulated so far. */
159 Lisp_Object Vread_symbol_positions_list
;
161 /* List of descriptors now open for Fload. */
162 static Lisp_Object load_descriptor_list
;
164 /* File for get_file_char to read from. Use by load. */
165 static FILE *instream
;
167 /* When nonzero, read conses in pure space */
168 static int read_pure
;
170 /* For use within read-from-string (this reader is non-reentrant!!) */
171 static int read_from_string_index
;
172 static int read_from_string_index_byte
;
173 static int read_from_string_limit
;
175 /* Number of characters read in the current call to Fread or
176 Fread_from_string. */
177 static int readchar_count
;
179 /* This contains the last string skipped with #@. */
180 static char *saved_doc_string
;
181 /* Length of buffer allocated in saved_doc_string. */
182 static int saved_doc_string_size
;
183 /* Length of actual data in saved_doc_string. */
184 static int saved_doc_string_length
;
185 /* This is the file position that string came from. */
186 static file_offset saved_doc_string_position
;
188 /* This contains the previous string skipped with #@.
189 We copy it from saved_doc_string when a new string
190 is put in saved_doc_string. */
191 static char *prev_saved_doc_string
;
192 /* Length of buffer allocated in prev_saved_doc_string. */
193 static int prev_saved_doc_string_size
;
194 /* Length of actual data in prev_saved_doc_string. */
195 static int prev_saved_doc_string_length
;
196 /* This is the file position that string came from. */
197 static file_offset prev_saved_doc_string_position
;
199 /* Nonzero means inside a new-style backquote
200 with no surrounding parentheses.
201 Fread initializes this to zero, so we need not specbind it
202 or worry about what happens to it when there is an error. */
203 static int new_backquote_flag
;
205 /* A list of file names for files being loaded in Fload. Used to
206 check for recursive loads. */
208 static Lisp_Object Vloads_in_progress
;
210 /* Non-zero means load dangerous compiled Lisp files. */
212 int load_dangerous_libraries
;
214 /* A regular expression used to detect files compiled with Emacs. */
216 static Lisp_Object Vbytecomp_version_regexp
;
218 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
221 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
222 Lisp_Object (*) (), int,
223 Lisp_Object
, Lisp_Object
,
224 Lisp_Object
, Lisp_Object
));
225 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
226 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
229 /* Functions that read one byte from the current source READCHARFUN
230 or unreads one byte. If the integer argument C is -1, it returns
231 one read byte, or -1 when there's no more byte in the source. If C
232 is 0 or positive, it unreads C, and the return value is not
235 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
236 static int readbyte_from_file
P_ ((int, Lisp_Object
));
237 static int readbyte_from_string
P_ ((int, Lisp_Object
));
239 /* Handle unreading and rereading of characters.
240 Write READCHAR to read a character,
241 UNREAD(c) to unread c to be read again.
243 These macros correctly read/unread multibyte characters. */
245 #define READCHAR readchar (readcharfun)
246 #define UNREAD(c) unreadchar (readcharfun, c)
248 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
249 Qlambda, or a cons, we use this to keep an unread character because
250 a file stream can't handle multibyte-char unreading. The value -1
251 means that there's no unread character. */
252 static int unread_char
;
255 readchar (readcharfun
)
256 Lisp_Object readcharfun
;
260 int (*readbyte
) P_ ((int, Lisp_Object
));
261 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
263 int emacs_mule_encoding
= 0;
267 if (BUFFERP (readcharfun
))
269 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
271 int pt_byte
= BUF_PT_BYTE (inbuffer
);
273 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
276 if (! NILP (inbuffer
->enable_multibyte_characters
))
278 /* Fetch the character code from the buffer. */
279 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
280 BUF_INC_POS (inbuffer
, pt_byte
);
281 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
285 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
286 if (! ASCII_BYTE_P (c
))
287 c
= BYTE8_TO_CHAR (c
);
290 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
294 if (MARKERP (readcharfun
))
296 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
298 int bytepos
= marker_byte_position (readcharfun
);
300 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
303 if (! NILP (inbuffer
->enable_multibyte_characters
))
305 /* Fetch the character code from the buffer. */
306 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
307 BUF_INC_POS (inbuffer
, bytepos
);
308 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
312 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
313 if (! ASCII_BYTE_P (c
))
314 c
= BYTE8_TO_CHAR (c
);
318 XMARKER (readcharfun
)->bytepos
= bytepos
;
319 XMARKER (readcharfun
)->charpos
++;
324 if (EQ (readcharfun
, Qlambda
))
326 readbyte
= readbyte_for_lambda
;
330 if (EQ (readcharfun
, Qget_file_char
))
332 readbyte
= readbyte_from_file
;
336 if (STRINGP (readcharfun
))
338 if (read_from_string_index
>= read_from_string_limit
)
341 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
342 read_from_string_index
,
343 read_from_string_index_byte
);
348 if (CONSP (readcharfun
))
350 /* This is the case that read_vector is reading from a unibyte
351 string that contains a byte sequence previously skipped
352 because of #@NUMBER. The car part of readcharfun is that
353 string, and the cdr part is a value of readcharfun given to
355 readbyte
= readbyte_from_string
;
356 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
357 emacs_mule_encoding
= 1;
361 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
363 readbyte
= readbyte_from_file
;
364 emacs_mule_encoding
= 1;
368 tem
= call0 (readcharfun
);
375 if (unread_char
>= 0)
381 c
= (*readbyte
) (-1, readcharfun
);
382 if (c
< 0 || ASCII_BYTE_P (c
) || load_each_byte
)
384 if (emacs_mule_encoding
)
385 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
388 len
= BYTES_BY_CHAR_HEAD (c
);
391 c
= (*readbyte
) (-1, readcharfun
);
392 if (c
< 0 || ! TRAILING_CODE_P (c
))
395 (*readbyte
) (buf
[i
], readcharfun
);
396 return BYTE8_TO_CHAR (buf
[0]);
400 return STRING_CHAR (buf
, i
);
403 /* Unread the character C in the way appropriate for the stream READCHARFUN.
404 If the stream is a user function, call it with the char as argument. */
407 unreadchar (readcharfun
, c
)
408 Lisp_Object readcharfun
;
413 /* Don't back up the pointer if we're unreading the end-of-input mark,
414 since readchar didn't advance it when we read it. */
416 else if (BUFFERP (readcharfun
))
418 struct buffer
*b
= XBUFFER (readcharfun
);
419 int bytepos
= BUF_PT_BYTE (b
);
422 if (! NILP (b
->enable_multibyte_characters
))
423 BUF_DEC_POS (b
, bytepos
);
427 BUF_PT_BYTE (b
) = bytepos
;
429 else if (MARKERP (readcharfun
))
431 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
432 int bytepos
= XMARKER (readcharfun
)->bytepos
;
434 XMARKER (readcharfun
)->charpos
--;
435 if (! NILP (b
->enable_multibyte_characters
))
436 BUF_DEC_POS (b
, bytepos
);
440 XMARKER (readcharfun
)->bytepos
= bytepos
;
442 else if (STRINGP (readcharfun
))
444 read_from_string_index
--;
445 read_from_string_index_byte
446 = string_char_to_byte (readcharfun
, read_from_string_index
);
448 else if (CONSP (readcharfun
))
452 else if (EQ (readcharfun
, Qlambda
))
456 else if (EQ (readcharfun
, Qget_file_char
)
457 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
460 ungetc (c
, instream
);
465 call1 (readcharfun
, make_number (c
));
469 readbyte_for_lambda (c
, readcharfun
)
471 Lisp_Object readcharfun
;
473 return read_bytecode_char (c
>= 0);
478 readbyte_from_file (c
, readcharfun
)
480 Lisp_Object readcharfun
;
484 ungetc (c
, instream
);
490 /* Interrupted reads have been observed while reading over the network */
491 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
498 return (c
== EOF
? -1 : c
);
502 readbyte_from_string (c
, readcharfun
)
504 Lisp_Object readcharfun
;
506 Lisp_Object string
= XCAR (readcharfun
);
510 read_from_string_index
--;
511 read_from_string_index_byte
512 = string_char_to_byte (string
, read_from_string_index
);
515 if (read_from_string_index
>= read_from_string_limit
)
518 FETCH_STRING_CHAR_ADVANCE (c
, string
,
519 read_from_string_index
,
520 read_from_string_index_byte
);
525 /* Read one non-ASCII character from INSTREAM. The character is
526 encoded in `emacs-mule' and the first byte is already read in
529 extern char emacs_mule_bytes
[256];
532 read_emacs_mule_char (c
, readbyte
, readcharfun
)
534 int (*readbyte
) P_ ((int, Lisp_Object
));
535 Lisp_Object readcharfun
;
537 /* Emacs-mule coding uses at most 4-byte for one character. */
538 unsigned char buf
[4];
539 int len
= emacs_mule_bytes
[c
];
540 struct charset
*charset
;
545 /* C is not a valid leading-code of `emacs-mule'. */
546 return BYTE8_TO_CHAR (c
);
552 c
= (*readbyte
) (-1, readcharfun
);
556 (*readbyte
) (buf
[i
], readcharfun
);
557 return BYTE8_TO_CHAR (buf
[0]);
564 charset
= emacs_mule_charset
[buf
[0]];
565 code
= buf
[1] & 0x7F;
569 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
570 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
572 charset
= emacs_mule_charset
[buf
[1]];
573 code
= buf
[2] & 0x7F;
577 charset
= emacs_mule_charset
[buf
[0]];
578 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
583 charset
= emacs_mule_charset
[buf
[1]];
584 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
586 c
= DECODE_CHAR (charset
, code
);
588 Fsignal (Qinvalid_read_syntax
,
589 Fcons (build_string ("invalid multibyte form"), Qnil
));
594 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
596 static Lisp_Object read0
P_ ((Lisp_Object
));
597 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
599 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
600 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
602 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
604 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
606 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
609 /* Get a character from the tty. */
611 extern Lisp_Object
read_char ();
613 /* Read input events until we get one that's acceptable for our purposes.
615 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
616 until we get a character we like, and then stuffed into
619 If ASCII_REQUIRED is non-zero, we check function key events to see
620 if the unmodified version of the symbol has a Qascii_character
621 property, and use that character, if present.
623 If ERROR_NONASCII is non-zero, we signal an error if the input we
624 get isn't an ASCII character with modifiers. If it's zero but
625 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
628 If INPUT_METHOD is nonzero, we invoke the current input method
629 if the character warrants that. */
632 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
634 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
636 register Lisp_Object val
, delayed_switch_frame
;
638 #ifdef HAVE_WINDOW_SYSTEM
639 if (display_hourglass_p
)
643 delayed_switch_frame
= Qnil
;
645 /* Read until we get an acceptable event. */
647 val
= read_char (0, 0, 0,
648 (input_method
? Qnil
: Qt
),
654 /* switch-frame events are put off until after the next ASCII
655 character. This is better than signaling an error just because
656 the last characters were typed to a separate minibuffer frame,
657 for example. Eventually, some code which can deal with
658 switch-frame events will read it and process it. */
660 && EVENT_HAS_PARAMETERS (val
)
661 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
663 delayed_switch_frame
= val
;
669 /* Convert certain symbols to their ASCII equivalents. */
672 Lisp_Object tem
, tem1
;
673 tem
= Fget (val
, Qevent_symbol_element_mask
);
676 tem1
= Fget (Fcar (tem
), Qascii_character
);
677 /* Merge this symbol's modifier bits
678 with the ASCII equivalent of its basic code. */
680 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
684 /* If we don't have a character now, deal with it appropriately. */
689 Vunread_command_events
= Fcons (val
, Qnil
);
690 error ("Non-character input-event");
697 if (! NILP (delayed_switch_frame
))
698 unread_switch_frame
= delayed_switch_frame
;
702 #ifdef HAVE_WINDOW_SYSTEM
703 if (display_hourglass_p
)
712 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
713 doc
: /* Read a character from the command input (keyboard or macro).
714 It is returned as a number.
715 If the user generates an event which is not a character (i.e. a mouse
716 click or function key event), `read-char' signals an error. As an
717 exception, switch-frame events are put off until non-ASCII events can
719 If you want to read non-character events, or ignore them, call
720 `read-event' or `read-char-exclusive' instead.
722 If the optional argument PROMPT is non-nil, display that as a prompt.
723 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
724 input method is turned on in the current buffer, that input method
725 is used for reading a character. */)
726 (prompt
, inherit_input_method
)
727 Lisp_Object prompt
, inherit_input_method
;
730 message_with_string ("%s", prompt
, 0);
731 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
734 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
735 doc
: /* Read an event object from the input stream.
736 If the optional argument PROMPT is non-nil, display that as a prompt.
737 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
738 input method is turned on in the current buffer, that input method
739 is used for reading a character. */)
740 (prompt
, inherit_input_method
)
741 Lisp_Object prompt
, inherit_input_method
;
744 message_with_string ("%s", prompt
, 0);
745 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
748 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
749 doc
: /* Read a character from the command input (keyboard or macro).
750 It is returned as a number. Non-character events are ignored.
752 If the optional argument PROMPT is non-nil, display that as a prompt.
753 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
754 input method is turned on in the current buffer, that input method
755 is used for reading a character. */)
756 (prompt
, inherit_input_method
)
757 Lisp_Object prompt
, inherit_input_method
;
760 message_with_string ("%s", prompt
, 0);
761 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
764 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
765 doc
: /* Don't use this yourself. */)
768 register Lisp_Object val
;
769 XSETINT (val
, getc (instream
));
775 /* Value is a version number of byte compiled code if the file
776 asswociated with file descriptor FD is a compiled Lisp file that's
777 safe to load. Only files compiled with Emacs are safe to load.
778 Files compiled with XEmacs can lead to a crash in Fbyte_code
779 because of an incompatible change in the byte compiler. */
790 /* Read the first few bytes from the file, and look for a line
791 specifying the byte compiler version used. */
792 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
797 /* Skip to the next newline, skipping over the initial `ELC'
798 with NUL bytes following it, but note the version. */
799 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
804 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
811 lseek (fd
, 0, SEEK_SET
);
816 /* Callback for record_unwind_protect. Restore the old load list OLD,
817 after loading a file successfully. */
820 record_load_unwind (old
)
823 return Vloads_in_progress
= old
;
826 /* This handler function is used via internal_condition_case_1. */
829 load_error_handler (data
)
835 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
836 doc
: /* Execute a file of Lisp code named FILE.
837 First try FILE with `.elc' appended, then try with `.el',
838 then try FILE unmodified (the exact suffixes are determined by
839 `load-suffixes'). Environment variable references in FILE
840 are replaced with their values by calling `substitute-in-file-name'.
841 This function searches the directories in `load-path'.
842 If optional second arg NOERROR is non-nil,
843 report no error if FILE doesn't exist.
844 Print messages at start and end of loading unless
845 optional third arg NOMESSAGE is non-nil.
846 If optional fourth arg NOSUFFIX is non-nil, don't try adding
847 suffixes `.elc' or `.el' to the specified name FILE.
848 If optional fifth arg MUST-SUFFIX is non-nil, insist on
849 the suffix `.elc' or `.el'; don't accept just FILE unless
850 it ends in one of those suffixes or includes a directory name.
851 Return t if file exists. */)
852 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
853 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
855 register FILE *stream
;
856 register int fd
= -1;
857 int count
= SPECPDL_INDEX ();
860 Lisp_Object found
, efound
;
861 /* 1 means we printed the ".el is newer" message. */
863 /* 1 means we are loading a compiled file. */
876 /* If file name is magic, call the handler. */
877 /* This shouldn't be necessary any more now that `openp' handles it right.
878 handler = Ffind_file_name_handler (file, Qload);
880 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
882 /* Do this after the handler to avoid
883 the need to gcpro noerror, nomessage and nosuffix.
884 (Below here, we care only whether they are nil or not.)
885 The presence of this call is the result of a historical accident:
886 it used to be in every file-operations and when it got removed
887 everywhere, it accidentally stayed here. Since then, enough people
888 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
889 that it seemed risky to remove. */
890 if (! NILP (noerror
))
892 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
893 Qt
, load_error_handler
);
898 file
= Fsubstitute_in_file_name (file
);
901 /* Avoid weird lossage with null string as arg,
902 since it would try to load a directory as a Lisp file */
903 if (SCHARS (file
) > 0)
905 int size
= SBYTES (file
);
910 if (! NILP (must_suffix
))
912 /* Don't insist on adding a suffix if FILE already ends with one. */
914 && !strcmp (SDATA (file
) + size
- 3, ".el"))
917 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
919 /* Don't insist on adding a suffix
920 if the argument includes a directory name. */
921 else if (! NILP (Ffile_name_directory (file
)))
925 fd
= openp (Vload_path
, file
,
926 (!NILP (nosuffix
) ? Qnil
927 : !NILP (must_suffix
) ? Vload_suffixes
928 : Fappend (2, (tmp
[0] = Vload_suffixes
,
929 tmp
[1] = default_suffixes
,
938 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
939 Fcons (file
, Qnil
)));
944 /* Tell startup.el whether or not we found the user's init file. */
945 if (EQ (Qt
, Vuser_init_file
))
946 Vuser_init_file
= found
;
948 /* If FD is -2, that means openp found a magic file. */
951 if (NILP (Fequal (found
, file
)))
952 /* If FOUND is a different file name from FILE,
953 find its handler even if we have already inhibited
954 the `load' operation on FILE. */
955 handler
= Ffind_file_name_handler (found
, Qt
);
957 handler
= Ffind_file_name_handler (found
, Qload
);
958 if (! NILP (handler
))
959 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
962 /* Check if we're stuck in a recursive load cycle.
964 2000-09-21: It's not possible to just check for the file loaded
965 being a member of Vloads_in_progress. This fails because of the
966 way the byte compiler currently works; `provide's are not
967 evaluted, see font-lock.el/jit-lock.el as an example. This
968 leads to a certain amount of ``normal'' recursion.
970 Also, just loading a file recursively is not always an error in
971 the general case; the second load may do something different. */
975 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
976 if (!NILP (Fequal (found
, XCAR (tem
))))
979 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
980 Fcons (found
, Vloads_in_progress
)));
981 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
982 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
986 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
988 || (version
= safe_to_load_p (fd
)) > 0)
989 /* Load .elc files directly, but not when they are
990 remote and have no handler! */
998 && ! (version
= safe_to_load_p (fd
)))
1001 if (!load_dangerous_libraries
)
1005 error ("File `%s' was not compiled in Emacs",
1008 else if (!NILP (nomessage
))
1009 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1015 efound
= ENCODE_FILE (found
);
1020 stat ((char *)SDATA (efound
), &s1
);
1021 SSET (efound
, SBYTES (efound
) - 1, 0);
1022 result
= stat ((char *)SDATA (efound
), &s2
);
1023 SSET (efound
, SBYTES (efound
) - 1, 'c');
1026 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1028 /* Make the progress messages mention that source is newer. */
1031 /* If we won't print another message, mention this anyway. */
1032 if (!NILP (nomessage
))
1035 file
= Fsubstring (found
, make_number (0), make_number (-1));
1036 message_with_string ("Source file `%s' newer than byte-compiled file",
1044 /* We are loading a source file (*.el). */
1045 if (!NILP (Vload_source_file_function
))
1051 val
= call4 (Vload_source_file_function
, found
, file
,
1052 NILP (noerror
) ? Qnil
: Qt
,
1053 NILP (nomessage
) ? Qnil
: Qt
);
1054 return unbind_to (count
, val
);
1061 efound
= ENCODE_FILE (found
);
1062 stream
= fopen ((char *) SDATA (efound
), fmode
);
1064 #else /* not WINDOWSNT */
1065 stream
= fdopen (fd
, fmode
);
1066 #endif /* not WINDOWSNT */
1070 error ("Failure to create stdio stream for %s", SDATA (file
));
1073 if (! NILP (Vpurify_flag
))
1074 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1076 if (NILP (nomessage
))
1079 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1082 message_with_string ("Loading %s (source)...", file
, 1);
1084 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1086 else /* The typical case; compiled file newer than source file. */
1087 message_with_string ("Loading %s...", file
, 1);
1091 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
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
,
1100 0, Qnil
, Qnil
, Qnil
, Qnil
);
1103 /* We can't handle a file which was compiled with
1104 byte-compile-dynamic by older version of Emacs. */
1105 specbind (Qload_force_doc_strings
, Qt
);
1106 readevalloop (Qget_emacs_mule_file_char
, stream
, file
, Feval
,
1107 0, Qnil
, Qnil
, Qnil
, Qnil
);
1109 unbind_to (count
, Qnil
);
1111 /* Run any load-hooks for this file. */
1112 temp
= Fassoc (file
, Vafter_load_alist
);
1114 Fprogn (Fcdr (temp
));
1117 if (saved_doc_string
)
1118 free (saved_doc_string
);
1119 saved_doc_string
= 0;
1120 saved_doc_string_size
= 0;
1122 if (prev_saved_doc_string
)
1123 xfree (prev_saved_doc_string
);
1124 prev_saved_doc_string
= 0;
1125 prev_saved_doc_string_size
= 0;
1127 if (!noninteractive
&& NILP (nomessage
))
1130 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1133 message_with_string ("Loading %s (source)...done", file
, 1);
1135 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1137 else /* The typical case; compiled file newer than source file. */
1138 message_with_string ("Loading %s...done", file
, 1);
1141 if (!NILP (Fequal (build_string ("obsolete"),
1142 Ffile_name_nondirectory
1143 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1144 message_with_string ("Package %s is obsolete", file
, 1);
1150 load_unwind (arg
) /* used as unwind-protect function in load */
1153 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1156 if (--load_in_progress
< 0) load_in_progress
= 0;
1161 load_descriptor_unwind (oldlist
)
1162 Lisp_Object oldlist
;
1164 load_descriptor_list
= oldlist
;
1168 /* Close all descriptors in use for Floads.
1169 This is used when starting a subprocess. */
1176 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1177 emacs_close (XFASTINT (XCAR (tail
)));
1182 complete_filename_p (pathname
)
1183 Lisp_Object pathname
;
1185 register const unsigned char *s
= SDATA (pathname
);
1186 return (IS_DIRECTORY_SEP (s
[0])
1187 || (SCHARS (pathname
) > 2
1188 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1198 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1199 doc
: /* Search for FILENAME through PATH.
1200 Returns the file's name in absolute form, or nil if not found.
1201 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1202 file name when searching.
1203 If non-nil, PREDICATE is used instead of `file-readable-p'.
1204 PREDICATE can also be an integer to pass to the access(2) function,
1205 in which case file-name-handlers are ignored. */)
1206 (filename
, path
, suffixes
, predicate
)
1207 Lisp_Object filename
, path
, suffixes
, predicate
;
1210 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1211 if (NILP (predicate
) && fd
> 0)
1217 /* Search for a file whose name is STR, looking in directories
1218 in the Lisp list PATH, and trying suffixes from SUFFIX.
1219 On success, returns a file descriptor. On failure, returns -1.
1221 SUFFIXES is a list of strings containing possible suffixes.
1222 The empty suffix is automatically added iff the list is empty.
1224 PREDICATE non-nil means don't open the files,
1225 just look for one that satisfies the predicate. In this case,
1226 returns 1 on success. The predicate can be a lisp function or
1227 an integer to pass to `access' (in which case file-name-handlers
1230 If STOREPTR is nonzero, it points to a slot where the name of
1231 the file actually found should be stored as a Lisp string.
1232 nil is stored there on failure.
1234 If the file we find is remote, return -2
1235 but store the found remote file name in *STOREPTR. */
1238 openp (path
, str
, suffixes
, storeptr
, predicate
)
1239 Lisp_Object path
, str
;
1240 Lisp_Object suffixes
;
1241 Lisp_Object
*storeptr
;
1242 Lisp_Object predicate
;
1247 register char *fn
= buf
;
1250 Lisp_Object filename
;
1252 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1253 Lisp_Object string
, tail
, encoded_fn
;
1254 int max_suffix_len
= 0;
1258 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1260 CHECK_STRING_CAR (tail
);
1261 max_suffix_len
= max (max_suffix_len
,
1262 SBYTES (XCAR (tail
)));
1265 string
= filename
= Qnil
;
1266 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1271 if (complete_filename_p (str
))
1274 for (; CONSP (path
); path
= XCDR (path
))
1276 filename
= Fexpand_file_name (str
, XCAR (path
));
1277 if (!complete_filename_p (filename
))
1278 /* If there are non-absolute elts in PATH (eg ".") */
1279 /* Of course, this could conceivably lose if luser sets
1280 default-directory to be something non-absolute... */
1282 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1283 if (!complete_filename_p (filename
))
1284 /* Give up on this path element! */
1288 /* Calculate maximum size of any filename made from
1289 this path element/specified file name and any possible suffix. */
1290 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1291 if (fn_size
< want_size
)
1292 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1294 /* Loop over suffixes. */
1295 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1296 CONSP (tail
); tail
= XCDR (tail
))
1298 int lsuffix
= SBYTES (XCAR (tail
));
1299 Lisp_Object handler
;
1302 /* Concatenate path element/specified name with the suffix.
1303 If the directory starts with /:, remove that. */
1304 if (SCHARS (filename
) > 2
1305 && SREF (filename
, 0) == '/'
1306 && SREF (filename
, 1) == ':')
1308 strncpy (fn
, SDATA (filename
) + 2,
1309 SBYTES (filename
) - 2);
1310 fn
[SBYTES (filename
) - 2] = 0;
1314 strncpy (fn
, SDATA (filename
),
1316 fn
[SBYTES (filename
)] = 0;
1319 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1320 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1322 /* Check that the file exists and is not a directory. */
1323 /* We used to only check for handlers on non-absolute file names:
1327 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1328 It's not clear why that was the case and it breaks things like
1329 (load "/bar.el") where the file is actually "/bar.el.gz". */
1330 string
= build_string (fn
);
1331 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1332 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1334 if (NILP (predicate
))
1335 exists
= !NILP (Ffile_readable_p (string
));
1337 exists
= !NILP (call1 (predicate
, string
));
1338 if (exists
&& !NILP (Ffile_directory_p (string
)))
1343 /* We succeeded; return this descriptor and filename. */
1354 encoded_fn
= ENCODE_FILE (string
);
1355 pfn
= SDATA (encoded_fn
);
1356 exists
= (stat (pfn
, &st
) >= 0
1357 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1360 /* Check that we can access or open it. */
1361 if (NATNUMP (predicate
))
1362 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1364 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1368 /* We succeeded; return this descriptor and filename. */
1386 /* Merge the list we've accumulated of globals from the current input source
1387 into the load_history variable. The details depend on whether
1388 the source has an associated file name or not. */
1391 build_load_history (stream
, source
)
1395 register Lisp_Object tail
, prev
, newelt
;
1396 register Lisp_Object tem
, tem2
;
1397 register int foundit
, loading
;
1399 loading
= stream
|| !NARROWED
;
1401 tail
= Vload_history
;
1404 while (CONSP (tail
))
1408 /* Find the feature's previous assoc list... */
1409 if (!NILP (Fequal (source
, Fcar (tem
))))
1413 /* If we're loading, remove it. */
1417 Vload_history
= XCDR (tail
);
1419 Fsetcdr (prev
, XCDR (tail
));
1422 /* Otherwise, cons on new symbols that are not already members. */
1425 tem2
= Vcurrent_load_list
;
1427 while (CONSP (tem2
))
1429 newelt
= XCAR (tem2
);
1431 if (NILP (Fmember (newelt
, tem
)))
1432 Fsetcar (tail
, Fcons (XCAR (tem
),
1433 Fcons (newelt
, XCDR (tem
))));
1446 /* If we're loading, cons the new assoc onto the front of load-history,
1447 the most-recently-loaded position. Also do this if we didn't find
1448 an existing member for the current source. */
1449 if (loading
|| !foundit
)
1450 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1455 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1463 readevalloop_1 (old
)
1466 load_convert_to_unibyte
= ! NILP (old
);
1470 /* Signal an `end-of-file' error, if possible with file name
1474 end_of_file_error ()
1478 if (STRINGP (Vload_file_name
))
1479 data
= Fcons (Vload_file_name
, Qnil
);
1483 Fsignal (Qend_of_file
, data
);
1486 /* UNIBYTE specifies how to set load_convert_to_unibyte
1487 for this invocation.
1488 READFUN, if non-nil, is used instead of `read'.
1489 START, END is region in current buffer (from eval-region). */
1492 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1493 printflag
, unibyte
, readfun
, start
, end
)
1494 Lisp_Object readcharfun
;
1496 Lisp_Object sourcename
;
1497 Lisp_Object (*evalfun
) ();
1499 Lisp_Object unibyte
, readfun
;
1500 Lisp_Object start
, end
;
1503 register Lisp_Object val
;
1504 int count
= SPECPDL_INDEX ();
1505 struct gcpro gcpro1
;
1506 struct buffer
*b
= 0;
1507 int continue_reading_p
;
1509 if (BUFFERP (readcharfun
))
1510 b
= XBUFFER (readcharfun
);
1511 else if (MARKERP (readcharfun
))
1512 b
= XMARKER (readcharfun
)->buffer
;
1514 specbind (Qstandard_input
, readcharfun
);
1515 specbind (Qcurrent_load_list
, Qnil
);
1516 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1517 load_convert_to_unibyte
= !NILP (unibyte
);
1519 GCPRO1 (sourcename
);
1521 LOADHIST_ATTACH (sourcename
);
1523 continue_reading_p
= 1;
1524 while (continue_reading_p
)
1526 int count1
= SPECPDL_INDEX ();
1528 if (b
!= 0 && NILP (b
->name
))
1529 error ("Reading from killed buffer");
1533 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1534 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1536 Fnarrow_to_region (make_number (BEGV
), end
);
1544 while ((c
= READCHAR
) != '\n' && c
!= -1);
1549 unbind_to (count1
, Qnil
);
1553 /* Ignore whitespace here, so we can detect eof. */
1554 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1557 if (!NILP (Vpurify_flag
) && c
== '(')
1559 record_unwind_protect (unreadpure
, Qnil
);
1560 val
= read_list (-1, readcharfun
);
1565 read_objects
= Qnil
;
1566 if (!NILP (readfun
))
1568 val
= call1 (readfun
, readcharfun
);
1570 /* If READCHARFUN has set point to ZV, we should
1571 stop reading, even if the form read sets point
1572 to a different value when evaluated. */
1573 if (BUFFERP (readcharfun
))
1575 struct buffer
*b
= XBUFFER (readcharfun
);
1576 if (BUF_PT (b
) == BUF_ZV (b
))
1577 continue_reading_p
= 0;
1580 else if (! NILP (Vload_read_function
))
1581 val
= call1 (Vload_read_function
, readcharfun
);
1583 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1586 if (!NILP (start
) && continue_reading_p
)
1587 start
= Fpoint_marker ();
1588 unbind_to (count1
, Qnil
);
1590 val
= (*evalfun
) (val
);
1594 Vvalues
= Fcons (val
, Vvalues
);
1595 if (EQ (Vstandard_output
, Qt
))
1602 build_load_history (stream
, sourcename
);
1605 unbind_to (count
, Qnil
);
1608 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1609 doc
: /* Execute the current buffer as Lisp code.
1610 Programs can pass two arguments, BUFFER and PRINTFLAG.
1611 BUFFER is the buffer to evaluate (nil means use current buffer).
1612 PRINTFLAG controls printing of output:
1613 nil means discard it; anything else is stream for print.
1615 If the optional third argument FILENAME is non-nil,
1616 it specifies the file name to use for `load-history'.
1617 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1618 for this invocation.
1620 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1621 `print' and related functions should work normally even if PRINTFLAG is nil.
1623 This function preserves the position of point. */)
1624 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1625 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1627 int count
= SPECPDL_INDEX ();
1628 Lisp_Object tem
, buf
;
1631 buf
= Fcurrent_buffer ();
1633 buf
= Fget_buffer (buffer
);
1635 error ("No such buffer");
1637 if (NILP (printflag
) && NILP (do_allow_print
))
1642 if (NILP (filename
))
1643 filename
= XBUFFER (buf
)->filename
;
1645 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1646 specbind (Qstandard_output
, tem
);
1647 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1648 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1649 readevalloop (buf
, 0, filename
, Feval
,
1650 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1651 unbind_to (count
, Qnil
);
1656 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1657 doc
: /* Execute the region as Lisp code.
1658 When called from programs, expects two arguments,
1659 giving starting and ending indices in the current buffer
1660 of the text to be executed.
1661 Programs can pass third argument PRINTFLAG which controls output:
1662 nil means discard it; anything else is stream for printing it.
1663 Also the fourth argument READ-FUNCTION, if non-nil, is used
1664 instead of `read' to read each expression. It gets one argument
1665 which is the input stream for reading characters.
1667 This function does not move point. */)
1668 (start
, end
, printflag
, read_function
)
1669 Lisp_Object start
, end
, printflag
, read_function
;
1671 int count
= SPECPDL_INDEX ();
1672 Lisp_Object tem
, cbuf
;
1674 cbuf
= Fcurrent_buffer ();
1676 if (NILP (printflag
))
1680 specbind (Qstandard_output
, tem
);
1681 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1683 /* readevalloop calls functions which check the type of start and end. */
1684 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1685 !NILP (printflag
), Qnil
, read_function
,
1688 return unbind_to (count
, Qnil
);
1692 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1693 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1694 If STREAM is nil, use the value of `standard-input' (which see).
1695 STREAM or the value of `standard-input' may be:
1696 a buffer (read from point and advance it)
1697 a marker (read from where it points and advance it)
1698 a function (call it with no arguments for each character,
1699 call it with a char as argument to push a char back)
1700 a string (takes text from string, starting at the beginning)
1701 t (read text line using minibuffer and use it, or read from
1702 standard input in batch mode). */)
1707 stream
= Vstandard_input
;
1708 if (EQ (stream
, Qt
))
1709 stream
= Qread_char
;
1710 if (EQ (stream
, Qread_char
))
1711 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1713 return read_internal_start (stream
, Qnil
, Qnil
);
1716 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1717 doc
: /* Read one Lisp expression which is represented as text by STRING.
1718 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1719 START and END optionally delimit a substring of STRING from which to read;
1720 they default to 0 and (length STRING) respectively. */)
1721 (string
, start
, end
)
1722 Lisp_Object string
, start
, end
;
1725 CHECK_STRING (string
);
1726 /* read_internal_start sets read_from_string_index. */
1727 ret
= read_internal_start (string
, start
, end
);
1728 return Fcons (ret
, make_number (read_from_string_index
));
1731 /* Function to set up the global context we need in toplevel read
1734 read_internal_start (stream
, start
, end
)
1736 Lisp_Object start
; /* Only used when stream is a string. */
1737 Lisp_Object end
; /* Only used when stream is a string. */
1742 new_backquote_flag
= 0;
1743 read_objects
= Qnil
;
1744 if (EQ (Vread_with_symbol_positions
, Qt
)
1745 || EQ (Vread_with_symbol_positions
, stream
))
1746 Vread_symbol_positions_list
= Qnil
;
1748 if (STRINGP (stream
)
1749 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1751 int startval
, endval
;
1754 if (STRINGP (stream
))
1757 string
= XCAR (stream
);
1760 endval
= SCHARS (string
);
1764 endval
= XINT (end
);
1765 if (endval
< 0 || endval
> SCHARS (string
))
1766 args_out_of_range (string
, end
);
1773 CHECK_NUMBER (start
);
1774 startval
= XINT (start
);
1775 if (startval
< 0 || startval
> endval
)
1776 args_out_of_range (string
, start
);
1778 read_from_string_index
= startval
;
1779 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1780 read_from_string_limit
= endval
;
1783 retval
= read0 (stream
);
1784 if (EQ (Vread_with_symbol_positions
, Qt
)
1785 || EQ (Vread_with_symbol_positions
, stream
))
1786 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1790 /* Use this for recursive reads, in contexts where internal tokens
1795 Lisp_Object readcharfun
;
1797 register Lisp_Object val
;
1800 val
= read1 (readcharfun
, &c
, 0);
1802 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1809 static int read_buffer_size
;
1810 static char *read_buffer
;
1812 /* Read a \-escape sequence, assuming we already read the `\'.
1813 If the escape sequence forces unibyte, return eight-bit char. */
1816 read_escape (readcharfun
, stringp
)
1817 Lisp_Object readcharfun
;
1820 register int c
= READCHAR
;
1825 end_of_file_error ();
1855 error ("Invalid escape character syntax");
1858 c
= read_escape (readcharfun
, 0);
1859 return c
| meta_modifier
;
1864 error ("Invalid escape character syntax");
1867 c
= read_escape (readcharfun
, 0);
1868 return c
| shift_modifier
;
1873 error ("Invalid escape character syntax");
1876 c
= read_escape (readcharfun
, 0);
1877 return c
| hyper_modifier
;
1882 error ("Invalid escape character syntax");
1885 c
= read_escape (readcharfun
, 0);
1886 return c
| alt_modifier
;
1898 c
= read_escape (readcharfun
, 0);
1899 return c
| super_modifier
;
1904 error ("Invalid escape character syntax");
1908 c
= read_escape (readcharfun
, 0);
1909 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1910 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1911 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1912 return c
| ctrl_modifier
;
1913 /* ASCII control chars are made from letters (both cases),
1914 as well as the non-letters within 0100...0137. */
1915 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1916 return (c
& (037 | ~0177));
1917 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1918 return (c
& (037 | ~0177));
1920 return c
| ctrl_modifier
;
1930 /* An octal escape, as in ANSI C. */
1932 register int i
= c
- '0';
1933 register int count
= 0;
1936 if ((c
= READCHAR
) >= '0' && c
<= '7')
1948 if (i
>= 0x80 && i
< 0x100)
1949 i
= BYTE8_TO_CHAR (i
);
1954 /* A hex escape, as in ANSI C. */
1961 if (c
>= '0' && c
<= '9')
1966 else if ((c
>= 'a' && c
<= 'f')
1967 || (c
>= 'A' && c
<= 'F'))
1970 if (c
>= 'a' && c
<= 'f')
1983 if (count
< 3 && i
>= 0x80)
1984 return BYTE8_TO_CHAR (i
);
1994 /* Read an integer in radix RADIX using READCHARFUN to read
1995 characters. RADIX must be in the interval [2..36]; if it isn't, a
1996 read error is signaled . Value is the integer read. Signals an
1997 error if encountering invalid read syntax or if RADIX is out of
2001 read_integer (readcharfun
, radix
)
2002 Lisp_Object readcharfun
;
2005 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2006 EMACS_INT number
= 0;
2008 if (radix
< 2 || radix
> 36)
2012 number
= ndigits
= invalid_p
= 0;
2028 if (c
>= '0' && c
<= '9')
2030 else if (c
>= 'a' && c
<= 'z')
2031 digit
= c
- 'a' + 10;
2032 else if (c
>= 'A' && c
<= 'Z')
2033 digit
= c
- 'A' + 10;
2040 if (digit
< 0 || digit
>= radix
)
2043 number
= radix
* number
+ digit
;
2049 if (ndigits
== 0 || invalid_p
)
2052 sprintf (buf
, "integer, radix %d", radix
);
2053 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
2056 return make_number (sign
* number
);
2060 /* If the next token is ')' or ']' or '.', we store that character
2061 in *PCH and the return value is not interesting. Else, we store
2062 zero in *PCH and we read and return one lisp object.
2064 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2067 read1 (readcharfun
, pch
, first_in_list
)
2068 register Lisp_Object readcharfun
;
2073 int uninterned_symbol
= 0;
2082 end_of_file_error ();
2087 return read_list (0, readcharfun
);
2090 return read_vector (readcharfun
, 0);
2107 tmp
= read_vector (readcharfun
, 0);
2108 if (XVECTOR (tmp
)->size
< VECSIZE (struct Lisp_Char_Table
))
2109 error ("Invalid size char-table");
2110 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2121 tmp
= read_vector (readcharfun
, 0);
2122 if (!INTEGERP (AREF (tmp
, 0)))
2123 error ("Invalid depth in char-table");
2124 depth
= XINT (AREF (tmp
, 0));
2125 if (depth
< 1 || depth
> 3)
2126 error ("Invalid depth in char-table");
2127 size
= XVECTOR (tmp
)->size
- 2;
2128 if (chartab_size
[depth
] != size
)
2129 error ("Invalid size char-table");
2130 XSETSUB_CHAR_TABLE (tmp
, XSUB_CHAR_TABLE (tmp
));
2133 Fsignal (Qinvalid_read_syntax
,
2134 Fcons (make_string ("#^^", 3), Qnil
));
2136 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2141 length
= read1 (readcharfun
, pch
, first_in_list
);
2145 Lisp_Object tmp
, val
;
2147 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2148 / BOOL_VECTOR_BITS_PER_CHAR
);
2151 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2152 if (STRING_MULTIBYTE (tmp
)
2153 || (size_in_chars
!= SCHARS (tmp
)
2154 /* We used to print 1 char too many
2155 when the number of bits was a multiple of 8.
2156 Accept such input in case it came from an old
2158 && ! (XFASTINT (length
)
2159 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2160 Fsignal (Qinvalid_read_syntax
,
2161 Fcons (make_string ("#&...", 5), Qnil
));
2163 val
= Fmake_bool_vector (length
, Qnil
);
2164 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2166 /* Clear the extraneous bits in the last byte. */
2167 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2168 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2169 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2172 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2177 /* Accept compiled functions at read-time so that we don't have to
2178 build them using function calls. */
2180 tmp
= read_vector (readcharfun
, 1);
2181 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2182 XVECTOR (tmp
)->contents
);
2187 struct gcpro gcpro1
;
2190 /* Read the string itself. */
2191 tmp
= read1 (readcharfun
, &ch
, 0);
2192 if (ch
!= 0 || !STRINGP (tmp
))
2193 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2195 /* Read the intervals and their properties. */
2198 Lisp_Object beg
, end
, plist
;
2200 beg
= read1 (readcharfun
, &ch
, 0);
2205 end
= read1 (readcharfun
, &ch
, 0);
2207 plist
= read1 (readcharfun
, &ch
, 0);
2209 Fsignal (Qinvalid_read_syntax
,
2210 Fcons (build_string ("invalid string property list"),
2212 Fset_text_properties (beg
, end
, plist
, tmp
);
2218 /* #@NUMBER is used to skip NUMBER following characters.
2219 That's used in .elc files to skip over doc strings
2220 and function definitions. */
2226 /* Read a decimal integer. */
2227 while ((c
= READCHAR
) >= 0
2228 && c
>= '0' && c
<= '9')
2236 if (load_force_doc_strings
2237 && (EQ (readcharfun
, Qget_file_char
)
2238 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2240 /* If we are supposed to force doc strings into core right now,
2241 record the last string that we skipped,
2242 and record where in the file it comes from. */
2244 /* But first exchange saved_doc_string
2245 with prev_saved_doc_string, so we save two strings. */
2247 char *temp
= saved_doc_string
;
2248 int temp_size
= saved_doc_string_size
;
2249 file_offset temp_pos
= saved_doc_string_position
;
2250 int temp_len
= saved_doc_string_length
;
2252 saved_doc_string
= prev_saved_doc_string
;
2253 saved_doc_string_size
= prev_saved_doc_string_size
;
2254 saved_doc_string_position
= prev_saved_doc_string_position
;
2255 saved_doc_string_length
= prev_saved_doc_string_length
;
2257 prev_saved_doc_string
= temp
;
2258 prev_saved_doc_string_size
= temp_size
;
2259 prev_saved_doc_string_position
= temp_pos
;
2260 prev_saved_doc_string_length
= temp_len
;
2263 if (saved_doc_string_size
== 0)
2265 saved_doc_string_size
= nskip
+ 100;
2266 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2268 if (nskip
> saved_doc_string_size
)
2270 saved_doc_string_size
= nskip
+ 100;
2271 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2272 saved_doc_string_size
);
2275 saved_doc_string_position
= file_tell (instream
);
2277 /* Copy that many characters into saved_doc_string. */
2278 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2279 saved_doc_string
[i
] = c
= READCHAR
;
2281 saved_doc_string_length
= i
;
2285 /* Skip that many characters. */
2286 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2295 /* #! appears at the beginning of an executable file.
2296 Skip the first line. */
2297 while (c
!= '\n' && c
>= 0)
2302 return Vload_file_name
;
2304 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2305 /* #:foo is the uninterned symbol named foo. */
2308 uninterned_symbol
= 1;
2312 /* Reader forms that can reuse previously read objects. */
2313 if (c
>= '0' && c
<= '9')
2318 /* Read a non-negative integer. */
2319 while (c
>= '0' && c
<= '9')
2325 /* #n=object returns object, but associates it with n for #n#. */
2328 /* Make a placeholder for #n# to use temporarily */
2329 Lisp_Object placeholder
;
2332 placeholder
= Fcons(Qnil
, Qnil
);
2333 cell
= Fcons (make_number (n
), placeholder
);
2334 read_objects
= Fcons (cell
, read_objects
);
2336 /* Read the object itself. */
2337 tem
= read0 (readcharfun
);
2339 /* Now put it everywhere the placeholder was... */
2340 substitute_object_in_subtree (tem
, placeholder
);
2342 /* ...and #n# will use the real value from now on. */
2343 Fsetcdr (cell
, tem
);
2347 /* #n# returns a previously read object. */
2350 tem
= Fassq (make_number (n
), read_objects
);
2353 /* Fall through to error message. */
2355 else if (c
== 'r' || c
== 'R')
2356 return read_integer (readcharfun
, n
);
2358 /* Fall through to error message. */
2360 else if (c
== 'x' || c
== 'X')
2361 return read_integer (readcharfun
, 16);
2362 else if (c
== 'o' || c
== 'O')
2363 return read_integer (readcharfun
, 8);
2364 else if (c
== 'b' || c
== 'B')
2365 return read_integer (readcharfun
, 2);
2368 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2371 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2376 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2386 new_backquote_flag
++;
2387 value
= read0 (readcharfun
);
2388 new_backquote_flag
--;
2390 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2394 if (new_backquote_flag
)
2396 Lisp_Object comma_type
= Qnil
;
2401 comma_type
= Qcomma_at
;
2403 comma_type
= Qcomma_dot
;
2406 if (ch
>= 0) UNREAD (ch
);
2407 comma_type
= Qcomma
;
2410 new_backquote_flag
--;
2411 value
= read0 (readcharfun
);
2412 new_backquote_flag
++;
2413 return Fcons (comma_type
, Fcons (value
, Qnil
));
2426 end_of_file_error ();
2428 /* Accept `single space' syntax like (list ? x) where the
2429 whitespace character is SPC or TAB.
2430 Other literal whitespace like NL, CR, and FF are not accepted,
2431 as there are well-established escape sequences for these. */
2432 if (c
== ' ' || c
== '\t')
2433 return make_number (c
);
2436 c
= read_escape (readcharfun
, 0);
2437 modifiers
= c
& CHAR_MODIFIER_MASK
;
2438 c
&= ~CHAR_MODIFIER_MASK
;
2439 if (CHAR_BYTE8_P (c
))
2440 c
= CHAR_TO_BYTE8 (c
);
2443 next_char
= READCHAR
;
2444 if (next_char
== '.')
2446 /* Only a dotted-pair dot is valid after a char constant. */
2447 int next_next_char
= READCHAR
;
2448 UNREAD (next_next_char
);
2450 ok
= (next_next_char
<= 040
2451 || (next_next_char
< 0200
2452 && (index ("\"';([#?", next_next_char
)
2453 || (!first_in_list
&& next_next_char
== '`')
2454 || (new_backquote_flag
&& next_next_char
== ','))));
2458 ok
= (next_char
<= 040
2459 || (next_char
< 0200
2460 && (index ("\"';()[]#?", next_char
)
2461 || (!first_in_list
&& next_char
== '`')
2462 || (new_backquote_flag
&& next_char
== ','))));
2466 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2468 return make_number (c
);
2473 char *p
= read_buffer
;
2474 char *end
= read_buffer
+ read_buffer_size
;
2476 /* Nonzero if we saw an escape sequence specifying
2477 a multibyte character. */
2478 int force_multibyte
= 0;
2479 /* Nonzero if we saw an escape sequence specifying
2480 a single-byte character. */
2481 int force_singlebyte
= 0;
2485 while ((c
= READCHAR
) >= 0
2488 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2490 int offset
= p
- read_buffer
;
2491 read_buffer
= (char *) xrealloc (read_buffer
,
2492 read_buffer_size
*= 2);
2493 p
= read_buffer
+ offset
;
2494 end
= read_buffer
+ read_buffer_size
;
2501 c
= read_escape (readcharfun
, 1);
2503 /* C is -1 if \ newline has just been seen */
2506 if (p
== read_buffer
)
2511 modifiers
= c
& CHAR_MODIFIER_MASK
;
2512 c
= c
& ~CHAR_MODIFIER_MASK
;
2514 if (CHAR_BYTE8_P (c
))
2515 force_singlebyte
= 1;
2516 else if (! ASCII_CHAR_P (c
))
2517 force_multibyte
= 1;
2518 else /* i.e. ASCII_CHAR_P (c) */
2520 /* Allow `\C- ' and `\C-?'. */
2521 if (modifiers
== CHAR_CTL
)
2524 c
= 0, modifiers
= 0;
2526 c
= 127, modifiers
= 0;
2528 if (modifiers
& CHAR_SHIFT
)
2530 /* Shift modifier is valid only with [A-Za-z]. */
2531 if (c
>= 'A' && c
<= 'Z')
2532 modifiers
&= ~CHAR_SHIFT
;
2533 else if (c
>= 'a' && c
<= 'z')
2534 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2537 if (modifiers
& CHAR_META
)
2539 /* Move the meta bit to the right place for a
2541 modifiers
&= ~CHAR_META
;
2542 c
= BYTE8_TO_CHAR (c
| 0x80);
2543 force_singlebyte
= 1;
2547 /* Any modifiers remaining are invalid. */
2549 error ("Invalid modifier in string");
2550 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2554 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2555 if (CHAR_BYTE8_P (c
))
2556 force_singlebyte
= 1;
2557 else if (! ASCII_CHAR_P (c
))
2558 force_multibyte
= 1;
2564 end_of_file_error ();
2566 /* If purifying, and string starts with \ newline,
2567 return zero instead. This is for doc strings
2568 that we are really going to find in etc/DOC.nn.nn */
2569 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2570 return make_number (0);
2572 if (force_multibyte
)
2573 /* READ_BUFFER already contains valid multibyte forms. */
2575 else if (force_singlebyte
)
2577 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2578 p
= read_buffer
+ nchars
;
2581 /* Otherwise, READ_BUFFER contains only ASCII. */
2584 /* We want readchar_count to be the number of characters, not
2585 bytes. Hence we adjust for multibyte characters in the
2586 string. ... But it doesn't seem to be necessary, because
2587 READCHAR *does* read multibyte characters from buffers. */
2588 /* readchar_count -= (p - read_buffer) - nchars; */
2590 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2592 || (p
- read_buffer
!= nchars
)));
2593 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2595 || (p
- read_buffer
!= nchars
)));
2600 int next_char
= READCHAR
;
2603 if (next_char
<= 040
2604 || (next_char
< 0200
2605 && (index ("\"';([#?", next_char
)
2606 || (!first_in_list
&& next_char
== '`')
2607 || (new_backquote_flag
&& next_char
== ','))))
2613 /* Otherwise, we fall through! Note that the atom-reading loop
2614 below will now loop at least once, assuring that we will not
2615 try to UNREAD two characters in a row. */
2619 if (c
<= 040) goto retry
;
2621 char *p
= read_buffer
;
2625 char *end
= read_buffer
+ read_buffer_size
;
2629 || (!index ("\"';()[]#", c
)
2630 && !(!first_in_list
&& c
== '`')
2631 && !(new_backquote_flag
&& c
== ','))))
2633 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
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 end_of_file_error ();
2650 p
+= CHAR_STRING (c
, p
);
2656 int offset
= p
- read_buffer
;
2657 read_buffer
= (char *) xrealloc (read_buffer
,
2658 read_buffer_size
*= 2);
2659 p
= read_buffer
+ offset
;
2660 end
= read_buffer
+ read_buffer_size
;
2667 if (!quoted
&& !uninterned_symbol
)
2670 register Lisp_Object val
;
2672 if (*p1
== '+' || *p1
== '-') p1
++;
2673 /* Is it an integer? */
2676 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2677 /* Integers can have trailing decimal points. */
2678 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2680 /* It is an integer. */
2684 /* Fixme: if we have strtol, use that, and check
2686 if (sizeof (int) == sizeof (EMACS_INT
))
2687 XSETINT (val
, atoi (read_buffer
));
2688 else if (sizeof (long) == sizeof (EMACS_INT
))
2689 XSETINT (val
, atol (read_buffer
));
2695 if (isfloat_string (read_buffer
))
2697 /* Compute NaN and infinities using 0.0 in a variable,
2698 to cope with compilers that think they are smarter
2704 /* Negate the value ourselves. This treats 0, NaNs,
2705 and infinity properly on IEEE floating point hosts,
2706 and works around a common bug where atof ("-0.0")
2708 int negative
= read_buffer
[0] == '-';
2710 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2711 returns 1, is if the input ends in e+INF or e+NaN. */
2718 value
= zero
/ zero
;
2720 /* If that made a "negative" NaN, negate it. */
2724 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2727 u_minus_zero
.d
= - 0.0;
2728 for (i
= 0; i
< sizeof (double); i
++)
2729 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2735 /* Now VALUE is a positive NaN. */
2738 value
= atof (read_buffer
+ negative
);
2742 return make_float (negative
? - value
: value
);
2746 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2747 : intern (read_buffer
);
2748 if (EQ (Vread_with_symbol_positions
, Qt
)
2749 || EQ (Vread_with_symbol_positions
, readcharfun
))
2750 Vread_symbol_positions_list
=
2751 /* Kind of a hack; this will probably fail if characters
2752 in the symbol name were escaped. Not really a big
2754 Fcons (Fcons (result
,
2755 make_number (readchar_count
2756 - XFASTINT (Flength (Fsymbol_name (result
))))),
2757 Vread_symbol_positions_list
);
2765 /* List of nodes we've seen during substitute_object_in_subtree. */
2766 static Lisp_Object seen_list
;
2769 substitute_object_in_subtree (object
, placeholder
)
2771 Lisp_Object placeholder
;
2773 Lisp_Object check_object
;
2775 /* We haven't seen any objects when we start. */
2778 /* Make all the substitutions. */
2780 = substitute_object_recurse (object
, placeholder
, object
);
2782 /* Clear seen_list because we're done with it. */
2785 /* The returned object here is expected to always eq the
2787 if (!EQ (check_object
, object
))
2788 error ("Unexpected mutation error in reader");
2791 /* Feval doesn't get called from here, so no gc protection is needed. */
2792 #define SUBSTITUTE(get_val, set_val) \
2794 Lisp_Object old_value = get_val; \
2795 Lisp_Object true_value \
2796 = substitute_object_recurse (object, placeholder,\
2799 if (!EQ (old_value, true_value)) \
2806 substitute_object_recurse (object
, placeholder
, subtree
)
2808 Lisp_Object placeholder
;
2809 Lisp_Object subtree
;
2811 /* If we find the placeholder, return the target object. */
2812 if (EQ (placeholder
, subtree
))
2815 /* If we've been to this node before, don't explore it again. */
2816 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2819 /* If this node can be the entry point to a cycle, remember that
2820 we've seen it. It can only be such an entry point if it was made
2821 by #n=, which means that we can find it as a value in
2823 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2824 seen_list
= Fcons (subtree
, seen_list
);
2826 /* Recurse according to subtree's type.
2827 Every branch must return a Lisp_Object. */
2828 switch (XTYPE (subtree
))
2830 case Lisp_Vectorlike
:
2833 int length
= XINT (Flength(subtree
));
2834 for (i
= 0; i
< length
; i
++)
2836 Lisp_Object idx
= make_number (i
);
2837 SUBSTITUTE (Faref (subtree
, idx
),
2838 Faset (subtree
, idx
, true_value
));
2845 SUBSTITUTE (Fcar_safe (subtree
),
2846 Fsetcar (subtree
, true_value
));
2847 SUBSTITUTE (Fcdr_safe (subtree
),
2848 Fsetcdr (subtree
, true_value
));
2854 /* Check for text properties in each interval.
2855 substitute_in_interval contains part of the logic. */
2857 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2858 Lisp_Object arg
= Fcons (object
, placeholder
);
2860 traverse_intervals_noorder (root_interval
,
2861 &substitute_in_interval
, arg
);
2866 /* Other types don't recurse any further. */
2872 /* Helper function for substitute_object_recurse. */
2874 substitute_in_interval (interval
, arg
)
2878 Lisp_Object object
= Fcar (arg
);
2879 Lisp_Object placeholder
= Fcdr (arg
);
2881 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2900 if (*cp
== '+' || *cp
== '-')
2903 if (*cp
>= '0' && *cp
<= '9')
2906 while (*cp
>= '0' && *cp
<= '9')
2914 if (*cp
>= '0' && *cp
<= '9')
2917 while (*cp
>= '0' && *cp
<= '9')
2920 if (*cp
== 'e' || *cp
== 'E')
2924 if (*cp
== '+' || *cp
== '-')
2928 if (*cp
>= '0' && *cp
<= '9')
2931 while (*cp
>= '0' && *cp
<= '9')
2934 else if (cp
== start
)
2936 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2941 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2947 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2948 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2949 || state
== (DOT_CHAR
|TRAIL_INT
)
2950 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2951 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2952 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2957 read_vector (readcharfun
, bytecodeflag
)
2958 Lisp_Object readcharfun
;
2963 register Lisp_Object
*ptr
;
2964 register Lisp_Object tem
, item
, vector
;
2965 register struct Lisp_Cons
*otem
;
2968 tem
= read_list (1, readcharfun
);
2969 len
= Flength (tem
);
2970 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2972 size
= XVECTOR (vector
)->size
;
2973 ptr
= XVECTOR (vector
)->contents
;
2974 for (i
= 0; i
< size
; i
++)
2977 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2978 bytecode object, the docstring containing the bytecode and
2979 constants values must be treated as unibyte and passed to
2980 Fread, to get the actual bytecode string and constants vector. */
2981 if (bytecodeflag
&& load_force_doc_strings
)
2983 if (i
== COMPILED_BYTECODE
)
2985 if (!STRINGP (item
))
2986 error ("Invalid byte code");
2988 /* Delay handling the bytecode slot until we know whether
2989 it is lazily-loaded (we can tell by whether the
2990 constants slot is nil). */
2991 ptr
[COMPILED_CONSTANTS
] = item
;
2994 else if (i
== COMPILED_CONSTANTS
)
2996 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3000 /* Coerce string to unibyte (like string-as-unibyte,
3001 but without generating extra garbage and
3002 guaranteeing no change in the contents). */
3003 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3004 STRING_SET_UNIBYTE (bytestr
);
3006 item
= Fread (Fcons (bytestr
, readcharfun
));
3008 error ("Invalid byte code");
3010 otem
= XCONS (item
);
3011 bytestr
= XCAR (item
);
3016 /* Now handle the bytecode slot. */
3017 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3019 else if (i
== COMPILED_DOC_STRING
3021 && ! STRING_MULTIBYTE (item
))
3023 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3024 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3026 item
= Fstring_as_multibyte (item
);
3029 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3037 /* FLAG = 1 means check for ] to terminate rather than ) and .
3038 FLAG = -1 means check for starting with defun
3039 and make structure pure. */
3042 read_list (flag
, readcharfun
)
3044 register Lisp_Object readcharfun
;
3046 /* -1 means check next element for defun,
3047 0 means don't check,
3048 1 means already checked and found defun. */
3049 int defunflag
= flag
< 0 ? -1 : 0;
3050 Lisp_Object val
, tail
;
3051 register Lisp_Object elt
, tem
;
3052 struct gcpro gcpro1
, gcpro2
;
3053 /* 0 is the normal case.
3054 1 means this list is a doc reference; replace it with the number 0.
3055 2 means this list is a doc reference; replace it with the doc string. */
3056 int doc_reference
= 0;
3058 /* Initialize this to 1 if we are reading a list. */
3059 int first_in_list
= flag
<= 0;
3068 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3073 /* While building, if the list starts with #$, treat it specially. */
3074 if (EQ (elt
, Vload_file_name
)
3076 && !NILP (Vpurify_flag
))
3078 if (NILP (Vdoc_file_name
))
3079 /* We have not yet called Snarf-documentation, so assume
3080 this file is described in the DOC-MM.NN file
3081 and Snarf-documentation will fill in the right value later.
3082 For now, replace the whole list with 0. */
3085 /* We have already called Snarf-documentation, so make a relative
3086 file name for this file, so it can be found properly
3087 in the installed Lisp directory.
3088 We don't use Fexpand_file_name because that would make
3089 the directory absolute now. */
3090 elt
= concat2 (build_string ("../lisp/"),
3091 Ffile_name_nondirectory (elt
));
3093 else if (EQ (elt
, Vload_file_name
)
3095 && load_force_doc_strings
)
3104 Fsignal (Qinvalid_read_syntax
,
3105 Fcons (make_string (") or . in a vector", 18), Qnil
));
3113 XSETCDR (tail
, read0 (readcharfun
));
3115 val
= read0 (readcharfun
);
3116 read1 (readcharfun
, &ch
, 0);
3120 if (doc_reference
== 1)
3121 return make_number (0);
3122 if (doc_reference
== 2)
3124 /* Get a doc string from the file we are loading.
3125 If it's in saved_doc_string, get it from there.
3127 Here, we don't know if the string is a
3128 bytecode string or a doc string. As a
3129 bytecode string must be unibyte, we always
3130 return a unibyte string. If it is actually a
3131 doc string, caller must make it
3134 int pos
= XINT (XCDR (val
));
3135 /* Position is negative for user variables. */
3136 if (pos
< 0) pos
= -pos
;
3137 if (pos
>= saved_doc_string_position
3138 && pos
< (saved_doc_string_position
3139 + saved_doc_string_length
))
3141 int start
= pos
- saved_doc_string_position
;
3144 /* Process quoting with ^A,
3145 and find the end of the string,
3146 which is marked with ^_ (037). */
3147 for (from
= start
, to
= start
;
3148 saved_doc_string
[from
] != 037;)
3150 int c
= saved_doc_string
[from
++];
3153 c
= saved_doc_string
[from
++];
3155 saved_doc_string
[to
++] = c
;
3157 saved_doc_string
[to
++] = 0;
3159 saved_doc_string
[to
++] = 037;
3162 saved_doc_string
[to
++] = c
;
3165 return make_unibyte_string (saved_doc_string
+ start
,
3168 /* Look in prev_saved_doc_string the same way. */
3169 else if (pos
>= prev_saved_doc_string_position
3170 && pos
< (prev_saved_doc_string_position
3171 + prev_saved_doc_string_length
))
3173 int start
= pos
- prev_saved_doc_string_position
;
3176 /* Process quoting with ^A,
3177 and find the end of the string,
3178 which is marked with ^_ (037). */
3179 for (from
= start
, to
= start
;
3180 prev_saved_doc_string
[from
] != 037;)
3182 int c
= prev_saved_doc_string
[from
++];
3185 c
= prev_saved_doc_string
[from
++];
3187 prev_saved_doc_string
[to
++] = c
;
3189 prev_saved_doc_string
[to
++] = 0;
3191 prev_saved_doc_string
[to
++] = 037;
3194 prev_saved_doc_string
[to
++] = c
;
3197 return make_unibyte_string (prev_saved_doc_string
3202 return get_doc_string (val
, 1, 0);
3207 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3209 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3211 tem
= (read_pure
&& flag
<= 0
3212 ? pure_cons (elt
, Qnil
)
3213 : Fcons (elt
, Qnil
));
3215 XSETCDR (tail
, tem
);
3220 defunflag
= EQ (elt
, Qdefun
);
3221 else if (defunflag
> 0)
3226 Lisp_Object Vobarray
;
3227 Lisp_Object initial_obarray
;
3229 /* oblookup stores the bucket number here, for the sake of Funintern. */
3231 int oblookup_last_bucket_number
;
3233 static int hash_string ();
3235 /* Get an error if OBARRAY is not an obarray.
3236 If it is one, return it. */
3239 check_obarray (obarray
)
3240 Lisp_Object obarray
;
3242 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3244 /* If Vobarray is now invalid, force it to be valid. */
3245 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3247 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3252 /* Intern the C string STR: return a symbol with that name,
3253 interned in the current obarray. */
3260 int len
= strlen (str
);
3261 Lisp_Object obarray
;
3264 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3265 obarray
= check_obarray (obarray
);
3266 tem
= oblookup (obarray
, str
, len
, len
);
3269 return Fintern (make_string (str
, len
), obarray
);
3272 /* Create an uninterned symbol with name STR. */
3278 int len
= strlen (str
);
3280 return Fmake_symbol ((!NILP (Vpurify_flag
)
3281 ? make_pure_string (str
, len
, len
, 0)
3282 : make_string (str
, len
)));
3285 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3286 doc
: /* Return the canonical symbol whose name is STRING.
3287 If there is none, one is created by this function and returned.
3288 A second optional argument specifies the obarray to use;
3289 it defaults to the value of `obarray'. */)
3291 Lisp_Object string
, obarray
;
3293 register Lisp_Object tem
, sym
, *ptr
;
3295 if (NILP (obarray
)) obarray
= Vobarray
;
3296 obarray
= check_obarray (obarray
);
3298 CHECK_STRING (string
);
3300 tem
= oblookup (obarray
, SDATA (string
),
3303 if (!INTEGERP (tem
))
3306 if (!NILP (Vpurify_flag
))
3307 string
= Fpurecopy (string
);
3308 sym
= Fmake_symbol (string
);
3310 if (EQ (obarray
, initial_obarray
))
3311 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3313 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3315 if ((SREF (string
, 0) == ':')
3316 && EQ (obarray
, initial_obarray
))
3318 XSYMBOL (sym
)->constant
= 1;
3319 XSYMBOL (sym
)->value
= sym
;
3322 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3324 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3326 XSYMBOL (sym
)->next
= 0;
3331 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3332 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3333 NAME may be a string or a symbol. If it is a symbol, that exact
3334 symbol is searched for.
3335 A second optional argument specifies the obarray to use;
3336 it defaults to the value of `obarray'. */)
3338 Lisp_Object name
, obarray
;
3340 register Lisp_Object tem
, string
;
3342 if (NILP (obarray
)) obarray
= Vobarray
;
3343 obarray
= check_obarray (obarray
);
3345 if (!SYMBOLP (name
))
3347 CHECK_STRING (name
);
3351 string
= SYMBOL_NAME (name
);
3353 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3354 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3360 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3361 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3362 The value is t if a symbol was found and deleted, nil otherwise.
3363 NAME may be a string or a symbol. If it is a symbol, that symbol
3364 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3365 OBARRAY defaults to the value of the variable `obarray'. */)
3367 Lisp_Object name
, obarray
;
3369 register Lisp_Object string
, tem
;
3372 if (NILP (obarray
)) obarray
= Vobarray
;
3373 obarray
= check_obarray (obarray
);
3376 string
= SYMBOL_NAME (name
);
3379 CHECK_STRING (name
);
3383 tem
= oblookup (obarray
, SDATA (string
),
3388 /* If arg was a symbol, don't delete anything but that symbol itself. */
3389 if (SYMBOLP (name
) && !EQ (name
, tem
))
3392 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3393 XSYMBOL (tem
)->constant
= 0;
3394 XSYMBOL (tem
)->indirect_variable
= 0;
3396 hash
= oblookup_last_bucket_number
;
3398 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3400 if (XSYMBOL (tem
)->next
)
3401 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3403 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3407 Lisp_Object tail
, following
;
3409 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3410 XSYMBOL (tail
)->next
;
3413 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3414 if (EQ (following
, tem
))
3416 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3425 /* Return the symbol in OBARRAY whose names matches the string
3426 of SIZE characters (SIZE_BYTE bytes) at PTR.
3427 If there is no such symbol in OBARRAY, return nil.
3429 Also store the bucket number in oblookup_last_bucket_number. */
3432 oblookup (obarray
, ptr
, size
, size_byte
)
3433 Lisp_Object obarray
;
3434 register const char *ptr
;
3435 int size
, size_byte
;
3439 register Lisp_Object tail
;
3440 Lisp_Object bucket
, tem
;
3442 if (!VECTORP (obarray
)
3443 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3445 obarray
= check_obarray (obarray
);
3446 obsize
= XVECTOR (obarray
)->size
;
3448 /* This is sometimes needed in the middle of GC. */
3449 obsize
&= ~ARRAY_MARK_FLAG
;
3450 /* Combining next two lines breaks VMS C 2.3. */
3451 hash
= hash_string (ptr
, size_byte
);
3453 bucket
= XVECTOR (obarray
)->contents
[hash
];
3454 oblookup_last_bucket_number
= hash
;
3455 if (EQ (bucket
, make_number (0)))
3457 else if (!SYMBOLP (bucket
))
3458 error ("Bad data in guts of obarray"); /* Like CADR error message */
3460 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3462 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3463 && SCHARS (SYMBOL_NAME (tail
)) == size
3464 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3466 else if (XSYMBOL (tail
)->next
== 0)
3469 XSETINT (tem
, hash
);
3474 hash_string (ptr
, len
)
3475 const unsigned char *ptr
;
3478 register const unsigned char *p
= ptr
;
3479 register const unsigned char *end
= p
+ len
;
3480 register unsigned char c
;
3481 register int hash
= 0;
3486 if (c
>= 0140) c
-= 40;
3487 hash
= ((hash
<<3) + (hash
>>28) + c
);
3489 return hash
& 07777777777;
3493 map_obarray (obarray
, fn
, arg
)
3494 Lisp_Object obarray
;
3495 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3499 register Lisp_Object tail
;
3500 CHECK_VECTOR (obarray
);
3501 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3503 tail
= XVECTOR (obarray
)->contents
[i
];
3508 if (XSYMBOL (tail
)->next
== 0)
3510 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3516 mapatoms_1 (sym
, function
)
3517 Lisp_Object sym
, function
;
3519 call1 (function
, sym
);
3522 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3523 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3524 OBARRAY defaults to the value of `obarray'. */)
3526 Lisp_Object function
, obarray
;
3528 if (NILP (obarray
)) obarray
= Vobarray
;
3529 obarray
= check_obarray (obarray
);
3531 map_obarray (obarray
, mapatoms_1
, function
);
3535 #define OBARRAY_SIZE 1511
3540 Lisp_Object oblength
;
3544 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3546 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3547 Vobarray
= Fmake_vector (oblength
, make_number (0));
3548 initial_obarray
= Vobarray
;
3549 staticpro (&initial_obarray
);
3550 /* Intern nil in the obarray */
3551 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3552 XSYMBOL (Qnil
)->constant
= 1;
3554 /* These locals are to kludge around a pyramid compiler bug. */
3555 hash
= hash_string ("nil", 3);
3556 /* Separate statement here to avoid VAXC bug. */
3557 hash
%= OBARRAY_SIZE
;
3558 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3561 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3562 XSYMBOL (Qnil
)->function
= Qunbound
;
3563 XSYMBOL (Qunbound
)->value
= Qunbound
;
3564 XSYMBOL (Qunbound
)->function
= Qunbound
;
3567 XSYMBOL (Qnil
)->value
= Qnil
;
3568 XSYMBOL (Qnil
)->plist
= Qnil
;
3569 XSYMBOL (Qt
)->value
= Qt
;
3570 XSYMBOL (Qt
)->constant
= 1;
3572 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3575 Qvariable_documentation
= intern ("variable-documentation");
3576 staticpro (&Qvariable_documentation
);
3578 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3579 read_buffer
= (char *) xmalloc (read_buffer_size
);
3584 struct Lisp_Subr
*sname
;
3587 sym
= intern (sname
->symbol_name
);
3588 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3591 #ifdef NOTDEF /* use fset in subr.el now */
3593 defalias (sname
, string
)
3594 struct Lisp_Subr
*sname
;
3598 sym
= intern (string
);
3599 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3603 /* Define an "integer variable"; a symbol whose value is forwarded
3604 to a C variable of type int. Sample call: */
3605 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3607 defvar_int (namestring
, address
)
3611 Lisp_Object sym
, val
;
3612 sym
= intern (namestring
);
3613 val
= allocate_misc ();
3614 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3615 XINTFWD (val
)->intvar
= address
;
3616 SET_SYMBOL_VALUE (sym
, val
);
3619 /* Similar but define a variable whose value is t if address contains 1,
3620 nil if address contains 0 */
3622 defvar_bool (namestring
, address
)
3626 Lisp_Object sym
, val
;
3627 sym
= intern (namestring
);
3628 val
= allocate_misc ();
3629 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3630 XBOOLFWD (val
)->boolvar
= address
;
3631 SET_SYMBOL_VALUE (sym
, val
);
3632 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3635 /* Similar but define a variable whose value is the Lisp Object stored
3636 at address. Two versions: with and without gc-marking of the C
3637 variable. The nopro version is used when that variable will be
3638 gc-marked for some other reason, since marking the same slot twice
3639 can cause trouble with strings. */
3641 defvar_lisp_nopro (namestring
, address
)
3643 Lisp_Object
*address
;
3645 Lisp_Object sym
, val
;
3646 sym
= intern (namestring
);
3647 val
= allocate_misc ();
3648 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3649 XOBJFWD (val
)->objvar
= address
;
3650 SET_SYMBOL_VALUE (sym
, val
);
3654 defvar_lisp (namestring
, address
)
3656 Lisp_Object
*address
;
3658 defvar_lisp_nopro (namestring
, address
);
3659 staticpro (address
);
3662 /* Similar but define a variable whose value is the Lisp Object stored in
3663 the current buffer. address is the address of the slot in the buffer
3664 that is current now. */
3667 defvar_per_buffer (namestring
, address
, type
, doc
)
3669 Lisp_Object
*address
;
3673 Lisp_Object sym
, val
;
3676 sym
= intern (namestring
);
3677 val
= allocate_misc ();
3678 offset
= (char *)address
- (char *)current_buffer
;
3680 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3681 XBUFFER_OBJFWD (val
)->offset
= offset
;
3682 SET_SYMBOL_VALUE (sym
, val
);
3683 PER_BUFFER_SYMBOL (offset
) = sym
;
3684 PER_BUFFER_TYPE (offset
) = type
;
3686 if (PER_BUFFER_IDX (offset
) == 0)
3687 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3688 slot of buffer_local_flags */
3693 /* Similar but define a variable whose value is the Lisp Object stored
3694 at a particular offset in the current kboard object. */
3697 defvar_kboard (namestring
, offset
)
3701 Lisp_Object sym
, val
;
3702 sym
= intern (namestring
);
3703 val
= allocate_misc ();
3704 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3705 XKBOARD_OBJFWD (val
)->offset
= offset
;
3706 SET_SYMBOL_VALUE (sym
, val
);
3709 /* Record the value of load-path used at the start of dumping
3710 so we can see if the site changed it later during dumping. */
3711 static Lisp_Object dump_path
;
3717 int turn_off_warning
= 0;
3719 /* Compute the default load-path. */
3721 normal
= PATH_LOADSEARCH
;
3722 Vload_path
= decode_env_path (0, normal
);
3724 if (NILP (Vpurify_flag
))
3725 normal
= PATH_LOADSEARCH
;
3727 normal
= PATH_DUMPLOADSEARCH
;
3729 /* In a dumped Emacs, we normally have to reset the value of
3730 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3731 uses ../lisp, instead of the path of the installed elisp
3732 libraries. However, if it appears that Vload_path was changed
3733 from the default before dumping, don't override that value. */
3736 if (! NILP (Fequal (dump_path
, Vload_path
)))
3738 Vload_path
= decode_env_path (0, normal
);
3739 if (!NILP (Vinstallation_directory
))
3741 Lisp_Object tem
, tem1
, sitelisp
;
3743 /* Remove site-lisp dirs from path temporarily and store
3744 them in sitelisp, then conc them on at the end so
3745 they're always first in path. */
3749 tem
= Fcar (Vload_path
);
3750 tem1
= Fstring_match (build_string ("site-lisp"),
3754 Vload_path
= Fcdr (Vload_path
);
3755 sitelisp
= Fcons (tem
, sitelisp
);
3761 /* Add to the path the lisp subdir of the
3762 installation dir, if it exists. */
3763 tem
= Fexpand_file_name (build_string ("lisp"),
3764 Vinstallation_directory
);
3765 tem1
= Ffile_exists_p (tem
);
3768 if (NILP (Fmember (tem
, Vload_path
)))
3770 turn_off_warning
= 1;
3771 Vload_path
= Fcons (tem
, Vload_path
);
3775 /* That dir doesn't exist, so add the build-time
3776 Lisp dirs instead. */
3777 Vload_path
= nconc2 (Vload_path
, dump_path
);
3779 /* Add leim under the installation dir, if it exists. */
3780 tem
= Fexpand_file_name (build_string ("leim"),
3781 Vinstallation_directory
);
3782 tem1
= Ffile_exists_p (tem
);
3785 if (NILP (Fmember (tem
, Vload_path
)))
3786 Vload_path
= Fcons (tem
, Vload_path
);
3789 /* Add site-list under the installation dir, if it exists. */
3790 tem
= Fexpand_file_name (build_string ("site-lisp"),
3791 Vinstallation_directory
);
3792 tem1
= Ffile_exists_p (tem
);
3795 if (NILP (Fmember (tem
, Vload_path
)))
3796 Vload_path
= Fcons (tem
, Vload_path
);
3799 /* If Emacs was not built in the source directory,
3800 and it is run from where it was built, add to load-path
3801 the lisp, leim and site-lisp dirs under that directory. */
3803 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3807 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3808 Vinstallation_directory
);
3809 tem1
= Ffile_exists_p (tem
);
3811 /* Don't be fooled if they moved the entire source tree
3812 AFTER dumping Emacs. If the build directory is indeed
3813 different from the source dir, src/Makefile.in and
3814 src/Makefile will not be found together. */
3815 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3816 Vinstallation_directory
);
3817 tem2
= Ffile_exists_p (tem
);
3818 if (!NILP (tem1
) && NILP (tem2
))
3820 tem
= Fexpand_file_name (build_string ("lisp"),
3823 if (NILP (Fmember (tem
, Vload_path
)))
3824 Vload_path
= Fcons (tem
, Vload_path
);
3826 tem
= Fexpand_file_name (build_string ("leim"),
3829 if (NILP (Fmember (tem
, Vload_path
)))
3830 Vload_path
= Fcons (tem
, Vload_path
);
3832 tem
= Fexpand_file_name (build_string ("site-lisp"),
3835 if (NILP (Fmember (tem
, Vload_path
)))
3836 Vload_path
= Fcons (tem
, Vload_path
);
3839 if (!NILP (sitelisp
))
3840 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3846 /* NORMAL refers to the lisp dir in the source directory. */
3847 /* We used to add ../lisp at the front here, but
3848 that caused trouble because it was copied from dump_path
3849 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3850 It should be unnecessary. */
3851 Vload_path
= decode_env_path (0, normal
);
3852 dump_path
= Vload_path
;
3856 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3857 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3858 almost never correct, thereby causing a warning to be printed out that
3859 confuses users. Since PATH_LOADSEARCH is always overridden by the
3860 EMACSLOADPATH environment variable below, disable the warning on NT.
3861 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3862 the "standard" paths may not exist and would be overridden by
3863 EMACSLOADPATH as on NT. Since this depends on how the executable
3864 was build and packaged, turn off the warnings in general */
3866 /* Warn if dirs in the *standard* path don't exist. */
3867 if (!turn_off_warning
)
3869 Lisp_Object path_tail
;
3871 for (path_tail
= Vload_path
;
3873 path_tail
= XCDR (path_tail
))
3875 Lisp_Object dirfile
;
3876 dirfile
= Fcar (path_tail
);
3877 if (STRINGP (dirfile
))
3879 dirfile
= Fdirectory_file_name (dirfile
);
3880 if (access (SDATA (dirfile
), 0) < 0)
3881 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3886 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3888 /* If the EMACSLOADPATH environment variable is set, use its value.
3889 This doesn't apply if we're dumping. */
3891 if (NILP (Vpurify_flag
)
3892 && egetenv ("EMACSLOADPATH"))
3894 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3898 load_in_progress
= 0;
3899 Vload_file_name
= Qnil
;
3901 load_descriptor_list
= Qnil
;
3903 Vstandard_input
= Qt
;
3904 Vloads_in_progress
= Qnil
;
3907 /* Print a warning, using format string FORMAT, that directory DIRNAME
3908 does not exist. Print it on stderr and put it in *Message*. */
3911 dir_warning (format
, dirname
)
3913 Lisp_Object dirname
;
3916 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3918 fprintf (stderr
, format
, SDATA (dirname
));
3919 sprintf (buffer
, format
, SDATA (dirname
));
3920 /* Don't log the warning before we've initialized!! */
3922 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3929 defsubr (&Sread_from_string
);
3931 defsubr (&Sintern_soft
);
3932 defsubr (&Sunintern
);
3934 defsubr (&Seval_buffer
);
3935 defsubr (&Seval_region
);
3936 defsubr (&Sread_char
);
3937 defsubr (&Sread_char_exclusive
);
3938 defsubr (&Sread_event
);
3939 defsubr (&Sget_file_char
);
3940 defsubr (&Smapatoms
);
3941 defsubr (&Slocate_file_internal
);
3943 DEFVAR_LISP ("obarray", &Vobarray
,
3944 doc
: /* Symbol table for use by `intern' and `read'.
3945 It is a vector whose length ought to be prime for best results.
3946 The vector's contents don't make sense if examined from Lisp programs;
3947 to find all the symbols in an obarray, use `mapatoms'. */);
3949 DEFVAR_LISP ("values", &Vvalues
,
3950 doc
: /* List of values of all expressions which were read, evaluated and printed.
3951 Order is reverse chronological. */);
3953 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3954 doc
: /* Stream for read to get input from.
3955 See documentation of `read' for possible values. */);
3956 Vstandard_input
= Qt
;
3958 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3959 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3961 If this variable is a buffer, then only forms read from that buffer
3962 will be added to `read-symbol-positions-list'.
3963 If this variable is t, then all read forms will be added.
3964 The effect of all other values other than nil are not currently
3965 defined, although they may be in the future.
3967 The positions are relative to the last call to `read' or
3968 `read-from-string'. It is probably a bad idea to set this variable at
3969 the toplevel; bind it instead. */);
3970 Vread_with_symbol_positions
= Qnil
;
3972 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3973 doc
: /* A list mapping read symbols to their positions.
3974 This variable is modified during calls to `read' or
3975 `read-from-string', but only when `read-with-symbol-positions' is
3978 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3979 CHAR-POSITION is an integer giving the offset of that occurrence of the
3980 symbol from the position where `read' or `read-from-string' started.
3982 Note that a symbol will appear multiple times in this list, if it was
3983 read multiple times. The list is in the same order as the symbols
3985 Vread_symbol_positions_list
= Qnil
;
3987 DEFVAR_LISP ("load-path", &Vload_path
,
3988 doc
: /* *List of directories to search for files to load.
3989 Each element is a string (directory name) or nil (try default directory).
3990 Initialized based on EMACSLOADPATH environment variable, if any,
3991 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3993 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3994 doc
: /* *List of suffixes to try for files to load.
3995 This list should not include the empty string. */);
3996 Vload_suffixes
= Fcons (build_string (".elc"),
3997 Fcons (build_string (".el"), Qnil
));
3998 /* We don't use empty_string because it's not initialized yet. */
3999 default_suffixes
= Fcons (build_string (""), Qnil
);
4000 staticpro (&default_suffixes
);
4002 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4003 doc
: /* Non-nil iff inside of `load'. */);
4005 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4006 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4007 Each element looks like (FILENAME FORMS...).
4008 When `load' is run and the file-name argument is FILENAME,
4009 the FORMS in the corresponding element are executed at the end of loading.
4011 FILENAME must match exactly! Normally FILENAME is the name of a library,
4012 with no directory specified, since that is how `load' is normally called.
4013 An error in FORMS does not undo the load,
4014 but does prevent execution of the rest of the FORMS.
4015 FILENAME can also be a symbol (a feature) and FORMS are then executed
4016 when the corresponding call to `provide' is made. */);
4017 Vafter_load_alist
= Qnil
;
4019 DEFVAR_LISP ("load-history", &Vload_history
,
4020 doc
: /* Alist mapping source file names to symbols and features.
4021 Each alist element is a list that starts with a file name,
4022 except for one element (optional) that starts with nil and describes
4023 definitions evaluated from buffers not visiting files.
4024 The remaining elements of each list are symbols defined as variables
4025 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4026 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
4027 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
4028 and means that SYMBOL was an autoload before this file redefined it
4030 Vload_history
= Qnil
;
4032 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4033 doc
: /* Full name of file being loaded by `load'. */);
4034 Vload_file_name
= Qnil
;
4036 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4037 doc
: /* File name, including directory, of user's initialization file.
4038 If the file loaded had extension `.elc', and the corresponding source file
4039 exists, this variable contains the name of source file, suitable for use
4040 by functions like `custom-save-all' which edit the init file. */);
4041 Vuser_init_file
= Qnil
;
4043 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4044 doc
: /* Used for internal purposes by `load'. */);
4045 Vcurrent_load_list
= Qnil
;
4047 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4048 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4049 The default is nil, which means use the function `read'. */);
4050 Vload_read_function
= Qnil
;
4052 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4053 doc
: /* Function called in `load' for loading an Emacs lisp source file.
4054 This function is for doing code conversion before reading the source file.
4055 If nil, loading is done without any code conversion.
4056 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4057 FULLNAME is the full name of FILE.
4058 See `load' for the meaning of the remaining arguments. */);
4059 Vload_source_file_function
= Qnil
;
4061 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4062 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4063 This is useful when the file being loaded is a temporary copy. */);
4064 load_force_doc_strings
= 0;
4066 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4067 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4068 This is normally bound by `load' and `eval-buffer' to control `read',
4069 and is not meant for users to change. */);
4070 load_convert_to_unibyte
= 0;
4072 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4073 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4074 You cannot count on them to still be there! */);
4076 = Fexpand_file_name (build_string ("../"),
4077 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4079 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4080 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4081 Vpreloaded_file_list
= Qnil
;
4083 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4084 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4085 Vbyte_boolean_vars
= Qnil
;
4087 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4088 doc
: /* Non-nil means load dangerous compiled Lisp files.
4089 Some versions of XEmacs use different byte codes than Emacs. These
4090 incompatible byte codes can make Emacs crash when it tries to execute
4092 load_dangerous_libraries
= 0;
4094 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4095 doc
: /* Regular expression matching safe to load compiled Lisp files.
4096 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4097 from the file, and matches them against this regular expression.
4098 When the regular expression matches, the file is considered to be safe
4099 to load. See also `load-dangerous-libraries'. */);
4100 Vbytecomp_version_regexp
4101 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4103 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4104 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4105 Veval_buffer_list
= Qnil
;
4107 /* Vsource_directory was initialized in init_lread. */
4109 load_descriptor_list
= Qnil
;
4110 staticpro (&load_descriptor_list
);
4112 Qcurrent_load_list
= intern ("current-load-list");
4113 staticpro (&Qcurrent_load_list
);
4115 Qstandard_input
= intern ("standard-input");
4116 staticpro (&Qstandard_input
);
4118 Qread_char
= intern ("read-char");
4119 staticpro (&Qread_char
);
4121 Qget_file_char
= intern ("get-file-char");
4122 staticpro (&Qget_file_char
);
4124 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4125 staticpro (&Qget_emacs_mule_file_char
);
4127 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4128 staticpro (&Qload_force_doc_strings
);
4130 Qbackquote
= intern ("`");
4131 staticpro (&Qbackquote
);
4132 Qcomma
= intern (",");
4133 staticpro (&Qcomma
);
4134 Qcomma_at
= intern (",@");
4135 staticpro (&Qcomma_at
);
4136 Qcomma_dot
= intern (",.");
4137 staticpro (&Qcomma_dot
);
4139 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4140 staticpro (&Qinhibit_file_name_operation
);
4142 Qascii_character
= intern ("ascii-character");
4143 staticpro (&Qascii_character
);
4145 Qfunction
= intern ("function");
4146 staticpro (&Qfunction
);
4148 Qload
= intern ("load");
4151 Qload_file_name
= intern ("load-file-name");
4152 staticpro (&Qload_file_name
);
4154 Qeval_buffer_list
= intern ("eval-buffer-list");
4155 staticpro (&Qeval_buffer_list
);
4157 staticpro (&dump_path
);
4159 staticpro (&read_objects
);
4160 read_objects
= Qnil
;
4161 staticpro (&seen_list
);
4164 Vloads_in_progress
= Qnil
;
4165 staticpro (&Vloads_in_progress
);
4168 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4169 (do not change this comment) */