1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
36 #include "termhooks.h"
40 #include <sys/inode.h>
45 #include <unistd.h> /* to get X_OK */
62 #endif /* HAVE_SETLOCALE */
72 #define file_offset off_t
73 #define file_tell ftello
75 #define file_offset long
76 #define file_tell ftell
83 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
84 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
85 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
86 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
87 Lisp_Object Qinhibit_file_name_operation
;
89 extern Lisp_Object Qevent_symbol_element_mask
;
90 extern Lisp_Object Qfile_exists_p
;
92 /* non-zero iff inside `load' */
95 /* Directory in which the sources were found. */
96 Lisp_Object Vsource_directory
;
98 /* Search path and suffixes for files to be loaded. */
99 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
101 /* File name of user's init file. */
102 Lisp_Object Vuser_init_file
;
104 /* This is the user-visible association list that maps features to
105 lists of defs in their load files. */
106 Lisp_Object Vload_history
;
108 /* This is used to build the load history. */
109 Lisp_Object Vcurrent_load_list
;
111 /* List of files that were preloaded. */
112 Lisp_Object Vpreloaded_file_list
;
114 /* Name of file actually being read by `load'. */
115 Lisp_Object Vload_file_name
;
117 /* Function to use for reading, in `load' and friends. */
118 Lisp_Object Vload_read_function
;
120 /* The association list of objects read with the #n=object form.
121 Each member of the list has the form (n . object), and is used to
122 look up the object for the corresponding #n# construct.
123 It must be set to nil before all top-level calls to read0. */
124 Lisp_Object read_objects
;
126 /* Nonzero means load should forcibly load all dynamic doc strings. */
127 static int load_force_doc_strings
;
129 /* Nonzero means read should convert strings to unibyte. */
130 static int load_convert_to_unibyte
;
132 /* Function to use for loading an Emacs lisp source file (not
133 compiled) instead of readevalloop. */
134 Lisp_Object Vload_source_file_function
;
136 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
137 Lisp_Object Vbyte_boolean_vars
;
139 /* Whether or not to add a `read-positions' property to symbols
141 Lisp_Object Vread_with_symbol_positions
;
143 /* List of (SYMBOL . POSITION) accumulated so far. */
144 Lisp_Object Vread_symbol_positions_list
;
146 /* List of descriptors now open for Fload. */
147 static Lisp_Object load_descriptor_list
;
149 /* File for get_file_char to read from. Use by load. */
150 static FILE *instream
;
152 /* When nonzero, read conses in pure space */
153 static int read_pure
;
155 /* For use within read-from-string (this reader is non-reentrant!!) */
156 static int read_from_string_index
;
157 static int read_from_string_index_byte
;
158 static int read_from_string_limit
;
160 /* Number of bytes left to read in the buffer character
161 that `readchar' has already advanced over. */
162 static int readchar_backlog
;
163 /* Number of characters read in the current call to Fread or
164 Fread_from_string. */
165 static int readchar_count
;
167 /* This contains the last string skipped with #@. */
168 static char *saved_doc_string
;
169 /* Length of buffer allocated in saved_doc_string. */
170 static int saved_doc_string_size
;
171 /* Length of actual data in saved_doc_string. */
172 static int saved_doc_string_length
;
173 /* This is the file position that string came from. */
174 static file_offset saved_doc_string_position
;
176 /* This contains the previous string skipped with #@.
177 We copy it from saved_doc_string when a new string
178 is put in saved_doc_string. */
179 static char *prev_saved_doc_string
;
180 /* Length of buffer allocated in prev_saved_doc_string. */
181 static int prev_saved_doc_string_size
;
182 /* Length of actual data in prev_saved_doc_string. */
183 static int prev_saved_doc_string_length
;
184 /* This is the file position that string came from. */
185 static file_offset prev_saved_doc_string_position
;
187 /* Nonzero means inside a new-style backquote
188 with no surrounding parentheses.
189 Fread initializes this to zero, so we need not specbind it
190 or worry about what happens to it when there is an error. */
191 static int new_backquote_flag
;
193 /* A list of file names for files being loaded in Fload. Used to
194 check for recursive loads. */
196 static Lisp_Object Vloads_in_progress
;
198 /* Non-zero means load dangerous compiled Lisp files. */
200 int load_dangerous_libraries
;
202 /* A regular expression used to detect files compiled with Emacs. */
204 static Lisp_Object Vbytecomp_version_regexp
;
206 static void to_multibyte
P_ ((char **, char **, int *));
207 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
208 Lisp_Object (*) (), int,
209 Lisp_Object
, Lisp_Object
,
210 Lisp_Object
, Lisp_Object
));
211 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
212 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
215 /* Handle unreading and rereading of characters.
216 Write READCHAR to read a character,
217 UNREAD(c) to unread c to be read again.
219 The READCHAR and UNREAD macros are meant for reading/unreading a
220 byte code; they do not handle multibyte characters. The caller
221 should manage them if necessary.
223 [ Actually that seems to be a lie; READCHAR will definitely read
224 multibyte characters from buffer sources, at least. Is the
225 comment just out of date?
226 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
229 #define READCHAR readchar (readcharfun)
230 #define UNREAD(c) unreadchar (readcharfun, c)
233 readchar (readcharfun
)
234 Lisp_Object readcharfun
;
241 if (BUFFERP (readcharfun
))
243 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
245 int pt_byte
= BUF_PT_BYTE (inbuffer
);
246 int orig_pt_byte
= pt_byte
;
248 if (readchar_backlog
> 0)
249 /* We get the address of the byte just passed,
250 which is the last byte of the character.
251 The other bytes in this character are consecutive with it,
252 because the gap can't be in the middle of a character. */
253 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
254 - --readchar_backlog
);
256 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
259 readchar_backlog
= -1;
261 if (! NILP (inbuffer
->enable_multibyte_characters
))
263 /* Fetch the character code from the buffer. */
264 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
265 BUF_INC_POS (inbuffer
, pt_byte
);
266 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
270 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
273 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
277 if (MARKERP (readcharfun
))
279 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
281 int bytepos
= marker_byte_position (readcharfun
);
282 int orig_bytepos
= bytepos
;
284 if (readchar_backlog
> 0)
285 /* We get the address of the byte just passed,
286 which is the last byte of the character.
287 The other bytes in this character are consecutive with it,
288 because the gap can't be in the middle of a character. */
289 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
290 - --readchar_backlog
);
292 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
295 readchar_backlog
= -1;
297 if (! NILP (inbuffer
->enable_multibyte_characters
))
299 /* Fetch the character code from the buffer. */
300 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
301 BUF_INC_POS (inbuffer
, bytepos
);
302 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
306 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
310 XMARKER (readcharfun
)->bytepos
= bytepos
;
311 XMARKER (readcharfun
)->charpos
++;
316 if (EQ (readcharfun
, Qlambda
))
317 return read_bytecode_char (0);
319 if (EQ (readcharfun
, Qget_file_char
))
323 /* Interrupted reads have been observed while reading over the network */
324 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
334 if (STRINGP (readcharfun
))
336 if (read_from_string_index
>= read_from_string_limit
)
339 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
340 read_from_string_index
,
341 read_from_string_index_byte
);
346 tem
= call0 (readcharfun
);
353 /* Unread the character C in the way appropriate for the stream READCHARFUN.
354 If the stream is a user function, call it with the char as argument. */
357 unreadchar (readcharfun
, c
)
358 Lisp_Object readcharfun
;
363 /* Don't back up the pointer if we're unreading the end-of-input mark,
364 since readchar didn't advance it when we read it. */
366 else if (BUFFERP (readcharfun
))
368 struct buffer
*b
= XBUFFER (readcharfun
);
369 int bytepos
= BUF_PT_BYTE (b
);
371 if (readchar_backlog
>= 0)
376 if (! NILP (b
->enable_multibyte_characters
))
377 BUF_DEC_POS (b
, bytepos
);
381 BUF_PT_BYTE (b
) = bytepos
;
384 else if (MARKERP (readcharfun
))
386 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
387 int bytepos
= XMARKER (readcharfun
)->bytepos
;
389 if (readchar_backlog
>= 0)
393 XMARKER (readcharfun
)->charpos
--;
394 if (! NILP (b
->enable_multibyte_characters
))
395 BUF_DEC_POS (b
, bytepos
);
399 XMARKER (readcharfun
)->bytepos
= bytepos
;
402 else if (STRINGP (readcharfun
))
404 read_from_string_index
--;
405 read_from_string_index_byte
406 = string_char_to_byte (readcharfun
, read_from_string_index
);
408 else if (EQ (readcharfun
, Qlambda
))
409 read_bytecode_char (1);
410 else if (EQ (readcharfun
, Qget_file_char
))
411 ungetc (c
, instream
);
413 call1 (readcharfun
, make_number (c
));
416 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
418 static Lisp_Object read0
P_ ((Lisp_Object
));
419 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
421 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
422 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
423 static int read_multibyte
P_ ((int, Lisp_Object
));
425 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
427 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
429 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
432 /* Get a character from the tty. */
434 extern Lisp_Object
read_char ();
436 /* Read input events until we get one that's acceptable for our purposes.
438 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
439 until we get a character we like, and then stuffed into
442 If ASCII_REQUIRED is non-zero, we check function key events to see
443 if the unmodified version of the symbol has a Qascii_character
444 property, and use that character, if present.
446 If ERROR_NONASCII is non-zero, we signal an error if the input we
447 get isn't an ASCII character with modifiers. If it's zero but
448 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
451 If INPUT_METHOD is nonzero, we invoke the current input method
452 if the character warrants that. */
455 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
457 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
459 register Lisp_Object val
, delayed_switch_frame
;
461 #ifdef HAVE_WINDOW_SYSTEM
462 if (display_hourglass_p
)
466 delayed_switch_frame
= Qnil
;
468 /* Read until we get an acceptable event. */
470 val
= read_char (0, 0, 0,
471 (input_method
? Qnil
: Qt
),
477 /* switch-frame events are put off until after the next ASCII
478 character. This is better than signaling an error just because
479 the last characters were typed to a separate minibuffer frame,
480 for example. Eventually, some code which can deal with
481 switch-frame events will read it and process it. */
483 && EVENT_HAS_PARAMETERS (val
)
484 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
486 delayed_switch_frame
= val
;
492 /* Convert certain symbols to their ASCII equivalents. */
495 Lisp_Object tem
, tem1
;
496 tem
= Fget (val
, Qevent_symbol_element_mask
);
499 tem1
= Fget (Fcar (tem
), Qascii_character
);
500 /* Merge this symbol's modifier bits
501 with the ASCII equivalent of its basic code. */
503 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
507 /* If we don't have a character now, deal with it appropriately. */
512 Vunread_command_events
= Fcons (val
, Qnil
);
513 error ("Non-character input-event");
520 if (! NILP (delayed_switch_frame
))
521 unread_switch_frame
= delayed_switch_frame
;
525 #ifdef HAVE_WINDOW_SYSTEM
526 if (display_hourglass_p
)
535 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
536 doc
: /* Read a character from the command input (keyboard or macro).
537 It is returned as a number.
538 If the user generates an event which is not a character (i.e. a mouse
539 click or function key event), `read-char' signals an error. As an
540 exception, switch-frame events are put off until non-ASCII events can
542 If you want to read non-character events, or ignore them, call
543 `read-event' or `read-char-exclusive' instead.
545 If the optional argument PROMPT is non-nil, display that as a prompt.
546 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
547 input method is turned on in the current buffer, that input method
548 is used for reading a character. */)
549 (prompt
, inherit_input_method
)
550 Lisp_Object prompt
, inherit_input_method
;
553 message_with_string ("%s", prompt
, 0);
554 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
557 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
558 doc
: /* Read an event object from the input stream.
559 If the optional argument PROMPT is non-nil, display that as a prompt.
560 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
561 input method is turned on in the current buffer, that input method
562 is used for reading a character. */)
563 (prompt
, inherit_input_method
)
564 Lisp_Object prompt
, inherit_input_method
;
567 message_with_string ("%s", prompt
, 0);
568 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
571 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
572 doc
: /* Read a character from the command input (keyboard or macro).
573 It is returned as a number. Non-character events are ignored.
575 If the optional argument PROMPT is non-nil, display that as a prompt.
576 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
577 input method is turned on in the current buffer, that input method
578 is used for reading a character. */)
579 (prompt
, inherit_input_method
)
580 Lisp_Object prompt
, inherit_input_method
;
583 message_with_string ("%s", prompt
, 0);
584 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
587 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
588 doc
: /* Don't use this yourself. */)
591 register Lisp_Object val
;
592 XSETINT (val
, getc (instream
));
598 /* Value is non-zero if the file asswociated with file descriptor FD
599 is a compiled Lisp file that's safe to load. Only files compiled
600 with Emacs are safe to load. Files compiled with XEmacs can lead
601 to a crash in Fbyte_code because of an incompatible change in the
612 /* Read the first few bytes from the file, and look for a line
613 specifying the byte compiler version used. */
614 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
619 /* Skip to the next newline, skipping over the initial `ELC'
620 with NUL bytes following it. */
621 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
625 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
630 lseek (fd
, 0, SEEK_SET
);
635 /* Callback for record_unwind_protect. Restore the old load list OLD,
636 after loading a file successfully. */
639 record_load_unwind (old
)
642 return Vloads_in_progress
= old
;
645 /* This handler function is used via internal_condition_case_1. */
648 load_error_handler (data
)
654 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
655 doc
: /* Execute a file of Lisp code named FILE.
656 First try FILE with `.elc' appended, then try with `.el',
657 then try FILE unmodified (the exact suffixes are determined by
658 `load-suffixes'). Environment variable references in FILE
659 are replaced with their values by calling `substitute-in-file-name'.
660 This function searches the directories in `load-path'.
661 If optional second arg NOERROR is non-nil,
662 report no error if FILE doesn't exist.
663 Print messages at start and end of loading unless
664 optional third arg NOMESSAGE is non-nil.
665 If optional fourth arg NOSUFFIX is non-nil, don't try adding
666 suffixes `.elc' or `.el' to the specified name FILE.
667 If optional fifth arg MUST-SUFFIX is non-nil, insist on
668 the suffix `.elc' or `.el'; don't accept just FILE unless
669 it ends in one of those suffixes or includes a directory name.
670 Return t if file exists. */)
671 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
672 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
674 register FILE *stream
;
675 register int fd
= -1;
676 register Lisp_Object lispstream
;
677 int count
= SPECPDL_INDEX ();
680 Lisp_Object found
, efound
;
681 /* 1 means we printed the ".el is newer" message. */
683 /* 1 means we are loading a compiled file. */
694 /* If file name is magic, call the handler. */
695 /* This shouldn't be necessary any more now that `openp' handles it right.
696 handler = Ffind_file_name_handler (file, Qload);
698 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
700 /* Do this after the handler to avoid
701 the need to gcpro noerror, nomessage and nosuffix.
702 (Below here, we care only whether they are nil or not.)
703 The presence of this call is the result of a historical accident:
704 it used to be in every file-operations and when it got removed
705 everywhere, it accidentally stayed here. Since then, enough people
706 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
707 that it seemed risky to remove. */
708 if (! NILP (noerror
))
710 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
711 Qt
, load_error_handler
);
716 file
= Fsubstitute_in_file_name (file
);
719 /* Avoid weird lossage with null string as arg,
720 since it would try to load a directory as a Lisp file */
721 if (SCHARS (file
) > 0)
723 int size
= SBYTES (file
);
728 if (! NILP (must_suffix
))
730 /* Don't insist on adding a suffix if FILE already ends with one. */
732 && !strcmp (SDATA (file
) + size
- 3, ".el"))
735 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
737 /* Don't insist on adding a suffix
738 if the argument includes a directory name. */
739 else if (! NILP (Ffile_name_directory (file
)))
743 fd
= openp (Vload_path
, file
,
744 (!NILP (nosuffix
) ? Qnil
745 : !NILP (must_suffix
) ? Vload_suffixes
746 : Fappend (2, (tmp
[0] = Vload_suffixes
,
747 tmp
[1] = default_suffixes
,
756 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
757 Fcons (file
, Qnil
)));
762 /* Tell startup.el whether or not we found the user's init file. */
763 if (EQ (Qt
, Vuser_init_file
))
764 Vuser_init_file
= found
;
766 /* If FD is -2, that means openp found a magic file. */
769 if (NILP (Fequal (found
, file
)))
770 /* If FOUND is a different file name from FILE,
771 find its handler even if we have already inhibited
772 the `load' operation on FILE. */
773 handler
= Ffind_file_name_handler (found
, Qt
);
775 handler
= Ffind_file_name_handler (found
, Qload
);
776 if (! NILP (handler
))
777 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
780 /* Check if we're stuck in a recursive load cycle.
782 2000-09-21: It's not possible to just check for the file loaded
783 being a member of Vloads_in_progress. This fails because of the
784 way the byte compiler currently works; `provide's are not
785 evaluted, see font-lock.el/jit-lock.el as an example. This
786 leads to a certain amount of ``normal'' recursion.
788 Also, just loading a file recursively is not always an error in
789 the general case; the second load may do something different. */
793 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
794 if (!NILP (Fequal (found
, XCAR (tem
))))
797 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
798 Fcons (found
, Vloads_in_progress
)));
799 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
800 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
803 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
805 /* Load .elc files directly, but not when they are
806 remote and have no handler! */
813 if (!safe_to_load_p (fd
))
816 if (!load_dangerous_libraries
)
820 error ("File `%s' was not compiled in Emacs",
823 else if (!NILP (nomessage
))
824 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
830 efound
= ENCODE_FILE (found
);
835 stat ((char *)SDATA (efound
), &s1
);
836 SSET (efound
, SBYTES (efound
) - 1, 0);
837 result
= stat ((char *)SDATA (efound
), &s2
);
838 SSET (efound
, SBYTES (efound
) - 1, 'c');
841 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
843 /* Make the progress messages mention that source is newer. */
846 /* If we won't print another message, mention this anyway. */
847 if (!NILP (nomessage
))
850 file
= Fsubstring (found
, make_number (0), make_number (-1));
851 message_with_string ("Source file `%s' newer than byte-compiled file",
859 /* We are loading a source file (*.el). */
860 if (!NILP (Vload_source_file_function
))
866 val
= call4 (Vload_source_file_function
, found
, file
,
867 NILP (noerror
) ? Qnil
: Qt
,
868 NILP (nomessage
) ? Qnil
: Qt
);
869 return unbind_to (count
, val
);
876 efound
= ENCODE_FILE (found
);
877 stream
= fopen ((char *) SDATA (efound
), fmode
);
879 #else /* not WINDOWSNT */
880 stream
= fdopen (fd
, fmode
);
881 #endif /* not WINDOWSNT */
885 error ("Failure to create stdio stream for %s", SDATA (file
));
888 if (! NILP (Vpurify_flag
))
889 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
891 if (NILP (nomessage
))
894 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
897 message_with_string ("Loading %s (source)...", file
, 1);
899 message_with_string ("Loading %s (compiled; note, source file is newer)...",
901 else /* The typical case; compiled file newer than source file. */
902 message_with_string ("Loading %s...", file
, 1);
906 lispstream
= Fcons (Qnil
, Qnil
);
907 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
908 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
909 record_unwind_protect (load_unwind
, lispstream
);
910 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
911 specbind (Qload_file_name
, found
);
912 specbind (Qinhibit_file_name_operation
, Qnil
);
914 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
916 readevalloop (Qget_file_char
, stream
, file
, Feval
,
917 0, Qnil
, Qnil
, Qnil
, Qnil
);
918 unbind_to (count
, Qnil
);
920 /* Run any load-hooks for this file. */
921 temp
= Fassoc (file
, Vafter_load_alist
);
923 Fprogn (Fcdr (temp
));
926 if (saved_doc_string
)
927 free (saved_doc_string
);
928 saved_doc_string
= 0;
929 saved_doc_string_size
= 0;
931 if (prev_saved_doc_string
)
932 xfree (prev_saved_doc_string
);
933 prev_saved_doc_string
= 0;
934 prev_saved_doc_string_size
= 0;
936 if (!noninteractive
&& NILP (nomessage
))
939 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
942 message_with_string ("Loading %s (source)...done", file
, 1);
944 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
946 else /* The typical case; compiled file newer than source file. */
947 message_with_string ("Loading %s...done", file
, 1);
950 if (!NILP (Fequal (build_string ("obsolete"),
951 Ffile_name_nondirectory
952 (Fdirectory_file_name (Ffile_name_directory (found
))))))
953 message_with_string ("Package %s is obsolete", file
, 1);
959 load_unwind (stream
) /* used as unwind-protect function in load */
962 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
963 | XFASTINT (XCDR (stream
))));
964 if (--load_in_progress
< 0) load_in_progress
= 0;
969 load_descriptor_unwind (oldlist
)
972 load_descriptor_list
= oldlist
;
976 /* Close all descriptors in use for Floads.
977 This is used when starting a subprocess. */
984 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
985 emacs_close (XFASTINT (XCAR (tail
)));
990 complete_filename_p (pathname
)
991 Lisp_Object pathname
;
993 register const unsigned char *s
= SDATA (pathname
);
994 return (IS_DIRECTORY_SEP (s
[0])
995 || (SCHARS (pathname
) > 2
996 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1006 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1007 doc
: /* Search for FILENAME through PATH.
1008 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1009 file name when searching.
1010 If non-nil, PREDICATE is used instead of `file-readable-p'.
1011 PREDICATE can also be an integer to pass to the access(2) function,
1012 in which case file-name-handlers are ignored. */)
1013 (filename
, path
, suffixes
, predicate
)
1014 Lisp_Object filename
, path
, suffixes
, predicate
;
1017 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1018 if (NILP (predicate
) && fd
> 0)
1024 /* Search for a file whose name is STR, looking in directories
1025 in the Lisp list PATH, and trying suffixes from SUFFIX.
1026 On success, returns a file descriptor. On failure, returns -1.
1028 SUFFIXES is a list of strings containing possible suffixes.
1029 The empty suffix is automatically added iff the list is empty.
1031 PREDICATE non-nil means don't open the files,
1032 just look for one that satisfies the predicate. In this case,
1033 returns 1 on success. The predicate can be a lisp function or
1034 an integer to pass to `access' (in which case file-name-handlers
1037 If STOREPTR is nonzero, it points to a slot where the name of
1038 the file actually found should be stored as a Lisp string.
1039 nil is stored there on failure.
1041 If the file we find is remote, return -2
1042 but store the found remote file name in *STOREPTR. */
1045 openp (path
, str
, suffixes
, storeptr
, predicate
)
1046 Lisp_Object path
, str
;
1047 Lisp_Object suffixes
;
1048 Lisp_Object
*storeptr
;
1049 Lisp_Object predicate
;
1054 register char *fn
= buf
;
1057 Lisp_Object filename
;
1059 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1060 Lisp_Object string
, tail
, encoded_fn
;
1061 int max_suffix_len
= 0;
1065 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1067 CHECK_STRING_CAR (tail
);
1068 max_suffix_len
= max (max_suffix_len
,
1069 SBYTES (XCAR (tail
)));
1072 string
= filename
= Qnil
;
1073 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1078 if (complete_filename_p (str
))
1081 for (; CONSP (path
); path
= XCDR (path
))
1083 filename
= Fexpand_file_name (str
, XCAR (path
));
1084 if (!complete_filename_p (filename
))
1085 /* If there are non-absolute elts in PATH (eg ".") */
1086 /* Of course, this could conceivably lose if luser sets
1087 default-directory to be something non-absolute... */
1089 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1090 if (!complete_filename_p (filename
))
1091 /* Give up on this path element! */
1095 /* Calculate maximum size of any filename made from
1096 this path element/specified file name and any possible suffix. */
1097 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1098 if (fn_size
< want_size
)
1099 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1101 /* Loop over suffixes. */
1102 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1103 CONSP (tail
); tail
= XCDR (tail
))
1105 int lsuffix
= SBYTES (XCAR (tail
));
1106 Lisp_Object handler
;
1109 /* Concatenate path element/specified name with the suffix.
1110 If the directory starts with /:, remove that. */
1111 if (SCHARS (filename
) > 2
1112 && SREF (filename
, 0) == '/'
1113 && SREF (filename
, 1) == ':')
1115 strncpy (fn
, SDATA (filename
) + 2,
1116 SBYTES (filename
) - 2);
1117 fn
[SBYTES (filename
) - 2] = 0;
1121 strncpy (fn
, SDATA (filename
),
1123 fn
[SBYTES (filename
)] = 0;
1126 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1127 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1129 /* Check that the file exists and is not a directory. */
1130 /* We used to only check for handlers on non-absolute file names:
1134 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1135 It's not clear why that was the case and it breaks things like
1136 (load "/bar.el") where the file is actually "/bar.el.gz". */
1137 string
= build_string (fn
);
1138 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1139 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1141 if (NILP (predicate
))
1142 exists
= !NILP (Ffile_readable_p (string
));
1144 exists
= !NILP (call1 (predicate
, string
));
1145 if (exists
&& !NILP (Ffile_directory_p (string
)))
1150 /* We succeeded; return this descriptor and filename. */
1161 encoded_fn
= ENCODE_FILE (string
);
1162 pfn
= SDATA (encoded_fn
);
1163 exists
= (stat (pfn
, &st
) >= 0
1164 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1167 /* Check that we can access or open it. */
1168 if (NATNUMP (predicate
))
1169 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1171 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1175 /* We succeeded; return this descriptor and filename. */
1193 /* Merge the list we've accumulated of globals from the current input source
1194 into the load_history variable. The details depend on whether
1195 the source has an associated file name or not. */
1198 build_load_history (stream
, source
)
1202 register Lisp_Object tail
, prev
, newelt
;
1203 register Lisp_Object tem
, tem2
;
1204 register int foundit
, loading
;
1206 loading
= stream
|| !NARROWED
;
1208 tail
= Vload_history
;
1211 while (CONSP (tail
))
1215 /* Find the feature's previous assoc list... */
1216 if (!NILP (Fequal (source
, Fcar (tem
))))
1220 /* If we're loading, remove it. */
1224 Vload_history
= XCDR (tail
);
1226 Fsetcdr (prev
, XCDR (tail
));
1229 /* Otherwise, cons on new symbols that are not already members. */
1232 tem2
= Vcurrent_load_list
;
1234 while (CONSP (tem2
))
1236 newelt
= XCAR (tem2
);
1238 if (NILP (Fmember (newelt
, tem
)))
1239 Fsetcar (tail
, Fcons (XCAR (tem
),
1240 Fcons (newelt
, XCDR (tem
))));
1253 /* If we're loading, cons the new assoc onto the front of load-history,
1254 the most-recently-loaded position. Also do this if we didn't find
1255 an existing member for the current source. */
1256 if (loading
|| !foundit
)
1257 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1262 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1270 readevalloop_1 (old
)
1273 load_convert_to_unibyte
= ! NILP (old
);
1277 /* Signal an `end-of-file' error, if possible with file name
1281 end_of_file_error ()
1285 if (STRINGP (Vload_file_name
))
1286 data
= Fcons (Vload_file_name
, Qnil
);
1290 Fsignal (Qend_of_file
, data
);
1293 /* UNIBYTE specifies how to set load_convert_to_unibyte
1294 for this invocation.
1295 READFUN, if non-nil, is used instead of `read'.
1296 START, END is region in current buffer (from eval-region). */
1299 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1300 printflag
, unibyte
, readfun
, start
, end
)
1301 Lisp_Object readcharfun
;
1303 Lisp_Object sourcename
;
1304 Lisp_Object (*evalfun
) ();
1306 Lisp_Object unibyte
, readfun
;
1307 Lisp_Object start
, end
;
1310 register Lisp_Object val
;
1311 int count
= SPECPDL_INDEX ();
1312 struct gcpro gcpro1
;
1313 struct buffer
*b
= 0;
1314 int continue_reading_p
;
1316 if (BUFFERP (readcharfun
))
1317 b
= XBUFFER (readcharfun
);
1318 else if (MARKERP (readcharfun
))
1319 b
= XMARKER (readcharfun
)->buffer
;
1321 specbind (Qstandard_input
, readcharfun
);
1322 specbind (Qcurrent_load_list
, Qnil
);
1323 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1324 load_convert_to_unibyte
= !NILP (unibyte
);
1326 readchar_backlog
= -1;
1328 GCPRO1 (sourcename
);
1330 LOADHIST_ATTACH (sourcename
);
1332 continue_reading_p
= 1;
1333 while (continue_reading_p
)
1335 int count1
= SPECPDL_INDEX ();
1337 if (b
!= 0 && NILP (b
->name
))
1338 error ("Reading from killed buffer");
1342 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1343 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1345 Fnarrow_to_region (make_number (BEGV
), end
);
1353 while ((c
= READCHAR
) != '\n' && c
!= -1);
1358 unbind_to (count1
, Qnil
);
1362 /* Ignore whitespace here, so we can detect eof. */
1363 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1366 if (!NILP (Vpurify_flag
) && c
== '(')
1368 record_unwind_protect (unreadpure
, Qnil
);
1369 val
= read_list (-1, readcharfun
);
1374 read_objects
= Qnil
;
1375 if (!NILP (readfun
))
1377 val
= call1 (readfun
, readcharfun
);
1379 /* If READCHARFUN has set point to ZV, we should
1380 stop reading, even if the form read sets point
1381 to a different value when evaluated. */
1382 if (BUFFERP (readcharfun
))
1384 struct buffer
*b
= XBUFFER (readcharfun
);
1385 if (BUF_PT (b
) == BUF_ZV (b
))
1386 continue_reading_p
= 0;
1389 else if (! NILP (Vload_read_function
))
1390 val
= call1 (Vload_read_function
, readcharfun
);
1392 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1395 if (!NILP (start
) && continue_reading_p
)
1396 start
= Fpoint_marker ();
1397 unbind_to (count1
, Qnil
);
1399 val
= (*evalfun
) (val
);
1403 Vvalues
= Fcons (val
, Vvalues
);
1404 if (EQ (Vstandard_output
, Qt
))
1411 build_load_history (stream
, sourcename
);
1414 unbind_to (count
, Qnil
);
1417 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1418 doc
: /* Execute the current buffer as Lisp code.
1419 Programs can pass two arguments, BUFFER and PRINTFLAG.
1420 BUFFER is the buffer to evaluate (nil means use current buffer).
1421 PRINTFLAG controls printing of output:
1422 nil means discard it; anything else is stream for print.
1424 If the optional third argument FILENAME is non-nil,
1425 it specifies the file name to use for `load-history'.
1426 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1427 for this invocation.
1429 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1430 `print' and related functions should work normally even if PRINTFLAG is nil.
1432 This function preserves the position of point. */)
1433 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1434 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1436 int count
= SPECPDL_INDEX ();
1437 Lisp_Object tem
, buf
;
1440 buf
= Fcurrent_buffer ();
1442 buf
= Fget_buffer (buffer
);
1444 error ("No such buffer");
1446 if (NILP (printflag
) && NILP (do_allow_print
))
1451 if (NILP (filename
))
1452 filename
= XBUFFER (buf
)->filename
;
1454 specbind (Qstandard_output
, tem
);
1455 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1456 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1457 readevalloop (buf
, 0, filename
, Feval
,
1458 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1459 unbind_to (count
, Qnil
);
1464 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1465 doc
: /* Execute the region as Lisp code.
1466 When called from programs, expects two arguments,
1467 giving starting and ending indices in the current buffer
1468 of the text to be executed.
1469 Programs can pass third argument PRINTFLAG which controls output:
1470 nil means discard it; anything else is stream for printing it.
1471 Also the fourth argument READ-FUNCTION, if non-nil, is used
1472 instead of `read' to read each expression. It gets one argument
1473 which is the input stream for reading characters.
1475 This function does not move point. */)
1476 (start
, end
, printflag
, read_function
)
1477 Lisp_Object start
, end
, printflag
, read_function
;
1479 int count
= SPECPDL_INDEX ();
1480 Lisp_Object tem
, cbuf
;
1482 cbuf
= Fcurrent_buffer ();
1484 if (NILP (printflag
))
1488 specbind (Qstandard_output
, tem
);
1490 /* readevalloop calls functions which check the type of start and end. */
1491 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1492 !NILP (printflag
), Qnil
, read_function
,
1495 return unbind_to (count
, Qnil
);
1499 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1500 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1501 If STREAM is nil, use the value of `standard-input' (which see).
1502 STREAM or the value of `standard-input' may be:
1503 a buffer (read from point and advance it)
1504 a marker (read from where it points and advance it)
1505 a function (call it with no arguments for each character,
1506 call it with a char as argument to push a char back)
1507 a string (takes text from string, starting at the beginning)
1508 t (read text line using minibuffer and use it, or read from
1509 standard input in batch mode). */)
1514 stream
= Vstandard_input
;
1515 if (EQ (stream
, Qt
))
1516 stream
= Qread_char
;
1517 if (EQ (stream
, Qread_char
))
1518 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1520 return read_internal_start (stream
, Qnil
, Qnil
);
1523 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1524 doc
: /* Read one Lisp expression which is represented as text by STRING.
1525 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1526 START and END optionally delimit a substring of STRING from which to read;
1527 they default to 0 and (length STRING) respectively. */)
1528 (string
, start
, end
)
1529 Lisp_Object string
, start
, end
;
1532 CHECK_STRING (string
);
1533 /* read_internal_start sets read_from_string_index. */
1534 ret
= read_internal_start (string
, start
, end
);
1535 return Fcons (ret
, make_number (read_from_string_index
));
1538 /* Function to set up the global context we need in toplevel read
1541 read_internal_start (stream
, start
, end
)
1543 Lisp_Object start
; /* Only used when stream is a string. */
1544 Lisp_Object end
; /* Only used when stream is a string. */
1548 readchar_backlog
= -1;
1550 new_backquote_flag
= 0;
1551 read_objects
= Qnil
;
1552 if (EQ (Vread_with_symbol_positions
, Qt
)
1553 || EQ (Vread_with_symbol_positions
, stream
))
1554 Vread_symbol_positions_list
= Qnil
;
1556 if (STRINGP (stream
))
1558 int startval
, endval
;
1560 endval
= SCHARS (stream
);
1564 endval
= XINT (end
);
1565 if (endval
< 0 || endval
> SCHARS (stream
))
1566 args_out_of_range (stream
, end
);
1573 CHECK_NUMBER (start
);
1574 startval
= XINT (start
);
1575 if (startval
< 0 || startval
> endval
)
1576 args_out_of_range (stream
, start
);
1578 read_from_string_index
= startval
;
1579 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1580 read_from_string_limit
= endval
;
1583 retval
= read0 (stream
);
1584 if (EQ (Vread_with_symbol_positions
, Qt
)
1585 || EQ (Vread_with_symbol_positions
, stream
))
1586 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1590 /* Use this for recursive reads, in contexts where internal tokens
1595 Lisp_Object readcharfun
;
1597 register Lisp_Object val
;
1600 val
= read1 (readcharfun
, &c
, 0);
1602 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1609 static int read_buffer_size
;
1610 static char *read_buffer
;
1612 /* Read multibyte form and return it as a character. C is a first
1613 byte of multibyte form, and rest of them are read from
1617 read_multibyte (c
, readcharfun
)
1619 Lisp_Object readcharfun
;
1621 /* We need the actual character code of this multibyte
1623 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1631 while ((c
= READCHAR
) >= 0xA0
1632 && len
< MAX_MULTIBYTE_LENGTH
)
1638 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1639 return STRING_CHAR (str
, len
);
1640 /* The byte sequence is not valid as multibyte. Unread all bytes
1641 but the first one, and return the first byte. */
1647 /* Read a \-escape sequence, assuming we already read the `\'.
1648 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1649 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1650 Otherwise store 0 into *BYTEREP. */
1653 read_escape (readcharfun
, stringp
, byterep
)
1654 Lisp_Object readcharfun
;
1658 register int c
= READCHAR
;
1665 end_of_file_error ();
1695 error ("Invalid escape character syntax");
1698 c
= read_escape (readcharfun
, 0, byterep
);
1699 return c
| meta_modifier
;
1704 error ("Invalid escape character syntax");
1707 c
= read_escape (readcharfun
, 0, byterep
);
1708 return c
| shift_modifier
;
1713 error ("Invalid escape character syntax");
1716 c
= read_escape (readcharfun
, 0, byterep
);
1717 return c
| hyper_modifier
;
1722 error ("Invalid escape character syntax");
1725 c
= read_escape (readcharfun
, 0, byterep
);
1726 return c
| alt_modifier
;
1738 c
= read_escape (readcharfun
, 0, byterep
);
1739 return c
| super_modifier
;
1744 error ("Invalid escape character syntax");
1748 c
= read_escape (readcharfun
, 0, byterep
);
1749 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1750 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1751 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1752 return c
| ctrl_modifier
;
1753 /* ASCII control chars are made from letters (both cases),
1754 as well as the non-letters within 0100...0137. */
1755 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1756 return (c
& (037 | ~0177));
1757 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1758 return (c
& (037 | ~0177));
1760 return c
| ctrl_modifier
;
1770 /* An octal escape, as in ANSI C. */
1772 register int i
= c
- '0';
1773 register int count
= 0;
1776 if ((c
= READCHAR
) >= '0' && c
<= '7')
1793 /* A hex escape, as in ANSI C. */
1799 if (c
>= '0' && c
<= '9')
1804 else if ((c
>= 'a' && c
<= 'f')
1805 || (c
>= 'A' && c
<= 'F'))
1808 if (c
>= 'a' && c
<= 'f')
1825 if (BASE_LEADING_CODE_P (c
))
1826 c
= read_multibyte (c
, readcharfun
);
1832 /* Read an integer in radix RADIX using READCHARFUN to read
1833 characters. RADIX must be in the interval [2..36]; if it isn't, a
1834 read error is signaled . Value is the integer read. Signals an
1835 error if encountering invalid read syntax or if RADIX is out of
1839 read_integer (readcharfun
, radix
)
1840 Lisp_Object readcharfun
;
1843 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1844 EMACS_INT number
= 0;
1846 if (radix
< 2 || radix
> 36)
1850 number
= ndigits
= invalid_p
= 0;
1866 if (c
>= '0' && c
<= '9')
1868 else if (c
>= 'a' && c
<= 'z')
1869 digit
= c
- 'a' + 10;
1870 else if (c
>= 'A' && c
<= 'Z')
1871 digit
= c
- 'A' + 10;
1878 if (digit
< 0 || digit
>= radix
)
1881 number
= radix
* number
+ digit
;
1887 if (ndigits
== 0 || invalid_p
)
1890 sprintf (buf
, "integer, radix %d", radix
);
1891 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1894 return make_number (sign
* number
);
1898 /* Convert unibyte text in read_buffer to multibyte.
1900 Initially, *P is a pointer after the end of the unibyte text, and
1901 the pointer *END points after the end of read_buffer.
1903 If read_buffer doesn't have enough room to hold the result
1904 of the conversion, reallocate it and adjust *P and *END.
1906 At the end, make *P point after the result of the conversion, and
1907 return in *NCHARS the number of characters in the converted
1911 to_multibyte (p
, end
, nchars
)
1917 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1918 if (read_buffer_size
< 2 * nbytes
)
1920 int offset
= *p
- read_buffer
;
1921 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1922 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1923 *p
= read_buffer
+ offset
;
1924 *end
= read_buffer
+ read_buffer_size
;
1927 if (nbytes
!= *nchars
)
1928 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1929 *p
- read_buffer
, nchars
);
1931 *p
= read_buffer
+ nbytes
;
1935 /* If the next token is ')' or ']' or '.', we store that character
1936 in *PCH and the return value is not interesting. Else, we store
1937 zero in *PCH and we read and return one lisp object.
1939 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1942 read1 (readcharfun
, pch
, first_in_list
)
1943 register Lisp_Object readcharfun
;
1948 int uninterned_symbol
= 0;
1956 end_of_file_error ();
1961 return read_list (0, readcharfun
);
1964 return read_vector (readcharfun
, 0);
1981 tmp
= read_vector (readcharfun
, 0);
1982 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1983 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1984 error ("Invalid size char-table");
1985 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1986 XCHAR_TABLE (tmp
)->top
= Qt
;
1995 tmp
= read_vector (readcharfun
, 0);
1996 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1997 error ("Invalid size char-table");
1998 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1999 XCHAR_TABLE (tmp
)->top
= Qnil
;
2002 Fsignal (Qinvalid_read_syntax
,
2003 Fcons (make_string ("#^^", 3), Qnil
));
2005 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2010 length
= read1 (readcharfun
, pch
, first_in_list
);
2014 Lisp_Object tmp
, val
;
2016 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2017 / BOOL_VECTOR_BITS_PER_CHAR
);
2020 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2021 if (size_in_chars
!= SCHARS (tmp
)
2022 /* We used to print 1 char too many
2023 when the number of bits was a multiple of 8.
2024 Accept such input in case it came from an old version. */
2025 && ! (XFASTINT (length
)
2026 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2027 Fsignal (Qinvalid_read_syntax
,
2028 Fcons (make_string ("#&...", 5), Qnil
));
2030 val
= Fmake_bool_vector (length
, Qnil
);
2031 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2033 /* Clear the extraneous bits in the last byte. */
2034 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2035 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2036 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2039 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2044 /* Accept compiled functions at read-time so that we don't have to
2045 build them using function calls. */
2047 tmp
= read_vector (readcharfun
, 1);
2048 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2049 XVECTOR (tmp
)->contents
);
2054 struct gcpro gcpro1
;
2057 /* Read the string itself. */
2058 tmp
= read1 (readcharfun
, &ch
, 0);
2059 if (ch
!= 0 || !STRINGP (tmp
))
2060 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2062 /* Read the intervals and their properties. */
2065 Lisp_Object beg
, end
, plist
;
2067 beg
= read1 (readcharfun
, &ch
, 0);
2072 end
= read1 (readcharfun
, &ch
, 0);
2074 plist
= read1 (readcharfun
, &ch
, 0);
2076 Fsignal (Qinvalid_read_syntax
,
2077 Fcons (build_string ("invalid string property list"),
2079 Fset_text_properties (beg
, end
, plist
, tmp
);
2085 /* #@NUMBER is used to skip NUMBER following characters.
2086 That's used in .elc files to skip over doc strings
2087 and function definitions. */
2092 /* Read a decimal integer. */
2093 while ((c
= READCHAR
) >= 0
2094 && c
>= '0' && c
<= '9')
2102 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2104 /* If we are supposed to force doc strings into core right now,
2105 record the last string that we skipped,
2106 and record where in the file it comes from. */
2108 /* But first exchange saved_doc_string
2109 with prev_saved_doc_string, so we save two strings. */
2111 char *temp
= saved_doc_string
;
2112 int temp_size
= saved_doc_string_size
;
2113 file_offset temp_pos
= saved_doc_string_position
;
2114 int temp_len
= saved_doc_string_length
;
2116 saved_doc_string
= prev_saved_doc_string
;
2117 saved_doc_string_size
= prev_saved_doc_string_size
;
2118 saved_doc_string_position
= prev_saved_doc_string_position
;
2119 saved_doc_string_length
= prev_saved_doc_string_length
;
2121 prev_saved_doc_string
= temp
;
2122 prev_saved_doc_string_size
= temp_size
;
2123 prev_saved_doc_string_position
= temp_pos
;
2124 prev_saved_doc_string_length
= temp_len
;
2127 if (saved_doc_string_size
== 0)
2129 saved_doc_string_size
= nskip
+ 100;
2130 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2132 if (nskip
> saved_doc_string_size
)
2134 saved_doc_string_size
= nskip
+ 100;
2135 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2136 saved_doc_string_size
);
2139 saved_doc_string_position
= file_tell (instream
);
2141 /* Copy that many characters into saved_doc_string. */
2142 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2143 saved_doc_string
[i
] = c
= READCHAR
;
2145 saved_doc_string_length
= i
;
2149 /* Skip that many characters. */
2150 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2158 /* #! appears at the beginning of an executable file.
2159 Skip the first line. */
2160 while (c
!= '\n' && c
>= 0)
2165 return Vload_file_name
;
2167 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2168 /* #:foo is the uninterned symbol named foo. */
2171 uninterned_symbol
= 1;
2175 /* Reader forms that can reuse previously read objects. */
2176 if (c
>= '0' && c
<= '9')
2181 /* Read a non-negative integer. */
2182 while (c
>= '0' && c
<= '9')
2188 /* #n=object returns object, but associates it with n for #n#. */
2191 /* Make a placeholder for #n# to use temporarily */
2192 Lisp_Object placeholder
;
2195 placeholder
= Fcons(Qnil
, Qnil
);
2196 cell
= Fcons (make_number (n
), placeholder
);
2197 read_objects
= Fcons (cell
, read_objects
);
2199 /* Read the object itself. */
2200 tem
= read0 (readcharfun
);
2202 /* Now put it everywhere the placeholder was... */
2203 substitute_object_in_subtree (tem
, placeholder
);
2205 /* ...and #n# will use the real value from now on. */
2206 Fsetcdr (cell
, tem
);
2210 /* #n# returns a previously read object. */
2213 tem
= Fassq (make_number (n
), read_objects
);
2216 /* Fall through to error message. */
2218 else if (c
== 'r' || c
== 'R')
2219 return read_integer (readcharfun
, n
);
2221 /* Fall through to error message. */
2223 else if (c
== 'x' || c
== 'X')
2224 return read_integer (readcharfun
, 16);
2225 else if (c
== 'o' || c
== 'O')
2226 return read_integer (readcharfun
, 8);
2227 else if (c
== 'b' || c
== 'B')
2228 return read_integer (readcharfun
, 2);
2231 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2234 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2239 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2249 new_backquote_flag
++;
2250 value
= read0 (readcharfun
);
2251 new_backquote_flag
--;
2253 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2257 if (new_backquote_flag
)
2259 Lisp_Object comma_type
= Qnil
;
2264 comma_type
= Qcomma_at
;
2266 comma_type
= Qcomma_dot
;
2269 if (ch
>= 0) UNREAD (ch
);
2270 comma_type
= Qcomma
;
2273 new_backquote_flag
--;
2274 value
= read0 (readcharfun
);
2275 new_backquote_flag
++;
2276 return Fcons (comma_type
, Fcons (value
, Qnil
));
2289 end_of_file_error ();
2291 /* Accept `single space' syntax like (list ? x) where the
2292 whitespace character is SPC or TAB.
2293 Other literal whitespace like NL, CR, and FF are not accepted,
2294 as there are well-established escape sequences for these. */
2295 if (c
== ' ' || c
== '\t')
2296 return make_number (c
);
2299 c
= read_escape (readcharfun
, 0, &discard
);
2300 else if (BASE_LEADING_CODE_P (c
))
2301 c
= read_multibyte (c
, readcharfun
);
2303 next_char
= READCHAR
;
2304 if (next_char
== '.')
2306 /* Only a dotted-pair dot is valid after a char constant. */
2307 int next_next_char
= READCHAR
;
2308 UNREAD (next_next_char
);
2310 ok
= (next_next_char
<= 040
2311 || (next_next_char
< 0200
2312 && (index ("\"';([#?", next_next_char
)
2313 || (!first_in_list
&& next_next_char
== '`')
2314 || (new_backquote_flag
&& next_next_char
== ','))));
2318 ok
= (next_char
<= 040
2319 || (next_char
< 0200
2320 && (index ("\"';()[]#?", next_char
)
2321 || (!first_in_list
&& next_char
== '`')
2322 || (new_backquote_flag
&& next_char
== ','))));
2326 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2328 return make_number (c
);
2333 char *p
= read_buffer
;
2334 char *end
= read_buffer
+ read_buffer_size
;
2336 /* 1 if we saw an escape sequence specifying
2337 a multibyte character, or a multibyte character. */
2338 int force_multibyte
= 0;
2339 /* 1 if we saw an escape sequence specifying
2340 a single-byte character. */
2341 int force_singlebyte
= 0;
2342 /* 1 if read_buffer contains multibyte text now. */
2343 int is_multibyte
= 0;
2347 while ((c
= READCHAR
) >= 0
2350 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2352 int offset
= p
- read_buffer
;
2353 read_buffer
= (char *) xrealloc (read_buffer
,
2354 read_buffer_size
*= 2);
2355 p
= read_buffer
+ offset
;
2356 end
= read_buffer
+ read_buffer_size
;
2363 c
= read_escape (readcharfun
, 1, &byterep
);
2365 /* C is -1 if \ newline has just been seen */
2368 if (p
== read_buffer
)
2374 force_singlebyte
= 1;
2375 else if (byterep
== 2)
2376 force_multibyte
= 1;
2379 /* A character that must be multibyte forces multibyte. */
2380 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2381 force_multibyte
= 1;
2383 /* If we just discovered the need to be multibyte,
2384 convert the text accumulated thus far. */
2385 if (force_multibyte
&& ! is_multibyte
)
2388 to_multibyte (&p
, &end
, &nchars
);
2391 /* Allow `\C- ' and `\C-?'. */
2392 if (c
== (CHAR_CTL
| ' '))
2394 else if (c
== (CHAR_CTL
| '?'))
2399 /* Shift modifier is valid only with [A-Za-z]. */
2400 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2402 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2403 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2407 /* Move the meta bit to the right place for a string. */
2408 c
= (c
& ~CHAR_META
) | 0x80;
2409 if (c
& CHAR_MODIFIER_MASK
)
2410 error ("Invalid modifier in string");
2413 p
+= CHAR_STRING (c
, p
);
2421 end_of_file_error ();
2423 /* If purifying, and string starts with \ newline,
2424 return zero instead. This is for doc strings
2425 that we are really going to find in etc/DOC.nn.nn */
2426 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2427 return make_number (0);
2429 if (is_multibyte
|| force_singlebyte
)
2431 else if (load_convert_to_unibyte
)
2434 to_multibyte (&p
, &end
, &nchars
);
2435 if (p
- read_buffer
!= nchars
)
2437 string
= make_multibyte_string (read_buffer
, nchars
,
2439 return Fstring_make_unibyte (string
);
2441 /* We can make a unibyte string directly. */
2444 else if (EQ (readcharfun
, Qget_file_char
)
2445 || EQ (readcharfun
, Qlambda
))
2447 /* Nowadays, reading directly from a file is used only for
2448 compiled Emacs Lisp files, and those always use the
2449 Emacs internal encoding. Meanwhile, Qlambda is used
2450 for reading dynamic byte code (compiled with
2451 byte-compile-dynamic = t). So make the string multibyte
2452 if the string contains any multibyte sequences.
2453 (to_multibyte is a no-op if not.) */
2454 to_multibyte (&p
, &end
, &nchars
);
2455 is_multibyte
= (p
- read_buffer
) != nchars
;
2458 /* In all other cases, if we read these bytes as
2459 separate characters, treat them as separate characters now. */
2462 /* We want readchar_count to be the number of characters, not
2463 bytes. Hence we adjust for multibyte characters in the
2464 string. ... But it doesn't seem to be necessary, because
2465 READCHAR *does* read multibyte characters from buffers. */
2466 /* readchar_count -= (p - read_buffer) - nchars; */
2468 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2470 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2476 int next_char
= READCHAR
;
2479 if (next_char
<= 040
2480 || (next_char
< 0200
2481 && (index ("\"';([#?", next_char
)
2482 || (!first_in_list
&& next_char
== '`')
2483 || (new_backquote_flag
&& next_char
== ','))))
2489 /* Otherwise, we fall through! Note that the atom-reading loop
2490 below will now loop at least once, assuring that we will not
2491 try to UNREAD two characters in a row. */
2495 if (c
<= 040) goto retry
;
2497 char *p
= read_buffer
;
2501 char *end
= read_buffer
+ read_buffer_size
;
2505 || (!index ("\"';()[]#", c
)
2506 && !(!first_in_list
&& c
== '`')
2507 && !(new_backquote_flag
&& c
== ','))))
2509 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2511 int offset
= p
- read_buffer
;
2512 read_buffer
= (char *) xrealloc (read_buffer
,
2513 read_buffer_size
*= 2);
2514 p
= read_buffer
+ offset
;
2515 end
= read_buffer
+ read_buffer_size
;
2522 end_of_file_error ();
2526 if (! SINGLE_BYTE_CHAR_P (c
))
2527 p
+= CHAR_STRING (c
, p
);
2536 int offset
= p
- read_buffer
;
2537 read_buffer
= (char *) xrealloc (read_buffer
,
2538 read_buffer_size
*= 2);
2539 p
= read_buffer
+ offset
;
2540 end
= read_buffer
+ read_buffer_size
;
2547 if (!quoted
&& !uninterned_symbol
)
2550 register Lisp_Object val
;
2552 if (*p1
== '+' || *p1
== '-') p1
++;
2553 /* Is it an integer? */
2556 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2557 /* Integers can have trailing decimal points. */
2558 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2560 /* It is an integer. */
2564 if (sizeof (int) == sizeof (EMACS_INT
))
2565 XSETINT (val
, atoi (read_buffer
));
2566 else if (sizeof (long) == sizeof (EMACS_INT
))
2567 XSETINT (val
, atol (read_buffer
));
2573 if (isfloat_string (read_buffer
))
2575 /* Compute NaN and infinities using 0.0 in a variable,
2576 to cope with compilers that think they are smarter
2582 /* Negate the value ourselves. This treats 0, NaNs,
2583 and infinity properly on IEEE floating point hosts,
2584 and works around a common bug where atof ("-0.0")
2586 int negative
= read_buffer
[0] == '-';
2588 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2589 returns 1, is if the input ends in e+INF or e+NaN. */
2596 value
= zero
/ zero
;
2599 value
= atof (read_buffer
+ negative
);
2603 return make_float (negative
? - value
: value
);
2607 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2608 : intern (read_buffer
);
2609 if (EQ (Vread_with_symbol_positions
, Qt
)
2610 || EQ (Vread_with_symbol_positions
, readcharfun
))
2611 Vread_symbol_positions_list
=
2612 /* Kind of a hack; this will probably fail if characters
2613 in the symbol name were escaped. Not really a big
2615 Fcons (Fcons (result
,
2616 make_number (readchar_count
2617 - XFASTINT (Flength (Fsymbol_name (result
))))),
2618 Vread_symbol_positions_list
);
2626 /* List of nodes we've seen during substitute_object_in_subtree. */
2627 static Lisp_Object seen_list
;
2630 substitute_object_in_subtree (object
, placeholder
)
2632 Lisp_Object placeholder
;
2634 Lisp_Object check_object
;
2636 /* We haven't seen any objects when we start. */
2639 /* Make all the substitutions. */
2641 = substitute_object_recurse (object
, placeholder
, object
);
2643 /* Clear seen_list because we're done with it. */
2646 /* The returned object here is expected to always eq the
2648 if (!EQ (check_object
, object
))
2649 error ("Unexpected mutation error in reader");
2652 /* Feval doesn't get called from here, so no gc protection is needed. */
2653 #define SUBSTITUTE(get_val, set_val) \
2655 Lisp_Object old_value = get_val; \
2656 Lisp_Object true_value \
2657 = substitute_object_recurse (object, placeholder,\
2660 if (!EQ (old_value, true_value)) \
2667 substitute_object_recurse (object
, placeholder
, subtree
)
2669 Lisp_Object placeholder
;
2670 Lisp_Object subtree
;
2672 /* If we find the placeholder, return the target object. */
2673 if (EQ (placeholder
, subtree
))
2676 /* If we've been to this node before, don't explore it again. */
2677 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2680 /* If this node can be the entry point to a cycle, remember that
2681 we've seen it. It can only be such an entry point if it was made
2682 by #n=, which means that we can find it as a value in
2684 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2685 seen_list
= Fcons (subtree
, seen_list
);
2687 /* Recurse according to subtree's type.
2688 Every branch must return a Lisp_Object. */
2689 switch (XTYPE (subtree
))
2691 case Lisp_Vectorlike
:
2694 int length
= XINT (Flength(subtree
));
2695 for (i
= 0; i
< length
; i
++)
2697 Lisp_Object idx
= make_number (i
);
2698 SUBSTITUTE (Faref (subtree
, idx
),
2699 Faset (subtree
, idx
, true_value
));
2706 SUBSTITUTE (Fcar_safe (subtree
),
2707 Fsetcar (subtree
, true_value
));
2708 SUBSTITUTE (Fcdr_safe (subtree
),
2709 Fsetcdr (subtree
, true_value
));
2715 /* Check for text properties in each interval.
2716 substitute_in_interval contains part of the logic. */
2718 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2719 Lisp_Object arg
= Fcons (object
, placeholder
);
2721 traverse_intervals_noorder (root_interval
,
2722 &substitute_in_interval
, arg
);
2727 /* Other types don't recurse any further. */
2733 /* Helper function for substitute_object_recurse. */
2735 substitute_in_interval (interval
, arg
)
2739 Lisp_Object object
= Fcar (arg
);
2740 Lisp_Object placeholder
= Fcdr (arg
);
2742 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2761 if (*cp
== '+' || *cp
== '-')
2764 if (*cp
>= '0' && *cp
<= '9')
2767 while (*cp
>= '0' && *cp
<= '9')
2775 if (*cp
>= '0' && *cp
<= '9')
2778 while (*cp
>= '0' && *cp
<= '9')
2781 if (*cp
== 'e' || *cp
== 'E')
2785 if (*cp
== '+' || *cp
== '-')
2789 if (*cp
>= '0' && *cp
<= '9')
2792 while (*cp
>= '0' && *cp
<= '9')
2795 else if (cp
== start
)
2797 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2802 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2808 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2809 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2810 || state
== (DOT_CHAR
|TRAIL_INT
)
2811 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2812 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2813 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2818 read_vector (readcharfun
, bytecodeflag
)
2819 Lisp_Object readcharfun
;
2824 register Lisp_Object
*ptr
;
2825 register Lisp_Object tem
, item
, vector
;
2826 register struct Lisp_Cons
*otem
;
2829 tem
= read_list (1, readcharfun
);
2830 len
= Flength (tem
);
2831 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2833 size
= XVECTOR (vector
)->size
;
2834 ptr
= XVECTOR (vector
)->contents
;
2835 for (i
= 0; i
< size
; i
++)
2838 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2839 bytecode object, the docstring containing the bytecode and
2840 constants values must be treated as unibyte and passed to
2841 Fread, to get the actual bytecode string and constants vector. */
2842 if (bytecodeflag
&& load_force_doc_strings
)
2844 if (i
== COMPILED_BYTECODE
)
2846 if (!STRINGP (item
))
2847 error ("invalid byte code");
2849 /* Delay handling the bytecode slot until we know whether
2850 it is lazily-loaded (we can tell by whether the
2851 constants slot is nil). */
2852 ptr
[COMPILED_CONSTANTS
] = item
;
2855 else if (i
== COMPILED_CONSTANTS
)
2857 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2861 /* Coerce string to unibyte (like string-as-unibyte,
2862 but without generating extra garbage and
2863 guaranteeing no change in the contents). */
2864 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2865 STRING_SET_UNIBYTE (bytestr
);
2867 item
= Fread (bytestr
);
2869 error ("invalid byte code");
2871 otem
= XCONS (item
);
2872 bytestr
= XCAR (item
);
2877 /* Now handle the bytecode slot. */
2878 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2881 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2889 /* FLAG = 1 means check for ] to terminate rather than ) and .
2890 FLAG = -1 means check for starting with defun
2891 and make structure pure. */
2894 read_list (flag
, readcharfun
)
2896 register Lisp_Object readcharfun
;
2898 /* -1 means check next element for defun,
2899 0 means don't check,
2900 1 means already checked and found defun. */
2901 int defunflag
= flag
< 0 ? -1 : 0;
2902 Lisp_Object val
, tail
;
2903 register Lisp_Object elt
, tem
;
2904 struct gcpro gcpro1
, gcpro2
;
2905 /* 0 is the normal case.
2906 1 means this list is a doc reference; replace it with the number 0.
2907 2 means this list is a doc reference; replace it with the doc string. */
2908 int doc_reference
= 0;
2910 /* Initialize this to 1 if we are reading a list. */
2911 int first_in_list
= flag
<= 0;
2920 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2925 /* While building, if the list starts with #$, treat it specially. */
2926 if (EQ (elt
, Vload_file_name
)
2928 && !NILP (Vpurify_flag
))
2930 if (NILP (Vdoc_file_name
))
2931 /* We have not yet called Snarf-documentation, so assume
2932 this file is described in the DOC-MM.NN file
2933 and Snarf-documentation will fill in the right value later.
2934 For now, replace the whole list with 0. */
2937 /* We have already called Snarf-documentation, so make a relative
2938 file name for this file, so it can be found properly
2939 in the installed Lisp directory.
2940 We don't use Fexpand_file_name because that would make
2941 the directory absolute now. */
2942 elt
= concat2 (build_string ("../lisp/"),
2943 Ffile_name_nondirectory (elt
));
2945 else if (EQ (elt
, Vload_file_name
)
2947 && load_force_doc_strings
)
2956 Fsignal (Qinvalid_read_syntax
,
2957 Fcons (make_string (") or . in a vector", 18), Qnil
));
2965 XSETCDR (tail
, read0 (readcharfun
));
2967 val
= read0 (readcharfun
);
2968 read1 (readcharfun
, &ch
, 0);
2972 if (doc_reference
== 1)
2973 return make_number (0);
2974 if (doc_reference
== 2)
2976 /* Get a doc string from the file we are loading.
2977 If it's in saved_doc_string, get it from there. */
2978 int pos
= XINT (XCDR (val
));
2979 /* Position is negative for user variables. */
2980 if (pos
< 0) pos
= -pos
;
2981 if (pos
>= saved_doc_string_position
2982 && pos
< (saved_doc_string_position
2983 + saved_doc_string_length
))
2985 int start
= pos
- saved_doc_string_position
;
2988 /* Process quoting with ^A,
2989 and find the end of the string,
2990 which is marked with ^_ (037). */
2991 for (from
= start
, to
= start
;
2992 saved_doc_string
[from
] != 037;)
2994 int c
= saved_doc_string
[from
++];
2997 c
= saved_doc_string
[from
++];
2999 saved_doc_string
[to
++] = c
;
3001 saved_doc_string
[to
++] = 0;
3003 saved_doc_string
[to
++] = 037;
3006 saved_doc_string
[to
++] = c
;
3009 return make_string (saved_doc_string
+ start
,
3012 /* Look in prev_saved_doc_string the same way. */
3013 else if (pos
>= prev_saved_doc_string_position
3014 && pos
< (prev_saved_doc_string_position
3015 + prev_saved_doc_string_length
))
3017 int start
= pos
- prev_saved_doc_string_position
;
3020 /* Process quoting with ^A,
3021 and find the end of the string,
3022 which is marked with ^_ (037). */
3023 for (from
= start
, to
= start
;
3024 prev_saved_doc_string
[from
] != 037;)
3026 int c
= prev_saved_doc_string
[from
++];
3029 c
= prev_saved_doc_string
[from
++];
3031 prev_saved_doc_string
[to
++] = c
;
3033 prev_saved_doc_string
[to
++] = 0;
3035 prev_saved_doc_string
[to
++] = 037;
3038 prev_saved_doc_string
[to
++] = c
;
3041 return make_string (prev_saved_doc_string
+ start
,
3045 return get_doc_string (val
, 0, 0);
3050 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3052 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3054 tem
= (read_pure
&& flag
<= 0
3055 ? pure_cons (elt
, Qnil
)
3056 : Fcons (elt
, Qnil
));
3058 XSETCDR (tail
, tem
);
3063 defunflag
= EQ (elt
, Qdefun
);
3064 else if (defunflag
> 0)
3069 Lisp_Object Vobarray
;
3070 Lisp_Object initial_obarray
;
3072 /* oblookup stores the bucket number here, for the sake of Funintern. */
3074 int oblookup_last_bucket_number
;
3076 static int hash_string ();
3078 /* Get an error if OBARRAY is not an obarray.
3079 If it is one, return it. */
3082 check_obarray (obarray
)
3083 Lisp_Object obarray
;
3085 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3087 /* If Vobarray is now invalid, force it to be valid. */
3088 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3090 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3095 /* Intern the C string STR: return a symbol with that name,
3096 interned in the current obarray. */
3103 int len
= strlen (str
);
3104 Lisp_Object obarray
;
3107 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3108 obarray
= check_obarray (obarray
);
3109 tem
= oblookup (obarray
, str
, len
, len
);
3112 return Fintern (make_string (str
, len
), obarray
);
3115 /* Create an uninterned symbol with name STR. */
3121 int len
= strlen (str
);
3123 return Fmake_symbol ((!NILP (Vpurify_flag
)
3124 ? make_pure_string (str
, len
, len
, 0)
3125 : make_string (str
, len
)));
3128 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3129 doc
: /* Return the canonical symbol whose name is STRING.
3130 If there is none, one is created by this function and returned.
3131 A second optional argument specifies the obarray to use;
3132 it defaults to the value of `obarray'. */)
3134 Lisp_Object string
, obarray
;
3136 register Lisp_Object tem
, sym
, *ptr
;
3138 if (NILP (obarray
)) obarray
= Vobarray
;
3139 obarray
= check_obarray (obarray
);
3141 CHECK_STRING (string
);
3143 tem
= oblookup (obarray
, SDATA (string
),
3146 if (!INTEGERP (tem
))
3149 if (!NILP (Vpurify_flag
))
3150 string
= Fpurecopy (string
);
3151 sym
= Fmake_symbol (string
);
3153 if (EQ (obarray
, initial_obarray
))
3154 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3156 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3158 if ((SREF (string
, 0) == ':')
3159 && EQ (obarray
, initial_obarray
))
3161 XSYMBOL (sym
)->constant
= 1;
3162 XSYMBOL (sym
)->value
= sym
;
3165 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3167 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3169 XSYMBOL (sym
)->next
= 0;
3174 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3175 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3176 NAME may be a string or a symbol. If it is a symbol, that exact
3177 symbol is searched for.
3178 A second optional argument specifies the obarray to use;
3179 it defaults to the value of `obarray'. */)
3181 Lisp_Object name
, obarray
;
3183 register Lisp_Object tem
, string
;
3185 if (NILP (obarray
)) obarray
= Vobarray
;
3186 obarray
= check_obarray (obarray
);
3188 if (!SYMBOLP (name
))
3190 CHECK_STRING (name
);
3194 string
= SYMBOL_NAME (name
);
3196 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3197 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3203 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3204 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3205 The value is t if a symbol was found and deleted, nil otherwise.
3206 NAME may be a string or a symbol. If it is a symbol, that symbol
3207 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3208 OBARRAY defaults to the value of the variable `obarray'. */)
3210 Lisp_Object name
, obarray
;
3212 register Lisp_Object string
, tem
;
3215 if (NILP (obarray
)) obarray
= Vobarray
;
3216 obarray
= check_obarray (obarray
);
3219 string
= SYMBOL_NAME (name
);
3222 CHECK_STRING (name
);
3226 tem
= oblookup (obarray
, SDATA (string
),
3231 /* If arg was a symbol, don't delete anything but that symbol itself. */
3232 if (SYMBOLP (name
) && !EQ (name
, tem
))
3235 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3236 XSYMBOL (tem
)->constant
= 0;
3237 XSYMBOL (tem
)->indirect_variable
= 0;
3239 hash
= oblookup_last_bucket_number
;
3241 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3243 if (XSYMBOL (tem
)->next
)
3244 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3246 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3250 Lisp_Object tail
, following
;
3252 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3253 XSYMBOL (tail
)->next
;
3256 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3257 if (EQ (following
, tem
))
3259 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3268 /* Return the symbol in OBARRAY whose names matches the string
3269 of SIZE characters (SIZE_BYTE bytes) at PTR.
3270 If there is no such symbol in OBARRAY, return nil.
3272 Also store the bucket number in oblookup_last_bucket_number. */
3275 oblookup (obarray
, ptr
, size
, size_byte
)
3276 Lisp_Object obarray
;
3277 register const char *ptr
;
3278 int size
, size_byte
;
3282 register Lisp_Object tail
;
3283 Lisp_Object bucket
, tem
;
3285 if (!VECTORP (obarray
)
3286 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3288 obarray
= check_obarray (obarray
);
3289 obsize
= XVECTOR (obarray
)->size
;
3291 /* This is sometimes needed in the middle of GC. */
3292 obsize
&= ~ARRAY_MARK_FLAG
;
3293 /* Combining next two lines breaks VMS C 2.3. */
3294 hash
= hash_string (ptr
, size_byte
);
3296 bucket
= XVECTOR (obarray
)->contents
[hash
];
3297 oblookup_last_bucket_number
= hash
;
3298 if (EQ (bucket
, make_number (0)))
3300 else if (!SYMBOLP (bucket
))
3301 error ("Bad data in guts of obarray"); /* Like CADR error message */
3303 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3305 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3306 && SCHARS (SYMBOL_NAME (tail
)) == size
3307 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3309 else if (XSYMBOL (tail
)->next
== 0)
3312 XSETINT (tem
, hash
);
3317 hash_string (ptr
, len
)
3318 const unsigned char *ptr
;
3321 register const unsigned char *p
= ptr
;
3322 register const unsigned char *end
= p
+ len
;
3323 register unsigned char c
;
3324 register int hash
= 0;
3329 if (c
>= 0140) c
-= 40;
3330 hash
= ((hash
<<3) + (hash
>>28) + c
);
3332 return hash
& 07777777777;
3336 map_obarray (obarray
, fn
, arg
)
3337 Lisp_Object obarray
;
3338 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3342 register Lisp_Object tail
;
3343 CHECK_VECTOR (obarray
);
3344 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3346 tail
= XVECTOR (obarray
)->contents
[i
];
3351 if (XSYMBOL (tail
)->next
== 0)
3353 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3359 mapatoms_1 (sym
, function
)
3360 Lisp_Object sym
, function
;
3362 call1 (function
, sym
);
3365 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3366 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3367 OBARRAY defaults to the value of `obarray'. */)
3369 Lisp_Object function
, obarray
;
3371 if (NILP (obarray
)) obarray
= Vobarray
;
3372 obarray
= check_obarray (obarray
);
3374 map_obarray (obarray
, mapatoms_1
, function
);
3378 #define OBARRAY_SIZE 1511
3383 Lisp_Object oblength
;
3387 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3389 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3390 Vobarray
= Fmake_vector (oblength
, make_number (0));
3391 initial_obarray
= Vobarray
;
3392 staticpro (&initial_obarray
);
3393 /* Intern nil in the obarray */
3394 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3395 XSYMBOL (Qnil
)->constant
= 1;
3397 /* These locals are to kludge around a pyramid compiler bug. */
3398 hash
= hash_string ("nil", 3);
3399 /* Separate statement here to avoid VAXC bug. */
3400 hash
%= OBARRAY_SIZE
;
3401 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3404 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3405 XSYMBOL (Qnil
)->function
= Qunbound
;
3406 XSYMBOL (Qunbound
)->value
= Qunbound
;
3407 XSYMBOL (Qunbound
)->function
= Qunbound
;
3410 XSYMBOL (Qnil
)->value
= Qnil
;
3411 XSYMBOL (Qnil
)->plist
= Qnil
;
3412 XSYMBOL (Qt
)->value
= Qt
;
3413 XSYMBOL (Qt
)->constant
= 1;
3415 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3418 Qvariable_documentation
= intern ("variable-documentation");
3419 staticpro (&Qvariable_documentation
);
3421 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3422 read_buffer
= (char *) xmalloc (read_buffer_size
);
3427 struct Lisp_Subr
*sname
;
3430 sym
= intern (sname
->symbol_name
);
3431 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3434 #ifdef NOTDEF /* use fset in subr.el now */
3436 defalias (sname
, string
)
3437 struct Lisp_Subr
*sname
;
3441 sym
= intern (string
);
3442 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3446 /* Define an "integer variable"; a symbol whose value is forwarded
3447 to a C variable of type int. Sample call: */
3448 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3450 defvar_int (namestring
, address
)
3454 Lisp_Object sym
, val
;
3455 sym
= intern (namestring
);
3456 val
= allocate_misc ();
3457 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3458 XINTFWD (val
)->intvar
= address
;
3459 SET_SYMBOL_VALUE (sym
, val
);
3462 /* Similar but define a variable whose value is t if address contains 1,
3463 nil if address contains 0 */
3465 defvar_bool (namestring
, address
)
3469 Lisp_Object sym
, val
;
3470 sym
= intern (namestring
);
3471 val
= allocate_misc ();
3472 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3473 XBOOLFWD (val
)->boolvar
= address
;
3474 SET_SYMBOL_VALUE (sym
, val
);
3475 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3478 /* Similar but define a variable whose value is the Lisp Object stored
3479 at address. Two versions: with and without gc-marking of the C
3480 variable. The nopro version is used when that variable will be
3481 gc-marked for some other reason, since marking the same slot twice
3482 can cause trouble with strings. */
3484 defvar_lisp_nopro (namestring
, address
)
3486 Lisp_Object
*address
;
3488 Lisp_Object sym
, val
;
3489 sym
= intern (namestring
);
3490 val
= allocate_misc ();
3491 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3492 XOBJFWD (val
)->objvar
= address
;
3493 SET_SYMBOL_VALUE (sym
, val
);
3497 defvar_lisp (namestring
, address
)
3499 Lisp_Object
*address
;
3501 defvar_lisp_nopro (namestring
, address
);
3502 staticpro (address
);
3505 /* Similar but define a variable whose value is the Lisp Object stored in
3506 the current buffer. address is the address of the slot in the buffer
3507 that is current now. */
3510 defvar_per_buffer (namestring
, address
, type
, doc
)
3512 Lisp_Object
*address
;
3516 Lisp_Object sym
, val
;
3519 sym
= intern (namestring
);
3520 val
= allocate_misc ();
3521 offset
= (char *)address
- (char *)current_buffer
;
3523 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3524 XBUFFER_OBJFWD (val
)->offset
= offset
;
3525 SET_SYMBOL_VALUE (sym
, val
);
3526 PER_BUFFER_SYMBOL (offset
) = sym
;
3527 PER_BUFFER_TYPE (offset
) = type
;
3529 if (PER_BUFFER_IDX (offset
) == 0)
3530 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3531 slot of buffer_local_flags */
3536 /* Similar but define a variable whose value is the Lisp Object stored
3537 at a particular offset in the current kboard object. */
3540 defvar_kboard (namestring
, offset
)
3544 Lisp_Object sym
, val
;
3545 sym
= intern (namestring
);
3546 val
= allocate_misc ();
3547 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3548 XKBOARD_OBJFWD (val
)->offset
= offset
;
3549 SET_SYMBOL_VALUE (sym
, val
);
3552 /* Record the value of load-path used at the start of dumping
3553 so we can see if the site changed it later during dumping. */
3554 static Lisp_Object dump_path
;
3560 int turn_off_warning
= 0;
3562 /* Compute the default load-path. */
3564 normal
= PATH_LOADSEARCH
;
3565 Vload_path
= decode_env_path (0, normal
);
3567 if (NILP (Vpurify_flag
))
3568 normal
= PATH_LOADSEARCH
;
3570 normal
= PATH_DUMPLOADSEARCH
;
3572 /* In a dumped Emacs, we normally have to reset the value of
3573 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3574 uses ../lisp, instead of the path of the installed elisp
3575 libraries. However, if it appears that Vload_path was changed
3576 from the default before dumping, don't override that value. */
3579 if (! NILP (Fequal (dump_path
, Vload_path
)))
3581 Vload_path
= decode_env_path (0, normal
);
3582 if (!NILP (Vinstallation_directory
))
3584 Lisp_Object tem
, tem1
, sitelisp
;
3586 /* Remove site-lisp dirs from path temporarily and store
3587 them in sitelisp, then conc them on at the end so
3588 they're always first in path. */
3592 tem
= Fcar (Vload_path
);
3593 tem1
= Fstring_match (build_string ("site-lisp"),
3597 Vload_path
= Fcdr (Vload_path
);
3598 sitelisp
= Fcons (tem
, sitelisp
);
3604 /* Add to the path the lisp subdir of the
3605 installation dir, if it exists. */
3606 tem
= Fexpand_file_name (build_string ("lisp"),
3607 Vinstallation_directory
);
3608 tem1
= Ffile_exists_p (tem
);
3611 if (NILP (Fmember (tem
, Vload_path
)))
3613 turn_off_warning
= 1;
3614 Vload_path
= Fcons (tem
, Vload_path
);
3618 /* That dir doesn't exist, so add the build-time
3619 Lisp dirs instead. */
3620 Vload_path
= nconc2 (Vload_path
, dump_path
);
3622 /* Add leim under the installation dir, if it exists. */
3623 tem
= Fexpand_file_name (build_string ("leim"),
3624 Vinstallation_directory
);
3625 tem1
= Ffile_exists_p (tem
);
3628 if (NILP (Fmember (tem
, Vload_path
)))
3629 Vload_path
= Fcons (tem
, Vload_path
);
3632 /* Add site-list under the installation dir, if it exists. */
3633 tem
= Fexpand_file_name (build_string ("site-lisp"),
3634 Vinstallation_directory
);
3635 tem1
= Ffile_exists_p (tem
);
3638 if (NILP (Fmember (tem
, Vload_path
)))
3639 Vload_path
= Fcons (tem
, Vload_path
);
3642 /* If Emacs was not built in the source directory,
3643 and it is run from where it was built, add to load-path
3644 the lisp, leim and site-lisp dirs under that directory. */
3646 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3650 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3651 Vinstallation_directory
);
3652 tem1
= Ffile_exists_p (tem
);
3654 /* Don't be fooled if they moved the entire source tree
3655 AFTER dumping Emacs. If the build directory is indeed
3656 different from the source dir, src/Makefile.in and
3657 src/Makefile will not be found together. */
3658 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3659 Vinstallation_directory
);
3660 tem2
= Ffile_exists_p (tem
);
3661 if (!NILP (tem1
) && NILP (tem2
))
3663 tem
= Fexpand_file_name (build_string ("lisp"),
3666 if (NILP (Fmember (tem
, Vload_path
)))
3667 Vload_path
= Fcons (tem
, Vload_path
);
3669 tem
= Fexpand_file_name (build_string ("leim"),
3672 if (NILP (Fmember (tem
, Vload_path
)))
3673 Vload_path
= Fcons (tem
, Vload_path
);
3675 tem
= Fexpand_file_name (build_string ("site-lisp"),
3678 if (NILP (Fmember (tem
, Vload_path
)))
3679 Vload_path
= Fcons (tem
, Vload_path
);
3682 if (!NILP (sitelisp
))
3683 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3689 /* NORMAL refers to the lisp dir in the source directory. */
3690 /* We used to add ../lisp at the front here, but
3691 that caused trouble because it was copied from dump_path
3692 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3693 It should be unnecessary. */
3694 Vload_path
= decode_env_path (0, normal
);
3695 dump_path
= Vload_path
;
3699 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3700 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3701 almost never correct, thereby causing a warning to be printed out that
3702 confuses users. Since PATH_LOADSEARCH is always overridden by the
3703 EMACSLOADPATH environment variable below, disable the warning on NT.
3704 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3705 the "standard" paths may not exist and would be overridden by
3706 EMACSLOADPATH as on NT. Since this depends on how the executable
3707 was build and packaged, turn off the warnings in general */
3709 /* Warn if dirs in the *standard* path don't exist. */
3710 if (!turn_off_warning
)
3712 Lisp_Object path_tail
;
3714 for (path_tail
= Vload_path
;
3716 path_tail
= XCDR (path_tail
))
3718 Lisp_Object dirfile
;
3719 dirfile
= Fcar (path_tail
);
3720 if (STRINGP (dirfile
))
3722 dirfile
= Fdirectory_file_name (dirfile
);
3723 if (access (SDATA (dirfile
), 0) < 0)
3724 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3729 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3731 /* If the EMACSLOADPATH environment variable is set, use its value.
3732 This doesn't apply if we're dumping. */
3734 if (NILP (Vpurify_flag
)
3735 && egetenv ("EMACSLOADPATH"))
3737 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3741 load_in_progress
= 0;
3742 Vload_file_name
= Qnil
;
3744 load_descriptor_list
= Qnil
;
3746 Vstandard_input
= Qt
;
3747 Vloads_in_progress
= Qnil
;
3750 /* Print a warning, using format string FORMAT, that directory DIRNAME
3751 does not exist. Print it on stderr and put it in *Message*. */
3754 dir_warning (format
, dirname
)
3756 Lisp_Object dirname
;
3759 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3761 fprintf (stderr
, format
, SDATA (dirname
));
3762 sprintf (buffer
, format
, SDATA (dirname
));
3763 /* Don't log the warning before we've initialized!! */
3765 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3772 defsubr (&Sread_from_string
);
3774 defsubr (&Sintern_soft
);
3775 defsubr (&Sunintern
);
3777 defsubr (&Seval_buffer
);
3778 defsubr (&Seval_region
);
3779 defsubr (&Sread_char
);
3780 defsubr (&Sread_char_exclusive
);
3781 defsubr (&Sread_event
);
3782 defsubr (&Sget_file_char
);
3783 defsubr (&Smapatoms
);
3784 defsubr (&Slocate_file_internal
);
3786 DEFVAR_LISP ("obarray", &Vobarray
,
3787 doc
: /* Symbol table for use by `intern' and `read'.
3788 It is a vector whose length ought to be prime for best results.
3789 The vector's contents don't make sense if examined from Lisp programs;
3790 to find all the symbols in an obarray, use `mapatoms'. */);
3792 DEFVAR_LISP ("values", &Vvalues
,
3793 doc
: /* List of values of all expressions which were read, evaluated and printed.
3794 Order is reverse chronological. */);
3796 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3797 doc
: /* Stream for read to get input from.
3798 See documentation of `read' for possible values. */);
3799 Vstandard_input
= Qt
;
3801 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3802 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3804 If this variable is a buffer, then only forms read from that buffer
3805 will be added to `read-symbol-positions-list'.
3806 If this variable is t, then all read forms will be added.
3807 The effect of all other values other than nil are not currently
3808 defined, although they may be in the future.
3810 The positions are relative to the last call to `read' or
3811 `read-from-string'. It is probably a bad idea to set this variable at
3812 the toplevel; bind it instead. */);
3813 Vread_with_symbol_positions
= Qnil
;
3815 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3816 doc
: /* A list mapping read symbols to their positions.
3817 This variable is modified during calls to `read' or
3818 `read-from-string', but only when `read-with-symbol-positions' is
3821 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3822 CHAR-POSITION is an integer giving the offset of that occurrence of the
3823 symbol from the position where `read' or `read-from-string' started.
3825 Note that a symbol will appear multiple times in this list, if it was
3826 read multiple times. The list is in the same order as the symbols
3828 Vread_symbol_positions_list
= Qnil
;
3830 DEFVAR_LISP ("load-path", &Vload_path
,
3831 doc
: /* *List of directories to search for files to load.
3832 Each element is a string (directory name) or nil (try default directory).
3833 Initialized based on EMACSLOADPATH environment variable, if any,
3834 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3836 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3837 doc
: /* *List of suffixes to try for files to load.
3838 This list should not include the empty string. */);
3839 Vload_suffixes
= Fcons (build_string (".elc"),
3840 Fcons (build_string (".el"), Qnil
));
3841 /* We don't use empty_string because it's not initialized yet. */
3842 default_suffixes
= Fcons (build_string (""), Qnil
);
3843 staticpro (&default_suffixes
);
3845 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3846 doc
: /* Non-nil iff inside of `load'. */);
3848 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3849 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3850 Each element looks like (FILENAME FORMS...).
3851 When `load' is run and the file-name argument is FILENAME,
3852 the FORMS in the corresponding element are executed at the end of loading.
3854 FILENAME must match exactly! Normally FILENAME is the name of a library,
3855 with no directory specified, since that is how `load' is normally called.
3856 An error in FORMS does not undo the load,
3857 but does prevent execution of the rest of the FORMS.
3858 FILENAME can also be a symbol (a feature) and FORMS are then executed
3859 when the corresponding call to `provide' is made. */);
3860 Vafter_load_alist
= Qnil
;
3862 DEFVAR_LISP ("load-history", &Vload_history
,
3863 doc
: /* Alist mapping source file names to symbols and features.
3864 Each alist element is a list that starts with a file name,
3865 except for one element (optional) that starts with nil and describes
3866 definitions evaluated from buffers not visiting files.
3867 The remaining elements of each list are symbols defined as variables
3868 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3869 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3870 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3871 and means that SYMBOL was an autoload before this file redefined it
3873 Vload_history
= Qnil
;
3875 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3876 doc
: /* Full name of file being loaded by `load'. */);
3877 Vload_file_name
= Qnil
;
3879 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3880 doc
: /* File name, including directory, of user's initialization file.
3881 If the file loaded had extension `.elc', and the corresponding source file
3882 exists, this variable contains the name of source file, suitable for use
3883 by functions like `custom-save-all' which edit the init file. */);
3884 Vuser_init_file
= Qnil
;
3886 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3887 doc
: /* Used for internal purposes by `load'. */);
3888 Vcurrent_load_list
= Qnil
;
3890 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3891 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3892 The default is nil, which means use the function `read'. */);
3893 Vload_read_function
= Qnil
;
3895 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3896 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3897 This function is for doing code conversion before reading the source file.
3898 If nil, loading is done without any code conversion.
3899 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3900 FULLNAME is the full name of FILE.
3901 See `load' for the meaning of the remaining arguments. */);
3902 Vload_source_file_function
= Qnil
;
3904 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3905 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3906 This is useful when the file being loaded is a temporary copy. */);
3907 load_force_doc_strings
= 0;
3909 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3910 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3911 This is normally bound by `load' and `eval-buffer' to control `read',
3912 and is not meant for users to change. */);
3913 load_convert_to_unibyte
= 0;
3915 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3916 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3917 You cannot count on them to still be there! */);
3919 = Fexpand_file_name (build_string ("../"),
3920 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3922 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3923 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3924 Vpreloaded_file_list
= Qnil
;
3926 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3927 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3928 Vbyte_boolean_vars
= Qnil
;
3930 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3931 doc
: /* Non-nil means load dangerous compiled Lisp files.
3932 Some versions of XEmacs use different byte codes than Emacs. These
3933 incompatible byte codes can make Emacs crash when it tries to execute
3935 load_dangerous_libraries
= 0;
3937 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3938 doc
: /* Regular expression matching safe to load compiled Lisp files.
3939 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3940 from the file, and matches them against this regular expression.
3941 When the regular expression matches, the file is considered to be safe
3942 to load. See also `load-dangerous-libraries'. */);
3943 Vbytecomp_version_regexp
3944 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3946 /* Vsource_directory was initialized in init_lread. */
3948 load_descriptor_list
= Qnil
;
3949 staticpro (&load_descriptor_list
);
3951 Qcurrent_load_list
= intern ("current-load-list");
3952 staticpro (&Qcurrent_load_list
);
3954 Qstandard_input
= intern ("standard-input");
3955 staticpro (&Qstandard_input
);
3957 Qread_char
= intern ("read-char");
3958 staticpro (&Qread_char
);
3960 Qget_file_char
= intern ("get-file-char");
3961 staticpro (&Qget_file_char
);
3963 Qbackquote
= intern ("`");
3964 staticpro (&Qbackquote
);
3965 Qcomma
= intern (",");
3966 staticpro (&Qcomma
);
3967 Qcomma_at
= intern (",@");
3968 staticpro (&Qcomma_at
);
3969 Qcomma_dot
= intern (",.");
3970 staticpro (&Qcomma_dot
);
3972 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3973 staticpro (&Qinhibit_file_name_operation
);
3975 Qascii_character
= intern ("ascii-character");
3976 staticpro (&Qascii_character
);
3978 Qfunction
= intern ("function");
3979 staticpro (&Qfunction
);
3981 Qload
= intern ("load");
3984 Qload_file_name
= intern ("load-file-name");
3985 staticpro (&Qload_file_name
);
3987 staticpro (&dump_path
);
3989 staticpro (&read_objects
);
3990 read_objects
= Qnil
;
3991 staticpro (&seen_list
);
3993 Vloads_in_progress
= Qnil
;
3994 staticpro (&Vloads_in_progress
);
3997 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
3998 (do not change this comment) */