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"
38 #include "termhooks.h"
42 #include <sys/inode.h>
47 #include <unistd.h> /* to get X_OK */
64 #endif /* HAVE_SETLOCALE */
74 #define file_offset off_t
75 #define file_tell ftello
77 #define file_offset long
78 #define file_tell ftell
85 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
86 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
87 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
88 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
89 Lisp_Object Qinhibit_file_name_operation
;
90 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
92 extern Lisp_Object Qevent_symbol_element_mask
;
93 extern Lisp_Object Qfile_exists_p
;
95 /* non-zero iff inside `load' */
98 /* Directory in which the sources were found. */
99 Lisp_Object Vsource_directory
;
101 /* Search path and suffixes for files to be loaded. */
102 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
104 /* File name of user's init file. */
105 Lisp_Object Vuser_init_file
;
107 /* This is the user-visible association list that maps features to
108 lists of defs in their load files. */
109 Lisp_Object Vload_history
;
111 /* This is used to build the load history. */
112 Lisp_Object Vcurrent_load_list
;
114 /* List of files that were preloaded. */
115 Lisp_Object Vpreloaded_file_list
;
117 /* Name of file actually being read by `load'. */
118 Lisp_Object Vload_file_name
;
120 /* Function to use for reading, in `load' and friends. */
121 Lisp_Object Vload_read_function
;
123 /* The association list of objects read with the #n=object form.
124 Each member of the list has the form (n . object), and is used to
125 look up the object for the corresponding #n# construct.
126 It must be set to nil before all top-level calls to read0. */
127 Lisp_Object read_objects
;
129 /* Nonzero means load should forcibly load all dynamic doc strings. */
130 static int load_force_doc_strings
;
132 /* Nonzero means read should convert strings to unibyte. */
133 static int load_convert_to_unibyte
;
135 /* Function to use for loading an Emacs lisp source file (not
136 compiled) instead of readevalloop. */
137 Lisp_Object Vload_source_file_function
;
139 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
140 Lisp_Object Vbyte_boolean_vars
;
142 /* Whether or not to add a `read-positions' property to symbols
144 Lisp_Object Vread_with_symbol_positions
;
146 /* List of (SYMBOL . POSITION) accumulated so far. */
147 Lisp_Object Vread_symbol_positions_list
;
149 /* List of descriptors now open for Fload. */
150 static Lisp_Object load_descriptor_list
;
152 /* File for get_file_char to read from. Use by load. */
153 static FILE *instream
;
155 /* When nonzero, read conses in pure space */
156 static int read_pure
;
158 /* For use within read-from-string (this reader is non-reentrant!!) */
159 static int read_from_string_index
;
160 static int read_from_string_index_byte
;
161 static int read_from_string_limit
;
163 /* Number of bytes left to read in the buffer character
164 that `readchar' has already advanced over. */
165 static int readchar_backlog
;
166 /* Number of characters read in the current call to Fread or
167 Fread_from_string. */
168 static int readchar_count
;
170 /* This contains the last string skipped with #@. */
171 static char *saved_doc_string
;
172 /* Length of buffer allocated in saved_doc_string. */
173 static int saved_doc_string_size
;
174 /* Length of actual data in saved_doc_string. */
175 static int saved_doc_string_length
;
176 /* This is the file position that string came from. */
177 static file_offset saved_doc_string_position
;
179 /* This contains the previous string skipped with #@.
180 We copy it from saved_doc_string when a new string
181 is put in saved_doc_string. */
182 static char *prev_saved_doc_string
;
183 /* Length of buffer allocated in prev_saved_doc_string. */
184 static int prev_saved_doc_string_size
;
185 /* Length of actual data in prev_saved_doc_string. */
186 static int prev_saved_doc_string_length
;
187 /* This is the file position that string came from. */
188 static file_offset prev_saved_doc_string_position
;
190 /* Nonzero means inside a new-style backquote
191 with no surrounding parentheses.
192 Fread initializes this to zero, so we need not specbind it
193 or worry about what happens to it when there is an error. */
194 static int new_backquote_flag
;
196 /* A list of file names for files being loaded in Fload. Used to
197 check for recursive loads. */
199 static Lisp_Object Vloads_in_progress
;
201 /* Non-zero means load dangerous compiled Lisp files. */
203 int load_dangerous_libraries
;
205 /* A regular expression used to detect files compiled with Emacs. */
207 static Lisp_Object Vbytecomp_version_regexp
;
209 static void to_multibyte
P_ ((char **, char **, int *));
210 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
211 Lisp_Object (*) (), int,
212 Lisp_Object
, Lisp_Object
,
213 Lisp_Object
, Lisp_Object
));
214 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
215 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
218 /* Handle unreading and rereading of characters.
219 Write READCHAR to read a character,
220 UNREAD(c) to unread c to be read again.
222 The READCHAR and UNREAD macros are meant for reading/unreading a
223 byte code; they do not handle multibyte characters. The caller
224 should manage them if necessary.
226 [ Actually that seems to be a lie; READCHAR will definitely read
227 multibyte characters from buffer sources, at least. Is the
228 comment just out of date?
229 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
232 #define READCHAR readchar (readcharfun)
233 #define UNREAD(c) unreadchar (readcharfun, c)
236 readchar (readcharfun
)
237 Lisp_Object readcharfun
;
244 if (BUFFERP (readcharfun
))
246 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
248 int pt_byte
= BUF_PT_BYTE (inbuffer
);
249 int orig_pt_byte
= pt_byte
;
251 if (readchar_backlog
> 0)
252 /* We get the address of the byte just passed,
253 which is the last byte of the character.
254 The other bytes in this character are consecutive with it,
255 because the gap can't be in the middle of a character. */
256 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
257 - --readchar_backlog
);
259 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
262 readchar_backlog
= -1;
264 if (! NILP (inbuffer
->enable_multibyte_characters
))
266 /* Fetch the character code from the buffer. */
267 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
268 BUF_INC_POS (inbuffer
, pt_byte
);
269 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
273 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
276 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
280 if (MARKERP (readcharfun
))
282 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
284 int bytepos
= marker_byte_position (readcharfun
);
285 int orig_bytepos
= bytepos
;
287 if (readchar_backlog
> 0)
288 /* We get the address of the byte just passed,
289 which is the last byte of the character.
290 The other bytes in this character are consecutive with it,
291 because the gap can't be in the middle of a character. */
292 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
293 - --readchar_backlog
);
295 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
298 readchar_backlog
= -1;
300 if (! NILP (inbuffer
->enable_multibyte_characters
))
302 /* Fetch the character code from the buffer. */
303 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
304 BUF_INC_POS (inbuffer
, bytepos
);
305 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
309 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
313 XMARKER (readcharfun
)->bytepos
= bytepos
;
314 XMARKER (readcharfun
)->charpos
++;
319 if (EQ (readcharfun
, Qlambda
))
320 return read_bytecode_char (0);
322 if (EQ (readcharfun
, Qget_file_char
))
326 /* Interrupted reads have been observed while reading over the network */
327 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
337 if (STRINGP (readcharfun
))
339 if (read_from_string_index
>= read_from_string_limit
)
342 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
343 read_from_string_index
,
344 read_from_string_index_byte
);
349 tem
= call0 (readcharfun
);
356 /* Unread the character C in the way appropriate for the stream READCHARFUN.
357 If the stream is a user function, call it with the char as argument. */
360 unreadchar (readcharfun
, c
)
361 Lisp_Object readcharfun
;
366 /* Don't back up the pointer if we're unreading the end-of-input mark,
367 since readchar didn't advance it when we read it. */
369 else if (BUFFERP (readcharfun
))
371 struct buffer
*b
= XBUFFER (readcharfun
);
372 int bytepos
= BUF_PT_BYTE (b
);
374 if (readchar_backlog
>= 0)
379 if (! NILP (b
->enable_multibyte_characters
))
380 BUF_DEC_POS (b
, bytepos
);
384 BUF_PT_BYTE (b
) = bytepos
;
387 else if (MARKERP (readcharfun
))
389 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
390 int bytepos
= XMARKER (readcharfun
)->bytepos
;
392 if (readchar_backlog
>= 0)
396 XMARKER (readcharfun
)->charpos
--;
397 if (! NILP (b
->enable_multibyte_characters
))
398 BUF_DEC_POS (b
, bytepos
);
402 XMARKER (readcharfun
)->bytepos
= bytepos
;
405 else if (STRINGP (readcharfun
))
407 read_from_string_index
--;
408 read_from_string_index_byte
409 = string_char_to_byte (readcharfun
, read_from_string_index
);
411 else if (EQ (readcharfun
, Qlambda
))
412 read_bytecode_char (1);
413 else if (EQ (readcharfun
, Qget_file_char
))
414 ungetc (c
, instream
);
416 call1 (readcharfun
, make_number (c
));
419 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
421 static Lisp_Object read0
P_ ((Lisp_Object
));
422 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
424 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
425 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
426 static int read_multibyte
P_ ((int, Lisp_Object
));
428 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
430 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
432 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
435 /* Get a character from the tty. */
437 extern Lisp_Object
read_char ();
439 /* Read input events until we get one that's acceptable for our purposes.
441 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
442 until we get a character we like, and then stuffed into
445 If ASCII_REQUIRED is non-zero, we check function key events to see
446 if the unmodified version of the symbol has a Qascii_character
447 property, and use that character, if present.
449 If ERROR_NONASCII is non-zero, we signal an error if the input we
450 get isn't an ASCII character with modifiers. If it's zero but
451 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
454 If INPUT_METHOD is nonzero, we invoke the current input method
455 if the character warrants that. */
458 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
460 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
462 register Lisp_Object val
, delayed_switch_frame
;
464 #ifdef HAVE_WINDOW_SYSTEM
465 if (display_hourglass_p
)
469 delayed_switch_frame
= Qnil
;
471 /* Read until we get an acceptable event. */
473 val
= read_char (0, 0, 0,
474 (input_method
? Qnil
: Qt
),
480 /* switch-frame events are put off until after the next ASCII
481 character. This is better than signaling an error just because
482 the last characters were typed to a separate minibuffer frame,
483 for example. Eventually, some code which can deal with
484 switch-frame events will read it and process it. */
486 && EVENT_HAS_PARAMETERS (val
)
487 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
489 delayed_switch_frame
= val
;
495 /* Convert certain symbols to their ASCII equivalents. */
498 Lisp_Object tem
, tem1
;
499 tem
= Fget (val
, Qevent_symbol_element_mask
);
502 tem1
= Fget (Fcar (tem
), Qascii_character
);
503 /* Merge this symbol's modifier bits
504 with the ASCII equivalent of its basic code. */
506 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
510 /* If we don't have a character now, deal with it appropriately. */
515 Vunread_command_events
= Fcons (val
, Qnil
);
516 error ("Non-character input-event");
523 if (! NILP (delayed_switch_frame
))
524 unread_switch_frame
= delayed_switch_frame
;
528 #ifdef HAVE_WINDOW_SYSTEM
529 if (display_hourglass_p
)
538 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
539 doc
: /* Read a character from the command input (keyboard or macro).
540 It is returned as a number.
541 If the user generates an event which is not a character (i.e. a mouse
542 click or function key event), `read-char' signals an error. As an
543 exception, switch-frame events are put off until non-ASCII events can
545 If you want to read non-character events, or ignore them, call
546 `read-event' or `read-char-exclusive' instead.
548 If the optional argument PROMPT is non-nil, display that as a prompt.
549 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
550 input method is turned on in the current buffer, that input method
551 is used for reading a character. */)
552 (prompt
, inherit_input_method
)
553 Lisp_Object prompt
, inherit_input_method
;
556 message_with_string ("%s", prompt
, 0);
557 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
560 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
561 doc
: /* Read an event object from the input stream.
562 If the optional argument PROMPT is non-nil, display that as a prompt.
563 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
564 input method is turned on in the current buffer, that input method
565 is used for reading a character. */)
566 (prompt
, inherit_input_method
)
567 Lisp_Object prompt
, inherit_input_method
;
570 message_with_string ("%s", prompt
, 0);
571 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
574 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
575 doc
: /* Read a character from the command input (keyboard or macro).
576 It is returned as a number. Non-character events are ignored.
578 If the optional argument PROMPT is non-nil, display that as a prompt.
579 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
580 input method is turned on in the current buffer, that input method
581 is used for reading a character. */)
582 (prompt
, inherit_input_method
)
583 Lisp_Object prompt
, inherit_input_method
;
586 message_with_string ("%s", prompt
, 0);
587 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
590 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
591 doc
: /* Don't use this yourself. */)
594 register Lisp_Object val
;
595 XSETINT (val
, getc (instream
));
601 /* Value is non-zero if the file asswociated with file descriptor FD
602 is a compiled Lisp file that's safe to load. Only files compiled
603 with Emacs are safe to load. Files compiled with XEmacs can lead
604 to a crash in Fbyte_code because of an incompatible change in the
615 /* Read the first few bytes from the file, and look for a line
616 specifying the byte compiler version used. */
617 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
622 /* Skip to the next newline, skipping over the initial `ELC'
623 with NUL bytes following it. */
624 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
628 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
633 lseek (fd
, 0, SEEK_SET
);
638 /* Callback for record_unwind_protect. Restore the old load list OLD,
639 after loading a file successfully. */
642 record_load_unwind (old
)
645 return Vloads_in_progress
= old
;
648 /* This handler function is used via internal_condition_case_1. */
651 load_error_handler (data
)
657 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
658 doc
: /* Execute a file of Lisp code named FILE.
659 First try FILE with `.elc' appended, then try with `.el',
660 then try FILE unmodified (the exact suffixes are determined by
661 `load-suffixes'). Environment variable references in FILE
662 are replaced with their values by calling `substitute-in-file-name'.
663 This function searches the directories in `load-path'.
664 If optional second arg NOERROR is non-nil,
665 report no error if FILE doesn't exist.
666 Print messages at start and end of loading unless
667 optional third arg NOMESSAGE is non-nil.
668 If optional fourth arg NOSUFFIX is non-nil, don't try adding
669 suffixes `.elc' or `.el' to the specified name FILE.
670 If optional fifth arg MUST-SUFFIX is non-nil, insist on
671 the suffix `.elc' or `.el'; don't accept just FILE unless
672 it ends in one of those suffixes or includes a directory name.
673 Return t if file exists. */)
674 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
675 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
677 register FILE *stream
;
678 register int fd
= -1;
679 int count
= SPECPDL_INDEX ();
682 Lisp_Object found
, efound
;
683 /* 1 means we printed the ".el is newer" message. */
685 /* 1 means we are loading a compiled file. */
696 /* If file name is magic, call the handler. */
697 /* This shouldn't be necessary any more now that `openp' handles it right.
698 handler = Ffind_file_name_handler (file, Qload);
700 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
702 /* Do this after the handler to avoid
703 the need to gcpro noerror, nomessage and nosuffix.
704 (Below here, we care only whether they are nil or not.)
705 The presence of this call is the result of a historical accident:
706 it used to be in every file-operations and when it got removed
707 everywhere, it accidentally stayed here. Since then, enough people
708 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
709 that it seemed risky to remove. */
710 if (! NILP (noerror
))
712 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
713 Qt
, load_error_handler
);
718 file
= Fsubstitute_in_file_name (file
);
721 /* Avoid weird lossage with null string as arg,
722 since it would try to load a directory as a Lisp file */
723 if (SCHARS (file
) > 0)
725 int size
= SBYTES (file
);
730 if (! NILP (must_suffix
))
732 /* Don't insist on adding a suffix if FILE already ends with one. */
734 && !strcmp (SDATA (file
) + size
- 3, ".el"))
737 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
739 /* Don't insist on adding a suffix
740 if the argument includes a directory name. */
741 else if (! NILP (Ffile_name_directory (file
)))
745 fd
= openp (Vload_path
, file
,
746 (!NILP (nosuffix
) ? Qnil
747 : !NILP (must_suffix
) ? Vload_suffixes
748 : Fappend (2, (tmp
[0] = Vload_suffixes
,
749 tmp
[1] = default_suffixes
,
758 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
759 Fcons (file
, Qnil
)));
764 /* Tell startup.el whether or not we found the user's init file. */
765 if (EQ (Qt
, Vuser_init_file
))
766 Vuser_init_file
= found
;
768 /* If FD is -2, that means openp found a magic file. */
771 if (NILP (Fequal (found
, file
)))
772 /* If FOUND is a different file name from FILE,
773 find its handler even if we have already inhibited
774 the `load' operation on FILE. */
775 handler
= Ffind_file_name_handler (found
, Qt
);
777 handler
= Ffind_file_name_handler (found
, Qload
);
778 if (! NILP (handler
))
779 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
782 /* Check if we're stuck in a recursive load cycle.
784 2000-09-21: It's not possible to just check for the file loaded
785 being a member of Vloads_in_progress. This fails because of the
786 way the byte compiler currently works; `provide's are not
787 evaluted, see font-lock.el/jit-lock.el as an example. This
788 leads to a certain amount of ``normal'' recursion.
790 Also, just loading a file recursively is not always an error in
791 the general case; the second load may do something different. */
795 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
796 if (!NILP (Fequal (found
, XCAR (tem
))))
799 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
800 Fcons (found
, Vloads_in_progress
)));
801 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
802 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
805 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
807 /* Load .elc files directly, but not when they are
808 remote and have no handler! */
815 if (!safe_to_load_p (fd
))
818 if (!load_dangerous_libraries
)
822 error ("File `%s' was not compiled in Emacs",
825 else if (!NILP (nomessage
))
826 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
832 efound
= ENCODE_FILE (found
);
837 stat ((char *)SDATA (efound
), &s1
);
838 SSET (efound
, SBYTES (efound
) - 1, 0);
839 result
= stat ((char *)SDATA (efound
), &s2
);
840 SSET (efound
, SBYTES (efound
) - 1, 'c');
843 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
845 /* Make the progress messages mention that source is newer. */
848 /* If we won't print another message, mention this anyway. */
849 if (!NILP (nomessage
))
852 file
= Fsubstring (found
, make_number (0), make_number (-1));
853 message_with_string ("Source file `%s' newer than byte-compiled file",
861 /* We are loading a source file (*.el). */
862 if (!NILP (Vload_source_file_function
))
868 val
= call4 (Vload_source_file_function
, found
, file
,
869 NILP (noerror
) ? Qnil
: Qt
,
870 NILP (nomessage
) ? Qnil
: Qt
);
871 return unbind_to (count
, val
);
878 efound
= ENCODE_FILE (found
);
879 stream
= fopen ((char *) SDATA (efound
), fmode
);
881 #else /* not WINDOWSNT */
882 stream
= fdopen (fd
, fmode
);
883 #endif /* not WINDOWSNT */
887 error ("Failure to create stdio stream for %s", SDATA (file
));
890 if (! NILP (Vpurify_flag
))
891 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
893 if (NILP (nomessage
))
896 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
899 message_with_string ("Loading %s (source)...", file
, 1);
901 message_with_string ("Loading %s (compiled; note, source file is newer)...",
903 else /* The typical case; compiled file newer than source file. */
904 message_with_string ("Loading %s...", file
, 1);
908 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
909 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
910 specbind (Qload_file_name
, found
);
911 specbind (Qinhibit_file_name_operation
, Qnil
);
913 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
915 readevalloop (Qget_file_char
, stream
, file
, Feval
,
916 0, Qnil
, Qnil
, Qnil
, Qnil
);
917 unbind_to (count
, Qnil
);
919 /* Run any load-hooks for this file. */
920 temp
= Fassoc (file
, Vafter_load_alist
);
922 Fprogn (Fcdr (temp
));
925 if (saved_doc_string
)
926 free (saved_doc_string
);
927 saved_doc_string
= 0;
928 saved_doc_string_size
= 0;
930 if (prev_saved_doc_string
)
931 xfree (prev_saved_doc_string
);
932 prev_saved_doc_string
= 0;
933 prev_saved_doc_string_size
= 0;
935 if (!noninteractive
&& NILP (nomessage
))
938 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
941 message_with_string ("Loading %s (source)...done", file
, 1);
943 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
945 else /* The typical case; compiled file newer than source file. */
946 message_with_string ("Loading %s...done", file
, 1);
949 if (!NILP (Fequal (build_string ("obsolete"),
950 Ffile_name_nondirectory
951 (Fdirectory_file_name (Ffile_name_directory (found
))))))
952 message_with_string ("Package %s is obsolete", file
, 1);
958 load_unwind (arg
) /* used as unwind-protect function in load */
961 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
964 if (--load_in_progress
< 0) load_in_progress
= 0;
969 load_descriptor_unwind (oldlist
)
972 load_descriptor_list
= oldlist
;
976 /* Close all descriptors in use for Floads.
977 This is used when starting a subprocess. */
984 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
985 emacs_close (XFASTINT (XCAR (tail
)));
990 complete_filename_p (pathname
)
991 Lisp_Object pathname
;
993 register const unsigned char *s
= SDATA (pathname
);
994 return (IS_DIRECTORY_SEP (s
[0])
995 || (SCHARS (pathname
) > 2
996 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1006 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1007 doc
: /* Search for FILENAME through PATH.
1008 Returns the file's name in absolute form, or nil if not found.
1009 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1010 file name when searching.
1011 If non-nil, PREDICATE is used instead of `file-readable-p'.
1012 PREDICATE can also be an integer to pass to the access(2) function,
1013 in which case file-name-handlers are ignored. */)
1014 (filename
, path
, suffixes
, predicate
)
1015 Lisp_Object filename
, path
, suffixes
, predicate
;
1018 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1019 if (NILP (predicate
) && fd
> 0)
1025 /* Search for a file whose name is STR, looking in directories
1026 in the Lisp list PATH, and trying suffixes from SUFFIX.
1027 On success, returns a file descriptor. On failure, returns -1.
1029 SUFFIXES is a list of strings containing possible suffixes.
1030 The empty suffix is automatically added iff the list is empty.
1032 PREDICATE non-nil means don't open the files,
1033 just look for one that satisfies the predicate. In this case,
1034 returns 1 on success. The predicate can be a lisp function or
1035 an integer to pass to `access' (in which case file-name-handlers
1038 If STOREPTR is nonzero, it points to a slot where the name of
1039 the file actually found should be stored as a Lisp string.
1040 nil is stored there on failure.
1042 If the file we find is remote, return -2
1043 but store the found remote file name in *STOREPTR. */
1046 openp (path
, str
, suffixes
, storeptr
, predicate
)
1047 Lisp_Object path
, str
;
1048 Lisp_Object suffixes
;
1049 Lisp_Object
*storeptr
;
1050 Lisp_Object predicate
;
1055 register char *fn
= buf
;
1058 Lisp_Object filename
;
1060 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1061 Lisp_Object string
, tail
, encoded_fn
;
1062 int max_suffix_len
= 0;
1066 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1068 CHECK_STRING_CAR (tail
);
1069 max_suffix_len
= max (max_suffix_len
,
1070 SBYTES (XCAR (tail
)));
1073 string
= filename
= Qnil
;
1074 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1079 if (complete_filename_p (str
))
1082 for (; CONSP (path
); path
= XCDR (path
))
1084 filename
= Fexpand_file_name (str
, XCAR (path
));
1085 if (!complete_filename_p (filename
))
1086 /* If there are non-absolute elts in PATH (eg ".") */
1087 /* Of course, this could conceivably lose if luser sets
1088 default-directory to be something non-absolute... */
1090 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1091 if (!complete_filename_p (filename
))
1092 /* Give up on this path element! */
1096 /* Calculate maximum size of any filename made from
1097 this path element/specified file name and any possible suffix. */
1098 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1099 if (fn_size
< want_size
)
1100 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1102 /* Loop over suffixes. */
1103 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1104 CONSP (tail
); tail
= XCDR (tail
))
1106 int lsuffix
= SBYTES (XCAR (tail
));
1107 Lisp_Object handler
;
1110 /* Concatenate path element/specified name with the suffix.
1111 If the directory starts with /:, remove that. */
1112 if (SCHARS (filename
) > 2
1113 && SREF (filename
, 0) == '/'
1114 && SREF (filename
, 1) == ':')
1116 strncpy (fn
, SDATA (filename
) + 2,
1117 SBYTES (filename
) - 2);
1118 fn
[SBYTES (filename
) - 2] = 0;
1122 strncpy (fn
, SDATA (filename
),
1124 fn
[SBYTES (filename
)] = 0;
1127 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1128 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1130 /* Check that the file exists and is not a directory. */
1131 /* We used to only check for handlers on non-absolute file names:
1135 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1136 It's not clear why that was the case and it breaks things like
1137 (load "/bar.el") where the file is actually "/bar.el.gz". */
1138 string
= build_string (fn
);
1139 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1140 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1142 if (NILP (predicate
))
1143 exists
= !NILP (Ffile_readable_p (string
));
1145 exists
= !NILP (call1 (predicate
, string
));
1146 if (exists
&& !NILP (Ffile_directory_p (string
)))
1151 /* We succeeded; return this descriptor and filename. */
1162 encoded_fn
= ENCODE_FILE (string
);
1163 pfn
= SDATA (encoded_fn
);
1164 exists
= (stat (pfn
, &st
) >= 0
1165 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1168 /* Check that we can access or open it. */
1169 if (NATNUMP (predicate
))
1170 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1172 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1176 /* We succeeded; return this descriptor and filename. */
1194 /* Merge the list we've accumulated of globals from the current input source
1195 into the load_history variable. The details depend on whether
1196 the source has an associated file name or not. */
1199 build_load_history (stream
, source
)
1203 register Lisp_Object tail
, prev
, newelt
;
1204 register Lisp_Object tem
, tem2
;
1205 register int foundit
, loading
;
1207 loading
= stream
|| !NARROWED
;
1209 tail
= Vload_history
;
1212 while (CONSP (tail
))
1216 /* Find the feature's previous assoc list... */
1217 if (!NILP (Fequal (source
, Fcar (tem
))))
1221 /* If we're loading, remove it. */
1225 Vload_history
= XCDR (tail
);
1227 Fsetcdr (prev
, XCDR (tail
));
1230 /* Otherwise, cons on new symbols that are not already members. */
1233 tem2
= Vcurrent_load_list
;
1235 while (CONSP (tem2
))
1237 newelt
= XCAR (tem2
);
1239 if (NILP (Fmember (newelt
, tem
)))
1240 Fsetcar (tail
, Fcons (XCAR (tem
),
1241 Fcons (newelt
, XCDR (tem
))));
1254 /* If we're loading, cons the new assoc onto the front of load-history,
1255 the most-recently-loaded position. Also do this if we didn't find
1256 an existing member for the current source. */
1257 if (loading
|| !foundit
)
1258 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1263 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1271 readevalloop_1 (old
)
1274 load_convert_to_unibyte
= ! NILP (old
);
1278 /* Signal an `end-of-file' error, if possible with file name
1282 end_of_file_error ()
1286 if (STRINGP (Vload_file_name
))
1287 data
= Fcons (Vload_file_name
, Qnil
);
1291 Fsignal (Qend_of_file
, data
);
1294 /* UNIBYTE specifies how to set load_convert_to_unibyte
1295 for this invocation.
1296 READFUN, if non-nil, is used instead of `read'.
1297 START, END is region in current buffer (from eval-region). */
1300 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1301 printflag
, unibyte
, readfun
, start
, end
)
1302 Lisp_Object readcharfun
;
1304 Lisp_Object sourcename
;
1305 Lisp_Object (*evalfun
) ();
1307 Lisp_Object unibyte
, readfun
;
1308 Lisp_Object start
, end
;
1311 register Lisp_Object val
;
1312 int count
= SPECPDL_INDEX ();
1313 struct gcpro gcpro1
;
1314 struct buffer
*b
= 0;
1315 int continue_reading_p
;
1317 if (BUFFERP (readcharfun
))
1318 b
= XBUFFER (readcharfun
);
1319 else if (MARKERP (readcharfun
))
1320 b
= XMARKER (readcharfun
)->buffer
;
1322 specbind (Qstandard_input
, readcharfun
);
1323 specbind (Qcurrent_load_list
, Qnil
);
1324 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1325 load_convert_to_unibyte
= !NILP (unibyte
);
1327 readchar_backlog
= -1;
1329 GCPRO1 (sourcename
);
1331 LOADHIST_ATTACH (sourcename
);
1333 continue_reading_p
= 1;
1334 while (continue_reading_p
)
1336 int count1
= SPECPDL_INDEX ();
1338 if (b
!= 0 && NILP (b
->name
))
1339 error ("Reading from killed buffer");
1343 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1344 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1346 Fnarrow_to_region (make_number (BEGV
), end
);
1354 while ((c
= READCHAR
) != '\n' && c
!= -1);
1359 unbind_to (count1
, Qnil
);
1363 /* Ignore whitespace here, so we can detect eof. */
1364 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1367 if (!NILP (Vpurify_flag
) && c
== '(')
1369 record_unwind_protect (unreadpure
, Qnil
);
1370 val
= read_list (-1, readcharfun
);
1375 read_objects
= Qnil
;
1376 if (!NILP (readfun
))
1378 val
= call1 (readfun
, readcharfun
);
1380 /* If READCHARFUN has set point to ZV, we should
1381 stop reading, even if the form read sets point
1382 to a different value when evaluated. */
1383 if (BUFFERP (readcharfun
))
1385 struct buffer
*b
= XBUFFER (readcharfun
);
1386 if (BUF_PT (b
) == BUF_ZV (b
))
1387 continue_reading_p
= 0;
1390 else if (! NILP (Vload_read_function
))
1391 val
= call1 (Vload_read_function
, readcharfun
);
1393 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1396 if (!NILP (start
) && continue_reading_p
)
1397 start
= Fpoint_marker ();
1398 unbind_to (count1
, Qnil
);
1400 val
= (*evalfun
) (val
);
1404 Vvalues
= Fcons (val
, Vvalues
);
1405 if (EQ (Vstandard_output
, Qt
))
1412 build_load_history (stream
, sourcename
);
1415 unbind_to (count
, Qnil
);
1418 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1419 doc
: /* Execute the current buffer as Lisp code.
1420 Programs can pass two arguments, BUFFER and PRINTFLAG.
1421 BUFFER is the buffer to evaluate (nil means use current buffer).
1422 PRINTFLAG controls printing of output:
1423 nil means discard it; anything else is stream for print.
1425 If the optional third argument FILENAME is non-nil,
1426 it specifies the file name to use for `load-history'.
1427 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1428 for this invocation.
1430 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1431 `print' and related functions should work normally even if PRINTFLAG is nil.
1433 This function preserves the position of point. */)
1434 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1435 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1437 int count
= SPECPDL_INDEX ();
1438 Lisp_Object tem
, buf
;
1441 buf
= Fcurrent_buffer ();
1443 buf
= Fget_buffer (buffer
);
1445 error ("No such buffer");
1447 if (NILP (printflag
) && NILP (do_allow_print
))
1452 if (NILP (filename
))
1453 filename
= XBUFFER (buf
)->filename
;
1455 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1456 specbind (Qstandard_output
, tem
);
1457 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1458 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1459 readevalloop (buf
, 0, filename
, Feval
,
1460 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1461 unbind_to (count
, Qnil
);
1466 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1467 doc
: /* Execute the region as Lisp code.
1468 When called from programs, expects two arguments,
1469 giving starting and ending indices in the current buffer
1470 of the text to be executed.
1471 Programs can pass third argument PRINTFLAG which controls output:
1472 nil means discard it; anything else is stream for printing it.
1473 Also the fourth argument READ-FUNCTION, if non-nil, is used
1474 instead of `read' to read each expression. It gets one argument
1475 which is the input stream for reading characters.
1477 This function does not move point. */)
1478 (start
, end
, printflag
, read_function
)
1479 Lisp_Object start
, end
, printflag
, read_function
;
1481 int count
= SPECPDL_INDEX ();
1482 Lisp_Object tem
, cbuf
;
1484 cbuf
= Fcurrent_buffer ();
1486 if (NILP (printflag
))
1490 specbind (Qstandard_output
, tem
);
1491 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1493 /* readevalloop calls functions which check the type of start and end. */
1494 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1495 !NILP (printflag
), Qnil
, read_function
,
1498 return unbind_to (count
, Qnil
);
1502 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1503 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1504 If STREAM is nil, use the value of `standard-input' (which see).
1505 STREAM or the value of `standard-input' may be:
1506 a buffer (read from point and advance it)
1507 a marker (read from where it points and advance it)
1508 a function (call it with no arguments for each character,
1509 call it with a char as argument to push a char back)
1510 a string (takes text from string, starting at the beginning)
1511 t (read text line using minibuffer and use it, or read from
1512 standard input in batch mode). */)
1517 stream
= Vstandard_input
;
1518 if (EQ (stream
, Qt
))
1519 stream
= Qread_char
;
1520 if (EQ (stream
, Qread_char
))
1521 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1523 return read_internal_start (stream
, Qnil
, Qnil
);
1526 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1527 doc
: /* Read one Lisp expression which is represented as text by STRING.
1528 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1529 START and END optionally delimit a substring of STRING from which to read;
1530 they default to 0 and (length STRING) respectively. */)
1531 (string
, start
, end
)
1532 Lisp_Object string
, start
, end
;
1535 CHECK_STRING (string
);
1536 /* read_internal_start sets read_from_string_index. */
1537 ret
= read_internal_start (string
, start
, end
);
1538 return Fcons (ret
, make_number (read_from_string_index
));
1541 /* Function to set up the global context we need in toplevel read
1544 read_internal_start (stream
, start
, end
)
1546 Lisp_Object start
; /* Only used when stream is a string. */
1547 Lisp_Object end
; /* Only used when stream is a string. */
1551 readchar_backlog
= -1;
1553 new_backquote_flag
= 0;
1554 read_objects
= Qnil
;
1555 if (EQ (Vread_with_symbol_positions
, Qt
)
1556 || EQ (Vread_with_symbol_positions
, stream
))
1557 Vread_symbol_positions_list
= Qnil
;
1559 if (STRINGP (stream
))
1561 int startval
, endval
;
1563 endval
= SCHARS (stream
);
1567 endval
= XINT (end
);
1568 if (endval
< 0 || endval
> SCHARS (stream
))
1569 args_out_of_range (stream
, end
);
1576 CHECK_NUMBER (start
);
1577 startval
= XINT (start
);
1578 if (startval
< 0 || startval
> endval
)
1579 args_out_of_range (stream
, start
);
1581 read_from_string_index
= startval
;
1582 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1583 read_from_string_limit
= endval
;
1586 retval
= read0 (stream
);
1587 if (EQ (Vread_with_symbol_positions
, Qt
)
1588 || EQ (Vread_with_symbol_positions
, stream
))
1589 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1593 /* Use this for recursive reads, in contexts where internal tokens
1598 Lisp_Object readcharfun
;
1600 register Lisp_Object val
;
1603 val
= read1 (readcharfun
, &c
, 0);
1605 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1612 static int read_buffer_size
;
1613 static char *read_buffer
;
1615 /* Read multibyte form and return it as a character. C is a first
1616 byte of multibyte form, and rest of them are read from
1620 read_multibyte (c
, readcharfun
)
1622 Lisp_Object readcharfun
;
1624 /* We need the actual character code of this multibyte
1626 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1634 while ((c
= READCHAR
) >= 0xA0
1635 && len
< MAX_MULTIBYTE_LENGTH
)
1641 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1642 return STRING_CHAR (str
, len
);
1643 /* The byte sequence is not valid as multibyte. Unread all bytes
1644 but the first one, and return the first byte. */
1650 /* Read a \-escape sequence, assuming we already read the `\'.
1651 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1652 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1653 Otherwise store 0 into *BYTEREP. */
1656 read_escape (readcharfun
, stringp
, byterep
)
1657 Lisp_Object readcharfun
;
1661 register int c
= READCHAR
;
1668 end_of_file_error ();
1698 error ("Invalid escape character syntax");
1701 c
= read_escape (readcharfun
, 0, byterep
);
1702 return c
| meta_modifier
;
1707 error ("Invalid escape character syntax");
1710 c
= read_escape (readcharfun
, 0, byterep
);
1711 return c
| shift_modifier
;
1716 error ("Invalid escape character syntax");
1719 c
= read_escape (readcharfun
, 0, byterep
);
1720 return c
| hyper_modifier
;
1725 error ("Invalid escape character syntax");
1728 c
= read_escape (readcharfun
, 0, byterep
);
1729 return c
| alt_modifier
;
1741 c
= read_escape (readcharfun
, 0, byterep
);
1742 return c
| super_modifier
;
1747 error ("Invalid escape character syntax");
1751 c
= read_escape (readcharfun
, 0, byterep
);
1752 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1753 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1754 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1755 return c
| ctrl_modifier
;
1756 /* ASCII control chars are made from letters (both cases),
1757 as well as the non-letters within 0100...0137. */
1758 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1759 return (c
& (037 | ~0177));
1760 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1761 return (c
& (037 | ~0177));
1763 return c
| ctrl_modifier
;
1773 /* An octal escape, as in ANSI C. */
1775 register int i
= c
- '0';
1776 register int count
= 0;
1779 if ((c
= READCHAR
) >= '0' && c
<= '7')
1796 /* A hex escape, as in ANSI C. */
1802 if (c
>= '0' && c
<= '9')
1807 else if ((c
>= 'a' && c
<= 'f')
1808 || (c
>= 'A' && c
<= 'F'))
1811 if (c
>= 'a' && c
<= 'f')
1828 if (BASE_LEADING_CODE_P (c
))
1829 c
= read_multibyte (c
, readcharfun
);
1835 /* Read an integer in radix RADIX using READCHARFUN to read
1836 characters. RADIX must be in the interval [2..36]; if it isn't, a
1837 read error is signaled . Value is the integer read. Signals an
1838 error if encountering invalid read syntax or if RADIX is out of
1842 read_integer (readcharfun
, radix
)
1843 Lisp_Object readcharfun
;
1846 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1847 EMACS_INT number
= 0;
1849 if (radix
< 2 || radix
> 36)
1853 number
= ndigits
= invalid_p
= 0;
1869 if (c
>= '0' && c
<= '9')
1871 else if (c
>= 'a' && c
<= 'z')
1872 digit
= c
- 'a' + 10;
1873 else if (c
>= 'A' && c
<= 'Z')
1874 digit
= c
- 'A' + 10;
1881 if (digit
< 0 || digit
>= radix
)
1884 number
= radix
* number
+ digit
;
1890 if (ndigits
== 0 || invalid_p
)
1893 sprintf (buf
, "integer, radix %d", radix
);
1894 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1897 return make_number (sign
* number
);
1901 /* Convert unibyte text in read_buffer to multibyte.
1903 Initially, *P is a pointer after the end of the unibyte text, and
1904 the pointer *END points after the end of read_buffer.
1906 If read_buffer doesn't have enough room to hold the result
1907 of the conversion, reallocate it and adjust *P and *END.
1909 At the end, make *P point after the result of the conversion, and
1910 return in *NCHARS the number of characters in the converted
1914 to_multibyte (p
, end
, nchars
)
1920 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1921 if (read_buffer_size
< 2 * nbytes
)
1923 int offset
= *p
- read_buffer
;
1924 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1925 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1926 *p
= read_buffer
+ offset
;
1927 *end
= read_buffer
+ read_buffer_size
;
1930 if (nbytes
!= *nchars
)
1931 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1932 *p
- read_buffer
, nchars
);
1934 *p
= read_buffer
+ nbytes
;
1938 /* If the next token is ')' or ']' or '.', we store that character
1939 in *PCH and the return value is not interesting. Else, we store
1940 zero in *PCH and we read and return one lisp object.
1942 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1945 read1 (readcharfun
, pch
, first_in_list
)
1946 register Lisp_Object readcharfun
;
1951 int uninterned_symbol
= 0;
1959 end_of_file_error ();
1964 return read_list (0, readcharfun
);
1967 return read_vector (readcharfun
, 0);
1984 tmp
= read_vector (readcharfun
, 0);
1985 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1986 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1987 error ("Invalid size char-table");
1988 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1989 XCHAR_TABLE (tmp
)->top
= Qt
;
1998 tmp
= read_vector (readcharfun
, 0);
1999 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2000 error ("Invalid size char-table");
2001 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2002 XCHAR_TABLE (tmp
)->top
= Qnil
;
2005 Fsignal (Qinvalid_read_syntax
,
2006 Fcons (make_string ("#^^", 3), Qnil
));
2008 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2013 length
= read1 (readcharfun
, pch
, first_in_list
);
2017 Lisp_Object tmp
, val
;
2019 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2020 / BOOL_VECTOR_BITS_PER_CHAR
);
2023 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2024 if (size_in_chars
!= SCHARS (tmp
)
2025 /* We used to print 1 char too many
2026 when the number of bits was a multiple of 8.
2027 Accept such input in case it came from an old version. */
2028 && ! (XFASTINT (length
)
2029 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2030 Fsignal (Qinvalid_read_syntax
,
2031 Fcons (make_string ("#&...", 5), Qnil
));
2033 val
= Fmake_bool_vector (length
, Qnil
);
2034 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2036 /* Clear the extraneous bits in the last byte. */
2037 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2038 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2039 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2042 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2047 /* Accept compiled functions at read-time so that we don't have to
2048 build them using function calls. */
2050 tmp
= read_vector (readcharfun
, 1);
2051 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2052 XVECTOR (tmp
)->contents
);
2057 struct gcpro gcpro1
;
2060 /* Read the string itself. */
2061 tmp
= read1 (readcharfun
, &ch
, 0);
2062 if (ch
!= 0 || !STRINGP (tmp
))
2063 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2065 /* Read the intervals and their properties. */
2068 Lisp_Object beg
, end
, plist
;
2070 beg
= read1 (readcharfun
, &ch
, 0);
2075 end
= read1 (readcharfun
, &ch
, 0);
2077 plist
= read1 (readcharfun
, &ch
, 0);
2079 Fsignal (Qinvalid_read_syntax
,
2080 Fcons (build_string ("invalid string property list"),
2082 Fset_text_properties (beg
, end
, plist
, tmp
);
2088 /* #@NUMBER is used to skip NUMBER following characters.
2089 That's used in .elc files to skip over doc strings
2090 and function definitions. */
2095 /* Read a decimal integer. */
2096 while ((c
= READCHAR
) >= 0
2097 && c
>= '0' && c
<= '9')
2105 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2107 /* If we are supposed to force doc strings into core right now,
2108 record the last string that we skipped,
2109 and record where in the file it comes from. */
2111 /* But first exchange saved_doc_string
2112 with prev_saved_doc_string, so we save two strings. */
2114 char *temp
= saved_doc_string
;
2115 int temp_size
= saved_doc_string_size
;
2116 file_offset temp_pos
= saved_doc_string_position
;
2117 int temp_len
= saved_doc_string_length
;
2119 saved_doc_string
= prev_saved_doc_string
;
2120 saved_doc_string_size
= prev_saved_doc_string_size
;
2121 saved_doc_string_position
= prev_saved_doc_string_position
;
2122 saved_doc_string_length
= prev_saved_doc_string_length
;
2124 prev_saved_doc_string
= temp
;
2125 prev_saved_doc_string_size
= temp_size
;
2126 prev_saved_doc_string_position
= temp_pos
;
2127 prev_saved_doc_string_length
= temp_len
;
2130 if (saved_doc_string_size
== 0)
2132 saved_doc_string_size
= nskip
+ 100;
2133 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2135 if (nskip
> saved_doc_string_size
)
2137 saved_doc_string_size
= nskip
+ 100;
2138 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2139 saved_doc_string_size
);
2142 saved_doc_string_position
= file_tell (instream
);
2144 /* Copy that many characters into saved_doc_string. */
2145 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2146 saved_doc_string
[i
] = c
= READCHAR
;
2148 saved_doc_string_length
= i
;
2152 /* Skip that many characters. */
2153 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2161 /* #! appears at the beginning of an executable file.
2162 Skip the first line. */
2163 while (c
!= '\n' && c
>= 0)
2168 return Vload_file_name
;
2170 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2171 /* #:foo is the uninterned symbol named foo. */
2174 uninterned_symbol
= 1;
2178 /* Reader forms that can reuse previously read objects. */
2179 if (c
>= '0' && c
<= '9')
2184 /* Read a non-negative integer. */
2185 while (c
>= '0' && c
<= '9')
2191 /* #n=object returns object, but associates it with n for #n#. */
2194 /* Make a placeholder for #n# to use temporarily */
2195 Lisp_Object placeholder
;
2198 placeholder
= Fcons(Qnil
, Qnil
);
2199 cell
= Fcons (make_number (n
), placeholder
);
2200 read_objects
= Fcons (cell
, read_objects
);
2202 /* Read the object itself. */
2203 tem
= read0 (readcharfun
);
2205 /* Now put it everywhere the placeholder was... */
2206 substitute_object_in_subtree (tem
, placeholder
);
2208 /* ...and #n# will use the real value from now on. */
2209 Fsetcdr (cell
, tem
);
2213 /* #n# returns a previously read object. */
2216 tem
= Fassq (make_number (n
), read_objects
);
2219 /* Fall through to error message. */
2221 else if (c
== 'r' || c
== 'R')
2222 return read_integer (readcharfun
, n
);
2224 /* Fall through to error message. */
2226 else if (c
== 'x' || c
== 'X')
2227 return read_integer (readcharfun
, 16);
2228 else if (c
== 'o' || c
== 'O')
2229 return read_integer (readcharfun
, 8);
2230 else if (c
== 'b' || c
== 'B')
2231 return read_integer (readcharfun
, 2);
2234 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2237 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2242 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2252 new_backquote_flag
++;
2253 value
= read0 (readcharfun
);
2254 new_backquote_flag
--;
2256 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2260 if (new_backquote_flag
)
2262 Lisp_Object comma_type
= Qnil
;
2267 comma_type
= Qcomma_at
;
2269 comma_type
= Qcomma_dot
;
2272 if (ch
>= 0) UNREAD (ch
);
2273 comma_type
= Qcomma
;
2276 new_backquote_flag
--;
2277 value
= read0 (readcharfun
);
2278 new_backquote_flag
++;
2279 return Fcons (comma_type
, Fcons (value
, Qnil
));
2292 end_of_file_error ();
2294 /* Accept `single space' syntax like (list ? x) where the
2295 whitespace character is SPC or TAB.
2296 Other literal whitespace like NL, CR, and FF are not accepted,
2297 as there are well-established escape sequences for these. */
2298 if (c
== ' ' || c
== '\t')
2299 return make_number (c
);
2302 c
= read_escape (readcharfun
, 0, &discard
);
2303 else if (BASE_LEADING_CODE_P (c
))
2304 c
= read_multibyte (c
, readcharfun
);
2306 next_char
= READCHAR
;
2307 if (next_char
== '.')
2309 /* Only a dotted-pair dot is valid after a char constant. */
2310 int next_next_char
= READCHAR
;
2311 UNREAD (next_next_char
);
2313 ok
= (next_next_char
<= 040
2314 || (next_next_char
< 0200
2315 && (index ("\"';([#?", next_next_char
)
2316 || (!first_in_list
&& next_next_char
== '`')
2317 || (new_backquote_flag
&& next_next_char
== ','))));
2321 ok
= (next_char
<= 040
2322 || (next_char
< 0200
2323 && (index ("\"';()[]#?", next_char
)
2324 || (!first_in_list
&& next_char
== '`')
2325 || (new_backquote_flag
&& next_char
== ','))));
2329 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2331 return make_number (c
);
2336 char *p
= read_buffer
;
2337 char *end
= read_buffer
+ read_buffer_size
;
2339 /* 1 if we saw an escape sequence specifying
2340 a multibyte character, or a multibyte character. */
2341 int force_multibyte
= 0;
2342 /* 1 if we saw an escape sequence specifying
2343 a single-byte character. */
2344 int force_singlebyte
= 0;
2345 /* 1 if read_buffer contains multibyte text now. */
2346 int is_multibyte
= 0;
2350 while ((c
= READCHAR
) >= 0
2353 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2355 int offset
= p
- read_buffer
;
2356 read_buffer
= (char *) xrealloc (read_buffer
,
2357 read_buffer_size
*= 2);
2358 p
= read_buffer
+ offset
;
2359 end
= read_buffer
+ read_buffer_size
;
2366 c
= read_escape (readcharfun
, 1, &byterep
);
2368 /* C is -1 if \ newline has just been seen */
2371 if (p
== read_buffer
)
2377 force_singlebyte
= 1;
2378 else if (byterep
== 2)
2379 force_multibyte
= 1;
2382 /* A character that must be multibyte forces multibyte. */
2383 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2384 force_multibyte
= 1;
2386 /* If we just discovered the need to be multibyte,
2387 convert the text accumulated thus far. */
2388 if (force_multibyte
&& ! is_multibyte
)
2391 to_multibyte (&p
, &end
, &nchars
);
2394 /* Allow `\C- ' and `\C-?'. */
2395 if (c
== (CHAR_CTL
| ' '))
2397 else if (c
== (CHAR_CTL
| '?'))
2402 /* Shift modifier is valid only with [A-Za-z]. */
2403 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2405 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2406 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2410 /* Move the meta bit to the right place for a string. */
2411 c
= (c
& ~CHAR_META
) | 0x80;
2412 if (c
& CHAR_MODIFIER_MASK
)
2413 error ("Invalid modifier in string");
2416 p
+= CHAR_STRING (c
, p
);
2424 end_of_file_error ();
2426 /* If purifying, and string starts with \ newline,
2427 return zero instead. This is for doc strings
2428 that we are really going to find in etc/DOC.nn.nn */
2429 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2430 return make_number (0);
2432 if (is_multibyte
|| force_singlebyte
)
2434 else if (load_convert_to_unibyte
)
2437 to_multibyte (&p
, &end
, &nchars
);
2438 if (p
- read_buffer
!= nchars
)
2440 string
= make_multibyte_string (read_buffer
, nchars
,
2442 return Fstring_make_unibyte (string
);
2444 /* We can make a unibyte string directly. */
2447 else if (EQ (readcharfun
, Qget_file_char
)
2448 || EQ (readcharfun
, Qlambda
))
2450 /* Nowadays, reading directly from a file is used only for
2451 compiled Emacs Lisp files, and those always use the
2452 Emacs internal encoding. Meanwhile, Qlambda is used
2453 for reading dynamic byte code (compiled with
2454 byte-compile-dynamic = t). So make the string multibyte
2455 if the string contains any multibyte sequences.
2456 (to_multibyte is a no-op if not.) */
2457 to_multibyte (&p
, &end
, &nchars
);
2458 is_multibyte
= (p
- read_buffer
) != nchars
;
2461 /* In all other cases, if we read these bytes as
2462 separate characters, treat them as separate characters now. */
2465 /* We want readchar_count to be the number of characters, not
2466 bytes. Hence we adjust for multibyte characters in the
2467 string. ... But it doesn't seem to be necessary, because
2468 READCHAR *does* read multibyte characters from buffers. */
2469 /* readchar_count -= (p - read_buffer) - nchars; */
2471 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2473 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2479 int next_char
= READCHAR
;
2482 if (next_char
<= 040
2483 || (next_char
< 0200
2484 && (index ("\"';([#?", next_char
)
2485 || (!first_in_list
&& next_char
== '`')
2486 || (new_backquote_flag
&& next_char
== ','))))
2492 /* Otherwise, we fall through! Note that the atom-reading loop
2493 below will now loop at least once, assuring that we will not
2494 try to UNREAD two characters in a row. */
2498 if (c
<= 040) goto retry
;
2500 char *p
= read_buffer
;
2504 char *end
= read_buffer
+ read_buffer_size
;
2508 || (!index ("\"';()[]#", c
)
2509 && !(!first_in_list
&& c
== '`')
2510 && !(new_backquote_flag
&& c
== ','))))
2512 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2514 int offset
= p
- read_buffer
;
2515 read_buffer
= (char *) xrealloc (read_buffer
,
2516 read_buffer_size
*= 2);
2517 p
= read_buffer
+ offset
;
2518 end
= read_buffer
+ read_buffer_size
;
2525 end_of_file_error ();
2529 if (! SINGLE_BYTE_CHAR_P (c
))
2530 p
+= CHAR_STRING (c
, p
);
2539 int offset
= p
- read_buffer
;
2540 read_buffer
= (char *) xrealloc (read_buffer
,
2541 read_buffer_size
*= 2);
2542 p
= read_buffer
+ offset
;
2543 end
= read_buffer
+ read_buffer_size
;
2550 if (!quoted
&& !uninterned_symbol
)
2553 register Lisp_Object val
;
2555 if (*p1
== '+' || *p1
== '-') p1
++;
2556 /* Is it an integer? */
2559 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2560 /* Integers can have trailing decimal points. */
2561 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2563 /* It is an integer. */
2567 if (sizeof (int) == sizeof (EMACS_INT
))
2568 XSETINT (val
, atoi (read_buffer
));
2569 else if (sizeof (long) == sizeof (EMACS_INT
))
2570 XSETINT (val
, atol (read_buffer
));
2576 if (isfloat_string (read_buffer
))
2578 /* Compute NaN and infinities using 0.0 in a variable,
2579 to cope with compilers that think they are smarter
2585 /* Negate the value ourselves. This treats 0, NaNs,
2586 and infinity properly on IEEE floating point hosts,
2587 and works around a common bug where atof ("-0.0")
2589 int negative
= read_buffer
[0] == '-';
2591 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2592 returns 1, is if the input ends in e+INF or e+NaN. */
2599 value
= zero
/ zero
;
2601 /* If that made a "negative" NaN, negate it. */
2605 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2608 u_minus_zero
.d
= - 0.0;
2609 for (i
= 0; i
< sizeof (double); i
++)
2610 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2616 /* Now VALUE is a positive NaN. */
2619 value
= atof (read_buffer
+ negative
);
2623 return make_float (negative
? - value
: value
);
2627 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2628 : intern (read_buffer
);
2629 if (EQ (Vread_with_symbol_positions
, Qt
)
2630 || EQ (Vread_with_symbol_positions
, readcharfun
))
2631 Vread_symbol_positions_list
=
2632 /* Kind of a hack; this will probably fail if characters
2633 in the symbol name were escaped. Not really a big
2635 Fcons (Fcons (result
,
2636 make_number (readchar_count
2637 - XFASTINT (Flength (Fsymbol_name (result
))))),
2638 Vread_symbol_positions_list
);
2646 /* List of nodes we've seen during substitute_object_in_subtree. */
2647 static Lisp_Object seen_list
;
2650 substitute_object_in_subtree (object
, placeholder
)
2652 Lisp_Object placeholder
;
2654 Lisp_Object check_object
;
2656 /* We haven't seen any objects when we start. */
2659 /* Make all the substitutions. */
2661 = substitute_object_recurse (object
, placeholder
, object
);
2663 /* Clear seen_list because we're done with it. */
2666 /* The returned object here is expected to always eq the
2668 if (!EQ (check_object
, object
))
2669 error ("Unexpected mutation error in reader");
2672 /* Feval doesn't get called from here, so no gc protection is needed. */
2673 #define SUBSTITUTE(get_val, set_val) \
2675 Lisp_Object old_value = get_val; \
2676 Lisp_Object true_value \
2677 = substitute_object_recurse (object, placeholder,\
2680 if (!EQ (old_value, true_value)) \
2687 substitute_object_recurse (object
, placeholder
, subtree
)
2689 Lisp_Object placeholder
;
2690 Lisp_Object subtree
;
2692 /* If we find the placeholder, return the target object. */
2693 if (EQ (placeholder
, subtree
))
2696 /* If we've been to this node before, don't explore it again. */
2697 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2700 /* If this node can be the entry point to a cycle, remember that
2701 we've seen it. It can only be such an entry point if it was made
2702 by #n=, which means that we can find it as a value in
2704 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2705 seen_list
= Fcons (subtree
, seen_list
);
2707 /* Recurse according to subtree's type.
2708 Every branch must return a Lisp_Object. */
2709 switch (XTYPE (subtree
))
2711 case Lisp_Vectorlike
:
2714 int length
= XINT (Flength(subtree
));
2715 for (i
= 0; i
< length
; i
++)
2717 Lisp_Object idx
= make_number (i
);
2718 SUBSTITUTE (Faref (subtree
, idx
),
2719 Faset (subtree
, idx
, true_value
));
2726 SUBSTITUTE (Fcar_safe (subtree
),
2727 Fsetcar (subtree
, true_value
));
2728 SUBSTITUTE (Fcdr_safe (subtree
),
2729 Fsetcdr (subtree
, true_value
));
2735 /* Check for text properties in each interval.
2736 substitute_in_interval contains part of the logic. */
2738 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2739 Lisp_Object arg
= Fcons (object
, placeholder
);
2741 traverse_intervals_noorder (root_interval
,
2742 &substitute_in_interval
, arg
);
2747 /* Other types don't recurse any further. */
2753 /* Helper function for substitute_object_recurse. */
2755 substitute_in_interval (interval
, arg
)
2759 Lisp_Object object
= Fcar (arg
);
2760 Lisp_Object placeholder
= Fcdr (arg
);
2762 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2781 if (*cp
== '+' || *cp
== '-')
2784 if (*cp
>= '0' && *cp
<= '9')
2787 while (*cp
>= '0' && *cp
<= '9')
2795 if (*cp
>= '0' && *cp
<= '9')
2798 while (*cp
>= '0' && *cp
<= '9')
2801 if (*cp
== 'e' || *cp
== 'E')
2805 if (*cp
== '+' || *cp
== '-')
2809 if (*cp
>= '0' && *cp
<= '9')
2812 while (*cp
>= '0' && *cp
<= '9')
2815 else if (cp
== start
)
2817 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2822 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2828 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2829 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2830 || state
== (DOT_CHAR
|TRAIL_INT
)
2831 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2832 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2833 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2838 read_vector (readcharfun
, bytecodeflag
)
2839 Lisp_Object readcharfun
;
2844 register Lisp_Object
*ptr
;
2845 register Lisp_Object tem
, item
, vector
;
2846 register struct Lisp_Cons
*otem
;
2849 tem
= read_list (1, readcharfun
);
2850 len
= Flength (tem
);
2851 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2853 size
= XVECTOR (vector
)->size
;
2854 ptr
= XVECTOR (vector
)->contents
;
2855 for (i
= 0; i
< size
; i
++)
2858 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2859 bytecode object, the docstring containing the bytecode and
2860 constants values must be treated as unibyte and passed to
2861 Fread, to get the actual bytecode string and constants vector. */
2862 if (bytecodeflag
&& load_force_doc_strings
)
2864 if (i
== COMPILED_BYTECODE
)
2866 if (!STRINGP (item
))
2867 error ("Invalid byte code");
2869 /* Delay handling the bytecode slot until we know whether
2870 it is lazily-loaded (we can tell by whether the
2871 constants slot is nil). */
2872 ptr
[COMPILED_CONSTANTS
] = item
;
2875 else if (i
== COMPILED_CONSTANTS
)
2877 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2881 /* Coerce string to unibyte (like string-as-unibyte,
2882 but without generating extra garbage and
2883 guaranteeing no change in the contents). */
2884 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2885 STRING_SET_UNIBYTE (bytestr
);
2887 item
= Fread (bytestr
);
2889 error ("Invalid byte code");
2891 otem
= XCONS (item
);
2892 bytestr
= XCAR (item
);
2897 /* Now handle the bytecode slot. */
2898 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2901 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2909 /* FLAG = 1 means check for ] to terminate rather than ) and .
2910 FLAG = -1 means check for starting with defun
2911 and make structure pure. */
2914 read_list (flag
, readcharfun
)
2916 register Lisp_Object readcharfun
;
2918 /* -1 means check next element for defun,
2919 0 means don't check,
2920 1 means already checked and found defun. */
2921 int defunflag
= flag
< 0 ? -1 : 0;
2922 Lisp_Object val
, tail
;
2923 register Lisp_Object elt
, tem
;
2924 struct gcpro gcpro1
, gcpro2
;
2925 /* 0 is the normal case.
2926 1 means this list is a doc reference; replace it with the number 0.
2927 2 means this list is a doc reference; replace it with the doc string. */
2928 int doc_reference
= 0;
2930 /* Initialize this to 1 if we are reading a list. */
2931 int first_in_list
= flag
<= 0;
2940 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2945 /* While building, if the list starts with #$, treat it specially. */
2946 if (EQ (elt
, Vload_file_name
)
2948 && !NILP (Vpurify_flag
))
2950 if (NILP (Vdoc_file_name
))
2951 /* We have not yet called Snarf-documentation, so assume
2952 this file is described in the DOC-MM.NN file
2953 and Snarf-documentation will fill in the right value later.
2954 For now, replace the whole list with 0. */
2957 /* We have already called Snarf-documentation, so make a relative
2958 file name for this file, so it can be found properly
2959 in the installed Lisp directory.
2960 We don't use Fexpand_file_name because that would make
2961 the directory absolute now. */
2962 elt
= concat2 (build_string ("../lisp/"),
2963 Ffile_name_nondirectory (elt
));
2965 else if (EQ (elt
, Vload_file_name
)
2967 && load_force_doc_strings
)
2976 Fsignal (Qinvalid_read_syntax
,
2977 Fcons (make_string (") or . in a vector", 18), Qnil
));
2985 XSETCDR (tail
, read0 (readcharfun
));
2987 val
= read0 (readcharfun
);
2988 read1 (readcharfun
, &ch
, 0);
2992 if (doc_reference
== 1)
2993 return make_number (0);
2994 if (doc_reference
== 2)
2996 /* Get a doc string from the file we are loading.
2997 If it's in saved_doc_string, get it from there. */
2998 int pos
= XINT (XCDR (val
));
2999 /* Position is negative for user variables. */
3000 if (pos
< 0) pos
= -pos
;
3001 if (pos
>= saved_doc_string_position
3002 && pos
< (saved_doc_string_position
3003 + saved_doc_string_length
))
3005 int start
= pos
- saved_doc_string_position
;
3008 /* Process quoting with ^A,
3009 and find the end of the string,
3010 which is marked with ^_ (037). */
3011 for (from
= start
, to
= start
;
3012 saved_doc_string
[from
] != 037;)
3014 int c
= saved_doc_string
[from
++];
3017 c
= saved_doc_string
[from
++];
3019 saved_doc_string
[to
++] = c
;
3021 saved_doc_string
[to
++] = 0;
3023 saved_doc_string
[to
++] = 037;
3026 saved_doc_string
[to
++] = c
;
3029 return make_string (saved_doc_string
+ start
,
3032 /* Look in prev_saved_doc_string the same way. */
3033 else if (pos
>= prev_saved_doc_string_position
3034 && pos
< (prev_saved_doc_string_position
3035 + prev_saved_doc_string_length
))
3037 int start
= pos
- prev_saved_doc_string_position
;
3040 /* Process quoting with ^A,
3041 and find the end of the string,
3042 which is marked with ^_ (037). */
3043 for (from
= start
, to
= start
;
3044 prev_saved_doc_string
[from
] != 037;)
3046 int c
= prev_saved_doc_string
[from
++];
3049 c
= prev_saved_doc_string
[from
++];
3051 prev_saved_doc_string
[to
++] = c
;
3053 prev_saved_doc_string
[to
++] = 0;
3055 prev_saved_doc_string
[to
++] = 037;
3058 prev_saved_doc_string
[to
++] = c
;
3061 return make_string (prev_saved_doc_string
+ start
,
3065 return get_doc_string (val
, 0, 0);
3070 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3072 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3074 tem
= (read_pure
&& flag
<= 0
3075 ? pure_cons (elt
, Qnil
)
3076 : Fcons (elt
, Qnil
));
3078 XSETCDR (tail
, tem
);
3083 defunflag
= EQ (elt
, Qdefun
);
3084 else if (defunflag
> 0)
3089 Lisp_Object Vobarray
;
3090 Lisp_Object initial_obarray
;
3092 /* oblookup stores the bucket number here, for the sake of Funintern. */
3094 int oblookup_last_bucket_number
;
3096 static int hash_string ();
3098 /* Get an error if OBARRAY is not an obarray.
3099 If it is one, return it. */
3102 check_obarray (obarray
)
3103 Lisp_Object obarray
;
3105 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3107 /* If Vobarray is now invalid, force it to be valid. */
3108 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3110 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3115 /* Intern the C string STR: return a symbol with that name,
3116 interned in the current obarray. */
3123 int len
= strlen (str
);
3124 Lisp_Object obarray
;
3127 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3128 obarray
= check_obarray (obarray
);
3129 tem
= oblookup (obarray
, str
, len
, len
);
3132 return Fintern (make_string (str
, len
), obarray
);
3135 /* Create an uninterned symbol with name STR. */
3141 int len
= strlen (str
);
3143 return Fmake_symbol ((!NILP (Vpurify_flag
)
3144 ? make_pure_string (str
, len
, len
, 0)
3145 : make_string (str
, len
)));
3148 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3149 doc
: /* Return the canonical symbol whose name is STRING.
3150 If there is none, one is created by this function and returned.
3151 A second optional argument specifies the obarray to use;
3152 it defaults to the value of `obarray'. */)
3154 Lisp_Object string
, obarray
;
3156 register Lisp_Object tem
, sym
, *ptr
;
3158 if (NILP (obarray
)) obarray
= Vobarray
;
3159 obarray
= check_obarray (obarray
);
3161 CHECK_STRING (string
);
3163 tem
= oblookup (obarray
, SDATA (string
),
3166 if (!INTEGERP (tem
))
3169 if (!NILP (Vpurify_flag
))
3170 string
= Fpurecopy (string
);
3171 sym
= Fmake_symbol (string
);
3173 if (EQ (obarray
, initial_obarray
))
3174 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3176 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3178 if ((SREF (string
, 0) == ':')
3179 && EQ (obarray
, initial_obarray
))
3181 XSYMBOL (sym
)->constant
= 1;
3182 XSYMBOL (sym
)->value
= sym
;
3185 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3187 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3189 XSYMBOL (sym
)->next
= 0;
3194 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3195 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3196 NAME may be a string or a symbol. If it is a symbol, that exact
3197 symbol is searched for.
3198 A second optional argument specifies the obarray to use;
3199 it defaults to the value of `obarray'. */)
3201 Lisp_Object name
, obarray
;
3203 register Lisp_Object tem
, string
;
3205 if (NILP (obarray
)) obarray
= Vobarray
;
3206 obarray
= check_obarray (obarray
);
3208 if (!SYMBOLP (name
))
3210 CHECK_STRING (name
);
3214 string
= SYMBOL_NAME (name
);
3216 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3217 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3223 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3224 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3225 The value is t if a symbol was found and deleted, nil otherwise.
3226 NAME may be a string or a symbol. If it is a symbol, that symbol
3227 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3228 OBARRAY defaults to the value of the variable `obarray'. */)
3230 Lisp_Object name
, obarray
;
3232 register Lisp_Object string
, tem
;
3235 if (NILP (obarray
)) obarray
= Vobarray
;
3236 obarray
= check_obarray (obarray
);
3239 string
= SYMBOL_NAME (name
);
3242 CHECK_STRING (name
);
3246 tem
= oblookup (obarray
, SDATA (string
),
3251 /* If arg was a symbol, don't delete anything but that symbol itself. */
3252 if (SYMBOLP (name
) && !EQ (name
, tem
))
3255 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3256 XSYMBOL (tem
)->constant
= 0;
3257 XSYMBOL (tem
)->indirect_variable
= 0;
3259 hash
= oblookup_last_bucket_number
;
3261 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3263 if (XSYMBOL (tem
)->next
)
3264 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3266 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3270 Lisp_Object tail
, following
;
3272 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3273 XSYMBOL (tail
)->next
;
3276 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3277 if (EQ (following
, tem
))
3279 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3288 /* Return the symbol in OBARRAY whose names matches the string
3289 of SIZE characters (SIZE_BYTE bytes) at PTR.
3290 If there is no such symbol in OBARRAY, return nil.
3292 Also store the bucket number in oblookup_last_bucket_number. */
3295 oblookup (obarray
, ptr
, size
, size_byte
)
3296 Lisp_Object obarray
;
3297 register const char *ptr
;
3298 int size
, size_byte
;
3302 register Lisp_Object tail
;
3303 Lisp_Object bucket
, tem
;
3305 if (!VECTORP (obarray
)
3306 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3308 obarray
= check_obarray (obarray
);
3309 obsize
= XVECTOR (obarray
)->size
;
3311 /* This is sometimes needed in the middle of GC. */
3312 obsize
&= ~ARRAY_MARK_FLAG
;
3313 /* Combining next two lines breaks VMS C 2.3. */
3314 hash
= hash_string (ptr
, size_byte
);
3316 bucket
= XVECTOR (obarray
)->contents
[hash
];
3317 oblookup_last_bucket_number
= hash
;
3318 if (EQ (bucket
, make_number (0)))
3320 else if (!SYMBOLP (bucket
))
3321 error ("Bad data in guts of obarray"); /* Like CADR error message */
3323 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3325 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3326 && SCHARS (SYMBOL_NAME (tail
)) == size
3327 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3329 else if (XSYMBOL (tail
)->next
== 0)
3332 XSETINT (tem
, hash
);
3337 hash_string (ptr
, len
)
3338 const unsigned char *ptr
;
3341 register const unsigned char *p
= ptr
;
3342 register const unsigned char *end
= p
+ len
;
3343 register unsigned char c
;
3344 register int hash
= 0;
3349 if (c
>= 0140) c
-= 40;
3350 hash
= ((hash
<<3) + (hash
>>28) + c
);
3352 return hash
& 07777777777;
3356 map_obarray (obarray
, fn
, arg
)
3357 Lisp_Object obarray
;
3358 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3362 register Lisp_Object tail
;
3363 CHECK_VECTOR (obarray
);
3364 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3366 tail
= XVECTOR (obarray
)->contents
[i
];
3371 if (XSYMBOL (tail
)->next
== 0)
3373 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3379 mapatoms_1 (sym
, function
)
3380 Lisp_Object sym
, function
;
3382 call1 (function
, sym
);
3385 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3386 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3387 OBARRAY defaults to the value of `obarray'. */)
3389 Lisp_Object function
, obarray
;
3391 if (NILP (obarray
)) obarray
= Vobarray
;
3392 obarray
= check_obarray (obarray
);
3394 map_obarray (obarray
, mapatoms_1
, function
);
3398 #define OBARRAY_SIZE 1511
3403 Lisp_Object oblength
;
3407 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3409 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3410 Vobarray
= Fmake_vector (oblength
, make_number (0));
3411 initial_obarray
= Vobarray
;
3412 staticpro (&initial_obarray
);
3413 /* Intern nil in the obarray */
3414 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3415 XSYMBOL (Qnil
)->constant
= 1;
3417 /* These locals are to kludge around a pyramid compiler bug. */
3418 hash
= hash_string ("nil", 3);
3419 /* Separate statement here to avoid VAXC bug. */
3420 hash
%= OBARRAY_SIZE
;
3421 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3424 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3425 XSYMBOL (Qnil
)->function
= Qunbound
;
3426 XSYMBOL (Qunbound
)->value
= Qunbound
;
3427 XSYMBOL (Qunbound
)->function
= Qunbound
;
3430 XSYMBOL (Qnil
)->value
= Qnil
;
3431 XSYMBOL (Qnil
)->plist
= Qnil
;
3432 XSYMBOL (Qt
)->value
= Qt
;
3433 XSYMBOL (Qt
)->constant
= 1;
3435 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3438 Qvariable_documentation
= intern ("variable-documentation");
3439 staticpro (&Qvariable_documentation
);
3441 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3442 read_buffer
= (char *) xmalloc (read_buffer_size
);
3447 struct Lisp_Subr
*sname
;
3450 sym
= intern (sname
->symbol_name
);
3451 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3454 #ifdef NOTDEF /* use fset in subr.el now */
3456 defalias (sname
, string
)
3457 struct Lisp_Subr
*sname
;
3461 sym
= intern (string
);
3462 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3466 /* Define an "integer variable"; a symbol whose value is forwarded
3467 to a C variable of type int. Sample call: */
3468 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3470 defvar_int (namestring
, address
)
3474 Lisp_Object sym
, val
;
3475 sym
= intern (namestring
);
3476 val
= allocate_misc ();
3477 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3478 XINTFWD (val
)->intvar
= address
;
3479 SET_SYMBOL_VALUE (sym
, val
);
3482 /* Similar but define a variable whose value is t if address contains 1,
3483 nil if address contains 0 */
3485 defvar_bool (namestring
, address
)
3489 Lisp_Object sym
, val
;
3490 sym
= intern (namestring
);
3491 val
= allocate_misc ();
3492 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3493 XBOOLFWD (val
)->boolvar
= address
;
3494 SET_SYMBOL_VALUE (sym
, val
);
3495 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3498 /* Similar but define a variable whose value is the Lisp Object stored
3499 at address. Two versions: with and without gc-marking of the C
3500 variable. The nopro version is used when that variable will be
3501 gc-marked for some other reason, since marking the same slot twice
3502 can cause trouble with strings. */
3504 defvar_lisp_nopro (namestring
, address
)
3506 Lisp_Object
*address
;
3508 Lisp_Object sym
, val
;
3509 sym
= intern (namestring
);
3510 val
= allocate_misc ();
3511 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3512 XOBJFWD (val
)->objvar
= address
;
3513 SET_SYMBOL_VALUE (sym
, val
);
3517 defvar_lisp (namestring
, address
)
3519 Lisp_Object
*address
;
3521 defvar_lisp_nopro (namestring
, address
);
3522 staticpro (address
);
3525 /* Similar but define a variable whose value is the Lisp Object stored in
3526 the current buffer. address is the address of the slot in the buffer
3527 that is current now. */
3530 defvar_per_buffer (namestring
, address
, type
, doc
)
3532 Lisp_Object
*address
;
3536 Lisp_Object sym
, val
;
3539 sym
= intern (namestring
);
3540 val
= allocate_misc ();
3541 offset
= (char *)address
- (char *)current_buffer
;
3543 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3544 XBUFFER_OBJFWD (val
)->offset
= offset
;
3545 SET_SYMBOL_VALUE (sym
, val
);
3546 PER_BUFFER_SYMBOL (offset
) = sym
;
3547 PER_BUFFER_TYPE (offset
) = type
;
3549 if (PER_BUFFER_IDX (offset
) == 0)
3550 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3551 slot of buffer_local_flags */
3556 /* Similar but define a variable whose value is the Lisp Object stored
3557 at a particular offset in the current kboard object. */
3560 defvar_kboard (namestring
, offset
)
3564 Lisp_Object sym
, val
;
3565 sym
= intern (namestring
);
3566 val
= allocate_misc ();
3567 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3568 XKBOARD_OBJFWD (val
)->offset
= offset
;
3569 SET_SYMBOL_VALUE (sym
, val
);
3572 /* Record the value of load-path used at the start of dumping
3573 so we can see if the site changed it later during dumping. */
3574 static Lisp_Object dump_path
;
3580 int turn_off_warning
= 0;
3582 /* Compute the default load-path. */
3584 normal
= PATH_LOADSEARCH
;
3585 Vload_path
= decode_env_path (0, normal
);
3587 if (NILP (Vpurify_flag
))
3588 normal
= PATH_LOADSEARCH
;
3590 normal
= PATH_DUMPLOADSEARCH
;
3592 /* In a dumped Emacs, we normally have to reset the value of
3593 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3594 uses ../lisp, instead of the path of the installed elisp
3595 libraries. However, if it appears that Vload_path was changed
3596 from the default before dumping, don't override that value. */
3599 if (! NILP (Fequal (dump_path
, Vload_path
)))
3601 Vload_path
= decode_env_path (0, normal
);
3602 if (!NILP (Vinstallation_directory
))
3604 Lisp_Object tem
, tem1
, sitelisp
;
3606 /* Remove site-lisp dirs from path temporarily and store
3607 them in sitelisp, then conc them on at the end so
3608 they're always first in path. */
3612 tem
= Fcar (Vload_path
);
3613 tem1
= Fstring_match (build_string ("site-lisp"),
3617 Vload_path
= Fcdr (Vload_path
);
3618 sitelisp
= Fcons (tem
, sitelisp
);
3624 /* Add to the path the lisp subdir of the
3625 installation dir, if it exists. */
3626 tem
= Fexpand_file_name (build_string ("lisp"),
3627 Vinstallation_directory
);
3628 tem1
= Ffile_exists_p (tem
);
3631 if (NILP (Fmember (tem
, Vload_path
)))
3633 turn_off_warning
= 1;
3634 Vload_path
= Fcons (tem
, Vload_path
);
3638 /* That dir doesn't exist, so add the build-time
3639 Lisp dirs instead. */
3640 Vload_path
= nconc2 (Vload_path
, dump_path
);
3642 /* Add leim under the installation dir, if it exists. */
3643 tem
= Fexpand_file_name (build_string ("leim"),
3644 Vinstallation_directory
);
3645 tem1
= Ffile_exists_p (tem
);
3648 if (NILP (Fmember (tem
, Vload_path
)))
3649 Vload_path
= Fcons (tem
, Vload_path
);
3652 /* Add site-list under the installation dir, if it exists. */
3653 tem
= Fexpand_file_name (build_string ("site-lisp"),
3654 Vinstallation_directory
);
3655 tem1
= Ffile_exists_p (tem
);
3658 if (NILP (Fmember (tem
, Vload_path
)))
3659 Vload_path
= Fcons (tem
, Vload_path
);
3662 /* If Emacs was not built in the source directory,
3663 and it is run from where it was built, add to load-path
3664 the lisp, leim and site-lisp dirs under that directory. */
3666 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3670 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3671 Vinstallation_directory
);
3672 tem1
= Ffile_exists_p (tem
);
3674 /* Don't be fooled if they moved the entire source tree
3675 AFTER dumping Emacs. If the build directory is indeed
3676 different from the source dir, src/Makefile.in and
3677 src/Makefile will not be found together. */
3678 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3679 Vinstallation_directory
);
3680 tem2
= Ffile_exists_p (tem
);
3681 if (!NILP (tem1
) && NILP (tem2
))
3683 tem
= Fexpand_file_name (build_string ("lisp"),
3686 if (NILP (Fmember (tem
, Vload_path
)))
3687 Vload_path
= Fcons (tem
, Vload_path
);
3689 tem
= Fexpand_file_name (build_string ("leim"),
3692 if (NILP (Fmember (tem
, Vload_path
)))
3693 Vload_path
= Fcons (tem
, Vload_path
);
3695 tem
= Fexpand_file_name (build_string ("site-lisp"),
3698 if (NILP (Fmember (tem
, Vload_path
)))
3699 Vload_path
= Fcons (tem
, Vload_path
);
3702 if (!NILP (sitelisp
))
3703 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3709 /* NORMAL refers to the lisp dir in the source directory. */
3710 /* We used to add ../lisp at the front here, but
3711 that caused trouble because it was copied from dump_path
3712 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3713 It should be unnecessary. */
3714 Vload_path
= decode_env_path (0, normal
);
3715 dump_path
= Vload_path
;
3719 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3720 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3721 almost never correct, thereby causing a warning to be printed out that
3722 confuses users. Since PATH_LOADSEARCH is always overridden by the
3723 EMACSLOADPATH environment variable below, disable the warning on NT.
3724 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3725 the "standard" paths may not exist and would be overridden by
3726 EMACSLOADPATH as on NT. Since this depends on how the executable
3727 was build and packaged, turn off the warnings in general */
3729 /* Warn if dirs in the *standard* path don't exist. */
3730 if (!turn_off_warning
)
3732 Lisp_Object path_tail
;
3734 for (path_tail
= Vload_path
;
3736 path_tail
= XCDR (path_tail
))
3738 Lisp_Object dirfile
;
3739 dirfile
= Fcar (path_tail
);
3740 if (STRINGP (dirfile
))
3742 dirfile
= Fdirectory_file_name (dirfile
);
3743 if (access (SDATA (dirfile
), 0) < 0)
3744 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3749 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3751 /* If the EMACSLOADPATH environment variable is set, use its value.
3752 This doesn't apply if we're dumping. */
3754 if (NILP (Vpurify_flag
)
3755 && egetenv ("EMACSLOADPATH"))
3757 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3761 load_in_progress
= 0;
3762 Vload_file_name
= Qnil
;
3764 load_descriptor_list
= Qnil
;
3766 Vstandard_input
= Qt
;
3767 Vloads_in_progress
= Qnil
;
3770 /* Print a warning, using format string FORMAT, that directory DIRNAME
3771 does not exist. Print it on stderr and put it in *Message*. */
3774 dir_warning (format
, dirname
)
3776 Lisp_Object dirname
;
3779 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3781 fprintf (stderr
, format
, SDATA (dirname
));
3782 sprintf (buffer
, format
, SDATA (dirname
));
3783 /* Don't log the warning before we've initialized!! */
3785 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3792 defsubr (&Sread_from_string
);
3794 defsubr (&Sintern_soft
);
3795 defsubr (&Sunintern
);
3797 defsubr (&Seval_buffer
);
3798 defsubr (&Seval_region
);
3799 defsubr (&Sread_char
);
3800 defsubr (&Sread_char_exclusive
);
3801 defsubr (&Sread_event
);
3802 defsubr (&Sget_file_char
);
3803 defsubr (&Smapatoms
);
3804 defsubr (&Slocate_file_internal
);
3806 DEFVAR_LISP ("obarray", &Vobarray
,
3807 doc
: /* Symbol table for use by `intern' and `read'.
3808 It is a vector whose length ought to be prime for best results.
3809 The vector's contents don't make sense if examined from Lisp programs;
3810 to find all the symbols in an obarray, use `mapatoms'. */);
3812 DEFVAR_LISP ("values", &Vvalues
,
3813 doc
: /* List of values of all expressions which were read, evaluated and printed.
3814 Order is reverse chronological. */);
3816 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3817 doc
: /* Stream for read to get input from.
3818 See documentation of `read' for possible values. */);
3819 Vstandard_input
= Qt
;
3821 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3822 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3824 If this variable is a buffer, then only forms read from that buffer
3825 will be added to `read-symbol-positions-list'.
3826 If this variable is t, then all read forms will be added.
3827 The effect of all other values other than nil are not currently
3828 defined, although they may be in the future.
3830 The positions are relative to the last call to `read' or
3831 `read-from-string'. It is probably a bad idea to set this variable at
3832 the toplevel; bind it instead. */);
3833 Vread_with_symbol_positions
= Qnil
;
3835 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3836 doc
: /* A list mapping read symbols to their positions.
3837 This variable is modified during calls to `read' or
3838 `read-from-string', but only when `read-with-symbol-positions' is
3841 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3842 CHAR-POSITION is an integer giving the offset of that occurrence of the
3843 symbol from the position where `read' or `read-from-string' started.
3845 Note that a symbol will appear multiple times in this list, if it was
3846 read multiple times. The list is in the same order as the symbols
3848 Vread_symbol_positions_list
= Qnil
;
3850 DEFVAR_LISP ("load-path", &Vload_path
,
3851 doc
: /* *List of directories to search for files to load.
3852 Each element is a string (directory name) or nil (try default directory).
3853 Initialized based on EMACSLOADPATH environment variable, if any,
3854 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3856 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3857 doc
: /* *List of suffixes to try for files to load.
3858 This list should not include the empty string. */);
3859 Vload_suffixes
= Fcons (build_string (".elc"),
3860 Fcons (build_string (".el"), Qnil
));
3861 /* We don't use empty_string because it's not initialized yet. */
3862 default_suffixes
= Fcons (build_string (""), Qnil
);
3863 staticpro (&default_suffixes
);
3865 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3866 doc
: /* Non-nil iff inside of `load'. */);
3868 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3869 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3870 Each element looks like (FILENAME FORMS...).
3871 When `load' is run and the file-name argument is FILENAME,
3872 the FORMS in the corresponding element are executed at the end of loading.
3874 FILENAME must match exactly! Normally FILENAME is the name of a library,
3875 with no directory specified, since that is how `load' is normally called.
3876 An error in FORMS does not undo the load,
3877 but does prevent execution of the rest of the FORMS.
3878 FILENAME can also be a symbol (a feature) and FORMS are then executed
3879 when the corresponding call to `provide' is made. */);
3880 Vafter_load_alist
= Qnil
;
3882 DEFVAR_LISP ("load-history", &Vload_history
,
3883 doc
: /* Alist mapping source file names to symbols and features.
3884 Each alist element is a list that starts with a file name,
3885 except for one element (optional) that starts with nil and describes
3886 definitions evaluated from buffers not visiting files.
3887 The remaining elements of each list are symbols defined as variables
3888 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3889 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3890 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3891 and means that SYMBOL was an autoload before this file redefined it
3893 Vload_history
= Qnil
;
3895 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3896 doc
: /* Full name of file being loaded by `load'. */);
3897 Vload_file_name
= Qnil
;
3899 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3900 doc
: /* File name, including directory, of user's initialization file.
3901 If the file loaded had extension `.elc', and the corresponding source file
3902 exists, this variable contains the name of source file, suitable for use
3903 by functions like `custom-save-all' which edit the init file. */);
3904 Vuser_init_file
= Qnil
;
3906 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3907 doc
: /* Used for internal purposes by `load'. */);
3908 Vcurrent_load_list
= Qnil
;
3910 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3911 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3912 The default is nil, which means use the function `read'. */);
3913 Vload_read_function
= Qnil
;
3915 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3916 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3917 This function is for doing code conversion before reading the source file.
3918 If nil, loading is done without any code conversion.
3919 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3920 FULLNAME is the full name of FILE.
3921 See `load' for the meaning of the remaining arguments. */);
3922 Vload_source_file_function
= Qnil
;
3924 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3925 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3926 This is useful when the file being loaded is a temporary copy. */);
3927 load_force_doc_strings
= 0;
3929 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3930 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3931 This is normally bound by `load' and `eval-buffer' to control `read',
3932 and is not meant for users to change. */);
3933 load_convert_to_unibyte
= 0;
3935 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3936 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3937 You cannot count on them to still be there! */);
3939 = Fexpand_file_name (build_string ("../"),
3940 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3942 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3943 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3944 Vpreloaded_file_list
= Qnil
;
3946 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3947 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3948 Vbyte_boolean_vars
= Qnil
;
3950 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3951 doc
: /* Non-nil means load dangerous compiled Lisp files.
3952 Some versions of XEmacs use different byte codes than Emacs. These
3953 incompatible byte codes can make Emacs crash when it tries to execute
3955 load_dangerous_libraries
= 0;
3957 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3958 doc
: /* Regular expression matching safe to load compiled Lisp files.
3959 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3960 from the file, and matches them against this regular expression.
3961 When the regular expression matches, the file is considered to be safe
3962 to load. See also `load-dangerous-libraries'. */);
3963 Vbytecomp_version_regexp
3964 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3966 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
3967 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
3968 Veval_buffer_list
= Qnil
;
3970 /* Vsource_directory was initialized in init_lread. */
3972 load_descriptor_list
= Qnil
;
3973 staticpro (&load_descriptor_list
);
3975 Qcurrent_load_list
= intern ("current-load-list");
3976 staticpro (&Qcurrent_load_list
);
3978 Qstandard_input
= intern ("standard-input");
3979 staticpro (&Qstandard_input
);
3981 Qread_char
= intern ("read-char");
3982 staticpro (&Qread_char
);
3984 Qget_file_char
= intern ("get-file-char");
3985 staticpro (&Qget_file_char
);
3987 Qbackquote
= intern ("`");
3988 staticpro (&Qbackquote
);
3989 Qcomma
= intern (",");
3990 staticpro (&Qcomma
);
3991 Qcomma_at
= intern (",@");
3992 staticpro (&Qcomma_at
);
3993 Qcomma_dot
= intern (",.");
3994 staticpro (&Qcomma_dot
);
3996 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3997 staticpro (&Qinhibit_file_name_operation
);
3999 Qascii_character
= intern ("ascii-character");
4000 staticpro (&Qascii_character
);
4002 Qfunction
= intern ("function");
4003 staticpro (&Qfunction
);
4005 Qload
= intern ("load");
4008 Qload_file_name
= intern ("load-file-name");
4009 staticpro (&Qload_file_name
);
4011 Qeval_buffer_list
= intern ("eval-buffer-list");
4012 staticpro (&Qeval_buffer_list
);
4014 staticpro (&dump_path
);
4016 staticpro (&read_objects
);
4017 read_objects
= Qnil
;
4018 staticpro (&seen_list
);
4021 Vloads_in_progress
= Qnil
;
4022 staticpro (&Vloads_in_progress
);
4025 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4026 (do not change this comment) */