1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
32 #include "intervals.h"
39 #include "termhooks.h"
43 #include <sys/inode.h>
48 #include <unistd.h> /* to get X_OK */
65 #endif /* HAVE_SETLOCALE */
75 #define file_offset off_t
76 #define file_tell ftello
78 #define file_offset long
79 #define file_tell ftell
86 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
87 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
88 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
89 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
90 Lisp_Object Qinhibit_file_name_operation
;
91 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
93 extern Lisp_Object Qevent_symbol_element_mask
;
94 extern Lisp_Object Qfile_exists_p
;
96 /* non-zero iff inside `load' */
99 /* Directory in which the sources were found. */
100 Lisp_Object Vsource_directory
;
102 /* Search path and suffixes for files to be loaded. */
103 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
105 /* File name of user's init file. */
106 Lisp_Object Vuser_init_file
;
108 /* This is the user-visible association list that maps features to
109 lists of defs in their load files. */
110 Lisp_Object Vload_history
;
112 /* This is used to build the load history. */
113 Lisp_Object Vcurrent_load_list
;
115 /* List of files that were preloaded. */
116 Lisp_Object Vpreloaded_file_list
;
118 /* Name of file actually being read by `load'. */
119 Lisp_Object Vload_file_name
;
121 /* Function to use for reading, in `load' and friends. */
122 Lisp_Object Vload_read_function
;
124 /* The association list of objects read with the #n=object form.
125 Each member of the list has the form (n . object), and is used to
126 look up the object for the corresponding #n# construct.
127 It must be set to nil before all top-level calls to read0. */
128 Lisp_Object read_objects
;
130 /* Nonzero means load should forcibly load all dynamic doc strings. */
131 static int load_force_doc_strings
;
133 /* Nonzero means read should convert strings to unibyte. */
134 static int load_convert_to_unibyte
;
136 /* Function to use for loading an Emacs lisp source file (not
137 compiled) instead of readevalloop. */
138 Lisp_Object Vload_source_file_function
;
140 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
141 Lisp_Object Vbyte_boolean_vars
;
143 /* Whether or not to add a `read-positions' property to symbols
145 Lisp_Object Vread_with_symbol_positions
;
147 /* List of (SYMBOL . POSITION) accumulated so far. */
148 Lisp_Object Vread_symbol_positions_list
;
150 /* List of descriptors now open for Fload. */
151 static Lisp_Object load_descriptor_list
;
153 /* File for get_file_char to read from. Use by load. */
154 static FILE *instream
;
156 /* When nonzero, read conses in pure space */
157 static int read_pure
;
159 /* For use within read-from-string (this reader is non-reentrant!!) */
160 static int read_from_string_index
;
161 static int read_from_string_index_byte
;
162 static int read_from_string_limit
;
164 /* Number of bytes left to read in the buffer character
165 that `readchar' has already advanced over. */
166 static int readchar_backlog
;
167 /* Number of characters read in the current call to Fread or
168 Fread_from_string. */
169 static int readchar_count
;
171 /* This contains the last string skipped with #@. */
172 static char *saved_doc_string
;
173 /* Length of buffer allocated in saved_doc_string. */
174 static int saved_doc_string_size
;
175 /* Length of actual data in saved_doc_string. */
176 static int saved_doc_string_length
;
177 /* This is the file position that string came from. */
178 static file_offset saved_doc_string_position
;
180 /* This contains the previous string skipped with #@.
181 We copy it from saved_doc_string when a new string
182 is put in saved_doc_string. */
183 static char *prev_saved_doc_string
;
184 /* Length of buffer allocated in prev_saved_doc_string. */
185 static int prev_saved_doc_string_size
;
186 /* Length of actual data in prev_saved_doc_string. */
187 static int prev_saved_doc_string_length
;
188 /* This is the file position that string came from. */
189 static file_offset prev_saved_doc_string_position
;
191 /* Nonzero means inside a new-style backquote
192 with no surrounding parentheses.
193 Fread initializes this to zero, so we need not specbind it
194 or worry about what happens to it when there is an error. */
195 static int new_backquote_flag
;
197 /* A list of file names for files being loaded in Fload. Used to
198 check for recursive loads. */
200 static Lisp_Object Vloads_in_progress
;
202 /* Non-zero means load dangerous compiled Lisp files. */
204 int load_dangerous_libraries
;
206 /* A regular expression used to detect files compiled with Emacs. */
208 static Lisp_Object Vbytecomp_version_regexp
;
210 static void to_multibyte
P_ ((char **, char **, int *));
211 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
212 Lisp_Object (*) (), int,
213 Lisp_Object
, Lisp_Object
,
214 Lisp_Object
, Lisp_Object
));
215 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
216 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
219 /* Handle unreading and rereading of characters.
220 Write READCHAR to read a character,
221 UNREAD(c) to unread c to be read again.
223 The READCHAR and UNREAD macros are meant for reading/unreading a
224 byte code; they do not handle multibyte characters. The caller
225 should manage them if necessary.
227 [ Actually that seems to be a lie; READCHAR will definitely read
228 multibyte characters from buffer sources, at least. Is the
229 comment just out of date?
230 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
233 #define READCHAR readchar (readcharfun)
234 #define UNREAD(c) unreadchar (readcharfun, c)
237 readchar (readcharfun
)
238 Lisp_Object readcharfun
;
245 if (BUFFERP (readcharfun
))
247 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
249 int pt_byte
= BUF_PT_BYTE (inbuffer
);
250 int orig_pt_byte
= pt_byte
;
252 if (readchar_backlog
> 0)
253 /* We get the address of the byte just passed,
254 which is the last byte of the character.
255 The other bytes in this character are consecutive with it,
256 because the gap can't be in the middle of a character. */
257 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
258 - --readchar_backlog
);
260 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
263 readchar_backlog
= -1;
265 if (! NILP (inbuffer
->enable_multibyte_characters
))
267 /* Fetch the character code from the buffer. */
268 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
269 BUF_INC_POS (inbuffer
, pt_byte
);
270 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
274 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
277 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
281 if (MARKERP (readcharfun
))
283 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
285 int bytepos
= marker_byte_position (readcharfun
);
286 int orig_bytepos
= bytepos
;
288 if (readchar_backlog
> 0)
289 /* We get the address of the byte just passed,
290 which is the last byte of the character.
291 The other bytes in this character are consecutive with it,
292 because the gap can't be in the middle of a character. */
293 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
294 - --readchar_backlog
);
296 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
299 readchar_backlog
= -1;
301 if (! NILP (inbuffer
->enable_multibyte_characters
))
303 /* Fetch the character code from the buffer. */
304 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
305 BUF_INC_POS (inbuffer
, bytepos
);
306 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
310 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
314 XMARKER (readcharfun
)->bytepos
= bytepos
;
315 XMARKER (readcharfun
)->charpos
++;
320 if (EQ (readcharfun
, Qlambda
))
321 return read_bytecode_char (0);
323 if (EQ (readcharfun
, Qget_file_char
))
327 /* Interrupted reads have been observed while reading over the network */
328 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
338 if (STRINGP (readcharfun
))
340 if (read_from_string_index
>= read_from_string_limit
)
343 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
344 read_from_string_index
,
345 read_from_string_index_byte
);
350 tem
= call0 (readcharfun
);
357 /* Unread the character C in the way appropriate for the stream READCHARFUN.
358 If the stream is a user function, call it with the char as argument. */
361 unreadchar (readcharfun
, c
)
362 Lisp_Object readcharfun
;
367 /* Don't back up the pointer if we're unreading the end-of-input mark,
368 since readchar didn't advance it when we read it. */
370 else if (BUFFERP (readcharfun
))
372 struct buffer
*b
= XBUFFER (readcharfun
);
373 int bytepos
= BUF_PT_BYTE (b
);
375 if (readchar_backlog
>= 0)
380 if (! NILP (b
->enable_multibyte_characters
))
381 BUF_DEC_POS (b
, bytepos
);
385 BUF_PT_BYTE (b
) = bytepos
;
388 else if (MARKERP (readcharfun
))
390 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
391 int bytepos
= XMARKER (readcharfun
)->bytepos
;
393 if (readchar_backlog
>= 0)
397 XMARKER (readcharfun
)->charpos
--;
398 if (! NILP (b
->enable_multibyte_characters
))
399 BUF_DEC_POS (b
, bytepos
);
403 XMARKER (readcharfun
)->bytepos
= bytepos
;
406 else if (STRINGP (readcharfun
))
408 read_from_string_index
--;
409 read_from_string_index_byte
410 = string_char_to_byte (readcharfun
, read_from_string_index
);
412 else if (EQ (readcharfun
, Qlambda
))
413 read_bytecode_char (1);
414 else if (EQ (readcharfun
, Qget_file_char
))
415 ungetc (c
, instream
);
417 call1 (readcharfun
, make_number (c
));
420 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
422 static Lisp_Object read0
P_ ((Lisp_Object
));
423 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
425 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
426 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
427 static int read_multibyte
P_ ((int, Lisp_Object
));
429 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
431 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
433 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
436 /* Get a character from the tty. */
438 extern Lisp_Object read_char
P_ ((int, int, Lisp_Object
*, Lisp_Object
, int *));
440 /* Read input events until we get one that's acceptable for our purposes.
442 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
443 until we get a character we like, and then stuffed into
446 If ASCII_REQUIRED is non-zero, we check function key events to see
447 if the unmodified version of the symbol has a Qascii_character
448 property, and use that character, if present.
450 If ERROR_NONASCII is non-zero, we signal an error if the input we
451 get isn't an ASCII character with modifiers. If it's zero but
452 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
455 If INPUT_METHOD is nonzero, we invoke the current input method
456 if the character warrants that. */
459 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
461 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
463 volatile register Lisp_Object val
, delayed_switch_frame
;
465 #ifdef HAVE_WINDOW_SYSTEM
466 if (display_hourglass_p
)
470 delayed_switch_frame
= Qnil
;
472 /* Read until we get an acceptable event. */
475 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0);
476 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
481 /* switch-frame events are put off until after the next ASCII
482 character. This is better than signaling an error just because
483 the last characters were typed to a separate minibuffer frame,
484 for example. Eventually, some code which can deal with
485 switch-frame events will read it and process it. */
487 && EVENT_HAS_PARAMETERS (val
)
488 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
490 delayed_switch_frame
= val
;
496 /* Convert certain symbols to their ASCII equivalents. */
499 Lisp_Object tem
, tem1
;
500 tem
= Fget (val
, Qevent_symbol_element_mask
);
503 tem1
= Fget (Fcar (tem
), Qascii_character
);
504 /* Merge this symbol's modifier bits
505 with the ASCII equivalent of its basic code. */
507 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
511 /* If we don't have a character now, deal with it appropriately. */
516 Vunread_command_events
= Fcons (val
, Qnil
);
517 error ("Non-character input-event");
524 if (! NILP (delayed_switch_frame
))
525 unread_switch_frame
= delayed_switch_frame
;
529 #ifdef HAVE_WINDOW_SYSTEM
530 if (display_hourglass_p
)
539 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
540 doc
: /* Read a character from the command input (keyboard or macro).
541 It is returned as a number.
542 If the user generates an event which is not a character (i.e. a mouse
543 click or function key event), `read-char' signals an error. As an
544 exception, switch-frame events are put off until non-ASCII events can
546 If you want to read non-character events, or ignore them, call
547 `read-event' or `read-char-exclusive' instead.
549 If the optional argument PROMPT is non-nil, display that as a prompt.
550 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
551 input method is turned on in the current buffer, that input method
552 is used for reading a character. */)
553 (prompt
, inherit_input_method
)
554 Lisp_Object prompt
, inherit_input_method
;
557 message_with_string ("%s", prompt
, 0);
558 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
561 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
562 doc
: /* Read an event object from the input stream.
563 If the optional argument PROMPT is non-nil, display that as a prompt.
564 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
565 input method is turned on in the current buffer, that input method
566 is used for reading a character. */)
567 (prompt
, inherit_input_method
)
568 Lisp_Object prompt
, inherit_input_method
;
571 message_with_string ("%s", prompt
, 0);
572 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
575 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
576 doc
: /* Read a character from the command input (keyboard or macro).
577 It is returned as a number. Non-character events are ignored.
579 If the optional argument PROMPT is non-nil, display that as a prompt.
580 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
581 input method is turned on in the current buffer, that input method
582 is used for reading a character. */)
583 (prompt
, inherit_input_method
)
584 Lisp_Object prompt
, inherit_input_method
;
587 message_with_string ("%s", prompt
, 0);
588 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
591 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
592 doc
: /* Don't use this yourself. */)
595 register Lisp_Object val
;
596 XSETINT (val
, getc (instream
));
602 /* Value is non-zero if the file asswociated with file descriptor FD
603 is a compiled Lisp file that's safe to load. Only files compiled
604 with Emacs are safe to load. Files compiled with XEmacs can lead
605 to a crash in Fbyte_code because of an incompatible change in the
616 /* Read the first few bytes from the file, and look for a line
617 specifying the byte compiler version used. */
618 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
623 /* Skip to the next newline, skipping over the initial `ELC'
624 with NUL bytes following it. */
625 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
629 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
634 lseek (fd
, 0, SEEK_SET
);
639 /* Callback for record_unwind_protect. Restore the old load list OLD,
640 after loading a file successfully. */
643 record_load_unwind (old
)
646 return Vloads_in_progress
= old
;
649 /* This handler function is used via internal_condition_case_1. */
652 load_error_handler (data
)
658 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
659 doc
: /* Execute a file of Lisp code named FILE.
660 First try FILE with `.elc' appended, then try with `.el',
661 then try FILE unmodified (the exact suffixes are determined by
662 `load-suffixes'). Environment variable references in FILE
663 are replaced with their values by calling `substitute-in-file-name'.
664 This function searches the directories in `load-path'.
665 If optional second arg NOERROR is non-nil,
666 report no error if FILE doesn't exist.
667 Print messages at start and end of loading unless
668 optional third arg NOMESSAGE is non-nil.
669 If optional fourth arg NOSUFFIX is non-nil, don't try adding
670 suffixes `.elc' or `.el' to the specified name FILE.
671 If optional fifth arg MUST-SUFFIX is non-nil, insist on
672 the suffix `.elc' or `.el'; don't accept just FILE unless
673 it ends in one of those suffixes or includes a directory name.
675 Loading a file records its definitions, and its `provide' and
676 `require' calls, in an element of `load-history' whose
677 car is the file name loaded. See `load-history'.
679 Return t if file exists. */)
680 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
681 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
683 register FILE *stream
;
684 register int fd
= -1;
685 int count
= SPECPDL_INDEX ();
687 struct gcpro gcpro1
, gcpro2
;
688 Lisp_Object found
, efound
;
689 /* 1 means we printed the ".el is newer" message. */
691 /* 1 means we are loading a compiled file. */
702 /* If file name is magic, call the handler. */
703 /* This shouldn't be necessary any more now that `openp' handles it right.
704 handler = Ffind_file_name_handler (file, Qload);
706 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
708 /* Do this after the handler to avoid
709 the need to gcpro noerror, nomessage and nosuffix.
710 (Below here, we care only whether they are nil or not.)
711 The presence of this call is the result of a historical accident:
712 it used to be in every file-operations and when it got removed
713 everywhere, it accidentally stayed here. Since then, enough people
714 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
715 that it seemed risky to remove. */
716 if (! NILP (noerror
))
718 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
719 Qt
, load_error_handler
);
724 file
= Fsubstitute_in_file_name (file
);
727 /* Avoid weird lossage with null string as arg,
728 since it would try to load a directory as a Lisp file */
729 if (SCHARS (file
) > 0)
731 int size
= SBYTES (file
);
735 GCPRO2 (file
, found
);
737 if (! NILP (must_suffix
))
739 /* Don't insist on adding a suffix if FILE already ends with one. */
741 && !strcmp (SDATA (file
) + size
- 3, ".el"))
744 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
746 /* Don't insist on adding a suffix
747 if the argument includes a directory name. */
748 else if (! NILP (Ffile_name_directory (file
)))
752 fd
= openp (Vload_path
, file
,
753 (!NILP (nosuffix
) ? Qnil
754 : !NILP (must_suffix
) ? Vload_suffixes
755 : Fappend (2, (tmp
[0] = Vload_suffixes
,
756 tmp
[1] = default_suffixes
,
765 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
766 Fcons (file
, Qnil
)));
771 /* Tell startup.el whether or not we found the user's init file. */
772 if (EQ (Qt
, Vuser_init_file
))
773 Vuser_init_file
= found
;
775 /* If FD is -2, that means openp found a magic file. */
778 if (NILP (Fequal (found
, file
)))
779 /* If FOUND is a different file name from FILE,
780 find its handler even if we have already inhibited
781 the `load' operation on FILE. */
782 handler
= Ffind_file_name_handler (found
, Qt
);
784 handler
= Ffind_file_name_handler (found
, Qload
);
785 if (! NILP (handler
))
786 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
789 /* Check if we're stuck in a recursive load cycle.
791 2000-09-21: It's not possible to just check for the file loaded
792 being a member of Vloads_in_progress. This fails because of the
793 way the byte compiler currently works; `provide's are not
794 evaluted, see font-lock.el/jit-lock.el as an example. This
795 leads to a certain amount of ``normal'' recursion.
797 Also, just loading a file recursively is not always an error in
798 the general case; the second load may do something different. */
802 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
803 if (!NILP (Fequal (found
, XCAR (tem
))))
809 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
810 Fcons (found
, Vloads_in_progress
)));
812 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
813 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
816 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
818 /* Load .elc files directly, but not when they are
819 remote and have no handler! */
826 GCPRO2 (file
, found
);
828 if (!safe_to_load_p (fd
))
831 if (!load_dangerous_libraries
)
835 error ("File `%s' was not compiled in Emacs",
838 else if (!NILP (nomessage
))
839 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
844 efound
= ENCODE_FILE (found
);
849 stat ((char *)SDATA (efound
), &s1
);
850 SSET (efound
, SBYTES (efound
) - 1, 0);
851 result
= stat ((char *)SDATA (efound
), &s2
);
852 SSET (efound
, SBYTES (efound
) - 1, 'c');
854 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
856 /* Make the progress messages mention that source is newer. */
859 /* If we won't print another message, mention this anyway. */
860 if (!NILP (nomessage
))
862 Lisp_Object msg_file
;
863 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
864 message_with_string ("Source file `%s' newer than byte-compiled file",
873 /* We are loading a source file (*.el). */
874 if (!NILP (Vload_source_file_function
))
880 val
= call4 (Vload_source_file_function
, found
, file
,
881 NILP (noerror
) ? Qnil
: Qt
,
882 NILP (nomessage
) ? Qnil
: Qt
);
883 return unbind_to (count
, val
);
887 GCPRO2 (file
, found
);
891 efound
= ENCODE_FILE (found
);
892 stream
= fopen ((char *) SDATA (efound
), fmode
);
893 #else /* not WINDOWSNT */
894 stream
= fdopen (fd
, fmode
);
895 #endif /* not WINDOWSNT */
899 error ("Failure to create stdio stream for %s", SDATA (file
));
902 if (! NILP (Vpurify_flag
))
903 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
905 if (NILP (nomessage
))
908 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
911 message_with_string ("Loading %s (source)...", file
, 1);
913 message_with_string ("Loading %s (compiled; note, source file is newer)...",
915 else /* The typical case; compiled file newer than source file. */
916 message_with_string ("Loading %s...", file
, 1);
919 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
920 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
921 specbind (Qload_file_name
, found
);
922 specbind (Qinhibit_file_name_operation
, Qnil
);
924 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
926 readevalloop (Qget_file_char
, stream
, (! NILP (Vpurify_flag
) ? file
: found
),
927 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
928 unbind_to (count
, Qnil
);
930 /* Run any load-hooks for this file. */
931 temp
= Fassoc (file
, Vafter_load_alist
);
933 Fprogn (Fcdr (temp
));
936 if (saved_doc_string
)
937 free (saved_doc_string
);
938 saved_doc_string
= 0;
939 saved_doc_string_size
= 0;
941 if (prev_saved_doc_string
)
942 xfree (prev_saved_doc_string
);
943 prev_saved_doc_string
= 0;
944 prev_saved_doc_string_size
= 0;
946 if (!noninteractive
&& NILP (nomessage
))
949 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
952 message_with_string ("Loading %s (source)...done", file
, 1);
954 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
956 else /* The typical case; compiled file newer than source file. */
957 message_with_string ("Loading %s...done", file
, 1);
960 if (!NILP (Fequal (build_string ("obsolete"),
961 Ffile_name_nondirectory
962 (Fdirectory_file_name (Ffile_name_directory (found
))))))
963 message_with_string ("Package %s is obsolete", file
, 1);
969 load_unwind (arg
) /* used as unwind-protect function in load */
972 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
975 if (--load_in_progress
< 0) load_in_progress
= 0;
980 load_descriptor_unwind (oldlist
)
983 load_descriptor_list
= oldlist
;
987 /* Close all descriptors in use for Floads.
988 This is used when starting a subprocess. */
995 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
996 emacs_close (XFASTINT (XCAR (tail
)));
1001 complete_filename_p (pathname
)
1002 Lisp_Object pathname
;
1004 register const unsigned char *s
= SDATA (pathname
);
1005 return (IS_DIRECTORY_SEP (s
[0])
1006 || (SCHARS (pathname
) > 2
1007 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1017 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1018 doc
: /* Search for FILENAME through PATH.
1019 Returns the file's name in absolute form, or nil if not found.
1020 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1021 file name when searching.
1022 If non-nil, PREDICATE is used instead of `file-readable-p'.
1023 PREDICATE can also be an integer to pass to the access(2) function,
1024 in which case file-name-handlers are ignored. */)
1025 (filename
, path
, suffixes
, predicate
)
1026 Lisp_Object filename
, path
, suffixes
, predicate
;
1029 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1030 if (NILP (predicate
) && fd
> 0)
1036 /* Search for a file whose name is STR, looking in directories
1037 in the Lisp list PATH, and trying suffixes from SUFFIX.
1038 On success, returns a file descriptor. On failure, returns -1.
1040 SUFFIXES is a list of strings containing possible suffixes.
1041 The empty suffix is automatically added iff the list is empty.
1043 PREDICATE non-nil means don't open the files,
1044 just look for one that satisfies the predicate. In this case,
1045 returns 1 on success. The predicate can be a lisp function or
1046 an integer to pass to `access' (in which case file-name-handlers
1049 If STOREPTR is nonzero, it points to a slot where the name of
1050 the file actually found should be stored as a Lisp string.
1051 nil is stored there on failure.
1053 If the file we find is remote, return -2
1054 but store the found remote file name in *STOREPTR. */
1057 openp (path
, str
, suffixes
, storeptr
, predicate
)
1058 Lisp_Object path
, str
;
1059 Lisp_Object suffixes
;
1060 Lisp_Object
*storeptr
;
1061 Lisp_Object predicate
;
1066 register char *fn
= buf
;
1069 Lisp_Object filename
;
1071 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1072 Lisp_Object string
, tail
, encoded_fn
;
1073 int max_suffix_len
= 0;
1077 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1079 CHECK_STRING_CAR (tail
);
1080 max_suffix_len
= max (max_suffix_len
,
1081 SBYTES (XCAR (tail
)));
1084 string
= filename
= encoded_fn
= Qnil
;
1085 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1090 if (complete_filename_p (str
))
1093 for (; CONSP (path
); path
= XCDR (path
))
1095 filename
= Fexpand_file_name (str
, XCAR (path
));
1096 if (!complete_filename_p (filename
))
1097 /* If there are non-absolute elts in PATH (eg ".") */
1098 /* Of course, this could conceivably lose if luser sets
1099 default-directory to be something non-absolute... */
1101 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1102 if (!complete_filename_p (filename
))
1103 /* Give up on this path element! */
1107 /* Calculate maximum size of any filename made from
1108 this path element/specified file name and any possible suffix. */
1109 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1110 if (fn_size
< want_size
)
1111 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1113 /* Loop over suffixes. */
1114 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1115 CONSP (tail
); tail
= XCDR (tail
))
1117 int lsuffix
= SBYTES (XCAR (tail
));
1118 Lisp_Object handler
;
1121 /* Concatenate path element/specified name with the suffix.
1122 If the directory starts with /:, remove that. */
1123 if (SCHARS (filename
) > 2
1124 && SREF (filename
, 0) == '/'
1125 && SREF (filename
, 1) == ':')
1127 strncpy (fn
, SDATA (filename
) + 2,
1128 SBYTES (filename
) - 2);
1129 fn
[SBYTES (filename
) - 2] = 0;
1133 strncpy (fn
, SDATA (filename
),
1135 fn
[SBYTES (filename
)] = 0;
1138 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1139 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1141 /* Check that the file exists and is not a directory. */
1142 /* We used to only check for handlers on non-absolute file names:
1146 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1147 It's not clear why that was the case and it breaks things like
1148 (load "/bar.el") where the file is actually "/bar.el.gz". */
1149 string
= build_string (fn
);
1150 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1151 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1153 if (NILP (predicate
))
1154 exists
= !NILP (Ffile_readable_p (string
));
1156 exists
= !NILP (call1 (predicate
, string
));
1157 if (exists
&& !NILP (Ffile_directory_p (string
)))
1162 /* We succeeded; return this descriptor and filename. */
1173 encoded_fn
= ENCODE_FILE (string
);
1174 pfn
= SDATA (encoded_fn
);
1175 exists
= (stat (pfn
, &st
) >= 0
1176 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1179 /* Check that we can access or open it. */
1180 if (NATNUMP (predicate
))
1181 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1183 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1187 /* We succeeded; return this descriptor and filename. */
1205 /* Merge the list we've accumulated of globals from the current input source
1206 into the load_history variable. The details depend on whether
1207 the source has an associated file name or not.
1209 FILENAME is the file name that we are loading from.
1210 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1213 build_load_history (filename
, entire
)
1214 Lisp_Object filename
;
1217 register Lisp_Object tail
, prev
, newelt
;
1218 register Lisp_Object tem
, tem2
;
1219 register int foundit
= 0;
1221 tail
= Vload_history
;
1224 while (CONSP (tail
))
1228 /* Find the feature's previous assoc list... */
1229 if (!NILP (Fequal (filename
, Fcar (tem
))))
1233 /* If we're loading the entire file, remove old data. */
1237 Vload_history
= XCDR (tail
);
1239 Fsetcdr (prev
, XCDR (tail
));
1242 /* Otherwise, cons on new symbols that are not already members. */
1245 tem2
= Vcurrent_load_list
;
1247 while (CONSP (tem2
))
1249 newelt
= XCAR (tem2
);
1251 if (NILP (Fmember (newelt
, tem
)))
1252 Fsetcar (tail
, Fcons (XCAR (tem
),
1253 Fcons (newelt
, XCDR (tem
))));
1266 /* If we're loading an entire file, cons the new assoc onto the
1267 front of load-history, the most-recently-loaded position. Also
1268 do this if we didn't find an existing member for the file. */
1269 if (entire
|| !foundit
)
1270 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1275 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1283 readevalloop_1 (old
)
1286 load_convert_to_unibyte
= ! NILP (old
);
1290 /* Signal an `end-of-file' error, if possible with file name
1294 end_of_file_error ()
1298 if (STRINGP (Vload_file_name
))
1299 data
= Fcons (Vload_file_name
, Qnil
);
1303 Fsignal (Qend_of_file
, data
);
1306 /* UNIBYTE specifies how to set load_convert_to_unibyte
1307 for this invocation.
1308 READFUN, if non-nil, is used instead of `read'.
1309 START, END is region in current buffer (from eval-region). */
1312 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1313 printflag
, unibyte
, readfun
, start
, end
)
1314 Lisp_Object readcharfun
;
1316 Lisp_Object sourcename
;
1317 Lisp_Object (*evalfun
) ();
1319 Lisp_Object unibyte
, readfun
;
1320 Lisp_Object start
, end
;
1323 register Lisp_Object val
;
1324 int count
= SPECPDL_INDEX ();
1325 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1326 struct buffer
*b
= 0;
1328 int continue_reading_p
;
1329 /* Nonzero if reading an entire buffer. */
1330 int whole_buffer
= 0;
1331 /* 1 on the first time around. */
1334 if (MARKERP (readcharfun
))
1337 start
= readcharfun
;
1340 if (BUFFERP (readcharfun
))
1341 b
= XBUFFER (readcharfun
);
1342 else if (MARKERP (readcharfun
))
1343 b
= XMARKER (readcharfun
)->buffer
;
1345 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1346 specbind (Qcurrent_load_list
, Qnil
);
1347 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1348 load_convert_to_unibyte
= !NILP (unibyte
);
1350 readchar_backlog
= -1;
1352 GCPRO4 (sourcename
, readfun
, start
, end
);
1354 LOADHIST_ATTACH (sourcename
);
1356 continue_reading_p
= 1;
1357 while (continue_reading_p
)
1359 int count1
= SPECPDL_INDEX ();
1361 if (b
!= 0 && NILP (b
->name
))
1362 error ("Reading from killed buffer");
1366 /* Switch to the buffer we are reading from. */
1367 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1368 set_buffer_internal (b
);
1370 /* Save point in it. */
1371 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1372 /* Save ZV in it. */
1373 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1374 /* Those get unbound after we read one expression. */
1376 /* Set point and ZV around stuff to be read. */
1379 Fnarrow_to_region (make_number (BEGV
), end
);
1381 /* Just for cleanliness, convert END to a marker
1382 if it is an integer. */
1384 end
= Fpoint_max_marker ();
1387 /* On the first cycle, we can easily test here
1388 whether we are reading the whole buffer. */
1389 if (b
&& first_sexp
)
1390 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1397 while ((c
= READCHAR
) != '\n' && c
!= -1);
1402 unbind_to (count1
, Qnil
);
1406 /* Ignore whitespace here, so we can detect eof. */
1407 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1410 if (!NILP (Vpurify_flag
) && c
== '(')
1412 record_unwind_protect (unreadpure
, Qnil
);
1413 val
= read_list (-1, readcharfun
);
1418 read_objects
= Qnil
;
1419 if (!NILP (readfun
))
1421 val
= call1 (readfun
, readcharfun
);
1423 /* If READCHARFUN has set point to ZV, we should
1424 stop reading, even if the form read sets point
1425 to a different value when evaluated. */
1426 if (BUFFERP (readcharfun
))
1428 struct buffer
*b
= XBUFFER (readcharfun
);
1429 if (BUF_PT (b
) == BUF_ZV (b
))
1430 continue_reading_p
= 0;
1433 else if (! NILP (Vload_read_function
))
1434 val
= call1 (Vload_read_function
, readcharfun
);
1436 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1439 if (!NILP (start
) && continue_reading_p
)
1440 start
= Fpoint_marker ();
1442 /* Restore saved point and BEGV. */
1443 unbind_to (count1
, Qnil
);
1445 /* Now eval what we just read. */
1446 val
= (*evalfun
) (val
);
1450 Vvalues
= Fcons (val
, Vvalues
);
1451 if (EQ (Vstandard_output
, Qt
))
1460 build_load_history (sourcename
,
1461 stream
|| whole_buffer
);
1465 unbind_to (count
, Qnil
);
1468 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1469 doc
: /* Execute the current buffer as Lisp code.
1470 Programs can pass two arguments, BUFFER and PRINTFLAG.
1471 BUFFER is the buffer to evaluate (nil means use current buffer).
1472 PRINTFLAG controls printing of output:
1473 nil means discard it; anything else is stream for print.
1475 If the optional third argument FILENAME is non-nil,
1476 it specifies the file name to use for `load-history'.
1477 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1478 for this invocation.
1480 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1481 `print' and related functions should work normally even if PRINTFLAG is nil.
1483 This function preserves the position of point. */)
1484 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1485 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1487 int count
= SPECPDL_INDEX ();
1488 Lisp_Object tem
, buf
;
1491 buf
= Fcurrent_buffer ();
1493 buf
= Fget_buffer (buffer
);
1495 error ("No such buffer");
1497 if (NILP (printflag
) && NILP (do_allow_print
))
1502 if (NILP (filename
))
1503 filename
= XBUFFER (buf
)->filename
;
1505 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1506 specbind (Qstandard_output
, tem
);
1507 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1508 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1509 readevalloop (buf
, 0, filename
, Feval
,
1510 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1511 unbind_to (count
, Qnil
);
1516 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1517 doc
: /* Execute the region as Lisp code.
1518 When called from programs, expects two arguments,
1519 giving starting and ending indices in the current buffer
1520 of the text to be executed.
1521 Programs can pass third argument PRINTFLAG which controls output:
1522 nil means discard it; anything else is stream for printing it.
1523 Also the fourth argument READ-FUNCTION, if non-nil, is used
1524 instead of `read' to read each expression. It gets one argument
1525 which is the input stream for reading characters.
1527 This function does not move point. */)
1528 (start
, end
, printflag
, read_function
)
1529 Lisp_Object start
, end
, printflag
, read_function
;
1531 int count
= SPECPDL_INDEX ();
1532 Lisp_Object tem
, cbuf
;
1534 cbuf
= Fcurrent_buffer ();
1536 if (NILP (printflag
))
1540 specbind (Qstandard_output
, tem
);
1541 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1543 /* readevalloop calls functions which check the type of start and end. */
1544 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1545 !NILP (printflag
), Qnil
, read_function
,
1548 return unbind_to (count
, Qnil
);
1552 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1553 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1554 If STREAM is nil, use the value of `standard-input' (which see).
1555 STREAM or the value of `standard-input' may be:
1556 a buffer (read from point and advance it)
1557 a marker (read from where it points and advance it)
1558 a function (call it with no arguments for each character,
1559 call it with a char as argument to push a char back)
1560 a string (takes text from string, starting at the beginning)
1561 t (read text line using minibuffer and use it, or read from
1562 standard input in batch mode). */)
1567 stream
= Vstandard_input
;
1568 if (EQ (stream
, Qt
))
1569 stream
= Qread_char
;
1570 if (EQ (stream
, Qread_char
))
1571 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1573 return read_internal_start (stream
, Qnil
, Qnil
);
1576 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1577 doc
: /* Read one Lisp expression which is represented as text by STRING.
1578 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1579 START and END optionally delimit a substring of STRING from which to read;
1580 they default to 0 and (length STRING) respectively. */)
1581 (string
, start
, end
)
1582 Lisp_Object string
, start
, end
;
1585 CHECK_STRING (string
);
1586 /* read_internal_start sets read_from_string_index. */
1587 ret
= read_internal_start (string
, start
, end
);
1588 return Fcons (ret
, make_number (read_from_string_index
));
1591 /* Function to set up the global context we need in toplevel read
1594 read_internal_start (stream
, start
, end
)
1596 Lisp_Object start
; /* Only used when stream is a string. */
1597 Lisp_Object end
; /* Only used when stream is a string. */
1601 readchar_backlog
= -1;
1603 new_backquote_flag
= 0;
1604 read_objects
= Qnil
;
1605 if (EQ (Vread_with_symbol_positions
, Qt
)
1606 || EQ (Vread_with_symbol_positions
, stream
))
1607 Vread_symbol_positions_list
= Qnil
;
1609 if (STRINGP (stream
))
1611 int startval
, endval
;
1613 endval
= SCHARS (stream
);
1617 endval
= XINT (end
);
1618 if (endval
< 0 || endval
> SCHARS (stream
))
1619 args_out_of_range (stream
, end
);
1626 CHECK_NUMBER (start
);
1627 startval
= XINT (start
);
1628 if (startval
< 0 || startval
> endval
)
1629 args_out_of_range (stream
, start
);
1631 read_from_string_index
= startval
;
1632 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1633 read_from_string_limit
= endval
;
1636 retval
= read0 (stream
);
1637 if (EQ (Vread_with_symbol_positions
, Qt
)
1638 || EQ (Vread_with_symbol_positions
, stream
))
1639 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1643 /* Use this for recursive reads, in contexts where internal tokens
1648 Lisp_Object readcharfun
;
1650 register Lisp_Object val
;
1653 val
= read1 (readcharfun
, &c
, 0);
1655 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1662 static int read_buffer_size
;
1663 static char *read_buffer
;
1665 /* Read multibyte form and return it as a character. C is a first
1666 byte of multibyte form, and rest of them are read from
1670 read_multibyte (c
, readcharfun
)
1672 Lisp_Object readcharfun
;
1674 /* We need the actual character code of this multibyte
1676 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1684 while ((c
= READCHAR
) >= 0xA0
1685 && len
< MAX_MULTIBYTE_LENGTH
)
1691 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1692 return STRING_CHAR (str
, len
);
1693 /* The byte sequence is not valid as multibyte. Unread all bytes
1694 but the first one, and return the first byte. */
1700 /* Read a \-escape sequence, assuming we already read the `\'.
1701 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1702 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1703 Otherwise store 0 into *BYTEREP. */
1706 read_escape (readcharfun
, stringp
, byterep
)
1707 Lisp_Object readcharfun
;
1711 register int c
= READCHAR
;
1718 end_of_file_error ();
1748 error ("Invalid escape character syntax");
1751 c
= read_escape (readcharfun
, 0, byterep
);
1752 return c
| meta_modifier
;
1757 error ("Invalid escape character syntax");
1760 c
= read_escape (readcharfun
, 0, byterep
);
1761 return c
| shift_modifier
;
1766 error ("Invalid escape character syntax");
1769 c
= read_escape (readcharfun
, 0, byterep
);
1770 return c
| hyper_modifier
;
1775 error ("Invalid escape character syntax");
1778 c
= read_escape (readcharfun
, 0, byterep
);
1779 return c
| alt_modifier
;
1790 c
= read_escape (readcharfun
, 0, byterep
);
1791 return c
| super_modifier
;
1796 error ("Invalid escape character syntax");
1800 c
= read_escape (readcharfun
, 0, byterep
);
1801 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1802 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1803 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1804 return c
| ctrl_modifier
;
1805 /* ASCII control chars are made from letters (both cases),
1806 as well as the non-letters within 0100...0137. */
1807 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1808 return (c
& (037 | ~0177));
1809 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1810 return (c
& (037 | ~0177));
1812 return c
| ctrl_modifier
;
1822 /* An octal escape, as in ANSI C. */
1824 register int i
= c
- '0';
1825 register int count
= 0;
1828 if ((c
= READCHAR
) >= '0' && c
<= '7')
1845 /* A hex escape, as in ANSI C. */
1851 if (c
>= '0' && c
<= '9')
1856 else if ((c
>= 'a' && c
<= 'f')
1857 || (c
>= 'A' && c
<= 'F'))
1860 if (c
>= 'a' && c
<= 'f')
1877 if (BASE_LEADING_CODE_P (c
))
1878 c
= read_multibyte (c
, readcharfun
);
1884 /* Read an integer in radix RADIX using READCHARFUN to read
1885 characters. RADIX must be in the interval [2..36]; if it isn't, a
1886 read error is signaled . Value is the integer read. Signals an
1887 error if encountering invalid read syntax or if RADIX is out of
1891 read_integer (readcharfun
, radix
)
1892 Lisp_Object readcharfun
;
1895 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1896 EMACS_INT number
= 0;
1898 if (radix
< 2 || radix
> 36)
1902 number
= ndigits
= invalid_p
= 0;
1918 if (c
>= '0' && c
<= '9')
1920 else if (c
>= 'a' && c
<= 'z')
1921 digit
= c
- 'a' + 10;
1922 else if (c
>= 'A' && c
<= 'Z')
1923 digit
= c
- 'A' + 10;
1930 if (digit
< 0 || digit
>= radix
)
1933 number
= radix
* number
+ digit
;
1939 if (ndigits
== 0 || invalid_p
)
1942 sprintf (buf
, "integer, radix %d", radix
);
1943 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1946 return make_number (sign
* number
);
1950 /* Convert unibyte text in read_buffer to multibyte.
1952 Initially, *P is a pointer after the end of the unibyte text, and
1953 the pointer *END points after the end of read_buffer.
1955 If read_buffer doesn't have enough room to hold the result
1956 of the conversion, reallocate it and adjust *P and *END.
1958 At the end, make *P point after the result of the conversion, and
1959 return in *NCHARS the number of characters in the converted
1963 to_multibyte (p
, end
, nchars
)
1969 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1970 if (read_buffer_size
< 2 * nbytes
)
1972 int offset
= *p
- read_buffer
;
1973 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1974 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1975 *p
= read_buffer
+ offset
;
1976 *end
= read_buffer
+ read_buffer_size
;
1979 if (nbytes
!= *nchars
)
1980 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1981 *p
- read_buffer
, nchars
);
1983 *p
= read_buffer
+ nbytes
;
1987 /* If the next token is ')' or ']' or '.', we store that character
1988 in *PCH and the return value is not interesting. Else, we store
1989 zero in *PCH and we read and return one lisp object.
1991 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1994 read1 (readcharfun
, pch
, first_in_list
)
1995 register Lisp_Object readcharfun
;
2000 int uninterned_symbol
= 0;
2008 end_of_file_error ();
2013 return read_list (0, readcharfun
);
2016 return read_vector (readcharfun
, 0);
2033 tmp
= read_vector (readcharfun
, 0);
2034 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
2035 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
2036 error ("Invalid size char-table");
2037 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2038 XCHAR_TABLE (tmp
)->top
= Qt
;
2047 tmp
= read_vector (readcharfun
, 0);
2048 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2049 error ("Invalid size char-table");
2050 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2051 XCHAR_TABLE (tmp
)->top
= Qnil
;
2054 Fsignal (Qinvalid_read_syntax
,
2055 Fcons (make_string ("#^^", 3), Qnil
));
2057 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2062 length
= read1 (readcharfun
, pch
, first_in_list
);
2066 Lisp_Object tmp
, val
;
2068 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2069 / BOOL_VECTOR_BITS_PER_CHAR
);
2072 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2073 if (size_in_chars
!= SCHARS (tmp
)
2074 /* We used to print 1 char too many
2075 when the number of bits was a multiple of 8.
2076 Accept such input in case it came from an old version. */
2077 && ! (XFASTINT (length
)
2078 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2079 Fsignal (Qinvalid_read_syntax
,
2080 Fcons (make_string ("#&...", 5), Qnil
));
2082 val
= Fmake_bool_vector (length
, Qnil
);
2083 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2085 /* Clear the extraneous bits in the last byte. */
2086 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2087 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2088 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2091 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2096 /* Accept compiled functions at read-time so that we don't have to
2097 build them using function calls. */
2099 tmp
= read_vector (readcharfun
, 1);
2100 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2101 XVECTOR (tmp
)->contents
);
2106 struct gcpro gcpro1
;
2109 /* Read the string itself. */
2110 tmp
= read1 (readcharfun
, &ch
, 0);
2111 if (ch
!= 0 || !STRINGP (tmp
))
2112 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2114 /* Read the intervals and their properties. */
2117 Lisp_Object beg
, end
, plist
;
2119 beg
= read1 (readcharfun
, &ch
, 0);
2124 end
= read1 (readcharfun
, &ch
, 0);
2126 plist
= read1 (readcharfun
, &ch
, 0);
2128 Fsignal (Qinvalid_read_syntax
,
2129 Fcons (build_string ("invalid string property list"),
2131 Fset_text_properties (beg
, end
, plist
, tmp
);
2137 /* #@NUMBER is used to skip NUMBER following characters.
2138 That's used in .elc files to skip over doc strings
2139 and function definitions. */
2144 /* Read a decimal integer. */
2145 while ((c
= READCHAR
) >= 0
2146 && c
>= '0' && c
<= '9')
2154 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2156 /* If we are supposed to force doc strings into core right now,
2157 record the last string that we skipped,
2158 and record where in the file it comes from. */
2160 /* But first exchange saved_doc_string
2161 with prev_saved_doc_string, so we save two strings. */
2163 char *temp
= saved_doc_string
;
2164 int temp_size
= saved_doc_string_size
;
2165 file_offset temp_pos
= saved_doc_string_position
;
2166 int temp_len
= saved_doc_string_length
;
2168 saved_doc_string
= prev_saved_doc_string
;
2169 saved_doc_string_size
= prev_saved_doc_string_size
;
2170 saved_doc_string_position
= prev_saved_doc_string_position
;
2171 saved_doc_string_length
= prev_saved_doc_string_length
;
2173 prev_saved_doc_string
= temp
;
2174 prev_saved_doc_string_size
= temp_size
;
2175 prev_saved_doc_string_position
= temp_pos
;
2176 prev_saved_doc_string_length
= temp_len
;
2179 if (saved_doc_string_size
== 0)
2181 saved_doc_string_size
= nskip
+ 100;
2182 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2184 if (nskip
> saved_doc_string_size
)
2186 saved_doc_string_size
= nskip
+ 100;
2187 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2188 saved_doc_string_size
);
2191 saved_doc_string_position
= file_tell (instream
);
2193 /* Copy that many characters into saved_doc_string. */
2194 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2195 saved_doc_string
[i
] = c
= READCHAR
;
2197 saved_doc_string_length
= i
;
2201 /* Skip that many characters. */
2202 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2210 /* #! appears at the beginning of an executable file.
2211 Skip the first line. */
2212 while (c
!= '\n' && c
>= 0)
2217 return Vload_file_name
;
2219 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2220 /* #:foo is the uninterned symbol named foo. */
2223 uninterned_symbol
= 1;
2227 /* Reader forms that can reuse previously read objects. */
2228 if (c
>= '0' && c
<= '9')
2233 /* Read a non-negative integer. */
2234 while (c
>= '0' && c
<= '9')
2240 /* #n=object returns object, but associates it with n for #n#. */
2243 /* Make a placeholder for #n# to use temporarily */
2244 Lisp_Object placeholder
;
2247 placeholder
= Fcons(Qnil
, Qnil
);
2248 cell
= Fcons (make_number (n
), placeholder
);
2249 read_objects
= Fcons (cell
, read_objects
);
2251 /* Read the object itself. */
2252 tem
= read0 (readcharfun
);
2254 /* Now put it everywhere the placeholder was... */
2255 substitute_object_in_subtree (tem
, placeholder
);
2257 /* ...and #n# will use the real value from now on. */
2258 Fsetcdr (cell
, tem
);
2262 /* #n# returns a previously read object. */
2265 tem
= Fassq (make_number (n
), read_objects
);
2268 /* Fall through to error message. */
2270 else if (c
== 'r' || c
== 'R')
2271 return read_integer (readcharfun
, n
);
2273 /* Fall through to error message. */
2275 else if (c
== 'x' || c
== 'X')
2276 return read_integer (readcharfun
, 16);
2277 else if (c
== 'o' || c
== 'O')
2278 return read_integer (readcharfun
, 8);
2279 else if (c
== 'b' || c
== 'B')
2280 return read_integer (readcharfun
, 2);
2283 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2286 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2291 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2301 new_backquote_flag
++;
2302 value
= read0 (readcharfun
);
2303 new_backquote_flag
--;
2305 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2309 if (new_backquote_flag
)
2311 Lisp_Object comma_type
= Qnil
;
2316 comma_type
= Qcomma_at
;
2318 comma_type
= Qcomma_dot
;
2321 if (ch
>= 0) UNREAD (ch
);
2322 comma_type
= Qcomma
;
2325 new_backquote_flag
--;
2326 value
= read0 (readcharfun
);
2327 new_backquote_flag
++;
2328 return Fcons (comma_type
, Fcons (value
, Qnil
));
2341 end_of_file_error ();
2343 /* Accept `single space' syntax like (list ? x) where the
2344 whitespace character is SPC or TAB.
2345 Other literal whitespace like NL, CR, and FF are not accepted,
2346 as there are well-established escape sequences for these. */
2347 if (c
== ' ' || c
== '\t')
2348 return make_number (c
);
2351 c
= read_escape (readcharfun
, 0, &discard
);
2352 else if (BASE_LEADING_CODE_P (c
))
2353 c
= read_multibyte (c
, readcharfun
);
2355 next_char
= READCHAR
;
2356 if (next_char
== '.')
2358 /* Only a dotted-pair dot is valid after a char constant. */
2359 int next_next_char
= READCHAR
;
2360 UNREAD (next_next_char
);
2362 ok
= (next_next_char
<= 040
2363 || (next_next_char
< 0200
2364 && (index ("\"';([#?", next_next_char
)
2365 || (!first_in_list
&& next_next_char
== '`')
2366 || (new_backquote_flag
&& next_next_char
== ','))));
2370 ok
= (next_char
<= 040
2371 || (next_char
< 0200
2372 && (index ("\"';()[]#?", next_char
)
2373 || (!first_in_list
&& next_char
== '`')
2374 || (new_backquote_flag
&& next_char
== ','))));
2378 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2380 return make_number (c
);
2385 char *p
= read_buffer
;
2386 char *end
= read_buffer
+ read_buffer_size
;
2388 /* 1 if we saw an escape sequence specifying
2389 a multibyte character, or a multibyte character. */
2390 int force_multibyte
= 0;
2391 /* 1 if we saw an escape sequence specifying
2392 a single-byte character. */
2393 int force_singlebyte
= 0;
2394 /* 1 if read_buffer contains multibyte text now. */
2395 int is_multibyte
= 0;
2399 while ((c
= READCHAR
) >= 0
2402 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2404 int offset
= p
- read_buffer
;
2405 read_buffer
= (char *) xrealloc (read_buffer
,
2406 read_buffer_size
*= 2);
2407 p
= read_buffer
+ offset
;
2408 end
= read_buffer
+ read_buffer_size
;
2415 c
= read_escape (readcharfun
, 1, &byterep
);
2417 /* C is -1 if \ newline has just been seen */
2420 if (p
== read_buffer
)
2426 force_singlebyte
= 1;
2427 else if (byterep
== 2)
2428 force_multibyte
= 1;
2431 /* A character that must be multibyte forces multibyte. */
2432 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2433 force_multibyte
= 1;
2435 /* If we just discovered the need to be multibyte,
2436 convert the text accumulated thus far. */
2437 if (force_multibyte
&& ! is_multibyte
)
2440 to_multibyte (&p
, &end
, &nchars
);
2443 /* Allow `\C- ' and `\C-?'. */
2444 if (c
== (CHAR_CTL
| ' '))
2446 else if (c
== (CHAR_CTL
| '?'))
2451 /* Shift modifier is valid only with [A-Za-z]. */
2452 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2454 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2455 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2459 /* Move the meta bit to the right place for a string. */
2460 c
= (c
& ~CHAR_META
) | 0x80;
2461 if (c
& CHAR_MODIFIER_MASK
)
2462 error ("Invalid modifier in string");
2465 p
+= CHAR_STRING (c
, p
);
2473 end_of_file_error ();
2475 /* If purifying, and string starts with \ newline,
2476 return zero instead. This is for doc strings
2477 that we are really going to find in etc/DOC.nn.nn */
2478 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2479 return make_number (0);
2481 if (is_multibyte
|| force_singlebyte
)
2483 else if (load_convert_to_unibyte
)
2486 to_multibyte (&p
, &end
, &nchars
);
2487 if (p
- read_buffer
!= nchars
)
2489 string
= make_multibyte_string (read_buffer
, nchars
,
2491 return Fstring_make_unibyte (string
);
2493 /* We can make a unibyte string directly. */
2496 else if (EQ (readcharfun
, Qget_file_char
)
2497 || EQ (readcharfun
, Qlambda
))
2499 /* Nowadays, reading directly from a file is used only for
2500 compiled Emacs Lisp files, and those always use the
2501 Emacs internal encoding. Meanwhile, Qlambda is used
2502 for reading dynamic byte code (compiled with
2503 byte-compile-dynamic = t). So make the string multibyte
2504 if the string contains any multibyte sequences.
2505 (to_multibyte is a no-op if not.) */
2506 to_multibyte (&p
, &end
, &nchars
);
2507 is_multibyte
= (p
- read_buffer
) != nchars
;
2510 /* In all other cases, if we read these bytes as
2511 separate characters, treat them as separate characters now. */
2514 /* We want readchar_count to be the number of characters, not
2515 bytes. Hence we adjust for multibyte characters in the
2516 string. ... But it doesn't seem to be necessary, because
2517 READCHAR *does* read multibyte characters from buffers. */
2518 /* readchar_count -= (p - read_buffer) - nchars; */
2520 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2522 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2528 int next_char
= READCHAR
;
2531 if (next_char
<= 040
2532 || (next_char
< 0200
2533 && (index ("\"';([#?", next_char
)
2534 || (!first_in_list
&& next_char
== '`')
2535 || (new_backquote_flag
&& next_char
== ','))))
2541 /* Otherwise, we fall through! Note that the atom-reading loop
2542 below will now loop at least once, assuring that we will not
2543 try to UNREAD two characters in a row. */
2547 if (c
<= 040) goto retry
;
2549 char *p
= read_buffer
;
2553 char *end
= read_buffer
+ read_buffer_size
;
2557 || (!index ("\"';()[]#", c
)
2558 && !(!first_in_list
&& c
== '`')
2559 && !(new_backquote_flag
&& c
== ','))))
2561 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2563 int offset
= p
- read_buffer
;
2564 read_buffer
= (char *) xrealloc (read_buffer
,
2565 read_buffer_size
*= 2);
2566 p
= read_buffer
+ offset
;
2567 end
= read_buffer
+ read_buffer_size
;
2574 end_of_file_error ();
2578 if (! SINGLE_BYTE_CHAR_P (c
))
2579 p
+= CHAR_STRING (c
, p
);
2588 int offset
= p
- read_buffer
;
2589 read_buffer
= (char *) xrealloc (read_buffer
,
2590 read_buffer_size
*= 2);
2591 p
= read_buffer
+ offset
;
2592 end
= read_buffer
+ read_buffer_size
;
2599 if (!quoted
&& !uninterned_symbol
)
2602 register Lisp_Object val
;
2604 if (*p1
== '+' || *p1
== '-') p1
++;
2605 /* Is it an integer? */
2608 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2609 /* Integers can have trailing decimal points. */
2610 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2612 /* It is an integer. */
2616 if (sizeof (int) == sizeof (EMACS_INT
))
2617 XSETINT (val
, atoi (read_buffer
));
2618 else if (sizeof (long) == sizeof (EMACS_INT
))
2619 XSETINT (val
, atol (read_buffer
));
2625 if (isfloat_string (read_buffer
))
2627 /* Compute NaN and infinities using 0.0 in a variable,
2628 to cope with compilers that think they are smarter
2634 /* Negate the value ourselves. This treats 0, NaNs,
2635 and infinity properly on IEEE floating point hosts,
2636 and works around a common bug where atof ("-0.0")
2638 int negative
= read_buffer
[0] == '-';
2640 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2641 returns 1, is if the input ends in e+INF or e+NaN. */
2648 value
= zero
/ zero
;
2650 /* If that made a "negative" NaN, negate it. */
2654 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2657 u_minus_zero
.d
= - 0.0;
2658 for (i
= 0; i
< sizeof (double); i
++)
2659 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2665 /* Now VALUE is a positive NaN. */
2668 value
= atof (read_buffer
+ negative
);
2672 return make_float (negative
? - value
: value
);
2676 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2677 : intern (read_buffer
);
2678 if (EQ (Vread_with_symbol_positions
, Qt
)
2679 || EQ (Vread_with_symbol_positions
, readcharfun
))
2680 Vread_symbol_positions_list
=
2681 /* Kind of a hack; this will probably fail if characters
2682 in the symbol name were escaped. Not really a big
2684 Fcons (Fcons (result
,
2685 make_number (readchar_count
2686 - XFASTINT (Flength (Fsymbol_name (result
))))),
2687 Vread_symbol_positions_list
);
2695 /* List of nodes we've seen during substitute_object_in_subtree. */
2696 static Lisp_Object seen_list
;
2699 substitute_object_in_subtree (object
, placeholder
)
2701 Lisp_Object placeholder
;
2703 Lisp_Object check_object
;
2705 /* We haven't seen any objects when we start. */
2708 /* Make all the substitutions. */
2710 = substitute_object_recurse (object
, placeholder
, object
);
2712 /* Clear seen_list because we're done with it. */
2715 /* The returned object here is expected to always eq the
2717 if (!EQ (check_object
, object
))
2718 error ("Unexpected mutation error in reader");
2721 /* Feval doesn't get called from here, so no gc protection is needed. */
2722 #define SUBSTITUTE(get_val, set_val) \
2724 Lisp_Object old_value = get_val; \
2725 Lisp_Object true_value \
2726 = substitute_object_recurse (object, placeholder,\
2729 if (!EQ (old_value, true_value)) \
2736 substitute_object_recurse (object
, placeholder
, subtree
)
2738 Lisp_Object placeholder
;
2739 Lisp_Object subtree
;
2741 /* If we find the placeholder, return the target object. */
2742 if (EQ (placeholder
, subtree
))
2745 /* If we've been to this node before, don't explore it again. */
2746 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2749 /* If this node can be the entry point to a cycle, remember that
2750 we've seen it. It can only be such an entry point if it was made
2751 by #n=, which means that we can find it as a value in
2753 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2754 seen_list
= Fcons (subtree
, seen_list
);
2756 /* Recurse according to subtree's type.
2757 Every branch must return a Lisp_Object. */
2758 switch (XTYPE (subtree
))
2760 case Lisp_Vectorlike
:
2763 int length
= XINT (Flength(subtree
));
2764 for (i
= 0; i
< length
; i
++)
2766 Lisp_Object idx
= make_number (i
);
2767 SUBSTITUTE (Faref (subtree
, idx
),
2768 Faset (subtree
, idx
, true_value
));
2775 SUBSTITUTE (Fcar_safe (subtree
),
2776 Fsetcar (subtree
, true_value
));
2777 SUBSTITUTE (Fcdr_safe (subtree
),
2778 Fsetcdr (subtree
, true_value
));
2784 /* Check for text properties in each interval.
2785 substitute_in_interval contains part of the logic. */
2787 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2788 Lisp_Object arg
= Fcons (object
, placeholder
);
2790 traverse_intervals_noorder (root_interval
,
2791 &substitute_in_interval
, arg
);
2796 /* Other types don't recurse any further. */
2802 /* Helper function for substitute_object_recurse. */
2804 substitute_in_interval (interval
, arg
)
2808 Lisp_Object object
= Fcar (arg
);
2809 Lisp_Object placeholder
= Fcdr (arg
);
2811 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2830 if (*cp
== '+' || *cp
== '-')
2833 if (*cp
>= '0' && *cp
<= '9')
2836 while (*cp
>= '0' && *cp
<= '9')
2844 if (*cp
>= '0' && *cp
<= '9')
2847 while (*cp
>= '0' && *cp
<= '9')
2850 if (*cp
== 'e' || *cp
== 'E')
2854 if (*cp
== '+' || *cp
== '-')
2858 if (*cp
>= '0' && *cp
<= '9')
2861 while (*cp
>= '0' && *cp
<= '9')
2864 else if (cp
== start
)
2866 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2871 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2877 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2878 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2879 || state
== (DOT_CHAR
|TRAIL_INT
)
2880 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2881 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2882 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2887 read_vector (readcharfun
, bytecodeflag
)
2888 Lisp_Object readcharfun
;
2893 register Lisp_Object
*ptr
;
2894 register Lisp_Object tem
, item
, vector
;
2895 register struct Lisp_Cons
*otem
;
2898 tem
= read_list (1, readcharfun
);
2899 len
= Flength (tem
);
2900 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2902 size
= XVECTOR (vector
)->size
;
2903 ptr
= XVECTOR (vector
)->contents
;
2904 for (i
= 0; i
< size
; i
++)
2907 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2908 bytecode object, the docstring containing the bytecode and
2909 constants values must be treated as unibyte and passed to
2910 Fread, to get the actual bytecode string and constants vector. */
2911 if (bytecodeflag
&& load_force_doc_strings
)
2913 if (i
== COMPILED_BYTECODE
)
2915 if (!STRINGP (item
))
2916 error ("Invalid byte code");
2918 /* Delay handling the bytecode slot until we know whether
2919 it is lazily-loaded (we can tell by whether the
2920 constants slot is nil). */
2921 ptr
[COMPILED_CONSTANTS
] = item
;
2924 else if (i
== COMPILED_CONSTANTS
)
2926 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2930 /* Coerce string to unibyte (like string-as-unibyte,
2931 but without generating extra garbage and
2932 guaranteeing no change in the contents). */
2933 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2934 STRING_SET_UNIBYTE (bytestr
);
2936 item
= Fread (bytestr
);
2938 error ("Invalid byte code");
2940 otem
= XCONS (item
);
2941 bytestr
= XCAR (item
);
2946 /* Now handle the bytecode slot. */
2947 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2950 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2958 /* FLAG = 1 means check for ] to terminate rather than ) and .
2959 FLAG = -1 means check for starting with defun
2960 and make structure pure. */
2963 read_list (flag
, readcharfun
)
2965 register Lisp_Object readcharfun
;
2967 /* -1 means check next element for defun,
2968 0 means don't check,
2969 1 means already checked and found defun. */
2970 int defunflag
= flag
< 0 ? -1 : 0;
2971 Lisp_Object val
, tail
;
2972 register Lisp_Object elt
, tem
;
2973 struct gcpro gcpro1
, gcpro2
;
2974 /* 0 is the normal case.
2975 1 means this list is a doc reference; replace it with the number 0.
2976 2 means this list is a doc reference; replace it with the doc string. */
2977 int doc_reference
= 0;
2979 /* Initialize this to 1 if we are reading a list. */
2980 int first_in_list
= flag
<= 0;
2989 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2994 /* While building, if the list starts with #$, treat it specially. */
2995 if (EQ (elt
, Vload_file_name
)
2997 && !NILP (Vpurify_flag
))
2999 if (NILP (Vdoc_file_name
))
3000 /* We have not yet called Snarf-documentation, so assume
3001 this file is described in the DOC-MM.NN file
3002 and Snarf-documentation will fill in the right value later.
3003 For now, replace the whole list with 0. */
3006 /* We have already called Snarf-documentation, so make a relative
3007 file name for this file, so it can be found properly
3008 in the installed Lisp directory.
3009 We don't use Fexpand_file_name because that would make
3010 the directory absolute now. */
3011 elt
= concat2 (build_string ("../lisp/"),
3012 Ffile_name_nondirectory (elt
));
3014 else if (EQ (elt
, Vload_file_name
)
3016 && load_force_doc_strings
)
3025 Fsignal (Qinvalid_read_syntax
,
3026 Fcons (make_string (") or . in a vector", 18), Qnil
));
3034 XSETCDR (tail
, read0 (readcharfun
));
3036 val
= read0 (readcharfun
);
3037 read1 (readcharfun
, &ch
, 0);
3041 if (doc_reference
== 1)
3042 return make_number (0);
3043 if (doc_reference
== 2)
3045 /* Get a doc string from the file we are loading.
3046 If it's in saved_doc_string, get it from there. */
3047 int pos
= XINT (XCDR (val
));
3048 /* Position is negative for user variables. */
3049 if (pos
< 0) pos
= -pos
;
3050 if (pos
>= saved_doc_string_position
3051 && pos
< (saved_doc_string_position
3052 + saved_doc_string_length
))
3054 int start
= pos
- saved_doc_string_position
;
3057 /* Process quoting with ^A,
3058 and find the end of the string,
3059 which is marked with ^_ (037). */
3060 for (from
= start
, to
= start
;
3061 saved_doc_string
[from
] != 037;)
3063 int c
= saved_doc_string
[from
++];
3066 c
= saved_doc_string
[from
++];
3068 saved_doc_string
[to
++] = c
;
3070 saved_doc_string
[to
++] = 0;
3072 saved_doc_string
[to
++] = 037;
3075 saved_doc_string
[to
++] = c
;
3078 return make_string (saved_doc_string
+ start
,
3081 /* Look in prev_saved_doc_string the same way. */
3082 else if (pos
>= prev_saved_doc_string_position
3083 && pos
< (prev_saved_doc_string_position
3084 + prev_saved_doc_string_length
))
3086 int start
= pos
- prev_saved_doc_string_position
;
3089 /* Process quoting with ^A,
3090 and find the end of the string,
3091 which is marked with ^_ (037). */
3092 for (from
= start
, to
= start
;
3093 prev_saved_doc_string
[from
] != 037;)
3095 int c
= prev_saved_doc_string
[from
++];
3098 c
= prev_saved_doc_string
[from
++];
3100 prev_saved_doc_string
[to
++] = c
;
3102 prev_saved_doc_string
[to
++] = 0;
3104 prev_saved_doc_string
[to
++] = 037;
3107 prev_saved_doc_string
[to
++] = c
;
3110 return make_string (prev_saved_doc_string
+ start
,
3114 return get_doc_string (val
, 0, 0);
3119 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3121 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3123 tem
= (read_pure
&& flag
<= 0
3124 ? pure_cons (elt
, Qnil
)
3125 : Fcons (elt
, Qnil
));
3127 XSETCDR (tail
, tem
);
3132 defunflag
= EQ (elt
, Qdefun
);
3133 else if (defunflag
> 0)
3138 Lisp_Object Vobarray
;
3139 Lisp_Object initial_obarray
;
3141 /* oblookup stores the bucket number here, for the sake of Funintern. */
3143 int oblookup_last_bucket_number
;
3145 static int hash_string ();
3147 /* Get an error if OBARRAY is not an obarray.
3148 If it is one, return it. */
3151 check_obarray (obarray
)
3152 Lisp_Object obarray
;
3154 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3156 /* If Vobarray is now invalid, force it to be valid. */
3157 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3159 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3164 /* Intern the C string STR: return a symbol with that name,
3165 interned in the current obarray. */
3172 int len
= strlen (str
);
3173 Lisp_Object obarray
;
3176 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3177 obarray
= check_obarray (obarray
);
3178 tem
= oblookup (obarray
, str
, len
, len
);
3181 return Fintern (make_string (str
, len
), obarray
);
3184 /* Create an uninterned symbol with name STR. */
3190 int len
= strlen (str
);
3192 return Fmake_symbol ((!NILP (Vpurify_flag
)
3193 ? make_pure_string (str
, len
, len
, 0)
3194 : make_string (str
, len
)));
3197 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3198 doc
: /* Return the canonical symbol whose name is STRING.
3199 If there is none, one is created by this function and returned.
3200 A second optional argument specifies the obarray to use;
3201 it defaults to the value of `obarray'. */)
3203 Lisp_Object string
, obarray
;
3205 register Lisp_Object tem
, sym
, *ptr
;
3207 if (NILP (obarray
)) obarray
= Vobarray
;
3208 obarray
= check_obarray (obarray
);
3210 CHECK_STRING (string
);
3212 tem
= oblookup (obarray
, SDATA (string
),
3215 if (!INTEGERP (tem
))
3218 if (!NILP (Vpurify_flag
))
3219 string
= Fpurecopy (string
);
3220 sym
= Fmake_symbol (string
);
3222 if (EQ (obarray
, initial_obarray
))
3223 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3225 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3227 if ((SREF (string
, 0) == ':')
3228 && EQ (obarray
, initial_obarray
))
3230 XSYMBOL (sym
)->constant
= 1;
3231 XSYMBOL (sym
)->value
= sym
;
3234 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3236 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3238 XSYMBOL (sym
)->next
= 0;
3243 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3244 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3245 NAME may be a string or a symbol. If it is a symbol, that exact
3246 symbol is searched for.
3247 A second optional argument specifies the obarray to use;
3248 it defaults to the value of `obarray'. */)
3250 Lisp_Object name
, obarray
;
3252 register Lisp_Object tem
, string
;
3254 if (NILP (obarray
)) obarray
= Vobarray
;
3255 obarray
= check_obarray (obarray
);
3257 if (!SYMBOLP (name
))
3259 CHECK_STRING (name
);
3263 string
= SYMBOL_NAME (name
);
3265 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3266 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3272 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3273 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3274 The value is t if a symbol was found and deleted, nil otherwise.
3275 NAME may be a string or a symbol. If it is a symbol, that symbol
3276 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3277 OBARRAY defaults to the value of the variable `obarray'. */)
3279 Lisp_Object name
, obarray
;
3281 register Lisp_Object string
, tem
;
3284 if (NILP (obarray
)) obarray
= Vobarray
;
3285 obarray
= check_obarray (obarray
);
3288 string
= SYMBOL_NAME (name
);
3291 CHECK_STRING (name
);
3295 tem
= oblookup (obarray
, SDATA (string
),
3300 /* If arg was a symbol, don't delete anything but that symbol itself. */
3301 if (SYMBOLP (name
) && !EQ (name
, tem
))
3304 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3305 XSYMBOL (tem
)->constant
= 0;
3306 XSYMBOL (tem
)->indirect_variable
= 0;
3308 hash
= oblookup_last_bucket_number
;
3310 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3312 if (XSYMBOL (tem
)->next
)
3313 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3315 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3319 Lisp_Object tail
, following
;
3321 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3322 XSYMBOL (tail
)->next
;
3325 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3326 if (EQ (following
, tem
))
3328 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3337 /* Return the symbol in OBARRAY whose names matches the string
3338 of SIZE characters (SIZE_BYTE bytes) at PTR.
3339 If there is no such symbol in OBARRAY, return nil.
3341 Also store the bucket number in oblookup_last_bucket_number. */
3344 oblookup (obarray
, ptr
, size
, size_byte
)
3345 Lisp_Object obarray
;
3346 register const char *ptr
;
3347 int size
, size_byte
;
3351 register Lisp_Object tail
;
3352 Lisp_Object bucket
, tem
;
3354 if (!VECTORP (obarray
)
3355 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3357 obarray
= check_obarray (obarray
);
3358 obsize
= XVECTOR (obarray
)->size
;
3360 /* This is sometimes needed in the middle of GC. */
3361 obsize
&= ~ARRAY_MARK_FLAG
;
3362 /* Combining next two lines breaks VMS C 2.3. */
3363 hash
= hash_string (ptr
, size_byte
);
3365 bucket
= XVECTOR (obarray
)->contents
[hash
];
3366 oblookup_last_bucket_number
= hash
;
3367 if (EQ (bucket
, make_number (0)))
3369 else if (!SYMBOLP (bucket
))
3370 error ("Bad data in guts of obarray"); /* Like CADR error message */
3372 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3374 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3375 && SCHARS (SYMBOL_NAME (tail
)) == size
3376 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3378 else if (XSYMBOL (tail
)->next
== 0)
3381 XSETINT (tem
, hash
);
3386 hash_string (ptr
, len
)
3387 const unsigned char *ptr
;
3390 register const unsigned char *p
= ptr
;
3391 register const unsigned char *end
= p
+ len
;
3392 register unsigned char c
;
3393 register int hash
= 0;
3398 if (c
>= 0140) c
-= 40;
3399 hash
= ((hash
<<3) + (hash
>>28) + c
);
3401 return hash
& 07777777777;
3405 map_obarray (obarray
, fn
, arg
)
3406 Lisp_Object obarray
;
3407 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3411 register Lisp_Object tail
;
3412 CHECK_VECTOR (obarray
);
3413 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3415 tail
= XVECTOR (obarray
)->contents
[i
];
3420 if (XSYMBOL (tail
)->next
== 0)
3422 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3428 mapatoms_1 (sym
, function
)
3429 Lisp_Object sym
, function
;
3431 call1 (function
, sym
);
3434 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3435 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3436 OBARRAY defaults to the value of `obarray'. */)
3438 Lisp_Object function
, obarray
;
3440 if (NILP (obarray
)) obarray
= Vobarray
;
3441 obarray
= check_obarray (obarray
);
3443 map_obarray (obarray
, mapatoms_1
, function
);
3447 #define OBARRAY_SIZE 1511
3452 Lisp_Object oblength
;
3456 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3458 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3459 Vobarray
= Fmake_vector (oblength
, make_number (0));
3460 initial_obarray
= Vobarray
;
3461 staticpro (&initial_obarray
);
3462 /* Intern nil in the obarray */
3463 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3464 XSYMBOL (Qnil
)->constant
= 1;
3466 /* These locals are to kludge around a pyramid compiler bug. */
3467 hash
= hash_string ("nil", 3);
3468 /* Separate statement here to avoid VAXC bug. */
3469 hash
%= OBARRAY_SIZE
;
3470 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3473 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3474 XSYMBOL (Qnil
)->function
= Qunbound
;
3475 XSYMBOL (Qunbound
)->value
= Qunbound
;
3476 XSYMBOL (Qunbound
)->function
= Qunbound
;
3479 XSYMBOL (Qnil
)->value
= Qnil
;
3480 XSYMBOL (Qnil
)->plist
= Qnil
;
3481 XSYMBOL (Qt
)->value
= Qt
;
3482 XSYMBOL (Qt
)->constant
= 1;
3484 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3487 Qvariable_documentation
= intern ("variable-documentation");
3488 staticpro (&Qvariable_documentation
);
3490 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3491 read_buffer
= (char *) xmalloc (read_buffer_size
);
3496 struct Lisp_Subr
*sname
;
3499 sym
= intern (sname
->symbol_name
);
3500 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3503 #ifdef NOTDEF /* use fset in subr.el now */
3505 defalias (sname
, string
)
3506 struct Lisp_Subr
*sname
;
3510 sym
= intern (string
);
3511 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3515 /* Define an "integer variable"; a symbol whose value is forwarded
3516 to a C variable of type int. Sample call: */
3517 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3519 defvar_int (namestring
, address
)
3523 Lisp_Object sym
, val
;
3524 sym
= intern (namestring
);
3525 val
= allocate_misc ();
3526 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3527 XINTFWD (val
)->intvar
= address
;
3528 SET_SYMBOL_VALUE (sym
, val
);
3531 /* Similar but define a variable whose value is t if address contains 1,
3532 nil if address contains 0 */
3534 defvar_bool (namestring
, address
)
3538 Lisp_Object sym
, val
;
3539 sym
= intern (namestring
);
3540 val
= allocate_misc ();
3541 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3542 XBOOLFWD (val
)->boolvar
= address
;
3543 SET_SYMBOL_VALUE (sym
, val
);
3544 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3547 /* Similar but define a variable whose value is the Lisp Object stored
3548 at address. Two versions: with and without gc-marking of the C
3549 variable. The nopro version is used when that variable will be
3550 gc-marked for some other reason, since marking the same slot twice
3551 can cause trouble with strings. */
3553 defvar_lisp_nopro (namestring
, address
)
3555 Lisp_Object
*address
;
3557 Lisp_Object sym
, val
;
3558 sym
= intern (namestring
);
3559 val
= allocate_misc ();
3560 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3561 XOBJFWD (val
)->objvar
= address
;
3562 SET_SYMBOL_VALUE (sym
, val
);
3566 defvar_lisp (namestring
, address
)
3568 Lisp_Object
*address
;
3570 defvar_lisp_nopro (namestring
, address
);
3571 staticpro (address
);
3574 /* Similar but define a variable whose value is the Lisp Object stored in
3575 the current buffer. address is the address of the slot in the buffer
3576 that is current now. */
3579 defvar_per_buffer (namestring
, address
, type
, doc
)
3581 Lisp_Object
*address
;
3585 Lisp_Object sym
, val
;
3588 sym
= intern (namestring
);
3589 val
= allocate_misc ();
3590 offset
= (char *)address
- (char *)current_buffer
;
3592 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3593 XBUFFER_OBJFWD (val
)->offset
= offset
;
3594 SET_SYMBOL_VALUE (sym
, val
);
3595 PER_BUFFER_SYMBOL (offset
) = sym
;
3596 PER_BUFFER_TYPE (offset
) = type
;
3598 if (PER_BUFFER_IDX (offset
) == 0)
3599 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3600 slot of buffer_local_flags */
3605 /* Similar but define a variable whose value is the Lisp Object stored
3606 at a particular offset in the current kboard object. */
3609 defvar_kboard (namestring
, offset
)
3613 Lisp_Object sym
, val
;
3614 sym
= intern (namestring
);
3615 val
= allocate_misc ();
3616 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3617 XKBOARD_OBJFWD (val
)->offset
= offset
;
3618 SET_SYMBOL_VALUE (sym
, val
);
3621 /* Record the value of load-path used at the start of dumping
3622 so we can see if the site changed it later during dumping. */
3623 static Lisp_Object dump_path
;
3629 int turn_off_warning
= 0;
3631 /* Compute the default load-path. */
3633 normal
= PATH_LOADSEARCH
;
3634 Vload_path
= decode_env_path (0, normal
);
3636 if (NILP (Vpurify_flag
))
3637 normal
= PATH_LOADSEARCH
;
3639 normal
= PATH_DUMPLOADSEARCH
;
3641 /* In a dumped Emacs, we normally have to reset the value of
3642 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3643 uses ../lisp, instead of the path of the installed elisp
3644 libraries. However, if it appears that Vload_path was changed
3645 from the default before dumping, don't override that value. */
3648 if (! NILP (Fequal (dump_path
, Vload_path
)))
3650 Vload_path
= decode_env_path (0, normal
);
3651 if (!NILP (Vinstallation_directory
))
3653 Lisp_Object tem
, tem1
, sitelisp
;
3655 /* Remove site-lisp dirs from path temporarily and store
3656 them in sitelisp, then conc them on at the end so
3657 they're always first in path. */
3661 tem
= Fcar (Vload_path
);
3662 tem1
= Fstring_match (build_string ("site-lisp"),
3666 Vload_path
= Fcdr (Vload_path
);
3667 sitelisp
= Fcons (tem
, sitelisp
);
3673 /* Add to the path the lisp subdir of the
3674 installation dir, if it exists. */
3675 tem
= Fexpand_file_name (build_string ("lisp"),
3676 Vinstallation_directory
);
3677 tem1
= Ffile_exists_p (tem
);
3680 if (NILP (Fmember (tem
, Vload_path
)))
3682 turn_off_warning
= 1;
3683 Vload_path
= Fcons (tem
, Vload_path
);
3687 /* That dir doesn't exist, so add the build-time
3688 Lisp dirs instead. */
3689 Vload_path
= nconc2 (Vload_path
, dump_path
);
3691 /* Add leim under the installation dir, if it exists. */
3692 tem
= Fexpand_file_name (build_string ("leim"),
3693 Vinstallation_directory
);
3694 tem1
= Ffile_exists_p (tem
);
3697 if (NILP (Fmember (tem
, Vload_path
)))
3698 Vload_path
= Fcons (tem
, Vload_path
);
3701 /* Add site-list under the installation dir, if it exists. */
3702 tem
= Fexpand_file_name (build_string ("site-lisp"),
3703 Vinstallation_directory
);
3704 tem1
= Ffile_exists_p (tem
);
3707 if (NILP (Fmember (tem
, Vload_path
)))
3708 Vload_path
= Fcons (tem
, Vload_path
);
3711 /* If Emacs was not built in the source directory,
3712 and it is run from where it was built, add to load-path
3713 the lisp, leim and site-lisp dirs under that directory. */
3715 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3719 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3720 Vinstallation_directory
);
3721 tem1
= Ffile_exists_p (tem
);
3723 /* Don't be fooled if they moved the entire source tree
3724 AFTER dumping Emacs. If the build directory is indeed
3725 different from the source dir, src/Makefile.in and
3726 src/Makefile will not be found together. */
3727 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3728 Vinstallation_directory
);
3729 tem2
= Ffile_exists_p (tem
);
3730 if (!NILP (tem1
) && NILP (tem2
))
3732 tem
= Fexpand_file_name (build_string ("lisp"),
3735 if (NILP (Fmember (tem
, Vload_path
)))
3736 Vload_path
= Fcons (tem
, Vload_path
);
3738 tem
= Fexpand_file_name (build_string ("leim"),
3741 if (NILP (Fmember (tem
, Vload_path
)))
3742 Vload_path
= Fcons (tem
, Vload_path
);
3744 tem
= Fexpand_file_name (build_string ("site-lisp"),
3747 if (NILP (Fmember (tem
, Vload_path
)))
3748 Vload_path
= Fcons (tem
, Vload_path
);
3751 if (!NILP (sitelisp
))
3752 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3758 /* NORMAL refers to the lisp dir in the source directory. */
3759 /* We used to add ../lisp at the front here, but
3760 that caused trouble because it was copied from dump_path
3761 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3762 It should be unnecessary. */
3763 Vload_path
= decode_env_path (0, normal
);
3764 dump_path
= Vload_path
;
3768 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3769 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3770 almost never correct, thereby causing a warning to be printed out that
3771 confuses users. Since PATH_LOADSEARCH is always overridden by the
3772 EMACSLOADPATH environment variable below, disable the warning on NT.
3773 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3774 the "standard" paths may not exist and would be overridden by
3775 EMACSLOADPATH as on NT. Since this depends on how the executable
3776 was build and packaged, turn off the warnings in general */
3778 /* Warn if dirs in the *standard* path don't exist. */
3779 if (!turn_off_warning
)
3781 Lisp_Object path_tail
;
3783 for (path_tail
= Vload_path
;
3785 path_tail
= XCDR (path_tail
))
3787 Lisp_Object dirfile
;
3788 dirfile
= Fcar (path_tail
);
3789 if (STRINGP (dirfile
))
3791 dirfile
= Fdirectory_file_name (dirfile
);
3792 if (access (SDATA (dirfile
), 0) < 0)
3793 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3798 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3800 /* If the EMACSLOADPATH environment variable is set, use its value.
3801 This doesn't apply if we're dumping. */
3803 if (NILP (Vpurify_flag
)
3804 && egetenv ("EMACSLOADPATH"))
3806 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3810 load_in_progress
= 0;
3811 Vload_file_name
= Qnil
;
3813 load_descriptor_list
= Qnil
;
3815 Vstandard_input
= Qt
;
3816 Vloads_in_progress
= Qnil
;
3819 /* Print a warning, using format string FORMAT, that directory DIRNAME
3820 does not exist. Print it on stderr and put it in *Message*. */
3823 dir_warning (format
, dirname
)
3825 Lisp_Object dirname
;
3828 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3830 fprintf (stderr
, format
, SDATA (dirname
));
3831 sprintf (buffer
, format
, SDATA (dirname
));
3832 /* Don't log the warning before we've initialized!! */
3834 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3841 defsubr (&Sread_from_string
);
3843 defsubr (&Sintern_soft
);
3844 defsubr (&Sunintern
);
3846 defsubr (&Seval_buffer
);
3847 defsubr (&Seval_region
);
3848 defsubr (&Sread_char
);
3849 defsubr (&Sread_char_exclusive
);
3850 defsubr (&Sread_event
);
3851 defsubr (&Sget_file_char
);
3852 defsubr (&Smapatoms
);
3853 defsubr (&Slocate_file_internal
);
3855 DEFVAR_LISP ("obarray", &Vobarray
,
3856 doc
: /* Symbol table for use by `intern' and `read'.
3857 It is a vector whose length ought to be prime for best results.
3858 The vector's contents don't make sense if examined from Lisp programs;
3859 to find all the symbols in an obarray, use `mapatoms'. */);
3861 DEFVAR_LISP ("values", &Vvalues
,
3862 doc
: /* List of values of all expressions which were read, evaluated and printed.
3863 Order is reverse chronological. */);
3865 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3866 doc
: /* Stream for read to get input from.
3867 See documentation of `read' for possible values. */);
3868 Vstandard_input
= Qt
;
3870 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3871 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3873 If this variable is a buffer, then only forms read from that buffer
3874 will be added to `read-symbol-positions-list'.
3875 If this variable is t, then all read forms will be added.
3876 The effect of all other values other than nil are not currently
3877 defined, although they may be in the future.
3879 The positions are relative to the last call to `read' or
3880 `read-from-string'. It is probably a bad idea to set this variable at
3881 the toplevel; bind it instead. */);
3882 Vread_with_symbol_positions
= Qnil
;
3884 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3885 doc
: /* A list mapping read symbols to their positions.
3886 This variable is modified during calls to `read' or
3887 `read-from-string', but only when `read-with-symbol-positions' is
3890 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3891 CHAR-POSITION is an integer giving the offset of that occurrence of the
3892 symbol from the position where `read' or `read-from-string' started.
3894 Note that a symbol will appear multiple times in this list, if it was
3895 read multiple times. The list is in the same order as the symbols
3897 Vread_symbol_positions_list
= Qnil
;
3899 DEFVAR_LISP ("load-path", &Vload_path
,
3900 doc
: /* *List of directories to search for files to load.
3901 Each element is a string (directory name) or nil (try default directory).
3902 Initialized based on EMACSLOADPATH environment variable, if any,
3903 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3905 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3906 doc
: /* *List of suffixes to try for files to load.
3907 This list should not include the empty string. */);
3908 Vload_suffixes
= Fcons (build_string (".elc"),
3909 Fcons (build_string (".el"), Qnil
));
3910 /* We don't use empty_string because it's not initialized yet. */
3911 default_suffixes
= Fcons (build_string (""), Qnil
);
3912 staticpro (&default_suffixes
);
3914 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3915 doc
: /* Non-nil iff inside of `load'. */);
3917 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3918 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3919 Each element looks like (FILENAME FORMS...).
3920 When `load' is run and the file-name argument is FILENAME,
3921 the FORMS in the corresponding element are executed at the end of loading.
3923 FILENAME must match exactly! Normally FILENAME is the name of a library,
3924 with no directory specified, since that is how `load' is normally called.
3925 An error in FORMS does not undo the load,
3926 but does prevent execution of the rest of the FORMS.
3927 FILENAME can also be a symbol (a feature) and FORMS are then executed
3928 when the corresponding call to `provide' is made. */);
3929 Vafter_load_alist
= Qnil
;
3931 DEFVAR_LISP ("load-history", &Vload_history
,
3932 doc
: /* Alist mapping file names to symbols and features.
3933 Each alist element is a list that starts with a file name,
3934 except for one element (optional) that starts with nil and describes
3935 definitions evaluated from buffers not visiting files.
3936 The remaining elements of each list are symbols defined as variables
3937 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3938 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3939 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3940 and means that SYMBOL was an autoload before this file redefined it
3943 During preloading, the file name recorded is relative to the main Lisp
3944 directory. These file names are converted to absolute at startup. */);
3945 Vload_history
= Qnil
;
3947 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3948 doc
: /* Full name of file being loaded by `load'. */);
3949 Vload_file_name
= Qnil
;
3951 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3952 doc
: /* File name, including directory, of user's initialization file.
3953 If the file loaded had extension `.elc', and the corresponding source file
3954 exists, this variable contains the name of source file, suitable for use
3955 by functions like `custom-save-all' which edit the init file. */);
3956 Vuser_init_file
= Qnil
;
3958 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3959 doc
: /* Used for internal purposes by `load'. */);
3960 Vcurrent_load_list
= Qnil
;
3962 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3963 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3964 The default is nil, which means use the function `read'. */);
3965 Vload_read_function
= Qnil
;
3967 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3968 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3969 This function is for doing code conversion before reading the source file.
3970 If nil, loading is done without any code conversion.
3971 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3972 FULLNAME is the full name of FILE.
3973 See `load' for the meaning of the remaining arguments. */);
3974 Vload_source_file_function
= Qnil
;
3976 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3977 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3978 This is useful when the file being loaded is a temporary copy. */);
3979 load_force_doc_strings
= 0;
3981 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3982 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3983 This is normally bound by `load' and `eval-buffer' to control `read',
3984 and is not meant for users to change. */);
3985 load_convert_to_unibyte
= 0;
3987 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3988 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3989 You cannot count on them to still be there! */);
3991 = Fexpand_file_name (build_string ("../"),
3992 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3994 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3995 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3996 Vpreloaded_file_list
= Qnil
;
3998 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3999 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4000 Vbyte_boolean_vars
= Qnil
;
4002 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4003 doc
: /* Non-nil means load dangerous compiled Lisp files.
4004 Some versions of XEmacs use different byte codes than Emacs. These
4005 incompatible byte codes can make Emacs crash when it tries to execute
4007 load_dangerous_libraries
= 0;
4009 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4010 doc
: /* Regular expression matching safe to load compiled Lisp files.
4011 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4012 from the file, and matches them against this regular expression.
4013 When the regular expression matches, the file is considered to be safe
4014 to load. See also `load-dangerous-libraries'. */);
4015 Vbytecomp_version_regexp
4016 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4018 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4019 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4020 Veval_buffer_list
= Qnil
;
4022 /* Vsource_directory was initialized in init_lread. */
4024 load_descriptor_list
= Qnil
;
4025 staticpro (&load_descriptor_list
);
4027 Qcurrent_load_list
= intern ("current-load-list");
4028 staticpro (&Qcurrent_load_list
);
4030 Qstandard_input
= intern ("standard-input");
4031 staticpro (&Qstandard_input
);
4033 Qread_char
= intern ("read-char");
4034 staticpro (&Qread_char
);
4036 Qget_file_char
= intern ("get-file-char");
4037 staticpro (&Qget_file_char
);
4039 Qbackquote
= intern ("`");
4040 staticpro (&Qbackquote
);
4041 Qcomma
= intern (",");
4042 staticpro (&Qcomma
);
4043 Qcomma_at
= intern (",@");
4044 staticpro (&Qcomma_at
);
4045 Qcomma_dot
= intern (",.");
4046 staticpro (&Qcomma_dot
);
4048 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4049 staticpro (&Qinhibit_file_name_operation
);
4051 Qascii_character
= intern ("ascii-character");
4052 staticpro (&Qascii_character
);
4054 Qfunction
= intern ("function");
4055 staticpro (&Qfunction
);
4057 Qload
= intern ("load");
4060 Qload_file_name
= intern ("load-file-name");
4061 staticpro (&Qload_file_name
);
4063 Qeval_buffer_list
= intern ("eval-buffer-list");
4064 staticpro (&Qeval_buffer_list
);
4066 staticpro (&dump_path
);
4068 staticpro (&read_objects
);
4069 read_objects
= Qnil
;
4070 staticpro (&seen_list
);
4073 Vloads_in_progress
= Qnil
;
4074 staticpro (&Vloads_in_progress
);
4077 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4078 (do not change this comment) */