1 /* Lisp parsing and input streams.
2 Copyright (C) 1985,86,87,88,89,93,94,95,97,98,99,2000,01,03,2004
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
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 if 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 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
212 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
215 /* Handle unreading and rereading of characters.
216 Write READCHAR to read a character,
217 UNREAD(c) to unread c to be read again.
219 The READCHAR and UNREAD macros are meant for reading/unreading a
220 byte code; they do not handle multibyte characters. The caller
221 should manage them if necessary.
223 [ Actually that seems to be a lie; READCHAR will definitely read
224 multibyte characters from buffer sources, at least. Is the
225 comment just out of date?
226 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
229 #define READCHAR readchar (readcharfun)
230 #define UNREAD(c) unreadchar (readcharfun, c)
233 readchar (readcharfun
)
234 Lisp_Object readcharfun
;
241 if (BUFFERP (readcharfun
))
243 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
245 int pt_byte
= BUF_PT_BYTE (inbuffer
);
246 int orig_pt_byte
= pt_byte
;
248 if (readchar_backlog
> 0)
249 /* We get the address of the byte just passed,
250 which is the last byte of the character.
251 The other bytes in this character are consecutive with it,
252 because the gap can't be in the middle of a character. */
253 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
254 - --readchar_backlog
);
256 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
259 readchar_backlog
= -1;
261 if (! NILP (inbuffer
->enable_multibyte_characters
))
263 /* Fetch the character code from the buffer. */
264 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
265 BUF_INC_POS (inbuffer
, pt_byte
);
266 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
270 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
273 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
277 if (MARKERP (readcharfun
))
279 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
281 int bytepos
= marker_byte_position (readcharfun
);
282 int orig_bytepos
= bytepos
;
284 if (readchar_backlog
> 0)
285 /* We get the address of the byte just passed,
286 which is the last byte of the character.
287 The other bytes in this character are consecutive with it,
288 because the gap can't be in the middle of a character. */
289 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
290 - --readchar_backlog
);
292 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
295 readchar_backlog
= -1;
297 if (! NILP (inbuffer
->enable_multibyte_characters
))
299 /* Fetch the character code from the buffer. */
300 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
301 BUF_INC_POS (inbuffer
, bytepos
);
302 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
306 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
310 XMARKER (readcharfun
)->bytepos
= bytepos
;
311 XMARKER (readcharfun
)->charpos
++;
316 if (EQ (readcharfun
, Qlambda
))
317 return read_bytecode_char (0);
319 if (EQ (readcharfun
, Qget_file_char
))
323 /* Interrupted reads have been observed while reading over the network */
324 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
333 if (STRINGP (readcharfun
))
335 if (read_from_string_index
>= read_from_string_limit
)
338 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
339 read_from_string_index
,
340 read_from_string_index_byte
);
345 tem
= call0 (readcharfun
);
352 /* Unread the character C in the way appropriate for the stream READCHARFUN.
353 If the stream is a user function, call it with the char as argument. */
356 unreadchar (readcharfun
, c
)
357 Lisp_Object readcharfun
;
362 /* Don't back up the pointer if we're unreading the end-of-input mark,
363 since readchar didn't advance it when we read it. */
365 else if (BUFFERP (readcharfun
))
367 struct buffer
*b
= XBUFFER (readcharfun
);
368 int bytepos
= BUF_PT_BYTE (b
);
370 if (readchar_backlog
>= 0)
375 if (! NILP (b
->enable_multibyte_characters
))
376 BUF_DEC_POS (b
, bytepos
);
380 BUF_PT_BYTE (b
) = bytepos
;
383 else if (MARKERP (readcharfun
))
385 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
386 int bytepos
= XMARKER (readcharfun
)->bytepos
;
388 if (readchar_backlog
>= 0)
392 XMARKER (readcharfun
)->charpos
--;
393 if (! NILP (b
->enable_multibyte_characters
))
394 BUF_DEC_POS (b
, bytepos
);
398 XMARKER (readcharfun
)->bytepos
= bytepos
;
401 else if (STRINGP (readcharfun
))
403 read_from_string_index
--;
404 read_from_string_index_byte
405 = string_char_to_byte (readcharfun
, read_from_string_index
);
407 else if (EQ (readcharfun
, Qlambda
))
408 read_bytecode_char (1);
409 else if (EQ (readcharfun
, Qget_file_char
))
410 ungetc (c
, instream
);
412 call1 (readcharfun
, make_number (c
));
415 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
417 static Lisp_Object read0
P_ ((Lisp_Object
));
418 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
420 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
421 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
422 static int read_multibyte
P_ ((int, Lisp_Object
));
424 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
426 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
428 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
431 /* Get a character from the tty. */
433 extern Lisp_Object
read_char ();
435 /* Read input events until we get one that's acceptable for our purposes.
437 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
438 until we get a character we like, and then stuffed into
441 If ASCII_REQUIRED is non-zero, we check function key events to see
442 if the unmodified version of the symbol has a Qascii_character
443 property, and use that character, if present.
445 If ERROR_NONASCII is non-zero, we signal an error if the input we
446 get isn't an ASCII character with modifiers. If it's zero but
447 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
450 If INPUT_METHOD is nonzero, we invoke the current input method
451 if the character warrants that. */
454 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
456 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
458 register Lisp_Object val
, delayed_switch_frame
;
460 #ifdef HAVE_WINDOW_SYSTEM
461 if (display_hourglass_p
)
465 delayed_switch_frame
= Qnil
;
467 /* Read until we get an acceptable event. */
469 val
= read_char (0, 0, 0,
470 (input_method
? Qnil
: Qt
),
476 /* switch-frame events are put off until after the next ASCII
477 character. This is better than signaling an error just because
478 the last characters were typed to a separate minibuffer frame,
479 for example. Eventually, some code which can deal with
480 switch-frame events will read it and process it. */
482 && EVENT_HAS_PARAMETERS (val
)
483 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
485 delayed_switch_frame
= val
;
491 /* Convert certain symbols to their ASCII equivalents. */
494 Lisp_Object tem
, tem1
;
495 tem
= Fget (val
, Qevent_symbol_element_mask
);
498 tem1
= Fget (Fcar (tem
), Qascii_character
);
499 /* Merge this symbol's modifier bits
500 with the ASCII equivalent of its basic code. */
502 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
506 /* If we don't have a character now, deal with it appropriately. */
511 Vunread_command_events
= Fcons (val
, Qnil
);
512 error ("Non-character input-event");
519 if (! NILP (delayed_switch_frame
))
520 unread_switch_frame
= delayed_switch_frame
;
524 #ifdef HAVE_WINDOW_SYSTEM
525 if (display_hourglass_p
)
534 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
535 doc
: /* Read a character from the command input (keyboard or macro).
536 It is returned as a number.
537 If the user generates an event which is not a character (i.e. a mouse
538 click or function key event), `read-char' signals an error. As an
539 exception, switch-frame events are put off until non-ASCII events can
541 If you want to read non-character events, or ignore them, call
542 `read-event' or `read-char-exclusive' instead.
544 If the optional argument PROMPT is non-nil, display that as a prompt.
545 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
546 input method is turned on in the current buffer, that input method
547 is used for reading a character. */)
548 (prompt
, inherit_input_method
)
549 Lisp_Object prompt
, inherit_input_method
;
552 message_with_string ("%s", prompt
, 0);
553 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
556 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
557 doc
: /* Read an event object from the input stream.
558 If the optional argument PROMPT is non-nil, display that as a prompt.
559 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
560 input method is turned on in the current buffer, that input method
561 is used for reading a character. */)
562 (prompt
, inherit_input_method
)
563 Lisp_Object prompt
, inherit_input_method
;
566 message_with_string ("%s", prompt
, 0);
567 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
570 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
571 doc
: /* Read a character from the command input (keyboard or macro).
572 It is returned as a number. Non-character events are ignored.
574 If the optional argument PROMPT is non-nil, display that as a prompt.
575 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
576 input method is turned on in the current buffer, that input method
577 is used for reading a character. */)
578 (prompt
, inherit_input_method
)
579 Lisp_Object prompt
, inherit_input_method
;
582 message_with_string ("%s", prompt
, 0);
583 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
586 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
587 doc
: /* Don't use this yourself. */)
590 register Lisp_Object val
;
591 XSETINT (val
, getc (instream
));
597 /* Value is non-zero if the file asswociated with file descriptor FD
598 is a compiled Lisp file that's safe to load. Only files compiled
599 with Emacs are safe to load. Files compiled with XEmacs can lead
600 to a crash in Fbyte_code because of an incompatible change in the
611 /* Read the first few bytes from the file, and look for a line
612 specifying the byte compiler version used. */
613 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
618 /* Skip to the next newline, skipping over the initial `ELC'
619 with NUL bytes following it. */
620 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
624 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
629 lseek (fd
, 0, SEEK_SET
);
634 /* Callback for record_unwind_protect. Restore the old load list OLD,
635 after loading a file successfully. */
638 record_load_unwind (old
)
641 return Vloads_in_progress
= old
;
644 /* This handler function is used via internal_condition_case_1. */
647 load_error_handler (data
)
653 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
654 doc
: /* Execute a file of Lisp code named FILE.
655 First try FILE with `.elc' appended, then try with `.el',
656 then try FILE unmodified (the exact suffixes are determined by
657 `load-suffixes'). Environment variable references in FILE
658 are replaced with their values by calling `substitute-in-file-name'.
659 This function searches the directories in `load-path'.
660 If optional second arg NOERROR is non-nil,
661 report no error if FILE doesn't exist.
662 Print messages at start and end of loading unless
663 optional third arg NOMESSAGE is non-nil.
664 If optional fourth arg NOSUFFIX is non-nil, don't try adding
665 suffixes `.elc' or `.el' to the specified name FILE.
666 If optional fifth arg MUST-SUFFIX is non-nil, insist on
667 the suffix `.elc' or `.el'; don't accept just FILE unless
668 it ends in one of those suffixes or includes a directory name.
669 Return t if file exists. */)
670 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
671 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
673 register FILE *stream
;
674 register int fd
= -1;
675 register Lisp_Object lispstream
;
676 int count
= SPECPDL_INDEX ();
679 Lisp_Object found
, efound
;
680 /* 1 means we printed the ".el is newer" message. */
682 /* 1 means we are loading a compiled file. */
693 /* If file name is magic, call the handler. */
694 /* This shouldn't be necessary any more now that `openp' handles it right.
695 handler = Ffind_file_name_handler (file, Qload);
697 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
699 /* Do this after the handler to avoid
700 the need to gcpro noerror, nomessage and nosuffix.
701 (Below here, we care only whether they are nil or not.)
702 The presence of this call is the result of a historical accident:
703 it used to be in every file-operations and when it got removed
704 everywhere, it accidentally stayed here. Since then, enough people
705 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
706 that it seemed risky to remove. */
707 if (! NILP (noerror
))
709 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
710 Qt
, load_error_handler
);
715 file
= Fsubstitute_in_file_name (file
);
718 /* Avoid weird lossage with null string as arg,
719 since it would try to load a directory as a Lisp file */
720 if (SCHARS (file
) > 0)
722 int size
= SBYTES (file
);
727 if (! NILP (must_suffix
))
729 /* Don't insist on adding a suffix if FILE already ends with one. */
731 && !strcmp (SDATA (file
) + size
- 3, ".el"))
734 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
736 /* Don't insist on adding a suffix
737 if the argument includes a directory name. */
738 else if (! NILP (Ffile_name_directory (file
)))
742 fd
= openp (Vload_path
, file
,
743 (!NILP (nosuffix
) ? Qnil
744 : !NILP (must_suffix
) ? Vload_suffixes
745 : Fappend (2, (tmp
[0] = Vload_suffixes
,
746 tmp
[1] = default_suffixes
,
755 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
756 Fcons (file
, Qnil
)));
761 /* Tell startup.el whether or not we found the user's init file. */
762 if (EQ (Qt
, Vuser_init_file
))
763 Vuser_init_file
= found
;
765 /* If FD is -2, that means openp found a magic file. */
768 if (NILP (Fequal (found
, file
)))
769 /* If FOUND is a different file name from FILE,
770 find its handler even if we have already inhibited
771 the `load' operation on FILE. */
772 handler
= Ffind_file_name_handler (found
, Qt
);
774 handler
= Ffind_file_name_handler (found
, Qload
);
775 if (! NILP (handler
))
776 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
779 /* Check if we're stuck in a recursive load cycle.
781 2000-09-21: It's not possible to just check for the file loaded
782 being a member of Vloads_in_progress. This fails because of the
783 way the byte compiler currently works; `provide's are not
784 evaluted, see font-lock.el/jit-lock.el as an example. This
785 leads to a certain amount of ``normal'' recursion.
787 Also, just loading a file recursively is not always an error in
788 the general case; the second load may do something different. */
792 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
793 if (!NILP (Fequal (found
, XCAR (tem
))))
796 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
797 Fcons (found
, Vloads_in_progress
)));
798 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
799 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
802 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
804 /* Load .elc files directly, but not when they are
805 remote and have no handler! */
812 if (!safe_to_load_p (fd
))
815 if (!load_dangerous_libraries
)
819 error ("File `%s' was not compiled in Emacs",
822 else if (!NILP (nomessage
))
823 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
829 efound
= ENCODE_FILE (found
);
834 stat ((char *)SDATA (efound
), &s1
);
835 SSET (efound
, SBYTES (efound
) - 1, 0);
836 result
= stat ((char *)SDATA (efound
), &s2
);
837 SSET (efound
, SBYTES (efound
) - 1, 'c');
840 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
842 /* Make the progress messages mention that source is newer. */
845 /* If we won't print another message, mention this anyway. */
846 if (!NILP (nomessage
))
849 file
= Fsubstring (found
, make_number (0), make_number (-1));
850 message_with_string ("Source file `%s' newer than byte-compiled file",
858 /* We are loading a source file (*.el). */
859 if (!NILP (Vload_source_file_function
))
865 val
= call4 (Vload_source_file_function
, found
, file
,
866 NILP (noerror
) ? Qnil
: Qt
,
867 NILP (nomessage
) ? Qnil
: Qt
);
868 return unbind_to (count
, val
);
875 efound
= ENCODE_FILE (found
);
876 stream
= fopen ((char *) SDATA (efound
), fmode
);
878 #else /* not WINDOWSNT */
879 stream
= fdopen (fd
, fmode
);
880 #endif /* not WINDOWSNT */
884 error ("Failure to create stdio stream for %s", SDATA (file
));
887 if (! NILP (Vpurify_flag
))
888 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
890 if (NILP (nomessage
))
893 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
896 message_with_string ("Loading %s (source)...", file
, 1);
898 message_with_string ("Loading %s (compiled; note, source file is newer)...",
900 else /* The typical case; compiled file newer than source file. */
901 message_with_string ("Loading %s...", file
, 1);
905 lispstream
= Fcons (Qnil
, Qnil
);
906 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
907 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
908 record_unwind_protect (load_unwind
, lispstream
);
909 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
910 specbind (Qload_file_name
, found
);
911 specbind (Qinhibit_file_name_operation
, Qnil
);
913 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
915 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
916 unbind_to (count
, Qnil
);
918 /* Run any load-hooks for this file. */
919 temp
= Fassoc (file
, Vafter_load_alist
);
921 Fprogn (Fcdr (temp
));
924 if (saved_doc_string
)
925 free (saved_doc_string
);
926 saved_doc_string
= 0;
927 saved_doc_string_size
= 0;
929 if (prev_saved_doc_string
)
930 xfree (prev_saved_doc_string
);
931 prev_saved_doc_string
= 0;
932 prev_saved_doc_string_size
= 0;
934 if (!noninteractive
&& NILP (nomessage
))
937 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
940 message_with_string ("Loading %s (source)...done", file
, 1);
942 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
944 else /* The typical case; compiled file newer than source file. */
945 message_with_string ("Loading %s...done", file
, 1);
948 if (!NILP (Fequal (build_string ("obsolete"),
949 Ffile_name_nondirectory
950 (Fdirectory_file_name (Ffile_name_directory (found
))))))
951 message_with_string ("Package %s is obsolete", file
, 1);
957 load_unwind (stream
) /* used as unwind-protect function in load */
960 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
961 | XFASTINT (XCDR (stream
))));
962 if (--load_in_progress
< 0) load_in_progress
= 0;
967 load_descriptor_unwind (oldlist
)
970 load_descriptor_list
= oldlist
;
974 /* Close all descriptors in use for Floads.
975 This is used when starting a subprocess. */
982 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
983 emacs_close (XFASTINT (XCAR (tail
)));
988 complete_filename_p (pathname
)
989 Lisp_Object pathname
;
991 register const unsigned char *s
= SDATA (pathname
);
992 return (IS_DIRECTORY_SEP (s
[0])
993 || (SCHARS (pathname
) > 2
994 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1004 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1005 doc
: /* Search for FILENAME through PATH.
1006 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1007 file name when searching.
1008 If non-nil, PREDICATE is used instead of `file-readable-p'.
1009 PREDICATE can also be an integer to pass to the access(2) function,
1010 in which case file-name-handlers are ignored. */)
1011 (filename
, path
, suffixes
, predicate
)
1012 Lisp_Object filename
, path
, suffixes
, predicate
;
1015 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1016 if (NILP (predicate
) && fd
> 0)
1022 /* Search for a file whose name is STR, looking in directories
1023 in the Lisp list PATH, and trying suffixes from SUFFIX.
1024 On success, returns a file descriptor. On failure, returns -1.
1026 SUFFIXES is a list of strings containing possible suffixes.
1027 The empty suffix is automatically added iff the list is empty.
1029 PREDICATE non-nil means don't open the files,
1030 just look for one that satisfies the predicate. In this case,
1031 returns 1 on success. The predicate can be a lisp function or
1032 an integer to pass to `access' (in which case file-name-handlers
1035 If STOREPTR is nonzero, it points to a slot where the name of
1036 the file actually found should be stored as a Lisp string.
1037 nil is stored there on failure.
1039 If the file we find is remote, return -2
1040 but store the found remote file name in *STOREPTR. */
1043 openp (path
, str
, suffixes
, storeptr
, predicate
)
1044 Lisp_Object path
, str
;
1045 Lisp_Object suffixes
;
1046 Lisp_Object
*storeptr
;
1047 Lisp_Object predicate
;
1052 register char *fn
= buf
;
1055 Lisp_Object filename
;
1057 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1058 Lisp_Object string
, tail
, encoded_fn
;
1059 int max_suffix_len
= 0;
1063 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1065 CHECK_STRING_CAR (tail
);
1066 max_suffix_len
= max (max_suffix_len
,
1067 SBYTES (XCAR (tail
)));
1070 string
= filename
= Qnil
;
1071 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1076 if (complete_filename_p (str
))
1079 for (; CONSP (path
); path
= XCDR (path
))
1081 filename
= Fexpand_file_name (str
, XCAR (path
));
1082 if (!complete_filename_p (filename
))
1083 /* If there are non-absolute elts in PATH (eg ".") */
1084 /* Of course, this could conceivably lose if luser sets
1085 default-directory to be something non-absolute... */
1087 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1088 if (!complete_filename_p (filename
))
1089 /* Give up on this path element! */
1093 /* Calculate maximum size of any filename made from
1094 this path element/specified file name and any possible suffix. */
1095 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1096 if (fn_size
< want_size
)
1097 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1099 /* Loop over suffixes. */
1100 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1101 CONSP (tail
); tail
= XCDR (tail
))
1103 int lsuffix
= SBYTES (XCAR (tail
));
1104 Lisp_Object handler
;
1107 /* Concatenate path element/specified name with the suffix.
1108 If the directory starts with /:, remove that. */
1109 if (SCHARS (filename
) > 2
1110 && SREF (filename
, 0) == '/'
1111 && SREF (filename
, 1) == ':')
1113 strncpy (fn
, SDATA (filename
) + 2,
1114 SBYTES (filename
) - 2);
1115 fn
[SBYTES (filename
) - 2] = 0;
1119 strncpy (fn
, SDATA (filename
),
1121 fn
[SBYTES (filename
)] = 0;
1124 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1125 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1127 /* Check that the file exists and is not a directory. */
1128 /* We used to only check for handlers on non-absolute file names:
1132 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1133 It's not clear why that was the case and it breaks things like
1134 (load "/bar.el") where the file is actually "/bar.el.gz". */
1135 string
= build_string (fn
);
1136 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1137 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1139 if (NILP (predicate
))
1140 exists
= !NILP (Ffile_readable_p (string
));
1142 exists
= !NILP (call1 (predicate
, string
));
1143 if (exists
&& !NILP (Ffile_directory_p (string
)))
1148 /* We succeeded; return this descriptor and filename. */
1159 encoded_fn
= ENCODE_FILE (string
);
1160 pfn
= SDATA (encoded_fn
);
1161 exists
= (stat (pfn
, &st
) >= 0
1162 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1165 /* Check that we can access or open it. */
1166 if (NATNUMP (predicate
))
1167 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1169 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1173 /* We succeeded; return this descriptor and filename. */
1191 /* Merge the list we've accumulated of globals from the current input source
1192 into the load_history variable. The details depend on whether
1193 the source has an associated file name or not. */
1196 build_load_history (stream
, source
)
1200 register Lisp_Object tail
, prev
, newelt
;
1201 register Lisp_Object tem
, tem2
;
1202 register int foundit
, loading
;
1204 loading
= stream
|| !NARROWED
;
1206 tail
= Vload_history
;
1209 while (CONSP (tail
))
1213 /* Find the feature's previous assoc list... */
1214 if (!NILP (Fequal (source
, Fcar (tem
))))
1218 /* If we're loading, remove it. */
1222 Vload_history
= XCDR (tail
);
1224 Fsetcdr (prev
, XCDR (tail
));
1227 /* Otherwise, cons on new symbols that are not already members. */
1230 tem2
= Vcurrent_load_list
;
1232 while (CONSP (tem2
))
1234 newelt
= XCAR (tem2
);
1236 if (NILP (Fmember (newelt
, tem
)))
1237 Fsetcar (tail
, Fcons (XCAR (tem
),
1238 Fcons (newelt
, XCDR (tem
))));
1251 /* If we're loading, cons the new assoc onto the front of load-history,
1252 the most-recently-loaded position. Also do this if we didn't find
1253 an existing member for the current source. */
1254 if (loading
|| !foundit
)
1255 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1260 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1268 readevalloop_1 (old
)
1271 load_convert_to_unibyte
= ! NILP (old
);
1275 /* Signal an `end-of-file' error, if possible with file name
1279 end_of_file_error ()
1283 if (STRINGP (Vload_file_name
))
1284 data
= Fcons (Vload_file_name
, Qnil
);
1288 Fsignal (Qend_of_file
, data
);
1291 /* UNIBYTE specifies how to set load_convert_to_unibyte
1292 for this invocation.
1293 READFUN, if non-nil, is used instead of `read'. */
1296 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1297 Lisp_Object readcharfun
;
1299 Lisp_Object sourcename
;
1300 Lisp_Object (*evalfun
) ();
1302 Lisp_Object unibyte
, readfun
;
1305 register Lisp_Object val
;
1306 int count
= SPECPDL_INDEX ();
1307 struct gcpro gcpro1
;
1308 struct buffer
*b
= 0;
1309 int continue_reading_p
;
1311 if (BUFFERP (readcharfun
))
1312 b
= XBUFFER (readcharfun
);
1313 else if (MARKERP (readcharfun
))
1314 b
= XMARKER (readcharfun
)->buffer
;
1316 specbind (Qstandard_input
, readcharfun
);
1317 specbind (Qcurrent_load_list
, Qnil
);
1318 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1319 load_convert_to_unibyte
= !NILP (unibyte
);
1321 readchar_backlog
= -1;
1323 GCPRO1 (sourcename
);
1325 LOADHIST_ATTACH (sourcename
);
1327 continue_reading_p
= 1;
1328 while (continue_reading_p
)
1330 if (b
!= 0 && NILP (b
->name
))
1331 error ("Reading from killed buffer");
1337 while ((c
= READCHAR
) != '\n' && c
!= -1);
1342 /* Ignore whitespace here, so we can detect eof. */
1343 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1346 if (!NILP (Vpurify_flag
) && c
== '(')
1348 int count1
= SPECPDL_INDEX ();
1349 record_unwind_protect (unreadpure
, Qnil
);
1350 val
= read_list (-1, readcharfun
);
1351 unbind_to (count1
, Qnil
);
1356 read_objects
= Qnil
;
1357 if (!NILP (readfun
))
1359 val
= call1 (readfun
, readcharfun
);
1361 /* If READCHARFUN has set point to ZV, we should
1362 stop reading, even if the form read sets point
1363 to a different value when evaluated. */
1364 if (BUFFERP (readcharfun
))
1366 struct buffer
*b
= XBUFFER (readcharfun
);
1367 if (BUF_PT (b
) == BUF_ZV (b
))
1368 continue_reading_p
= 0;
1371 else if (! NILP (Vload_read_function
))
1372 val
= call1 (Vload_read_function
, readcharfun
);
1374 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1377 val
= (*evalfun
) (val
);
1381 Vvalues
= Fcons (val
, Vvalues
);
1382 if (EQ (Vstandard_output
, Qt
))
1389 build_load_history (stream
, sourcename
);
1392 unbind_to (count
, Qnil
);
1395 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1396 doc
: /* Execute the current buffer as Lisp code.
1397 Programs can pass two arguments, BUFFER and PRINTFLAG.
1398 BUFFER is the buffer to evaluate (nil means use current buffer).
1399 PRINTFLAG controls printing of output:
1400 nil means discard it; anything else is stream for print.
1402 If the optional third argument FILENAME is non-nil,
1403 it specifies the file name to use for `load-history'.
1404 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1405 for this invocation.
1407 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1408 `print' and related functions should work normally even if PRINTFLAG is nil.
1410 This function preserves the position of point. */)
1411 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1412 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1414 int count
= SPECPDL_INDEX ();
1415 Lisp_Object tem
, buf
;
1418 buf
= Fcurrent_buffer ();
1420 buf
= Fget_buffer (buffer
);
1422 error ("No such buffer");
1424 if (NILP (printflag
) && NILP (do_allow_print
))
1429 if (NILP (filename
))
1430 filename
= XBUFFER (buf
)->filename
;
1432 specbind (Qstandard_output
, tem
);
1433 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1434 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1435 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1436 unbind_to (count
, Qnil
);
1441 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1442 doc
: /* Execute the region as Lisp code.
1443 When called from programs, expects two arguments,
1444 giving starting and ending indices in the current buffer
1445 of the text to be executed.
1446 Programs can pass third argument PRINTFLAG which controls output:
1447 nil means discard it; anything else is stream for printing it.
1448 Also the fourth argument READ-FUNCTION, if non-nil, is used
1449 instead of `read' to read each expression. It gets one argument
1450 which is the input stream for reading characters.
1452 This function does not move point. */)
1453 (start
, end
, printflag
, read_function
)
1454 Lisp_Object start
, end
, printflag
, read_function
;
1456 int count
= SPECPDL_INDEX ();
1457 Lisp_Object tem
, cbuf
;
1459 cbuf
= Fcurrent_buffer ();
1461 if (NILP (printflag
))
1465 specbind (Qstandard_output
, tem
);
1467 if (NILP (printflag
))
1468 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1469 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1471 /* This both uses start and checks its type. */
1473 Fnarrow_to_region (make_number (BEGV
), end
);
1474 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1475 !NILP (printflag
), Qnil
, read_function
);
1477 return unbind_to (count
, Qnil
);
1481 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1482 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1483 If STREAM is nil, use the value of `standard-input' (which see).
1484 STREAM or the value of `standard-input' may be:
1485 a buffer (read from point and advance it)
1486 a marker (read from where it points and advance it)
1487 a function (call it with no arguments for each character,
1488 call it with a char as argument to push a char back)
1489 a string (takes text from string, starting at the beginning)
1490 t (read text line using minibuffer and use it, or read from
1491 standard input in batch mode). */)
1496 stream
= Vstandard_input
;
1497 if (EQ (stream
, Qt
))
1498 stream
= Qread_char
;
1499 if (EQ (stream
, Qread_char
))
1500 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1502 return read_internal_start (stream
, Qnil
, Qnil
);
1505 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1506 doc
: /* Read one Lisp expression which is represented as text by STRING.
1507 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1508 START and END optionally delimit a substring of STRING from which to read;
1509 they default to 0 and (length STRING) respectively. */)
1510 (string
, start
, end
)
1511 Lisp_Object string
, start
, end
;
1514 CHECK_STRING (string
);
1515 /* read_internal_start sets read_from_string_index. */
1516 ret
= read_internal_start (string
, start
, end
);
1517 return Fcons (ret
, make_number (read_from_string_index
));
1520 /* Function to set up the global context we need in toplevel read
1523 read_internal_start (stream
, start
, end
)
1525 Lisp_Object start
; /* Only used when stream is a string. */
1526 Lisp_Object end
; /* Only used when stream is a string. */
1530 readchar_backlog
= -1;
1532 new_backquote_flag
= 0;
1533 read_objects
= Qnil
;
1534 if (EQ (Vread_with_symbol_positions
, Qt
)
1535 || EQ (Vread_with_symbol_positions
, stream
))
1536 Vread_symbol_positions_list
= Qnil
;
1538 if (STRINGP (stream
))
1540 int startval
, endval
;
1542 endval
= SCHARS (stream
);
1546 endval
= XINT (end
);
1547 if (endval
< 0 || endval
> SCHARS (stream
))
1548 args_out_of_range (stream
, end
);
1555 CHECK_NUMBER (start
);
1556 startval
= XINT (start
);
1557 if (startval
< 0 || startval
> endval
)
1558 args_out_of_range (stream
, start
);
1560 read_from_string_index
= startval
;
1561 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1562 read_from_string_limit
= endval
;
1565 retval
= read0 (stream
);
1566 if (EQ (Vread_with_symbol_positions
, Qt
)
1567 || EQ (Vread_with_symbol_positions
, stream
))
1568 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1572 /* Use this for recursive reads, in contexts where internal tokens
1577 Lisp_Object readcharfun
;
1579 register Lisp_Object val
;
1582 val
= read1 (readcharfun
, &c
, 0);
1584 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1591 static int read_buffer_size
;
1592 static char *read_buffer
;
1594 /* Read multibyte form and return it as a character. C is a first
1595 byte of multibyte form, and rest of them are read from
1599 read_multibyte (c
, readcharfun
)
1601 Lisp_Object readcharfun
;
1603 /* We need the actual character code of this multibyte
1605 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1613 while ((c
= READCHAR
) >= 0xA0
1614 && len
< MAX_MULTIBYTE_LENGTH
)
1620 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1621 return STRING_CHAR (str
, len
);
1622 /* The byte sequence is not valid as multibyte. Unread all bytes
1623 but the first one, and return the first byte. */
1629 /* Read a \-escape sequence, assuming we already read the `\'.
1630 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1631 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1632 Otherwise store 0 into *BYTEREP. */
1635 read_escape (readcharfun
, stringp
, byterep
)
1636 Lisp_Object readcharfun
;
1640 register int c
= READCHAR
;
1647 end_of_file_error ();
1677 error ("Invalid escape character syntax");
1680 c
= read_escape (readcharfun
, 0, byterep
);
1681 return c
| meta_modifier
;
1686 error ("Invalid escape character syntax");
1689 c
= read_escape (readcharfun
, 0, byterep
);
1690 return c
| shift_modifier
;
1695 error ("Invalid escape character syntax");
1698 c
= read_escape (readcharfun
, 0, byterep
);
1699 return c
| hyper_modifier
;
1704 error ("Invalid escape character syntax");
1707 c
= read_escape (readcharfun
, 0, byterep
);
1708 return c
| alt_modifier
;
1720 c
= read_escape (readcharfun
, 0, byterep
);
1721 return c
| super_modifier
;
1726 error ("Invalid escape character syntax");
1730 c
= read_escape (readcharfun
, 0, byterep
);
1731 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1732 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1733 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1734 return c
| ctrl_modifier
;
1735 /* ASCII control chars are made from letters (both cases),
1736 as well as the non-letters within 0100...0137. */
1737 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1738 return (c
& (037 | ~0177));
1739 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1740 return (c
& (037 | ~0177));
1742 return c
| ctrl_modifier
;
1752 /* An octal escape, as in ANSI C. */
1754 register int i
= c
- '0';
1755 register int count
= 0;
1758 if ((c
= READCHAR
) >= '0' && c
<= '7')
1775 /* A hex escape, as in ANSI C. */
1781 if (c
>= '0' && c
<= '9')
1786 else if ((c
>= 'a' && c
<= 'f')
1787 || (c
>= 'A' && c
<= 'F'))
1790 if (c
>= 'a' && c
<= 'f')
1807 if (BASE_LEADING_CODE_P (c
))
1808 c
= read_multibyte (c
, readcharfun
);
1814 /* Read an integer in radix RADIX using READCHARFUN to read
1815 characters. RADIX must be in the interval [2..36]; if it isn't, a
1816 read error is signaled . Value is the integer read. Signals an
1817 error if encountering invalid read syntax or if RADIX is out of
1821 read_integer (readcharfun
, radix
)
1822 Lisp_Object readcharfun
;
1825 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1826 EMACS_INT number
= 0;
1828 if (radix
< 2 || radix
> 36)
1832 number
= ndigits
= invalid_p
= 0;
1848 if (c
>= '0' && c
<= '9')
1850 else if (c
>= 'a' && c
<= 'z')
1851 digit
= c
- 'a' + 10;
1852 else if (c
>= 'A' && c
<= 'Z')
1853 digit
= c
- 'A' + 10;
1860 if (digit
< 0 || digit
>= radix
)
1863 number
= radix
* number
+ digit
;
1869 if (ndigits
== 0 || invalid_p
)
1872 sprintf (buf
, "integer, radix %d", radix
);
1873 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1876 return make_number (sign
* number
);
1880 /* Convert unibyte text in read_buffer to multibyte.
1882 Initially, *P is a pointer after the end of the unibyte text, and
1883 the pointer *END points after the end of read_buffer.
1885 If read_buffer doesn't have enough room to hold the result
1886 of the conversion, reallocate it and adjust *P and *END.
1888 At the end, make *P point after the result of the conversion, and
1889 return in *NCHARS the number of characters in the converted
1893 to_multibyte (p
, end
, nchars
)
1899 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1900 if (read_buffer_size
< 2 * nbytes
)
1902 int offset
= *p
- read_buffer
;
1903 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1904 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1905 *p
= read_buffer
+ offset
;
1906 *end
= read_buffer
+ read_buffer_size
;
1909 if (nbytes
!= *nchars
)
1910 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1911 *p
- read_buffer
, nchars
);
1913 *p
= read_buffer
+ nbytes
;
1917 /* If the next token is ')' or ']' or '.', we store that character
1918 in *PCH and the return value is not interesting. Else, we store
1919 zero in *PCH and we read and return one lisp object.
1921 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1924 read1 (readcharfun
, pch
, first_in_list
)
1925 register Lisp_Object readcharfun
;
1930 int uninterned_symbol
= 0;
1938 end_of_file_error ();
1943 return read_list (0, readcharfun
);
1946 return read_vector (readcharfun
, 0);
1963 tmp
= read_vector (readcharfun
, 0);
1964 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1965 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1966 error ("Invalid size char-table");
1967 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1968 XCHAR_TABLE (tmp
)->top
= Qt
;
1977 tmp
= read_vector (readcharfun
, 0);
1978 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1979 error ("Invalid size char-table");
1980 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1981 XCHAR_TABLE (tmp
)->top
= Qnil
;
1984 Fsignal (Qinvalid_read_syntax
,
1985 Fcons (make_string ("#^^", 3), Qnil
));
1987 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1992 length
= read1 (readcharfun
, pch
, first_in_list
);
1996 Lisp_Object tmp
, val
;
1997 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
2001 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2002 if (size_in_chars
!= SCHARS (tmp
)
2003 /* We used to print 1 char too many
2004 when the number of bits was a multiple of 8.
2005 Accept such input in case it came from an old version. */
2006 && ! (XFASTINT (length
)
2007 == (SCHARS (tmp
) - 1) * BITS_PER_CHAR
))
2008 Fsignal (Qinvalid_read_syntax
,
2009 Fcons (make_string ("#&...", 5), Qnil
));
2011 val
= Fmake_bool_vector (length
, Qnil
);
2012 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2014 /* Clear the extraneous bits in the last byte. */
2015 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
2016 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2017 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
2020 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2025 /* Accept compiled functions at read-time so that we don't have to
2026 build them using function calls. */
2028 tmp
= read_vector (readcharfun
, 1);
2029 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2030 XVECTOR (tmp
)->contents
);
2035 struct gcpro gcpro1
;
2038 /* Read the string itself. */
2039 tmp
= read1 (readcharfun
, &ch
, 0);
2040 if (ch
!= 0 || !STRINGP (tmp
))
2041 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2043 /* Read the intervals and their properties. */
2046 Lisp_Object beg
, end
, plist
;
2048 beg
= read1 (readcharfun
, &ch
, 0);
2053 end
= read1 (readcharfun
, &ch
, 0);
2055 plist
= read1 (readcharfun
, &ch
, 0);
2057 Fsignal (Qinvalid_read_syntax
,
2058 Fcons (build_string ("invalid string property list"),
2060 Fset_text_properties (beg
, end
, plist
, tmp
);
2066 /* #@NUMBER is used to skip NUMBER following characters.
2067 That's used in .elc files to skip over doc strings
2068 and function definitions. */
2073 /* Read a decimal integer. */
2074 while ((c
= READCHAR
) >= 0
2075 && c
>= '0' && c
<= '9')
2083 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2085 /* If we are supposed to force doc strings into core right now,
2086 record the last string that we skipped,
2087 and record where in the file it comes from. */
2089 /* But first exchange saved_doc_string
2090 with prev_saved_doc_string, so we save two strings. */
2092 char *temp
= saved_doc_string
;
2093 int temp_size
= saved_doc_string_size
;
2094 file_offset temp_pos
= saved_doc_string_position
;
2095 int temp_len
= saved_doc_string_length
;
2097 saved_doc_string
= prev_saved_doc_string
;
2098 saved_doc_string_size
= prev_saved_doc_string_size
;
2099 saved_doc_string_position
= prev_saved_doc_string_position
;
2100 saved_doc_string_length
= prev_saved_doc_string_length
;
2102 prev_saved_doc_string
= temp
;
2103 prev_saved_doc_string_size
= temp_size
;
2104 prev_saved_doc_string_position
= temp_pos
;
2105 prev_saved_doc_string_length
= temp_len
;
2108 if (saved_doc_string_size
== 0)
2110 saved_doc_string_size
= nskip
+ 100;
2111 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2113 if (nskip
> saved_doc_string_size
)
2115 saved_doc_string_size
= nskip
+ 100;
2116 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2117 saved_doc_string_size
);
2120 saved_doc_string_position
= file_tell (instream
);
2122 /* Copy that many characters into saved_doc_string. */
2123 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2124 saved_doc_string
[i
] = c
= READCHAR
;
2126 saved_doc_string_length
= i
;
2130 /* Skip that many characters. */
2131 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2139 /* #! appears at the beginning of an executable file.
2140 Skip the first line. */
2141 while (c
!= '\n' && c
>= 0)
2146 return Vload_file_name
;
2148 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2149 /* #:foo is the uninterned symbol named foo. */
2152 uninterned_symbol
= 1;
2156 /* Reader forms that can reuse previously read objects. */
2157 if (c
>= '0' && c
<= '9')
2162 /* Read a non-negative integer. */
2163 while (c
>= '0' && c
<= '9')
2169 /* #n=object returns object, but associates it with n for #n#. */
2172 /* Make a placeholder for #n# to use temporarily */
2173 Lisp_Object placeholder
;
2176 placeholder
= Fcons(Qnil
, Qnil
);
2177 cell
= Fcons (make_number (n
), placeholder
);
2178 read_objects
= Fcons (cell
, read_objects
);
2180 /* Read the object itself. */
2181 tem
= read0 (readcharfun
);
2183 /* Now put it everywhere the placeholder was... */
2184 substitute_object_in_subtree (tem
, placeholder
);
2186 /* ...and #n# will use the real value from now on. */
2187 Fsetcdr (cell
, tem
);
2191 /* #n# returns a previously read object. */
2194 tem
= Fassq (make_number (n
), read_objects
);
2197 /* Fall through to error message. */
2199 else if (c
== 'r' || c
== 'R')
2200 return read_integer (readcharfun
, n
);
2202 /* Fall through to error message. */
2204 else if (c
== 'x' || c
== 'X')
2205 return read_integer (readcharfun
, 16);
2206 else if (c
== 'o' || c
== 'O')
2207 return read_integer (readcharfun
, 8);
2208 else if (c
== 'b' || c
== 'B')
2209 return read_integer (readcharfun
, 2);
2212 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2215 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2220 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2230 new_backquote_flag
++;
2231 value
= read0 (readcharfun
);
2232 new_backquote_flag
--;
2234 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2238 if (new_backquote_flag
)
2240 Lisp_Object comma_type
= Qnil
;
2245 comma_type
= Qcomma_at
;
2247 comma_type
= Qcomma_dot
;
2250 if (ch
>= 0) UNREAD (ch
);
2251 comma_type
= Qcomma
;
2254 new_backquote_flag
--;
2255 value
= read0 (readcharfun
);
2256 new_backquote_flag
++;
2257 return Fcons (comma_type
, Fcons (value
, Qnil
));
2270 end_of_file_error ();
2272 /* Accept `single space' syntax like (list ? x) where the
2273 whitespace character is SPC or TAB.
2274 Other literal whitespace like NL, CR, and FF are not accepted,
2275 as there are well-established escape sequences for these. */
2276 if (c
== ' ' || c
== '\t')
2277 return make_number (c
);
2280 c
= read_escape (readcharfun
, 0, &discard
);
2281 else if (BASE_LEADING_CODE_P (c
))
2282 c
= read_multibyte (c
, readcharfun
);
2284 next_char
= READCHAR
;
2285 if (next_char
== '.')
2287 /* Only a dotted-pair dot is valid after a char constant. */
2288 int next_next_char
= READCHAR
;
2289 UNREAD (next_next_char
);
2291 ok
= (next_next_char
<= 040
2292 || (next_next_char
< 0200
2293 && (index ("\"';([#?", next_next_char
)
2294 || (!first_in_list
&& next_next_char
== '`')
2295 || (new_backquote_flag
&& next_next_char
== ','))));
2299 ok
= (next_char
<= 040
2300 || (next_char
< 0200
2301 && (index ("\"';()[]#?", next_char
)
2302 || (!first_in_list
&& next_char
== '`')
2303 || (new_backquote_flag
&& next_char
== ','))));
2307 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2309 return make_number (c
);
2314 char *p
= read_buffer
;
2315 char *end
= read_buffer
+ read_buffer_size
;
2317 /* 1 if we saw an escape sequence specifying
2318 a multibyte character, or a multibyte character. */
2319 int force_multibyte
= 0;
2320 /* 1 if we saw an escape sequence specifying
2321 a single-byte character. */
2322 int force_singlebyte
= 0;
2323 /* 1 if read_buffer contains multibyte text now. */
2324 int is_multibyte
= 0;
2328 while ((c
= READCHAR
) >= 0
2331 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2333 int offset
= p
- read_buffer
;
2334 read_buffer
= (char *) xrealloc (read_buffer
,
2335 read_buffer_size
*= 2);
2336 p
= read_buffer
+ offset
;
2337 end
= read_buffer
+ read_buffer_size
;
2344 c
= read_escape (readcharfun
, 1, &byterep
);
2346 /* C is -1 if \ newline has just been seen */
2349 if (p
== read_buffer
)
2355 force_singlebyte
= 1;
2356 else if (byterep
== 2)
2357 force_multibyte
= 1;
2360 /* A character that must be multibyte forces multibyte. */
2361 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2362 force_multibyte
= 1;
2364 /* If we just discovered the need to be multibyte,
2365 convert the text accumulated thus far. */
2366 if (force_multibyte
&& ! is_multibyte
)
2369 to_multibyte (&p
, &end
, &nchars
);
2372 /* Allow `\C- ' and `\C-?'. */
2373 if (c
== (CHAR_CTL
| ' '))
2375 else if (c
== (CHAR_CTL
| '?'))
2380 /* Shift modifier is valid only with [A-Za-z]. */
2381 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2383 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2384 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2388 /* Move the meta bit to the right place for a string. */
2389 c
= (c
& ~CHAR_META
) | 0x80;
2390 if (c
& CHAR_MODIFIER_MASK
)
2391 error ("Invalid modifier in string");
2394 p
+= CHAR_STRING (c
, p
);
2402 end_of_file_error ();
2404 /* If purifying, and string starts with \ newline,
2405 return zero instead. This is for doc strings
2406 that we are really going to find in etc/DOC.nn.nn */
2407 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2408 return make_number (0);
2410 if (is_multibyte
|| force_singlebyte
)
2412 else if (load_convert_to_unibyte
)
2415 to_multibyte (&p
, &end
, &nchars
);
2416 if (p
- read_buffer
!= nchars
)
2418 string
= make_multibyte_string (read_buffer
, nchars
,
2420 return Fstring_make_unibyte (string
);
2422 /* We can make a unibyte string directly. */
2425 else if (EQ (readcharfun
, Qget_file_char
)
2426 || EQ (readcharfun
, Qlambda
))
2428 /* Nowadays, reading directly from a file is used only for
2429 compiled Emacs Lisp files, and those always use the
2430 Emacs internal encoding. Meanwhile, Qlambda is used
2431 for reading dynamic byte code (compiled with
2432 byte-compile-dynamic = t). So make the string multibyte
2433 if the string contains any multibyte sequences.
2434 (to_multibyte is a no-op if not.) */
2435 to_multibyte (&p
, &end
, &nchars
);
2436 is_multibyte
= (p
- read_buffer
) != nchars
;
2439 /* In all other cases, if we read these bytes as
2440 separate characters, treat them as separate characters now. */
2443 /* We want readchar_count to be the number of characters, not
2444 bytes. Hence we adjust for multibyte characters in the
2445 string. ... But it doesn't seem to be necessary, because
2446 READCHAR *does* read multibyte characters from buffers. */
2447 /* readchar_count -= (p - read_buffer) - nchars; */
2449 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2451 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2457 int next_char
= READCHAR
;
2460 if (next_char
<= 040
2461 || (next_char
< 0200
2462 && index ("\"';([#?", next_char
)
2463 || (!first_in_list
&& next_char
== '`')
2464 || (new_backquote_flag
&& next_char
== ',')))
2470 /* Otherwise, we fall through! Note that the atom-reading loop
2471 below will now loop at least once, assuring that we will not
2472 try to UNREAD two characters in a row. */
2476 if (c
<= 040) goto retry
;
2478 char *p
= read_buffer
;
2482 char *end
= read_buffer
+ read_buffer_size
;
2486 || (!index ("\"';()[]#", c
)
2487 && !(!first_in_list
&& c
== '`')
2488 && !(new_backquote_flag
&& c
== ','))))
2490 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2492 int offset
= p
- read_buffer
;
2493 read_buffer
= (char *) xrealloc (read_buffer
,
2494 read_buffer_size
*= 2);
2495 p
= read_buffer
+ offset
;
2496 end
= read_buffer
+ read_buffer_size
;
2503 end_of_file_error ();
2507 if (! SINGLE_BYTE_CHAR_P (c
))
2508 p
+= CHAR_STRING (c
, p
);
2517 int offset
= p
- read_buffer
;
2518 read_buffer
= (char *) xrealloc (read_buffer
,
2519 read_buffer_size
*= 2);
2520 p
= read_buffer
+ offset
;
2521 end
= read_buffer
+ read_buffer_size
;
2528 if (!quoted
&& !uninterned_symbol
)
2531 register Lisp_Object val
;
2533 if (*p1
== '+' || *p1
== '-') p1
++;
2534 /* Is it an integer? */
2537 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2538 /* Integers can have trailing decimal points. */
2539 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2541 /* It is an integer. */
2545 if (sizeof (int) == sizeof (EMACS_INT
))
2546 XSETINT (val
, atoi (read_buffer
));
2547 else if (sizeof (long) == sizeof (EMACS_INT
))
2548 XSETINT (val
, atol (read_buffer
));
2554 if (isfloat_string (read_buffer
))
2556 /* Compute NaN and infinities using 0.0 in a variable,
2557 to cope with compilers that think they are smarter
2563 /* Negate the value ourselves. This treats 0, NaNs,
2564 and infinity properly on IEEE floating point hosts,
2565 and works around a common bug where atof ("-0.0")
2567 int negative
= read_buffer
[0] == '-';
2569 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2570 returns 1, is if the input ends in e+INF or e+NaN. */
2577 value
= zero
/ zero
;
2580 value
= atof (read_buffer
+ negative
);
2584 return make_float (negative
? - value
: value
);
2588 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2589 : intern (read_buffer
);
2590 if (EQ (Vread_with_symbol_positions
, Qt
)
2591 || EQ (Vread_with_symbol_positions
, readcharfun
))
2592 Vread_symbol_positions_list
=
2593 /* Kind of a hack; this will probably fail if characters
2594 in the symbol name were escaped. Not really a big
2596 Fcons (Fcons (result
,
2597 make_number (readchar_count
2598 - XFASTINT (Flength (Fsymbol_name (result
))))),
2599 Vread_symbol_positions_list
);
2607 /* List of nodes we've seen during substitute_object_in_subtree. */
2608 static Lisp_Object seen_list
;
2611 substitute_object_in_subtree (object
, placeholder
)
2613 Lisp_Object placeholder
;
2615 Lisp_Object check_object
;
2617 /* We haven't seen any objects when we start. */
2620 /* Make all the substitutions. */
2622 = substitute_object_recurse (object
, placeholder
, object
);
2624 /* Clear seen_list because we're done with it. */
2627 /* The returned object here is expected to always eq the
2629 if (!EQ (check_object
, object
))
2630 error ("Unexpected mutation error in reader");
2633 /* Feval doesn't get called from here, so no gc protection is needed. */
2634 #define SUBSTITUTE(get_val, set_val) \
2636 Lisp_Object old_value = get_val; \
2637 Lisp_Object true_value \
2638 = substitute_object_recurse (object, placeholder,\
2641 if (!EQ (old_value, true_value)) \
2648 substitute_object_recurse (object
, placeholder
, subtree
)
2650 Lisp_Object placeholder
;
2651 Lisp_Object subtree
;
2653 /* If we find the placeholder, return the target object. */
2654 if (EQ (placeholder
, subtree
))
2657 /* If we've been to this node before, don't explore it again. */
2658 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2661 /* If this node can be the entry point to a cycle, remember that
2662 we've seen it. It can only be such an entry point if it was made
2663 by #n=, which means that we can find it as a value in
2665 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2666 seen_list
= Fcons (subtree
, seen_list
);
2668 /* Recurse according to subtree's type.
2669 Every branch must return a Lisp_Object. */
2670 switch (XTYPE (subtree
))
2672 case Lisp_Vectorlike
:
2675 int length
= XINT (Flength(subtree
));
2676 for (i
= 0; i
< length
; i
++)
2678 Lisp_Object idx
= make_number (i
);
2679 SUBSTITUTE (Faref (subtree
, idx
),
2680 Faset (subtree
, idx
, true_value
));
2687 SUBSTITUTE (Fcar_safe (subtree
),
2688 Fsetcar (subtree
, true_value
));
2689 SUBSTITUTE (Fcdr_safe (subtree
),
2690 Fsetcdr (subtree
, true_value
));
2696 /* Check for text properties in each interval.
2697 substitute_in_interval contains part of the logic. */
2699 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2700 Lisp_Object arg
= Fcons (object
, placeholder
);
2702 traverse_intervals_noorder (root_interval
,
2703 &substitute_in_interval
, arg
);
2708 /* Other types don't recurse any further. */
2714 /* Helper function for substitute_object_recurse. */
2716 substitute_in_interval (interval
, arg
)
2720 Lisp_Object object
= Fcar (arg
);
2721 Lisp_Object placeholder
= Fcdr (arg
);
2723 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2742 if (*cp
== '+' || *cp
== '-')
2745 if (*cp
>= '0' && *cp
<= '9')
2748 while (*cp
>= '0' && *cp
<= '9')
2756 if (*cp
>= '0' && *cp
<= '9')
2759 while (*cp
>= '0' && *cp
<= '9')
2762 if (*cp
== 'e' || *cp
== 'E')
2766 if (*cp
== '+' || *cp
== '-')
2770 if (*cp
>= '0' && *cp
<= '9')
2773 while (*cp
>= '0' && *cp
<= '9')
2776 else if (cp
== start
)
2778 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2783 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2789 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2790 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2791 || state
== (DOT_CHAR
|TRAIL_INT
)
2792 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2793 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2794 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2799 read_vector (readcharfun
, bytecodeflag
)
2800 Lisp_Object readcharfun
;
2805 register Lisp_Object
*ptr
;
2806 register Lisp_Object tem
, item
, vector
;
2807 register struct Lisp_Cons
*otem
;
2810 tem
= read_list (1, readcharfun
);
2811 len
= Flength (tem
);
2812 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2814 size
= XVECTOR (vector
)->size
;
2815 ptr
= XVECTOR (vector
)->contents
;
2816 for (i
= 0; i
< size
; i
++)
2819 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2820 bytecode object, the docstring containing the bytecode and
2821 constants values must be treated as unibyte and passed to
2822 Fread, to get the actual bytecode string and constants vector. */
2823 if (bytecodeflag
&& load_force_doc_strings
)
2825 if (i
== COMPILED_BYTECODE
)
2827 if (!STRINGP (item
))
2828 error ("invalid byte code");
2830 /* Delay handling the bytecode slot until we know whether
2831 it is lazily-loaded (we can tell by whether the
2832 constants slot is nil). */
2833 ptr
[COMPILED_CONSTANTS
] = item
;
2836 else if (i
== COMPILED_CONSTANTS
)
2838 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2842 /* Coerce string to unibyte (like string-as-unibyte,
2843 but without generating extra garbage and
2844 guaranteeing no change in the contents). */
2845 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2846 STRING_SET_UNIBYTE (bytestr
);
2848 item
= Fread (bytestr
);
2850 error ("invalid byte code");
2852 otem
= XCONS (item
);
2853 bytestr
= XCAR (item
);
2858 /* Now handle the bytecode slot. */
2859 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2862 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2870 /* FLAG = 1 means check for ] to terminate rather than ) and .
2871 FLAG = -1 means check for starting with defun
2872 and make structure pure. */
2875 read_list (flag
, readcharfun
)
2877 register Lisp_Object readcharfun
;
2879 /* -1 means check next element for defun,
2880 0 means don't check,
2881 1 means already checked and found defun. */
2882 int defunflag
= flag
< 0 ? -1 : 0;
2883 Lisp_Object val
, tail
;
2884 register Lisp_Object elt
, tem
;
2885 struct gcpro gcpro1
, gcpro2
;
2886 /* 0 is the normal case.
2887 1 means this list is a doc reference; replace it with the number 0.
2888 2 means this list is a doc reference; replace it with the doc string. */
2889 int doc_reference
= 0;
2891 /* Initialize this to 1 if we are reading a list. */
2892 int first_in_list
= flag
<= 0;
2901 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2906 /* While building, if the list starts with #$, treat it specially. */
2907 if (EQ (elt
, Vload_file_name
)
2909 && !NILP (Vpurify_flag
))
2911 if (NILP (Vdoc_file_name
))
2912 /* We have not yet called Snarf-documentation, so assume
2913 this file is described in the DOC-MM.NN file
2914 and Snarf-documentation will fill in the right value later.
2915 For now, replace the whole list with 0. */
2918 /* We have already called Snarf-documentation, so make a relative
2919 file name for this file, so it can be found properly
2920 in the installed Lisp directory.
2921 We don't use Fexpand_file_name because that would make
2922 the directory absolute now. */
2923 elt
= concat2 (build_string ("../lisp/"),
2924 Ffile_name_nondirectory (elt
));
2926 else if (EQ (elt
, Vload_file_name
)
2928 && load_force_doc_strings
)
2937 Fsignal (Qinvalid_read_syntax
,
2938 Fcons (make_string (") or . in a vector", 18), Qnil
));
2946 XSETCDR (tail
, read0 (readcharfun
));
2948 val
= read0 (readcharfun
);
2949 read1 (readcharfun
, &ch
, 0);
2953 if (doc_reference
== 1)
2954 return make_number (0);
2955 if (doc_reference
== 2)
2957 /* Get a doc string from the file we are loading.
2958 If it's in saved_doc_string, get it from there. */
2959 int pos
= XINT (XCDR (val
));
2960 /* Position is negative for user variables. */
2961 if (pos
< 0) pos
= -pos
;
2962 if (pos
>= saved_doc_string_position
2963 && pos
< (saved_doc_string_position
2964 + saved_doc_string_length
))
2966 int start
= pos
- saved_doc_string_position
;
2969 /* Process quoting with ^A,
2970 and find the end of the string,
2971 which is marked with ^_ (037). */
2972 for (from
= start
, to
= start
;
2973 saved_doc_string
[from
] != 037;)
2975 int c
= saved_doc_string
[from
++];
2978 c
= saved_doc_string
[from
++];
2980 saved_doc_string
[to
++] = c
;
2982 saved_doc_string
[to
++] = 0;
2984 saved_doc_string
[to
++] = 037;
2987 saved_doc_string
[to
++] = c
;
2990 return make_string (saved_doc_string
+ start
,
2993 /* Look in prev_saved_doc_string the same way. */
2994 else if (pos
>= prev_saved_doc_string_position
2995 && pos
< (prev_saved_doc_string_position
2996 + prev_saved_doc_string_length
))
2998 int start
= pos
- prev_saved_doc_string_position
;
3001 /* Process quoting with ^A,
3002 and find the end of the string,
3003 which is marked with ^_ (037). */
3004 for (from
= start
, to
= start
;
3005 prev_saved_doc_string
[from
] != 037;)
3007 int c
= prev_saved_doc_string
[from
++];
3010 c
= prev_saved_doc_string
[from
++];
3012 prev_saved_doc_string
[to
++] = c
;
3014 prev_saved_doc_string
[to
++] = 0;
3016 prev_saved_doc_string
[to
++] = 037;
3019 prev_saved_doc_string
[to
++] = c
;
3022 return make_string (prev_saved_doc_string
+ start
,
3026 return get_doc_string (val
, 0, 0);
3031 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3033 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3035 tem
= (read_pure
&& flag
<= 0
3036 ? pure_cons (elt
, Qnil
)
3037 : Fcons (elt
, Qnil
));
3039 XSETCDR (tail
, tem
);
3044 defunflag
= EQ (elt
, Qdefun
);
3045 else if (defunflag
> 0)
3050 Lisp_Object Vobarray
;
3051 Lisp_Object initial_obarray
;
3053 /* oblookup stores the bucket number here, for the sake of Funintern. */
3055 int oblookup_last_bucket_number
;
3057 static int hash_string ();
3059 /* Get an error if OBARRAY is not an obarray.
3060 If it is one, return it. */
3063 check_obarray (obarray
)
3064 Lisp_Object obarray
;
3066 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3068 /* If Vobarray is now invalid, force it to be valid. */
3069 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3071 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3076 /* Intern the C string STR: return a symbol with that name,
3077 interned in the current obarray. */
3084 int len
= strlen (str
);
3085 Lisp_Object obarray
;
3088 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3089 obarray
= check_obarray (obarray
);
3090 tem
= oblookup (obarray
, str
, len
, len
);
3093 return Fintern (make_string (str
, len
), obarray
);
3096 /* Create an uninterned symbol with name STR. */
3102 int len
= strlen (str
);
3104 return Fmake_symbol ((!NILP (Vpurify_flag
)
3105 ? make_pure_string (str
, len
, len
, 0)
3106 : make_string (str
, len
)));
3109 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3110 doc
: /* Return the canonical symbol whose name is STRING.
3111 If there is none, one is created by this function and returned.
3112 A second optional argument specifies the obarray to use;
3113 it defaults to the value of `obarray'. */)
3115 Lisp_Object string
, obarray
;
3117 register Lisp_Object tem
, sym
, *ptr
;
3119 if (NILP (obarray
)) obarray
= Vobarray
;
3120 obarray
= check_obarray (obarray
);
3122 CHECK_STRING (string
);
3124 tem
= oblookup (obarray
, SDATA (string
),
3127 if (!INTEGERP (tem
))
3130 if (!NILP (Vpurify_flag
))
3131 string
= Fpurecopy (string
);
3132 sym
= Fmake_symbol (string
);
3134 if (EQ (obarray
, initial_obarray
))
3135 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3137 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3139 if ((SREF (string
, 0) == ':')
3140 && EQ (obarray
, initial_obarray
))
3142 XSYMBOL (sym
)->constant
= 1;
3143 XSYMBOL (sym
)->value
= sym
;
3146 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3148 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3150 XSYMBOL (sym
)->next
= 0;
3155 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3156 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3157 NAME may be a string or a symbol. If it is a symbol, that exact
3158 symbol is searched for.
3159 A second optional argument specifies the obarray to use;
3160 it defaults to the value of `obarray'. */)
3162 Lisp_Object name
, obarray
;
3164 register Lisp_Object tem
, string
;
3166 if (NILP (obarray
)) obarray
= Vobarray
;
3167 obarray
= check_obarray (obarray
);
3169 if (!SYMBOLP (name
))
3171 CHECK_STRING (name
);
3175 string
= SYMBOL_NAME (name
);
3177 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3178 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3184 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3185 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3186 The value is t if a symbol was found and deleted, nil otherwise.
3187 NAME may be a string or a symbol. If it is a symbol, that symbol
3188 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3189 OBARRAY defaults to the value of the variable `obarray'. */)
3191 Lisp_Object name
, obarray
;
3193 register Lisp_Object string
, tem
;
3196 if (NILP (obarray
)) obarray
= Vobarray
;
3197 obarray
= check_obarray (obarray
);
3200 string
= SYMBOL_NAME (name
);
3203 CHECK_STRING (name
);
3207 tem
= oblookup (obarray
, SDATA (string
),
3212 /* If arg was a symbol, don't delete anything but that symbol itself. */
3213 if (SYMBOLP (name
) && !EQ (name
, tem
))
3216 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3217 XSYMBOL (tem
)->constant
= 0;
3218 XSYMBOL (tem
)->indirect_variable
= 0;
3220 hash
= oblookup_last_bucket_number
;
3222 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3224 if (XSYMBOL (tem
)->next
)
3225 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3227 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3231 Lisp_Object tail
, following
;
3233 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3234 XSYMBOL (tail
)->next
;
3237 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3238 if (EQ (following
, tem
))
3240 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3249 /* Return the symbol in OBARRAY whose names matches the string
3250 of SIZE characters (SIZE_BYTE bytes) at PTR.
3251 If there is no such symbol in OBARRAY, return nil.
3253 Also store the bucket number in oblookup_last_bucket_number. */
3256 oblookup (obarray
, ptr
, size
, size_byte
)
3257 Lisp_Object obarray
;
3258 register const char *ptr
;
3259 int size
, size_byte
;
3263 register Lisp_Object tail
;
3264 Lisp_Object bucket
, tem
;
3266 if (!VECTORP (obarray
)
3267 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3269 obarray
= check_obarray (obarray
);
3270 obsize
= XVECTOR (obarray
)->size
;
3272 /* This is sometimes needed in the middle of GC. */
3273 obsize
&= ~ARRAY_MARK_FLAG
;
3274 /* Combining next two lines breaks VMS C 2.3. */
3275 hash
= hash_string (ptr
, size_byte
);
3277 bucket
= XVECTOR (obarray
)->contents
[hash
];
3278 oblookup_last_bucket_number
= hash
;
3279 if (XFASTINT (bucket
) == 0)
3281 else if (!SYMBOLP (bucket
))
3282 error ("Bad data in guts of obarray"); /* Like CADR error message */
3284 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3286 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3287 && SCHARS (SYMBOL_NAME (tail
)) == size
3288 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3290 else if (XSYMBOL (tail
)->next
== 0)
3293 XSETINT (tem
, hash
);
3298 hash_string (ptr
, len
)
3299 const unsigned char *ptr
;
3302 register const unsigned char *p
= ptr
;
3303 register const unsigned char *end
= p
+ len
;
3304 register unsigned char c
;
3305 register int hash
= 0;
3310 if (c
>= 0140) c
-= 40;
3311 hash
= ((hash
<<3) + (hash
>>28) + c
);
3313 return hash
& 07777777777;
3317 map_obarray (obarray
, fn
, arg
)
3318 Lisp_Object obarray
;
3319 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3323 register Lisp_Object tail
;
3324 CHECK_VECTOR (obarray
);
3325 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3327 tail
= XVECTOR (obarray
)->contents
[i
];
3332 if (XSYMBOL (tail
)->next
== 0)
3334 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3340 mapatoms_1 (sym
, function
)
3341 Lisp_Object sym
, function
;
3343 call1 (function
, sym
);
3346 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3347 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3348 OBARRAY defaults to the value of `obarray'. */)
3350 Lisp_Object function
, obarray
;
3352 if (NILP (obarray
)) obarray
= Vobarray
;
3353 obarray
= check_obarray (obarray
);
3355 map_obarray (obarray
, mapatoms_1
, function
);
3359 #define OBARRAY_SIZE 1511
3364 Lisp_Object oblength
;
3368 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3370 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3371 Vobarray
= Fmake_vector (oblength
, make_number (0));
3372 initial_obarray
= Vobarray
;
3373 staticpro (&initial_obarray
);
3374 /* Intern nil in the obarray */
3375 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3376 XSYMBOL (Qnil
)->constant
= 1;
3378 /* These locals are to kludge around a pyramid compiler bug. */
3379 hash
= hash_string ("nil", 3);
3380 /* Separate statement here to avoid VAXC bug. */
3381 hash
%= OBARRAY_SIZE
;
3382 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3385 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3386 XSYMBOL (Qnil
)->function
= Qunbound
;
3387 XSYMBOL (Qunbound
)->value
= Qunbound
;
3388 XSYMBOL (Qunbound
)->function
= Qunbound
;
3391 XSYMBOL (Qnil
)->value
= Qnil
;
3392 XSYMBOL (Qnil
)->plist
= Qnil
;
3393 XSYMBOL (Qt
)->value
= Qt
;
3394 XSYMBOL (Qt
)->constant
= 1;
3396 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3399 Qvariable_documentation
= intern ("variable-documentation");
3400 staticpro (&Qvariable_documentation
);
3402 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3403 read_buffer
= (char *) xmalloc (read_buffer_size
);
3408 struct Lisp_Subr
*sname
;
3411 sym
= intern (sname
->symbol_name
);
3412 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3415 #ifdef NOTDEF /* use fset in subr.el now */
3417 defalias (sname
, string
)
3418 struct Lisp_Subr
*sname
;
3422 sym
= intern (string
);
3423 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3427 /* Define an "integer variable"; a symbol whose value is forwarded
3428 to a C variable of type int. Sample call: */
3429 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3431 defvar_int (namestring
, address
)
3435 Lisp_Object sym
, val
;
3436 sym
= intern (namestring
);
3437 val
= allocate_misc ();
3438 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3439 XINTFWD (val
)->intvar
= address
;
3440 SET_SYMBOL_VALUE (sym
, val
);
3443 /* Similar but define a variable whose value is t if address contains 1,
3444 nil if address contains 0 */
3446 defvar_bool (namestring
, address
)
3450 Lisp_Object sym
, val
;
3451 sym
= intern (namestring
);
3452 val
= allocate_misc ();
3453 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3454 XBOOLFWD (val
)->boolvar
= address
;
3455 SET_SYMBOL_VALUE (sym
, val
);
3456 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3459 /* Similar but define a variable whose value is the Lisp Object stored
3460 at address. Two versions: with and without gc-marking of the C
3461 variable. The nopro version is used when that variable will be
3462 gc-marked for some other reason, since marking the same slot twice
3463 can cause trouble with strings. */
3465 defvar_lisp_nopro (namestring
, address
)
3467 Lisp_Object
*address
;
3469 Lisp_Object sym
, val
;
3470 sym
= intern (namestring
);
3471 val
= allocate_misc ();
3472 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3473 XOBJFWD (val
)->objvar
= address
;
3474 SET_SYMBOL_VALUE (sym
, val
);
3478 defvar_lisp (namestring
, address
)
3480 Lisp_Object
*address
;
3482 defvar_lisp_nopro (namestring
, address
);
3483 staticpro (address
);
3486 /* Similar but define a variable whose value is the Lisp Object stored in
3487 the current buffer. address is the address of the slot in the buffer
3488 that is current now. */
3491 defvar_per_buffer (namestring
, address
, type
, doc
)
3493 Lisp_Object
*address
;
3497 Lisp_Object sym
, val
;
3500 sym
= intern (namestring
);
3501 val
= allocate_misc ();
3502 offset
= (char *)address
- (char *)current_buffer
;
3504 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3505 XBUFFER_OBJFWD (val
)->offset
= offset
;
3506 SET_SYMBOL_VALUE (sym
, val
);
3507 PER_BUFFER_SYMBOL (offset
) = sym
;
3508 PER_BUFFER_TYPE (offset
) = type
;
3510 if (PER_BUFFER_IDX (offset
) == 0)
3511 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3512 slot of buffer_local_flags */
3517 /* Similar but define a variable whose value is the Lisp Object stored
3518 at a particular offset in the current kboard object. */
3521 defvar_kboard (namestring
, offset
)
3525 Lisp_Object sym
, val
;
3526 sym
= intern (namestring
);
3527 val
= allocate_misc ();
3528 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3529 XKBOARD_OBJFWD (val
)->offset
= offset
;
3530 SET_SYMBOL_VALUE (sym
, val
);
3533 /* Record the value of load-path used at the start of dumping
3534 so we can see if the site changed it later during dumping. */
3535 static Lisp_Object dump_path
;
3541 int turn_off_warning
= 0;
3543 /* Compute the default load-path. */
3545 normal
= PATH_LOADSEARCH
;
3546 Vload_path
= decode_env_path (0, normal
);
3548 if (NILP (Vpurify_flag
))
3549 normal
= PATH_LOADSEARCH
;
3551 normal
= PATH_DUMPLOADSEARCH
;
3553 /* In a dumped Emacs, we normally have to reset the value of
3554 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3555 uses ../lisp, instead of the path of the installed elisp
3556 libraries. However, if it appears that Vload_path was changed
3557 from the default before dumping, don't override that value. */
3560 if (! NILP (Fequal (dump_path
, Vload_path
)))
3562 Vload_path
= decode_env_path (0, normal
);
3563 if (!NILP (Vinstallation_directory
))
3565 Lisp_Object tem
, tem1
, sitelisp
;
3567 /* Remove site-lisp dirs from path temporarily and store
3568 them in sitelisp, then conc them on at the end so
3569 they're always first in path. */
3573 tem
= Fcar (Vload_path
);
3574 tem1
= Fstring_match (build_string ("site-lisp"),
3578 Vload_path
= Fcdr (Vload_path
);
3579 sitelisp
= Fcons (tem
, sitelisp
);
3585 /* Add to the path the lisp subdir of the
3586 installation dir, if it exists. */
3587 tem
= Fexpand_file_name (build_string ("lisp"),
3588 Vinstallation_directory
);
3589 tem1
= Ffile_exists_p (tem
);
3592 if (NILP (Fmember (tem
, Vload_path
)))
3594 turn_off_warning
= 1;
3595 Vload_path
= Fcons (tem
, Vload_path
);
3599 /* That dir doesn't exist, so add the build-time
3600 Lisp dirs instead. */
3601 Vload_path
= nconc2 (Vload_path
, dump_path
);
3603 /* Add leim under the installation dir, if it exists. */
3604 tem
= Fexpand_file_name (build_string ("leim"),
3605 Vinstallation_directory
);
3606 tem1
= Ffile_exists_p (tem
);
3609 if (NILP (Fmember (tem
, Vload_path
)))
3610 Vload_path
= Fcons (tem
, Vload_path
);
3613 /* Add site-list under the installation dir, if it exists. */
3614 tem
= Fexpand_file_name (build_string ("site-lisp"),
3615 Vinstallation_directory
);
3616 tem1
= Ffile_exists_p (tem
);
3619 if (NILP (Fmember (tem
, Vload_path
)))
3620 Vload_path
= Fcons (tem
, Vload_path
);
3623 /* If Emacs was not built in the source directory,
3624 and it is run from where it was built, add to load-path
3625 the lisp, leim and site-lisp dirs under that directory. */
3627 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3631 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3632 Vinstallation_directory
);
3633 tem1
= Ffile_exists_p (tem
);
3635 /* Don't be fooled if they moved the entire source tree
3636 AFTER dumping Emacs. If the build directory is indeed
3637 different from the source dir, src/Makefile.in and
3638 src/Makefile will not be found together. */
3639 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3640 Vinstallation_directory
);
3641 tem2
= Ffile_exists_p (tem
);
3642 if (!NILP (tem1
) && NILP (tem2
))
3644 tem
= Fexpand_file_name (build_string ("lisp"),
3647 if (NILP (Fmember (tem
, Vload_path
)))
3648 Vload_path
= Fcons (tem
, Vload_path
);
3650 tem
= Fexpand_file_name (build_string ("leim"),
3653 if (NILP (Fmember (tem
, Vload_path
)))
3654 Vload_path
= Fcons (tem
, Vload_path
);
3656 tem
= Fexpand_file_name (build_string ("site-lisp"),
3659 if (NILP (Fmember (tem
, Vload_path
)))
3660 Vload_path
= Fcons (tem
, Vload_path
);
3663 if (!NILP (sitelisp
))
3664 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3670 /* NORMAL refers to the lisp dir in the source directory. */
3671 /* We used to add ../lisp at the front here, but
3672 that caused trouble because it was copied from dump_path
3673 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3674 It should be unnecessary. */
3675 Vload_path
= decode_env_path (0, normal
);
3676 dump_path
= Vload_path
;
3681 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3682 almost never correct, thereby causing a warning to be printed out that
3683 confuses users. Since PATH_LOADSEARCH is always overridden by the
3684 EMACSLOADPATH environment variable below, disable the warning on NT. */
3686 /* Warn if dirs in the *standard* path don't exist. */
3687 if (!turn_off_warning
)
3689 Lisp_Object path_tail
;
3691 for (path_tail
= Vload_path
;
3693 path_tail
= XCDR (path_tail
))
3695 Lisp_Object dirfile
;
3696 dirfile
= Fcar (path_tail
);
3697 if (STRINGP (dirfile
))
3699 dirfile
= Fdirectory_file_name (dirfile
);
3700 if (access (SDATA (dirfile
), 0) < 0)
3701 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3706 #endif /* WINDOWSNT */
3708 /* If the EMACSLOADPATH environment variable is set, use its value.
3709 This doesn't apply if we're dumping. */
3711 if (NILP (Vpurify_flag
)
3712 && egetenv ("EMACSLOADPATH"))
3714 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3718 load_in_progress
= 0;
3719 Vload_file_name
= Qnil
;
3721 load_descriptor_list
= Qnil
;
3723 Vstandard_input
= Qt
;
3724 Vloads_in_progress
= Qnil
;
3727 /* Print a warning, using format string FORMAT, that directory DIRNAME
3728 does not exist. Print it on stderr and put it in *Message*. */
3731 dir_warning (format
, dirname
)
3733 Lisp_Object dirname
;
3736 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3738 fprintf (stderr
, format
, SDATA (dirname
));
3739 sprintf (buffer
, format
, SDATA (dirname
));
3740 /* Don't log the warning before we've initialized!! */
3742 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3749 defsubr (&Sread_from_string
);
3751 defsubr (&Sintern_soft
);
3752 defsubr (&Sunintern
);
3754 defsubr (&Seval_buffer
);
3755 defsubr (&Seval_region
);
3756 defsubr (&Sread_char
);
3757 defsubr (&Sread_char_exclusive
);
3758 defsubr (&Sread_event
);
3759 defsubr (&Sget_file_char
);
3760 defsubr (&Smapatoms
);
3761 defsubr (&Slocate_file_internal
);
3763 DEFVAR_LISP ("obarray", &Vobarray
,
3764 doc
: /* Symbol table for use by `intern' and `read'.
3765 It is a vector whose length ought to be prime for best results.
3766 The vector's contents don't make sense if examined from Lisp programs;
3767 to find all the symbols in an obarray, use `mapatoms'. */);
3769 DEFVAR_LISP ("values", &Vvalues
,
3770 doc
: /* List of values of all expressions which were read, evaluated and printed.
3771 Order is reverse chronological. */);
3773 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3774 doc
: /* Stream for read to get input from.
3775 See documentation of `read' for possible values. */);
3776 Vstandard_input
= Qt
;
3778 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3779 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3781 If this variable is a buffer, then only forms read from that buffer
3782 will be added to `read-symbol-positions-list'.
3783 If this variable is t, then all read forms will be added.
3784 The effect of all other values other than nil are not currently
3785 defined, although they may be in the future.
3787 The positions are relative to the last call to `read' or
3788 `read-from-string'. It is probably a bad idea to set this variable at
3789 the toplevel; bind it instead. */);
3790 Vread_with_symbol_positions
= Qnil
;
3792 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3793 doc
: /* A list mapping read symbols to their positions.
3794 This variable is modified during calls to `read' or
3795 `read-from-string', but only when `read-with-symbol-positions' is
3798 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3799 CHAR-POSITION is an integer giving the offset of that occurrence of the
3800 symbol from the position where `read' or `read-from-string' started.
3802 Note that a symbol will appear multiple times in this list, if it was
3803 read multiple times. The list is in the same order as the symbols
3805 Vread_symbol_positions_list
= Qnil
;
3807 DEFVAR_LISP ("load-path", &Vload_path
,
3808 doc
: /* *List of directories to search for files to load.
3809 Each element is a string (directory name) or nil (try default directory).
3810 Initialized based on EMACSLOADPATH environment variable, if any,
3811 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3813 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3814 doc
: /* *List of suffixes to try for files to load.
3815 This list should not include the empty string. */);
3816 Vload_suffixes
= Fcons (build_string (".elc"),
3817 Fcons (build_string (".el"), Qnil
));
3818 /* We don't use empty_string because it's not initialized yet. */
3819 default_suffixes
= Fcons (build_string (""), Qnil
);
3820 staticpro (&default_suffixes
);
3822 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3823 doc
: /* Non-nil iff inside of `load'. */);
3825 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3826 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3827 Each element looks like (FILENAME FORMS...).
3828 When `load' is run and the file-name argument is FILENAME,
3829 the FORMS in the corresponding element are executed at the end of loading.
3831 FILENAME must match exactly! Normally FILENAME is the name of a library,
3832 with no directory specified, since that is how `load' is normally called.
3833 An error in FORMS does not undo the load,
3834 but does prevent execution of the rest of the FORMS.
3835 FILENAME can also be a symbol (a feature) and FORMS are then executed
3836 when the corresponding call to `provide' is made. */);
3837 Vafter_load_alist
= Qnil
;
3839 DEFVAR_LISP ("load-history", &Vload_history
,
3840 doc
: /* Alist mapping source file names to symbols and features.
3841 Each alist element is a list that starts with a file name,
3842 except for one element (optional) that starts with nil and describes
3843 definitions evaluated from buffers not visiting files.
3844 The remaining elements of each list are symbols defined as functions,
3845 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3846 `(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3847 An element `(t . SYMBOL)' precedes an entry that is just SYMBOL,
3848 and means that SYMBOL was an autoload before this file redefined it
3850 Vload_history
= Qnil
;
3852 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3853 doc
: /* Full name of file being loaded by `load'. */);
3854 Vload_file_name
= Qnil
;
3856 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3857 doc
: /* File name, including directory, of user's initialization file.
3858 If the file loaded had extension `.elc' and there was a corresponding `.el'
3859 file, this variable contains the name of the .el file, suitable for use
3860 by functions like `custom-save-all' which edit the init file. */);
3861 Vuser_init_file
= Qnil
;
3863 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3864 doc
: /* Used for internal purposes by `load'. */);
3865 Vcurrent_load_list
= Qnil
;
3867 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3868 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3869 The default is nil, which means use the function `read'. */);
3870 Vload_read_function
= Qnil
;
3872 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3873 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3874 This function is for doing code conversion before reading the source file.
3875 If nil, loading is done without any code conversion.
3876 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3877 FULLNAME is the full name of FILE.
3878 See `load' for the meaning of the remaining arguments. */);
3879 Vload_source_file_function
= Qnil
;
3881 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3882 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3883 This is useful when the file being loaded is a temporary copy. */);
3884 load_force_doc_strings
= 0;
3886 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3887 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3888 This is normally bound by `load' and `eval-buffer' to control `read',
3889 and is not meant for users to change. */);
3890 load_convert_to_unibyte
= 0;
3892 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3893 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3894 You cannot count on them to still be there! */);
3896 = Fexpand_file_name (build_string ("../"),
3897 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3899 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3900 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3901 Vpreloaded_file_list
= Qnil
;
3903 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3904 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3905 Vbyte_boolean_vars
= Qnil
;
3907 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3908 doc
: /* Non-nil means load dangerous compiled Lisp files.
3909 Some versions of XEmacs use different byte codes than Emacs. These
3910 incompatible byte codes can make Emacs crash when it tries to execute
3912 load_dangerous_libraries
= 0;
3914 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3915 doc
: /* Regular expression matching safe to load compiled Lisp files.
3916 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3917 from the file, and matches them against this regular expression.
3918 When the regular expression matches, the file is considered to be safe
3919 to load. See also `load-dangerous-libraries'. */);
3920 Vbytecomp_version_regexp
3921 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3923 /* Vsource_directory was initialized in init_lread. */
3925 load_descriptor_list
= Qnil
;
3926 staticpro (&load_descriptor_list
);
3928 Qcurrent_load_list
= intern ("current-load-list");
3929 staticpro (&Qcurrent_load_list
);
3931 Qstandard_input
= intern ("standard-input");
3932 staticpro (&Qstandard_input
);
3934 Qread_char
= intern ("read-char");
3935 staticpro (&Qread_char
);
3937 Qget_file_char
= intern ("get-file-char");
3938 staticpro (&Qget_file_char
);
3940 Qbackquote
= intern ("`");
3941 staticpro (&Qbackquote
);
3942 Qcomma
= intern (",");
3943 staticpro (&Qcomma
);
3944 Qcomma_at
= intern (",@");
3945 staticpro (&Qcomma_at
);
3946 Qcomma_dot
= intern (",.");
3947 staticpro (&Qcomma_dot
);
3949 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3950 staticpro (&Qinhibit_file_name_operation
);
3952 Qascii_character
= intern ("ascii-character");
3953 staticpro (&Qascii_character
);
3955 Qfunction
= intern ("function");
3956 staticpro (&Qfunction
);
3958 Qload
= intern ("load");
3961 Qload_file_name
= intern ("load-file-name");
3962 staticpro (&Qload_file_name
);
3964 staticpro (&dump_path
);
3966 staticpro (&read_objects
);
3967 read_objects
= Qnil
;
3968 staticpro (&seen_list
);
3970 Vloads_in_progress
= Qnil
;
3971 staticpro (&Vloads_in_progress
);
3974 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
3975 (do not change this comment) */