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 Returns the file's name in absolute form, or nil if not found.
1010 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1011 file name when searching.
1012 If non-nil, PREDICATE is used instead of `file-readable-p'.
1013 PREDICATE can also be an integer to pass to the access(2) function,
1014 in which case file-name-handlers are ignored. */)
1015 (filename
, path
, suffixes
, predicate
)
1016 Lisp_Object filename
, path
, suffixes
, predicate
;
1019 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1020 if (NILP (predicate
) && fd
> 0)
1026 /* Search for a file whose name is STR, looking in directories
1027 in the Lisp list PATH, and trying suffixes from SUFFIX.
1028 On success, returns a file descriptor. On failure, returns -1.
1030 SUFFIXES is a list of strings containing possible suffixes.
1031 The empty suffix is automatically added iff the list is empty.
1033 PREDICATE non-nil means don't open the files,
1034 just look for one that satisfies the predicate. In this case,
1035 returns 1 on success. The predicate can be a lisp function or
1036 an integer to pass to `access' (in which case file-name-handlers
1039 If STOREPTR is nonzero, it points to a slot where the name of
1040 the file actually found should be stored as a Lisp string.
1041 nil is stored there on failure.
1043 If the file we find is remote, return -2
1044 but store the found remote file name in *STOREPTR. */
1047 openp (path
, str
, suffixes
, storeptr
, predicate
)
1048 Lisp_Object path
, str
;
1049 Lisp_Object suffixes
;
1050 Lisp_Object
*storeptr
;
1051 Lisp_Object predicate
;
1056 register char *fn
= buf
;
1059 Lisp_Object filename
;
1061 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1062 Lisp_Object string
, tail
, encoded_fn
;
1063 int max_suffix_len
= 0;
1067 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1069 CHECK_STRING_CAR (tail
);
1070 max_suffix_len
= max (max_suffix_len
,
1071 SBYTES (XCAR (tail
)));
1074 string
= filename
= Qnil
;
1075 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1080 if (complete_filename_p (str
))
1083 for (; CONSP (path
); path
= XCDR (path
))
1085 filename
= Fexpand_file_name (str
, XCAR (path
));
1086 if (!complete_filename_p (filename
))
1087 /* If there are non-absolute elts in PATH (eg ".") */
1088 /* Of course, this could conceivably lose if luser sets
1089 default-directory to be something non-absolute... */
1091 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1092 if (!complete_filename_p (filename
))
1093 /* Give up on this path element! */
1097 /* Calculate maximum size of any filename made from
1098 this path element/specified file name and any possible suffix. */
1099 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1100 if (fn_size
< want_size
)
1101 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1103 /* Loop over suffixes. */
1104 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1105 CONSP (tail
); tail
= XCDR (tail
))
1107 int lsuffix
= SBYTES (XCAR (tail
));
1108 Lisp_Object handler
;
1111 /* Concatenate path element/specified name with the suffix.
1112 If the directory starts with /:, remove that. */
1113 if (SCHARS (filename
) > 2
1114 && SREF (filename
, 0) == '/'
1115 && SREF (filename
, 1) == ':')
1117 strncpy (fn
, SDATA (filename
) + 2,
1118 SBYTES (filename
) - 2);
1119 fn
[SBYTES (filename
) - 2] = 0;
1123 strncpy (fn
, SDATA (filename
),
1125 fn
[SBYTES (filename
)] = 0;
1128 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1129 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1131 /* Check that the file exists and is not a directory. */
1132 /* We used to only check for handlers on non-absolute file names:
1136 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1137 It's not clear why that was the case and it breaks things like
1138 (load "/bar.el") where the file is actually "/bar.el.gz". */
1139 string
= build_string (fn
);
1140 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1141 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1143 if (NILP (predicate
))
1144 exists
= !NILP (Ffile_readable_p (string
));
1146 exists
= !NILP (call1 (predicate
, string
));
1147 if (exists
&& !NILP (Ffile_directory_p (string
)))
1152 /* We succeeded; return this descriptor and filename. */
1163 encoded_fn
= ENCODE_FILE (string
);
1164 pfn
= SDATA (encoded_fn
);
1165 exists
= (stat (pfn
, &st
) >= 0
1166 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1169 /* Check that we can access or open it. */
1170 if (NATNUMP (predicate
))
1171 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1173 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1177 /* We succeeded; return this descriptor and filename. */
1195 /* Merge the list we've accumulated of globals from the current input source
1196 into the load_history variable. The details depend on whether
1197 the source has an associated file name or not. */
1200 build_load_history (stream
, source
)
1204 register Lisp_Object tail
, prev
, newelt
;
1205 register Lisp_Object tem
, tem2
;
1206 register int foundit
, loading
;
1208 loading
= stream
|| !NARROWED
;
1210 tail
= Vload_history
;
1213 while (CONSP (tail
))
1217 /* Find the feature's previous assoc list... */
1218 if (!NILP (Fequal (source
, Fcar (tem
))))
1222 /* If we're loading, remove it. */
1226 Vload_history
= XCDR (tail
);
1228 Fsetcdr (prev
, XCDR (tail
));
1231 /* Otherwise, cons on new symbols that are not already members. */
1234 tem2
= Vcurrent_load_list
;
1236 while (CONSP (tem2
))
1238 newelt
= XCAR (tem2
);
1240 if (NILP (Fmember (newelt
, tem
)))
1241 Fsetcar (tail
, Fcons (XCAR (tem
),
1242 Fcons (newelt
, XCDR (tem
))));
1255 /* If we're loading, cons the new assoc onto the front of load-history,
1256 the most-recently-loaded position. Also do this if we didn't find
1257 an existing member for the current source. */
1258 if (loading
|| !foundit
)
1259 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1264 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1272 readevalloop_1 (old
)
1275 load_convert_to_unibyte
= ! NILP (old
);
1279 /* Signal an `end-of-file' error, if possible with file name
1283 end_of_file_error ()
1287 if (STRINGP (Vload_file_name
))
1288 data
= Fcons (Vload_file_name
, Qnil
);
1292 Fsignal (Qend_of_file
, data
);
1295 /* UNIBYTE specifies how to set load_convert_to_unibyte
1296 for this invocation.
1297 READFUN, if non-nil, is used instead of `read'.
1298 START, END is region in current buffer (from eval-region). */
1301 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1302 printflag
, unibyte
, readfun
, start
, end
)
1303 Lisp_Object readcharfun
;
1305 Lisp_Object sourcename
;
1306 Lisp_Object (*evalfun
) ();
1308 Lisp_Object unibyte
, readfun
;
1309 Lisp_Object start
, end
;
1312 register Lisp_Object val
;
1313 int count
= SPECPDL_INDEX ();
1314 struct gcpro gcpro1
;
1315 struct buffer
*b
= 0;
1316 int continue_reading_p
;
1318 if (BUFFERP (readcharfun
))
1319 b
= XBUFFER (readcharfun
);
1320 else if (MARKERP (readcharfun
))
1321 b
= XMARKER (readcharfun
)->buffer
;
1323 specbind (Qstandard_input
, readcharfun
);
1324 specbind (Qcurrent_load_list
, Qnil
);
1325 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1326 load_convert_to_unibyte
= !NILP (unibyte
);
1328 readchar_backlog
= -1;
1330 GCPRO1 (sourcename
);
1332 LOADHIST_ATTACH (sourcename
);
1334 continue_reading_p
= 1;
1335 while (continue_reading_p
)
1337 int count1
= SPECPDL_INDEX ();
1339 if (b
!= 0 && NILP (b
->name
))
1340 error ("Reading from killed buffer");
1344 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1345 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1347 Fnarrow_to_region (make_number (BEGV
), end
);
1355 while ((c
= READCHAR
) != '\n' && c
!= -1);
1360 unbind_to (count1
, Qnil
);
1364 /* Ignore whitespace here, so we can detect eof. */
1365 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1368 if (!NILP (Vpurify_flag
) && c
== '(')
1370 record_unwind_protect (unreadpure
, Qnil
);
1371 val
= read_list (-1, readcharfun
);
1376 read_objects
= Qnil
;
1377 if (!NILP (readfun
))
1379 val
= call1 (readfun
, readcharfun
);
1381 /* If READCHARFUN has set point to ZV, we should
1382 stop reading, even if the form read sets point
1383 to a different value when evaluated. */
1384 if (BUFFERP (readcharfun
))
1386 struct buffer
*b
= XBUFFER (readcharfun
);
1387 if (BUF_PT (b
) == BUF_ZV (b
))
1388 continue_reading_p
= 0;
1391 else if (! NILP (Vload_read_function
))
1392 val
= call1 (Vload_read_function
, readcharfun
);
1394 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1397 if (!NILP (start
) && continue_reading_p
)
1398 start
= Fpoint_marker ();
1399 unbind_to (count1
, Qnil
);
1401 val
= (*evalfun
) (val
);
1405 Vvalues
= Fcons (val
, Vvalues
);
1406 if (EQ (Vstandard_output
, Qt
))
1413 build_load_history (stream
, sourcename
);
1416 unbind_to (count
, Qnil
);
1419 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1420 doc
: /* Execute the current buffer as Lisp code.
1421 Programs can pass two arguments, BUFFER and PRINTFLAG.
1422 BUFFER is the buffer to evaluate (nil means use current buffer).
1423 PRINTFLAG controls printing of output:
1424 nil means discard it; anything else is stream for print.
1426 If the optional third argument FILENAME is non-nil,
1427 it specifies the file name to use for `load-history'.
1428 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1429 for this invocation.
1431 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1432 `print' and related functions should work normally even if PRINTFLAG is nil.
1434 This function preserves the position of point. */)
1435 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1436 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1438 int count
= SPECPDL_INDEX ();
1439 Lisp_Object tem
, buf
;
1442 buf
= Fcurrent_buffer ();
1444 buf
= Fget_buffer (buffer
);
1446 error ("No such buffer");
1448 if (NILP (printflag
) && NILP (do_allow_print
))
1453 if (NILP (filename
))
1454 filename
= XBUFFER (buf
)->filename
;
1456 specbind (Qstandard_output
, tem
);
1457 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1458 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1459 readevalloop (buf
, 0, filename
, Feval
,
1460 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1461 unbind_to (count
, Qnil
);
1466 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1467 doc
: /* Execute the region as Lisp code.
1468 When called from programs, expects two arguments,
1469 giving starting and ending indices in the current buffer
1470 of the text to be executed.
1471 Programs can pass third argument PRINTFLAG which controls output:
1472 nil means discard it; anything else is stream for printing it.
1473 Also the fourth argument READ-FUNCTION, if non-nil, is used
1474 instead of `read' to read each expression. It gets one argument
1475 which is the input stream for reading characters.
1477 This function does not move point. */)
1478 (start
, end
, printflag
, read_function
)
1479 Lisp_Object start
, end
, printflag
, read_function
;
1481 int count
= SPECPDL_INDEX ();
1482 Lisp_Object tem
, cbuf
;
1484 cbuf
= Fcurrent_buffer ();
1486 if (NILP (printflag
))
1490 specbind (Qstandard_output
, tem
);
1492 /* readevalloop calls functions which check the type of start and end. */
1493 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1494 !NILP (printflag
), Qnil
, read_function
,
1497 return unbind_to (count
, Qnil
);
1501 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1502 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1503 If STREAM is nil, use the value of `standard-input' (which see).
1504 STREAM or the value of `standard-input' may be:
1505 a buffer (read from point and advance it)
1506 a marker (read from where it points and advance it)
1507 a function (call it with no arguments for each character,
1508 call it with a char as argument to push a char back)
1509 a string (takes text from string, starting at the beginning)
1510 t (read text line using minibuffer and use it, or read from
1511 standard input in batch mode). */)
1516 stream
= Vstandard_input
;
1517 if (EQ (stream
, Qt
))
1518 stream
= Qread_char
;
1519 if (EQ (stream
, Qread_char
))
1520 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1522 return read_internal_start (stream
, Qnil
, Qnil
);
1525 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1526 doc
: /* Read one Lisp expression which is represented as text by STRING.
1527 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1528 START and END optionally delimit a substring of STRING from which to read;
1529 they default to 0 and (length STRING) respectively. */)
1530 (string
, start
, end
)
1531 Lisp_Object string
, start
, end
;
1534 CHECK_STRING (string
);
1535 /* read_internal_start sets read_from_string_index. */
1536 ret
= read_internal_start (string
, start
, end
);
1537 return Fcons (ret
, make_number (read_from_string_index
));
1540 /* Function to set up the global context we need in toplevel read
1543 read_internal_start (stream
, start
, end
)
1545 Lisp_Object start
; /* Only used when stream is a string. */
1546 Lisp_Object end
; /* Only used when stream is a string. */
1550 readchar_backlog
= -1;
1552 new_backquote_flag
= 0;
1553 read_objects
= Qnil
;
1554 if (EQ (Vread_with_symbol_positions
, Qt
)
1555 || EQ (Vread_with_symbol_positions
, stream
))
1556 Vread_symbol_positions_list
= Qnil
;
1558 if (STRINGP (stream
))
1560 int startval
, endval
;
1562 endval
= SCHARS (stream
);
1566 endval
= XINT (end
);
1567 if (endval
< 0 || endval
> SCHARS (stream
))
1568 args_out_of_range (stream
, end
);
1575 CHECK_NUMBER (start
);
1576 startval
= XINT (start
);
1577 if (startval
< 0 || startval
> endval
)
1578 args_out_of_range (stream
, start
);
1580 read_from_string_index
= startval
;
1581 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1582 read_from_string_limit
= endval
;
1585 retval
= read0 (stream
);
1586 if (EQ (Vread_with_symbol_positions
, Qt
)
1587 || EQ (Vread_with_symbol_positions
, stream
))
1588 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1592 /* Use this for recursive reads, in contexts where internal tokens
1597 Lisp_Object readcharfun
;
1599 register Lisp_Object val
;
1602 val
= read1 (readcharfun
, &c
, 0);
1604 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1611 static int read_buffer_size
;
1612 static char *read_buffer
;
1614 /* Read multibyte form and return it as a character. C is a first
1615 byte of multibyte form, and rest of them are read from
1619 read_multibyte (c
, readcharfun
)
1621 Lisp_Object readcharfun
;
1623 /* We need the actual character code of this multibyte
1625 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1633 while ((c
= READCHAR
) >= 0xA0
1634 && len
< MAX_MULTIBYTE_LENGTH
)
1640 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1641 return STRING_CHAR (str
, len
);
1642 /* The byte sequence is not valid as multibyte. Unread all bytes
1643 but the first one, and return the first byte. */
1649 /* Read a \-escape sequence, assuming we already read the `\'.
1650 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1651 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1652 Otherwise store 0 into *BYTEREP. */
1655 read_escape (readcharfun
, stringp
, byterep
)
1656 Lisp_Object readcharfun
;
1660 register int c
= READCHAR
;
1667 end_of_file_error ();
1697 error ("Invalid escape character syntax");
1700 c
= read_escape (readcharfun
, 0, byterep
);
1701 return c
| meta_modifier
;
1706 error ("Invalid escape character syntax");
1709 c
= read_escape (readcharfun
, 0, byterep
);
1710 return c
| shift_modifier
;
1715 error ("Invalid escape character syntax");
1718 c
= read_escape (readcharfun
, 0, byterep
);
1719 return c
| hyper_modifier
;
1724 error ("Invalid escape character syntax");
1727 c
= read_escape (readcharfun
, 0, byterep
);
1728 return c
| alt_modifier
;
1740 c
= read_escape (readcharfun
, 0, byterep
);
1741 return c
| super_modifier
;
1746 error ("Invalid escape character syntax");
1750 c
= read_escape (readcharfun
, 0, byterep
);
1751 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1752 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1753 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1754 return c
| ctrl_modifier
;
1755 /* ASCII control chars are made from letters (both cases),
1756 as well as the non-letters within 0100...0137. */
1757 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1758 return (c
& (037 | ~0177));
1759 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1760 return (c
& (037 | ~0177));
1762 return c
| ctrl_modifier
;
1772 /* An octal escape, as in ANSI C. */
1774 register int i
= c
- '0';
1775 register int count
= 0;
1778 if ((c
= READCHAR
) >= '0' && c
<= '7')
1795 /* A hex escape, as in ANSI C. */
1801 if (c
>= '0' && c
<= '9')
1806 else if ((c
>= 'a' && c
<= 'f')
1807 || (c
>= 'A' && c
<= 'F'))
1810 if (c
>= 'a' && c
<= 'f')
1827 if (BASE_LEADING_CODE_P (c
))
1828 c
= read_multibyte (c
, readcharfun
);
1834 /* Read an integer in radix RADIX using READCHARFUN to read
1835 characters. RADIX must be in the interval [2..36]; if it isn't, a
1836 read error is signaled . Value is the integer read. Signals an
1837 error if encountering invalid read syntax or if RADIX is out of
1841 read_integer (readcharfun
, radix
)
1842 Lisp_Object readcharfun
;
1845 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1846 EMACS_INT number
= 0;
1848 if (radix
< 2 || radix
> 36)
1852 number
= ndigits
= invalid_p
= 0;
1868 if (c
>= '0' && c
<= '9')
1870 else if (c
>= 'a' && c
<= 'z')
1871 digit
= c
- 'a' + 10;
1872 else if (c
>= 'A' && c
<= 'Z')
1873 digit
= c
- 'A' + 10;
1880 if (digit
< 0 || digit
>= radix
)
1883 number
= radix
* number
+ digit
;
1889 if (ndigits
== 0 || invalid_p
)
1892 sprintf (buf
, "integer, radix %d", radix
);
1893 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1896 return make_number (sign
* number
);
1900 /* Convert unibyte text in read_buffer to multibyte.
1902 Initially, *P is a pointer after the end of the unibyte text, and
1903 the pointer *END points after the end of read_buffer.
1905 If read_buffer doesn't have enough room to hold the result
1906 of the conversion, reallocate it and adjust *P and *END.
1908 At the end, make *P point after the result of the conversion, and
1909 return in *NCHARS the number of characters in the converted
1913 to_multibyte (p
, end
, nchars
)
1919 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1920 if (read_buffer_size
< 2 * nbytes
)
1922 int offset
= *p
- read_buffer
;
1923 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1924 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1925 *p
= read_buffer
+ offset
;
1926 *end
= read_buffer
+ read_buffer_size
;
1929 if (nbytes
!= *nchars
)
1930 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1931 *p
- read_buffer
, nchars
);
1933 *p
= read_buffer
+ nbytes
;
1937 /* If the next token is ')' or ']' or '.', we store that character
1938 in *PCH and the return value is not interesting. Else, we store
1939 zero in *PCH and we read and return one lisp object.
1941 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1944 read1 (readcharfun
, pch
, first_in_list
)
1945 register Lisp_Object readcharfun
;
1950 int uninterned_symbol
= 0;
1958 end_of_file_error ();
1963 return read_list (0, readcharfun
);
1966 return read_vector (readcharfun
, 0);
1983 tmp
= read_vector (readcharfun
, 0);
1984 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1985 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1986 error ("Invalid size char-table");
1987 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1988 XCHAR_TABLE (tmp
)->top
= Qt
;
1997 tmp
= read_vector (readcharfun
, 0);
1998 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1999 error ("Invalid size char-table");
2000 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2001 XCHAR_TABLE (tmp
)->top
= Qnil
;
2004 Fsignal (Qinvalid_read_syntax
,
2005 Fcons (make_string ("#^^", 3), Qnil
));
2007 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2012 length
= read1 (readcharfun
, pch
, first_in_list
);
2016 Lisp_Object tmp
, val
;
2018 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2019 / BOOL_VECTOR_BITS_PER_CHAR
);
2022 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2023 if (size_in_chars
!= SCHARS (tmp
)
2024 /* We used to print 1 char too many
2025 when the number of bits was a multiple of 8.
2026 Accept such input in case it came from an old version. */
2027 && ! (XFASTINT (length
)
2028 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2029 Fsignal (Qinvalid_read_syntax
,
2030 Fcons (make_string ("#&...", 5), Qnil
));
2032 val
= Fmake_bool_vector (length
, Qnil
);
2033 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2035 /* Clear the extraneous bits in the last byte. */
2036 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2037 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2038 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2041 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2046 /* Accept compiled functions at read-time so that we don't have to
2047 build them using function calls. */
2049 tmp
= read_vector (readcharfun
, 1);
2050 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2051 XVECTOR (tmp
)->contents
);
2056 struct gcpro gcpro1
;
2059 /* Read the string itself. */
2060 tmp
= read1 (readcharfun
, &ch
, 0);
2061 if (ch
!= 0 || !STRINGP (tmp
))
2062 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2064 /* Read the intervals and their properties. */
2067 Lisp_Object beg
, end
, plist
;
2069 beg
= read1 (readcharfun
, &ch
, 0);
2074 end
= read1 (readcharfun
, &ch
, 0);
2076 plist
= read1 (readcharfun
, &ch
, 0);
2078 Fsignal (Qinvalid_read_syntax
,
2079 Fcons (build_string ("invalid string property list"),
2081 Fset_text_properties (beg
, end
, plist
, tmp
);
2087 /* #@NUMBER is used to skip NUMBER following characters.
2088 That's used in .elc files to skip over doc strings
2089 and function definitions. */
2094 /* Read a decimal integer. */
2095 while ((c
= READCHAR
) >= 0
2096 && c
>= '0' && c
<= '9')
2104 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2106 /* If we are supposed to force doc strings into core right now,
2107 record the last string that we skipped,
2108 and record where in the file it comes from. */
2110 /* But first exchange saved_doc_string
2111 with prev_saved_doc_string, so we save two strings. */
2113 char *temp
= saved_doc_string
;
2114 int temp_size
= saved_doc_string_size
;
2115 file_offset temp_pos
= saved_doc_string_position
;
2116 int temp_len
= saved_doc_string_length
;
2118 saved_doc_string
= prev_saved_doc_string
;
2119 saved_doc_string_size
= prev_saved_doc_string_size
;
2120 saved_doc_string_position
= prev_saved_doc_string_position
;
2121 saved_doc_string_length
= prev_saved_doc_string_length
;
2123 prev_saved_doc_string
= temp
;
2124 prev_saved_doc_string_size
= temp_size
;
2125 prev_saved_doc_string_position
= temp_pos
;
2126 prev_saved_doc_string_length
= temp_len
;
2129 if (saved_doc_string_size
== 0)
2131 saved_doc_string_size
= nskip
+ 100;
2132 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2134 if (nskip
> saved_doc_string_size
)
2136 saved_doc_string_size
= nskip
+ 100;
2137 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2138 saved_doc_string_size
);
2141 saved_doc_string_position
= file_tell (instream
);
2143 /* Copy that many characters into saved_doc_string. */
2144 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2145 saved_doc_string
[i
] = c
= READCHAR
;
2147 saved_doc_string_length
= i
;
2151 /* Skip that many characters. */
2152 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2160 /* #! appears at the beginning of an executable file.
2161 Skip the first line. */
2162 while (c
!= '\n' && c
>= 0)
2167 return Vload_file_name
;
2169 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2170 /* #:foo is the uninterned symbol named foo. */
2173 uninterned_symbol
= 1;
2177 /* Reader forms that can reuse previously read objects. */
2178 if (c
>= '0' && c
<= '9')
2183 /* Read a non-negative integer. */
2184 while (c
>= '0' && c
<= '9')
2190 /* #n=object returns object, but associates it with n for #n#. */
2193 /* Make a placeholder for #n# to use temporarily */
2194 Lisp_Object placeholder
;
2197 placeholder
= Fcons(Qnil
, Qnil
);
2198 cell
= Fcons (make_number (n
), placeholder
);
2199 read_objects
= Fcons (cell
, read_objects
);
2201 /* Read the object itself. */
2202 tem
= read0 (readcharfun
);
2204 /* Now put it everywhere the placeholder was... */
2205 substitute_object_in_subtree (tem
, placeholder
);
2207 /* ...and #n# will use the real value from now on. */
2208 Fsetcdr (cell
, tem
);
2212 /* #n# returns a previously read object. */
2215 tem
= Fassq (make_number (n
), read_objects
);
2218 /* Fall through to error message. */
2220 else if (c
== 'r' || c
== 'R')
2221 return read_integer (readcharfun
, n
);
2223 /* Fall through to error message. */
2225 else if (c
== 'x' || c
== 'X')
2226 return read_integer (readcharfun
, 16);
2227 else if (c
== 'o' || c
== 'O')
2228 return read_integer (readcharfun
, 8);
2229 else if (c
== 'b' || c
== 'B')
2230 return read_integer (readcharfun
, 2);
2233 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2236 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2241 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2251 new_backquote_flag
++;
2252 value
= read0 (readcharfun
);
2253 new_backquote_flag
--;
2255 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2259 if (new_backquote_flag
)
2261 Lisp_Object comma_type
= Qnil
;
2266 comma_type
= Qcomma_at
;
2268 comma_type
= Qcomma_dot
;
2271 if (ch
>= 0) UNREAD (ch
);
2272 comma_type
= Qcomma
;
2275 new_backquote_flag
--;
2276 value
= read0 (readcharfun
);
2277 new_backquote_flag
++;
2278 return Fcons (comma_type
, Fcons (value
, Qnil
));
2291 end_of_file_error ();
2293 /* Accept `single space' syntax like (list ? x) where the
2294 whitespace character is SPC or TAB.
2295 Other literal whitespace like NL, CR, and FF are not accepted,
2296 as there are well-established escape sequences for these. */
2297 if (c
== ' ' || c
== '\t')
2298 return make_number (c
);
2301 c
= read_escape (readcharfun
, 0, &discard
);
2302 else if (BASE_LEADING_CODE_P (c
))
2303 c
= read_multibyte (c
, readcharfun
);
2305 next_char
= READCHAR
;
2306 if (next_char
== '.')
2308 /* Only a dotted-pair dot is valid after a char constant. */
2309 int next_next_char
= READCHAR
;
2310 UNREAD (next_next_char
);
2312 ok
= (next_next_char
<= 040
2313 || (next_next_char
< 0200
2314 && (index ("\"';([#?", next_next_char
)
2315 || (!first_in_list
&& next_next_char
== '`')
2316 || (new_backquote_flag
&& next_next_char
== ','))));
2320 ok
= (next_char
<= 040
2321 || (next_char
< 0200
2322 && (index ("\"';()[]#?", next_char
)
2323 || (!first_in_list
&& next_char
== '`')
2324 || (new_backquote_flag
&& next_char
== ','))));
2328 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2330 return make_number (c
);
2335 char *p
= read_buffer
;
2336 char *end
= read_buffer
+ read_buffer_size
;
2338 /* 1 if we saw an escape sequence specifying
2339 a multibyte character, or a multibyte character. */
2340 int force_multibyte
= 0;
2341 /* 1 if we saw an escape sequence specifying
2342 a single-byte character. */
2343 int force_singlebyte
= 0;
2344 /* 1 if read_buffer contains multibyte text now. */
2345 int is_multibyte
= 0;
2349 while ((c
= READCHAR
) >= 0
2352 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2354 int offset
= p
- read_buffer
;
2355 read_buffer
= (char *) xrealloc (read_buffer
,
2356 read_buffer_size
*= 2);
2357 p
= read_buffer
+ offset
;
2358 end
= read_buffer
+ read_buffer_size
;
2365 c
= read_escape (readcharfun
, 1, &byterep
);
2367 /* C is -1 if \ newline has just been seen */
2370 if (p
== read_buffer
)
2376 force_singlebyte
= 1;
2377 else if (byterep
== 2)
2378 force_multibyte
= 1;
2381 /* A character that must be multibyte forces multibyte. */
2382 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2383 force_multibyte
= 1;
2385 /* If we just discovered the need to be multibyte,
2386 convert the text accumulated thus far. */
2387 if (force_multibyte
&& ! is_multibyte
)
2390 to_multibyte (&p
, &end
, &nchars
);
2393 /* Allow `\C- ' and `\C-?'. */
2394 if (c
== (CHAR_CTL
| ' '))
2396 else if (c
== (CHAR_CTL
| '?'))
2401 /* Shift modifier is valid only with [A-Za-z]. */
2402 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2404 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2405 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2409 /* Move the meta bit to the right place for a string. */
2410 c
= (c
& ~CHAR_META
) | 0x80;
2411 if (c
& CHAR_MODIFIER_MASK
)
2412 error ("Invalid modifier in string");
2415 p
+= CHAR_STRING (c
, p
);
2423 end_of_file_error ();
2425 /* If purifying, and string starts with \ newline,
2426 return zero instead. This is for doc strings
2427 that we are really going to find in etc/DOC.nn.nn */
2428 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2429 return make_number (0);
2431 if (is_multibyte
|| force_singlebyte
)
2433 else if (load_convert_to_unibyte
)
2436 to_multibyte (&p
, &end
, &nchars
);
2437 if (p
- read_buffer
!= nchars
)
2439 string
= make_multibyte_string (read_buffer
, nchars
,
2441 return Fstring_make_unibyte (string
);
2443 /* We can make a unibyte string directly. */
2446 else if (EQ (readcharfun
, Qget_file_char
)
2447 || EQ (readcharfun
, Qlambda
))
2449 /* Nowadays, reading directly from a file is used only for
2450 compiled Emacs Lisp files, and those always use the
2451 Emacs internal encoding. Meanwhile, Qlambda is used
2452 for reading dynamic byte code (compiled with
2453 byte-compile-dynamic = t). So make the string multibyte
2454 if the string contains any multibyte sequences.
2455 (to_multibyte is a no-op if not.) */
2456 to_multibyte (&p
, &end
, &nchars
);
2457 is_multibyte
= (p
- read_buffer
) != nchars
;
2460 /* In all other cases, if we read these bytes as
2461 separate characters, treat them as separate characters now. */
2464 /* We want readchar_count to be the number of characters, not
2465 bytes. Hence we adjust for multibyte characters in the
2466 string. ... But it doesn't seem to be necessary, because
2467 READCHAR *does* read multibyte characters from buffers. */
2468 /* readchar_count -= (p - read_buffer) - nchars; */
2470 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2472 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2478 int next_char
= READCHAR
;
2481 if (next_char
<= 040
2482 || (next_char
< 0200
2483 && (index ("\"';([#?", next_char
)
2484 || (!first_in_list
&& next_char
== '`')
2485 || (new_backquote_flag
&& next_char
== ','))))
2491 /* Otherwise, we fall through! Note that the atom-reading loop
2492 below will now loop at least once, assuring that we will not
2493 try to UNREAD two characters in a row. */
2497 if (c
<= 040) goto retry
;
2499 char *p
= read_buffer
;
2503 char *end
= read_buffer
+ read_buffer_size
;
2507 || (!index ("\"';()[]#", c
)
2508 && !(!first_in_list
&& c
== '`')
2509 && !(new_backquote_flag
&& c
== ','))))
2511 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2513 int offset
= p
- read_buffer
;
2514 read_buffer
= (char *) xrealloc (read_buffer
,
2515 read_buffer_size
*= 2);
2516 p
= read_buffer
+ offset
;
2517 end
= read_buffer
+ read_buffer_size
;
2524 end_of_file_error ();
2528 if (! SINGLE_BYTE_CHAR_P (c
))
2529 p
+= CHAR_STRING (c
, p
);
2538 int offset
= p
- read_buffer
;
2539 read_buffer
= (char *) xrealloc (read_buffer
,
2540 read_buffer_size
*= 2);
2541 p
= read_buffer
+ offset
;
2542 end
= read_buffer
+ read_buffer_size
;
2549 if (!quoted
&& !uninterned_symbol
)
2552 register Lisp_Object val
;
2554 if (*p1
== '+' || *p1
== '-') p1
++;
2555 /* Is it an integer? */
2558 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2559 /* Integers can have trailing decimal points. */
2560 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2562 /* It is an integer. */
2566 if (sizeof (int) == sizeof (EMACS_INT
))
2567 XSETINT (val
, atoi (read_buffer
));
2568 else if (sizeof (long) == sizeof (EMACS_INT
))
2569 XSETINT (val
, atol (read_buffer
));
2575 if (isfloat_string (read_buffer
))
2577 /* Compute NaN and infinities using 0.0 in a variable,
2578 to cope with compilers that think they are smarter
2584 /* Negate the value ourselves. This treats 0, NaNs,
2585 and infinity properly on IEEE floating point hosts,
2586 and works around a common bug where atof ("-0.0")
2588 int negative
= read_buffer
[0] == '-';
2590 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2591 returns 1, is if the input ends in e+INF or e+NaN. */
2598 value
= zero
/ zero
;
2601 value
= atof (read_buffer
+ negative
);
2605 return make_float (negative
? - value
: value
);
2609 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2610 : intern (read_buffer
);
2611 if (EQ (Vread_with_symbol_positions
, Qt
)
2612 || EQ (Vread_with_symbol_positions
, readcharfun
))
2613 Vread_symbol_positions_list
=
2614 /* Kind of a hack; this will probably fail if characters
2615 in the symbol name were escaped. Not really a big
2617 Fcons (Fcons (result
,
2618 make_number (readchar_count
2619 - XFASTINT (Flength (Fsymbol_name (result
))))),
2620 Vread_symbol_positions_list
);
2628 /* List of nodes we've seen during substitute_object_in_subtree. */
2629 static Lisp_Object seen_list
;
2632 substitute_object_in_subtree (object
, placeholder
)
2634 Lisp_Object placeholder
;
2636 Lisp_Object check_object
;
2638 /* We haven't seen any objects when we start. */
2641 /* Make all the substitutions. */
2643 = substitute_object_recurse (object
, placeholder
, object
);
2645 /* Clear seen_list because we're done with it. */
2648 /* The returned object here is expected to always eq the
2650 if (!EQ (check_object
, object
))
2651 error ("Unexpected mutation error in reader");
2654 /* Feval doesn't get called from here, so no gc protection is needed. */
2655 #define SUBSTITUTE(get_val, set_val) \
2657 Lisp_Object old_value = get_val; \
2658 Lisp_Object true_value \
2659 = substitute_object_recurse (object, placeholder,\
2662 if (!EQ (old_value, true_value)) \
2669 substitute_object_recurse (object
, placeholder
, subtree
)
2671 Lisp_Object placeholder
;
2672 Lisp_Object subtree
;
2674 /* If we find the placeholder, return the target object. */
2675 if (EQ (placeholder
, subtree
))
2678 /* If we've been to this node before, don't explore it again. */
2679 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2682 /* If this node can be the entry point to a cycle, remember that
2683 we've seen it. It can only be such an entry point if it was made
2684 by #n=, which means that we can find it as a value in
2686 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2687 seen_list
= Fcons (subtree
, seen_list
);
2689 /* Recurse according to subtree's type.
2690 Every branch must return a Lisp_Object. */
2691 switch (XTYPE (subtree
))
2693 case Lisp_Vectorlike
:
2696 int length
= XINT (Flength(subtree
));
2697 for (i
= 0; i
< length
; i
++)
2699 Lisp_Object idx
= make_number (i
);
2700 SUBSTITUTE (Faref (subtree
, idx
),
2701 Faset (subtree
, idx
, true_value
));
2708 SUBSTITUTE (Fcar_safe (subtree
),
2709 Fsetcar (subtree
, true_value
));
2710 SUBSTITUTE (Fcdr_safe (subtree
),
2711 Fsetcdr (subtree
, true_value
));
2717 /* Check for text properties in each interval.
2718 substitute_in_interval contains part of the logic. */
2720 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2721 Lisp_Object arg
= Fcons (object
, placeholder
);
2723 traverse_intervals_noorder (root_interval
,
2724 &substitute_in_interval
, arg
);
2729 /* Other types don't recurse any further. */
2735 /* Helper function for substitute_object_recurse. */
2737 substitute_in_interval (interval
, arg
)
2741 Lisp_Object object
= Fcar (arg
);
2742 Lisp_Object placeholder
= Fcdr (arg
);
2744 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2763 if (*cp
== '+' || *cp
== '-')
2766 if (*cp
>= '0' && *cp
<= '9')
2769 while (*cp
>= '0' && *cp
<= '9')
2777 if (*cp
>= '0' && *cp
<= '9')
2780 while (*cp
>= '0' && *cp
<= '9')
2783 if (*cp
== 'e' || *cp
== 'E')
2787 if (*cp
== '+' || *cp
== '-')
2791 if (*cp
>= '0' && *cp
<= '9')
2794 while (*cp
>= '0' && *cp
<= '9')
2797 else if (cp
== start
)
2799 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2804 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2810 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2811 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2812 || state
== (DOT_CHAR
|TRAIL_INT
)
2813 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2814 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2815 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2820 read_vector (readcharfun
, bytecodeflag
)
2821 Lisp_Object readcharfun
;
2826 register Lisp_Object
*ptr
;
2827 register Lisp_Object tem
, item
, vector
;
2828 register struct Lisp_Cons
*otem
;
2831 tem
= read_list (1, readcharfun
);
2832 len
= Flength (tem
);
2833 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2835 size
= XVECTOR (vector
)->size
;
2836 ptr
= XVECTOR (vector
)->contents
;
2837 for (i
= 0; i
< size
; i
++)
2840 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2841 bytecode object, the docstring containing the bytecode and
2842 constants values must be treated as unibyte and passed to
2843 Fread, to get the actual bytecode string and constants vector. */
2844 if (bytecodeflag
&& load_force_doc_strings
)
2846 if (i
== COMPILED_BYTECODE
)
2848 if (!STRINGP (item
))
2849 error ("invalid byte code");
2851 /* Delay handling the bytecode slot until we know whether
2852 it is lazily-loaded (we can tell by whether the
2853 constants slot is nil). */
2854 ptr
[COMPILED_CONSTANTS
] = item
;
2857 else if (i
== COMPILED_CONSTANTS
)
2859 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2863 /* Coerce string to unibyte (like string-as-unibyte,
2864 but without generating extra garbage and
2865 guaranteeing no change in the contents). */
2866 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2867 STRING_SET_UNIBYTE (bytestr
);
2869 item
= Fread (bytestr
);
2871 error ("invalid byte code");
2873 otem
= XCONS (item
);
2874 bytestr
= XCAR (item
);
2879 /* Now handle the bytecode slot. */
2880 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2883 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2891 /* FLAG = 1 means check for ] to terminate rather than ) and .
2892 FLAG = -1 means check for starting with defun
2893 and make structure pure. */
2896 read_list (flag
, readcharfun
)
2898 register Lisp_Object readcharfun
;
2900 /* -1 means check next element for defun,
2901 0 means don't check,
2902 1 means already checked and found defun. */
2903 int defunflag
= flag
< 0 ? -1 : 0;
2904 Lisp_Object val
, tail
;
2905 register Lisp_Object elt
, tem
;
2906 struct gcpro gcpro1
, gcpro2
;
2907 /* 0 is the normal case.
2908 1 means this list is a doc reference; replace it with the number 0.
2909 2 means this list is a doc reference; replace it with the doc string. */
2910 int doc_reference
= 0;
2912 /* Initialize this to 1 if we are reading a list. */
2913 int first_in_list
= flag
<= 0;
2922 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2927 /* While building, if the list starts with #$, treat it specially. */
2928 if (EQ (elt
, Vload_file_name
)
2930 && !NILP (Vpurify_flag
))
2932 if (NILP (Vdoc_file_name
))
2933 /* We have not yet called Snarf-documentation, so assume
2934 this file is described in the DOC-MM.NN file
2935 and Snarf-documentation will fill in the right value later.
2936 For now, replace the whole list with 0. */
2939 /* We have already called Snarf-documentation, so make a relative
2940 file name for this file, so it can be found properly
2941 in the installed Lisp directory.
2942 We don't use Fexpand_file_name because that would make
2943 the directory absolute now. */
2944 elt
= concat2 (build_string ("../lisp/"),
2945 Ffile_name_nondirectory (elt
));
2947 else if (EQ (elt
, Vload_file_name
)
2949 && load_force_doc_strings
)
2958 Fsignal (Qinvalid_read_syntax
,
2959 Fcons (make_string (") or . in a vector", 18), Qnil
));
2967 XSETCDR (tail
, read0 (readcharfun
));
2969 val
= read0 (readcharfun
);
2970 read1 (readcharfun
, &ch
, 0);
2974 if (doc_reference
== 1)
2975 return make_number (0);
2976 if (doc_reference
== 2)
2978 /* Get a doc string from the file we are loading.
2979 If it's in saved_doc_string, get it from there. */
2980 int pos
= XINT (XCDR (val
));
2981 /* Position is negative for user variables. */
2982 if (pos
< 0) pos
= -pos
;
2983 if (pos
>= saved_doc_string_position
2984 && pos
< (saved_doc_string_position
2985 + saved_doc_string_length
))
2987 int start
= pos
- saved_doc_string_position
;
2990 /* Process quoting with ^A,
2991 and find the end of the string,
2992 which is marked with ^_ (037). */
2993 for (from
= start
, to
= start
;
2994 saved_doc_string
[from
] != 037;)
2996 int c
= saved_doc_string
[from
++];
2999 c
= saved_doc_string
[from
++];
3001 saved_doc_string
[to
++] = c
;
3003 saved_doc_string
[to
++] = 0;
3005 saved_doc_string
[to
++] = 037;
3008 saved_doc_string
[to
++] = c
;
3011 return make_string (saved_doc_string
+ start
,
3014 /* Look in prev_saved_doc_string the same way. */
3015 else if (pos
>= prev_saved_doc_string_position
3016 && pos
< (prev_saved_doc_string_position
3017 + prev_saved_doc_string_length
))
3019 int start
= pos
- prev_saved_doc_string_position
;
3022 /* Process quoting with ^A,
3023 and find the end of the string,
3024 which is marked with ^_ (037). */
3025 for (from
= start
, to
= start
;
3026 prev_saved_doc_string
[from
] != 037;)
3028 int c
= prev_saved_doc_string
[from
++];
3031 c
= prev_saved_doc_string
[from
++];
3033 prev_saved_doc_string
[to
++] = c
;
3035 prev_saved_doc_string
[to
++] = 0;
3037 prev_saved_doc_string
[to
++] = 037;
3040 prev_saved_doc_string
[to
++] = c
;
3043 return make_string (prev_saved_doc_string
+ start
,
3047 return get_doc_string (val
, 0, 0);
3052 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3054 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3056 tem
= (read_pure
&& flag
<= 0
3057 ? pure_cons (elt
, Qnil
)
3058 : Fcons (elt
, Qnil
));
3060 XSETCDR (tail
, tem
);
3065 defunflag
= EQ (elt
, Qdefun
);
3066 else if (defunflag
> 0)
3071 Lisp_Object Vobarray
;
3072 Lisp_Object initial_obarray
;
3074 /* oblookup stores the bucket number here, for the sake of Funintern. */
3076 int oblookup_last_bucket_number
;
3078 static int hash_string ();
3080 /* Get an error if OBARRAY is not an obarray.
3081 If it is one, return it. */
3084 check_obarray (obarray
)
3085 Lisp_Object obarray
;
3087 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3089 /* If Vobarray is now invalid, force it to be valid. */
3090 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3092 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3097 /* Intern the C string STR: return a symbol with that name,
3098 interned in the current obarray. */
3105 int len
= strlen (str
);
3106 Lisp_Object obarray
;
3109 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3110 obarray
= check_obarray (obarray
);
3111 tem
= oblookup (obarray
, str
, len
, len
);
3114 return Fintern (make_string (str
, len
), obarray
);
3117 /* Create an uninterned symbol with name STR. */
3123 int len
= strlen (str
);
3125 return Fmake_symbol ((!NILP (Vpurify_flag
)
3126 ? make_pure_string (str
, len
, len
, 0)
3127 : make_string (str
, len
)));
3130 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3131 doc
: /* Return the canonical symbol whose name is STRING.
3132 If there is none, one is created by this function and returned.
3133 A second optional argument specifies the obarray to use;
3134 it defaults to the value of `obarray'. */)
3136 Lisp_Object string
, obarray
;
3138 register Lisp_Object tem
, sym
, *ptr
;
3140 if (NILP (obarray
)) obarray
= Vobarray
;
3141 obarray
= check_obarray (obarray
);
3143 CHECK_STRING (string
);
3145 tem
= oblookup (obarray
, SDATA (string
),
3148 if (!INTEGERP (tem
))
3151 if (!NILP (Vpurify_flag
))
3152 string
= Fpurecopy (string
);
3153 sym
= Fmake_symbol (string
);
3155 if (EQ (obarray
, initial_obarray
))
3156 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3158 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3160 if ((SREF (string
, 0) == ':')
3161 && EQ (obarray
, initial_obarray
))
3163 XSYMBOL (sym
)->constant
= 1;
3164 XSYMBOL (sym
)->value
= sym
;
3167 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3169 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3171 XSYMBOL (sym
)->next
= 0;
3176 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3177 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3178 NAME may be a string or a symbol. If it is a symbol, that exact
3179 symbol is searched for.
3180 A second optional argument specifies the obarray to use;
3181 it defaults to the value of `obarray'. */)
3183 Lisp_Object name
, obarray
;
3185 register Lisp_Object tem
, string
;
3187 if (NILP (obarray
)) obarray
= Vobarray
;
3188 obarray
= check_obarray (obarray
);
3190 if (!SYMBOLP (name
))
3192 CHECK_STRING (name
);
3196 string
= SYMBOL_NAME (name
);
3198 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3199 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3205 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3206 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3207 The value is t if a symbol was found and deleted, nil otherwise.
3208 NAME may be a string or a symbol. If it is a symbol, that symbol
3209 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3210 OBARRAY defaults to the value of the variable `obarray'. */)
3212 Lisp_Object name
, obarray
;
3214 register Lisp_Object string
, tem
;
3217 if (NILP (obarray
)) obarray
= Vobarray
;
3218 obarray
= check_obarray (obarray
);
3221 string
= SYMBOL_NAME (name
);
3224 CHECK_STRING (name
);
3228 tem
= oblookup (obarray
, SDATA (string
),
3233 /* If arg was a symbol, don't delete anything but that symbol itself. */
3234 if (SYMBOLP (name
) && !EQ (name
, tem
))
3237 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3238 XSYMBOL (tem
)->constant
= 0;
3239 XSYMBOL (tem
)->indirect_variable
= 0;
3241 hash
= oblookup_last_bucket_number
;
3243 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3245 if (XSYMBOL (tem
)->next
)
3246 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3248 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3252 Lisp_Object tail
, following
;
3254 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3255 XSYMBOL (tail
)->next
;
3258 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3259 if (EQ (following
, tem
))
3261 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3270 /* Return the symbol in OBARRAY whose names matches the string
3271 of SIZE characters (SIZE_BYTE bytes) at PTR.
3272 If there is no such symbol in OBARRAY, return nil.
3274 Also store the bucket number in oblookup_last_bucket_number. */
3277 oblookup (obarray
, ptr
, size
, size_byte
)
3278 Lisp_Object obarray
;
3279 register const char *ptr
;
3280 int size
, size_byte
;
3284 register Lisp_Object tail
;
3285 Lisp_Object bucket
, tem
;
3287 if (!VECTORP (obarray
)
3288 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3290 obarray
= check_obarray (obarray
);
3291 obsize
= XVECTOR (obarray
)->size
;
3293 /* This is sometimes needed in the middle of GC. */
3294 obsize
&= ~ARRAY_MARK_FLAG
;
3295 /* Combining next two lines breaks VMS C 2.3. */
3296 hash
= hash_string (ptr
, size_byte
);
3298 bucket
= XVECTOR (obarray
)->contents
[hash
];
3299 oblookup_last_bucket_number
= hash
;
3300 if (EQ (bucket
, make_number (0)))
3302 else if (!SYMBOLP (bucket
))
3303 error ("Bad data in guts of obarray"); /* Like CADR error message */
3305 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3307 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3308 && SCHARS (SYMBOL_NAME (tail
)) == size
3309 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3311 else if (XSYMBOL (tail
)->next
== 0)
3314 XSETINT (tem
, hash
);
3319 hash_string (ptr
, len
)
3320 const unsigned char *ptr
;
3323 register const unsigned char *p
= ptr
;
3324 register const unsigned char *end
= p
+ len
;
3325 register unsigned char c
;
3326 register int hash
= 0;
3331 if (c
>= 0140) c
-= 40;
3332 hash
= ((hash
<<3) + (hash
>>28) + c
);
3334 return hash
& 07777777777;
3338 map_obarray (obarray
, fn
, arg
)
3339 Lisp_Object obarray
;
3340 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3344 register Lisp_Object tail
;
3345 CHECK_VECTOR (obarray
);
3346 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3348 tail
= XVECTOR (obarray
)->contents
[i
];
3353 if (XSYMBOL (tail
)->next
== 0)
3355 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3361 mapatoms_1 (sym
, function
)
3362 Lisp_Object sym
, function
;
3364 call1 (function
, sym
);
3367 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3368 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3369 OBARRAY defaults to the value of `obarray'. */)
3371 Lisp_Object function
, obarray
;
3373 if (NILP (obarray
)) obarray
= Vobarray
;
3374 obarray
= check_obarray (obarray
);
3376 map_obarray (obarray
, mapatoms_1
, function
);
3380 #define OBARRAY_SIZE 1511
3385 Lisp_Object oblength
;
3389 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3391 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3392 Vobarray
= Fmake_vector (oblength
, make_number (0));
3393 initial_obarray
= Vobarray
;
3394 staticpro (&initial_obarray
);
3395 /* Intern nil in the obarray */
3396 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3397 XSYMBOL (Qnil
)->constant
= 1;
3399 /* These locals are to kludge around a pyramid compiler bug. */
3400 hash
= hash_string ("nil", 3);
3401 /* Separate statement here to avoid VAXC bug. */
3402 hash
%= OBARRAY_SIZE
;
3403 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3406 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3407 XSYMBOL (Qnil
)->function
= Qunbound
;
3408 XSYMBOL (Qunbound
)->value
= Qunbound
;
3409 XSYMBOL (Qunbound
)->function
= Qunbound
;
3412 XSYMBOL (Qnil
)->value
= Qnil
;
3413 XSYMBOL (Qnil
)->plist
= Qnil
;
3414 XSYMBOL (Qt
)->value
= Qt
;
3415 XSYMBOL (Qt
)->constant
= 1;
3417 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3420 Qvariable_documentation
= intern ("variable-documentation");
3421 staticpro (&Qvariable_documentation
);
3423 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3424 read_buffer
= (char *) xmalloc (read_buffer_size
);
3429 struct Lisp_Subr
*sname
;
3432 sym
= intern (sname
->symbol_name
);
3433 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3436 #ifdef NOTDEF /* use fset in subr.el now */
3438 defalias (sname
, string
)
3439 struct Lisp_Subr
*sname
;
3443 sym
= intern (string
);
3444 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3448 /* Define an "integer variable"; a symbol whose value is forwarded
3449 to a C variable of type int. Sample call: */
3450 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3452 defvar_int (namestring
, address
)
3456 Lisp_Object sym
, val
;
3457 sym
= intern (namestring
);
3458 val
= allocate_misc ();
3459 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3460 XINTFWD (val
)->intvar
= address
;
3461 SET_SYMBOL_VALUE (sym
, val
);
3464 /* Similar but define a variable whose value is t if address contains 1,
3465 nil if address contains 0 */
3467 defvar_bool (namestring
, address
)
3471 Lisp_Object sym
, val
;
3472 sym
= intern (namestring
);
3473 val
= allocate_misc ();
3474 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3475 XBOOLFWD (val
)->boolvar
= address
;
3476 SET_SYMBOL_VALUE (sym
, val
);
3477 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3480 /* Similar but define a variable whose value is the Lisp Object stored
3481 at address. Two versions: with and without gc-marking of the C
3482 variable. The nopro version is used when that variable will be
3483 gc-marked for some other reason, since marking the same slot twice
3484 can cause trouble with strings. */
3486 defvar_lisp_nopro (namestring
, address
)
3488 Lisp_Object
*address
;
3490 Lisp_Object sym
, val
;
3491 sym
= intern (namestring
);
3492 val
= allocate_misc ();
3493 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3494 XOBJFWD (val
)->objvar
= address
;
3495 SET_SYMBOL_VALUE (sym
, val
);
3499 defvar_lisp (namestring
, address
)
3501 Lisp_Object
*address
;
3503 defvar_lisp_nopro (namestring
, address
);
3504 staticpro (address
);
3507 /* Similar but define a variable whose value is the Lisp Object stored in
3508 the current buffer. address is the address of the slot in the buffer
3509 that is current now. */
3512 defvar_per_buffer (namestring
, address
, type
, doc
)
3514 Lisp_Object
*address
;
3518 Lisp_Object sym
, val
;
3521 sym
= intern (namestring
);
3522 val
= allocate_misc ();
3523 offset
= (char *)address
- (char *)current_buffer
;
3525 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3526 XBUFFER_OBJFWD (val
)->offset
= offset
;
3527 SET_SYMBOL_VALUE (sym
, val
);
3528 PER_BUFFER_SYMBOL (offset
) = sym
;
3529 PER_BUFFER_TYPE (offset
) = type
;
3531 if (PER_BUFFER_IDX (offset
) == 0)
3532 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3533 slot of buffer_local_flags */
3538 /* Similar but define a variable whose value is the Lisp Object stored
3539 at a particular offset in the current kboard object. */
3542 defvar_kboard (namestring
, offset
)
3546 Lisp_Object sym
, val
;
3547 sym
= intern (namestring
);
3548 val
= allocate_misc ();
3549 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3550 XKBOARD_OBJFWD (val
)->offset
= offset
;
3551 SET_SYMBOL_VALUE (sym
, val
);
3554 /* Record the value of load-path used at the start of dumping
3555 so we can see if the site changed it later during dumping. */
3556 static Lisp_Object dump_path
;
3562 int turn_off_warning
= 0;
3564 /* Compute the default load-path. */
3566 normal
= PATH_LOADSEARCH
;
3567 Vload_path
= decode_env_path (0, normal
);
3569 if (NILP (Vpurify_flag
))
3570 normal
= PATH_LOADSEARCH
;
3572 normal
= PATH_DUMPLOADSEARCH
;
3574 /* In a dumped Emacs, we normally have to reset the value of
3575 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3576 uses ../lisp, instead of the path of the installed elisp
3577 libraries. However, if it appears that Vload_path was changed
3578 from the default before dumping, don't override that value. */
3581 if (! NILP (Fequal (dump_path
, Vload_path
)))
3583 Vload_path
= decode_env_path (0, normal
);
3584 if (!NILP (Vinstallation_directory
))
3586 Lisp_Object tem
, tem1
, sitelisp
;
3588 /* Remove site-lisp dirs from path temporarily and store
3589 them in sitelisp, then conc them on at the end so
3590 they're always first in path. */
3594 tem
= Fcar (Vload_path
);
3595 tem1
= Fstring_match (build_string ("site-lisp"),
3599 Vload_path
= Fcdr (Vload_path
);
3600 sitelisp
= Fcons (tem
, sitelisp
);
3606 /* Add to the path the lisp subdir of the
3607 installation dir, if it exists. */
3608 tem
= Fexpand_file_name (build_string ("lisp"),
3609 Vinstallation_directory
);
3610 tem1
= Ffile_exists_p (tem
);
3613 if (NILP (Fmember (tem
, Vload_path
)))
3615 turn_off_warning
= 1;
3616 Vload_path
= Fcons (tem
, Vload_path
);
3620 /* That dir doesn't exist, so add the build-time
3621 Lisp dirs instead. */
3622 Vload_path
= nconc2 (Vload_path
, dump_path
);
3624 /* Add leim under the installation dir, if it exists. */
3625 tem
= Fexpand_file_name (build_string ("leim"),
3626 Vinstallation_directory
);
3627 tem1
= Ffile_exists_p (tem
);
3630 if (NILP (Fmember (tem
, Vload_path
)))
3631 Vload_path
= Fcons (tem
, Vload_path
);
3634 /* Add site-list under the installation dir, if it exists. */
3635 tem
= Fexpand_file_name (build_string ("site-lisp"),
3636 Vinstallation_directory
);
3637 tem1
= Ffile_exists_p (tem
);
3640 if (NILP (Fmember (tem
, Vload_path
)))
3641 Vload_path
= Fcons (tem
, Vload_path
);
3644 /* If Emacs was not built in the source directory,
3645 and it is run from where it was built, add to load-path
3646 the lisp, leim and site-lisp dirs under that directory. */
3648 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3652 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3653 Vinstallation_directory
);
3654 tem1
= Ffile_exists_p (tem
);
3656 /* Don't be fooled if they moved the entire source tree
3657 AFTER dumping Emacs. If the build directory is indeed
3658 different from the source dir, src/Makefile.in and
3659 src/Makefile will not be found together. */
3660 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3661 Vinstallation_directory
);
3662 tem2
= Ffile_exists_p (tem
);
3663 if (!NILP (tem1
) && NILP (tem2
))
3665 tem
= Fexpand_file_name (build_string ("lisp"),
3668 if (NILP (Fmember (tem
, Vload_path
)))
3669 Vload_path
= Fcons (tem
, Vload_path
);
3671 tem
= Fexpand_file_name (build_string ("leim"),
3674 if (NILP (Fmember (tem
, Vload_path
)))
3675 Vload_path
= Fcons (tem
, Vload_path
);
3677 tem
= Fexpand_file_name (build_string ("site-lisp"),
3680 if (NILP (Fmember (tem
, Vload_path
)))
3681 Vload_path
= Fcons (tem
, Vload_path
);
3684 if (!NILP (sitelisp
))
3685 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3691 /* NORMAL refers to the lisp dir in the source directory. */
3692 /* We used to add ../lisp at the front here, but
3693 that caused trouble because it was copied from dump_path
3694 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3695 It should be unnecessary. */
3696 Vload_path
= decode_env_path (0, normal
);
3697 dump_path
= Vload_path
;
3701 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3702 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3703 almost never correct, thereby causing a warning to be printed out that
3704 confuses users. Since PATH_LOADSEARCH is always overridden by the
3705 EMACSLOADPATH environment variable below, disable the warning on NT.
3706 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3707 the "standard" paths may not exist and would be overridden by
3708 EMACSLOADPATH as on NT. Since this depends on how the executable
3709 was build and packaged, turn off the warnings in general */
3711 /* Warn if dirs in the *standard* path don't exist. */
3712 if (!turn_off_warning
)
3714 Lisp_Object path_tail
;
3716 for (path_tail
= Vload_path
;
3718 path_tail
= XCDR (path_tail
))
3720 Lisp_Object dirfile
;
3721 dirfile
= Fcar (path_tail
);
3722 if (STRINGP (dirfile
))
3724 dirfile
= Fdirectory_file_name (dirfile
);
3725 if (access (SDATA (dirfile
), 0) < 0)
3726 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3731 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3733 /* If the EMACSLOADPATH environment variable is set, use its value.
3734 This doesn't apply if we're dumping. */
3736 if (NILP (Vpurify_flag
)
3737 && egetenv ("EMACSLOADPATH"))
3739 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3743 load_in_progress
= 0;
3744 Vload_file_name
= Qnil
;
3746 load_descriptor_list
= Qnil
;
3748 Vstandard_input
= Qt
;
3749 Vloads_in_progress
= Qnil
;
3752 /* Print a warning, using format string FORMAT, that directory DIRNAME
3753 does not exist. Print it on stderr and put it in *Message*. */
3756 dir_warning (format
, dirname
)
3758 Lisp_Object dirname
;
3761 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3763 fprintf (stderr
, format
, SDATA (dirname
));
3764 sprintf (buffer
, format
, SDATA (dirname
));
3765 /* Don't log the warning before we've initialized!! */
3767 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3774 defsubr (&Sread_from_string
);
3776 defsubr (&Sintern_soft
);
3777 defsubr (&Sunintern
);
3779 defsubr (&Seval_buffer
);
3780 defsubr (&Seval_region
);
3781 defsubr (&Sread_char
);
3782 defsubr (&Sread_char_exclusive
);
3783 defsubr (&Sread_event
);
3784 defsubr (&Sget_file_char
);
3785 defsubr (&Smapatoms
);
3786 defsubr (&Slocate_file_internal
);
3788 DEFVAR_LISP ("obarray", &Vobarray
,
3789 doc
: /* Symbol table for use by `intern' and `read'.
3790 It is a vector whose length ought to be prime for best results.
3791 The vector's contents don't make sense if examined from Lisp programs;
3792 to find all the symbols in an obarray, use `mapatoms'. */);
3794 DEFVAR_LISP ("values", &Vvalues
,
3795 doc
: /* List of values of all expressions which were read, evaluated and printed.
3796 Order is reverse chronological. */);
3798 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3799 doc
: /* Stream for read to get input from.
3800 See documentation of `read' for possible values. */);
3801 Vstandard_input
= Qt
;
3803 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3804 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3806 If this variable is a buffer, then only forms read from that buffer
3807 will be added to `read-symbol-positions-list'.
3808 If this variable is t, then all read forms will be added.
3809 The effect of all other values other than nil are not currently
3810 defined, although they may be in the future.
3812 The positions are relative to the last call to `read' or
3813 `read-from-string'. It is probably a bad idea to set this variable at
3814 the toplevel; bind it instead. */);
3815 Vread_with_symbol_positions
= Qnil
;
3817 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3818 doc
: /* A list mapping read symbols to their positions.
3819 This variable is modified during calls to `read' or
3820 `read-from-string', but only when `read-with-symbol-positions' is
3823 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3824 CHAR-POSITION is an integer giving the offset of that occurrence of the
3825 symbol from the position where `read' or `read-from-string' started.
3827 Note that a symbol will appear multiple times in this list, if it was
3828 read multiple times. The list is in the same order as the symbols
3830 Vread_symbol_positions_list
= Qnil
;
3832 DEFVAR_LISP ("load-path", &Vload_path
,
3833 doc
: /* *List of directories to search for files to load.
3834 Each element is a string (directory name) or nil (try default directory).
3835 Initialized based on EMACSLOADPATH environment variable, if any,
3836 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3838 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3839 doc
: /* *List of suffixes to try for files to load.
3840 This list should not include the empty string. */);
3841 Vload_suffixes
= Fcons (build_string (".elc"),
3842 Fcons (build_string (".el"), Qnil
));
3843 /* We don't use empty_string because it's not initialized yet. */
3844 default_suffixes
= Fcons (build_string (""), Qnil
);
3845 staticpro (&default_suffixes
);
3847 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3848 doc
: /* Non-nil iff inside of `load'. */);
3850 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3851 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3852 Each element looks like (FILENAME FORMS...).
3853 When `load' is run and the file-name argument is FILENAME,
3854 the FORMS in the corresponding element are executed at the end of loading.
3856 FILENAME must match exactly! Normally FILENAME is the name of a library,
3857 with no directory specified, since that is how `load' is normally called.
3858 An error in FORMS does not undo the load,
3859 but does prevent execution of the rest of the FORMS.
3860 FILENAME can also be a symbol (a feature) and FORMS are then executed
3861 when the corresponding call to `provide' is made. */);
3862 Vafter_load_alist
= Qnil
;
3864 DEFVAR_LISP ("load-history", &Vload_history
,
3865 doc
: /* Alist mapping source file names to symbols and features.
3866 Each alist element is a list that starts with a file name,
3867 except for one element (optional) that starts with nil and describes
3868 definitions evaluated from buffers not visiting files.
3869 The remaining elements of each list are symbols defined as variables
3870 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3871 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3872 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3873 and means that SYMBOL was an autoload before this file redefined it
3875 Vload_history
= Qnil
;
3877 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3878 doc
: /* Full name of file being loaded by `load'. */);
3879 Vload_file_name
= Qnil
;
3881 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3882 doc
: /* File name, including directory, of user's initialization file.
3883 If the file loaded had extension `.elc', and the corresponding source file
3884 exists, this variable contains the name of source file, suitable for use
3885 by functions like `custom-save-all' which edit the init file. */);
3886 Vuser_init_file
= Qnil
;
3888 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3889 doc
: /* Used for internal purposes by `load'. */);
3890 Vcurrent_load_list
= Qnil
;
3892 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3893 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3894 The default is nil, which means use the function `read'. */);
3895 Vload_read_function
= Qnil
;
3897 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3898 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3899 This function is for doing code conversion before reading the source file.
3900 If nil, loading is done without any code conversion.
3901 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3902 FULLNAME is the full name of FILE.
3903 See `load' for the meaning of the remaining arguments. */);
3904 Vload_source_file_function
= Qnil
;
3906 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3907 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3908 This is useful when the file being loaded is a temporary copy. */);
3909 load_force_doc_strings
= 0;
3911 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3912 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3913 This is normally bound by `load' and `eval-buffer' to control `read',
3914 and is not meant for users to change. */);
3915 load_convert_to_unibyte
= 0;
3917 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3918 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3919 You cannot count on them to still be there! */);
3921 = Fexpand_file_name (build_string ("../"),
3922 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3924 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3925 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3926 Vpreloaded_file_list
= Qnil
;
3928 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3929 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3930 Vbyte_boolean_vars
= Qnil
;
3932 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3933 doc
: /* Non-nil means load dangerous compiled Lisp files.
3934 Some versions of XEmacs use different byte codes than Emacs. These
3935 incompatible byte codes can make Emacs crash when it tries to execute
3937 load_dangerous_libraries
= 0;
3939 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3940 doc
: /* Regular expression matching safe to load compiled Lisp files.
3941 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3942 from the file, and matches them against this regular expression.
3943 When the regular expression matches, the file is considered to be safe
3944 to load. See also `load-dangerous-libraries'. */);
3945 Vbytecomp_version_regexp
3946 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3948 /* Vsource_directory was initialized in init_lread. */
3950 load_descriptor_list
= Qnil
;
3951 staticpro (&load_descriptor_list
);
3953 Qcurrent_load_list
= intern ("current-load-list");
3954 staticpro (&Qcurrent_load_list
);
3956 Qstandard_input
= intern ("standard-input");
3957 staticpro (&Qstandard_input
);
3959 Qread_char
= intern ("read-char");
3960 staticpro (&Qread_char
);
3962 Qget_file_char
= intern ("get-file-char");
3963 staticpro (&Qget_file_char
);
3965 Qbackquote
= intern ("`");
3966 staticpro (&Qbackquote
);
3967 Qcomma
= intern (",");
3968 staticpro (&Qcomma
);
3969 Qcomma_at
= intern (",@");
3970 staticpro (&Qcomma_at
);
3971 Qcomma_dot
= intern (",.");
3972 staticpro (&Qcomma_dot
);
3974 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3975 staticpro (&Qinhibit_file_name_operation
);
3977 Qascii_character
= intern ("ascii-character");
3978 staticpro (&Qascii_character
);
3980 Qfunction
= intern ("function");
3981 staticpro (&Qfunction
);
3983 Qload
= intern ("load");
3986 Qload_file_name
= intern ("load-file-name");
3987 staticpro (&Qload_file_name
);
3989 staticpro (&dump_path
);
3991 staticpro (&read_objects
);
3992 read_objects
= Qnil
;
3993 staticpro (&seen_list
);
3995 Vloads_in_progress
= Qnil
;
3996 staticpro (&Vloads_in_progress
);
3999 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4000 (do not change this comment) */