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 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>
31 #include "intervals.h"
37 #include "termhooks.h"
41 #include <sys/inode.h>
46 #include <unistd.h> /* to get X_OK */
63 #endif /* HAVE_SETLOCALE */
73 #define file_offset off_t
74 #define file_tell ftello
76 #define file_offset long
77 #define file_tell ftell
84 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
85 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
86 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
87 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
88 Lisp_Object Qinhibit_file_name_operation
;
89 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
91 extern Lisp_Object Qevent_symbol_element_mask
;
92 extern Lisp_Object Qfile_exists_p
;
94 /* non-zero iff inside `load' */
97 /* Directory in which the sources were found. */
98 Lisp_Object Vsource_directory
;
100 /* Search path and suffixes for files to be loaded. */
101 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
103 /* File name of user's init file. */
104 Lisp_Object Vuser_init_file
;
106 /* This is the user-visible association list that maps features to
107 lists of defs in their load files. */
108 Lisp_Object Vload_history
;
110 /* This is used to build the load history. */
111 Lisp_Object Vcurrent_load_list
;
113 /* List of files that were preloaded. */
114 Lisp_Object Vpreloaded_file_list
;
116 /* Name of file actually being read by `load'. */
117 Lisp_Object Vload_file_name
;
119 /* Function to use for reading, in `load' and friends. */
120 Lisp_Object Vload_read_function
;
122 /* The association list of objects read with the #n=object form.
123 Each member of the list has the form (n . object), and is used to
124 look up the object for the corresponding #n# construct.
125 It must be set to nil before all top-level calls to read0. */
126 Lisp_Object read_objects
;
128 /* Nonzero means load should forcibly load all dynamic doc strings. */
129 static int load_force_doc_strings
;
131 /* Nonzero means read should convert strings to unibyte. */
132 static int load_convert_to_unibyte
;
134 /* Function to use for loading an Emacs lisp source file (not
135 compiled) instead of readevalloop. */
136 Lisp_Object Vload_source_file_function
;
138 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
139 Lisp_Object Vbyte_boolean_vars
;
141 /* Whether or not to add a `read-positions' property to symbols
143 Lisp_Object Vread_with_symbol_positions
;
145 /* List of (SYMBOL . POSITION) accumulated so far. */
146 Lisp_Object Vread_symbol_positions_list
;
148 /* List of descriptors now open for Fload. */
149 static Lisp_Object load_descriptor_list
;
151 /* File for get_file_char to read from. Use by load. */
152 static FILE *instream
;
154 /* When nonzero, read conses in pure space */
155 static int read_pure
;
157 /* For use within read-from-string (this reader is non-reentrant!!) */
158 static int read_from_string_index
;
159 static int read_from_string_index_byte
;
160 static int read_from_string_limit
;
162 /* Number of bytes left to read in the buffer character
163 that `readchar' has already advanced over. */
164 static int readchar_backlog
;
165 /* Number of characters read in the current call to Fread or
166 Fread_from_string. */
167 static int readchar_count
;
169 /* This contains the last string skipped with #@. */
170 static char *saved_doc_string
;
171 /* Length of buffer allocated in saved_doc_string. */
172 static int saved_doc_string_size
;
173 /* Length of actual data in saved_doc_string. */
174 static int saved_doc_string_length
;
175 /* This is the file position that string came from. */
176 static file_offset saved_doc_string_position
;
178 /* This contains the previous string skipped with #@.
179 We copy it from saved_doc_string when a new string
180 is put in saved_doc_string. */
181 static char *prev_saved_doc_string
;
182 /* Length of buffer allocated in prev_saved_doc_string. */
183 static int prev_saved_doc_string_size
;
184 /* Length of actual data in prev_saved_doc_string. */
185 static int prev_saved_doc_string_length
;
186 /* This is the file position that string came from. */
187 static file_offset prev_saved_doc_string_position
;
189 /* Nonzero means inside a new-style backquote
190 with no surrounding parentheses.
191 Fread initializes this to zero, so we need not specbind it
192 or worry about what happens to it when there is an error. */
193 static int new_backquote_flag
;
195 /* A list of file names for files being loaded in Fload. Used to
196 check for recursive loads. */
198 static Lisp_Object Vloads_in_progress
;
200 /* Non-zero means load dangerous compiled Lisp files. */
202 int load_dangerous_libraries
;
204 /* A regular expression used to detect files compiled with Emacs. */
206 static Lisp_Object Vbytecomp_version_regexp
;
208 static void to_multibyte
P_ ((char **, char **, int *));
209 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
210 Lisp_Object (*) (), int,
211 Lisp_Object
, Lisp_Object
,
212 Lisp_Object
, Lisp_Object
));
213 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
214 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
217 /* Handle unreading and rereading of characters.
218 Write READCHAR to read a character,
219 UNREAD(c) to unread c to be read again.
221 The READCHAR and UNREAD macros are meant for reading/unreading a
222 byte code; they do not handle multibyte characters. The caller
223 should manage them if necessary.
225 [ Actually that seems to be a lie; READCHAR will definitely read
226 multibyte characters from buffer sources, at least. Is the
227 comment just out of date?
228 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
231 #define READCHAR readchar (readcharfun)
232 #define UNREAD(c) unreadchar (readcharfun, c)
235 readchar (readcharfun
)
236 Lisp_Object readcharfun
;
243 if (BUFFERP (readcharfun
))
245 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
247 int pt_byte
= BUF_PT_BYTE (inbuffer
);
248 int orig_pt_byte
= pt_byte
;
250 if (readchar_backlog
> 0)
251 /* We get the address of the byte just passed,
252 which is the last byte of the character.
253 The other bytes in this character are consecutive with it,
254 because the gap can't be in the middle of a character. */
255 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
256 - --readchar_backlog
);
258 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
261 readchar_backlog
= -1;
263 if (! NILP (inbuffer
->enable_multibyte_characters
))
265 /* Fetch the character code from the buffer. */
266 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
267 BUF_INC_POS (inbuffer
, pt_byte
);
268 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
272 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
275 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
279 if (MARKERP (readcharfun
))
281 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
283 int bytepos
= marker_byte_position (readcharfun
);
284 int orig_bytepos
= bytepos
;
286 if (readchar_backlog
> 0)
287 /* We get the address of the byte just passed,
288 which is the last byte of the character.
289 The other bytes in this character are consecutive with it,
290 because the gap can't be in the middle of a character. */
291 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
292 - --readchar_backlog
);
294 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
297 readchar_backlog
= -1;
299 if (! NILP (inbuffer
->enable_multibyte_characters
))
301 /* Fetch the character code from the buffer. */
302 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
303 BUF_INC_POS (inbuffer
, bytepos
);
304 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
308 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
312 XMARKER (readcharfun
)->bytepos
= bytepos
;
313 XMARKER (readcharfun
)->charpos
++;
318 if (EQ (readcharfun
, Qlambda
))
319 return read_bytecode_char (0);
321 if (EQ (readcharfun
, Qget_file_char
))
325 /* Interrupted reads have been observed while reading over the network */
326 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
336 if (STRINGP (readcharfun
))
338 if (read_from_string_index
>= read_from_string_limit
)
341 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
342 read_from_string_index
,
343 read_from_string_index_byte
);
348 tem
= call0 (readcharfun
);
355 /* Unread the character C in the way appropriate for the stream READCHARFUN.
356 If the stream is a user function, call it with the char as argument. */
359 unreadchar (readcharfun
, c
)
360 Lisp_Object readcharfun
;
365 /* Don't back up the pointer if we're unreading the end-of-input mark,
366 since readchar didn't advance it when we read it. */
368 else if (BUFFERP (readcharfun
))
370 struct buffer
*b
= XBUFFER (readcharfun
);
371 int bytepos
= BUF_PT_BYTE (b
);
373 if (readchar_backlog
>= 0)
378 if (! NILP (b
->enable_multibyte_characters
))
379 BUF_DEC_POS (b
, bytepos
);
383 BUF_PT_BYTE (b
) = bytepos
;
386 else if (MARKERP (readcharfun
))
388 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
389 int bytepos
= XMARKER (readcharfun
)->bytepos
;
391 if (readchar_backlog
>= 0)
395 XMARKER (readcharfun
)->charpos
--;
396 if (! NILP (b
->enable_multibyte_characters
))
397 BUF_DEC_POS (b
, bytepos
);
401 XMARKER (readcharfun
)->bytepos
= bytepos
;
404 else if (STRINGP (readcharfun
))
406 read_from_string_index
--;
407 read_from_string_index_byte
408 = string_char_to_byte (readcharfun
, read_from_string_index
);
410 else if (EQ (readcharfun
, Qlambda
))
411 read_bytecode_char (1);
412 else if (EQ (readcharfun
, Qget_file_char
))
413 ungetc (c
, instream
);
415 call1 (readcharfun
, make_number (c
));
418 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
420 static Lisp_Object read0
P_ ((Lisp_Object
));
421 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
423 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
424 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
425 static int read_multibyte
P_ ((int, Lisp_Object
));
427 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
429 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
431 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
434 /* Get a character from the tty. */
436 extern Lisp_Object
read_char ();
438 /* Read input events until we get one that's acceptable for our purposes.
440 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
441 until we get a character we like, and then stuffed into
444 If ASCII_REQUIRED is non-zero, we check function key events to see
445 if the unmodified version of the symbol has a Qascii_character
446 property, and use that character, if present.
448 If ERROR_NONASCII is non-zero, we signal an error if the input we
449 get isn't an ASCII character with modifiers. If it's zero but
450 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
453 If INPUT_METHOD is nonzero, we invoke the current input method
454 if the character warrants that. */
457 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
459 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
461 register Lisp_Object val
, delayed_switch_frame
;
463 #ifdef HAVE_WINDOW_SYSTEM
464 if (display_hourglass_p
)
468 delayed_switch_frame
= Qnil
;
470 /* Read until we get an acceptable event. */
472 val
= read_char (0, 0, 0,
473 (input_method
? Qnil
: Qt
),
479 /* switch-frame events are put off until after the next ASCII
480 character. This is better than signaling an error just because
481 the last characters were typed to a separate minibuffer frame,
482 for example. Eventually, some code which can deal with
483 switch-frame events will read it and process it. */
485 && EVENT_HAS_PARAMETERS (val
)
486 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
488 delayed_switch_frame
= val
;
494 /* Convert certain symbols to their ASCII equivalents. */
497 Lisp_Object tem
, tem1
;
498 tem
= Fget (val
, Qevent_symbol_element_mask
);
501 tem1
= Fget (Fcar (tem
), Qascii_character
);
502 /* Merge this symbol's modifier bits
503 with the ASCII equivalent of its basic code. */
505 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
509 /* If we don't have a character now, deal with it appropriately. */
514 Vunread_command_events
= Fcons (val
, Qnil
);
515 error ("Non-character input-event");
522 if (! NILP (delayed_switch_frame
))
523 unread_switch_frame
= delayed_switch_frame
;
527 #ifdef HAVE_WINDOW_SYSTEM
528 if (display_hourglass_p
)
537 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
538 doc
: /* Read a character from the command input (keyboard or macro).
539 It is returned as a number.
540 If the user generates an event which is not a character (i.e. a mouse
541 click or function key event), `read-char' signals an error. As an
542 exception, switch-frame events are put off until non-ASCII events can
544 If you want to read non-character events, or ignore them, call
545 `read-event' or `read-char-exclusive' instead.
547 If the optional argument PROMPT is non-nil, display that as a prompt.
548 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
549 input method is turned on in the current buffer, that input method
550 is used for reading a character. */)
551 (prompt
, inherit_input_method
)
552 Lisp_Object prompt
, inherit_input_method
;
555 message_with_string ("%s", prompt
, 0);
556 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
559 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
560 doc
: /* Read an event object from the input stream.
561 If the optional argument PROMPT is non-nil, display that as a prompt.
562 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
563 input method is turned on in the current buffer, that input method
564 is used for reading a character. */)
565 (prompt
, inherit_input_method
)
566 Lisp_Object prompt
, inherit_input_method
;
569 message_with_string ("%s", prompt
, 0);
570 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
573 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
574 doc
: /* Read a character from the command input (keyboard or macro).
575 It is returned as a number. Non-character events are ignored.
577 If the optional argument PROMPT is non-nil, display that as a prompt.
578 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
579 input method is turned on in the current buffer, that input method
580 is used for reading a character. */)
581 (prompt
, inherit_input_method
)
582 Lisp_Object prompt
, inherit_input_method
;
585 message_with_string ("%s", prompt
, 0);
586 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
589 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
590 doc
: /* Don't use this yourself. */)
593 register Lisp_Object val
;
594 XSETINT (val
, getc (instream
));
600 /* Value is non-zero if the file asswociated with file descriptor FD
601 is a compiled Lisp file that's safe to load. Only files compiled
602 with Emacs are safe to load. Files compiled with XEmacs can lead
603 to a crash in Fbyte_code because of an incompatible change in the
614 /* Read the first few bytes from the file, and look for a line
615 specifying the byte compiler version used. */
616 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
621 /* Skip to the next newline, skipping over the initial `ELC'
622 with NUL bytes following it. */
623 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
627 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
632 lseek (fd
, 0, SEEK_SET
);
637 /* Callback for record_unwind_protect. Restore the old load list OLD,
638 after loading a file successfully. */
641 record_load_unwind (old
)
644 return Vloads_in_progress
= old
;
647 /* This handler function is used via internal_condition_case_1. */
650 load_error_handler (data
)
656 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
657 doc
: /* Execute a file of Lisp code named FILE.
658 First try FILE with `.elc' appended, then try with `.el',
659 then try FILE unmodified (the exact suffixes are determined by
660 `load-suffixes'). Environment variable references in FILE
661 are replaced with their values by calling `substitute-in-file-name'.
662 This function searches the directories in `load-path'.
663 If optional second arg NOERROR is non-nil,
664 report no error if FILE doesn't exist.
665 Print messages at start and end of loading unless
666 optional third arg NOMESSAGE is non-nil.
667 If optional fourth arg NOSUFFIX is non-nil, don't try adding
668 suffixes `.elc' or `.el' to the specified name FILE.
669 If optional fifth arg MUST-SUFFIX is non-nil, insist on
670 the suffix `.elc' or `.el'; don't accept just FILE unless
671 it ends in one of those suffixes or includes a directory name.
673 Loading a file records its definitions, and its `provide' and
674 `require' calls, in an element of `load-history' whose
675 car is the file name loaded. See `load-history'.
677 Return t if file exists. */)
678 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
679 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
681 register FILE *stream
;
682 register int fd
= -1;
683 int count
= SPECPDL_INDEX ();
685 struct gcpro gcpro1
, gcpro2
;
686 Lisp_Object found
, efound
;
687 /* 1 means we printed the ".el is newer" message. */
689 /* 1 means we are loading a compiled file. */
700 /* If file name is magic, call the handler. */
701 /* This shouldn't be necessary any more now that `openp' handles it right.
702 handler = Ffind_file_name_handler (file, Qload);
704 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
706 /* Do this after the handler to avoid
707 the need to gcpro noerror, nomessage and nosuffix.
708 (Below here, we care only whether they are nil or not.)
709 The presence of this call is the result of a historical accident:
710 it used to be in every file-operations and when it got removed
711 everywhere, it accidentally stayed here. Since then, enough people
712 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
713 that it seemed risky to remove. */
714 if (! NILP (noerror
))
716 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
717 Qt
, load_error_handler
);
722 file
= Fsubstitute_in_file_name (file
);
725 /* Avoid weird lossage with null string as arg,
726 since it would try to load a directory as a Lisp file */
727 if (SCHARS (file
) > 0)
729 int size
= SBYTES (file
);
733 GCPRO2 (file
, found
);
735 if (! NILP (must_suffix
))
737 /* Don't insist on adding a suffix if FILE already ends with one. */
739 && !strcmp (SDATA (file
) + size
- 3, ".el"))
742 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
744 /* Don't insist on adding a suffix
745 if the argument includes a directory name. */
746 else if (! NILP (Ffile_name_directory (file
)))
750 fd
= openp (Vload_path
, file
,
751 (!NILP (nosuffix
) ? Qnil
752 : !NILP (must_suffix
) ? Vload_suffixes
753 : Fappend (2, (tmp
[0] = Vload_suffixes
,
754 tmp
[1] = default_suffixes
,
763 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
764 Fcons (file
, Qnil
)));
769 /* Tell startup.el whether or not we found the user's init file. */
770 if (EQ (Qt
, Vuser_init_file
))
771 Vuser_init_file
= found
;
773 /* If FD is -2, that means openp found a magic file. */
776 if (NILP (Fequal (found
, file
)))
777 /* If FOUND is a different file name from FILE,
778 find its handler even if we have already inhibited
779 the `load' operation on FILE. */
780 handler
= Ffind_file_name_handler (found
, Qt
);
782 handler
= Ffind_file_name_handler (found
, Qload
);
783 if (! NILP (handler
))
784 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
787 /* Check if we're stuck in a recursive load cycle.
789 2000-09-21: It's not possible to just check for the file loaded
790 being a member of Vloads_in_progress. This fails because of the
791 way the byte compiler currently works; `provide's are not
792 evaluted, see font-lock.el/jit-lock.el as an example. This
793 leads to a certain amount of ``normal'' recursion.
795 Also, just loading a file recursively is not always an error in
796 the general case; the second load may do something different. */
800 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
801 if (!NILP (Fequal (found
, XCAR (tem
))))
804 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
805 Fcons (found
, Vloads_in_progress
)));
806 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
807 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
810 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
812 /* Load .elc files directly, but not when they are
813 remote and have no handler! */
820 GCPRO2 (file
, found
);
822 if (!safe_to_load_p (fd
))
825 if (!load_dangerous_libraries
)
829 error ("File `%s' was not compiled in Emacs",
832 else if (!NILP (nomessage
))
833 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
838 efound
= ENCODE_FILE (found
);
843 stat ((char *)SDATA (efound
), &s1
);
844 SSET (efound
, SBYTES (efound
) - 1, 0);
845 result
= stat ((char *)SDATA (efound
), &s2
);
846 SSET (efound
, SBYTES (efound
) - 1, 'c');
848 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
850 /* Make the progress messages mention that source is newer. */
853 /* If we won't print another message, mention this anyway. */
854 if (!NILP (nomessage
))
856 Lisp_Object msg_file
;
857 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
858 message_with_string ("Source file `%s' newer than byte-compiled file",
867 /* We are loading a source file (*.el). */
868 if (!NILP (Vload_source_file_function
))
874 val
= call4 (Vload_source_file_function
, found
, file
,
875 NILP (noerror
) ? Qnil
: Qt
,
876 NILP (nomessage
) ? Qnil
: Qt
);
877 return unbind_to (count
, val
);
881 GCPRO2 (file
, found
);
885 efound
= ENCODE_FILE (found
);
886 stream
= fopen ((char *) SDATA (efound
), fmode
);
887 #else /* not WINDOWSNT */
888 stream
= fdopen (fd
, fmode
);
889 #endif /* not WINDOWSNT */
893 error ("Failure to create stdio stream for %s", SDATA (file
));
896 if (! NILP (Vpurify_flag
))
897 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
899 if (NILP (nomessage
))
902 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
905 message_with_string ("Loading %s (source)...", file
, 1);
907 message_with_string ("Loading %s (compiled; note, source file is newer)...",
909 else /* The typical case; compiled file newer than source file. */
910 message_with_string ("Loading %s...", file
, 1);
913 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
914 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
915 specbind (Qload_file_name
, found
);
916 specbind (Qinhibit_file_name_operation
, Qnil
);
918 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
920 readevalloop (Qget_file_char
, stream
, (! NILP (Vpurify_flag
) ? file
: found
),
921 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
922 unbind_to (count
, Qnil
);
924 /* Run any load-hooks for this file. */
925 temp
= Fassoc (file
, Vafter_load_alist
);
927 Fprogn (Fcdr (temp
));
930 if (saved_doc_string
)
931 free (saved_doc_string
);
932 saved_doc_string
= 0;
933 saved_doc_string_size
= 0;
935 if (prev_saved_doc_string
)
936 xfree (prev_saved_doc_string
);
937 prev_saved_doc_string
= 0;
938 prev_saved_doc_string_size
= 0;
940 if (!noninteractive
&& NILP (nomessage
))
943 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
946 message_with_string ("Loading %s (source)...done", file
, 1);
948 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
950 else /* The typical case; compiled file newer than source file. */
951 message_with_string ("Loading %s...done", file
, 1);
954 if (!NILP (Fequal (build_string ("obsolete"),
955 Ffile_name_nondirectory
956 (Fdirectory_file_name (Ffile_name_directory (found
))))))
957 message_with_string ("Package %s is obsolete", file
, 1);
963 load_unwind (arg
) /* used as unwind-protect function in load */
966 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
969 if (--load_in_progress
< 0) load_in_progress
= 0;
974 load_descriptor_unwind (oldlist
)
977 load_descriptor_list
= oldlist
;
981 /* Close all descriptors in use for Floads.
982 This is used when starting a subprocess. */
989 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
990 emacs_close (XFASTINT (XCAR (tail
)));
995 complete_filename_p (pathname
)
996 Lisp_Object pathname
;
998 register const unsigned char *s
= SDATA (pathname
);
999 return (IS_DIRECTORY_SEP (s
[0])
1000 || (SCHARS (pathname
) > 2
1001 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1011 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1012 doc
: /* Search for FILENAME through PATH.
1013 Returns the file's name in absolute form, or nil if not found.
1014 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1015 file name when searching.
1016 If non-nil, PREDICATE is used instead of `file-readable-p'.
1017 PREDICATE can also be an integer to pass to the access(2) function,
1018 in which case file-name-handlers are ignored. */)
1019 (filename
, path
, suffixes
, predicate
)
1020 Lisp_Object filename
, path
, suffixes
, predicate
;
1023 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1024 if (NILP (predicate
) && fd
> 0)
1030 /* Search for a file whose name is STR, looking in directories
1031 in the Lisp list PATH, and trying suffixes from SUFFIX.
1032 On success, returns a file descriptor. On failure, returns -1.
1034 SUFFIXES is a list of strings containing possible suffixes.
1035 The empty suffix is automatically added iff the list is empty.
1037 PREDICATE non-nil means don't open the files,
1038 just look for one that satisfies the predicate. In this case,
1039 returns 1 on success. The predicate can be a lisp function or
1040 an integer to pass to `access' (in which case file-name-handlers
1043 If STOREPTR is nonzero, it points to a slot where the name of
1044 the file actually found should be stored as a Lisp string.
1045 nil is stored there on failure.
1047 If the file we find is remote, return -2
1048 but store the found remote file name in *STOREPTR. */
1051 openp (path
, str
, suffixes
, storeptr
, predicate
)
1052 Lisp_Object path
, str
;
1053 Lisp_Object suffixes
;
1054 Lisp_Object
*storeptr
;
1055 Lisp_Object predicate
;
1060 register char *fn
= buf
;
1063 Lisp_Object filename
;
1065 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1066 Lisp_Object string
, tail
, encoded_fn
;
1067 int max_suffix_len
= 0;
1071 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1073 CHECK_STRING_CAR (tail
);
1074 max_suffix_len
= max (max_suffix_len
,
1075 SBYTES (XCAR (tail
)));
1078 string
= filename
= Qnil
;
1079 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1084 if (complete_filename_p (str
))
1087 for (; CONSP (path
); path
= XCDR (path
))
1089 filename
= Fexpand_file_name (str
, XCAR (path
));
1090 if (!complete_filename_p (filename
))
1091 /* If there are non-absolute elts in PATH (eg ".") */
1092 /* Of course, this could conceivably lose if luser sets
1093 default-directory to be something non-absolute... */
1095 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1096 if (!complete_filename_p (filename
))
1097 /* Give up on this path element! */
1101 /* Calculate maximum size of any filename made from
1102 this path element/specified file name and any possible suffix. */
1103 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1104 if (fn_size
< want_size
)
1105 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1107 /* Loop over suffixes. */
1108 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1109 CONSP (tail
); tail
= XCDR (tail
))
1111 int lsuffix
= SBYTES (XCAR (tail
));
1112 Lisp_Object handler
;
1115 /* Concatenate path element/specified name with the suffix.
1116 If the directory starts with /:, remove that. */
1117 if (SCHARS (filename
) > 2
1118 && SREF (filename
, 0) == '/'
1119 && SREF (filename
, 1) == ':')
1121 strncpy (fn
, SDATA (filename
) + 2,
1122 SBYTES (filename
) - 2);
1123 fn
[SBYTES (filename
) - 2] = 0;
1127 strncpy (fn
, SDATA (filename
),
1129 fn
[SBYTES (filename
)] = 0;
1132 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1133 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1135 /* Check that the file exists and is not a directory. */
1136 /* We used to only check for handlers on non-absolute file names:
1140 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1141 It's not clear why that was the case and it breaks things like
1142 (load "/bar.el") where the file is actually "/bar.el.gz". */
1143 string
= build_string (fn
);
1144 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1145 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1147 if (NILP (predicate
))
1148 exists
= !NILP (Ffile_readable_p (string
));
1150 exists
= !NILP (call1 (predicate
, string
));
1151 if (exists
&& !NILP (Ffile_directory_p (string
)))
1156 /* We succeeded; return this descriptor and filename. */
1167 encoded_fn
= ENCODE_FILE (string
);
1168 pfn
= SDATA (encoded_fn
);
1169 exists
= (stat (pfn
, &st
) >= 0
1170 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1173 /* Check that we can access or open it. */
1174 if (NATNUMP (predicate
))
1175 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1177 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1181 /* We succeeded; return this descriptor and filename. */
1199 /* Merge the list we've accumulated of globals from the current input source
1200 into the load_history variable. The details depend on whether
1201 the source has an associated file name or not.
1203 FILENAME is the file name that we are loading from.
1204 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1207 build_load_history (filename
, entire
)
1208 Lisp_Object filename
;
1211 register Lisp_Object tail
, prev
, newelt
;
1212 register Lisp_Object tem
, tem2
;
1213 register int foundit
= 0;
1215 tail
= Vload_history
;
1218 while (CONSP (tail
))
1222 /* Find the feature's previous assoc list... */
1223 if (!NILP (Fequal (filename
, Fcar (tem
))))
1227 /* If we're loading the entire file, remove old data. */
1231 Vload_history
= XCDR (tail
);
1233 Fsetcdr (prev
, XCDR (tail
));
1236 /* Otherwise, cons on new symbols that are not already members. */
1239 tem2
= Vcurrent_load_list
;
1241 while (CONSP (tem2
))
1243 newelt
= XCAR (tem2
);
1245 if (NILP (Fmember (newelt
, tem
)))
1246 Fsetcar (tail
, Fcons (XCAR (tem
),
1247 Fcons (newelt
, XCDR (tem
))));
1260 /* If we're loading an entire file, cons the new assoc onto the
1261 front of load-history, the most-recently-loaded position. Also
1262 do this if we didn't find an existing member for the file. */
1263 if (entire
|| !foundit
)
1264 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1269 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1277 readevalloop_1 (old
)
1280 load_convert_to_unibyte
= ! NILP (old
);
1284 /* Signal an `end-of-file' error, if possible with file name
1288 end_of_file_error ()
1292 if (STRINGP (Vload_file_name
))
1293 data
= Fcons (Vload_file_name
, Qnil
);
1297 Fsignal (Qend_of_file
, data
);
1300 /* UNIBYTE specifies how to set load_convert_to_unibyte
1301 for this invocation.
1302 READFUN, if non-nil, is used instead of `read'.
1303 START, END is region in current buffer (from eval-region). */
1306 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1307 printflag
, unibyte
, readfun
, start
, end
)
1308 Lisp_Object readcharfun
;
1310 Lisp_Object sourcename
;
1311 Lisp_Object (*evalfun
) ();
1313 Lisp_Object unibyte
, readfun
;
1314 Lisp_Object start
, end
;
1317 register Lisp_Object val
;
1318 int count
= SPECPDL_INDEX ();
1319 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1320 struct buffer
*b
= 0;
1321 int continue_reading_p
;
1323 if (BUFFERP (readcharfun
))
1324 b
= XBUFFER (readcharfun
);
1325 else if (MARKERP (readcharfun
))
1326 b
= XMARKER (readcharfun
)->buffer
;
1328 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1329 specbind (Qcurrent_load_list
, Qnil
);
1330 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1331 load_convert_to_unibyte
= !NILP (unibyte
);
1333 readchar_backlog
= -1;
1335 GCPRO4 (sourcename
, readfun
, start
, end
);
1337 LOADHIST_ATTACH (sourcename
);
1339 continue_reading_p
= 1;
1340 while (continue_reading_p
)
1342 int count1
= SPECPDL_INDEX ();
1344 if (b
!= 0 && NILP (b
->name
))
1345 error ("Reading from killed buffer");
1350 /* Switch to the buffer we are reading from. */
1351 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1352 set_buffer_internal (b
);
1354 /* Save point in it. */
1355 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1356 /* Save ZV in it. */
1357 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1358 /* Those get unbound after we read one expression. */
1360 /* Set point and ZV around stuff to be read. */
1362 Fnarrow_to_region (make_number (BEGV
), end
);
1370 while ((c
= READCHAR
) != '\n' && c
!= -1);
1375 unbind_to (count1
, Qnil
);
1379 /* Ignore whitespace here, so we can detect eof. */
1380 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1383 if (!NILP (Vpurify_flag
) && c
== '(')
1385 record_unwind_protect (unreadpure
, Qnil
);
1386 val
= read_list (-1, readcharfun
);
1391 read_objects
= Qnil
;
1392 if (!NILP (readfun
))
1394 val
= call1 (readfun
, readcharfun
);
1396 /* If READCHARFUN has set point to ZV, we should
1397 stop reading, even if the form read sets point
1398 to a different value when evaluated. */
1399 if (BUFFERP (readcharfun
))
1401 struct buffer
*b
= XBUFFER (readcharfun
);
1402 if (BUF_PT (b
) == BUF_ZV (b
))
1403 continue_reading_p
= 0;
1406 else if (! NILP (Vload_read_function
))
1407 val
= call1 (Vload_read_function
, readcharfun
);
1409 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1412 if (!NILP (start
) && continue_reading_p
)
1413 start
= Fpoint_marker ();
1414 unbind_to (count1
, Qnil
);
1416 val
= (*evalfun
) (val
);
1420 Vvalues
= Fcons (val
, Vvalues
);
1421 if (EQ (Vstandard_output
, Qt
))
1428 build_load_history (sourcename
,
1429 stream
|| (INTEGERP (start
) && INTEGERP (end
)
1430 && XINT (start
) == BEG
&& XINT (end
) == Z
));
1434 unbind_to (count
, Qnil
);
1437 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1438 doc
: /* Execute the current buffer as Lisp code.
1439 Programs can pass two arguments, BUFFER and PRINTFLAG.
1440 BUFFER is the buffer to evaluate (nil means use current buffer).
1441 PRINTFLAG controls printing of output:
1442 nil means discard it; anything else is stream for print.
1444 If the optional third argument FILENAME is non-nil,
1445 it specifies the file name to use for `load-history'.
1446 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1447 for this invocation.
1449 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1450 `print' and related functions should work normally even if PRINTFLAG is nil.
1452 This function preserves the position of point. */)
1453 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1454 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1456 int count
= SPECPDL_INDEX ();
1457 Lisp_Object tem
, buf
;
1460 buf
= Fcurrent_buffer ();
1462 buf
= Fget_buffer (buffer
);
1464 error ("No such buffer");
1466 if (NILP (printflag
) && NILP (do_allow_print
))
1471 if (NILP (filename
))
1472 filename
= XBUFFER (buf
)->filename
;
1474 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1475 specbind (Qstandard_output
, tem
);
1476 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1477 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1478 readevalloop (buf
, 0, filename
, Feval
,
1479 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1480 unbind_to (count
, Qnil
);
1485 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1486 doc
: /* Execute the region as Lisp code.
1487 When called from programs, expects two arguments,
1488 giving starting and ending indices in the current buffer
1489 of the text to be executed.
1490 Programs can pass third argument PRINTFLAG which controls output:
1491 nil means discard it; anything else is stream for printing it.
1492 Also the fourth argument READ-FUNCTION, if non-nil, is used
1493 instead of `read' to read each expression. It gets one argument
1494 which is the input stream for reading characters.
1496 This function does not move point. */)
1497 (start
, end
, printflag
, read_function
)
1498 Lisp_Object start
, end
, printflag
, read_function
;
1500 int count
= SPECPDL_INDEX ();
1501 Lisp_Object tem
, cbuf
;
1503 cbuf
= Fcurrent_buffer ();
1505 if (NILP (printflag
))
1509 specbind (Qstandard_output
, tem
);
1510 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1512 /* readevalloop calls functions which check the type of start and end. */
1513 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1514 !NILP (printflag
), Qnil
, read_function
,
1517 return unbind_to (count
, Qnil
);
1521 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1522 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1523 If STREAM is nil, use the value of `standard-input' (which see).
1524 STREAM or the value of `standard-input' may be:
1525 a buffer (read from point and advance it)
1526 a marker (read from where it points and advance it)
1527 a function (call it with no arguments for each character,
1528 call it with a char as argument to push a char back)
1529 a string (takes text from string, starting at the beginning)
1530 t (read text line using minibuffer and use it, or read from
1531 standard input in batch mode). */)
1536 stream
= Vstandard_input
;
1537 if (EQ (stream
, Qt
))
1538 stream
= Qread_char
;
1539 if (EQ (stream
, Qread_char
))
1540 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1542 return read_internal_start (stream
, Qnil
, Qnil
);
1545 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1546 doc
: /* Read one Lisp expression which is represented as text by STRING.
1547 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1548 START and END optionally delimit a substring of STRING from which to read;
1549 they default to 0 and (length STRING) respectively. */)
1550 (string
, start
, end
)
1551 Lisp_Object string
, start
, end
;
1554 CHECK_STRING (string
);
1555 /* read_internal_start sets read_from_string_index. */
1556 ret
= read_internal_start (string
, start
, end
);
1557 return Fcons (ret
, make_number (read_from_string_index
));
1560 /* Function to set up the global context we need in toplevel read
1563 read_internal_start (stream
, start
, end
)
1565 Lisp_Object start
; /* Only used when stream is a string. */
1566 Lisp_Object end
; /* Only used when stream is a string. */
1570 readchar_backlog
= -1;
1572 new_backquote_flag
= 0;
1573 read_objects
= Qnil
;
1574 if (EQ (Vread_with_symbol_positions
, Qt
)
1575 || EQ (Vread_with_symbol_positions
, stream
))
1576 Vread_symbol_positions_list
= Qnil
;
1578 if (STRINGP (stream
))
1580 int startval
, endval
;
1582 endval
= SCHARS (stream
);
1586 endval
= XINT (end
);
1587 if (endval
< 0 || endval
> SCHARS (stream
))
1588 args_out_of_range (stream
, end
);
1595 CHECK_NUMBER (start
);
1596 startval
= XINT (start
);
1597 if (startval
< 0 || startval
> endval
)
1598 args_out_of_range (stream
, start
);
1600 read_from_string_index
= startval
;
1601 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1602 read_from_string_limit
= endval
;
1605 retval
= read0 (stream
);
1606 if (EQ (Vread_with_symbol_positions
, Qt
)
1607 || EQ (Vread_with_symbol_positions
, stream
))
1608 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1612 /* Use this for recursive reads, in contexts where internal tokens
1617 Lisp_Object readcharfun
;
1619 register Lisp_Object val
;
1622 val
= read1 (readcharfun
, &c
, 0);
1624 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1631 static int read_buffer_size
;
1632 static char *read_buffer
;
1634 /* Read multibyte form and return it as a character. C is a first
1635 byte of multibyte form, and rest of them are read from
1639 read_multibyte (c
, readcharfun
)
1641 Lisp_Object readcharfun
;
1643 /* We need the actual character code of this multibyte
1645 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1653 while ((c
= READCHAR
) >= 0xA0
1654 && len
< MAX_MULTIBYTE_LENGTH
)
1660 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1661 return STRING_CHAR (str
, len
);
1662 /* The byte sequence is not valid as multibyte. Unread all bytes
1663 but the first one, and return the first byte. */
1669 /* Read a \-escape sequence, assuming we already read the `\'.
1670 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1671 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1672 Otherwise store 0 into *BYTEREP. */
1675 read_escape (readcharfun
, stringp
, byterep
)
1676 Lisp_Object readcharfun
;
1680 register int c
= READCHAR
;
1687 end_of_file_error ();
1717 error ("Invalid escape character syntax");
1720 c
= read_escape (readcharfun
, 0, byterep
);
1721 return c
| meta_modifier
;
1726 error ("Invalid escape character syntax");
1729 c
= read_escape (readcharfun
, 0, byterep
);
1730 return c
| shift_modifier
;
1735 error ("Invalid escape character syntax");
1738 c
= read_escape (readcharfun
, 0, byterep
);
1739 return c
| hyper_modifier
;
1744 error ("Invalid escape character syntax");
1747 c
= read_escape (readcharfun
, 0, byterep
);
1748 return c
| alt_modifier
;
1759 c
= read_escape (readcharfun
, 0, byterep
);
1760 return c
| super_modifier
;
1765 error ("Invalid escape character syntax");
1769 c
= read_escape (readcharfun
, 0, byterep
);
1770 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1771 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1772 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1773 return c
| ctrl_modifier
;
1774 /* ASCII control chars are made from letters (both cases),
1775 as well as the non-letters within 0100...0137. */
1776 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1777 return (c
& (037 | ~0177));
1778 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1779 return (c
& (037 | ~0177));
1781 return c
| ctrl_modifier
;
1791 /* An octal escape, as in ANSI C. */
1793 register int i
= c
- '0';
1794 register int count
= 0;
1797 if ((c
= READCHAR
) >= '0' && c
<= '7')
1814 /* A hex escape, as in ANSI C. */
1820 if (c
>= '0' && c
<= '9')
1825 else if ((c
>= 'a' && c
<= 'f')
1826 || (c
>= 'A' && c
<= 'F'))
1829 if (c
>= 'a' && c
<= 'f')
1846 if (BASE_LEADING_CODE_P (c
))
1847 c
= read_multibyte (c
, readcharfun
);
1853 /* Read an integer in radix RADIX using READCHARFUN to read
1854 characters. RADIX must be in the interval [2..36]; if it isn't, a
1855 read error is signaled . Value is the integer read. Signals an
1856 error if encountering invalid read syntax or if RADIX is out of
1860 read_integer (readcharfun
, radix
)
1861 Lisp_Object readcharfun
;
1864 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1865 EMACS_INT number
= 0;
1867 if (radix
< 2 || radix
> 36)
1871 number
= ndigits
= invalid_p
= 0;
1887 if (c
>= '0' && c
<= '9')
1889 else if (c
>= 'a' && c
<= 'z')
1890 digit
= c
- 'a' + 10;
1891 else if (c
>= 'A' && c
<= 'Z')
1892 digit
= c
- 'A' + 10;
1899 if (digit
< 0 || digit
>= radix
)
1902 number
= radix
* number
+ digit
;
1908 if (ndigits
== 0 || invalid_p
)
1911 sprintf (buf
, "integer, radix %d", radix
);
1912 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1915 return make_number (sign
* number
);
1919 /* Convert unibyte text in read_buffer to multibyte.
1921 Initially, *P is a pointer after the end of the unibyte text, and
1922 the pointer *END points after the end of read_buffer.
1924 If read_buffer doesn't have enough room to hold the result
1925 of the conversion, reallocate it and adjust *P and *END.
1927 At the end, make *P point after the result of the conversion, and
1928 return in *NCHARS the number of characters in the converted
1932 to_multibyte (p
, end
, nchars
)
1938 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1939 if (read_buffer_size
< 2 * nbytes
)
1941 int offset
= *p
- read_buffer
;
1942 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1943 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1944 *p
= read_buffer
+ offset
;
1945 *end
= read_buffer
+ read_buffer_size
;
1948 if (nbytes
!= *nchars
)
1949 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1950 *p
- read_buffer
, nchars
);
1952 *p
= read_buffer
+ nbytes
;
1956 /* If the next token is ')' or ']' or '.', we store that character
1957 in *PCH and the return value is not interesting. Else, we store
1958 zero in *PCH and we read and return one lisp object.
1960 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1963 read1 (readcharfun
, pch
, first_in_list
)
1964 register Lisp_Object readcharfun
;
1969 int uninterned_symbol
= 0;
1977 end_of_file_error ();
1982 return read_list (0, readcharfun
);
1985 return read_vector (readcharfun
, 0);
2002 tmp
= read_vector (readcharfun
, 0);
2003 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
2004 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
2005 error ("Invalid size char-table");
2006 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2007 XCHAR_TABLE (tmp
)->top
= Qt
;
2016 tmp
= read_vector (readcharfun
, 0);
2017 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2018 error ("Invalid size char-table");
2019 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2020 XCHAR_TABLE (tmp
)->top
= Qnil
;
2023 Fsignal (Qinvalid_read_syntax
,
2024 Fcons (make_string ("#^^", 3), Qnil
));
2026 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2031 length
= read1 (readcharfun
, pch
, first_in_list
);
2035 Lisp_Object tmp
, val
;
2037 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2038 / BOOL_VECTOR_BITS_PER_CHAR
);
2041 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2042 if (size_in_chars
!= SCHARS (tmp
)
2043 /* We used to print 1 char too many
2044 when the number of bits was a multiple of 8.
2045 Accept such input in case it came from an old version. */
2046 && ! (XFASTINT (length
)
2047 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2048 Fsignal (Qinvalid_read_syntax
,
2049 Fcons (make_string ("#&...", 5), Qnil
));
2051 val
= Fmake_bool_vector (length
, Qnil
);
2052 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2054 /* Clear the extraneous bits in the last byte. */
2055 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2056 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2057 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2060 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2065 /* Accept compiled functions at read-time so that we don't have to
2066 build them using function calls. */
2068 tmp
= read_vector (readcharfun
, 1);
2069 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2070 XVECTOR (tmp
)->contents
);
2075 struct gcpro gcpro1
;
2078 /* Read the string itself. */
2079 tmp
= read1 (readcharfun
, &ch
, 0);
2080 if (ch
!= 0 || !STRINGP (tmp
))
2081 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2083 /* Read the intervals and their properties. */
2086 Lisp_Object beg
, end
, plist
;
2088 beg
= read1 (readcharfun
, &ch
, 0);
2093 end
= read1 (readcharfun
, &ch
, 0);
2095 plist
= read1 (readcharfun
, &ch
, 0);
2097 Fsignal (Qinvalid_read_syntax
,
2098 Fcons (build_string ("invalid string property list"),
2100 Fset_text_properties (beg
, end
, plist
, tmp
);
2106 /* #@NUMBER is used to skip NUMBER following characters.
2107 That's used in .elc files to skip over doc strings
2108 and function definitions. */
2113 /* Read a decimal integer. */
2114 while ((c
= READCHAR
) >= 0
2115 && c
>= '0' && c
<= '9')
2123 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2125 /* If we are supposed to force doc strings into core right now,
2126 record the last string that we skipped,
2127 and record where in the file it comes from. */
2129 /* But first exchange saved_doc_string
2130 with prev_saved_doc_string, so we save two strings. */
2132 char *temp
= saved_doc_string
;
2133 int temp_size
= saved_doc_string_size
;
2134 file_offset temp_pos
= saved_doc_string_position
;
2135 int temp_len
= saved_doc_string_length
;
2137 saved_doc_string
= prev_saved_doc_string
;
2138 saved_doc_string_size
= prev_saved_doc_string_size
;
2139 saved_doc_string_position
= prev_saved_doc_string_position
;
2140 saved_doc_string_length
= prev_saved_doc_string_length
;
2142 prev_saved_doc_string
= temp
;
2143 prev_saved_doc_string_size
= temp_size
;
2144 prev_saved_doc_string_position
= temp_pos
;
2145 prev_saved_doc_string_length
= temp_len
;
2148 if (saved_doc_string_size
== 0)
2150 saved_doc_string_size
= nskip
+ 100;
2151 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2153 if (nskip
> saved_doc_string_size
)
2155 saved_doc_string_size
= nskip
+ 100;
2156 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2157 saved_doc_string_size
);
2160 saved_doc_string_position
= file_tell (instream
);
2162 /* Copy that many characters into saved_doc_string. */
2163 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2164 saved_doc_string
[i
] = c
= READCHAR
;
2166 saved_doc_string_length
= i
;
2170 /* Skip that many characters. */
2171 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2179 /* #! appears at the beginning of an executable file.
2180 Skip the first line. */
2181 while (c
!= '\n' && c
>= 0)
2186 return Vload_file_name
;
2188 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2189 /* #:foo is the uninterned symbol named foo. */
2192 uninterned_symbol
= 1;
2196 /* Reader forms that can reuse previously read objects. */
2197 if (c
>= '0' && c
<= '9')
2202 /* Read a non-negative integer. */
2203 while (c
>= '0' && c
<= '9')
2209 /* #n=object returns object, but associates it with n for #n#. */
2212 /* Make a placeholder for #n# to use temporarily */
2213 Lisp_Object placeholder
;
2216 placeholder
= Fcons(Qnil
, Qnil
);
2217 cell
= Fcons (make_number (n
), placeholder
);
2218 read_objects
= Fcons (cell
, read_objects
);
2220 /* Read the object itself. */
2221 tem
= read0 (readcharfun
);
2223 /* Now put it everywhere the placeholder was... */
2224 substitute_object_in_subtree (tem
, placeholder
);
2226 /* ...and #n# will use the real value from now on. */
2227 Fsetcdr (cell
, tem
);
2231 /* #n# returns a previously read object. */
2234 tem
= Fassq (make_number (n
), read_objects
);
2237 /* Fall through to error message. */
2239 else if (c
== 'r' || c
== 'R')
2240 return read_integer (readcharfun
, n
);
2242 /* Fall through to error message. */
2244 else if (c
== 'x' || c
== 'X')
2245 return read_integer (readcharfun
, 16);
2246 else if (c
== 'o' || c
== 'O')
2247 return read_integer (readcharfun
, 8);
2248 else if (c
== 'b' || c
== 'B')
2249 return read_integer (readcharfun
, 2);
2252 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2255 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2260 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2270 new_backquote_flag
++;
2271 value
= read0 (readcharfun
);
2272 new_backquote_flag
--;
2274 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2278 if (new_backquote_flag
)
2280 Lisp_Object comma_type
= Qnil
;
2285 comma_type
= Qcomma_at
;
2287 comma_type
= Qcomma_dot
;
2290 if (ch
>= 0) UNREAD (ch
);
2291 comma_type
= Qcomma
;
2294 new_backquote_flag
--;
2295 value
= read0 (readcharfun
);
2296 new_backquote_flag
++;
2297 return Fcons (comma_type
, Fcons (value
, Qnil
));
2310 end_of_file_error ();
2312 /* Accept `single space' syntax like (list ? x) where the
2313 whitespace character is SPC or TAB.
2314 Other literal whitespace like NL, CR, and FF are not accepted,
2315 as there are well-established escape sequences for these. */
2316 if (c
== ' ' || c
== '\t')
2317 return make_number (c
);
2320 c
= read_escape (readcharfun
, 0, &discard
);
2321 else if (BASE_LEADING_CODE_P (c
))
2322 c
= read_multibyte (c
, readcharfun
);
2324 next_char
= READCHAR
;
2325 if (next_char
== '.')
2327 /* Only a dotted-pair dot is valid after a char constant. */
2328 int next_next_char
= READCHAR
;
2329 UNREAD (next_next_char
);
2331 ok
= (next_next_char
<= 040
2332 || (next_next_char
< 0200
2333 && (index ("\"';([#?", next_next_char
)
2334 || (!first_in_list
&& next_next_char
== '`')
2335 || (new_backquote_flag
&& next_next_char
== ','))));
2339 ok
= (next_char
<= 040
2340 || (next_char
< 0200
2341 && (index ("\"';()[]#?", next_char
)
2342 || (!first_in_list
&& next_char
== '`')
2343 || (new_backquote_flag
&& next_char
== ','))));
2347 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2349 return make_number (c
);
2354 char *p
= read_buffer
;
2355 char *end
= read_buffer
+ read_buffer_size
;
2357 /* 1 if we saw an escape sequence specifying
2358 a multibyte character, or a multibyte character. */
2359 int force_multibyte
= 0;
2360 /* 1 if we saw an escape sequence specifying
2361 a single-byte character. */
2362 int force_singlebyte
= 0;
2363 /* 1 if read_buffer contains multibyte text now. */
2364 int is_multibyte
= 0;
2368 while ((c
= READCHAR
) >= 0
2371 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2373 int offset
= p
- read_buffer
;
2374 read_buffer
= (char *) xrealloc (read_buffer
,
2375 read_buffer_size
*= 2);
2376 p
= read_buffer
+ offset
;
2377 end
= read_buffer
+ read_buffer_size
;
2384 c
= read_escape (readcharfun
, 1, &byterep
);
2386 /* C is -1 if \ newline has just been seen */
2389 if (p
== read_buffer
)
2395 force_singlebyte
= 1;
2396 else if (byterep
== 2)
2397 force_multibyte
= 1;
2400 /* A character that must be multibyte forces multibyte. */
2401 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2402 force_multibyte
= 1;
2404 /* If we just discovered the need to be multibyte,
2405 convert the text accumulated thus far. */
2406 if (force_multibyte
&& ! is_multibyte
)
2409 to_multibyte (&p
, &end
, &nchars
);
2412 /* Allow `\C- ' and `\C-?'. */
2413 if (c
== (CHAR_CTL
| ' '))
2415 else if (c
== (CHAR_CTL
| '?'))
2420 /* Shift modifier is valid only with [A-Za-z]. */
2421 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2423 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2424 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2428 /* Move the meta bit to the right place for a string. */
2429 c
= (c
& ~CHAR_META
) | 0x80;
2430 if (c
& CHAR_MODIFIER_MASK
)
2431 error ("Invalid modifier in string");
2434 p
+= CHAR_STRING (c
, p
);
2442 end_of_file_error ();
2444 /* If purifying, and string starts with \ newline,
2445 return zero instead. This is for doc strings
2446 that we are really going to find in etc/DOC.nn.nn */
2447 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2448 return make_number (0);
2450 if (is_multibyte
|| force_singlebyte
)
2452 else if (load_convert_to_unibyte
)
2455 to_multibyte (&p
, &end
, &nchars
);
2456 if (p
- read_buffer
!= nchars
)
2458 string
= make_multibyte_string (read_buffer
, nchars
,
2460 return Fstring_make_unibyte (string
);
2462 /* We can make a unibyte string directly. */
2465 else if (EQ (readcharfun
, Qget_file_char
)
2466 || EQ (readcharfun
, Qlambda
))
2468 /* Nowadays, reading directly from a file is used only for
2469 compiled Emacs Lisp files, and those always use the
2470 Emacs internal encoding. Meanwhile, Qlambda is used
2471 for reading dynamic byte code (compiled with
2472 byte-compile-dynamic = t). So make the string multibyte
2473 if the string contains any multibyte sequences.
2474 (to_multibyte is a no-op if not.) */
2475 to_multibyte (&p
, &end
, &nchars
);
2476 is_multibyte
= (p
- read_buffer
) != nchars
;
2479 /* In all other cases, if we read these bytes as
2480 separate characters, treat them as separate characters now. */
2483 /* We want readchar_count to be the number of characters, not
2484 bytes. Hence we adjust for multibyte characters in the
2485 string. ... But it doesn't seem to be necessary, because
2486 READCHAR *does* read multibyte characters from buffers. */
2487 /* readchar_count -= (p - read_buffer) - nchars; */
2489 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2491 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2497 int next_char
= READCHAR
;
2500 if (next_char
<= 040
2501 || (next_char
< 0200
2502 && (index ("\"';([#?", next_char
)
2503 || (!first_in_list
&& next_char
== '`')
2504 || (new_backquote_flag
&& next_char
== ','))))
2510 /* Otherwise, we fall through! Note that the atom-reading loop
2511 below will now loop at least once, assuring that we will not
2512 try to UNREAD two characters in a row. */
2516 if (c
<= 040) goto retry
;
2518 char *p
= read_buffer
;
2522 char *end
= read_buffer
+ read_buffer_size
;
2526 || (!index ("\"';()[]#", c
)
2527 && !(!first_in_list
&& c
== '`')
2528 && !(new_backquote_flag
&& c
== ','))))
2530 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2532 int offset
= p
- read_buffer
;
2533 read_buffer
= (char *) xrealloc (read_buffer
,
2534 read_buffer_size
*= 2);
2535 p
= read_buffer
+ offset
;
2536 end
= read_buffer
+ read_buffer_size
;
2543 end_of_file_error ();
2547 if (! SINGLE_BYTE_CHAR_P (c
))
2548 p
+= CHAR_STRING (c
, p
);
2557 int offset
= p
- read_buffer
;
2558 read_buffer
= (char *) xrealloc (read_buffer
,
2559 read_buffer_size
*= 2);
2560 p
= read_buffer
+ offset
;
2561 end
= read_buffer
+ read_buffer_size
;
2568 if (!quoted
&& !uninterned_symbol
)
2571 register Lisp_Object val
;
2573 if (*p1
== '+' || *p1
== '-') p1
++;
2574 /* Is it an integer? */
2577 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2578 /* Integers can have trailing decimal points. */
2579 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2581 /* It is an integer. */
2585 if (sizeof (int) == sizeof (EMACS_INT
))
2586 XSETINT (val
, atoi (read_buffer
));
2587 else if (sizeof (long) == sizeof (EMACS_INT
))
2588 XSETINT (val
, atol (read_buffer
));
2594 if (isfloat_string (read_buffer
))
2596 /* Compute NaN and infinities using 0.0 in a variable,
2597 to cope with compilers that think they are smarter
2603 /* Negate the value ourselves. This treats 0, NaNs,
2604 and infinity properly on IEEE floating point hosts,
2605 and works around a common bug where atof ("-0.0")
2607 int negative
= read_buffer
[0] == '-';
2609 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2610 returns 1, is if the input ends in e+INF or e+NaN. */
2617 value
= zero
/ zero
;
2619 /* If that made a "negative" NaN, negate it. */
2623 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2626 u_minus_zero
.d
= - 0.0;
2627 for (i
= 0; i
< sizeof (double); i
++)
2628 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2634 /* Now VALUE is a positive NaN. */
2637 value
= atof (read_buffer
+ negative
);
2641 return make_float (negative
? - value
: value
);
2645 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2646 : intern (read_buffer
);
2647 if (EQ (Vread_with_symbol_positions
, Qt
)
2648 || EQ (Vread_with_symbol_positions
, readcharfun
))
2649 Vread_symbol_positions_list
=
2650 /* Kind of a hack; this will probably fail if characters
2651 in the symbol name were escaped. Not really a big
2653 Fcons (Fcons (result
,
2654 make_number (readchar_count
2655 - XFASTINT (Flength (Fsymbol_name (result
))))),
2656 Vread_symbol_positions_list
);
2664 /* List of nodes we've seen during substitute_object_in_subtree. */
2665 static Lisp_Object seen_list
;
2668 substitute_object_in_subtree (object
, placeholder
)
2670 Lisp_Object placeholder
;
2672 Lisp_Object check_object
;
2674 /* We haven't seen any objects when we start. */
2677 /* Make all the substitutions. */
2679 = substitute_object_recurse (object
, placeholder
, object
);
2681 /* Clear seen_list because we're done with it. */
2684 /* The returned object here is expected to always eq the
2686 if (!EQ (check_object
, object
))
2687 error ("Unexpected mutation error in reader");
2690 /* Feval doesn't get called from here, so no gc protection is needed. */
2691 #define SUBSTITUTE(get_val, set_val) \
2693 Lisp_Object old_value = get_val; \
2694 Lisp_Object true_value \
2695 = substitute_object_recurse (object, placeholder,\
2698 if (!EQ (old_value, true_value)) \
2705 substitute_object_recurse (object
, placeholder
, subtree
)
2707 Lisp_Object placeholder
;
2708 Lisp_Object subtree
;
2710 /* If we find the placeholder, return the target object. */
2711 if (EQ (placeholder
, subtree
))
2714 /* If we've been to this node before, don't explore it again. */
2715 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2718 /* If this node can be the entry point to a cycle, remember that
2719 we've seen it. It can only be such an entry point if it was made
2720 by #n=, which means that we can find it as a value in
2722 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2723 seen_list
= Fcons (subtree
, seen_list
);
2725 /* Recurse according to subtree's type.
2726 Every branch must return a Lisp_Object. */
2727 switch (XTYPE (subtree
))
2729 case Lisp_Vectorlike
:
2732 int length
= XINT (Flength(subtree
));
2733 for (i
= 0; i
< length
; i
++)
2735 Lisp_Object idx
= make_number (i
);
2736 SUBSTITUTE (Faref (subtree
, idx
),
2737 Faset (subtree
, idx
, true_value
));
2744 SUBSTITUTE (Fcar_safe (subtree
),
2745 Fsetcar (subtree
, true_value
));
2746 SUBSTITUTE (Fcdr_safe (subtree
),
2747 Fsetcdr (subtree
, true_value
));
2753 /* Check for text properties in each interval.
2754 substitute_in_interval contains part of the logic. */
2756 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2757 Lisp_Object arg
= Fcons (object
, placeholder
);
2759 traverse_intervals_noorder (root_interval
,
2760 &substitute_in_interval
, arg
);
2765 /* Other types don't recurse any further. */
2771 /* Helper function for substitute_object_recurse. */
2773 substitute_in_interval (interval
, arg
)
2777 Lisp_Object object
= Fcar (arg
);
2778 Lisp_Object placeholder
= Fcdr (arg
);
2780 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2799 if (*cp
== '+' || *cp
== '-')
2802 if (*cp
>= '0' && *cp
<= '9')
2805 while (*cp
>= '0' && *cp
<= '9')
2813 if (*cp
>= '0' && *cp
<= '9')
2816 while (*cp
>= '0' && *cp
<= '9')
2819 if (*cp
== 'e' || *cp
== 'E')
2823 if (*cp
== '+' || *cp
== '-')
2827 if (*cp
>= '0' && *cp
<= '9')
2830 while (*cp
>= '0' && *cp
<= '9')
2833 else if (cp
== start
)
2835 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2840 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2846 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2847 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2848 || state
== (DOT_CHAR
|TRAIL_INT
)
2849 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2850 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2851 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2856 read_vector (readcharfun
, bytecodeflag
)
2857 Lisp_Object readcharfun
;
2862 register Lisp_Object
*ptr
;
2863 register Lisp_Object tem
, item
, vector
;
2864 register struct Lisp_Cons
*otem
;
2867 tem
= read_list (1, readcharfun
);
2868 len
= Flength (tem
);
2869 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2871 size
= XVECTOR (vector
)->size
;
2872 ptr
= XVECTOR (vector
)->contents
;
2873 for (i
= 0; i
< size
; i
++)
2876 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2877 bytecode object, the docstring containing the bytecode and
2878 constants values must be treated as unibyte and passed to
2879 Fread, to get the actual bytecode string and constants vector. */
2880 if (bytecodeflag
&& load_force_doc_strings
)
2882 if (i
== COMPILED_BYTECODE
)
2884 if (!STRINGP (item
))
2885 error ("Invalid byte code");
2887 /* Delay handling the bytecode slot until we know whether
2888 it is lazily-loaded (we can tell by whether the
2889 constants slot is nil). */
2890 ptr
[COMPILED_CONSTANTS
] = item
;
2893 else if (i
== COMPILED_CONSTANTS
)
2895 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2899 /* Coerce string to unibyte (like string-as-unibyte,
2900 but without generating extra garbage and
2901 guaranteeing no change in the contents). */
2902 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2903 STRING_SET_UNIBYTE (bytestr
);
2905 item
= Fread (bytestr
);
2907 error ("Invalid byte code");
2909 otem
= XCONS (item
);
2910 bytestr
= XCAR (item
);
2915 /* Now handle the bytecode slot. */
2916 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2919 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2927 /* FLAG = 1 means check for ] to terminate rather than ) and .
2928 FLAG = -1 means check for starting with defun
2929 and make structure pure. */
2932 read_list (flag
, readcharfun
)
2934 register Lisp_Object readcharfun
;
2936 /* -1 means check next element for defun,
2937 0 means don't check,
2938 1 means already checked and found defun. */
2939 int defunflag
= flag
< 0 ? -1 : 0;
2940 Lisp_Object val
, tail
;
2941 register Lisp_Object elt
, tem
;
2942 struct gcpro gcpro1
, gcpro2
;
2943 /* 0 is the normal case.
2944 1 means this list is a doc reference; replace it with the number 0.
2945 2 means this list is a doc reference; replace it with the doc string. */
2946 int doc_reference
= 0;
2948 /* Initialize this to 1 if we are reading a list. */
2949 int first_in_list
= flag
<= 0;
2958 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2963 /* While building, if the list starts with #$, treat it specially. */
2964 if (EQ (elt
, Vload_file_name
)
2966 && !NILP (Vpurify_flag
))
2968 if (NILP (Vdoc_file_name
))
2969 /* We have not yet called Snarf-documentation, so assume
2970 this file is described in the DOC-MM.NN file
2971 and Snarf-documentation will fill in the right value later.
2972 For now, replace the whole list with 0. */
2975 /* We have already called Snarf-documentation, so make a relative
2976 file name for this file, so it can be found properly
2977 in the installed Lisp directory.
2978 We don't use Fexpand_file_name because that would make
2979 the directory absolute now. */
2980 elt
= concat2 (build_string ("../lisp/"),
2981 Ffile_name_nondirectory (elt
));
2983 else if (EQ (elt
, Vload_file_name
)
2985 && load_force_doc_strings
)
2994 Fsignal (Qinvalid_read_syntax
,
2995 Fcons (make_string (") or . in a vector", 18), Qnil
));
3003 XSETCDR (tail
, read0 (readcharfun
));
3005 val
= read0 (readcharfun
);
3006 read1 (readcharfun
, &ch
, 0);
3010 if (doc_reference
== 1)
3011 return make_number (0);
3012 if (doc_reference
== 2)
3014 /* Get a doc string from the file we are loading.
3015 If it's in saved_doc_string, get it from there. */
3016 int pos
= XINT (XCDR (val
));
3017 /* Position is negative for user variables. */
3018 if (pos
< 0) pos
= -pos
;
3019 if (pos
>= saved_doc_string_position
3020 && pos
< (saved_doc_string_position
3021 + saved_doc_string_length
))
3023 int start
= pos
- saved_doc_string_position
;
3026 /* Process quoting with ^A,
3027 and find the end of the string,
3028 which is marked with ^_ (037). */
3029 for (from
= start
, to
= start
;
3030 saved_doc_string
[from
] != 037;)
3032 int c
= saved_doc_string
[from
++];
3035 c
= saved_doc_string
[from
++];
3037 saved_doc_string
[to
++] = c
;
3039 saved_doc_string
[to
++] = 0;
3041 saved_doc_string
[to
++] = 037;
3044 saved_doc_string
[to
++] = c
;
3047 return make_string (saved_doc_string
+ start
,
3050 /* Look in prev_saved_doc_string the same way. */
3051 else if (pos
>= prev_saved_doc_string_position
3052 && pos
< (prev_saved_doc_string_position
3053 + prev_saved_doc_string_length
))
3055 int start
= pos
- prev_saved_doc_string_position
;
3058 /* Process quoting with ^A,
3059 and find the end of the string,
3060 which is marked with ^_ (037). */
3061 for (from
= start
, to
= start
;
3062 prev_saved_doc_string
[from
] != 037;)
3064 int c
= prev_saved_doc_string
[from
++];
3067 c
= prev_saved_doc_string
[from
++];
3069 prev_saved_doc_string
[to
++] = c
;
3071 prev_saved_doc_string
[to
++] = 0;
3073 prev_saved_doc_string
[to
++] = 037;
3076 prev_saved_doc_string
[to
++] = c
;
3079 return make_string (prev_saved_doc_string
+ start
,
3083 return get_doc_string (val
, 0, 0);
3088 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3090 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3092 tem
= (read_pure
&& flag
<= 0
3093 ? pure_cons (elt
, Qnil
)
3094 : Fcons (elt
, Qnil
));
3096 XSETCDR (tail
, tem
);
3101 defunflag
= EQ (elt
, Qdefun
);
3102 else if (defunflag
> 0)
3107 Lisp_Object Vobarray
;
3108 Lisp_Object initial_obarray
;
3110 /* oblookup stores the bucket number here, for the sake of Funintern. */
3112 int oblookup_last_bucket_number
;
3114 static int hash_string ();
3116 /* Get an error if OBARRAY is not an obarray.
3117 If it is one, return it. */
3120 check_obarray (obarray
)
3121 Lisp_Object obarray
;
3123 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3125 /* If Vobarray is now invalid, force it to be valid. */
3126 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3128 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3133 /* Intern the C string STR: return a symbol with that name,
3134 interned in the current obarray. */
3141 int len
= strlen (str
);
3142 Lisp_Object obarray
;
3145 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3146 obarray
= check_obarray (obarray
);
3147 tem
= oblookup (obarray
, str
, len
, len
);
3150 return Fintern (make_string (str
, len
), obarray
);
3153 /* Create an uninterned symbol with name STR. */
3159 int len
= strlen (str
);
3161 return Fmake_symbol ((!NILP (Vpurify_flag
)
3162 ? make_pure_string (str
, len
, len
, 0)
3163 : make_string (str
, len
)));
3166 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3167 doc
: /* Return the canonical symbol whose name is STRING.
3168 If there is none, one is created by this function and returned.
3169 A second optional argument specifies the obarray to use;
3170 it defaults to the value of `obarray'. */)
3172 Lisp_Object string
, obarray
;
3174 register Lisp_Object tem
, sym
, *ptr
;
3176 if (NILP (obarray
)) obarray
= Vobarray
;
3177 obarray
= check_obarray (obarray
);
3179 CHECK_STRING (string
);
3181 tem
= oblookup (obarray
, SDATA (string
),
3184 if (!INTEGERP (tem
))
3187 if (!NILP (Vpurify_flag
))
3188 string
= Fpurecopy (string
);
3189 sym
= Fmake_symbol (string
);
3191 if (EQ (obarray
, initial_obarray
))
3192 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3194 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3196 if ((SREF (string
, 0) == ':')
3197 && EQ (obarray
, initial_obarray
))
3199 XSYMBOL (sym
)->constant
= 1;
3200 XSYMBOL (sym
)->value
= sym
;
3203 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3205 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3207 XSYMBOL (sym
)->next
= 0;
3212 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3213 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3214 NAME may be a string or a symbol. If it is a symbol, that exact
3215 symbol is searched for.
3216 A second optional argument specifies the obarray to use;
3217 it defaults to the value of `obarray'. */)
3219 Lisp_Object name
, obarray
;
3221 register Lisp_Object tem
, string
;
3223 if (NILP (obarray
)) obarray
= Vobarray
;
3224 obarray
= check_obarray (obarray
);
3226 if (!SYMBOLP (name
))
3228 CHECK_STRING (name
);
3232 string
= SYMBOL_NAME (name
);
3234 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3235 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3241 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3242 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3243 The value is t if a symbol was found and deleted, nil otherwise.
3244 NAME may be a string or a symbol. If it is a symbol, that symbol
3245 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3246 OBARRAY defaults to the value of the variable `obarray'. */)
3248 Lisp_Object name
, obarray
;
3250 register Lisp_Object string
, tem
;
3253 if (NILP (obarray
)) obarray
= Vobarray
;
3254 obarray
= check_obarray (obarray
);
3257 string
= SYMBOL_NAME (name
);
3260 CHECK_STRING (name
);
3264 tem
= oblookup (obarray
, SDATA (string
),
3269 /* If arg was a symbol, don't delete anything but that symbol itself. */
3270 if (SYMBOLP (name
) && !EQ (name
, tem
))
3273 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3274 XSYMBOL (tem
)->constant
= 0;
3275 XSYMBOL (tem
)->indirect_variable
= 0;
3277 hash
= oblookup_last_bucket_number
;
3279 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3281 if (XSYMBOL (tem
)->next
)
3282 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3284 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3288 Lisp_Object tail
, following
;
3290 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3291 XSYMBOL (tail
)->next
;
3294 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3295 if (EQ (following
, tem
))
3297 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3306 /* Return the symbol in OBARRAY whose names matches the string
3307 of SIZE characters (SIZE_BYTE bytes) at PTR.
3308 If there is no such symbol in OBARRAY, return nil.
3310 Also store the bucket number in oblookup_last_bucket_number. */
3313 oblookup (obarray
, ptr
, size
, size_byte
)
3314 Lisp_Object obarray
;
3315 register const char *ptr
;
3316 int size
, size_byte
;
3320 register Lisp_Object tail
;
3321 Lisp_Object bucket
, tem
;
3323 if (!VECTORP (obarray
)
3324 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3326 obarray
= check_obarray (obarray
);
3327 obsize
= XVECTOR (obarray
)->size
;
3329 /* This is sometimes needed in the middle of GC. */
3330 obsize
&= ~ARRAY_MARK_FLAG
;
3331 /* Combining next two lines breaks VMS C 2.3. */
3332 hash
= hash_string (ptr
, size_byte
);
3334 bucket
= XVECTOR (obarray
)->contents
[hash
];
3335 oblookup_last_bucket_number
= hash
;
3336 if (EQ (bucket
, make_number (0)))
3338 else if (!SYMBOLP (bucket
))
3339 error ("Bad data in guts of obarray"); /* Like CADR error message */
3341 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3343 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3344 && SCHARS (SYMBOL_NAME (tail
)) == size
3345 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3347 else if (XSYMBOL (tail
)->next
== 0)
3350 XSETINT (tem
, hash
);
3355 hash_string (ptr
, len
)
3356 const unsigned char *ptr
;
3359 register const unsigned char *p
= ptr
;
3360 register const unsigned char *end
= p
+ len
;
3361 register unsigned char c
;
3362 register int hash
= 0;
3367 if (c
>= 0140) c
-= 40;
3368 hash
= ((hash
<<3) + (hash
>>28) + c
);
3370 return hash
& 07777777777;
3374 map_obarray (obarray
, fn
, arg
)
3375 Lisp_Object obarray
;
3376 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3380 register Lisp_Object tail
;
3381 CHECK_VECTOR (obarray
);
3382 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3384 tail
= XVECTOR (obarray
)->contents
[i
];
3389 if (XSYMBOL (tail
)->next
== 0)
3391 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3397 mapatoms_1 (sym
, function
)
3398 Lisp_Object sym
, function
;
3400 call1 (function
, sym
);
3403 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3404 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3405 OBARRAY defaults to the value of `obarray'. */)
3407 Lisp_Object function
, obarray
;
3409 if (NILP (obarray
)) obarray
= Vobarray
;
3410 obarray
= check_obarray (obarray
);
3412 map_obarray (obarray
, mapatoms_1
, function
);
3416 #define OBARRAY_SIZE 1511
3421 Lisp_Object oblength
;
3425 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3427 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3428 Vobarray
= Fmake_vector (oblength
, make_number (0));
3429 initial_obarray
= Vobarray
;
3430 staticpro (&initial_obarray
);
3431 /* Intern nil in the obarray */
3432 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3433 XSYMBOL (Qnil
)->constant
= 1;
3435 /* These locals are to kludge around a pyramid compiler bug. */
3436 hash
= hash_string ("nil", 3);
3437 /* Separate statement here to avoid VAXC bug. */
3438 hash
%= OBARRAY_SIZE
;
3439 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3442 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3443 XSYMBOL (Qnil
)->function
= Qunbound
;
3444 XSYMBOL (Qunbound
)->value
= Qunbound
;
3445 XSYMBOL (Qunbound
)->function
= Qunbound
;
3448 XSYMBOL (Qnil
)->value
= Qnil
;
3449 XSYMBOL (Qnil
)->plist
= Qnil
;
3450 XSYMBOL (Qt
)->value
= Qt
;
3451 XSYMBOL (Qt
)->constant
= 1;
3453 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3456 Qvariable_documentation
= intern ("variable-documentation");
3457 staticpro (&Qvariable_documentation
);
3459 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3460 read_buffer
= (char *) xmalloc (read_buffer_size
);
3465 struct Lisp_Subr
*sname
;
3468 sym
= intern (sname
->symbol_name
);
3469 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3472 #ifdef NOTDEF /* use fset in subr.el now */
3474 defalias (sname
, string
)
3475 struct Lisp_Subr
*sname
;
3479 sym
= intern (string
);
3480 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3484 /* Define an "integer variable"; a symbol whose value is forwarded
3485 to a C variable of type int. Sample call: */
3486 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3488 defvar_int (namestring
, address
)
3492 Lisp_Object sym
, val
;
3493 sym
= intern (namestring
);
3494 val
= allocate_misc ();
3495 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3496 XINTFWD (val
)->intvar
= address
;
3497 SET_SYMBOL_VALUE (sym
, val
);
3500 /* Similar but define a variable whose value is t if address contains 1,
3501 nil if address contains 0 */
3503 defvar_bool (namestring
, address
)
3507 Lisp_Object sym
, val
;
3508 sym
= intern (namestring
);
3509 val
= allocate_misc ();
3510 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3511 XBOOLFWD (val
)->boolvar
= address
;
3512 SET_SYMBOL_VALUE (sym
, val
);
3513 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3516 /* Similar but define a variable whose value is the Lisp Object stored
3517 at address. Two versions: with and without gc-marking of the C
3518 variable. The nopro version is used when that variable will be
3519 gc-marked for some other reason, since marking the same slot twice
3520 can cause trouble with strings. */
3522 defvar_lisp_nopro (namestring
, address
)
3524 Lisp_Object
*address
;
3526 Lisp_Object sym
, val
;
3527 sym
= intern (namestring
);
3528 val
= allocate_misc ();
3529 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3530 XOBJFWD (val
)->objvar
= address
;
3531 SET_SYMBOL_VALUE (sym
, val
);
3535 defvar_lisp (namestring
, address
)
3537 Lisp_Object
*address
;
3539 defvar_lisp_nopro (namestring
, address
);
3540 staticpro (address
);
3543 /* Similar but define a variable whose value is the Lisp Object stored in
3544 the current buffer. address is the address of the slot in the buffer
3545 that is current now. */
3548 defvar_per_buffer (namestring
, address
, type
, doc
)
3550 Lisp_Object
*address
;
3554 Lisp_Object sym
, val
;
3557 sym
= intern (namestring
);
3558 val
= allocate_misc ();
3559 offset
= (char *)address
- (char *)current_buffer
;
3561 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3562 XBUFFER_OBJFWD (val
)->offset
= offset
;
3563 SET_SYMBOL_VALUE (sym
, val
);
3564 PER_BUFFER_SYMBOL (offset
) = sym
;
3565 PER_BUFFER_TYPE (offset
) = type
;
3567 if (PER_BUFFER_IDX (offset
) == 0)
3568 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3569 slot of buffer_local_flags */
3574 /* Similar but define a variable whose value is the Lisp Object stored
3575 at a particular offset in the current kboard object. */
3578 defvar_kboard (namestring
, offset
)
3582 Lisp_Object sym
, val
;
3583 sym
= intern (namestring
);
3584 val
= allocate_misc ();
3585 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3586 XKBOARD_OBJFWD (val
)->offset
= offset
;
3587 SET_SYMBOL_VALUE (sym
, val
);
3590 /* Record the value of load-path used at the start of dumping
3591 so we can see if the site changed it later during dumping. */
3592 static Lisp_Object dump_path
;
3598 int turn_off_warning
= 0;
3600 /* Compute the default load-path. */
3602 normal
= PATH_LOADSEARCH
;
3603 Vload_path
= decode_env_path (0, normal
);
3605 if (NILP (Vpurify_flag
))
3606 normal
= PATH_LOADSEARCH
;
3608 normal
= PATH_DUMPLOADSEARCH
;
3610 /* In a dumped Emacs, we normally have to reset the value of
3611 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3612 uses ../lisp, instead of the path of the installed elisp
3613 libraries. However, if it appears that Vload_path was changed
3614 from the default before dumping, don't override that value. */
3617 if (! NILP (Fequal (dump_path
, Vload_path
)))
3619 Vload_path
= decode_env_path (0, normal
);
3620 if (!NILP (Vinstallation_directory
))
3622 Lisp_Object tem
, tem1
, sitelisp
;
3624 /* Remove site-lisp dirs from path temporarily and store
3625 them in sitelisp, then conc them on at the end so
3626 they're always first in path. */
3630 tem
= Fcar (Vload_path
);
3631 tem1
= Fstring_match (build_string ("site-lisp"),
3635 Vload_path
= Fcdr (Vload_path
);
3636 sitelisp
= Fcons (tem
, sitelisp
);
3642 /* Add to the path the lisp subdir of the
3643 installation dir, if it exists. */
3644 tem
= Fexpand_file_name (build_string ("lisp"),
3645 Vinstallation_directory
);
3646 tem1
= Ffile_exists_p (tem
);
3649 if (NILP (Fmember (tem
, Vload_path
)))
3651 turn_off_warning
= 1;
3652 Vload_path
= Fcons (tem
, Vload_path
);
3656 /* That dir doesn't exist, so add the build-time
3657 Lisp dirs instead. */
3658 Vload_path
= nconc2 (Vload_path
, dump_path
);
3660 /* Add leim under the installation dir, if it exists. */
3661 tem
= Fexpand_file_name (build_string ("leim"),
3662 Vinstallation_directory
);
3663 tem1
= Ffile_exists_p (tem
);
3666 if (NILP (Fmember (tem
, Vload_path
)))
3667 Vload_path
= Fcons (tem
, Vload_path
);
3670 /* Add site-list under the installation dir, if it exists. */
3671 tem
= Fexpand_file_name (build_string ("site-lisp"),
3672 Vinstallation_directory
);
3673 tem1
= Ffile_exists_p (tem
);
3676 if (NILP (Fmember (tem
, Vload_path
)))
3677 Vload_path
= Fcons (tem
, Vload_path
);
3680 /* If Emacs was not built in the source directory,
3681 and it is run from where it was built, add to load-path
3682 the lisp, leim and site-lisp dirs under that directory. */
3684 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3688 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3689 Vinstallation_directory
);
3690 tem1
= Ffile_exists_p (tem
);
3692 /* Don't be fooled if they moved the entire source tree
3693 AFTER dumping Emacs. If the build directory is indeed
3694 different from the source dir, src/Makefile.in and
3695 src/Makefile will not be found together. */
3696 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3697 Vinstallation_directory
);
3698 tem2
= Ffile_exists_p (tem
);
3699 if (!NILP (tem1
) && NILP (tem2
))
3701 tem
= Fexpand_file_name (build_string ("lisp"),
3704 if (NILP (Fmember (tem
, Vload_path
)))
3705 Vload_path
= Fcons (tem
, Vload_path
);
3707 tem
= Fexpand_file_name (build_string ("leim"),
3710 if (NILP (Fmember (tem
, Vload_path
)))
3711 Vload_path
= Fcons (tem
, Vload_path
);
3713 tem
= Fexpand_file_name (build_string ("site-lisp"),
3716 if (NILP (Fmember (tem
, Vload_path
)))
3717 Vload_path
= Fcons (tem
, Vload_path
);
3720 if (!NILP (sitelisp
))
3721 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3727 /* NORMAL refers to the lisp dir in the source directory. */
3728 /* We used to add ../lisp at the front here, but
3729 that caused trouble because it was copied from dump_path
3730 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3731 It should be unnecessary. */
3732 Vload_path
= decode_env_path (0, normal
);
3733 dump_path
= Vload_path
;
3737 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3738 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3739 almost never correct, thereby causing a warning to be printed out that
3740 confuses users. Since PATH_LOADSEARCH is always overridden by the
3741 EMACSLOADPATH environment variable below, disable the warning on NT.
3742 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3743 the "standard" paths may not exist and would be overridden by
3744 EMACSLOADPATH as on NT. Since this depends on how the executable
3745 was build and packaged, turn off the warnings in general */
3747 /* Warn if dirs in the *standard* path don't exist. */
3748 if (!turn_off_warning
)
3750 Lisp_Object path_tail
;
3752 for (path_tail
= Vload_path
;
3754 path_tail
= XCDR (path_tail
))
3756 Lisp_Object dirfile
;
3757 dirfile
= Fcar (path_tail
);
3758 if (STRINGP (dirfile
))
3760 dirfile
= Fdirectory_file_name (dirfile
);
3761 if (access (SDATA (dirfile
), 0) < 0)
3762 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3767 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3769 /* If the EMACSLOADPATH environment variable is set, use its value.
3770 This doesn't apply if we're dumping. */
3772 if (NILP (Vpurify_flag
)
3773 && egetenv ("EMACSLOADPATH"))
3775 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3779 load_in_progress
= 0;
3780 Vload_file_name
= Qnil
;
3782 load_descriptor_list
= Qnil
;
3784 Vstandard_input
= Qt
;
3785 Vloads_in_progress
= Qnil
;
3788 /* Print a warning, using format string FORMAT, that directory DIRNAME
3789 does not exist. Print it on stderr and put it in *Message*. */
3792 dir_warning (format
, dirname
)
3794 Lisp_Object dirname
;
3797 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3799 fprintf (stderr
, format
, SDATA (dirname
));
3800 sprintf (buffer
, format
, SDATA (dirname
));
3801 /* Don't log the warning before we've initialized!! */
3803 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3810 defsubr (&Sread_from_string
);
3812 defsubr (&Sintern_soft
);
3813 defsubr (&Sunintern
);
3815 defsubr (&Seval_buffer
);
3816 defsubr (&Seval_region
);
3817 defsubr (&Sread_char
);
3818 defsubr (&Sread_char_exclusive
);
3819 defsubr (&Sread_event
);
3820 defsubr (&Sget_file_char
);
3821 defsubr (&Smapatoms
);
3822 defsubr (&Slocate_file_internal
);
3824 DEFVAR_LISP ("obarray", &Vobarray
,
3825 doc
: /* Symbol table for use by `intern' and `read'.
3826 It is a vector whose length ought to be prime for best results.
3827 The vector's contents don't make sense if examined from Lisp programs;
3828 to find all the symbols in an obarray, use `mapatoms'. */);
3830 DEFVAR_LISP ("values", &Vvalues
,
3831 doc
: /* List of values of all expressions which were read, evaluated and printed.
3832 Order is reverse chronological. */);
3834 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3835 doc
: /* Stream for read to get input from.
3836 See documentation of `read' for possible values. */);
3837 Vstandard_input
= Qt
;
3839 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3840 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3842 If this variable is a buffer, then only forms read from that buffer
3843 will be added to `read-symbol-positions-list'.
3844 If this variable is t, then all read forms will be added.
3845 The effect of all other values other than nil are not currently
3846 defined, although they may be in the future.
3848 The positions are relative to the last call to `read' or
3849 `read-from-string'. It is probably a bad idea to set this variable at
3850 the toplevel; bind it instead. */);
3851 Vread_with_symbol_positions
= Qnil
;
3853 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3854 doc
: /* A list mapping read symbols to their positions.
3855 This variable is modified during calls to `read' or
3856 `read-from-string', but only when `read-with-symbol-positions' is
3859 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3860 CHAR-POSITION is an integer giving the offset of that occurrence of the
3861 symbol from the position where `read' or `read-from-string' started.
3863 Note that a symbol will appear multiple times in this list, if it was
3864 read multiple times. The list is in the same order as the symbols
3866 Vread_symbol_positions_list
= Qnil
;
3868 DEFVAR_LISP ("load-path", &Vload_path
,
3869 doc
: /* *List of directories to search for files to load.
3870 Each element is a string (directory name) or nil (try default directory).
3871 Initialized based on EMACSLOADPATH environment variable, if any,
3872 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3874 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3875 doc
: /* *List of suffixes to try for files to load.
3876 This list should not include the empty string. */);
3877 Vload_suffixes
= Fcons (build_string (".elc"),
3878 Fcons (build_string (".el"), Qnil
));
3879 /* We don't use empty_string because it's not initialized yet. */
3880 default_suffixes
= Fcons (build_string (""), Qnil
);
3881 staticpro (&default_suffixes
);
3883 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3884 doc
: /* Non-nil iff inside of `load'. */);
3886 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3887 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3888 Each element looks like (FILENAME FORMS...).
3889 When `load' is run and the file-name argument is FILENAME,
3890 the FORMS in the corresponding element are executed at the end of loading.
3892 FILENAME must match exactly! Normally FILENAME is the name of a library,
3893 with no directory specified, since that is how `load' is normally called.
3894 An error in FORMS does not undo the load,
3895 but does prevent execution of the rest of the FORMS.
3896 FILENAME can also be a symbol (a feature) and FORMS are then executed
3897 when the corresponding call to `provide' is made. */);
3898 Vafter_load_alist
= Qnil
;
3900 DEFVAR_LISP ("load-history", &Vload_history
,
3901 doc
: /* Alist mapping file names to symbols and features.
3902 Each alist element is a list that starts with a file name,
3903 except for one element (optional) that starts with nil and describes
3904 definitions evaluated from buffers not visiting files.
3905 The remaining elements of each list are symbols defined as variables
3906 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3907 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3908 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3909 and means that SYMBOL was an autoload before this file redefined it
3912 During preloading, the file name recorded is relative to the main Lisp
3913 directory. These file names are converted to absolute at startup. */);
3914 Vload_history
= Qnil
;
3916 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3917 doc
: /* Full name of file being loaded by `load'. */);
3918 Vload_file_name
= Qnil
;
3920 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3921 doc
: /* File name, including directory, of user's initialization file.
3922 If the file loaded had extension `.elc', and the corresponding source file
3923 exists, this variable contains the name of source file, suitable for use
3924 by functions like `custom-save-all' which edit the init file. */);
3925 Vuser_init_file
= Qnil
;
3927 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3928 doc
: /* Used for internal purposes by `load'. */);
3929 Vcurrent_load_list
= Qnil
;
3931 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3932 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3933 The default is nil, which means use the function `read'. */);
3934 Vload_read_function
= Qnil
;
3936 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3937 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3938 This function is for doing code conversion before reading the source file.
3939 If nil, loading is done without any code conversion.
3940 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3941 FULLNAME is the full name of FILE.
3942 See `load' for the meaning of the remaining arguments. */);
3943 Vload_source_file_function
= Qnil
;
3945 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3946 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3947 This is useful when the file being loaded is a temporary copy. */);
3948 load_force_doc_strings
= 0;
3950 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3951 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3952 This is normally bound by `load' and `eval-buffer' to control `read',
3953 and is not meant for users to change. */);
3954 load_convert_to_unibyte
= 0;
3956 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3957 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3958 You cannot count on them to still be there! */);
3960 = Fexpand_file_name (build_string ("../"),
3961 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3963 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3964 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3965 Vpreloaded_file_list
= Qnil
;
3967 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3968 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3969 Vbyte_boolean_vars
= Qnil
;
3971 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3972 doc
: /* Non-nil means load dangerous compiled Lisp files.
3973 Some versions of XEmacs use different byte codes than Emacs. These
3974 incompatible byte codes can make Emacs crash when it tries to execute
3976 load_dangerous_libraries
= 0;
3978 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3979 doc
: /* Regular expression matching safe to load compiled Lisp files.
3980 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3981 from the file, and matches them against this regular expression.
3982 When the regular expression matches, the file is considered to be safe
3983 to load. See also `load-dangerous-libraries'. */);
3984 Vbytecomp_version_regexp
3985 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3987 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
3988 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
3989 Veval_buffer_list
= Qnil
;
3991 /* Vsource_directory was initialized in init_lread. */
3993 load_descriptor_list
= Qnil
;
3994 staticpro (&load_descriptor_list
);
3996 Qcurrent_load_list
= intern ("current-load-list");
3997 staticpro (&Qcurrent_load_list
);
3999 Qstandard_input
= intern ("standard-input");
4000 staticpro (&Qstandard_input
);
4002 Qread_char
= intern ("read-char");
4003 staticpro (&Qread_char
);
4005 Qget_file_char
= intern ("get-file-char");
4006 staticpro (&Qget_file_char
);
4008 Qbackquote
= intern ("`");
4009 staticpro (&Qbackquote
);
4010 Qcomma
= intern (",");
4011 staticpro (&Qcomma
);
4012 Qcomma_at
= intern (",@");
4013 staticpro (&Qcomma_at
);
4014 Qcomma_dot
= intern (",.");
4015 staticpro (&Qcomma_dot
);
4017 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4018 staticpro (&Qinhibit_file_name_operation
);
4020 Qascii_character
= intern ("ascii-character");
4021 staticpro (&Qascii_character
);
4023 Qfunction
= intern ("function");
4024 staticpro (&Qfunction
);
4026 Qload
= intern ("load");
4029 Qload_file_name
= intern ("load-file-name");
4030 staticpro (&Qload_file_name
);
4032 Qeval_buffer_list
= intern ("eval-buffer-list");
4033 staticpro (&Qeval_buffer_list
);
4035 staticpro (&dump_path
);
4037 staticpro (&read_objects
);
4038 read_objects
= Qnil
;
4039 staticpro (&seen_list
);
4042 Vloads_in_progress
= Qnil
;
4043 staticpro (&Vloads_in_progress
);
4046 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4047 (do not change this comment) */