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.
674 Loading a file records its definitions, and its `provide' and
675 `require' calls, in an element of `load-history' whose
676 car is the file name loaded. See `load-history'.
678 Return t if file exists. */)
679 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
680 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
682 register FILE *stream
;
683 register int fd
= -1;
684 int count
= SPECPDL_INDEX ();
686 struct gcpro gcpro1
, gcpro2
;
687 Lisp_Object found
, efound
;
688 /* 1 means we printed the ".el is newer" message. */
690 /* 1 means we are loading a compiled file. */
701 /* If file name is magic, call the handler. */
702 /* This shouldn't be necessary any more now that `openp' handles it right.
703 handler = Ffind_file_name_handler (file, Qload);
705 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
707 /* Do this after the handler to avoid
708 the need to gcpro noerror, nomessage and nosuffix.
709 (Below here, we care only whether they are nil or not.)
710 The presence of this call is the result of a historical accident:
711 it used to be in every file-operations and when it got removed
712 everywhere, it accidentally stayed here. Since then, enough people
713 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
714 that it seemed risky to remove. */
715 if (! NILP (noerror
))
717 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
718 Qt
, load_error_handler
);
723 file
= Fsubstitute_in_file_name (file
);
726 /* Avoid weird lossage with null string as arg,
727 since it would try to load a directory as a Lisp file */
728 if (SCHARS (file
) > 0)
730 int size
= SBYTES (file
);
734 GCPRO2 (file
, found
);
736 if (! NILP (must_suffix
))
738 /* Don't insist on adding a suffix if FILE already ends with one. */
740 && !strcmp (SDATA (file
) + size
- 3, ".el"))
743 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
745 /* Don't insist on adding a suffix
746 if the argument includes a directory name. */
747 else if (! NILP (Ffile_name_directory (file
)))
751 fd
= openp (Vload_path
, file
,
752 (!NILP (nosuffix
) ? Qnil
753 : !NILP (must_suffix
) ? Vload_suffixes
754 : Fappend (2, (tmp
[0] = Vload_suffixes
,
755 tmp
[1] = default_suffixes
,
764 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
765 Fcons (file
, Qnil
)));
770 /* Tell startup.el whether or not we found the user's init file. */
771 if (EQ (Qt
, Vuser_init_file
))
772 Vuser_init_file
= found
;
774 /* If FD is -2, that means openp found a magic file. */
777 if (NILP (Fequal (found
, file
)))
778 /* If FOUND is a different file name from FILE,
779 find its handler even if we have already inhibited
780 the `load' operation on FILE. */
781 handler
= Ffind_file_name_handler (found
, Qt
);
783 handler
= Ffind_file_name_handler (found
, Qload
);
784 if (! NILP (handler
))
785 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
788 /* Check if we're stuck in a recursive load cycle.
790 2000-09-21: It's not possible to just check for the file loaded
791 being a member of Vloads_in_progress. This fails because of the
792 way the byte compiler currently works; `provide's are not
793 evaluted, see font-lock.el/jit-lock.el as an example. This
794 leads to a certain amount of ``normal'' recursion.
796 Also, just loading a file recursively is not always an error in
797 the general case; the second load may do something different. */
801 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
802 if (!NILP (Fequal (found
, XCAR (tem
))))
805 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
806 Fcons (found
, Vloads_in_progress
)));
807 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
808 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
811 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
813 /* Load .elc files directly, but not when they are
814 remote and have no handler! */
821 GCPRO2 (file
, found
);
823 if (!safe_to_load_p (fd
))
826 if (!load_dangerous_libraries
)
830 error ("File `%s' was not compiled in Emacs",
833 else if (!NILP (nomessage
))
834 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
839 efound
= ENCODE_FILE (found
);
844 stat ((char *)SDATA (efound
), &s1
);
845 SSET (efound
, SBYTES (efound
) - 1, 0);
846 result
= stat ((char *)SDATA (efound
), &s2
);
847 SSET (efound
, SBYTES (efound
) - 1, 'c');
849 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
851 /* Make the progress messages mention that source is newer. */
854 /* If we won't print another message, mention this anyway. */
855 if (!NILP (nomessage
))
857 Lisp_Object msg_file
;
858 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
859 message_with_string ("Source file `%s' newer than byte-compiled file",
868 /* We are loading a source file (*.el). */
869 if (!NILP (Vload_source_file_function
))
875 val
= call4 (Vload_source_file_function
, found
, file
,
876 NILP (noerror
) ? Qnil
: Qt
,
877 NILP (nomessage
) ? Qnil
: Qt
);
878 return unbind_to (count
, val
);
882 GCPRO2 (file
, found
);
886 efound
= ENCODE_FILE (found
);
887 stream
= fopen ((char *) SDATA (efound
), fmode
);
888 #else /* not WINDOWSNT */
889 stream
= fdopen (fd
, fmode
);
890 #endif /* not WINDOWSNT */
894 error ("Failure to create stdio stream for %s", SDATA (file
));
897 if (! NILP (Vpurify_flag
))
898 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
900 if (NILP (nomessage
))
903 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
906 message_with_string ("Loading %s (source)...", file
, 1);
908 message_with_string ("Loading %s (compiled; note, source file is newer)...",
910 else /* The typical case; compiled file newer than source file. */
911 message_with_string ("Loading %s...", file
, 1);
914 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
915 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
916 specbind (Qload_file_name
, found
);
917 specbind (Qinhibit_file_name_operation
, Qnil
);
919 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
921 readevalloop (Qget_file_char
, stream
, (! NILP (Vpurify_flag
) ? file
: found
),
922 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
923 unbind_to (count
, Qnil
);
925 /* Run any load-hooks for this file. */
926 temp
= Fassoc (file
, Vafter_load_alist
);
928 Fprogn (Fcdr (temp
));
931 if (saved_doc_string
)
932 free (saved_doc_string
);
933 saved_doc_string
= 0;
934 saved_doc_string_size
= 0;
936 if (prev_saved_doc_string
)
937 xfree (prev_saved_doc_string
);
938 prev_saved_doc_string
= 0;
939 prev_saved_doc_string_size
= 0;
941 if (!noninteractive
&& NILP (nomessage
))
944 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
947 message_with_string ("Loading %s (source)...done", file
, 1);
949 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
951 else /* The typical case; compiled file newer than source file. */
952 message_with_string ("Loading %s...done", file
, 1);
955 if (!NILP (Fequal (build_string ("obsolete"),
956 Ffile_name_nondirectory
957 (Fdirectory_file_name (Ffile_name_directory (found
))))))
958 message_with_string ("Package %s is obsolete", file
, 1);
964 load_unwind (arg
) /* used as unwind-protect function in load */
967 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
970 if (--load_in_progress
< 0) load_in_progress
= 0;
975 load_descriptor_unwind (oldlist
)
978 load_descriptor_list
= oldlist
;
982 /* Close all descriptors in use for Floads.
983 This is used when starting a subprocess. */
990 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
991 emacs_close (XFASTINT (XCAR (tail
)));
996 complete_filename_p (pathname
)
997 Lisp_Object pathname
;
999 register const unsigned char *s
= SDATA (pathname
);
1000 return (IS_DIRECTORY_SEP (s
[0])
1001 || (SCHARS (pathname
) > 2
1002 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1012 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1013 doc
: /* Search for FILENAME through PATH.
1014 Returns the file's name in absolute form, or nil if not found.
1015 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1016 file name when searching.
1017 If non-nil, PREDICATE is used instead of `file-readable-p'.
1018 PREDICATE can also be an integer to pass to the access(2) function,
1019 in which case file-name-handlers are ignored. */)
1020 (filename
, path
, suffixes
, predicate
)
1021 Lisp_Object filename
, path
, suffixes
, predicate
;
1024 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1025 if (NILP (predicate
) && fd
> 0)
1031 /* Search for a file whose name is STR, looking in directories
1032 in the Lisp list PATH, and trying suffixes from SUFFIX.
1033 On success, returns a file descriptor. On failure, returns -1.
1035 SUFFIXES is a list of strings containing possible suffixes.
1036 The empty suffix is automatically added iff the list is empty.
1038 PREDICATE non-nil means don't open the files,
1039 just look for one that satisfies the predicate. In this case,
1040 returns 1 on success. The predicate can be a lisp function or
1041 an integer to pass to `access' (in which case file-name-handlers
1044 If STOREPTR is nonzero, it points to a slot where the name of
1045 the file actually found should be stored as a Lisp string.
1046 nil is stored there on failure.
1048 If the file we find is remote, return -2
1049 but store the found remote file name in *STOREPTR. */
1052 openp (path
, str
, suffixes
, storeptr
, predicate
)
1053 Lisp_Object path
, str
;
1054 Lisp_Object suffixes
;
1055 Lisp_Object
*storeptr
;
1056 Lisp_Object predicate
;
1061 register char *fn
= buf
;
1064 Lisp_Object filename
;
1066 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1067 Lisp_Object string
, tail
, encoded_fn
;
1068 int max_suffix_len
= 0;
1072 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1074 CHECK_STRING_CAR (tail
);
1075 max_suffix_len
= max (max_suffix_len
,
1076 SBYTES (XCAR (tail
)));
1079 string
= filename
= Qnil
;
1080 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1085 if (complete_filename_p (str
))
1088 for (; CONSP (path
); path
= XCDR (path
))
1090 filename
= Fexpand_file_name (str
, XCAR (path
));
1091 if (!complete_filename_p (filename
))
1092 /* If there are non-absolute elts in PATH (eg ".") */
1093 /* Of course, this could conceivably lose if luser sets
1094 default-directory to be something non-absolute... */
1096 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1097 if (!complete_filename_p (filename
))
1098 /* Give up on this path element! */
1102 /* Calculate maximum size of any filename made from
1103 this path element/specified file name and any possible suffix. */
1104 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1105 if (fn_size
< want_size
)
1106 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1108 /* Loop over suffixes. */
1109 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1110 CONSP (tail
); tail
= XCDR (tail
))
1112 int lsuffix
= SBYTES (XCAR (tail
));
1113 Lisp_Object handler
;
1116 /* Concatenate path element/specified name with the suffix.
1117 If the directory starts with /:, remove that. */
1118 if (SCHARS (filename
) > 2
1119 && SREF (filename
, 0) == '/'
1120 && SREF (filename
, 1) == ':')
1122 strncpy (fn
, SDATA (filename
) + 2,
1123 SBYTES (filename
) - 2);
1124 fn
[SBYTES (filename
) - 2] = 0;
1128 strncpy (fn
, SDATA (filename
),
1130 fn
[SBYTES (filename
)] = 0;
1133 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1134 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1136 /* Check that the file exists and is not a directory. */
1137 /* We used to only check for handlers on non-absolute file names:
1141 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1142 It's not clear why that was the case and it breaks things like
1143 (load "/bar.el") where the file is actually "/bar.el.gz". */
1144 string
= build_string (fn
);
1145 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1146 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1148 if (NILP (predicate
))
1149 exists
= !NILP (Ffile_readable_p (string
));
1151 exists
= !NILP (call1 (predicate
, string
));
1152 if (exists
&& !NILP (Ffile_directory_p (string
)))
1157 /* We succeeded; return this descriptor and filename. */
1168 encoded_fn
= ENCODE_FILE (string
);
1169 pfn
= SDATA (encoded_fn
);
1170 exists
= (stat (pfn
, &st
) >= 0
1171 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1174 /* Check that we can access or open it. */
1175 if (NATNUMP (predicate
))
1176 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1178 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1182 /* We succeeded; return this descriptor and filename. */
1200 /* Merge the list we've accumulated of globals from the current input source
1201 into the load_history variable. The details depend on whether
1202 the source has an associated file name or not.
1204 FILENAME is the file name that we are loading from.
1205 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1208 build_load_history (filename
, entire
)
1209 Lisp_Object filename
;
1212 register Lisp_Object tail
, prev
, newelt
;
1213 register Lisp_Object tem
, tem2
;
1214 register int foundit
= 0;
1216 tail
= Vload_history
;
1219 while (CONSP (tail
))
1223 /* Find the feature's previous assoc list... */
1224 if (!NILP (Fequal (filename
, Fcar (tem
))))
1228 /* If we're loading the entire file, remove old data. */
1232 Vload_history
= XCDR (tail
);
1234 Fsetcdr (prev
, XCDR (tail
));
1237 /* Otherwise, cons on new symbols that are not already members. */
1240 tem2
= Vcurrent_load_list
;
1242 while (CONSP (tem2
))
1244 newelt
= XCAR (tem2
);
1246 if (NILP (Fmember (newelt
, tem
)))
1247 Fsetcar (tail
, Fcons (XCAR (tem
),
1248 Fcons (newelt
, XCDR (tem
))));
1261 /* If we're loading an entire file, cons the new assoc onto the
1262 front of load-history, the most-recently-loaded position. Also
1263 do this if we didn't find an existing member for the file. */
1264 if (entire
|| !foundit
)
1265 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1270 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1278 readevalloop_1 (old
)
1281 load_convert_to_unibyte
= ! NILP (old
);
1285 /* Signal an `end-of-file' error, if possible with file name
1289 end_of_file_error ()
1293 if (STRINGP (Vload_file_name
))
1294 data
= Fcons (Vload_file_name
, Qnil
);
1298 Fsignal (Qend_of_file
, data
);
1301 /* UNIBYTE specifies how to set load_convert_to_unibyte
1302 for this invocation.
1303 READFUN, if non-nil, is used instead of `read'.
1304 START, END is region in current buffer (from eval-region). */
1307 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1308 printflag
, unibyte
, readfun
, start
, end
)
1309 Lisp_Object readcharfun
;
1311 Lisp_Object sourcename
;
1312 Lisp_Object (*evalfun
) ();
1314 Lisp_Object unibyte
, readfun
;
1315 Lisp_Object start
, end
;
1318 register Lisp_Object val
;
1319 int count
= SPECPDL_INDEX ();
1320 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1321 struct buffer
*b
= 0;
1322 int continue_reading_p
;
1324 if (BUFFERP (readcharfun
))
1325 b
= XBUFFER (readcharfun
);
1326 else if (MARKERP (readcharfun
))
1327 b
= XMARKER (readcharfun
)->buffer
;
1329 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1330 specbind (Qcurrent_load_list
, Qnil
);
1331 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1332 load_convert_to_unibyte
= !NILP (unibyte
);
1334 readchar_backlog
= -1;
1336 GCPRO4 (sourcename
, readfun
, start
, end
);
1338 LOADHIST_ATTACH (sourcename
);
1340 continue_reading_p
= 1;
1341 while (continue_reading_p
)
1343 int count1
= SPECPDL_INDEX ();
1345 if (b
!= 0 && NILP (b
->name
))
1346 error ("Reading from killed buffer");
1350 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1351 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1353 Fnarrow_to_region (make_number (BEGV
), end
);
1361 while ((c
= READCHAR
) != '\n' && c
!= -1);
1366 unbind_to (count1
, Qnil
);
1370 /* Ignore whitespace here, so we can detect eof. */
1371 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1374 if (!NILP (Vpurify_flag
) && c
== '(')
1376 record_unwind_protect (unreadpure
, Qnil
);
1377 val
= read_list (-1, readcharfun
);
1382 read_objects
= Qnil
;
1383 if (!NILP (readfun
))
1385 val
= call1 (readfun
, readcharfun
);
1387 /* If READCHARFUN has set point to ZV, we should
1388 stop reading, even if the form read sets point
1389 to a different value when evaluated. */
1390 if (BUFFERP (readcharfun
))
1392 struct buffer
*b
= XBUFFER (readcharfun
);
1393 if (BUF_PT (b
) == BUF_ZV (b
))
1394 continue_reading_p
= 0;
1397 else if (! NILP (Vload_read_function
))
1398 val
= call1 (Vload_read_function
, readcharfun
);
1400 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1403 if (!NILP (start
) && continue_reading_p
)
1404 start
= Fpoint_marker ();
1405 unbind_to (count1
, Qnil
);
1407 val
= (*evalfun
) (val
);
1411 Vvalues
= Fcons (val
, Vvalues
);
1412 if (EQ (Vstandard_output
, Qt
))
1419 build_load_history (sourcename
,
1420 stream
|| (INTEGERP (start
) && INTEGERP (end
)
1421 && XINT (start
) == BEG
&& XINT (end
) == Z
));
1425 unbind_to (count
, Qnil
);
1428 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1429 doc
: /* Execute the current buffer as Lisp code.
1430 Programs can pass two arguments, BUFFER and PRINTFLAG.
1431 BUFFER is the buffer to evaluate (nil means use current buffer).
1432 PRINTFLAG controls printing of output:
1433 nil means discard it; anything else is stream for print.
1435 If the optional third argument FILENAME is non-nil,
1436 it specifies the file name to use for `load-history'.
1437 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1438 for this invocation.
1440 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1441 `print' and related functions should work normally even if PRINTFLAG is nil.
1443 This function preserves the position of point. */)
1444 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1445 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1447 int count
= SPECPDL_INDEX ();
1448 Lisp_Object tem
, buf
;
1451 buf
= Fcurrent_buffer ();
1453 buf
= Fget_buffer (buffer
);
1455 error ("No such buffer");
1457 if (NILP (printflag
) && NILP (do_allow_print
))
1462 if (NILP (filename
))
1463 filename
= XBUFFER (buf
)->filename
;
1465 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1466 specbind (Qstandard_output
, tem
);
1467 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1468 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1469 readevalloop (buf
, 0, filename
, Feval
,
1470 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1471 unbind_to (count
, Qnil
);
1476 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1477 doc
: /* Execute the region as Lisp code.
1478 When called from programs, expects two arguments,
1479 giving starting and ending indices in the current buffer
1480 of the text to be executed.
1481 Programs can pass third argument PRINTFLAG which controls output:
1482 nil means discard it; anything else is stream for printing it.
1483 Also the fourth argument READ-FUNCTION, if non-nil, is used
1484 instead of `read' to read each expression. It gets one argument
1485 which is the input stream for reading characters.
1487 This function does not move point. */)
1488 (start
, end
, printflag
, read_function
)
1489 Lisp_Object start
, end
, printflag
, read_function
;
1491 int count
= SPECPDL_INDEX ();
1492 Lisp_Object tem
, cbuf
;
1494 cbuf
= Fcurrent_buffer ();
1496 if (NILP (printflag
))
1500 specbind (Qstandard_output
, tem
);
1501 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1503 /* readevalloop calls functions which check the type of start and end. */
1504 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1505 !NILP (printflag
), Qnil
, read_function
,
1508 return unbind_to (count
, Qnil
);
1512 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1513 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1514 If STREAM is nil, use the value of `standard-input' (which see).
1515 STREAM or the value of `standard-input' may be:
1516 a buffer (read from point and advance it)
1517 a marker (read from where it points and advance it)
1518 a function (call it with no arguments for each character,
1519 call it with a char as argument to push a char back)
1520 a string (takes text from string, starting at the beginning)
1521 t (read text line using minibuffer and use it, or read from
1522 standard input in batch mode). */)
1527 stream
= Vstandard_input
;
1528 if (EQ (stream
, Qt
))
1529 stream
= Qread_char
;
1530 if (EQ (stream
, Qread_char
))
1531 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1533 return read_internal_start (stream
, Qnil
, Qnil
);
1536 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1537 doc
: /* Read one Lisp expression which is represented as text by STRING.
1538 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1539 START and END optionally delimit a substring of STRING from which to read;
1540 they default to 0 and (length STRING) respectively. */)
1541 (string
, start
, end
)
1542 Lisp_Object string
, start
, end
;
1545 CHECK_STRING (string
);
1546 /* read_internal_start sets read_from_string_index. */
1547 ret
= read_internal_start (string
, start
, end
);
1548 return Fcons (ret
, make_number (read_from_string_index
));
1551 /* Function to set up the global context we need in toplevel read
1554 read_internal_start (stream
, start
, end
)
1556 Lisp_Object start
; /* Only used when stream is a string. */
1557 Lisp_Object end
; /* Only used when stream is a string. */
1561 readchar_backlog
= -1;
1563 new_backquote_flag
= 0;
1564 read_objects
= Qnil
;
1565 if (EQ (Vread_with_symbol_positions
, Qt
)
1566 || EQ (Vread_with_symbol_positions
, stream
))
1567 Vread_symbol_positions_list
= Qnil
;
1569 if (STRINGP (stream
))
1571 int startval
, endval
;
1573 endval
= SCHARS (stream
);
1577 endval
= XINT (end
);
1578 if (endval
< 0 || endval
> SCHARS (stream
))
1579 args_out_of_range (stream
, end
);
1586 CHECK_NUMBER (start
);
1587 startval
= XINT (start
);
1588 if (startval
< 0 || startval
> endval
)
1589 args_out_of_range (stream
, start
);
1591 read_from_string_index
= startval
;
1592 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1593 read_from_string_limit
= endval
;
1596 retval
= read0 (stream
);
1597 if (EQ (Vread_with_symbol_positions
, Qt
)
1598 || EQ (Vread_with_symbol_positions
, stream
))
1599 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1603 /* Use this for recursive reads, in contexts where internal tokens
1608 Lisp_Object readcharfun
;
1610 register Lisp_Object val
;
1613 val
= read1 (readcharfun
, &c
, 0);
1615 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1622 static int read_buffer_size
;
1623 static char *read_buffer
;
1625 /* Read multibyte form and return it as a character. C is a first
1626 byte of multibyte form, and rest of them are read from
1630 read_multibyte (c
, readcharfun
)
1632 Lisp_Object readcharfun
;
1634 /* We need the actual character code of this multibyte
1636 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1644 while ((c
= READCHAR
) >= 0xA0
1645 && len
< MAX_MULTIBYTE_LENGTH
)
1651 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1652 return STRING_CHAR (str
, len
);
1653 /* The byte sequence is not valid as multibyte. Unread all bytes
1654 but the first one, and return the first byte. */
1660 /* Read a \-escape sequence, assuming we already read the `\'.
1661 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1662 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1663 Otherwise store 0 into *BYTEREP. */
1666 read_escape (readcharfun
, stringp
, byterep
)
1667 Lisp_Object readcharfun
;
1671 register int c
= READCHAR
;
1678 end_of_file_error ();
1708 error ("Invalid escape character syntax");
1711 c
= read_escape (readcharfun
, 0, byterep
);
1712 return c
| meta_modifier
;
1717 error ("Invalid escape character syntax");
1720 c
= read_escape (readcharfun
, 0, byterep
);
1721 return c
| shift_modifier
;
1726 error ("Invalid escape character syntax");
1729 c
= read_escape (readcharfun
, 0, byterep
);
1730 return c
| hyper_modifier
;
1735 error ("Invalid escape character syntax");
1738 c
= read_escape (readcharfun
, 0, byterep
);
1739 return c
| alt_modifier
;
1750 c
= read_escape (readcharfun
, 0, byterep
);
1751 return c
| super_modifier
;
1756 error ("Invalid escape character syntax");
1760 c
= read_escape (readcharfun
, 0, byterep
);
1761 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1762 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1763 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1764 return c
| ctrl_modifier
;
1765 /* ASCII control chars are made from letters (both cases),
1766 as well as the non-letters within 0100...0137. */
1767 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1768 return (c
& (037 | ~0177));
1769 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1770 return (c
& (037 | ~0177));
1772 return c
| ctrl_modifier
;
1782 /* An octal escape, as in ANSI C. */
1784 register int i
= c
- '0';
1785 register int count
= 0;
1788 if ((c
= READCHAR
) >= '0' && c
<= '7')
1805 /* A hex escape, as in ANSI C. */
1811 if (c
>= '0' && c
<= '9')
1816 else if ((c
>= 'a' && c
<= 'f')
1817 || (c
>= 'A' && c
<= 'F'))
1820 if (c
>= 'a' && c
<= 'f')
1837 if (BASE_LEADING_CODE_P (c
))
1838 c
= read_multibyte (c
, readcharfun
);
1844 /* Read an integer in radix RADIX using READCHARFUN to read
1845 characters. RADIX must be in the interval [2..36]; if it isn't, a
1846 read error is signaled . Value is the integer read. Signals an
1847 error if encountering invalid read syntax or if RADIX is out of
1851 read_integer (readcharfun
, radix
)
1852 Lisp_Object readcharfun
;
1855 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1856 EMACS_INT number
= 0;
1858 if (radix
< 2 || radix
> 36)
1862 number
= ndigits
= invalid_p
= 0;
1878 if (c
>= '0' && c
<= '9')
1880 else if (c
>= 'a' && c
<= 'z')
1881 digit
= c
- 'a' + 10;
1882 else if (c
>= 'A' && c
<= 'Z')
1883 digit
= c
- 'A' + 10;
1890 if (digit
< 0 || digit
>= radix
)
1893 number
= radix
* number
+ digit
;
1899 if (ndigits
== 0 || invalid_p
)
1902 sprintf (buf
, "integer, radix %d", radix
);
1903 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1906 return make_number (sign
* number
);
1910 /* Convert unibyte text in read_buffer to multibyte.
1912 Initially, *P is a pointer after the end of the unibyte text, and
1913 the pointer *END points after the end of read_buffer.
1915 If read_buffer doesn't have enough room to hold the result
1916 of the conversion, reallocate it and adjust *P and *END.
1918 At the end, make *P point after the result of the conversion, and
1919 return in *NCHARS the number of characters in the converted
1923 to_multibyte (p
, end
, nchars
)
1929 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1930 if (read_buffer_size
< 2 * nbytes
)
1932 int offset
= *p
- read_buffer
;
1933 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1934 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1935 *p
= read_buffer
+ offset
;
1936 *end
= read_buffer
+ read_buffer_size
;
1939 if (nbytes
!= *nchars
)
1940 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1941 *p
- read_buffer
, nchars
);
1943 *p
= read_buffer
+ nbytes
;
1947 /* If the next token is ')' or ']' or '.', we store that character
1948 in *PCH and the return value is not interesting. Else, we store
1949 zero in *PCH and we read and return one lisp object.
1951 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1954 read1 (readcharfun
, pch
, first_in_list
)
1955 register Lisp_Object readcharfun
;
1960 int uninterned_symbol
= 0;
1968 end_of_file_error ();
1973 return read_list (0, readcharfun
);
1976 return read_vector (readcharfun
, 0);
1993 tmp
= read_vector (readcharfun
, 0);
1994 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1995 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1996 error ("Invalid size char-table");
1997 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1998 XCHAR_TABLE (tmp
)->top
= Qt
;
2007 tmp
= read_vector (readcharfun
, 0);
2008 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2009 error ("Invalid size char-table");
2010 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2011 XCHAR_TABLE (tmp
)->top
= Qnil
;
2014 Fsignal (Qinvalid_read_syntax
,
2015 Fcons (make_string ("#^^", 3), Qnil
));
2017 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2022 length
= read1 (readcharfun
, pch
, first_in_list
);
2026 Lisp_Object tmp
, val
;
2028 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2029 / BOOL_VECTOR_BITS_PER_CHAR
);
2032 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2033 if (size_in_chars
!= SCHARS (tmp
)
2034 /* We used to print 1 char too many
2035 when the number of bits was a multiple of 8.
2036 Accept such input in case it came from an old version. */
2037 && ! (XFASTINT (length
)
2038 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2039 Fsignal (Qinvalid_read_syntax
,
2040 Fcons (make_string ("#&...", 5), Qnil
));
2042 val
= Fmake_bool_vector (length
, Qnil
);
2043 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2045 /* Clear the extraneous bits in the last byte. */
2046 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2047 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2048 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2051 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2056 /* Accept compiled functions at read-time so that we don't have to
2057 build them using function calls. */
2059 tmp
= read_vector (readcharfun
, 1);
2060 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2061 XVECTOR (tmp
)->contents
);
2066 struct gcpro gcpro1
;
2069 /* Read the string itself. */
2070 tmp
= read1 (readcharfun
, &ch
, 0);
2071 if (ch
!= 0 || !STRINGP (tmp
))
2072 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2074 /* Read the intervals and their properties. */
2077 Lisp_Object beg
, end
, plist
;
2079 beg
= read1 (readcharfun
, &ch
, 0);
2084 end
= read1 (readcharfun
, &ch
, 0);
2086 plist
= read1 (readcharfun
, &ch
, 0);
2088 Fsignal (Qinvalid_read_syntax
,
2089 Fcons (build_string ("invalid string property list"),
2091 Fset_text_properties (beg
, end
, plist
, tmp
);
2097 /* #@NUMBER is used to skip NUMBER following characters.
2098 That's used in .elc files to skip over doc strings
2099 and function definitions. */
2104 /* Read a decimal integer. */
2105 while ((c
= READCHAR
) >= 0
2106 && c
>= '0' && c
<= '9')
2114 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2116 /* If we are supposed to force doc strings into core right now,
2117 record the last string that we skipped,
2118 and record where in the file it comes from. */
2120 /* But first exchange saved_doc_string
2121 with prev_saved_doc_string, so we save two strings. */
2123 char *temp
= saved_doc_string
;
2124 int temp_size
= saved_doc_string_size
;
2125 file_offset temp_pos
= saved_doc_string_position
;
2126 int temp_len
= saved_doc_string_length
;
2128 saved_doc_string
= prev_saved_doc_string
;
2129 saved_doc_string_size
= prev_saved_doc_string_size
;
2130 saved_doc_string_position
= prev_saved_doc_string_position
;
2131 saved_doc_string_length
= prev_saved_doc_string_length
;
2133 prev_saved_doc_string
= temp
;
2134 prev_saved_doc_string_size
= temp_size
;
2135 prev_saved_doc_string_position
= temp_pos
;
2136 prev_saved_doc_string_length
= temp_len
;
2139 if (saved_doc_string_size
== 0)
2141 saved_doc_string_size
= nskip
+ 100;
2142 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2144 if (nskip
> saved_doc_string_size
)
2146 saved_doc_string_size
= nskip
+ 100;
2147 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2148 saved_doc_string_size
);
2151 saved_doc_string_position
= file_tell (instream
);
2153 /* Copy that many characters into saved_doc_string. */
2154 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2155 saved_doc_string
[i
] = c
= READCHAR
;
2157 saved_doc_string_length
= i
;
2161 /* Skip that many characters. */
2162 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2170 /* #! appears at the beginning of an executable file.
2171 Skip the first line. */
2172 while (c
!= '\n' && c
>= 0)
2177 return Vload_file_name
;
2179 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2180 /* #:foo is the uninterned symbol named foo. */
2183 uninterned_symbol
= 1;
2187 /* Reader forms that can reuse previously read objects. */
2188 if (c
>= '0' && c
<= '9')
2193 /* Read a non-negative integer. */
2194 while (c
>= '0' && c
<= '9')
2200 /* #n=object returns object, but associates it with n for #n#. */
2203 /* Make a placeholder for #n# to use temporarily */
2204 Lisp_Object placeholder
;
2207 placeholder
= Fcons(Qnil
, Qnil
);
2208 cell
= Fcons (make_number (n
), placeholder
);
2209 read_objects
= Fcons (cell
, read_objects
);
2211 /* Read the object itself. */
2212 tem
= read0 (readcharfun
);
2214 /* Now put it everywhere the placeholder was... */
2215 substitute_object_in_subtree (tem
, placeholder
);
2217 /* ...and #n# will use the real value from now on. */
2218 Fsetcdr (cell
, tem
);
2222 /* #n# returns a previously read object. */
2225 tem
= Fassq (make_number (n
), read_objects
);
2228 /* Fall through to error message. */
2230 else if (c
== 'r' || c
== 'R')
2231 return read_integer (readcharfun
, n
);
2233 /* Fall through to error message. */
2235 else if (c
== 'x' || c
== 'X')
2236 return read_integer (readcharfun
, 16);
2237 else if (c
== 'o' || c
== 'O')
2238 return read_integer (readcharfun
, 8);
2239 else if (c
== 'b' || c
== 'B')
2240 return read_integer (readcharfun
, 2);
2243 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2246 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2251 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2261 new_backquote_flag
++;
2262 value
= read0 (readcharfun
);
2263 new_backquote_flag
--;
2265 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2269 if (new_backquote_flag
)
2271 Lisp_Object comma_type
= Qnil
;
2276 comma_type
= Qcomma_at
;
2278 comma_type
= Qcomma_dot
;
2281 if (ch
>= 0) UNREAD (ch
);
2282 comma_type
= Qcomma
;
2285 new_backquote_flag
--;
2286 value
= read0 (readcharfun
);
2287 new_backquote_flag
++;
2288 return Fcons (comma_type
, Fcons (value
, Qnil
));
2301 end_of_file_error ();
2303 /* Accept `single space' syntax like (list ? x) where the
2304 whitespace character is SPC or TAB.
2305 Other literal whitespace like NL, CR, and FF are not accepted,
2306 as there are well-established escape sequences for these. */
2307 if (c
== ' ' || c
== '\t')
2308 return make_number (c
);
2311 c
= read_escape (readcharfun
, 0, &discard
);
2312 else if (BASE_LEADING_CODE_P (c
))
2313 c
= read_multibyte (c
, readcharfun
);
2315 next_char
= READCHAR
;
2316 if (next_char
== '.')
2318 /* Only a dotted-pair dot is valid after a char constant. */
2319 int next_next_char
= READCHAR
;
2320 UNREAD (next_next_char
);
2322 ok
= (next_next_char
<= 040
2323 || (next_next_char
< 0200
2324 && (index ("\"';([#?", next_next_char
)
2325 || (!first_in_list
&& next_next_char
== '`')
2326 || (new_backquote_flag
&& next_next_char
== ','))));
2330 ok
= (next_char
<= 040
2331 || (next_char
< 0200
2332 && (index ("\"';()[]#?", next_char
)
2333 || (!first_in_list
&& next_char
== '`')
2334 || (new_backquote_flag
&& next_char
== ','))));
2338 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2340 return make_number (c
);
2345 char *p
= read_buffer
;
2346 char *end
= read_buffer
+ read_buffer_size
;
2348 /* 1 if we saw an escape sequence specifying
2349 a multibyte character, or a multibyte character. */
2350 int force_multibyte
= 0;
2351 /* 1 if we saw an escape sequence specifying
2352 a single-byte character. */
2353 int force_singlebyte
= 0;
2354 /* 1 if read_buffer contains multibyte text now. */
2355 int is_multibyte
= 0;
2359 while ((c
= READCHAR
) >= 0
2362 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2364 int offset
= p
- read_buffer
;
2365 read_buffer
= (char *) xrealloc (read_buffer
,
2366 read_buffer_size
*= 2);
2367 p
= read_buffer
+ offset
;
2368 end
= read_buffer
+ read_buffer_size
;
2375 c
= read_escape (readcharfun
, 1, &byterep
);
2377 /* C is -1 if \ newline has just been seen */
2380 if (p
== read_buffer
)
2386 force_singlebyte
= 1;
2387 else if (byterep
== 2)
2388 force_multibyte
= 1;
2391 /* A character that must be multibyte forces multibyte. */
2392 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2393 force_multibyte
= 1;
2395 /* If we just discovered the need to be multibyte,
2396 convert the text accumulated thus far. */
2397 if (force_multibyte
&& ! is_multibyte
)
2400 to_multibyte (&p
, &end
, &nchars
);
2403 /* Allow `\C- ' and `\C-?'. */
2404 if (c
== (CHAR_CTL
| ' '))
2406 else if (c
== (CHAR_CTL
| '?'))
2411 /* Shift modifier is valid only with [A-Za-z]. */
2412 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2414 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2415 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2419 /* Move the meta bit to the right place for a string. */
2420 c
= (c
& ~CHAR_META
) | 0x80;
2421 if (c
& CHAR_MODIFIER_MASK
)
2422 error ("Invalid modifier in string");
2425 p
+= CHAR_STRING (c
, p
);
2433 end_of_file_error ();
2435 /* If purifying, and string starts with \ newline,
2436 return zero instead. This is for doc strings
2437 that we are really going to find in etc/DOC.nn.nn */
2438 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2439 return make_number (0);
2441 if (is_multibyte
|| force_singlebyte
)
2443 else if (load_convert_to_unibyte
)
2446 to_multibyte (&p
, &end
, &nchars
);
2447 if (p
- read_buffer
!= nchars
)
2449 string
= make_multibyte_string (read_buffer
, nchars
,
2451 return Fstring_make_unibyte (string
);
2453 /* We can make a unibyte string directly. */
2456 else if (EQ (readcharfun
, Qget_file_char
)
2457 || EQ (readcharfun
, Qlambda
))
2459 /* Nowadays, reading directly from a file is used only for
2460 compiled Emacs Lisp files, and those always use the
2461 Emacs internal encoding. Meanwhile, Qlambda is used
2462 for reading dynamic byte code (compiled with
2463 byte-compile-dynamic = t). So make the string multibyte
2464 if the string contains any multibyte sequences.
2465 (to_multibyte is a no-op if not.) */
2466 to_multibyte (&p
, &end
, &nchars
);
2467 is_multibyte
= (p
- read_buffer
) != nchars
;
2470 /* In all other cases, if we read these bytes as
2471 separate characters, treat them as separate characters now. */
2474 /* We want readchar_count to be the number of characters, not
2475 bytes. Hence we adjust for multibyte characters in the
2476 string. ... But it doesn't seem to be necessary, because
2477 READCHAR *does* read multibyte characters from buffers. */
2478 /* readchar_count -= (p - read_buffer) - nchars; */
2480 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2482 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2488 int next_char
= READCHAR
;
2491 if (next_char
<= 040
2492 || (next_char
< 0200
2493 && (index ("\"';([#?", next_char
)
2494 || (!first_in_list
&& next_char
== '`')
2495 || (new_backquote_flag
&& next_char
== ','))))
2501 /* Otherwise, we fall through! Note that the atom-reading loop
2502 below will now loop at least once, assuring that we will not
2503 try to UNREAD two characters in a row. */
2507 if (c
<= 040) goto retry
;
2509 char *p
= read_buffer
;
2513 char *end
= read_buffer
+ read_buffer_size
;
2517 || (!index ("\"';()[]#", c
)
2518 && !(!first_in_list
&& c
== '`')
2519 && !(new_backquote_flag
&& c
== ','))))
2521 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2523 int offset
= p
- read_buffer
;
2524 read_buffer
= (char *) xrealloc (read_buffer
,
2525 read_buffer_size
*= 2);
2526 p
= read_buffer
+ offset
;
2527 end
= read_buffer
+ read_buffer_size
;
2534 end_of_file_error ();
2538 if (! SINGLE_BYTE_CHAR_P (c
))
2539 p
+= CHAR_STRING (c
, p
);
2548 int offset
= p
- read_buffer
;
2549 read_buffer
= (char *) xrealloc (read_buffer
,
2550 read_buffer_size
*= 2);
2551 p
= read_buffer
+ offset
;
2552 end
= read_buffer
+ read_buffer_size
;
2559 if (!quoted
&& !uninterned_symbol
)
2562 register Lisp_Object val
;
2564 if (*p1
== '+' || *p1
== '-') p1
++;
2565 /* Is it an integer? */
2568 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2569 /* Integers can have trailing decimal points. */
2570 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2572 /* It is an integer. */
2576 if (sizeof (int) == sizeof (EMACS_INT
))
2577 XSETINT (val
, atoi (read_buffer
));
2578 else if (sizeof (long) == sizeof (EMACS_INT
))
2579 XSETINT (val
, atol (read_buffer
));
2585 if (isfloat_string (read_buffer
))
2587 /* Compute NaN and infinities using 0.0 in a variable,
2588 to cope with compilers that think they are smarter
2594 /* Negate the value ourselves. This treats 0, NaNs,
2595 and infinity properly on IEEE floating point hosts,
2596 and works around a common bug where atof ("-0.0")
2598 int negative
= read_buffer
[0] == '-';
2600 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2601 returns 1, is if the input ends in e+INF or e+NaN. */
2608 value
= zero
/ zero
;
2610 /* If that made a "negative" NaN, negate it. */
2614 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2617 u_minus_zero
.d
= - 0.0;
2618 for (i
= 0; i
< sizeof (double); i
++)
2619 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2625 /* Now VALUE is a positive NaN. */
2628 value
= atof (read_buffer
+ negative
);
2632 return make_float (negative
? - value
: value
);
2636 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2637 : intern (read_buffer
);
2638 if (EQ (Vread_with_symbol_positions
, Qt
)
2639 || EQ (Vread_with_symbol_positions
, readcharfun
))
2640 Vread_symbol_positions_list
=
2641 /* Kind of a hack; this will probably fail if characters
2642 in the symbol name were escaped. Not really a big
2644 Fcons (Fcons (result
,
2645 make_number (readchar_count
2646 - XFASTINT (Flength (Fsymbol_name (result
))))),
2647 Vread_symbol_positions_list
);
2655 /* List of nodes we've seen during substitute_object_in_subtree. */
2656 static Lisp_Object seen_list
;
2659 substitute_object_in_subtree (object
, placeholder
)
2661 Lisp_Object placeholder
;
2663 Lisp_Object check_object
;
2665 /* We haven't seen any objects when we start. */
2668 /* Make all the substitutions. */
2670 = substitute_object_recurse (object
, placeholder
, object
);
2672 /* Clear seen_list because we're done with it. */
2675 /* The returned object here is expected to always eq the
2677 if (!EQ (check_object
, object
))
2678 error ("Unexpected mutation error in reader");
2681 /* Feval doesn't get called from here, so no gc protection is needed. */
2682 #define SUBSTITUTE(get_val, set_val) \
2684 Lisp_Object old_value = get_val; \
2685 Lisp_Object true_value \
2686 = substitute_object_recurse (object, placeholder,\
2689 if (!EQ (old_value, true_value)) \
2696 substitute_object_recurse (object
, placeholder
, subtree
)
2698 Lisp_Object placeholder
;
2699 Lisp_Object subtree
;
2701 /* If we find the placeholder, return the target object. */
2702 if (EQ (placeholder
, subtree
))
2705 /* If we've been to this node before, don't explore it again. */
2706 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2709 /* If this node can be the entry point to a cycle, remember that
2710 we've seen it. It can only be such an entry point if it was made
2711 by #n=, which means that we can find it as a value in
2713 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2714 seen_list
= Fcons (subtree
, seen_list
);
2716 /* Recurse according to subtree's type.
2717 Every branch must return a Lisp_Object. */
2718 switch (XTYPE (subtree
))
2720 case Lisp_Vectorlike
:
2723 int length
= XINT (Flength(subtree
));
2724 for (i
= 0; i
< length
; i
++)
2726 Lisp_Object idx
= make_number (i
);
2727 SUBSTITUTE (Faref (subtree
, idx
),
2728 Faset (subtree
, idx
, true_value
));
2735 SUBSTITUTE (Fcar_safe (subtree
),
2736 Fsetcar (subtree
, true_value
));
2737 SUBSTITUTE (Fcdr_safe (subtree
),
2738 Fsetcdr (subtree
, true_value
));
2744 /* Check for text properties in each interval.
2745 substitute_in_interval contains part of the logic. */
2747 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2748 Lisp_Object arg
= Fcons (object
, placeholder
);
2750 traverse_intervals_noorder (root_interval
,
2751 &substitute_in_interval
, arg
);
2756 /* Other types don't recurse any further. */
2762 /* Helper function for substitute_object_recurse. */
2764 substitute_in_interval (interval
, arg
)
2768 Lisp_Object object
= Fcar (arg
);
2769 Lisp_Object placeholder
= Fcdr (arg
);
2771 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2790 if (*cp
== '+' || *cp
== '-')
2793 if (*cp
>= '0' && *cp
<= '9')
2796 while (*cp
>= '0' && *cp
<= '9')
2804 if (*cp
>= '0' && *cp
<= '9')
2807 while (*cp
>= '0' && *cp
<= '9')
2810 if (*cp
== 'e' || *cp
== 'E')
2814 if (*cp
== '+' || *cp
== '-')
2818 if (*cp
>= '0' && *cp
<= '9')
2821 while (*cp
>= '0' && *cp
<= '9')
2824 else if (cp
== start
)
2826 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2831 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2837 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2838 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2839 || state
== (DOT_CHAR
|TRAIL_INT
)
2840 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2841 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2842 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2847 read_vector (readcharfun
, bytecodeflag
)
2848 Lisp_Object readcharfun
;
2853 register Lisp_Object
*ptr
;
2854 register Lisp_Object tem
, item
, vector
;
2855 register struct Lisp_Cons
*otem
;
2858 tem
= read_list (1, readcharfun
);
2859 len
= Flength (tem
);
2860 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2862 size
= XVECTOR (vector
)->size
;
2863 ptr
= XVECTOR (vector
)->contents
;
2864 for (i
= 0; i
< size
; i
++)
2867 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2868 bytecode object, the docstring containing the bytecode and
2869 constants values must be treated as unibyte and passed to
2870 Fread, to get the actual bytecode string and constants vector. */
2871 if (bytecodeflag
&& load_force_doc_strings
)
2873 if (i
== COMPILED_BYTECODE
)
2875 if (!STRINGP (item
))
2876 error ("Invalid byte code");
2878 /* Delay handling the bytecode slot until we know whether
2879 it is lazily-loaded (we can tell by whether the
2880 constants slot is nil). */
2881 ptr
[COMPILED_CONSTANTS
] = item
;
2884 else if (i
== COMPILED_CONSTANTS
)
2886 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2890 /* Coerce string to unibyte (like string-as-unibyte,
2891 but without generating extra garbage and
2892 guaranteeing no change in the contents). */
2893 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2894 STRING_SET_UNIBYTE (bytestr
);
2896 item
= Fread (bytestr
);
2898 error ("Invalid byte code");
2900 otem
= XCONS (item
);
2901 bytestr
= XCAR (item
);
2906 /* Now handle the bytecode slot. */
2907 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2910 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2918 /* FLAG = 1 means check for ] to terminate rather than ) and .
2919 FLAG = -1 means check for starting with defun
2920 and make structure pure. */
2923 read_list (flag
, readcharfun
)
2925 register Lisp_Object readcharfun
;
2927 /* -1 means check next element for defun,
2928 0 means don't check,
2929 1 means already checked and found defun. */
2930 int defunflag
= flag
< 0 ? -1 : 0;
2931 Lisp_Object val
, tail
;
2932 register Lisp_Object elt
, tem
;
2933 struct gcpro gcpro1
, gcpro2
;
2934 /* 0 is the normal case.
2935 1 means this list is a doc reference; replace it with the number 0.
2936 2 means this list is a doc reference; replace it with the doc string. */
2937 int doc_reference
= 0;
2939 /* Initialize this to 1 if we are reading a list. */
2940 int first_in_list
= flag
<= 0;
2949 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2954 /* While building, if the list starts with #$, treat it specially. */
2955 if (EQ (elt
, Vload_file_name
)
2957 && !NILP (Vpurify_flag
))
2959 if (NILP (Vdoc_file_name
))
2960 /* We have not yet called Snarf-documentation, so assume
2961 this file is described in the DOC-MM.NN file
2962 and Snarf-documentation will fill in the right value later.
2963 For now, replace the whole list with 0. */
2966 /* We have already called Snarf-documentation, so make a relative
2967 file name for this file, so it can be found properly
2968 in the installed Lisp directory.
2969 We don't use Fexpand_file_name because that would make
2970 the directory absolute now. */
2971 elt
= concat2 (build_string ("../lisp/"),
2972 Ffile_name_nondirectory (elt
));
2974 else if (EQ (elt
, Vload_file_name
)
2976 && load_force_doc_strings
)
2985 Fsignal (Qinvalid_read_syntax
,
2986 Fcons (make_string (") or . in a vector", 18), Qnil
));
2994 XSETCDR (tail
, read0 (readcharfun
));
2996 val
= read0 (readcharfun
);
2997 read1 (readcharfun
, &ch
, 0);
3001 if (doc_reference
== 1)
3002 return make_number (0);
3003 if (doc_reference
== 2)
3005 /* Get a doc string from the file we are loading.
3006 If it's in saved_doc_string, get it from there. */
3007 int pos
= XINT (XCDR (val
));
3008 /* Position is negative for user variables. */
3009 if (pos
< 0) pos
= -pos
;
3010 if (pos
>= saved_doc_string_position
3011 && pos
< (saved_doc_string_position
3012 + saved_doc_string_length
))
3014 int start
= pos
- saved_doc_string_position
;
3017 /* Process quoting with ^A,
3018 and find the end of the string,
3019 which is marked with ^_ (037). */
3020 for (from
= start
, to
= start
;
3021 saved_doc_string
[from
] != 037;)
3023 int c
= saved_doc_string
[from
++];
3026 c
= saved_doc_string
[from
++];
3028 saved_doc_string
[to
++] = c
;
3030 saved_doc_string
[to
++] = 0;
3032 saved_doc_string
[to
++] = 037;
3035 saved_doc_string
[to
++] = c
;
3038 return make_string (saved_doc_string
+ start
,
3041 /* Look in prev_saved_doc_string the same way. */
3042 else if (pos
>= prev_saved_doc_string_position
3043 && pos
< (prev_saved_doc_string_position
3044 + prev_saved_doc_string_length
))
3046 int start
= pos
- prev_saved_doc_string_position
;
3049 /* Process quoting with ^A,
3050 and find the end of the string,
3051 which is marked with ^_ (037). */
3052 for (from
= start
, to
= start
;
3053 prev_saved_doc_string
[from
] != 037;)
3055 int c
= prev_saved_doc_string
[from
++];
3058 c
= prev_saved_doc_string
[from
++];
3060 prev_saved_doc_string
[to
++] = c
;
3062 prev_saved_doc_string
[to
++] = 0;
3064 prev_saved_doc_string
[to
++] = 037;
3067 prev_saved_doc_string
[to
++] = c
;
3070 return make_string (prev_saved_doc_string
+ start
,
3074 return get_doc_string (val
, 0, 0);
3079 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3081 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3083 tem
= (read_pure
&& flag
<= 0
3084 ? pure_cons (elt
, Qnil
)
3085 : Fcons (elt
, Qnil
));
3087 XSETCDR (tail
, tem
);
3092 defunflag
= EQ (elt
, Qdefun
);
3093 else if (defunflag
> 0)
3098 Lisp_Object Vobarray
;
3099 Lisp_Object initial_obarray
;
3101 /* oblookup stores the bucket number here, for the sake of Funintern. */
3103 int oblookup_last_bucket_number
;
3105 static int hash_string ();
3107 /* Get an error if OBARRAY is not an obarray.
3108 If it is one, return it. */
3111 check_obarray (obarray
)
3112 Lisp_Object obarray
;
3114 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3116 /* If Vobarray is now invalid, force it to be valid. */
3117 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3119 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3124 /* Intern the C string STR: return a symbol with that name,
3125 interned in the current obarray. */
3132 int len
= strlen (str
);
3133 Lisp_Object obarray
;
3136 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3137 obarray
= check_obarray (obarray
);
3138 tem
= oblookup (obarray
, str
, len
, len
);
3141 return Fintern (make_string (str
, len
), obarray
);
3144 /* Create an uninterned symbol with name STR. */
3150 int len
= strlen (str
);
3152 return Fmake_symbol ((!NILP (Vpurify_flag
)
3153 ? make_pure_string (str
, len
, len
, 0)
3154 : make_string (str
, len
)));
3157 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3158 doc
: /* Return the canonical symbol whose name is STRING.
3159 If there is none, one is created by this function and returned.
3160 A second optional argument specifies the obarray to use;
3161 it defaults to the value of `obarray'. */)
3163 Lisp_Object string
, obarray
;
3165 register Lisp_Object tem
, sym
, *ptr
;
3167 if (NILP (obarray
)) obarray
= Vobarray
;
3168 obarray
= check_obarray (obarray
);
3170 CHECK_STRING (string
);
3172 tem
= oblookup (obarray
, SDATA (string
),
3175 if (!INTEGERP (tem
))
3178 if (!NILP (Vpurify_flag
))
3179 string
= Fpurecopy (string
);
3180 sym
= Fmake_symbol (string
);
3182 if (EQ (obarray
, initial_obarray
))
3183 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3185 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3187 if ((SREF (string
, 0) == ':')
3188 && EQ (obarray
, initial_obarray
))
3190 XSYMBOL (sym
)->constant
= 1;
3191 XSYMBOL (sym
)->value
= sym
;
3194 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3196 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3198 XSYMBOL (sym
)->next
= 0;
3203 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3204 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3205 NAME may be a string or a symbol. If it is a symbol, that exact
3206 symbol is searched for.
3207 A second optional argument specifies the obarray to use;
3208 it defaults to the value of `obarray'. */)
3210 Lisp_Object name
, obarray
;
3212 register Lisp_Object tem
, string
;
3214 if (NILP (obarray
)) obarray
= Vobarray
;
3215 obarray
= check_obarray (obarray
);
3217 if (!SYMBOLP (name
))
3219 CHECK_STRING (name
);
3223 string
= SYMBOL_NAME (name
);
3225 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3226 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3232 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3233 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3234 The value is t if a symbol was found and deleted, nil otherwise.
3235 NAME may be a string or a symbol. If it is a symbol, that symbol
3236 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3237 OBARRAY defaults to the value of the variable `obarray'. */)
3239 Lisp_Object name
, obarray
;
3241 register Lisp_Object string
, tem
;
3244 if (NILP (obarray
)) obarray
= Vobarray
;
3245 obarray
= check_obarray (obarray
);
3248 string
= SYMBOL_NAME (name
);
3251 CHECK_STRING (name
);
3255 tem
= oblookup (obarray
, SDATA (string
),
3260 /* If arg was a symbol, don't delete anything but that symbol itself. */
3261 if (SYMBOLP (name
) && !EQ (name
, tem
))
3264 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3265 XSYMBOL (tem
)->constant
= 0;
3266 XSYMBOL (tem
)->indirect_variable
= 0;
3268 hash
= oblookup_last_bucket_number
;
3270 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3272 if (XSYMBOL (tem
)->next
)
3273 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3275 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3279 Lisp_Object tail
, following
;
3281 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3282 XSYMBOL (tail
)->next
;
3285 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3286 if (EQ (following
, tem
))
3288 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3297 /* Return the symbol in OBARRAY whose names matches the string
3298 of SIZE characters (SIZE_BYTE bytes) at PTR.
3299 If there is no such symbol in OBARRAY, return nil.
3301 Also store the bucket number in oblookup_last_bucket_number. */
3304 oblookup (obarray
, ptr
, size
, size_byte
)
3305 Lisp_Object obarray
;
3306 register const char *ptr
;
3307 int size
, size_byte
;
3311 register Lisp_Object tail
;
3312 Lisp_Object bucket
, tem
;
3314 if (!VECTORP (obarray
)
3315 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3317 obarray
= check_obarray (obarray
);
3318 obsize
= XVECTOR (obarray
)->size
;
3320 /* This is sometimes needed in the middle of GC. */
3321 obsize
&= ~ARRAY_MARK_FLAG
;
3322 /* Combining next two lines breaks VMS C 2.3. */
3323 hash
= hash_string (ptr
, size_byte
);
3325 bucket
= XVECTOR (obarray
)->contents
[hash
];
3326 oblookup_last_bucket_number
= hash
;
3327 if (EQ (bucket
, make_number (0)))
3329 else if (!SYMBOLP (bucket
))
3330 error ("Bad data in guts of obarray"); /* Like CADR error message */
3332 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3334 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3335 && SCHARS (SYMBOL_NAME (tail
)) == size
3336 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3338 else if (XSYMBOL (tail
)->next
== 0)
3341 XSETINT (tem
, hash
);
3346 hash_string (ptr
, len
)
3347 const unsigned char *ptr
;
3350 register const unsigned char *p
= ptr
;
3351 register const unsigned char *end
= p
+ len
;
3352 register unsigned char c
;
3353 register int hash
= 0;
3358 if (c
>= 0140) c
-= 40;
3359 hash
= ((hash
<<3) + (hash
>>28) + c
);
3361 return hash
& 07777777777;
3365 map_obarray (obarray
, fn
, arg
)
3366 Lisp_Object obarray
;
3367 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3371 register Lisp_Object tail
;
3372 CHECK_VECTOR (obarray
);
3373 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3375 tail
= XVECTOR (obarray
)->contents
[i
];
3380 if (XSYMBOL (tail
)->next
== 0)
3382 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3388 mapatoms_1 (sym
, function
)
3389 Lisp_Object sym
, function
;
3391 call1 (function
, sym
);
3394 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3395 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3396 OBARRAY defaults to the value of `obarray'. */)
3398 Lisp_Object function
, obarray
;
3400 if (NILP (obarray
)) obarray
= Vobarray
;
3401 obarray
= check_obarray (obarray
);
3403 map_obarray (obarray
, mapatoms_1
, function
);
3407 #define OBARRAY_SIZE 1511
3412 Lisp_Object oblength
;
3416 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3418 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3419 Vobarray
= Fmake_vector (oblength
, make_number (0));
3420 initial_obarray
= Vobarray
;
3421 staticpro (&initial_obarray
);
3422 /* Intern nil in the obarray */
3423 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3424 XSYMBOL (Qnil
)->constant
= 1;
3426 /* These locals are to kludge around a pyramid compiler bug. */
3427 hash
= hash_string ("nil", 3);
3428 /* Separate statement here to avoid VAXC bug. */
3429 hash
%= OBARRAY_SIZE
;
3430 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3433 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3434 XSYMBOL (Qnil
)->function
= Qunbound
;
3435 XSYMBOL (Qunbound
)->value
= Qunbound
;
3436 XSYMBOL (Qunbound
)->function
= Qunbound
;
3439 XSYMBOL (Qnil
)->value
= Qnil
;
3440 XSYMBOL (Qnil
)->plist
= Qnil
;
3441 XSYMBOL (Qt
)->value
= Qt
;
3442 XSYMBOL (Qt
)->constant
= 1;
3444 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3447 Qvariable_documentation
= intern ("variable-documentation");
3448 staticpro (&Qvariable_documentation
);
3450 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3451 read_buffer
= (char *) xmalloc (read_buffer_size
);
3456 struct Lisp_Subr
*sname
;
3459 sym
= intern (sname
->symbol_name
);
3460 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3463 #ifdef NOTDEF /* use fset in subr.el now */
3465 defalias (sname
, string
)
3466 struct Lisp_Subr
*sname
;
3470 sym
= intern (string
);
3471 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3475 /* Define an "integer variable"; a symbol whose value is forwarded
3476 to a C variable of type int. Sample call: */
3477 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3479 defvar_int (namestring
, address
)
3483 Lisp_Object sym
, val
;
3484 sym
= intern (namestring
);
3485 val
= allocate_misc ();
3486 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3487 XINTFWD (val
)->intvar
= address
;
3488 SET_SYMBOL_VALUE (sym
, val
);
3491 /* Similar but define a variable whose value is t if address contains 1,
3492 nil if address contains 0 */
3494 defvar_bool (namestring
, address
)
3498 Lisp_Object sym
, val
;
3499 sym
= intern (namestring
);
3500 val
= allocate_misc ();
3501 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3502 XBOOLFWD (val
)->boolvar
= address
;
3503 SET_SYMBOL_VALUE (sym
, val
);
3504 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3507 /* Similar but define a variable whose value is the Lisp Object stored
3508 at address. Two versions: with and without gc-marking of the C
3509 variable. The nopro version is used when that variable will be
3510 gc-marked for some other reason, since marking the same slot twice
3511 can cause trouble with strings. */
3513 defvar_lisp_nopro (namestring
, address
)
3515 Lisp_Object
*address
;
3517 Lisp_Object sym
, val
;
3518 sym
= intern (namestring
);
3519 val
= allocate_misc ();
3520 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3521 XOBJFWD (val
)->objvar
= address
;
3522 SET_SYMBOL_VALUE (sym
, val
);
3526 defvar_lisp (namestring
, address
)
3528 Lisp_Object
*address
;
3530 defvar_lisp_nopro (namestring
, address
);
3531 staticpro (address
);
3534 /* Similar but define a variable whose value is the Lisp Object stored in
3535 the current buffer. address is the address of the slot in the buffer
3536 that is current now. */
3539 defvar_per_buffer (namestring
, address
, type
, doc
)
3541 Lisp_Object
*address
;
3545 Lisp_Object sym
, val
;
3548 sym
= intern (namestring
);
3549 val
= allocate_misc ();
3550 offset
= (char *)address
- (char *)current_buffer
;
3552 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3553 XBUFFER_OBJFWD (val
)->offset
= offset
;
3554 SET_SYMBOL_VALUE (sym
, val
);
3555 PER_BUFFER_SYMBOL (offset
) = sym
;
3556 PER_BUFFER_TYPE (offset
) = type
;
3558 if (PER_BUFFER_IDX (offset
) == 0)
3559 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3560 slot of buffer_local_flags */
3565 /* Similar but define a variable whose value is the Lisp Object stored
3566 at a particular offset in the current kboard object. */
3569 defvar_kboard (namestring
, offset
)
3573 Lisp_Object sym
, val
;
3574 sym
= intern (namestring
);
3575 val
= allocate_misc ();
3576 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3577 XKBOARD_OBJFWD (val
)->offset
= offset
;
3578 SET_SYMBOL_VALUE (sym
, val
);
3581 /* Record the value of load-path used at the start of dumping
3582 so we can see if the site changed it later during dumping. */
3583 static Lisp_Object dump_path
;
3589 int turn_off_warning
= 0;
3591 /* Compute the default load-path. */
3593 normal
= PATH_LOADSEARCH
;
3594 Vload_path
= decode_env_path (0, normal
);
3596 if (NILP (Vpurify_flag
))
3597 normal
= PATH_LOADSEARCH
;
3599 normal
= PATH_DUMPLOADSEARCH
;
3601 /* In a dumped Emacs, we normally have to reset the value of
3602 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3603 uses ../lisp, instead of the path of the installed elisp
3604 libraries. However, if it appears that Vload_path was changed
3605 from the default before dumping, don't override that value. */
3608 if (! NILP (Fequal (dump_path
, Vload_path
)))
3610 Vload_path
= decode_env_path (0, normal
);
3611 if (!NILP (Vinstallation_directory
))
3613 Lisp_Object tem
, tem1
, sitelisp
;
3615 /* Remove site-lisp dirs from path temporarily and store
3616 them in sitelisp, then conc them on at the end so
3617 they're always first in path. */
3621 tem
= Fcar (Vload_path
);
3622 tem1
= Fstring_match (build_string ("site-lisp"),
3626 Vload_path
= Fcdr (Vload_path
);
3627 sitelisp
= Fcons (tem
, sitelisp
);
3633 /* Add to the path the lisp subdir of the
3634 installation dir, if it exists. */
3635 tem
= Fexpand_file_name (build_string ("lisp"),
3636 Vinstallation_directory
);
3637 tem1
= Ffile_exists_p (tem
);
3640 if (NILP (Fmember (tem
, Vload_path
)))
3642 turn_off_warning
= 1;
3643 Vload_path
= Fcons (tem
, Vload_path
);
3647 /* That dir doesn't exist, so add the build-time
3648 Lisp dirs instead. */
3649 Vload_path
= nconc2 (Vload_path
, dump_path
);
3651 /* Add leim under the installation dir, if it exists. */
3652 tem
= Fexpand_file_name (build_string ("leim"),
3653 Vinstallation_directory
);
3654 tem1
= Ffile_exists_p (tem
);
3657 if (NILP (Fmember (tem
, Vload_path
)))
3658 Vload_path
= Fcons (tem
, Vload_path
);
3661 /* Add site-list under the installation dir, if it exists. */
3662 tem
= Fexpand_file_name (build_string ("site-lisp"),
3663 Vinstallation_directory
);
3664 tem1
= Ffile_exists_p (tem
);
3667 if (NILP (Fmember (tem
, Vload_path
)))
3668 Vload_path
= Fcons (tem
, Vload_path
);
3671 /* If Emacs was not built in the source directory,
3672 and it is run from where it was built, add to load-path
3673 the lisp, leim and site-lisp dirs under that directory. */
3675 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3679 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3680 Vinstallation_directory
);
3681 tem1
= Ffile_exists_p (tem
);
3683 /* Don't be fooled if they moved the entire source tree
3684 AFTER dumping Emacs. If the build directory is indeed
3685 different from the source dir, src/Makefile.in and
3686 src/Makefile will not be found together. */
3687 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3688 Vinstallation_directory
);
3689 tem2
= Ffile_exists_p (tem
);
3690 if (!NILP (tem1
) && NILP (tem2
))
3692 tem
= Fexpand_file_name (build_string ("lisp"),
3695 if (NILP (Fmember (tem
, Vload_path
)))
3696 Vload_path
= Fcons (tem
, Vload_path
);
3698 tem
= Fexpand_file_name (build_string ("leim"),
3701 if (NILP (Fmember (tem
, Vload_path
)))
3702 Vload_path
= Fcons (tem
, Vload_path
);
3704 tem
= Fexpand_file_name (build_string ("site-lisp"),
3707 if (NILP (Fmember (tem
, Vload_path
)))
3708 Vload_path
= Fcons (tem
, Vload_path
);
3711 if (!NILP (sitelisp
))
3712 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3718 /* NORMAL refers to the lisp dir in the source directory. */
3719 /* We used to add ../lisp at the front here, but
3720 that caused trouble because it was copied from dump_path
3721 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3722 It should be unnecessary. */
3723 Vload_path
= decode_env_path (0, normal
);
3724 dump_path
= Vload_path
;
3728 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3729 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3730 almost never correct, thereby causing a warning to be printed out that
3731 confuses users. Since PATH_LOADSEARCH is always overridden by the
3732 EMACSLOADPATH environment variable below, disable the warning on NT.
3733 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3734 the "standard" paths may not exist and would be overridden by
3735 EMACSLOADPATH as on NT. Since this depends on how the executable
3736 was build and packaged, turn off the warnings in general */
3738 /* Warn if dirs in the *standard* path don't exist. */
3739 if (!turn_off_warning
)
3741 Lisp_Object path_tail
;
3743 for (path_tail
= Vload_path
;
3745 path_tail
= XCDR (path_tail
))
3747 Lisp_Object dirfile
;
3748 dirfile
= Fcar (path_tail
);
3749 if (STRINGP (dirfile
))
3751 dirfile
= Fdirectory_file_name (dirfile
);
3752 if (access (SDATA (dirfile
), 0) < 0)
3753 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3758 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3760 /* If the EMACSLOADPATH environment variable is set, use its value.
3761 This doesn't apply if we're dumping. */
3763 if (NILP (Vpurify_flag
)
3764 && egetenv ("EMACSLOADPATH"))
3766 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3770 load_in_progress
= 0;
3771 Vload_file_name
= Qnil
;
3773 load_descriptor_list
= Qnil
;
3775 Vstandard_input
= Qt
;
3776 Vloads_in_progress
= Qnil
;
3779 /* Print a warning, using format string FORMAT, that directory DIRNAME
3780 does not exist. Print it on stderr and put it in *Message*. */
3783 dir_warning (format
, dirname
)
3785 Lisp_Object dirname
;
3788 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3790 fprintf (stderr
, format
, SDATA (dirname
));
3791 sprintf (buffer
, format
, SDATA (dirname
));
3792 /* Don't log the warning before we've initialized!! */
3794 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3801 defsubr (&Sread_from_string
);
3803 defsubr (&Sintern_soft
);
3804 defsubr (&Sunintern
);
3806 defsubr (&Seval_buffer
);
3807 defsubr (&Seval_region
);
3808 defsubr (&Sread_char
);
3809 defsubr (&Sread_char_exclusive
);
3810 defsubr (&Sread_event
);
3811 defsubr (&Sget_file_char
);
3812 defsubr (&Smapatoms
);
3813 defsubr (&Slocate_file_internal
);
3815 DEFVAR_LISP ("obarray", &Vobarray
,
3816 doc
: /* Symbol table for use by `intern' and `read'.
3817 It is a vector whose length ought to be prime for best results.
3818 The vector's contents don't make sense if examined from Lisp programs;
3819 to find all the symbols in an obarray, use `mapatoms'. */);
3821 DEFVAR_LISP ("values", &Vvalues
,
3822 doc
: /* List of values of all expressions which were read, evaluated and printed.
3823 Order is reverse chronological. */);
3825 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3826 doc
: /* Stream for read to get input from.
3827 See documentation of `read' for possible values. */);
3828 Vstandard_input
= Qt
;
3830 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3831 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3833 If this variable is a buffer, then only forms read from that buffer
3834 will be added to `read-symbol-positions-list'.
3835 If this variable is t, then all read forms will be added.
3836 The effect of all other values other than nil are not currently
3837 defined, although they may be in the future.
3839 The positions are relative to the last call to `read' or
3840 `read-from-string'. It is probably a bad idea to set this variable at
3841 the toplevel; bind it instead. */);
3842 Vread_with_symbol_positions
= Qnil
;
3844 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3845 doc
: /* A list mapping read symbols to their positions.
3846 This variable is modified during calls to `read' or
3847 `read-from-string', but only when `read-with-symbol-positions' is
3850 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3851 CHAR-POSITION is an integer giving the offset of that occurrence of the
3852 symbol from the position where `read' or `read-from-string' started.
3854 Note that a symbol will appear multiple times in this list, if it was
3855 read multiple times. The list is in the same order as the symbols
3857 Vread_symbol_positions_list
= Qnil
;
3859 DEFVAR_LISP ("load-path", &Vload_path
,
3860 doc
: /* *List of directories to search for files to load.
3861 Each element is a string (directory name) or nil (try default directory).
3862 Initialized based on EMACSLOADPATH environment variable, if any,
3863 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3865 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3866 doc
: /* *List of suffixes to try for files to load.
3867 This list should not include the empty string. */);
3868 Vload_suffixes
= Fcons (build_string (".elc"),
3869 Fcons (build_string (".el"), Qnil
));
3870 /* We don't use empty_string because it's not initialized yet. */
3871 default_suffixes
= Fcons (build_string (""), Qnil
);
3872 staticpro (&default_suffixes
);
3874 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3875 doc
: /* Non-nil iff inside of `load'. */);
3877 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3878 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3879 Each element looks like (FILENAME FORMS...).
3880 When `load' is run and the file-name argument is FILENAME,
3881 the FORMS in the corresponding element are executed at the end of loading.
3883 FILENAME must match exactly! Normally FILENAME is the name of a library,
3884 with no directory specified, since that is how `load' is normally called.
3885 An error in FORMS does not undo the load,
3886 but does prevent execution of the rest of the FORMS.
3887 FILENAME can also be a symbol (a feature) and FORMS are then executed
3888 when the corresponding call to `provide' is made. */);
3889 Vafter_load_alist
= Qnil
;
3891 DEFVAR_LISP ("load-history", &Vload_history
,
3892 doc
: /* Alist mapping file names to symbols and features.
3893 Each alist element is a list that starts with a file name,
3894 except for one element (optional) that starts with nil and describes
3895 definitions evaluated from buffers not visiting files.
3896 The remaining elements of each list are symbols defined as variables
3897 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3898 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3899 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3900 and means that SYMBOL was an autoload before this file redefined it
3903 During preloading, the file name recorded is relative to the main Lisp
3904 directory. These file names are converted to absolute at startup. */);
3905 Vload_history
= Qnil
;
3907 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3908 doc
: /* Full name of file being loaded by `load'. */);
3909 Vload_file_name
= Qnil
;
3911 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3912 doc
: /* File name, including directory, of user's initialization file.
3913 If the file loaded had extension `.elc', and the corresponding source file
3914 exists, this variable contains the name of source file, suitable for use
3915 by functions like `custom-save-all' which edit the init file. */);
3916 Vuser_init_file
= Qnil
;
3918 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3919 doc
: /* Used for internal purposes by `load'. */);
3920 Vcurrent_load_list
= Qnil
;
3922 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3923 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3924 The default is nil, which means use the function `read'. */);
3925 Vload_read_function
= Qnil
;
3927 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3928 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3929 This function is for doing code conversion before reading the source file.
3930 If nil, loading is done without any code conversion.
3931 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3932 FULLNAME is the full name of FILE.
3933 See `load' for the meaning of the remaining arguments. */);
3934 Vload_source_file_function
= Qnil
;
3936 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3937 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3938 This is useful when the file being loaded is a temporary copy. */);
3939 load_force_doc_strings
= 0;
3941 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3942 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3943 This is normally bound by `load' and `eval-buffer' to control `read',
3944 and is not meant for users to change. */);
3945 load_convert_to_unibyte
= 0;
3947 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3948 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3949 You cannot count on them to still be there! */);
3951 = Fexpand_file_name (build_string ("../"),
3952 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3954 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3955 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3956 Vpreloaded_file_list
= Qnil
;
3958 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3959 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3960 Vbyte_boolean_vars
= Qnil
;
3962 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3963 doc
: /* Non-nil means load dangerous compiled Lisp files.
3964 Some versions of XEmacs use different byte codes than Emacs. These
3965 incompatible byte codes can make Emacs crash when it tries to execute
3967 load_dangerous_libraries
= 0;
3969 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3970 doc
: /* Regular expression matching safe to load compiled Lisp files.
3971 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3972 from the file, and matches them against this regular expression.
3973 When the regular expression matches, the file is considered to be safe
3974 to load. See also `load-dangerous-libraries'. */);
3975 Vbytecomp_version_regexp
3976 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3978 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
3979 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
3980 Veval_buffer_list
= Qnil
;
3982 /* Vsource_directory was initialized in init_lread. */
3984 load_descriptor_list
= Qnil
;
3985 staticpro (&load_descriptor_list
);
3987 Qcurrent_load_list
= intern ("current-load-list");
3988 staticpro (&Qcurrent_load_list
);
3990 Qstandard_input
= intern ("standard-input");
3991 staticpro (&Qstandard_input
);
3993 Qread_char
= intern ("read-char");
3994 staticpro (&Qread_char
);
3996 Qget_file_char
= intern ("get-file-char");
3997 staticpro (&Qget_file_char
);
3999 Qbackquote
= intern ("`");
4000 staticpro (&Qbackquote
);
4001 Qcomma
= intern (",");
4002 staticpro (&Qcomma
);
4003 Qcomma_at
= intern (",@");
4004 staticpro (&Qcomma_at
);
4005 Qcomma_dot
= intern (",.");
4006 staticpro (&Qcomma_dot
);
4008 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4009 staticpro (&Qinhibit_file_name_operation
);
4011 Qascii_character
= intern ("ascii-character");
4012 staticpro (&Qascii_character
);
4014 Qfunction
= intern ("function");
4015 staticpro (&Qfunction
);
4017 Qload
= intern ("load");
4020 Qload_file_name
= intern ("load-file-name");
4021 staticpro (&Qload_file_name
);
4023 Qeval_buffer_list
= intern ("eval-buffer-list");
4024 staticpro (&Qeval_buffer_list
);
4026 staticpro (&dump_path
);
4028 staticpro (&read_objects
);
4029 read_objects
= Qnil
;
4030 staticpro (&seen_list
);
4033 Vloads_in_progress
= Qnil
;
4034 staticpro (&Vloads_in_progress
);
4037 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4038 (do not change this comment) */