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"
37 #include "termhooks.h"
41 #include <sys/inode.h>
46 #include <unistd.h> /* to get X_OK */
63 #endif /* HAVE_SETLOCALE */
73 #define file_offset off_t
74 #define file_tell ftello
76 #define file_offset long
77 #define file_tell ftell
84 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
85 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
86 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
87 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
88 Lisp_Object Qinhibit_file_name_operation
;
90 extern Lisp_Object Qevent_symbol_element_mask
;
91 extern Lisp_Object Qfile_exists_p
;
93 /* non-zero iff inside `load' */
96 /* Directory in which the sources were found. */
97 Lisp_Object Vsource_directory
;
99 /* Search path and suffixes for files to be loaded. */
100 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
102 /* File name of user's init file. */
103 Lisp_Object Vuser_init_file
;
105 /* This is the user-visible association list that maps features to
106 lists of defs in their load files. */
107 Lisp_Object Vload_history
;
109 /* This is used to build the load history. */
110 Lisp_Object Vcurrent_load_list
;
112 /* List of files that were preloaded. */
113 Lisp_Object Vpreloaded_file_list
;
115 /* Name of file actually being read by `load'. */
116 Lisp_Object Vload_file_name
;
118 /* Function to use for reading, in `load' and friends. */
119 Lisp_Object Vload_read_function
;
121 /* The association list of objects read with the #n=object form.
122 Each member of the list has the form (n . object), and is used to
123 look up the object for the corresponding #n# construct.
124 It must be set to nil before all top-level calls to read0. */
125 Lisp_Object read_objects
;
127 /* Nonzero means load should forcibly load all dynamic doc strings. */
128 static int load_force_doc_strings
;
130 /* Nonzero means read should convert strings to unibyte. */
131 static int load_convert_to_unibyte
;
133 /* Function to use for loading an Emacs lisp source file (not
134 compiled) instead of readevalloop. */
135 Lisp_Object Vload_source_file_function
;
137 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
138 Lisp_Object Vbyte_boolean_vars
;
140 /* Whether or not to add a `read-positions' property to symbols
142 Lisp_Object Vread_with_symbol_positions
;
144 /* List of (SYMBOL . POSITION) accumulated so far. */
145 Lisp_Object Vread_symbol_positions_list
;
147 /* List of descriptors now open for Fload. */
148 static Lisp_Object load_descriptor_list
;
150 /* File for get_file_char to read from. Use by load. */
151 static FILE *instream
;
153 /* When nonzero, read conses in pure space */
154 static int read_pure
;
156 /* For use within read-from-string (this reader is non-reentrant!!) */
157 static int read_from_string_index
;
158 static int read_from_string_index_byte
;
159 static int read_from_string_limit
;
161 /* Number of bytes left to read in the buffer character
162 that `readchar' has already advanced over. */
163 static int readchar_backlog
;
164 /* Number of characters read in the current call to Fread or
165 Fread_from_string. */
166 static int readchar_count
;
168 /* This contains the last string skipped with #@. */
169 static char *saved_doc_string
;
170 /* Length of buffer allocated in saved_doc_string. */
171 static int saved_doc_string_size
;
172 /* Length of actual data in saved_doc_string. */
173 static int saved_doc_string_length
;
174 /* This is the file position that string came from. */
175 static file_offset saved_doc_string_position
;
177 /* This contains the previous string skipped with #@.
178 We copy it from saved_doc_string when a new string
179 is put in saved_doc_string. */
180 static char *prev_saved_doc_string
;
181 /* Length of buffer allocated in prev_saved_doc_string. */
182 static int prev_saved_doc_string_size
;
183 /* Length of actual data in prev_saved_doc_string. */
184 static int prev_saved_doc_string_length
;
185 /* This is the file position that string came from. */
186 static file_offset prev_saved_doc_string_position
;
188 /* Nonzero means inside a new-style backquote
189 with no surrounding parentheses.
190 Fread initializes this to zero, so we need not specbind it
191 or worry about what happens to it when there is an error. */
192 static int new_backquote_flag
;
194 /* A list of file names for files being loaded in Fload. Used to
195 check for recursive loads. */
197 static Lisp_Object Vloads_in_progress
;
199 /* Non-zero means load dangerous compiled Lisp files. */
201 int load_dangerous_libraries
;
203 /* A regular expression used to detect files compiled with Emacs. */
205 static Lisp_Object Vbytecomp_version_regexp
;
207 static void to_multibyte
P_ ((char **, char **, int *));
208 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
209 Lisp_Object (*) (), int,
210 Lisp_Object
, Lisp_Object
,
211 Lisp_Object
, Lisp_Object
));
212 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
213 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
216 /* Handle unreading and rereading of characters.
217 Write READCHAR to read a character,
218 UNREAD(c) to unread c to be read again.
220 The READCHAR and UNREAD macros are meant for reading/unreading a
221 byte code; they do not handle multibyte characters. The caller
222 should manage them if necessary.
224 [ Actually that seems to be a lie; READCHAR will definitely read
225 multibyte characters from buffer sources, at least. Is the
226 comment just out of date?
227 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
230 #define READCHAR readchar (readcharfun)
231 #define UNREAD(c) unreadchar (readcharfun, c)
234 readchar (readcharfun
)
235 Lisp_Object readcharfun
;
242 if (BUFFERP (readcharfun
))
244 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
246 int pt_byte
= BUF_PT_BYTE (inbuffer
);
247 int orig_pt_byte
= pt_byte
;
249 if (readchar_backlog
> 0)
250 /* We get the address of the byte just passed,
251 which is the last byte of the character.
252 The other bytes in this character are consecutive with it,
253 because the gap can't be in the middle of a character. */
254 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
255 - --readchar_backlog
);
257 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
260 readchar_backlog
= -1;
262 if (! NILP (inbuffer
->enable_multibyte_characters
))
264 /* Fetch the character code from the buffer. */
265 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
266 BUF_INC_POS (inbuffer
, pt_byte
);
267 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
271 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
274 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
278 if (MARKERP (readcharfun
))
280 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
282 int bytepos
= marker_byte_position (readcharfun
);
283 int orig_bytepos
= bytepos
;
285 if (readchar_backlog
> 0)
286 /* We get the address of the byte just passed,
287 which is the last byte of the character.
288 The other bytes in this character are consecutive with it,
289 because the gap can't be in the middle of a character. */
290 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
291 - --readchar_backlog
);
293 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
296 readchar_backlog
= -1;
298 if (! NILP (inbuffer
->enable_multibyte_characters
))
300 /* Fetch the character code from the buffer. */
301 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
302 BUF_INC_POS (inbuffer
, bytepos
);
303 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
307 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
311 XMARKER (readcharfun
)->bytepos
= bytepos
;
312 XMARKER (readcharfun
)->charpos
++;
317 if (EQ (readcharfun
, Qlambda
))
318 return read_bytecode_char (0);
320 if (EQ (readcharfun
, Qget_file_char
))
324 /* Interrupted reads have been observed while reading over the network */
325 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
335 if (STRINGP (readcharfun
))
337 if (read_from_string_index
>= read_from_string_limit
)
340 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
341 read_from_string_index
,
342 read_from_string_index_byte
);
347 tem
= call0 (readcharfun
);
354 /* Unread the character C in the way appropriate for the stream READCHARFUN.
355 If the stream is a user function, call it with the char as argument. */
358 unreadchar (readcharfun
, c
)
359 Lisp_Object readcharfun
;
364 /* Don't back up the pointer if we're unreading the end-of-input mark,
365 since readchar didn't advance it when we read it. */
367 else if (BUFFERP (readcharfun
))
369 struct buffer
*b
= XBUFFER (readcharfun
);
370 int bytepos
= BUF_PT_BYTE (b
);
372 if (readchar_backlog
>= 0)
377 if (! NILP (b
->enable_multibyte_characters
))
378 BUF_DEC_POS (b
, bytepos
);
382 BUF_PT_BYTE (b
) = bytepos
;
385 else if (MARKERP (readcharfun
))
387 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
388 int bytepos
= XMARKER (readcharfun
)->bytepos
;
390 if (readchar_backlog
>= 0)
394 XMARKER (readcharfun
)->charpos
--;
395 if (! NILP (b
->enable_multibyte_characters
))
396 BUF_DEC_POS (b
, bytepos
);
400 XMARKER (readcharfun
)->bytepos
= bytepos
;
403 else if (STRINGP (readcharfun
))
405 read_from_string_index
--;
406 read_from_string_index_byte
407 = string_char_to_byte (readcharfun
, read_from_string_index
);
409 else if (EQ (readcharfun
, Qlambda
))
410 read_bytecode_char (1);
411 else if (EQ (readcharfun
, Qget_file_char
))
412 ungetc (c
, instream
);
414 call1 (readcharfun
, make_number (c
));
417 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
419 static Lisp_Object read0
P_ ((Lisp_Object
));
420 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
422 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
423 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
424 static int read_multibyte
P_ ((int, Lisp_Object
));
426 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
428 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
430 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
433 /* Get a character from the tty. */
435 extern Lisp_Object
read_char ();
437 /* Read input events until we get one that's acceptable for our purposes.
439 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
440 until we get a character we like, and then stuffed into
443 If ASCII_REQUIRED is non-zero, we check function key events to see
444 if the unmodified version of the symbol has a Qascii_character
445 property, and use that character, if present.
447 If ERROR_NONASCII is non-zero, we signal an error if the input we
448 get isn't an ASCII character with modifiers. If it's zero but
449 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
452 If INPUT_METHOD is nonzero, we invoke the current input method
453 if the character warrants that. */
456 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
458 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
460 register Lisp_Object val
, delayed_switch_frame
;
462 #ifdef HAVE_WINDOW_SYSTEM
463 if (display_hourglass_p
)
467 delayed_switch_frame
= Qnil
;
469 /* Read until we get an acceptable event. */
471 val
= read_char (0, 0, 0,
472 (input_method
? Qnil
: Qt
),
478 /* switch-frame events are put off until after the next ASCII
479 character. This is better than signaling an error just because
480 the last characters were typed to a separate minibuffer frame,
481 for example. Eventually, some code which can deal with
482 switch-frame events will read it and process it. */
484 && EVENT_HAS_PARAMETERS (val
)
485 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
487 delayed_switch_frame
= val
;
493 /* Convert certain symbols to their ASCII equivalents. */
496 Lisp_Object tem
, tem1
;
497 tem
= Fget (val
, Qevent_symbol_element_mask
);
500 tem1
= Fget (Fcar (tem
), Qascii_character
);
501 /* Merge this symbol's modifier bits
502 with the ASCII equivalent of its basic code. */
504 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
508 /* If we don't have a character now, deal with it appropriately. */
513 Vunread_command_events
= Fcons (val
, Qnil
);
514 error ("Non-character input-event");
521 if (! NILP (delayed_switch_frame
))
522 unread_switch_frame
= delayed_switch_frame
;
526 #ifdef HAVE_WINDOW_SYSTEM
527 if (display_hourglass_p
)
536 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
537 doc
: /* Read a character from the command input (keyboard or macro).
538 It is returned as a number.
539 If the user generates an event which is not a character (i.e. a mouse
540 click or function key event), `read-char' signals an error. As an
541 exception, switch-frame events are put off until non-ASCII events can
543 If you want to read non-character events, or ignore them, call
544 `read-event' or `read-char-exclusive' instead.
546 If the optional argument PROMPT is non-nil, display that as a prompt.
547 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
548 input method is turned on in the current buffer, that input method
549 is used for reading a character. */)
550 (prompt
, inherit_input_method
)
551 Lisp_Object prompt
, inherit_input_method
;
554 message_with_string ("%s", prompt
, 0);
555 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
558 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
559 doc
: /* Read an event object from the input stream.
560 If the optional argument PROMPT is non-nil, display that as a prompt.
561 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
562 input method is turned on in the current buffer, that input method
563 is used for reading a character. */)
564 (prompt
, inherit_input_method
)
565 Lisp_Object prompt
, inherit_input_method
;
568 message_with_string ("%s", prompt
, 0);
569 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
572 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
573 doc
: /* Read a character from the command input (keyboard or macro).
574 It is returned as a number. Non-character events are ignored.
576 If the optional argument PROMPT is non-nil, display that as a prompt.
577 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
578 input method is turned on in the current buffer, that input method
579 is used for reading a character. */)
580 (prompt
, inherit_input_method
)
581 Lisp_Object prompt
, inherit_input_method
;
584 message_with_string ("%s", prompt
, 0);
585 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
588 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
589 doc
: /* Don't use this yourself. */)
592 register Lisp_Object val
;
593 XSETINT (val
, getc (instream
));
599 /* Value is non-zero if the file asswociated with file descriptor FD
600 is a compiled Lisp file that's safe to load. Only files compiled
601 with Emacs are safe to load. Files compiled with XEmacs can lead
602 to a crash in Fbyte_code because of an incompatible change in the
613 /* Read the first few bytes from the file, and look for a line
614 specifying the byte compiler version used. */
615 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
620 /* Skip to the next newline, skipping over the initial `ELC'
621 with NUL bytes following it. */
622 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
626 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
631 lseek (fd
, 0, SEEK_SET
);
636 /* Callback for record_unwind_protect. Restore the old load list OLD,
637 after loading a file successfully. */
640 record_load_unwind (old
)
643 return Vloads_in_progress
= old
;
646 /* This handler function is used via internal_condition_case_1. */
649 load_error_handler (data
)
655 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
656 doc
: /* Execute a file of Lisp code named FILE.
657 First try FILE with `.elc' appended, then try with `.el',
658 then try FILE unmodified (the exact suffixes are determined by
659 `load-suffixes'). Environment variable references in FILE
660 are replaced with their values by calling `substitute-in-file-name'.
661 This function searches the directories in `load-path'.
662 If optional second arg NOERROR is non-nil,
663 report no error if FILE doesn't exist.
664 Print messages at start and end of loading unless
665 optional third arg NOMESSAGE is non-nil.
666 If optional fourth arg NOSUFFIX is non-nil, don't try adding
667 suffixes `.elc' or `.el' to the specified name FILE.
668 If optional fifth arg MUST-SUFFIX is non-nil, insist on
669 the suffix `.elc' or `.el'; don't accept just FILE unless
670 it ends in one of those suffixes or includes a directory name.
671 Return t if file exists. */)
672 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
673 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
675 register FILE *stream
;
676 register int fd
= -1;
677 register Lisp_Object lispstream
;
678 int count
= SPECPDL_INDEX ();
681 Lisp_Object found
, efound
;
682 /* 1 means we printed the ".el is newer" message. */
684 /* 1 means we are loading a compiled file. */
695 /* If file name is magic, call the handler. */
696 /* This shouldn't be necessary any more now that `openp' handles it right.
697 handler = Ffind_file_name_handler (file, Qload);
699 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
701 /* Do this after the handler to avoid
702 the need to gcpro noerror, nomessage and nosuffix.
703 (Below here, we care only whether they are nil or not.)
704 The presence of this call is the result of a historical accident:
705 it used to be in every file-operations and when it got removed
706 everywhere, it accidentally stayed here. Since then, enough people
707 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
708 that it seemed risky to remove. */
709 if (! NILP (noerror
))
711 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
712 Qt
, load_error_handler
);
717 file
= Fsubstitute_in_file_name (file
);
720 /* Avoid weird lossage with null string as arg,
721 since it would try to load a directory as a Lisp file */
722 if (SCHARS (file
) > 0)
724 int size
= SBYTES (file
);
729 if (! NILP (must_suffix
))
731 /* Don't insist on adding a suffix if FILE already ends with one. */
733 && !strcmp (SDATA (file
) + size
- 3, ".el"))
736 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
738 /* Don't insist on adding a suffix
739 if the argument includes a directory name. */
740 else if (! NILP (Ffile_name_directory (file
)))
744 fd
= openp (Vload_path
, file
,
745 (!NILP (nosuffix
) ? Qnil
746 : !NILP (must_suffix
) ? Vload_suffixes
747 : Fappend (2, (tmp
[0] = Vload_suffixes
,
748 tmp
[1] = default_suffixes
,
757 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
758 Fcons (file
, Qnil
)));
763 /* Tell startup.el whether or not we found the user's init file. */
764 if (EQ (Qt
, Vuser_init_file
))
765 Vuser_init_file
= found
;
767 /* If FD is -2, that means openp found a magic file. */
770 if (NILP (Fequal (found
, file
)))
771 /* If FOUND is a different file name from FILE,
772 find its handler even if we have already inhibited
773 the `load' operation on FILE. */
774 handler
= Ffind_file_name_handler (found
, Qt
);
776 handler
= Ffind_file_name_handler (found
, Qload
);
777 if (! NILP (handler
))
778 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
781 /* Check if we're stuck in a recursive load cycle.
783 2000-09-21: It's not possible to just check for the file loaded
784 being a member of Vloads_in_progress. This fails because of the
785 way the byte compiler currently works; `provide's are not
786 evaluted, see font-lock.el/jit-lock.el as an example. This
787 leads to a certain amount of ``normal'' recursion.
789 Also, just loading a file recursively is not always an error in
790 the general case; the second load may do something different. */
794 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
795 if (!NILP (Fequal (found
, XCAR (tem
))))
798 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
799 Fcons (found
, Vloads_in_progress
)));
800 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
801 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
804 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
806 /* Load .elc files directly, but not when they are
807 remote and have no handler! */
814 if (!safe_to_load_p (fd
))
817 if (!load_dangerous_libraries
)
821 error ("File `%s' was not compiled in Emacs",
824 else if (!NILP (nomessage
))
825 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
831 efound
= ENCODE_FILE (found
);
836 stat ((char *)SDATA (efound
), &s1
);
837 SSET (efound
, SBYTES (efound
) - 1, 0);
838 result
= stat ((char *)SDATA (efound
), &s2
);
839 SSET (efound
, SBYTES (efound
) - 1, 'c');
842 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
844 /* Make the progress messages mention that source is newer. */
847 /* If we won't print another message, mention this anyway. */
848 if (!NILP (nomessage
))
851 file
= Fsubstring (found
, make_number (0), make_number (-1));
852 message_with_string ("Source file `%s' newer than byte-compiled file",
860 /* We are loading a source file (*.el). */
861 if (!NILP (Vload_source_file_function
))
867 val
= call4 (Vload_source_file_function
, found
, file
,
868 NILP (noerror
) ? Qnil
: Qt
,
869 NILP (nomessage
) ? Qnil
: Qt
);
870 return unbind_to (count
, val
);
877 efound
= ENCODE_FILE (found
);
878 stream
= fopen ((char *) SDATA (efound
), fmode
);
880 #else /* not WINDOWSNT */
881 stream
= fdopen (fd
, fmode
);
882 #endif /* not WINDOWSNT */
886 error ("Failure to create stdio stream for %s", SDATA (file
));
889 if (! NILP (Vpurify_flag
))
890 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
892 if (NILP (nomessage
))
895 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
898 message_with_string ("Loading %s (source)...", file
, 1);
900 message_with_string ("Loading %s (compiled; note, source file is newer)...",
902 else /* The typical case; compiled file newer than source file. */
903 message_with_string ("Loading %s...", file
, 1);
907 lispstream
= Fcons (Qnil
, Qnil
);
908 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
909 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
910 record_unwind_protect (load_unwind
, lispstream
);
911 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
912 specbind (Qload_file_name
, found
);
913 specbind (Qinhibit_file_name_operation
, Qnil
);
915 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
917 readevalloop (Qget_file_char
, stream
, file
, Feval
,
918 0, Qnil
, Qnil
, Qnil
, Qnil
);
919 unbind_to (count
, Qnil
);
921 /* Run any load-hooks for this file. */
922 temp
= Fassoc (file
, Vafter_load_alist
);
924 Fprogn (Fcdr (temp
));
927 if (saved_doc_string
)
928 free (saved_doc_string
);
929 saved_doc_string
= 0;
930 saved_doc_string_size
= 0;
932 if (prev_saved_doc_string
)
933 xfree (prev_saved_doc_string
);
934 prev_saved_doc_string
= 0;
935 prev_saved_doc_string_size
= 0;
937 if (!noninteractive
&& NILP (nomessage
))
940 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
943 message_with_string ("Loading %s (source)...done", file
, 1);
945 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
947 else /* The typical case; compiled file newer than source file. */
948 message_with_string ("Loading %s...done", file
, 1);
951 if (!NILP (Fequal (build_string ("obsolete"),
952 Ffile_name_nondirectory
953 (Fdirectory_file_name (Ffile_name_directory (found
))))))
954 message_with_string ("Package %s is obsolete", file
, 1);
960 load_unwind (stream
) /* used as unwind-protect function in load */
963 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
964 | XFASTINT (XCDR (stream
))));
965 if (--load_in_progress
< 0) load_in_progress
= 0;
970 load_descriptor_unwind (oldlist
)
973 load_descriptor_list
= oldlist
;
977 /* Close all descriptors in use for Floads.
978 This is used when starting a subprocess. */
985 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
986 emacs_close (XFASTINT (XCAR (tail
)));
991 complete_filename_p (pathname
)
992 Lisp_Object pathname
;
994 register const unsigned char *s
= SDATA (pathname
);
995 return (IS_DIRECTORY_SEP (s
[0])
996 || (SCHARS (pathname
) > 2
997 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1007 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1008 doc
: /* Search for FILENAME through PATH.
1009 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1010 file name when searching.
1011 If non-nil, PREDICATE is used instead of `file-readable-p'.
1012 PREDICATE can also be an integer to pass to the access(2) function,
1013 in which case file-name-handlers are ignored. */)
1014 (filename
, path
, suffixes
, predicate
)
1015 Lisp_Object filename
, path
, suffixes
, predicate
;
1018 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1019 if (NILP (predicate
) && fd
> 0)
1025 /* Search for a file whose name is STR, looking in directories
1026 in the Lisp list PATH, and trying suffixes from SUFFIX.
1027 On success, returns a file descriptor. On failure, returns -1.
1029 SUFFIXES is a list of strings containing possible suffixes.
1030 The empty suffix is automatically added iff the list is empty.
1032 PREDICATE non-nil means don't open the files,
1033 just look for one that satisfies the predicate. In this case,
1034 returns 1 on success. The predicate can be a lisp function or
1035 an integer to pass to `access' (in which case file-name-handlers
1038 If STOREPTR is nonzero, it points to a slot where the name of
1039 the file actually found should be stored as a Lisp string.
1040 nil is stored there on failure.
1042 If the file we find is remote, return -2
1043 but store the found remote file name in *STOREPTR. */
1046 openp (path
, str
, suffixes
, storeptr
, predicate
)
1047 Lisp_Object path
, str
;
1048 Lisp_Object suffixes
;
1049 Lisp_Object
*storeptr
;
1050 Lisp_Object predicate
;
1055 register char *fn
= buf
;
1058 Lisp_Object filename
;
1060 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1061 Lisp_Object string
, tail
, encoded_fn
;
1062 int max_suffix_len
= 0;
1066 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1068 CHECK_STRING_CAR (tail
);
1069 max_suffix_len
= max (max_suffix_len
,
1070 SBYTES (XCAR (tail
)));
1073 string
= filename
= Qnil
;
1074 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1079 if (complete_filename_p (str
))
1082 for (; CONSP (path
); path
= XCDR (path
))
1084 filename
= Fexpand_file_name (str
, XCAR (path
));
1085 if (!complete_filename_p (filename
))
1086 /* If there are non-absolute elts in PATH (eg ".") */
1087 /* Of course, this could conceivably lose if luser sets
1088 default-directory to be something non-absolute... */
1090 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1091 if (!complete_filename_p (filename
))
1092 /* Give up on this path element! */
1096 /* Calculate maximum size of any filename made from
1097 this path element/specified file name and any possible suffix. */
1098 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1099 if (fn_size
< want_size
)
1100 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1102 /* Loop over suffixes. */
1103 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1104 CONSP (tail
); tail
= XCDR (tail
))
1106 int lsuffix
= SBYTES (XCAR (tail
));
1107 Lisp_Object handler
;
1110 /* Concatenate path element/specified name with the suffix.
1111 If the directory starts with /:, remove that. */
1112 if (SCHARS (filename
) > 2
1113 && SREF (filename
, 0) == '/'
1114 && SREF (filename
, 1) == ':')
1116 strncpy (fn
, SDATA (filename
) + 2,
1117 SBYTES (filename
) - 2);
1118 fn
[SBYTES (filename
) - 2] = 0;
1122 strncpy (fn
, SDATA (filename
),
1124 fn
[SBYTES (filename
)] = 0;
1127 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1128 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1130 /* Check that the file exists and is not a directory. */
1131 /* We used to only check for handlers on non-absolute file names:
1135 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1136 It's not clear why that was the case and it breaks things like
1137 (load "/bar.el") where the file is actually "/bar.el.gz". */
1138 string
= build_string (fn
);
1139 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1140 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1142 if (NILP (predicate
))
1143 exists
= !NILP (Ffile_readable_p (string
));
1145 exists
= !NILP (call1 (predicate
, string
));
1146 if (exists
&& !NILP (Ffile_directory_p (string
)))
1151 /* We succeeded; return this descriptor and filename. */
1162 encoded_fn
= ENCODE_FILE (string
);
1163 pfn
= SDATA (encoded_fn
);
1164 exists
= (stat (pfn
, &st
) >= 0
1165 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1168 /* Check that we can access or open it. */
1169 if (NATNUMP (predicate
))
1170 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1172 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1176 /* We succeeded; return this descriptor and filename. */
1194 /* Merge the list we've accumulated of globals from the current input source
1195 into the load_history variable. The details depend on whether
1196 the source has an associated file name or not. */
1199 build_load_history (stream
, source
)
1203 register Lisp_Object tail
, prev
, newelt
;
1204 register Lisp_Object tem
, tem2
;
1205 register int foundit
, loading
;
1207 loading
= stream
|| !NARROWED
;
1209 tail
= Vload_history
;
1212 while (CONSP (tail
))
1216 /* Find the feature's previous assoc list... */
1217 if (!NILP (Fequal (source
, Fcar (tem
))))
1221 /* If we're loading, remove it. */
1225 Vload_history
= XCDR (tail
);
1227 Fsetcdr (prev
, XCDR (tail
));
1230 /* Otherwise, cons on new symbols that are not already members. */
1233 tem2
= Vcurrent_load_list
;
1235 while (CONSP (tem2
))
1237 newelt
= XCAR (tem2
);
1239 if (NILP (Fmember (newelt
, tem
)))
1240 Fsetcar (tail
, Fcons (XCAR (tem
),
1241 Fcons (newelt
, XCDR (tem
))));
1254 /* If we're loading, cons the new assoc onto the front of load-history,
1255 the most-recently-loaded position. Also do this if we didn't find
1256 an existing member for the current source. */
1257 if (loading
|| !foundit
)
1258 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1263 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1271 readevalloop_1 (old
)
1274 load_convert_to_unibyte
= ! NILP (old
);
1278 /* Signal an `end-of-file' error, if possible with file name
1282 end_of_file_error ()
1286 if (STRINGP (Vload_file_name
))
1287 data
= Fcons (Vload_file_name
, Qnil
);
1291 Fsignal (Qend_of_file
, data
);
1294 /* UNIBYTE specifies how to set load_convert_to_unibyte
1295 for this invocation.
1296 READFUN, if non-nil, is used instead of `read'.
1297 START, END is region in current buffer (from eval-region). */
1300 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1301 printflag
, unibyte
, readfun
, start
, end
)
1302 Lisp_Object readcharfun
;
1304 Lisp_Object sourcename
;
1305 Lisp_Object (*evalfun
) ();
1307 Lisp_Object unibyte
, readfun
;
1308 Lisp_Object start
, end
;
1311 register Lisp_Object val
;
1312 int count
= SPECPDL_INDEX ();
1313 struct gcpro gcpro1
;
1314 struct buffer
*b
= 0;
1315 int continue_reading_p
;
1317 if (BUFFERP (readcharfun
))
1318 b
= XBUFFER (readcharfun
);
1319 else if (MARKERP (readcharfun
))
1320 b
= XMARKER (readcharfun
)->buffer
;
1322 specbind (Qstandard_input
, readcharfun
);
1323 specbind (Qcurrent_load_list
, Qnil
);
1324 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1325 load_convert_to_unibyte
= !NILP (unibyte
);
1327 readchar_backlog
= -1;
1329 GCPRO1 (sourcename
);
1331 LOADHIST_ATTACH (sourcename
);
1333 continue_reading_p
= 1;
1334 while (continue_reading_p
)
1336 int count1
= SPECPDL_INDEX ();
1338 if (b
!= 0 && NILP (b
->name
))
1339 error ("Reading from killed buffer");
1343 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1344 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1346 Fnarrow_to_region (make_number (BEGV
), end
);
1354 while ((c
= READCHAR
) != '\n' && c
!= -1);
1359 unbind_to (count1
, Qnil
);
1363 /* Ignore whitespace here, so we can detect eof. */
1364 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1367 if (!NILP (Vpurify_flag
) && c
== '(')
1369 record_unwind_protect (unreadpure
, Qnil
);
1370 val
= read_list (-1, readcharfun
);
1375 read_objects
= Qnil
;
1376 if (!NILP (readfun
))
1378 val
= call1 (readfun
, readcharfun
);
1380 /* If READCHARFUN has set point to ZV, we should
1381 stop reading, even if the form read sets point
1382 to a different value when evaluated. */
1383 if (BUFFERP (readcharfun
))
1385 struct buffer
*b
= XBUFFER (readcharfun
);
1386 if (BUF_PT (b
) == BUF_ZV (b
))
1387 continue_reading_p
= 0;
1390 else if (! NILP (Vload_read_function
))
1391 val
= call1 (Vload_read_function
, readcharfun
);
1393 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1396 if (!NILP (start
) && continue_reading_p
)
1397 start
= Fpoint_marker ();
1398 unbind_to (count1
, Qnil
);
1400 val
= (*evalfun
) (val
);
1404 Vvalues
= Fcons (val
, Vvalues
);
1405 if (EQ (Vstandard_output
, Qt
))
1412 build_load_history (stream
, sourcename
);
1415 unbind_to (count
, Qnil
);
1418 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1419 doc
: /* Execute the current buffer as Lisp code.
1420 Programs can pass two arguments, BUFFER and PRINTFLAG.
1421 BUFFER is the buffer to evaluate (nil means use current buffer).
1422 PRINTFLAG controls printing of output:
1423 nil means discard it; anything else is stream for print.
1425 If the optional third argument FILENAME is non-nil,
1426 it specifies the file name to use for `load-history'.
1427 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1428 for this invocation.
1430 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1431 `print' and related functions should work normally even if PRINTFLAG is nil.
1433 This function preserves the position of point. */)
1434 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1435 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1437 int count
= SPECPDL_INDEX ();
1438 Lisp_Object tem
, buf
;
1441 buf
= Fcurrent_buffer ();
1443 buf
= Fget_buffer (buffer
);
1445 error ("No such buffer");
1447 if (NILP (printflag
) && NILP (do_allow_print
))
1452 if (NILP (filename
))
1453 filename
= XBUFFER (buf
)->filename
;
1455 specbind (Qstandard_output
, tem
);
1456 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1457 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1458 readevalloop (buf
, 0, filename
, Feval
,
1459 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1460 unbind_to (count
, Qnil
);
1465 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1466 doc
: /* Execute the region as Lisp code.
1467 When called from programs, expects two arguments,
1468 giving starting and ending indices in the current buffer
1469 of the text to be executed.
1470 Programs can pass third argument PRINTFLAG which controls output:
1471 nil means discard it; anything else is stream for printing it.
1472 Also the fourth argument READ-FUNCTION, if non-nil, is used
1473 instead of `read' to read each expression. It gets one argument
1474 which is the input stream for reading characters.
1476 This function does not move point. */)
1477 (start
, end
, printflag
, read_function
)
1478 Lisp_Object start
, end
, printflag
, read_function
;
1480 int count
= SPECPDL_INDEX ();
1481 Lisp_Object tem
, cbuf
;
1483 cbuf
= Fcurrent_buffer ();
1485 if (NILP (printflag
))
1489 specbind (Qstandard_output
, tem
);
1491 /* readevalloop calls functions which check the type of start and end. */
1492 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1493 !NILP (printflag
), Qnil
, read_function
,
1496 return unbind_to (count
, Qnil
);
1500 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1501 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1502 If STREAM is nil, use the value of `standard-input' (which see).
1503 STREAM or the value of `standard-input' may be:
1504 a buffer (read from point and advance it)
1505 a marker (read from where it points and advance it)
1506 a function (call it with no arguments for each character,
1507 call it with a char as argument to push a char back)
1508 a string (takes text from string, starting at the beginning)
1509 t (read text line using minibuffer and use it, or read from
1510 standard input in batch mode). */)
1515 stream
= Vstandard_input
;
1516 if (EQ (stream
, Qt
))
1517 stream
= Qread_char
;
1518 if (EQ (stream
, Qread_char
))
1519 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1521 return read_internal_start (stream
, Qnil
, Qnil
);
1524 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1525 doc
: /* Read one Lisp expression which is represented as text by STRING.
1526 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1527 START and END optionally delimit a substring of STRING from which to read;
1528 they default to 0 and (length STRING) respectively. */)
1529 (string
, start
, end
)
1530 Lisp_Object string
, start
, end
;
1533 CHECK_STRING (string
);
1534 /* read_internal_start sets read_from_string_index. */
1535 ret
= read_internal_start (string
, start
, end
);
1536 return Fcons (ret
, make_number (read_from_string_index
));
1539 /* Function to set up the global context we need in toplevel read
1542 read_internal_start (stream
, start
, end
)
1544 Lisp_Object start
; /* Only used when stream is a string. */
1545 Lisp_Object end
; /* Only used when stream is a string. */
1549 readchar_backlog
= -1;
1551 new_backquote_flag
= 0;
1552 read_objects
= Qnil
;
1553 if (EQ (Vread_with_symbol_positions
, Qt
)
1554 || EQ (Vread_with_symbol_positions
, stream
))
1555 Vread_symbol_positions_list
= Qnil
;
1557 if (STRINGP (stream
))
1559 int startval
, endval
;
1561 endval
= SCHARS (stream
);
1565 endval
= XINT (end
);
1566 if (endval
< 0 || endval
> SCHARS (stream
))
1567 args_out_of_range (stream
, end
);
1574 CHECK_NUMBER (start
);
1575 startval
= XINT (start
);
1576 if (startval
< 0 || startval
> endval
)
1577 args_out_of_range (stream
, start
);
1579 read_from_string_index
= startval
;
1580 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1581 read_from_string_limit
= endval
;
1584 retval
= read0 (stream
);
1585 if (EQ (Vread_with_symbol_positions
, Qt
)
1586 || EQ (Vread_with_symbol_positions
, stream
))
1587 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1591 /* Use this for recursive reads, in contexts where internal tokens
1596 Lisp_Object readcharfun
;
1598 register Lisp_Object val
;
1601 val
= read1 (readcharfun
, &c
, 0);
1603 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1610 static int read_buffer_size
;
1611 static char *read_buffer
;
1613 /* Read multibyte form and return it as a character. C is a first
1614 byte of multibyte form, and rest of them are read from
1618 read_multibyte (c
, readcharfun
)
1620 Lisp_Object readcharfun
;
1622 /* We need the actual character code of this multibyte
1624 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1632 while ((c
= READCHAR
) >= 0xA0
1633 && len
< MAX_MULTIBYTE_LENGTH
)
1639 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1640 return STRING_CHAR (str
, len
);
1641 /* The byte sequence is not valid as multibyte. Unread all bytes
1642 but the first one, and return the first byte. */
1648 /* Read a \-escape sequence, assuming we already read the `\'.
1649 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1650 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1651 Otherwise store 0 into *BYTEREP. */
1654 read_escape (readcharfun
, stringp
, byterep
)
1655 Lisp_Object readcharfun
;
1659 register int c
= READCHAR
;
1666 end_of_file_error ();
1696 error ("Invalid escape character syntax");
1699 c
= read_escape (readcharfun
, 0, byterep
);
1700 return c
| meta_modifier
;
1705 error ("Invalid escape character syntax");
1708 c
= read_escape (readcharfun
, 0, byterep
);
1709 return c
| shift_modifier
;
1714 error ("Invalid escape character syntax");
1717 c
= read_escape (readcharfun
, 0, byterep
);
1718 return c
| hyper_modifier
;
1723 error ("Invalid escape character syntax");
1726 c
= read_escape (readcharfun
, 0, byterep
);
1727 return c
| alt_modifier
;
1739 c
= read_escape (readcharfun
, 0, byterep
);
1740 return c
| super_modifier
;
1745 error ("Invalid escape character syntax");
1749 c
= read_escape (readcharfun
, 0, byterep
);
1750 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1751 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1752 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1753 return c
| ctrl_modifier
;
1754 /* ASCII control chars are made from letters (both cases),
1755 as well as the non-letters within 0100...0137. */
1756 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1757 return (c
& (037 | ~0177));
1758 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1759 return (c
& (037 | ~0177));
1761 return c
| ctrl_modifier
;
1771 /* An octal escape, as in ANSI C. */
1773 register int i
= c
- '0';
1774 register int count
= 0;
1777 if ((c
= READCHAR
) >= '0' && c
<= '7')
1794 /* A hex escape, as in ANSI C. */
1800 if (c
>= '0' && c
<= '9')
1805 else if ((c
>= 'a' && c
<= 'f')
1806 || (c
>= 'A' && c
<= 'F'))
1809 if (c
>= 'a' && c
<= 'f')
1826 if (BASE_LEADING_CODE_P (c
))
1827 c
= read_multibyte (c
, readcharfun
);
1833 /* Read an integer in radix RADIX using READCHARFUN to read
1834 characters. RADIX must be in the interval [2..36]; if it isn't, a
1835 read error is signaled . Value is the integer read. Signals an
1836 error if encountering invalid read syntax or if RADIX is out of
1840 read_integer (readcharfun
, radix
)
1841 Lisp_Object readcharfun
;
1844 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1845 EMACS_INT number
= 0;
1847 if (radix
< 2 || radix
> 36)
1851 number
= ndigits
= invalid_p
= 0;
1867 if (c
>= '0' && c
<= '9')
1869 else if (c
>= 'a' && c
<= 'z')
1870 digit
= c
- 'a' + 10;
1871 else if (c
>= 'A' && c
<= 'Z')
1872 digit
= c
- 'A' + 10;
1879 if (digit
< 0 || digit
>= radix
)
1882 number
= radix
* number
+ digit
;
1888 if (ndigits
== 0 || invalid_p
)
1891 sprintf (buf
, "integer, radix %d", radix
);
1892 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1895 return make_number (sign
* number
);
1899 /* Convert unibyte text in read_buffer to multibyte.
1901 Initially, *P is a pointer after the end of the unibyte text, and
1902 the pointer *END points after the end of read_buffer.
1904 If read_buffer doesn't have enough room to hold the result
1905 of the conversion, reallocate it and adjust *P and *END.
1907 At the end, make *P point after the result of the conversion, and
1908 return in *NCHARS the number of characters in the converted
1912 to_multibyte (p
, end
, nchars
)
1918 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1919 if (read_buffer_size
< 2 * nbytes
)
1921 int offset
= *p
- read_buffer
;
1922 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1923 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1924 *p
= read_buffer
+ offset
;
1925 *end
= read_buffer
+ read_buffer_size
;
1928 if (nbytes
!= *nchars
)
1929 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1930 *p
- read_buffer
, nchars
);
1932 *p
= read_buffer
+ nbytes
;
1936 /* If the next token is ')' or ']' or '.', we store that character
1937 in *PCH and the return value is not interesting. Else, we store
1938 zero in *PCH and we read and return one lisp object.
1940 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1943 read1 (readcharfun
, pch
, first_in_list
)
1944 register Lisp_Object readcharfun
;
1949 int uninterned_symbol
= 0;
1957 end_of_file_error ();
1962 return read_list (0, readcharfun
);
1965 return read_vector (readcharfun
, 0);
1982 tmp
= read_vector (readcharfun
, 0);
1983 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1984 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1985 error ("Invalid size char-table");
1986 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1987 XCHAR_TABLE (tmp
)->top
= Qt
;
1996 tmp
= read_vector (readcharfun
, 0);
1997 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1998 error ("Invalid size char-table");
1999 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2000 XCHAR_TABLE (tmp
)->top
= Qnil
;
2003 Fsignal (Qinvalid_read_syntax
,
2004 Fcons (make_string ("#^^", 3), Qnil
));
2006 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2011 length
= read1 (readcharfun
, pch
, first_in_list
);
2015 Lisp_Object tmp
, val
;
2017 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2018 / BOOL_VECTOR_BITS_PER_CHAR
);
2021 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2022 if (size_in_chars
!= SCHARS (tmp
)
2023 /* We used to print 1 char too many
2024 when the number of bits was a multiple of 8.
2025 Accept such input in case it came from an old version. */
2026 && ! (XFASTINT (length
)
2027 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2028 Fsignal (Qinvalid_read_syntax
,
2029 Fcons (make_string ("#&...", 5), Qnil
));
2031 val
= Fmake_bool_vector (length
, Qnil
);
2032 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2034 /* Clear the extraneous bits in the last byte. */
2035 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2036 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2037 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2040 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2045 /* Accept compiled functions at read-time so that we don't have to
2046 build them using function calls. */
2048 tmp
= read_vector (readcharfun
, 1);
2049 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2050 XVECTOR (tmp
)->contents
);
2055 struct gcpro gcpro1
;
2058 /* Read the string itself. */
2059 tmp
= read1 (readcharfun
, &ch
, 0);
2060 if (ch
!= 0 || !STRINGP (tmp
))
2061 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2063 /* Read the intervals and their properties. */
2066 Lisp_Object beg
, end
, plist
;
2068 beg
= read1 (readcharfun
, &ch
, 0);
2073 end
= read1 (readcharfun
, &ch
, 0);
2075 plist
= read1 (readcharfun
, &ch
, 0);
2077 Fsignal (Qinvalid_read_syntax
,
2078 Fcons (build_string ("invalid string property list"),
2080 Fset_text_properties (beg
, end
, plist
, tmp
);
2086 /* #@NUMBER is used to skip NUMBER following characters.
2087 That's used in .elc files to skip over doc strings
2088 and function definitions. */
2093 /* Read a decimal integer. */
2094 while ((c
= READCHAR
) >= 0
2095 && c
>= '0' && c
<= '9')
2103 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2105 /* If we are supposed to force doc strings into core right now,
2106 record the last string that we skipped,
2107 and record where in the file it comes from. */
2109 /* But first exchange saved_doc_string
2110 with prev_saved_doc_string, so we save two strings. */
2112 char *temp
= saved_doc_string
;
2113 int temp_size
= saved_doc_string_size
;
2114 file_offset temp_pos
= saved_doc_string_position
;
2115 int temp_len
= saved_doc_string_length
;
2117 saved_doc_string
= prev_saved_doc_string
;
2118 saved_doc_string_size
= prev_saved_doc_string_size
;
2119 saved_doc_string_position
= prev_saved_doc_string_position
;
2120 saved_doc_string_length
= prev_saved_doc_string_length
;
2122 prev_saved_doc_string
= temp
;
2123 prev_saved_doc_string_size
= temp_size
;
2124 prev_saved_doc_string_position
= temp_pos
;
2125 prev_saved_doc_string_length
= temp_len
;
2128 if (saved_doc_string_size
== 0)
2130 saved_doc_string_size
= nskip
+ 100;
2131 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2133 if (nskip
> saved_doc_string_size
)
2135 saved_doc_string_size
= nskip
+ 100;
2136 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2137 saved_doc_string_size
);
2140 saved_doc_string_position
= file_tell (instream
);
2142 /* Copy that many characters into saved_doc_string. */
2143 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2144 saved_doc_string
[i
] = c
= READCHAR
;
2146 saved_doc_string_length
= i
;
2150 /* Skip that many characters. */
2151 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2159 /* #! appears at the beginning of an executable file.
2160 Skip the first line. */
2161 while (c
!= '\n' && c
>= 0)
2166 return Vload_file_name
;
2168 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2169 /* #:foo is the uninterned symbol named foo. */
2172 uninterned_symbol
= 1;
2176 /* Reader forms that can reuse previously read objects. */
2177 if (c
>= '0' && c
<= '9')
2182 /* Read a non-negative integer. */
2183 while (c
>= '0' && c
<= '9')
2189 /* #n=object returns object, but associates it with n for #n#. */
2192 /* Make a placeholder for #n# to use temporarily */
2193 Lisp_Object placeholder
;
2196 placeholder
= Fcons(Qnil
, Qnil
);
2197 cell
= Fcons (make_number (n
), placeholder
);
2198 read_objects
= Fcons (cell
, read_objects
);
2200 /* Read the object itself. */
2201 tem
= read0 (readcharfun
);
2203 /* Now put it everywhere the placeholder was... */
2204 substitute_object_in_subtree (tem
, placeholder
);
2206 /* ...and #n# will use the real value from now on. */
2207 Fsetcdr (cell
, tem
);
2211 /* #n# returns a previously read object. */
2214 tem
= Fassq (make_number (n
), read_objects
);
2217 /* Fall through to error message. */
2219 else if (c
== 'r' || c
== 'R')
2220 return read_integer (readcharfun
, n
);
2222 /* Fall through to error message. */
2224 else if (c
== 'x' || c
== 'X')
2225 return read_integer (readcharfun
, 16);
2226 else if (c
== 'o' || c
== 'O')
2227 return read_integer (readcharfun
, 8);
2228 else if (c
== 'b' || c
== 'B')
2229 return read_integer (readcharfun
, 2);
2232 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2235 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2240 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2250 new_backquote_flag
++;
2251 value
= read0 (readcharfun
);
2252 new_backquote_flag
--;
2254 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2258 if (new_backquote_flag
)
2260 Lisp_Object comma_type
= Qnil
;
2265 comma_type
= Qcomma_at
;
2267 comma_type
= Qcomma_dot
;
2270 if (ch
>= 0) UNREAD (ch
);
2271 comma_type
= Qcomma
;
2274 new_backquote_flag
--;
2275 value
= read0 (readcharfun
);
2276 new_backquote_flag
++;
2277 return Fcons (comma_type
, Fcons (value
, Qnil
));
2290 end_of_file_error ();
2292 /* Accept `single space' syntax like (list ? x) where the
2293 whitespace character is SPC or TAB.
2294 Other literal whitespace like NL, CR, and FF are not accepted,
2295 as there are well-established escape sequences for these. */
2296 if (c
== ' ' || c
== '\t')
2297 return make_number (c
);
2300 c
= read_escape (readcharfun
, 0, &discard
);
2301 else if (BASE_LEADING_CODE_P (c
))
2302 c
= read_multibyte (c
, readcharfun
);
2304 next_char
= READCHAR
;
2305 if (next_char
== '.')
2307 /* Only a dotted-pair dot is valid after a char constant. */
2308 int next_next_char
= READCHAR
;
2309 UNREAD (next_next_char
);
2311 ok
= (next_next_char
<= 040
2312 || (next_next_char
< 0200
2313 && (index ("\"';([#?", next_next_char
)
2314 || (!first_in_list
&& next_next_char
== '`')
2315 || (new_backquote_flag
&& next_next_char
== ','))));
2319 ok
= (next_char
<= 040
2320 || (next_char
< 0200
2321 && (index ("\"';()[]#?", next_char
)
2322 || (!first_in_list
&& next_char
== '`')
2323 || (new_backquote_flag
&& next_char
== ','))));
2327 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2329 return make_number (c
);
2334 char *p
= read_buffer
;
2335 char *end
= read_buffer
+ read_buffer_size
;
2337 /* 1 if we saw an escape sequence specifying
2338 a multibyte character, or a multibyte character. */
2339 int force_multibyte
= 0;
2340 /* 1 if we saw an escape sequence specifying
2341 a single-byte character. */
2342 int force_singlebyte
= 0;
2343 /* 1 if read_buffer contains multibyte text now. */
2344 int is_multibyte
= 0;
2348 while ((c
= READCHAR
) >= 0
2351 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2353 int offset
= p
- read_buffer
;
2354 read_buffer
= (char *) xrealloc (read_buffer
,
2355 read_buffer_size
*= 2);
2356 p
= read_buffer
+ offset
;
2357 end
= read_buffer
+ read_buffer_size
;
2364 c
= read_escape (readcharfun
, 1, &byterep
);
2366 /* C is -1 if \ newline has just been seen */
2369 if (p
== read_buffer
)
2375 force_singlebyte
= 1;
2376 else if (byterep
== 2)
2377 force_multibyte
= 1;
2380 /* A character that must be multibyte forces multibyte. */
2381 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2382 force_multibyte
= 1;
2384 /* If we just discovered the need to be multibyte,
2385 convert the text accumulated thus far. */
2386 if (force_multibyte
&& ! is_multibyte
)
2389 to_multibyte (&p
, &end
, &nchars
);
2392 /* Allow `\C- ' and `\C-?'. */
2393 if (c
== (CHAR_CTL
| ' '))
2395 else if (c
== (CHAR_CTL
| '?'))
2400 /* Shift modifier is valid only with [A-Za-z]. */
2401 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2403 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2404 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2408 /* Move the meta bit to the right place for a string. */
2409 c
= (c
& ~CHAR_META
) | 0x80;
2410 if (c
& CHAR_MODIFIER_MASK
)
2411 error ("Invalid modifier in string");
2414 p
+= CHAR_STRING (c
, p
);
2422 end_of_file_error ();
2424 /* If purifying, and string starts with \ newline,
2425 return zero instead. This is for doc strings
2426 that we are really going to find in etc/DOC.nn.nn */
2427 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2428 return make_number (0);
2430 if (is_multibyte
|| force_singlebyte
)
2432 else if (load_convert_to_unibyte
)
2435 to_multibyte (&p
, &end
, &nchars
);
2436 if (p
- read_buffer
!= nchars
)
2438 string
= make_multibyte_string (read_buffer
, nchars
,
2440 return Fstring_make_unibyte (string
);
2442 /* We can make a unibyte string directly. */
2445 else if (EQ (readcharfun
, Qget_file_char
)
2446 || EQ (readcharfun
, Qlambda
))
2448 /* Nowadays, reading directly from a file is used only for
2449 compiled Emacs Lisp files, and those always use the
2450 Emacs internal encoding. Meanwhile, Qlambda is used
2451 for reading dynamic byte code (compiled with
2452 byte-compile-dynamic = t). So make the string multibyte
2453 if the string contains any multibyte sequences.
2454 (to_multibyte is a no-op if not.) */
2455 to_multibyte (&p
, &end
, &nchars
);
2456 is_multibyte
= (p
- read_buffer
) != nchars
;
2459 /* In all other cases, if we read these bytes as
2460 separate characters, treat them as separate characters now. */
2463 /* We want readchar_count to be the number of characters, not
2464 bytes. Hence we adjust for multibyte characters in the
2465 string. ... But it doesn't seem to be necessary, because
2466 READCHAR *does* read multibyte characters from buffers. */
2467 /* readchar_count -= (p - read_buffer) - nchars; */
2469 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2471 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2477 int next_char
= READCHAR
;
2480 if (next_char
<= 040
2481 || (next_char
< 0200
2482 && (index ("\"';([#?", next_char
)
2483 || (!first_in_list
&& next_char
== '`')
2484 || (new_backquote_flag
&& next_char
== ','))))
2490 /* Otherwise, we fall through! Note that the atom-reading loop
2491 below will now loop at least once, assuring that we will not
2492 try to UNREAD two characters in a row. */
2496 if (c
<= 040) goto retry
;
2498 char *p
= read_buffer
;
2502 char *end
= read_buffer
+ read_buffer_size
;
2506 || (!index ("\"';()[]#", c
)
2507 && !(!first_in_list
&& c
== '`')
2508 && !(new_backquote_flag
&& c
== ','))))
2510 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2512 int offset
= p
- read_buffer
;
2513 read_buffer
= (char *) xrealloc (read_buffer
,
2514 read_buffer_size
*= 2);
2515 p
= read_buffer
+ offset
;
2516 end
= read_buffer
+ read_buffer_size
;
2523 end_of_file_error ();
2527 if (! SINGLE_BYTE_CHAR_P (c
))
2528 p
+= CHAR_STRING (c
, p
);
2537 int offset
= p
- read_buffer
;
2538 read_buffer
= (char *) xrealloc (read_buffer
,
2539 read_buffer_size
*= 2);
2540 p
= read_buffer
+ offset
;
2541 end
= read_buffer
+ read_buffer_size
;
2548 if (!quoted
&& !uninterned_symbol
)
2551 register Lisp_Object val
;
2553 if (*p1
== '+' || *p1
== '-') p1
++;
2554 /* Is it an integer? */
2557 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2558 /* Integers can have trailing decimal points. */
2559 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2561 /* It is an integer. */
2565 if (sizeof (int) == sizeof (EMACS_INT
))
2566 XSETINT (val
, atoi (read_buffer
));
2567 else if (sizeof (long) == sizeof (EMACS_INT
))
2568 XSETINT (val
, atol (read_buffer
));
2574 if (isfloat_string (read_buffer
))
2576 /* Compute NaN and infinities using 0.0 in a variable,
2577 to cope with compilers that think they are smarter
2583 /* Negate the value ourselves. This treats 0, NaNs,
2584 and infinity properly on IEEE floating point hosts,
2585 and works around a common bug where atof ("-0.0")
2587 int negative
= read_buffer
[0] == '-';
2589 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2590 returns 1, is if the input ends in e+INF or e+NaN. */
2597 value
= zero
/ zero
;
2600 value
= atof (read_buffer
+ negative
);
2604 return make_float (negative
? - value
: value
);
2608 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2609 : intern (read_buffer
);
2610 if (EQ (Vread_with_symbol_positions
, Qt
)
2611 || EQ (Vread_with_symbol_positions
, readcharfun
))
2612 Vread_symbol_positions_list
=
2613 /* Kind of a hack; this will probably fail if characters
2614 in the symbol name were escaped. Not really a big
2616 Fcons (Fcons (result
,
2617 make_number (readchar_count
2618 - XFASTINT (Flength (Fsymbol_name (result
))))),
2619 Vread_symbol_positions_list
);
2627 /* List of nodes we've seen during substitute_object_in_subtree. */
2628 static Lisp_Object seen_list
;
2631 substitute_object_in_subtree (object
, placeholder
)
2633 Lisp_Object placeholder
;
2635 Lisp_Object check_object
;
2637 /* We haven't seen any objects when we start. */
2640 /* Make all the substitutions. */
2642 = substitute_object_recurse (object
, placeholder
, object
);
2644 /* Clear seen_list because we're done with it. */
2647 /* The returned object here is expected to always eq the
2649 if (!EQ (check_object
, object
))
2650 error ("Unexpected mutation error in reader");
2653 /* Feval doesn't get called from here, so no gc protection is needed. */
2654 #define SUBSTITUTE(get_val, set_val) \
2656 Lisp_Object old_value = get_val; \
2657 Lisp_Object true_value \
2658 = substitute_object_recurse (object, placeholder,\
2661 if (!EQ (old_value, true_value)) \
2668 substitute_object_recurse (object
, placeholder
, subtree
)
2670 Lisp_Object placeholder
;
2671 Lisp_Object subtree
;
2673 /* If we find the placeholder, return the target object. */
2674 if (EQ (placeholder
, subtree
))
2677 /* If we've been to this node before, don't explore it again. */
2678 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2681 /* If this node can be the entry point to a cycle, remember that
2682 we've seen it. It can only be such an entry point if it was made
2683 by #n=, which means that we can find it as a value in
2685 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2686 seen_list
= Fcons (subtree
, seen_list
);
2688 /* Recurse according to subtree's type.
2689 Every branch must return a Lisp_Object. */
2690 switch (XTYPE (subtree
))
2692 case Lisp_Vectorlike
:
2695 int length
= XINT (Flength(subtree
));
2696 for (i
= 0; i
< length
; i
++)
2698 Lisp_Object idx
= make_number (i
);
2699 SUBSTITUTE (Faref (subtree
, idx
),
2700 Faset (subtree
, idx
, true_value
));
2707 SUBSTITUTE (Fcar_safe (subtree
),
2708 Fsetcar (subtree
, true_value
));
2709 SUBSTITUTE (Fcdr_safe (subtree
),
2710 Fsetcdr (subtree
, true_value
));
2716 /* Check for text properties in each interval.
2717 substitute_in_interval contains part of the logic. */
2719 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2720 Lisp_Object arg
= Fcons (object
, placeholder
);
2722 traverse_intervals_noorder (root_interval
,
2723 &substitute_in_interval
, arg
);
2728 /* Other types don't recurse any further. */
2734 /* Helper function for substitute_object_recurse. */
2736 substitute_in_interval (interval
, arg
)
2740 Lisp_Object object
= Fcar (arg
);
2741 Lisp_Object placeholder
= Fcdr (arg
);
2743 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2762 if (*cp
== '+' || *cp
== '-')
2765 if (*cp
>= '0' && *cp
<= '9')
2768 while (*cp
>= '0' && *cp
<= '9')
2776 if (*cp
>= '0' && *cp
<= '9')
2779 while (*cp
>= '0' && *cp
<= '9')
2782 if (*cp
== 'e' || *cp
== 'E')
2786 if (*cp
== '+' || *cp
== '-')
2790 if (*cp
>= '0' && *cp
<= '9')
2793 while (*cp
>= '0' && *cp
<= '9')
2796 else if (cp
== start
)
2798 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2803 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2809 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2810 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2811 || state
== (DOT_CHAR
|TRAIL_INT
)
2812 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2813 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2814 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2819 read_vector (readcharfun
, bytecodeflag
)
2820 Lisp_Object readcharfun
;
2825 register Lisp_Object
*ptr
;
2826 register Lisp_Object tem
, item
, vector
;
2827 register struct Lisp_Cons
*otem
;
2830 tem
= read_list (1, readcharfun
);
2831 len
= Flength (tem
);
2832 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2834 size
= XVECTOR (vector
)->size
;
2835 ptr
= XVECTOR (vector
)->contents
;
2836 for (i
= 0; i
< size
; i
++)
2839 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2840 bytecode object, the docstring containing the bytecode and
2841 constants values must be treated as unibyte and passed to
2842 Fread, to get the actual bytecode string and constants vector. */
2843 if (bytecodeflag
&& load_force_doc_strings
)
2845 if (i
== COMPILED_BYTECODE
)
2847 if (!STRINGP (item
))
2848 error ("invalid byte code");
2850 /* Delay handling the bytecode slot until we know whether
2851 it is lazily-loaded (we can tell by whether the
2852 constants slot is nil). */
2853 ptr
[COMPILED_CONSTANTS
] = item
;
2856 else if (i
== COMPILED_CONSTANTS
)
2858 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2862 /* Coerce string to unibyte (like string-as-unibyte,
2863 but without generating extra garbage and
2864 guaranteeing no change in the contents). */
2865 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2866 STRING_SET_UNIBYTE (bytestr
);
2868 item
= Fread (bytestr
);
2870 error ("invalid byte code");
2872 otem
= XCONS (item
);
2873 bytestr
= XCAR (item
);
2878 /* Now handle the bytecode slot. */
2879 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2882 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2890 /* FLAG = 1 means check for ] to terminate rather than ) and .
2891 FLAG = -1 means check for starting with defun
2892 and make structure pure. */
2895 read_list (flag
, readcharfun
)
2897 register Lisp_Object readcharfun
;
2899 /* -1 means check next element for defun,
2900 0 means don't check,
2901 1 means already checked and found defun. */
2902 int defunflag
= flag
< 0 ? -1 : 0;
2903 Lisp_Object val
, tail
;
2904 register Lisp_Object elt
, tem
;
2905 struct gcpro gcpro1
, gcpro2
;
2906 /* 0 is the normal case.
2907 1 means this list is a doc reference; replace it with the number 0.
2908 2 means this list is a doc reference; replace it with the doc string. */
2909 int doc_reference
= 0;
2911 /* Initialize this to 1 if we are reading a list. */
2912 int first_in_list
= flag
<= 0;
2921 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2926 /* While building, if the list starts with #$, treat it specially. */
2927 if (EQ (elt
, Vload_file_name
)
2929 && !NILP (Vpurify_flag
))
2931 if (NILP (Vdoc_file_name
))
2932 /* We have not yet called Snarf-documentation, so assume
2933 this file is described in the DOC-MM.NN file
2934 and Snarf-documentation will fill in the right value later.
2935 For now, replace the whole list with 0. */
2938 /* We have already called Snarf-documentation, so make a relative
2939 file name for this file, so it can be found properly
2940 in the installed Lisp directory.
2941 We don't use Fexpand_file_name because that would make
2942 the directory absolute now. */
2943 elt
= concat2 (build_string ("../lisp/"),
2944 Ffile_name_nondirectory (elt
));
2946 else if (EQ (elt
, Vload_file_name
)
2948 && load_force_doc_strings
)
2957 Fsignal (Qinvalid_read_syntax
,
2958 Fcons (make_string (") or . in a vector", 18), Qnil
));
2966 XSETCDR (tail
, read0 (readcharfun
));
2968 val
= read0 (readcharfun
);
2969 read1 (readcharfun
, &ch
, 0);
2973 if (doc_reference
== 1)
2974 return make_number (0);
2975 if (doc_reference
== 2)
2977 /* Get a doc string from the file we are loading.
2978 If it's in saved_doc_string, get it from there. */
2979 int pos
= XINT (XCDR (val
));
2980 /* Position is negative for user variables. */
2981 if (pos
< 0) pos
= -pos
;
2982 if (pos
>= saved_doc_string_position
2983 && pos
< (saved_doc_string_position
2984 + saved_doc_string_length
))
2986 int start
= pos
- saved_doc_string_position
;
2989 /* Process quoting with ^A,
2990 and find the end of the string,
2991 which is marked with ^_ (037). */
2992 for (from
= start
, to
= start
;
2993 saved_doc_string
[from
] != 037;)
2995 int c
= saved_doc_string
[from
++];
2998 c
= saved_doc_string
[from
++];
3000 saved_doc_string
[to
++] = c
;
3002 saved_doc_string
[to
++] = 0;
3004 saved_doc_string
[to
++] = 037;
3007 saved_doc_string
[to
++] = c
;
3010 return make_string (saved_doc_string
+ start
,
3013 /* Look in prev_saved_doc_string the same way. */
3014 else if (pos
>= prev_saved_doc_string_position
3015 && pos
< (prev_saved_doc_string_position
3016 + prev_saved_doc_string_length
))
3018 int start
= pos
- prev_saved_doc_string_position
;
3021 /* Process quoting with ^A,
3022 and find the end of the string,
3023 which is marked with ^_ (037). */
3024 for (from
= start
, to
= start
;
3025 prev_saved_doc_string
[from
] != 037;)
3027 int c
= prev_saved_doc_string
[from
++];
3030 c
= prev_saved_doc_string
[from
++];
3032 prev_saved_doc_string
[to
++] = c
;
3034 prev_saved_doc_string
[to
++] = 0;
3036 prev_saved_doc_string
[to
++] = 037;
3039 prev_saved_doc_string
[to
++] = c
;
3042 return make_string (prev_saved_doc_string
+ start
,
3046 return get_doc_string (val
, 0, 0);
3051 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3053 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3055 tem
= (read_pure
&& flag
<= 0
3056 ? pure_cons (elt
, Qnil
)
3057 : Fcons (elt
, Qnil
));
3059 XSETCDR (tail
, tem
);
3064 defunflag
= EQ (elt
, Qdefun
);
3065 else if (defunflag
> 0)
3070 Lisp_Object Vobarray
;
3071 Lisp_Object initial_obarray
;
3073 /* oblookup stores the bucket number here, for the sake of Funintern. */
3075 int oblookup_last_bucket_number
;
3077 static int hash_string ();
3079 /* Get an error if OBARRAY is not an obarray.
3080 If it is one, return it. */
3083 check_obarray (obarray
)
3084 Lisp_Object obarray
;
3086 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3088 /* If Vobarray is now invalid, force it to be valid. */
3089 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3091 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3096 /* Intern the C string STR: return a symbol with that name,
3097 interned in the current obarray. */
3104 int len
= strlen (str
);
3105 Lisp_Object obarray
;
3108 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3109 obarray
= check_obarray (obarray
);
3110 tem
= oblookup (obarray
, str
, len
, len
);
3113 return Fintern (make_string (str
, len
), obarray
);
3116 /* Create an uninterned symbol with name STR. */
3122 int len
= strlen (str
);
3124 return Fmake_symbol ((!NILP (Vpurify_flag
)
3125 ? make_pure_string (str
, len
, len
, 0)
3126 : make_string (str
, len
)));
3129 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3130 doc
: /* Return the canonical symbol whose name is STRING.
3131 If there is none, one is created by this function and returned.
3132 A second optional argument specifies the obarray to use;
3133 it defaults to the value of `obarray'. */)
3135 Lisp_Object string
, obarray
;
3137 register Lisp_Object tem
, sym
, *ptr
;
3139 if (NILP (obarray
)) obarray
= Vobarray
;
3140 obarray
= check_obarray (obarray
);
3142 CHECK_STRING (string
);
3144 tem
= oblookup (obarray
, SDATA (string
),
3147 if (!INTEGERP (tem
))
3150 if (!NILP (Vpurify_flag
))
3151 string
= Fpurecopy (string
);
3152 sym
= Fmake_symbol (string
);
3154 if (EQ (obarray
, initial_obarray
))
3155 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3157 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3159 if ((SREF (string
, 0) == ':')
3160 && EQ (obarray
, initial_obarray
))
3162 XSYMBOL (sym
)->constant
= 1;
3163 XSYMBOL (sym
)->value
= sym
;
3166 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3168 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3170 XSYMBOL (sym
)->next
= 0;
3175 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3176 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3177 NAME may be a string or a symbol. If it is a symbol, that exact
3178 symbol is searched for.
3179 A second optional argument specifies the obarray to use;
3180 it defaults to the value of `obarray'. */)
3182 Lisp_Object name
, obarray
;
3184 register Lisp_Object tem
, string
;
3186 if (NILP (obarray
)) obarray
= Vobarray
;
3187 obarray
= check_obarray (obarray
);
3189 if (!SYMBOLP (name
))
3191 CHECK_STRING (name
);
3195 string
= SYMBOL_NAME (name
);
3197 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3198 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3204 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3205 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3206 The value is t if a symbol was found and deleted, nil otherwise.
3207 NAME may be a string or a symbol. If it is a symbol, that symbol
3208 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3209 OBARRAY defaults to the value of the variable `obarray'. */)
3211 Lisp_Object name
, obarray
;
3213 register Lisp_Object string
, tem
;
3216 if (NILP (obarray
)) obarray
= Vobarray
;
3217 obarray
= check_obarray (obarray
);
3220 string
= SYMBOL_NAME (name
);
3223 CHECK_STRING (name
);
3227 tem
= oblookup (obarray
, SDATA (string
),
3232 /* If arg was a symbol, don't delete anything but that symbol itself. */
3233 if (SYMBOLP (name
) && !EQ (name
, tem
))
3236 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3237 XSYMBOL (tem
)->constant
= 0;
3238 XSYMBOL (tem
)->indirect_variable
= 0;
3240 hash
= oblookup_last_bucket_number
;
3242 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3244 if (XSYMBOL (tem
)->next
)
3245 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3247 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3251 Lisp_Object tail
, following
;
3253 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3254 XSYMBOL (tail
)->next
;
3257 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3258 if (EQ (following
, tem
))
3260 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3269 /* Return the symbol in OBARRAY whose names matches the string
3270 of SIZE characters (SIZE_BYTE bytes) at PTR.
3271 If there is no such symbol in OBARRAY, return nil.
3273 Also store the bucket number in oblookup_last_bucket_number. */
3276 oblookup (obarray
, ptr
, size
, size_byte
)
3277 Lisp_Object obarray
;
3278 register const char *ptr
;
3279 int size
, size_byte
;
3283 register Lisp_Object tail
;
3284 Lisp_Object bucket
, tem
;
3286 if (!VECTORP (obarray
)
3287 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3289 obarray
= check_obarray (obarray
);
3290 obsize
= XVECTOR (obarray
)->size
;
3292 /* This is sometimes needed in the middle of GC. */
3293 obsize
&= ~ARRAY_MARK_FLAG
;
3294 /* Combining next two lines breaks VMS C 2.3. */
3295 hash
= hash_string (ptr
, size_byte
);
3297 bucket
= XVECTOR (obarray
)->contents
[hash
];
3298 oblookup_last_bucket_number
= hash
;
3299 if (EQ (bucket
, make_number (0)))
3301 else if (!SYMBOLP (bucket
))
3302 error ("Bad data in guts of obarray"); /* Like CADR error message */
3304 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3306 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3307 && SCHARS (SYMBOL_NAME (tail
)) == size
3308 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3310 else if (XSYMBOL (tail
)->next
== 0)
3313 XSETINT (tem
, hash
);
3318 hash_string (ptr
, len
)
3319 const unsigned char *ptr
;
3322 register const unsigned char *p
= ptr
;
3323 register const unsigned char *end
= p
+ len
;
3324 register unsigned char c
;
3325 register int hash
= 0;
3330 if (c
>= 0140) c
-= 40;
3331 hash
= ((hash
<<3) + (hash
>>28) + c
);
3333 return hash
& 07777777777;
3337 map_obarray (obarray
, fn
, arg
)
3338 Lisp_Object obarray
;
3339 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3343 register Lisp_Object tail
;
3344 CHECK_VECTOR (obarray
);
3345 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3347 tail
= XVECTOR (obarray
)->contents
[i
];
3352 if (XSYMBOL (tail
)->next
== 0)
3354 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3360 mapatoms_1 (sym
, function
)
3361 Lisp_Object sym
, function
;
3363 call1 (function
, sym
);
3366 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3367 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3368 OBARRAY defaults to the value of `obarray'. */)
3370 Lisp_Object function
, obarray
;
3372 if (NILP (obarray
)) obarray
= Vobarray
;
3373 obarray
= check_obarray (obarray
);
3375 map_obarray (obarray
, mapatoms_1
, function
);
3379 #define OBARRAY_SIZE 1511
3384 Lisp_Object oblength
;
3388 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3390 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3391 Vobarray
= Fmake_vector (oblength
, make_number (0));
3392 initial_obarray
= Vobarray
;
3393 staticpro (&initial_obarray
);
3394 /* Intern nil in the obarray */
3395 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3396 XSYMBOL (Qnil
)->constant
= 1;
3398 /* These locals are to kludge around a pyramid compiler bug. */
3399 hash
= hash_string ("nil", 3);
3400 /* Separate statement here to avoid VAXC bug. */
3401 hash
%= OBARRAY_SIZE
;
3402 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3405 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3406 XSYMBOL (Qnil
)->function
= Qunbound
;
3407 XSYMBOL (Qunbound
)->value
= Qunbound
;
3408 XSYMBOL (Qunbound
)->function
= Qunbound
;
3411 XSYMBOL (Qnil
)->value
= Qnil
;
3412 XSYMBOL (Qnil
)->plist
= Qnil
;
3413 XSYMBOL (Qt
)->value
= Qt
;
3414 XSYMBOL (Qt
)->constant
= 1;
3416 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3419 Qvariable_documentation
= intern ("variable-documentation");
3420 staticpro (&Qvariable_documentation
);
3422 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3423 read_buffer
= (char *) xmalloc (read_buffer_size
);
3428 struct Lisp_Subr
*sname
;
3431 sym
= intern (sname
->symbol_name
);
3432 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3435 #ifdef NOTDEF /* use fset in subr.el now */
3437 defalias (sname
, string
)
3438 struct Lisp_Subr
*sname
;
3442 sym
= intern (string
);
3443 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3447 /* Define an "integer variable"; a symbol whose value is forwarded
3448 to a C variable of type int. Sample call: */
3449 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3451 defvar_int (namestring
, address
)
3455 Lisp_Object sym
, val
;
3456 sym
= intern (namestring
);
3457 val
= allocate_misc ();
3458 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3459 XINTFWD (val
)->intvar
= address
;
3460 SET_SYMBOL_VALUE (sym
, val
);
3463 /* Similar but define a variable whose value is t if address contains 1,
3464 nil if address contains 0 */
3466 defvar_bool (namestring
, address
)
3470 Lisp_Object sym
, val
;
3471 sym
= intern (namestring
);
3472 val
= allocate_misc ();
3473 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3474 XBOOLFWD (val
)->boolvar
= address
;
3475 SET_SYMBOL_VALUE (sym
, val
);
3476 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3479 /* Similar but define a variable whose value is the Lisp Object stored
3480 at address. Two versions: with and without gc-marking of the C
3481 variable. The nopro version is used when that variable will be
3482 gc-marked for some other reason, since marking the same slot twice
3483 can cause trouble with strings. */
3485 defvar_lisp_nopro (namestring
, address
)
3487 Lisp_Object
*address
;
3489 Lisp_Object sym
, val
;
3490 sym
= intern (namestring
);
3491 val
= allocate_misc ();
3492 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3493 XOBJFWD (val
)->objvar
= address
;
3494 SET_SYMBOL_VALUE (sym
, val
);
3498 defvar_lisp (namestring
, address
)
3500 Lisp_Object
*address
;
3502 defvar_lisp_nopro (namestring
, address
);
3503 staticpro (address
);
3506 /* Similar but define a variable whose value is the Lisp Object stored in
3507 the current buffer. address is the address of the slot in the buffer
3508 that is current now. */
3511 defvar_per_buffer (namestring
, address
, type
, doc
)
3513 Lisp_Object
*address
;
3517 Lisp_Object sym
, val
;
3520 sym
= intern (namestring
);
3521 val
= allocate_misc ();
3522 offset
= (char *)address
- (char *)current_buffer
;
3524 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3525 XBUFFER_OBJFWD (val
)->offset
= offset
;
3526 SET_SYMBOL_VALUE (sym
, val
);
3527 PER_BUFFER_SYMBOL (offset
) = sym
;
3528 PER_BUFFER_TYPE (offset
) = type
;
3530 if (PER_BUFFER_IDX (offset
) == 0)
3531 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3532 slot of buffer_local_flags */
3537 /* Similar but define a variable whose value is the Lisp Object stored
3538 at a particular offset in the current kboard object. */
3541 defvar_kboard (namestring
, offset
)
3545 Lisp_Object sym
, val
;
3546 sym
= intern (namestring
);
3547 val
= allocate_misc ();
3548 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3549 XKBOARD_OBJFWD (val
)->offset
= offset
;
3550 SET_SYMBOL_VALUE (sym
, val
);
3553 /* Record the value of load-path used at the start of dumping
3554 so we can see if the site changed it later during dumping. */
3555 static Lisp_Object dump_path
;
3561 int turn_off_warning
= 0;
3563 /* Compute the default load-path. */
3565 normal
= PATH_LOADSEARCH
;
3566 Vload_path
= decode_env_path (0, normal
);
3568 if (NILP (Vpurify_flag
))
3569 normal
= PATH_LOADSEARCH
;
3571 normal
= PATH_DUMPLOADSEARCH
;
3573 /* In a dumped Emacs, we normally have to reset the value of
3574 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3575 uses ../lisp, instead of the path of the installed elisp
3576 libraries. However, if it appears that Vload_path was changed
3577 from the default before dumping, don't override that value. */
3580 if (! NILP (Fequal (dump_path
, Vload_path
)))
3582 Vload_path
= decode_env_path (0, normal
);
3583 if (!NILP (Vinstallation_directory
))
3585 Lisp_Object tem
, tem1
, sitelisp
;
3587 /* Remove site-lisp dirs from path temporarily and store
3588 them in sitelisp, then conc them on at the end so
3589 they're always first in path. */
3593 tem
= Fcar (Vload_path
);
3594 tem1
= Fstring_match (build_string ("site-lisp"),
3598 Vload_path
= Fcdr (Vload_path
);
3599 sitelisp
= Fcons (tem
, sitelisp
);
3605 /* Add to the path the lisp subdir of the
3606 installation dir, if it exists. */
3607 tem
= Fexpand_file_name (build_string ("lisp"),
3608 Vinstallation_directory
);
3609 tem1
= Ffile_exists_p (tem
);
3612 if (NILP (Fmember (tem
, Vload_path
)))
3614 turn_off_warning
= 1;
3615 Vload_path
= Fcons (tem
, Vload_path
);
3619 /* That dir doesn't exist, so add the build-time
3620 Lisp dirs instead. */
3621 Vload_path
= nconc2 (Vload_path
, dump_path
);
3623 /* Add leim under the installation dir, if it exists. */
3624 tem
= Fexpand_file_name (build_string ("leim"),
3625 Vinstallation_directory
);
3626 tem1
= Ffile_exists_p (tem
);
3629 if (NILP (Fmember (tem
, Vload_path
)))
3630 Vload_path
= Fcons (tem
, Vload_path
);
3633 /* Add site-list under the installation dir, if it exists. */
3634 tem
= Fexpand_file_name (build_string ("site-lisp"),
3635 Vinstallation_directory
);
3636 tem1
= Ffile_exists_p (tem
);
3639 if (NILP (Fmember (tem
, Vload_path
)))
3640 Vload_path
= Fcons (tem
, Vload_path
);
3643 /* If Emacs was not built in the source directory,
3644 and it is run from where it was built, add to load-path
3645 the lisp, leim and site-lisp dirs under that directory. */
3647 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3651 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3652 Vinstallation_directory
);
3653 tem1
= Ffile_exists_p (tem
);
3655 /* Don't be fooled if they moved the entire source tree
3656 AFTER dumping Emacs. If the build directory is indeed
3657 different from the source dir, src/Makefile.in and
3658 src/Makefile will not be found together. */
3659 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3660 Vinstallation_directory
);
3661 tem2
= Ffile_exists_p (tem
);
3662 if (!NILP (tem1
) && NILP (tem2
))
3664 tem
= Fexpand_file_name (build_string ("lisp"),
3667 if (NILP (Fmember (tem
, Vload_path
)))
3668 Vload_path
= Fcons (tem
, Vload_path
);
3670 tem
= Fexpand_file_name (build_string ("leim"),
3673 if (NILP (Fmember (tem
, Vload_path
)))
3674 Vload_path
= Fcons (tem
, Vload_path
);
3676 tem
= Fexpand_file_name (build_string ("site-lisp"),
3679 if (NILP (Fmember (tem
, Vload_path
)))
3680 Vload_path
= Fcons (tem
, Vload_path
);
3683 if (!NILP (sitelisp
))
3684 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3690 /* NORMAL refers to the lisp dir in the source directory. */
3691 /* We used to add ../lisp at the front here, but
3692 that caused trouble because it was copied from dump_path
3693 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3694 It should be unnecessary. */
3695 Vload_path
= decode_env_path (0, normal
);
3696 dump_path
= Vload_path
;
3700 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3701 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3702 almost never correct, thereby causing a warning to be printed out that
3703 confuses users. Since PATH_LOADSEARCH is always overridden by the
3704 EMACSLOADPATH environment variable below, disable the warning on NT.
3705 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3706 the "standard" paths may not exist and would be overridden by
3707 EMACSLOADPATH as on NT. Since this depends on how the executable
3708 was build and packaged, turn off the warnings in general */
3710 /* Warn if dirs in the *standard* path don't exist. */
3711 if (!turn_off_warning
)
3713 Lisp_Object path_tail
;
3715 for (path_tail
= Vload_path
;
3717 path_tail
= XCDR (path_tail
))
3719 Lisp_Object dirfile
;
3720 dirfile
= Fcar (path_tail
);
3721 if (STRINGP (dirfile
))
3723 dirfile
= Fdirectory_file_name (dirfile
);
3724 if (access (SDATA (dirfile
), 0) < 0)
3725 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3730 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3732 /* If the EMACSLOADPATH environment variable is set, use its value.
3733 This doesn't apply if we're dumping. */
3735 if (NILP (Vpurify_flag
)
3736 && egetenv ("EMACSLOADPATH"))
3738 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3742 load_in_progress
= 0;
3743 Vload_file_name
= Qnil
;
3745 load_descriptor_list
= Qnil
;
3747 Vstandard_input
= Qt
;
3748 Vloads_in_progress
= Qnil
;
3751 /* Print a warning, using format string FORMAT, that directory DIRNAME
3752 does not exist. Print it on stderr and put it in *Message*. */
3755 dir_warning (format
, dirname
)
3757 Lisp_Object dirname
;
3760 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3762 fprintf (stderr
, format
, SDATA (dirname
));
3763 sprintf (buffer
, format
, SDATA (dirname
));
3764 /* Don't log the warning before we've initialized!! */
3766 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3773 defsubr (&Sread_from_string
);
3775 defsubr (&Sintern_soft
);
3776 defsubr (&Sunintern
);
3778 defsubr (&Seval_buffer
);
3779 defsubr (&Seval_region
);
3780 defsubr (&Sread_char
);
3781 defsubr (&Sread_char_exclusive
);
3782 defsubr (&Sread_event
);
3783 defsubr (&Sget_file_char
);
3784 defsubr (&Smapatoms
);
3785 defsubr (&Slocate_file_internal
);
3787 DEFVAR_LISP ("obarray", &Vobarray
,
3788 doc
: /* Symbol table for use by `intern' and `read'.
3789 It is a vector whose length ought to be prime for best results.
3790 The vector's contents don't make sense if examined from Lisp programs;
3791 to find all the symbols in an obarray, use `mapatoms'. */);
3793 DEFVAR_LISP ("values", &Vvalues
,
3794 doc
: /* List of values of all expressions which were read, evaluated and printed.
3795 Order is reverse chronological. */);
3797 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3798 doc
: /* Stream for read to get input from.
3799 See documentation of `read' for possible values. */);
3800 Vstandard_input
= Qt
;
3802 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3803 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3805 If this variable is a buffer, then only forms read from that buffer
3806 will be added to `read-symbol-positions-list'.
3807 If this variable is t, then all read forms will be added.
3808 The effect of all other values other than nil are not currently
3809 defined, although they may be in the future.
3811 The positions are relative to the last call to `read' or
3812 `read-from-string'. It is probably a bad idea to set this variable at
3813 the toplevel; bind it instead. */);
3814 Vread_with_symbol_positions
= Qnil
;
3816 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3817 doc
: /* A list mapping read symbols to their positions.
3818 This variable is modified during calls to `read' or
3819 `read-from-string', but only when `read-with-symbol-positions' is
3822 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3823 CHAR-POSITION is an integer giving the offset of that occurrence of the
3824 symbol from the position where `read' or `read-from-string' started.
3826 Note that a symbol will appear multiple times in this list, if it was
3827 read multiple times. The list is in the same order as the symbols
3829 Vread_symbol_positions_list
= Qnil
;
3831 DEFVAR_LISP ("load-path", &Vload_path
,
3832 doc
: /* *List of directories to search for files to load.
3833 Each element is a string (directory name) or nil (try default directory).
3834 Initialized based on EMACSLOADPATH environment variable, if any,
3835 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3837 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3838 doc
: /* *List of suffixes to try for files to load.
3839 This list should not include the empty string. */);
3840 Vload_suffixes
= Fcons (build_string (".elc"),
3841 Fcons (build_string (".el"), Qnil
));
3842 /* We don't use empty_string because it's not initialized yet. */
3843 default_suffixes
= Fcons (build_string (""), Qnil
);
3844 staticpro (&default_suffixes
);
3846 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3847 doc
: /* Non-nil iff inside of `load'. */);
3849 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3850 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3851 Each element looks like (FILENAME FORMS...).
3852 When `load' is run and the file-name argument is FILENAME,
3853 the FORMS in the corresponding element are executed at the end of loading.
3855 FILENAME must match exactly! Normally FILENAME is the name of a library,
3856 with no directory specified, since that is how `load' is normally called.
3857 An error in FORMS does not undo the load,
3858 but does prevent execution of the rest of the FORMS.
3859 FILENAME can also be a symbol (a feature) and FORMS are then executed
3860 when the corresponding call to `provide' is made. */);
3861 Vafter_load_alist
= Qnil
;
3863 DEFVAR_LISP ("load-history", &Vload_history
,
3864 doc
: /* Alist mapping source file names to symbols and features.
3865 Each alist element is a list that starts with a file name,
3866 except for one element (optional) that starts with nil and describes
3867 definitions evaluated from buffers not visiting files.
3868 The remaining elements of each list are symbols defined as variables
3869 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3870 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3871 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3872 and means that SYMBOL was an autoload before this file redefined it
3874 Vload_history
= Qnil
;
3876 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3877 doc
: /* Full name of file being loaded by `load'. */);
3878 Vload_file_name
= Qnil
;
3880 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3881 doc
: /* File name, including directory, of user's initialization file.
3882 If the file loaded had extension `.elc', and the corresponding source file
3883 exists, this variable contains the name of source file, suitable for use
3884 by functions like `custom-save-all' which edit the init file. */);
3885 Vuser_init_file
= Qnil
;
3887 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3888 doc
: /* Used for internal purposes by `load'. */);
3889 Vcurrent_load_list
= Qnil
;
3891 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3892 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3893 The default is nil, which means use the function `read'. */);
3894 Vload_read_function
= Qnil
;
3896 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3897 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3898 This function is for doing code conversion before reading the source file.
3899 If nil, loading is done without any code conversion.
3900 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3901 FULLNAME is the full name of FILE.
3902 See `load' for the meaning of the remaining arguments. */);
3903 Vload_source_file_function
= Qnil
;
3905 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3906 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3907 This is useful when the file being loaded is a temporary copy. */);
3908 load_force_doc_strings
= 0;
3910 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3911 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3912 This is normally bound by `load' and `eval-buffer' to control `read',
3913 and is not meant for users to change. */);
3914 load_convert_to_unibyte
= 0;
3916 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3917 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3918 You cannot count on them to still be there! */);
3920 = Fexpand_file_name (build_string ("../"),
3921 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3923 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3924 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3925 Vpreloaded_file_list
= Qnil
;
3927 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3928 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3929 Vbyte_boolean_vars
= Qnil
;
3931 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3932 doc
: /* Non-nil means load dangerous compiled Lisp files.
3933 Some versions of XEmacs use different byte codes than Emacs. These
3934 incompatible byte codes can make Emacs crash when it tries to execute
3936 load_dangerous_libraries
= 0;
3938 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3939 doc
: /* Regular expression matching safe to load compiled Lisp files.
3940 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3941 from the file, and matches them against this regular expression.
3942 When the regular expression matches, the file is considered to be safe
3943 to load. See also `load-dangerous-libraries'. */);
3944 Vbytecomp_version_regexp
3945 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3947 /* Vsource_directory was initialized in init_lread. */
3949 load_descriptor_list
= Qnil
;
3950 staticpro (&load_descriptor_list
);
3952 Qcurrent_load_list
= intern ("current-load-list");
3953 staticpro (&Qcurrent_load_list
);
3955 Qstandard_input
= intern ("standard-input");
3956 staticpro (&Qstandard_input
);
3958 Qread_char
= intern ("read-char");
3959 staticpro (&Qread_char
);
3961 Qget_file_char
= intern ("get-file-char");
3962 staticpro (&Qget_file_char
);
3964 Qbackquote
= intern ("`");
3965 staticpro (&Qbackquote
);
3966 Qcomma
= intern (",");
3967 staticpro (&Qcomma
);
3968 Qcomma_at
= intern (",@");
3969 staticpro (&Qcomma_at
);
3970 Qcomma_dot
= intern (",.");
3971 staticpro (&Qcomma_dot
);
3973 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3974 staticpro (&Qinhibit_file_name_operation
);
3976 Qascii_character
= intern ("ascii-character");
3977 staticpro (&Qascii_character
);
3979 Qfunction
= intern ("function");
3980 staticpro (&Qfunction
);
3982 Qload
= intern ("load");
3985 Qload_file_name
= intern ("load-file-name");
3986 staticpro (&Qload_file_name
);
3988 staticpro (&dump_path
);
3990 staticpro (&read_objects
);
3991 read_objects
= Qnil
;
3992 staticpro (&seen_list
);
3994 Vloads_in_progress
= Qnil
;
3995 staticpro (&Vloads_in_progress
);
3998 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
3999 (do not change this comment) */