1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998,
3 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
36 #include "termhooks.h"
40 #include <sys/inode.h>
45 #include <unistd.h> /* to get X_OK */
62 #endif /* HAVE_SETLOCALE */
72 #define file_offset off_t
73 #define file_tell ftello
75 #define file_offset long
76 #define file_tell ftell
83 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
84 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
85 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
86 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
87 Lisp_Object Qinhibit_file_name_operation
;
88 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
90 extern Lisp_Object Qevent_symbol_element_mask
;
91 extern Lisp_Object Qfile_exists_p
;
93 /* non-zero iff inside `load' */
96 /* Directory in which the sources were found. */
97 Lisp_Object Vsource_directory
;
99 /* Search path and suffixes for files to be loaded. */
100 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
102 /* File name of user's init file. */
103 Lisp_Object Vuser_init_file
;
105 /* This is the user-visible association list that maps features to
106 lists of defs in their load files. */
107 Lisp_Object Vload_history
;
109 /* This is used to build the load history. */
110 Lisp_Object Vcurrent_load_list
;
112 /* List of files that were preloaded. */
113 Lisp_Object Vpreloaded_file_list
;
115 /* Name of file actually being read by `load'. */
116 Lisp_Object Vload_file_name
;
118 /* Function to use for reading, in `load' and friends. */
119 Lisp_Object Vload_read_function
;
121 /* The association list of objects read with the #n=object form.
122 Each member of the list has the form (n . object), and is used to
123 look up the object for the corresponding #n# construct.
124 It must be set to nil before all top-level calls to read0. */
125 Lisp_Object read_objects
;
127 /* Nonzero means load should forcibly load all dynamic doc strings. */
128 static int load_force_doc_strings
;
130 /* Nonzero means read should convert strings to unibyte. */
131 static int load_convert_to_unibyte
;
133 /* Function to use for loading an Emacs lisp source file (not
134 compiled) instead of readevalloop. */
135 Lisp_Object Vload_source_file_function
;
137 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
138 Lisp_Object Vbyte_boolean_vars
;
140 /* Whether or not to add a `read-positions' property to symbols
142 Lisp_Object Vread_with_symbol_positions
;
144 /* List of (SYMBOL . POSITION) accumulated so far. */
145 Lisp_Object Vread_symbol_positions_list
;
147 /* List of descriptors now open for Fload. */
148 static Lisp_Object load_descriptor_list
;
150 /* File for get_file_char to read from. Use by load. */
151 static FILE *instream
;
153 /* When nonzero, read conses in pure space */
154 static int read_pure
;
156 /* For use within read-from-string (this reader is non-reentrant!!) */
157 static int read_from_string_index
;
158 static int read_from_string_index_byte
;
159 static int read_from_string_limit
;
161 /* Number of bytes left to read in the buffer character
162 that `readchar' has already advanced over. */
163 static int readchar_backlog
;
164 /* Number of characters read in the current call to Fread or
165 Fread_from_string. */
166 static int readchar_count
;
168 /* This contains the last string skipped with #@. */
169 static char *saved_doc_string
;
170 /* Length of buffer allocated in saved_doc_string. */
171 static int saved_doc_string_size
;
172 /* Length of actual data in saved_doc_string. */
173 static int saved_doc_string_length
;
174 /* This is the file position that string came from. */
175 static file_offset saved_doc_string_position
;
177 /* This contains the previous string skipped with #@.
178 We copy it from saved_doc_string when a new string
179 is put in saved_doc_string. */
180 static char *prev_saved_doc_string
;
181 /* Length of buffer allocated in prev_saved_doc_string. */
182 static int prev_saved_doc_string_size
;
183 /* Length of actual data in prev_saved_doc_string. */
184 static int prev_saved_doc_string_length
;
185 /* This is the file position that string came from. */
186 static file_offset prev_saved_doc_string_position
;
188 /* Nonzero means inside a new-style backquote
189 with no surrounding parentheses.
190 Fread initializes this to zero, so we need not specbind it
191 or worry about what happens to it when there is an error. */
192 static int new_backquote_flag
;
194 /* A list of file names for files being loaded in Fload. Used to
195 check for recursive loads. */
197 static Lisp_Object Vloads_in_progress
;
199 /* Non-zero means load dangerous compiled Lisp files. */
201 int load_dangerous_libraries
;
203 /* A regular expression used to detect files compiled with Emacs. */
205 static Lisp_Object Vbytecomp_version_regexp
;
207 static void to_multibyte
P_ ((char **, char **, int *));
208 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
209 Lisp_Object (*) (), int,
210 Lisp_Object
, Lisp_Object
,
211 Lisp_Object
, Lisp_Object
));
212 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
213 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
216 /* Handle unreading and rereading of characters.
217 Write READCHAR to read a character,
218 UNREAD(c) to unread c to be read again.
220 The READCHAR and UNREAD macros are meant for reading/unreading a
221 byte code; they do not handle multibyte characters. The caller
222 should manage them if necessary.
224 [ Actually that seems to be a lie; READCHAR will definitely read
225 multibyte characters from buffer sources, at least. Is the
226 comment just out of date?
227 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
230 #define READCHAR readchar (readcharfun)
231 #define UNREAD(c) unreadchar (readcharfun, c)
234 readchar (readcharfun
)
235 Lisp_Object readcharfun
;
242 if (BUFFERP (readcharfun
))
244 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
246 int pt_byte
= BUF_PT_BYTE (inbuffer
);
247 int orig_pt_byte
= pt_byte
;
249 if (readchar_backlog
> 0)
250 /* We get the address of the byte just passed,
251 which is the last byte of the character.
252 The other bytes in this character are consecutive with it,
253 because the gap can't be in the middle of a character. */
254 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
255 - --readchar_backlog
);
257 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
260 readchar_backlog
= -1;
262 if (! NILP (inbuffer
->enable_multibyte_characters
))
264 /* Fetch the character code from the buffer. */
265 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
266 BUF_INC_POS (inbuffer
, pt_byte
);
267 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
271 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
274 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
278 if (MARKERP (readcharfun
))
280 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
282 int bytepos
= marker_byte_position (readcharfun
);
283 int orig_bytepos
= bytepos
;
285 if (readchar_backlog
> 0)
286 /* We get the address of the byte just passed,
287 which is the last byte of the character.
288 The other bytes in this character are consecutive with it,
289 because the gap can't be in the middle of a character. */
290 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
291 - --readchar_backlog
);
293 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
296 readchar_backlog
= -1;
298 if (! NILP (inbuffer
->enable_multibyte_characters
))
300 /* Fetch the character code from the buffer. */
301 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
302 BUF_INC_POS (inbuffer
, bytepos
);
303 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
307 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
311 XMARKER (readcharfun
)->bytepos
= bytepos
;
312 XMARKER (readcharfun
)->charpos
++;
317 if (EQ (readcharfun
, Qlambda
))
318 return read_bytecode_char (0);
320 if (EQ (readcharfun
, Qget_file_char
))
324 /* Interrupted reads have been observed while reading over the network */
325 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
335 if (STRINGP (readcharfun
))
337 if (read_from_string_index
>= read_from_string_limit
)
340 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
341 read_from_string_index
,
342 read_from_string_index_byte
);
347 tem
= call0 (readcharfun
);
354 /* Unread the character C in the way appropriate for the stream READCHARFUN.
355 If the stream is a user function, call it with the char as argument. */
358 unreadchar (readcharfun
, c
)
359 Lisp_Object readcharfun
;
364 /* Don't back up the pointer if we're unreading the end-of-input mark,
365 since readchar didn't advance it when we read it. */
367 else if (BUFFERP (readcharfun
))
369 struct buffer
*b
= XBUFFER (readcharfun
);
370 int bytepos
= BUF_PT_BYTE (b
);
372 if (readchar_backlog
>= 0)
377 if (! NILP (b
->enable_multibyte_characters
))
378 BUF_DEC_POS (b
, bytepos
);
382 BUF_PT_BYTE (b
) = bytepos
;
385 else if (MARKERP (readcharfun
))
387 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
388 int bytepos
= XMARKER (readcharfun
)->bytepos
;
390 if (readchar_backlog
>= 0)
394 XMARKER (readcharfun
)->charpos
--;
395 if (! NILP (b
->enable_multibyte_characters
))
396 BUF_DEC_POS (b
, bytepos
);
400 XMARKER (readcharfun
)->bytepos
= bytepos
;
403 else if (STRINGP (readcharfun
))
405 read_from_string_index
--;
406 read_from_string_index_byte
407 = string_char_to_byte (readcharfun
, read_from_string_index
);
409 else if (EQ (readcharfun
, Qlambda
))
410 read_bytecode_char (1);
411 else if (EQ (readcharfun
, Qget_file_char
))
412 ungetc (c
, instream
);
414 call1 (readcharfun
, make_number (c
));
417 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
419 static Lisp_Object read0
P_ ((Lisp_Object
));
420 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
422 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
423 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
424 static int read_multibyte
P_ ((int, Lisp_Object
));
426 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
428 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
430 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
433 /* Get a character from the tty. */
435 extern Lisp_Object
read_char ();
437 /* Read input events until we get one that's acceptable for our purposes.
439 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
440 until we get a character we like, and then stuffed into
443 If ASCII_REQUIRED is non-zero, we check function key events to see
444 if the unmodified version of the symbol has a Qascii_character
445 property, and use that character, if present.
447 If ERROR_NONASCII is non-zero, we signal an error if the input we
448 get isn't an ASCII character with modifiers. If it's zero but
449 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
452 If INPUT_METHOD is nonzero, we invoke the current input method
453 if the character warrants that. */
456 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
458 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
460 register Lisp_Object val
, delayed_switch_frame
;
462 #ifdef HAVE_WINDOW_SYSTEM
463 if (display_hourglass_p
)
467 delayed_switch_frame
= Qnil
;
469 /* Read until we get an acceptable event. */
471 val
= read_char (0, 0, 0,
472 (input_method
? Qnil
: Qt
),
478 /* switch-frame events are put off until after the next ASCII
479 character. This is better than signaling an error just because
480 the last characters were typed to a separate minibuffer frame,
481 for example. Eventually, some code which can deal with
482 switch-frame events will read it and process it. */
484 && EVENT_HAS_PARAMETERS (val
)
485 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
487 delayed_switch_frame
= val
;
493 /* Convert certain symbols to their ASCII equivalents. */
496 Lisp_Object tem
, tem1
;
497 tem
= Fget (val
, Qevent_symbol_element_mask
);
500 tem1
= Fget (Fcar (tem
), Qascii_character
);
501 /* Merge this symbol's modifier bits
502 with the ASCII equivalent of its basic code. */
504 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
508 /* If we don't have a character now, deal with it appropriately. */
513 Vunread_command_events
= Fcons (val
, Qnil
);
514 error ("Non-character input-event");
521 if (! NILP (delayed_switch_frame
))
522 unread_switch_frame
= delayed_switch_frame
;
526 #ifdef HAVE_WINDOW_SYSTEM
527 if (display_hourglass_p
)
536 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
537 doc
: /* Read a character from the command input (keyboard or macro).
538 It is returned as a number.
539 If the user generates an event which is not a character (i.e. a mouse
540 click or function key event), `read-char' signals an error. As an
541 exception, switch-frame events are put off until non-ASCII events can
543 If you want to read non-character events, or ignore them, call
544 `read-event' or `read-char-exclusive' instead.
546 If the optional argument PROMPT is non-nil, display that as a prompt.
547 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
548 input method is turned on in the current buffer, that input method
549 is used for reading a character. */)
550 (prompt
, inherit_input_method
)
551 Lisp_Object prompt
, inherit_input_method
;
554 message_with_string ("%s", prompt
, 0);
555 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
558 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
559 doc
: /* Read an event object from the input stream.
560 If the optional argument PROMPT is non-nil, display that as a prompt.
561 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
562 input method is turned on in the current buffer, that input method
563 is used for reading a character. */)
564 (prompt
, inherit_input_method
)
565 Lisp_Object prompt
, inherit_input_method
;
568 message_with_string ("%s", prompt
, 0);
569 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
572 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
573 doc
: /* Read a character from the command input (keyboard or macro).
574 It is returned as a number. Non-character events are ignored.
576 If the optional argument PROMPT is non-nil, display that as a prompt.
577 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
578 input method is turned on in the current buffer, that input method
579 is used for reading a character. */)
580 (prompt
, inherit_input_method
)
581 Lisp_Object prompt
, inherit_input_method
;
584 message_with_string ("%s", prompt
, 0);
585 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
588 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
589 doc
: /* Don't use this yourself. */)
592 register Lisp_Object val
;
593 XSETINT (val
, getc (instream
));
599 /* Value is non-zero if the file asswociated with file descriptor FD
600 is a compiled Lisp file that's safe to load. Only files compiled
601 with Emacs are safe to load. Files compiled with XEmacs can lead
602 to a crash in Fbyte_code because of an incompatible change in the
613 /* Read the first few bytes from the file, and look for a line
614 specifying the byte compiler version used. */
615 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
620 /* Skip to the next newline, skipping over the initial `ELC'
621 with NUL bytes following it. */
622 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
626 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
631 lseek (fd
, 0, SEEK_SET
);
636 /* Callback for record_unwind_protect. Restore the old load list OLD,
637 after loading a file successfully. */
640 record_load_unwind (old
)
643 return Vloads_in_progress
= old
;
646 /* This handler function is used via internal_condition_case_1. */
649 load_error_handler (data
)
655 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
656 doc
: /* Execute a file of Lisp code named FILE.
657 First try FILE with `.elc' appended, then try with `.el',
658 then try FILE unmodified (the exact suffixes are determined by
659 `load-suffixes'). Environment variable references in FILE
660 are replaced with their values by calling `substitute-in-file-name'.
661 This function searches the directories in `load-path'.
662 If optional second arg NOERROR is non-nil,
663 report no error if FILE doesn't exist.
664 Print messages at start and end of loading unless
665 optional third arg NOMESSAGE is non-nil.
666 If optional fourth arg NOSUFFIX is non-nil, don't try adding
667 suffixes `.elc' or `.el' to the specified name FILE.
668 If optional fifth arg MUST-SUFFIX is non-nil, insist on
669 the suffix `.elc' or `.el'; don't accept just FILE unless
670 it ends in one of those suffixes or includes a directory name.
671 Return t if file exists. */)
672 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
673 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
675 register FILE *stream
;
676 register int fd
= -1;
677 register Lisp_Object lispstream
;
678 int count
= SPECPDL_INDEX ();
681 Lisp_Object found
, efound
;
682 /* 1 means we printed the ".el is newer" message. */
684 /* 1 means we are loading a compiled file. */
695 /* If file name is magic, call the handler. */
696 /* This shouldn't be necessary any more now that `openp' handles it right.
697 handler = Ffind_file_name_handler (file, Qload);
699 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
701 /* Do this after the handler to avoid
702 the need to gcpro noerror, nomessage and nosuffix.
703 (Below here, we care only whether they are nil or not.)
704 The presence of this call is the result of a historical accident:
705 it used to be in every file-operations and when it got removed
706 everywhere, it accidentally stayed here. Since then, enough people
707 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
708 that it seemed risky to remove. */
709 if (! NILP (noerror
))
711 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
712 Qt
, load_error_handler
);
717 file
= Fsubstitute_in_file_name (file
);
720 /* Avoid weird lossage with null string as arg,
721 since it would try to load a directory as a Lisp file */
722 if (SCHARS (file
) > 0)
724 int size
= SBYTES (file
);
729 if (! NILP (must_suffix
))
731 /* Don't insist on adding a suffix if FILE already ends with one. */
733 && !strcmp (SDATA (file
) + size
- 3, ".el"))
736 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
738 /* Don't insist on adding a suffix
739 if the argument includes a directory name. */
740 else if (! NILP (Ffile_name_directory (file
)))
744 fd
= openp (Vload_path
, file
,
745 (!NILP (nosuffix
) ? Qnil
746 : !NILP (must_suffix
) ? Vload_suffixes
747 : Fappend (2, (tmp
[0] = Vload_suffixes
,
748 tmp
[1] = default_suffixes
,
757 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
758 Fcons (file
, Qnil
)));
763 /* Tell startup.el whether or not we found the user's init file. */
764 if (EQ (Qt
, Vuser_init_file
))
765 Vuser_init_file
= found
;
767 /* If FD is -2, that means openp found a magic file. */
770 if (NILP (Fequal (found
, file
)))
771 /* If FOUND is a different file name from FILE,
772 find its handler even if we have already inhibited
773 the `load' operation on FILE. */
774 handler
= Ffind_file_name_handler (found
, Qt
);
776 handler
= Ffind_file_name_handler (found
, Qload
);
777 if (! NILP (handler
))
778 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
781 /* Check if we're stuck in a recursive load cycle.
783 2000-09-21: It's not possible to just check for the file loaded
784 being a member of Vloads_in_progress. This fails because of the
785 way the byte compiler currently works; `provide's are not
786 evaluted, see font-lock.el/jit-lock.el as an example. This
787 leads to a certain amount of ``normal'' recursion.
789 Also, just loading a file recursively is not always an error in
790 the general case; the second load may do something different. */
794 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
795 if (!NILP (Fequal (found
, XCAR (tem
))))
798 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
799 Fcons (found
, Vloads_in_progress
)));
800 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
801 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
804 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
806 /* Load .elc files directly, but not when they are
807 remote and have no handler! */
814 if (!safe_to_load_p (fd
))
817 if (!load_dangerous_libraries
)
821 error ("File `%s' was not compiled in Emacs",
824 else if (!NILP (nomessage
))
825 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
831 efound
= ENCODE_FILE (found
);
836 stat ((char *)SDATA (efound
), &s1
);
837 SSET (efound
, SBYTES (efound
) - 1, 0);
838 result
= stat ((char *)SDATA (efound
), &s2
);
839 SSET (efound
, SBYTES (efound
) - 1, 'c');
842 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
844 /* Make the progress messages mention that source is newer. */
847 /* If we won't print another message, mention this anyway. */
848 if (!NILP (nomessage
))
851 file
= Fsubstring (found
, make_number (0), make_number (-1));
852 message_with_string ("Source file `%s' newer than byte-compiled file",
860 /* We are loading a source file (*.el). */
861 if (!NILP (Vload_source_file_function
))
867 val
= call4 (Vload_source_file_function
, found
, file
,
868 NILP (noerror
) ? Qnil
: Qt
,
869 NILP (nomessage
) ? Qnil
: Qt
);
870 return unbind_to (count
, val
);
877 efound
= ENCODE_FILE (found
);
878 stream
= fopen ((char *) SDATA (efound
), fmode
);
880 #else /* not WINDOWSNT */
881 stream
= fdopen (fd
, fmode
);
882 #endif /* not WINDOWSNT */
886 error ("Failure to create stdio stream for %s", SDATA (file
));
889 if (! NILP (Vpurify_flag
))
890 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
892 if (NILP (nomessage
))
895 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
898 message_with_string ("Loading %s (source)...", file
, 1);
900 message_with_string ("Loading %s (compiled; note, source file is newer)...",
902 else /* The typical case; compiled file newer than source file. */
903 message_with_string ("Loading %s...", file
, 1);
907 lispstream
= Fcons (Qnil
, Qnil
);
908 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
909 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
910 record_unwind_protect (load_unwind
, lispstream
);
911 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
912 specbind (Qload_file_name
, found
);
913 specbind (Qinhibit_file_name_operation
, Qnil
);
915 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
917 readevalloop (Qget_file_char
, stream
, file
, Feval
,
918 0, Qnil
, Qnil
, Qnil
, Qnil
);
919 unbind_to (count
, Qnil
);
921 /* Run any load-hooks for this file. */
922 temp
= Fassoc (file
, Vafter_load_alist
);
924 Fprogn (Fcdr (temp
));
927 if (saved_doc_string
)
928 free (saved_doc_string
);
929 saved_doc_string
= 0;
930 saved_doc_string_size
= 0;
932 if (prev_saved_doc_string
)
933 xfree (prev_saved_doc_string
);
934 prev_saved_doc_string
= 0;
935 prev_saved_doc_string_size
= 0;
937 if (!noninteractive
&& NILP (nomessage
))
940 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
943 message_with_string ("Loading %s (source)...done", file
, 1);
945 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
947 else /* The typical case; compiled file newer than source file. */
948 message_with_string ("Loading %s...done", file
, 1);
951 if (!NILP (Fequal (build_string ("obsolete"),
952 Ffile_name_nondirectory
953 (Fdirectory_file_name (Ffile_name_directory (found
))))))
954 message_with_string ("Package %s is obsolete", file
, 1);
960 load_unwind (stream
) /* used as unwind-protect function in load */
963 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
964 | XFASTINT (XCDR (stream
))));
965 if (--load_in_progress
< 0) load_in_progress
= 0;
970 load_descriptor_unwind (oldlist
)
973 load_descriptor_list
= oldlist
;
977 /* Close all descriptors in use for Floads.
978 This is used when starting a subprocess. */
985 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
986 emacs_close (XFASTINT (XCAR (tail
)));
991 complete_filename_p (pathname
)
992 Lisp_Object pathname
;
994 register const unsigned char *s
= SDATA (pathname
);
995 return (IS_DIRECTORY_SEP (s
[0])
996 || (SCHARS (pathname
) > 2
997 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1007 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1008 doc
: /* Search for FILENAME through PATH.
1009 Returns the file's name in absolute form, or nil if not found.
1010 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1011 file name when searching.
1012 If non-nil, PREDICATE is used instead of `file-readable-p'.
1013 PREDICATE can also be an integer to pass to the access(2) function,
1014 in which case file-name-handlers are ignored. */)
1015 (filename
, path
, suffixes
, predicate
)
1016 Lisp_Object filename
, path
, suffixes
, predicate
;
1019 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1020 if (NILP (predicate
) && fd
> 0)
1026 /* Search for a file whose name is STR, looking in directories
1027 in the Lisp list PATH, and trying suffixes from SUFFIX.
1028 On success, returns a file descriptor. On failure, returns -1.
1030 SUFFIXES is a list of strings containing possible suffixes.
1031 The empty suffix is automatically added iff the list is empty.
1033 PREDICATE non-nil means don't open the files,
1034 just look for one that satisfies the predicate. In this case,
1035 returns 1 on success. The predicate can be a lisp function or
1036 an integer to pass to `access' (in which case file-name-handlers
1039 If STOREPTR is nonzero, it points to a slot where the name of
1040 the file actually found should be stored as a Lisp string.
1041 nil is stored there on failure.
1043 If the file we find is remote, return -2
1044 but store the found remote file name in *STOREPTR. */
1047 openp (path
, str
, suffixes
, storeptr
, predicate
)
1048 Lisp_Object path
, str
;
1049 Lisp_Object suffixes
;
1050 Lisp_Object
*storeptr
;
1051 Lisp_Object predicate
;
1056 register char *fn
= buf
;
1059 Lisp_Object filename
;
1061 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1062 Lisp_Object string
, tail
, encoded_fn
;
1063 int max_suffix_len
= 0;
1067 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1069 CHECK_STRING_CAR (tail
);
1070 max_suffix_len
= max (max_suffix_len
,
1071 SBYTES (XCAR (tail
)));
1074 string
= filename
= Qnil
;
1075 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1080 if (complete_filename_p (str
))
1083 for (; CONSP (path
); path
= XCDR (path
))
1085 filename
= Fexpand_file_name (str
, XCAR (path
));
1086 if (!complete_filename_p (filename
))
1087 /* If there are non-absolute elts in PATH (eg ".") */
1088 /* Of course, this could conceivably lose if luser sets
1089 default-directory to be something non-absolute... */
1091 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1092 if (!complete_filename_p (filename
))
1093 /* Give up on this path element! */
1097 /* Calculate maximum size of any filename made from
1098 this path element/specified file name and any possible suffix. */
1099 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1100 if (fn_size
< want_size
)
1101 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1103 /* Loop over suffixes. */
1104 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1105 CONSP (tail
); tail
= XCDR (tail
))
1107 int lsuffix
= SBYTES (XCAR (tail
));
1108 Lisp_Object handler
;
1111 /* Concatenate path element/specified name with the suffix.
1112 If the directory starts with /:, remove that. */
1113 if (SCHARS (filename
) > 2
1114 && SREF (filename
, 0) == '/'
1115 && SREF (filename
, 1) == ':')
1117 strncpy (fn
, SDATA (filename
) + 2,
1118 SBYTES (filename
) - 2);
1119 fn
[SBYTES (filename
) - 2] = 0;
1123 strncpy (fn
, SDATA (filename
),
1125 fn
[SBYTES (filename
)] = 0;
1128 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1129 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1131 /* Check that the file exists and is not a directory. */
1132 /* We used to only check for handlers on non-absolute file names:
1136 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1137 It's not clear why that was the case and it breaks things like
1138 (load "/bar.el") where the file is actually "/bar.el.gz". */
1139 string
= build_string (fn
);
1140 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1141 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1143 if (NILP (predicate
))
1144 exists
= !NILP (Ffile_readable_p (string
));
1146 exists
= !NILP (call1 (predicate
, string
));
1147 if (exists
&& !NILP (Ffile_directory_p (string
)))
1152 /* We succeeded; return this descriptor and filename. */
1163 encoded_fn
= ENCODE_FILE (string
);
1164 pfn
= SDATA (encoded_fn
);
1165 exists
= (stat (pfn
, &st
) >= 0
1166 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1169 /* Check that we can access or open it. */
1170 if (NATNUMP (predicate
))
1171 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1173 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1177 /* We succeeded; return this descriptor and filename. */
1195 /* Merge the list we've accumulated of globals from the current input source
1196 into the load_history variable. The details depend on whether
1197 the source has an associated file name or not. */
1200 build_load_history (stream
, source
)
1204 register Lisp_Object tail
, prev
, newelt
;
1205 register Lisp_Object tem
, tem2
;
1206 register int foundit
, loading
;
1208 loading
= stream
|| !NARROWED
;
1210 tail
= Vload_history
;
1213 while (CONSP (tail
))
1217 /* Find the feature's previous assoc list... */
1218 if (!NILP (Fequal (source
, Fcar (tem
))))
1222 /* If we're loading, remove it. */
1226 Vload_history
= XCDR (tail
);
1228 Fsetcdr (prev
, XCDR (tail
));
1231 /* Otherwise, cons on new symbols that are not already members. */
1234 tem2
= Vcurrent_load_list
;
1236 while (CONSP (tem2
))
1238 newelt
= XCAR (tem2
);
1240 if (NILP (Fmember (newelt
, tem
)))
1241 Fsetcar (tail
, Fcons (XCAR (tem
),
1242 Fcons (newelt
, XCDR (tem
))));
1255 /* If we're loading, cons the new assoc onto the front of load-history,
1256 the most-recently-loaded position. Also do this if we didn't find
1257 an existing member for the current source. */
1258 if (loading
|| !foundit
)
1259 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1264 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1272 readevalloop_1 (old
)
1275 load_convert_to_unibyte
= ! NILP (old
);
1279 /* Signal an `end-of-file' error, if possible with file name
1283 end_of_file_error ()
1287 if (STRINGP (Vload_file_name
))
1288 data
= Fcons (Vload_file_name
, Qnil
);
1292 Fsignal (Qend_of_file
, data
);
1295 /* UNIBYTE specifies how to set load_convert_to_unibyte
1296 for this invocation.
1297 READFUN, if non-nil, is used instead of `read'.
1298 START, END is region in current buffer (from eval-region). */
1301 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1302 printflag
, unibyte
, readfun
, start
, end
)
1303 Lisp_Object readcharfun
;
1305 Lisp_Object sourcename
;
1306 Lisp_Object (*evalfun
) ();
1308 Lisp_Object unibyte
, readfun
;
1309 Lisp_Object start
, end
;
1312 register Lisp_Object val
;
1313 int count
= SPECPDL_INDEX ();
1314 struct gcpro gcpro1
;
1315 struct buffer
*b
= 0;
1316 int continue_reading_p
;
1318 if (BUFFERP (readcharfun
))
1319 b
= XBUFFER (readcharfun
);
1320 else if (MARKERP (readcharfun
))
1321 b
= XMARKER (readcharfun
)->buffer
;
1323 specbind (Qstandard_input
, readcharfun
);
1324 specbind (Qcurrent_load_list
, Qnil
);
1325 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1326 load_convert_to_unibyte
= !NILP (unibyte
);
1328 readchar_backlog
= -1;
1330 GCPRO1 (sourcename
);
1332 LOADHIST_ATTACH (sourcename
);
1334 continue_reading_p
= 1;
1335 while (continue_reading_p
)
1337 int count1
= SPECPDL_INDEX ();
1339 if (b
!= 0 && NILP (b
->name
))
1340 error ("Reading from killed buffer");
1344 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1345 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1347 Fnarrow_to_region (make_number (BEGV
), end
);
1355 while ((c
= READCHAR
) != '\n' && c
!= -1);
1360 unbind_to (count1
, Qnil
);
1364 /* Ignore whitespace here, so we can detect eof. */
1365 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1368 if (!NILP (Vpurify_flag
) && c
== '(')
1370 record_unwind_protect (unreadpure
, Qnil
);
1371 val
= read_list (-1, readcharfun
);
1376 read_objects
= Qnil
;
1377 if (!NILP (readfun
))
1379 val
= call1 (readfun
, readcharfun
);
1381 /* If READCHARFUN has set point to ZV, we should
1382 stop reading, even if the form read sets point
1383 to a different value when evaluated. */
1384 if (BUFFERP (readcharfun
))
1386 struct buffer
*b
= XBUFFER (readcharfun
);
1387 if (BUF_PT (b
) == BUF_ZV (b
))
1388 continue_reading_p
= 0;
1391 else if (! NILP (Vload_read_function
))
1392 val
= call1 (Vload_read_function
, readcharfun
);
1394 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1397 if (!NILP (start
) && continue_reading_p
)
1398 start
= Fpoint_marker ();
1399 unbind_to (count1
, Qnil
);
1401 val
= (*evalfun
) (val
);
1405 Vvalues
= Fcons (val
, Vvalues
);
1406 if (EQ (Vstandard_output
, Qt
))
1413 build_load_history (stream
, sourcename
);
1416 unbind_to (count
, Qnil
);
1419 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1420 doc
: /* Execute the current buffer as Lisp code.
1421 Programs can pass two arguments, BUFFER and PRINTFLAG.
1422 BUFFER is the buffer to evaluate (nil means use current buffer).
1423 PRINTFLAG controls printing of output:
1424 nil means discard it; anything else is stream for print.
1426 If the optional third argument FILENAME is non-nil,
1427 it specifies the file name to use for `load-history'.
1428 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1429 for this invocation.
1431 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1432 `print' and related functions should work normally even if PRINTFLAG is nil.
1434 This function preserves the position of point. */)
1435 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1436 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1438 int count
= SPECPDL_INDEX ();
1439 Lisp_Object tem
, buf
;
1442 buf
= Fcurrent_buffer ();
1444 buf
= Fget_buffer (buffer
);
1446 error ("No such buffer");
1448 if (NILP (printflag
) && NILP (do_allow_print
))
1453 if (NILP (filename
))
1454 filename
= XBUFFER (buf
)->filename
;
1456 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1457 specbind (Qstandard_output
, tem
);
1458 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1459 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1460 readevalloop (buf
, 0, filename
, Feval
,
1461 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1462 unbind_to (count
, Qnil
);
1467 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1468 doc
: /* Execute the region as Lisp code.
1469 When called from programs, expects two arguments,
1470 giving starting and ending indices in the current buffer
1471 of the text to be executed.
1472 Programs can pass third argument PRINTFLAG which controls output:
1473 nil means discard it; anything else is stream for printing it.
1474 Also the fourth argument READ-FUNCTION, if non-nil, is used
1475 instead of `read' to read each expression. It gets one argument
1476 which is the input stream for reading characters.
1478 This function does not move point. */)
1479 (start
, end
, printflag
, read_function
)
1480 Lisp_Object start
, end
, printflag
, read_function
;
1482 int count
= SPECPDL_INDEX ();
1483 Lisp_Object tem
, cbuf
;
1485 cbuf
= Fcurrent_buffer ();
1487 if (NILP (printflag
))
1491 specbind (Qstandard_output
, tem
);
1492 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1494 /* readevalloop calls functions which check the type of start and end. */
1495 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1496 !NILP (printflag
), Qnil
, read_function
,
1499 return unbind_to (count
, Qnil
);
1503 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1504 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1505 If STREAM is nil, use the value of `standard-input' (which see).
1506 STREAM or the value of `standard-input' may be:
1507 a buffer (read from point and advance it)
1508 a marker (read from where it points and advance it)
1509 a function (call it with no arguments for each character,
1510 call it with a char as argument to push a char back)
1511 a string (takes text from string, starting at the beginning)
1512 t (read text line using minibuffer and use it, or read from
1513 standard input in batch mode). */)
1518 stream
= Vstandard_input
;
1519 if (EQ (stream
, Qt
))
1520 stream
= Qread_char
;
1521 if (EQ (stream
, Qread_char
))
1522 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1524 return read_internal_start (stream
, Qnil
, Qnil
);
1527 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1528 doc
: /* Read one Lisp expression which is represented as text by STRING.
1529 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1530 START and END optionally delimit a substring of STRING from which to read;
1531 they default to 0 and (length STRING) respectively. */)
1532 (string
, start
, end
)
1533 Lisp_Object string
, start
, end
;
1536 CHECK_STRING (string
);
1537 /* read_internal_start sets read_from_string_index. */
1538 ret
= read_internal_start (string
, start
, end
);
1539 return Fcons (ret
, make_number (read_from_string_index
));
1542 /* Function to set up the global context we need in toplevel read
1545 read_internal_start (stream
, start
, end
)
1547 Lisp_Object start
; /* Only used when stream is a string. */
1548 Lisp_Object end
; /* Only used when stream is a string. */
1552 readchar_backlog
= -1;
1554 new_backquote_flag
= 0;
1555 read_objects
= Qnil
;
1556 if (EQ (Vread_with_symbol_positions
, Qt
)
1557 || EQ (Vread_with_symbol_positions
, stream
))
1558 Vread_symbol_positions_list
= Qnil
;
1560 if (STRINGP (stream
))
1562 int startval
, endval
;
1564 endval
= SCHARS (stream
);
1568 endval
= XINT (end
);
1569 if (endval
< 0 || endval
> SCHARS (stream
))
1570 args_out_of_range (stream
, end
);
1577 CHECK_NUMBER (start
);
1578 startval
= XINT (start
);
1579 if (startval
< 0 || startval
> endval
)
1580 args_out_of_range (stream
, start
);
1582 read_from_string_index
= startval
;
1583 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1584 read_from_string_limit
= endval
;
1587 retval
= read0 (stream
);
1588 if (EQ (Vread_with_symbol_positions
, Qt
)
1589 || EQ (Vread_with_symbol_positions
, stream
))
1590 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1594 /* Use this for recursive reads, in contexts where internal tokens
1599 Lisp_Object readcharfun
;
1601 register Lisp_Object val
;
1604 val
= read1 (readcharfun
, &c
, 0);
1606 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1613 static int read_buffer_size
;
1614 static char *read_buffer
;
1616 /* Read multibyte form and return it as a character. C is a first
1617 byte of multibyte form, and rest of them are read from
1621 read_multibyte (c
, readcharfun
)
1623 Lisp_Object readcharfun
;
1625 /* We need the actual character code of this multibyte
1627 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1635 while ((c
= READCHAR
) >= 0xA0
1636 && len
< MAX_MULTIBYTE_LENGTH
)
1642 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1643 return STRING_CHAR (str
, len
);
1644 /* The byte sequence is not valid as multibyte. Unread all bytes
1645 but the first one, and return the first byte. */
1651 /* Read a \-escape sequence, assuming we already read the `\'.
1652 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1653 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1654 Otherwise store 0 into *BYTEREP. */
1657 read_escape (readcharfun
, stringp
, byterep
)
1658 Lisp_Object readcharfun
;
1662 register int c
= READCHAR
;
1669 end_of_file_error ();
1699 error ("Invalid escape character syntax");
1702 c
= read_escape (readcharfun
, 0, byterep
);
1703 return c
| meta_modifier
;
1708 error ("Invalid escape character syntax");
1711 c
= read_escape (readcharfun
, 0, byterep
);
1712 return c
| shift_modifier
;
1717 error ("Invalid escape character syntax");
1720 c
= read_escape (readcharfun
, 0, byterep
);
1721 return c
| hyper_modifier
;
1726 error ("Invalid escape character syntax");
1729 c
= read_escape (readcharfun
, 0, byterep
);
1730 return c
| alt_modifier
;
1742 c
= read_escape (readcharfun
, 0, byterep
);
1743 return c
| super_modifier
;
1748 error ("Invalid escape character syntax");
1752 c
= read_escape (readcharfun
, 0, byterep
);
1753 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1754 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1755 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1756 return c
| ctrl_modifier
;
1757 /* ASCII control chars are made from letters (both cases),
1758 as well as the non-letters within 0100...0137. */
1759 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1760 return (c
& (037 | ~0177));
1761 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1762 return (c
& (037 | ~0177));
1764 return c
| ctrl_modifier
;
1774 /* An octal escape, as in ANSI C. */
1776 register int i
= c
- '0';
1777 register int count
= 0;
1780 if ((c
= READCHAR
) >= '0' && c
<= '7')
1797 /* A hex escape, as in ANSI C. */
1803 if (c
>= '0' && c
<= '9')
1808 else if ((c
>= 'a' && c
<= 'f')
1809 || (c
>= 'A' && c
<= 'F'))
1812 if (c
>= 'a' && c
<= 'f')
1829 if (BASE_LEADING_CODE_P (c
))
1830 c
= read_multibyte (c
, readcharfun
);
1836 /* Read an integer in radix RADIX using READCHARFUN to read
1837 characters. RADIX must be in the interval [2..36]; if it isn't, a
1838 read error is signaled . Value is the integer read. Signals an
1839 error if encountering invalid read syntax or if RADIX is out of
1843 read_integer (readcharfun
, radix
)
1844 Lisp_Object readcharfun
;
1847 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1848 EMACS_INT number
= 0;
1850 if (radix
< 2 || radix
> 36)
1854 number
= ndigits
= invalid_p
= 0;
1870 if (c
>= '0' && c
<= '9')
1872 else if (c
>= 'a' && c
<= 'z')
1873 digit
= c
- 'a' + 10;
1874 else if (c
>= 'A' && c
<= 'Z')
1875 digit
= c
- 'A' + 10;
1882 if (digit
< 0 || digit
>= radix
)
1885 number
= radix
* number
+ digit
;
1891 if (ndigits
== 0 || invalid_p
)
1894 sprintf (buf
, "integer, radix %d", radix
);
1895 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1898 return make_number (sign
* number
);
1902 /* Convert unibyte text in read_buffer to multibyte.
1904 Initially, *P is a pointer after the end of the unibyte text, and
1905 the pointer *END points after the end of read_buffer.
1907 If read_buffer doesn't have enough room to hold the result
1908 of the conversion, reallocate it and adjust *P and *END.
1910 At the end, make *P point after the result of the conversion, and
1911 return in *NCHARS the number of characters in the converted
1915 to_multibyte (p
, end
, nchars
)
1921 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1922 if (read_buffer_size
< 2 * nbytes
)
1924 int offset
= *p
- read_buffer
;
1925 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1926 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1927 *p
= read_buffer
+ offset
;
1928 *end
= read_buffer
+ read_buffer_size
;
1931 if (nbytes
!= *nchars
)
1932 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1933 *p
- read_buffer
, nchars
);
1935 *p
= read_buffer
+ nbytes
;
1939 /* If the next token is ')' or ']' or '.', we store that character
1940 in *PCH and the return value is not interesting. Else, we store
1941 zero in *PCH and we read and return one lisp object.
1943 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1946 read1 (readcharfun
, pch
, first_in_list
)
1947 register Lisp_Object readcharfun
;
1952 int uninterned_symbol
= 0;
1960 end_of_file_error ();
1965 return read_list (0, readcharfun
);
1968 return read_vector (readcharfun
, 0);
1985 tmp
= read_vector (readcharfun
, 0);
1986 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1987 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1988 error ("Invalid size char-table");
1989 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1990 XCHAR_TABLE (tmp
)->top
= Qt
;
1999 tmp
= read_vector (readcharfun
, 0);
2000 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2001 error ("Invalid size char-table");
2002 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2003 XCHAR_TABLE (tmp
)->top
= Qnil
;
2006 Fsignal (Qinvalid_read_syntax
,
2007 Fcons (make_string ("#^^", 3), Qnil
));
2009 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2014 length
= read1 (readcharfun
, pch
, first_in_list
);
2018 Lisp_Object tmp
, val
;
2020 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2021 / BOOL_VECTOR_BITS_PER_CHAR
);
2024 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2025 if (size_in_chars
!= SCHARS (tmp
)
2026 /* We used to print 1 char too many
2027 when the number of bits was a multiple of 8.
2028 Accept such input in case it came from an old version. */
2029 && ! (XFASTINT (length
)
2030 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2031 Fsignal (Qinvalid_read_syntax
,
2032 Fcons (make_string ("#&...", 5), Qnil
));
2034 val
= Fmake_bool_vector (length
, Qnil
);
2035 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2037 /* Clear the extraneous bits in the last byte. */
2038 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2039 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2040 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2043 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2048 /* Accept compiled functions at read-time so that we don't have to
2049 build them using function calls. */
2051 tmp
= read_vector (readcharfun
, 1);
2052 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2053 XVECTOR (tmp
)->contents
);
2058 struct gcpro gcpro1
;
2061 /* Read the string itself. */
2062 tmp
= read1 (readcharfun
, &ch
, 0);
2063 if (ch
!= 0 || !STRINGP (tmp
))
2064 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2066 /* Read the intervals and their properties. */
2069 Lisp_Object beg
, end
, plist
;
2071 beg
= read1 (readcharfun
, &ch
, 0);
2076 end
= read1 (readcharfun
, &ch
, 0);
2078 plist
= read1 (readcharfun
, &ch
, 0);
2080 Fsignal (Qinvalid_read_syntax
,
2081 Fcons (build_string ("invalid string property list"),
2083 Fset_text_properties (beg
, end
, plist
, tmp
);
2089 /* #@NUMBER is used to skip NUMBER following characters.
2090 That's used in .elc files to skip over doc strings
2091 and function definitions. */
2096 /* Read a decimal integer. */
2097 while ((c
= READCHAR
) >= 0
2098 && c
>= '0' && c
<= '9')
2106 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2108 /* If we are supposed to force doc strings into core right now,
2109 record the last string that we skipped,
2110 and record where in the file it comes from. */
2112 /* But first exchange saved_doc_string
2113 with prev_saved_doc_string, so we save two strings. */
2115 char *temp
= saved_doc_string
;
2116 int temp_size
= saved_doc_string_size
;
2117 file_offset temp_pos
= saved_doc_string_position
;
2118 int temp_len
= saved_doc_string_length
;
2120 saved_doc_string
= prev_saved_doc_string
;
2121 saved_doc_string_size
= prev_saved_doc_string_size
;
2122 saved_doc_string_position
= prev_saved_doc_string_position
;
2123 saved_doc_string_length
= prev_saved_doc_string_length
;
2125 prev_saved_doc_string
= temp
;
2126 prev_saved_doc_string_size
= temp_size
;
2127 prev_saved_doc_string_position
= temp_pos
;
2128 prev_saved_doc_string_length
= temp_len
;
2131 if (saved_doc_string_size
== 0)
2133 saved_doc_string_size
= nskip
+ 100;
2134 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2136 if (nskip
> saved_doc_string_size
)
2138 saved_doc_string_size
= nskip
+ 100;
2139 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2140 saved_doc_string_size
);
2143 saved_doc_string_position
= file_tell (instream
);
2145 /* Copy that many characters into saved_doc_string. */
2146 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2147 saved_doc_string
[i
] = c
= READCHAR
;
2149 saved_doc_string_length
= i
;
2153 /* Skip that many characters. */
2154 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2162 /* #! appears at the beginning of an executable file.
2163 Skip the first line. */
2164 while (c
!= '\n' && c
>= 0)
2169 return Vload_file_name
;
2171 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2172 /* #:foo is the uninterned symbol named foo. */
2175 uninterned_symbol
= 1;
2179 /* Reader forms that can reuse previously read objects. */
2180 if (c
>= '0' && c
<= '9')
2185 /* Read a non-negative integer. */
2186 while (c
>= '0' && c
<= '9')
2192 /* #n=object returns object, but associates it with n for #n#. */
2195 /* Make a placeholder for #n# to use temporarily */
2196 Lisp_Object placeholder
;
2199 placeholder
= Fcons(Qnil
, Qnil
);
2200 cell
= Fcons (make_number (n
), placeholder
);
2201 read_objects
= Fcons (cell
, read_objects
);
2203 /* Read the object itself. */
2204 tem
= read0 (readcharfun
);
2206 /* Now put it everywhere the placeholder was... */
2207 substitute_object_in_subtree (tem
, placeholder
);
2209 /* ...and #n# will use the real value from now on. */
2210 Fsetcdr (cell
, tem
);
2214 /* #n# returns a previously read object. */
2217 tem
= Fassq (make_number (n
), read_objects
);
2220 /* Fall through to error message. */
2222 else if (c
== 'r' || c
== 'R')
2223 return read_integer (readcharfun
, n
);
2225 /* Fall through to error message. */
2227 else if (c
== 'x' || c
== 'X')
2228 return read_integer (readcharfun
, 16);
2229 else if (c
== 'o' || c
== 'O')
2230 return read_integer (readcharfun
, 8);
2231 else if (c
== 'b' || c
== 'B')
2232 return read_integer (readcharfun
, 2);
2235 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2238 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2243 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2253 new_backquote_flag
++;
2254 value
= read0 (readcharfun
);
2255 new_backquote_flag
--;
2257 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2261 if (new_backquote_flag
)
2263 Lisp_Object comma_type
= Qnil
;
2268 comma_type
= Qcomma_at
;
2270 comma_type
= Qcomma_dot
;
2273 if (ch
>= 0) UNREAD (ch
);
2274 comma_type
= Qcomma
;
2277 new_backquote_flag
--;
2278 value
= read0 (readcharfun
);
2279 new_backquote_flag
++;
2280 return Fcons (comma_type
, Fcons (value
, Qnil
));
2293 end_of_file_error ();
2295 /* Accept `single space' syntax like (list ? x) where the
2296 whitespace character is SPC or TAB.
2297 Other literal whitespace like NL, CR, and FF are not accepted,
2298 as there are well-established escape sequences for these. */
2299 if (c
== ' ' || c
== '\t')
2300 return make_number (c
);
2303 c
= read_escape (readcharfun
, 0, &discard
);
2304 else if (BASE_LEADING_CODE_P (c
))
2305 c
= read_multibyte (c
, readcharfun
);
2307 next_char
= READCHAR
;
2308 if (next_char
== '.')
2310 /* Only a dotted-pair dot is valid after a char constant. */
2311 int next_next_char
= READCHAR
;
2312 UNREAD (next_next_char
);
2314 ok
= (next_next_char
<= 040
2315 || (next_next_char
< 0200
2316 && (index ("\"';([#?", next_next_char
)
2317 || (!first_in_list
&& next_next_char
== '`')
2318 || (new_backquote_flag
&& next_next_char
== ','))));
2322 ok
= (next_char
<= 040
2323 || (next_char
< 0200
2324 && (index ("\"';()[]#?", next_char
)
2325 || (!first_in_list
&& next_char
== '`')
2326 || (new_backquote_flag
&& next_char
== ','))));
2330 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2332 return make_number (c
);
2337 char *p
= read_buffer
;
2338 char *end
= read_buffer
+ read_buffer_size
;
2340 /* 1 if we saw an escape sequence specifying
2341 a multibyte character, or a multibyte character. */
2342 int force_multibyte
= 0;
2343 /* 1 if we saw an escape sequence specifying
2344 a single-byte character. */
2345 int force_singlebyte
= 0;
2346 /* 1 if read_buffer contains multibyte text now. */
2347 int is_multibyte
= 0;
2351 while ((c
= READCHAR
) >= 0
2354 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2356 int offset
= p
- read_buffer
;
2357 read_buffer
= (char *) xrealloc (read_buffer
,
2358 read_buffer_size
*= 2);
2359 p
= read_buffer
+ offset
;
2360 end
= read_buffer
+ read_buffer_size
;
2367 c
= read_escape (readcharfun
, 1, &byterep
);
2369 /* C is -1 if \ newline has just been seen */
2372 if (p
== read_buffer
)
2378 force_singlebyte
= 1;
2379 else if (byterep
== 2)
2380 force_multibyte
= 1;
2383 /* A character that must be multibyte forces multibyte. */
2384 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2385 force_multibyte
= 1;
2387 /* If we just discovered the need to be multibyte,
2388 convert the text accumulated thus far. */
2389 if (force_multibyte
&& ! is_multibyte
)
2392 to_multibyte (&p
, &end
, &nchars
);
2395 /* Allow `\C- ' and `\C-?'. */
2396 if (c
== (CHAR_CTL
| ' '))
2398 else if (c
== (CHAR_CTL
| '?'))
2403 /* Shift modifier is valid only with [A-Za-z]. */
2404 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2406 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2407 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2411 /* Move the meta bit to the right place for a string. */
2412 c
= (c
& ~CHAR_META
) | 0x80;
2413 if (c
& CHAR_MODIFIER_MASK
)
2414 error ("Invalid modifier in string");
2417 p
+= CHAR_STRING (c
, p
);
2425 end_of_file_error ();
2427 /* If purifying, and string starts with \ newline,
2428 return zero instead. This is for doc strings
2429 that we are really going to find in etc/DOC.nn.nn */
2430 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2431 return make_number (0);
2433 if (is_multibyte
|| force_singlebyte
)
2435 else if (load_convert_to_unibyte
)
2438 to_multibyte (&p
, &end
, &nchars
);
2439 if (p
- read_buffer
!= nchars
)
2441 string
= make_multibyte_string (read_buffer
, nchars
,
2443 return Fstring_make_unibyte (string
);
2445 /* We can make a unibyte string directly. */
2448 else if (EQ (readcharfun
, Qget_file_char
)
2449 || EQ (readcharfun
, Qlambda
))
2451 /* Nowadays, reading directly from a file is used only for
2452 compiled Emacs Lisp files, and those always use the
2453 Emacs internal encoding. Meanwhile, Qlambda is used
2454 for reading dynamic byte code (compiled with
2455 byte-compile-dynamic = t). So make the string multibyte
2456 if the string contains any multibyte sequences.
2457 (to_multibyte is a no-op if not.) */
2458 to_multibyte (&p
, &end
, &nchars
);
2459 is_multibyte
= (p
- read_buffer
) != nchars
;
2462 /* In all other cases, if we read these bytes as
2463 separate characters, treat them as separate characters now. */
2466 /* We want readchar_count to be the number of characters, not
2467 bytes. Hence we adjust for multibyte characters in the
2468 string. ... But it doesn't seem to be necessary, because
2469 READCHAR *does* read multibyte characters from buffers. */
2470 /* readchar_count -= (p - read_buffer) - nchars; */
2472 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2474 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2480 int next_char
= READCHAR
;
2483 if (next_char
<= 040
2484 || (next_char
< 0200
2485 && (index ("\"';([#?", next_char
)
2486 || (!first_in_list
&& next_char
== '`')
2487 || (new_backquote_flag
&& next_char
== ','))))
2493 /* Otherwise, we fall through! Note that the atom-reading loop
2494 below will now loop at least once, assuring that we will not
2495 try to UNREAD two characters in a row. */
2499 if (c
<= 040) goto retry
;
2501 char *p
= read_buffer
;
2505 char *end
= read_buffer
+ read_buffer_size
;
2509 || (!index ("\"';()[]#", c
)
2510 && !(!first_in_list
&& c
== '`')
2511 && !(new_backquote_flag
&& c
== ','))))
2513 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2515 int offset
= p
- read_buffer
;
2516 read_buffer
= (char *) xrealloc (read_buffer
,
2517 read_buffer_size
*= 2);
2518 p
= read_buffer
+ offset
;
2519 end
= read_buffer
+ read_buffer_size
;
2526 end_of_file_error ();
2530 if (! SINGLE_BYTE_CHAR_P (c
))
2531 p
+= CHAR_STRING (c
, p
);
2540 int offset
= p
- read_buffer
;
2541 read_buffer
= (char *) xrealloc (read_buffer
,
2542 read_buffer_size
*= 2);
2543 p
= read_buffer
+ offset
;
2544 end
= read_buffer
+ read_buffer_size
;
2551 if (!quoted
&& !uninterned_symbol
)
2554 register Lisp_Object val
;
2556 if (*p1
== '+' || *p1
== '-') p1
++;
2557 /* Is it an integer? */
2560 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2561 /* Integers can have trailing decimal points. */
2562 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2564 /* It is an integer. */
2568 if (sizeof (int) == sizeof (EMACS_INT
))
2569 XSETINT (val
, atoi (read_buffer
));
2570 else if (sizeof (long) == sizeof (EMACS_INT
))
2571 XSETINT (val
, atol (read_buffer
));
2577 if (isfloat_string (read_buffer
))
2579 /* Compute NaN and infinities using 0.0 in a variable,
2580 to cope with compilers that think they are smarter
2586 /* Negate the value ourselves. This treats 0, NaNs,
2587 and infinity properly on IEEE floating point hosts,
2588 and works around a common bug where atof ("-0.0")
2590 int negative
= read_buffer
[0] == '-';
2592 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2593 returns 1, is if the input ends in e+INF or e+NaN. */
2600 value
= zero
/ zero
;
2602 /* If that made a "negative" NaN, negate it. */
2606 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2609 u_minus_zero
.d
= - 0.0;
2610 for (i
= 0; i
< sizeof (double); i
++)
2611 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2617 /* Now VALUE is a positive NaN. */
2620 value
= atof (read_buffer
+ negative
);
2624 return make_float (negative
? - value
: value
);
2628 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2629 : intern (read_buffer
);
2630 if (EQ (Vread_with_symbol_positions
, Qt
)
2631 || EQ (Vread_with_symbol_positions
, readcharfun
))
2632 Vread_symbol_positions_list
=
2633 /* Kind of a hack; this will probably fail if characters
2634 in the symbol name were escaped. Not really a big
2636 Fcons (Fcons (result
,
2637 make_number (readchar_count
2638 - XFASTINT (Flength (Fsymbol_name (result
))))),
2639 Vread_symbol_positions_list
);
2647 /* List of nodes we've seen during substitute_object_in_subtree. */
2648 static Lisp_Object seen_list
;
2651 substitute_object_in_subtree (object
, placeholder
)
2653 Lisp_Object placeholder
;
2655 Lisp_Object check_object
;
2657 /* We haven't seen any objects when we start. */
2660 /* Make all the substitutions. */
2662 = substitute_object_recurse (object
, placeholder
, object
);
2664 /* Clear seen_list because we're done with it. */
2667 /* The returned object here is expected to always eq the
2669 if (!EQ (check_object
, object
))
2670 error ("Unexpected mutation error in reader");
2673 /* Feval doesn't get called from here, so no gc protection is needed. */
2674 #define SUBSTITUTE(get_val, set_val) \
2676 Lisp_Object old_value = get_val; \
2677 Lisp_Object true_value \
2678 = substitute_object_recurse (object, placeholder,\
2681 if (!EQ (old_value, true_value)) \
2688 substitute_object_recurse (object
, placeholder
, subtree
)
2690 Lisp_Object placeholder
;
2691 Lisp_Object subtree
;
2693 /* If we find the placeholder, return the target object. */
2694 if (EQ (placeholder
, subtree
))
2697 /* If we've been to this node before, don't explore it again. */
2698 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2701 /* If this node can be the entry point to a cycle, remember that
2702 we've seen it. It can only be such an entry point if it was made
2703 by #n=, which means that we can find it as a value in
2705 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2706 seen_list
= Fcons (subtree
, seen_list
);
2708 /* Recurse according to subtree's type.
2709 Every branch must return a Lisp_Object. */
2710 switch (XTYPE (subtree
))
2712 case Lisp_Vectorlike
:
2715 int length
= XINT (Flength(subtree
));
2716 for (i
= 0; i
< length
; i
++)
2718 Lisp_Object idx
= make_number (i
);
2719 SUBSTITUTE (Faref (subtree
, idx
),
2720 Faset (subtree
, idx
, true_value
));
2727 SUBSTITUTE (Fcar_safe (subtree
),
2728 Fsetcar (subtree
, true_value
));
2729 SUBSTITUTE (Fcdr_safe (subtree
),
2730 Fsetcdr (subtree
, true_value
));
2736 /* Check for text properties in each interval.
2737 substitute_in_interval contains part of the logic. */
2739 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2740 Lisp_Object arg
= Fcons (object
, placeholder
);
2742 traverse_intervals_noorder (root_interval
,
2743 &substitute_in_interval
, arg
);
2748 /* Other types don't recurse any further. */
2754 /* Helper function for substitute_object_recurse. */
2756 substitute_in_interval (interval
, arg
)
2760 Lisp_Object object
= Fcar (arg
);
2761 Lisp_Object placeholder
= Fcdr (arg
);
2763 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2782 if (*cp
== '+' || *cp
== '-')
2785 if (*cp
>= '0' && *cp
<= '9')
2788 while (*cp
>= '0' && *cp
<= '9')
2796 if (*cp
>= '0' && *cp
<= '9')
2799 while (*cp
>= '0' && *cp
<= '9')
2802 if (*cp
== 'e' || *cp
== 'E')
2806 if (*cp
== '+' || *cp
== '-')
2810 if (*cp
>= '0' && *cp
<= '9')
2813 while (*cp
>= '0' && *cp
<= '9')
2816 else if (cp
== start
)
2818 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2823 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2829 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2830 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2831 || state
== (DOT_CHAR
|TRAIL_INT
)
2832 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2833 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2834 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2839 read_vector (readcharfun
, bytecodeflag
)
2840 Lisp_Object readcharfun
;
2845 register Lisp_Object
*ptr
;
2846 register Lisp_Object tem
, item
, vector
;
2847 register struct Lisp_Cons
*otem
;
2850 tem
= read_list (1, readcharfun
);
2851 len
= Flength (tem
);
2852 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2854 size
= XVECTOR (vector
)->size
;
2855 ptr
= XVECTOR (vector
)->contents
;
2856 for (i
= 0; i
< size
; i
++)
2859 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2860 bytecode object, the docstring containing the bytecode and
2861 constants values must be treated as unibyte and passed to
2862 Fread, to get the actual bytecode string and constants vector. */
2863 if (bytecodeflag
&& load_force_doc_strings
)
2865 if (i
== COMPILED_BYTECODE
)
2867 if (!STRINGP (item
))
2868 error ("Invalid byte code");
2870 /* Delay handling the bytecode slot until we know whether
2871 it is lazily-loaded (we can tell by whether the
2872 constants slot is nil). */
2873 ptr
[COMPILED_CONSTANTS
] = item
;
2876 else if (i
== COMPILED_CONSTANTS
)
2878 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2882 /* Coerce string to unibyte (like string-as-unibyte,
2883 but without generating extra garbage and
2884 guaranteeing no change in the contents). */
2885 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2886 STRING_SET_UNIBYTE (bytestr
);
2888 item
= Fread (bytestr
);
2890 error ("Invalid byte code");
2892 otem
= XCONS (item
);
2893 bytestr
= XCAR (item
);
2898 /* Now handle the bytecode slot. */
2899 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2902 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2910 /* FLAG = 1 means check for ] to terminate rather than ) and .
2911 FLAG = -1 means check for starting with defun
2912 and make structure pure. */
2915 read_list (flag
, readcharfun
)
2917 register Lisp_Object readcharfun
;
2919 /* -1 means check next element for defun,
2920 0 means don't check,
2921 1 means already checked and found defun. */
2922 int defunflag
= flag
< 0 ? -1 : 0;
2923 Lisp_Object val
, tail
;
2924 register Lisp_Object elt
, tem
;
2925 struct gcpro gcpro1
, gcpro2
;
2926 /* 0 is the normal case.
2927 1 means this list is a doc reference; replace it with the number 0.
2928 2 means this list is a doc reference; replace it with the doc string. */
2929 int doc_reference
= 0;
2931 /* Initialize this to 1 if we are reading a list. */
2932 int first_in_list
= flag
<= 0;
2941 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2946 /* While building, if the list starts with #$, treat it specially. */
2947 if (EQ (elt
, Vload_file_name
)
2949 && !NILP (Vpurify_flag
))
2951 if (NILP (Vdoc_file_name
))
2952 /* We have not yet called Snarf-documentation, so assume
2953 this file is described in the DOC-MM.NN file
2954 and Snarf-documentation will fill in the right value later.
2955 For now, replace the whole list with 0. */
2958 /* We have already called Snarf-documentation, so make a relative
2959 file name for this file, so it can be found properly
2960 in the installed Lisp directory.
2961 We don't use Fexpand_file_name because that would make
2962 the directory absolute now. */
2963 elt
= concat2 (build_string ("../lisp/"),
2964 Ffile_name_nondirectory (elt
));
2966 else if (EQ (elt
, Vload_file_name
)
2968 && load_force_doc_strings
)
2977 Fsignal (Qinvalid_read_syntax
,
2978 Fcons (make_string (") or . in a vector", 18), Qnil
));
2986 XSETCDR (tail
, read0 (readcharfun
));
2988 val
= read0 (readcharfun
);
2989 read1 (readcharfun
, &ch
, 0);
2993 if (doc_reference
== 1)
2994 return make_number (0);
2995 if (doc_reference
== 2)
2997 /* Get a doc string from the file we are loading.
2998 If it's in saved_doc_string, get it from there. */
2999 int pos
= XINT (XCDR (val
));
3000 /* Position is negative for user variables. */
3001 if (pos
< 0) pos
= -pos
;
3002 if (pos
>= saved_doc_string_position
3003 && pos
< (saved_doc_string_position
3004 + saved_doc_string_length
))
3006 int start
= pos
- saved_doc_string_position
;
3009 /* Process quoting with ^A,
3010 and find the end of the string,
3011 which is marked with ^_ (037). */
3012 for (from
= start
, to
= start
;
3013 saved_doc_string
[from
] != 037;)
3015 int c
= saved_doc_string
[from
++];
3018 c
= saved_doc_string
[from
++];
3020 saved_doc_string
[to
++] = c
;
3022 saved_doc_string
[to
++] = 0;
3024 saved_doc_string
[to
++] = 037;
3027 saved_doc_string
[to
++] = c
;
3030 return make_string (saved_doc_string
+ start
,
3033 /* Look in prev_saved_doc_string the same way. */
3034 else if (pos
>= prev_saved_doc_string_position
3035 && pos
< (prev_saved_doc_string_position
3036 + prev_saved_doc_string_length
))
3038 int start
= pos
- prev_saved_doc_string_position
;
3041 /* Process quoting with ^A,
3042 and find the end of the string,
3043 which is marked with ^_ (037). */
3044 for (from
= start
, to
= start
;
3045 prev_saved_doc_string
[from
] != 037;)
3047 int c
= prev_saved_doc_string
[from
++];
3050 c
= prev_saved_doc_string
[from
++];
3052 prev_saved_doc_string
[to
++] = c
;
3054 prev_saved_doc_string
[to
++] = 0;
3056 prev_saved_doc_string
[to
++] = 037;
3059 prev_saved_doc_string
[to
++] = c
;
3062 return make_string (prev_saved_doc_string
+ start
,
3066 return get_doc_string (val
, 0, 0);
3071 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3073 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3075 tem
= (read_pure
&& flag
<= 0
3076 ? pure_cons (elt
, Qnil
)
3077 : Fcons (elt
, Qnil
));
3079 XSETCDR (tail
, tem
);
3084 defunflag
= EQ (elt
, Qdefun
);
3085 else if (defunflag
> 0)
3090 Lisp_Object Vobarray
;
3091 Lisp_Object initial_obarray
;
3093 /* oblookup stores the bucket number here, for the sake of Funintern. */
3095 int oblookup_last_bucket_number
;
3097 static int hash_string ();
3099 /* Get an error if OBARRAY is not an obarray.
3100 If it is one, return it. */
3103 check_obarray (obarray
)
3104 Lisp_Object obarray
;
3106 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3108 /* If Vobarray is now invalid, force it to be valid. */
3109 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3111 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3116 /* Intern the C string STR: return a symbol with that name,
3117 interned in the current obarray. */
3124 int len
= strlen (str
);
3125 Lisp_Object obarray
;
3128 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3129 obarray
= check_obarray (obarray
);
3130 tem
= oblookup (obarray
, str
, len
, len
);
3133 return Fintern (make_string (str
, len
), obarray
);
3136 /* Create an uninterned symbol with name STR. */
3142 int len
= strlen (str
);
3144 return Fmake_symbol ((!NILP (Vpurify_flag
)
3145 ? make_pure_string (str
, len
, len
, 0)
3146 : make_string (str
, len
)));
3149 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3150 doc
: /* Return the canonical symbol whose name is STRING.
3151 If there is none, one is created by this function and returned.
3152 A second optional argument specifies the obarray to use;
3153 it defaults to the value of `obarray'. */)
3155 Lisp_Object string
, obarray
;
3157 register Lisp_Object tem
, sym
, *ptr
;
3159 if (NILP (obarray
)) obarray
= Vobarray
;
3160 obarray
= check_obarray (obarray
);
3162 CHECK_STRING (string
);
3164 tem
= oblookup (obarray
, SDATA (string
),
3167 if (!INTEGERP (tem
))
3170 if (!NILP (Vpurify_flag
))
3171 string
= Fpurecopy (string
);
3172 sym
= Fmake_symbol (string
);
3174 if (EQ (obarray
, initial_obarray
))
3175 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3177 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3179 if ((SREF (string
, 0) == ':')
3180 && EQ (obarray
, initial_obarray
))
3182 XSYMBOL (sym
)->constant
= 1;
3183 XSYMBOL (sym
)->value
= sym
;
3186 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3188 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3190 XSYMBOL (sym
)->next
= 0;
3195 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3196 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3197 NAME may be a string or a symbol. If it is a symbol, that exact
3198 symbol is searched for.
3199 A second optional argument specifies the obarray to use;
3200 it defaults to the value of `obarray'. */)
3202 Lisp_Object name
, obarray
;
3204 register Lisp_Object tem
, string
;
3206 if (NILP (obarray
)) obarray
= Vobarray
;
3207 obarray
= check_obarray (obarray
);
3209 if (!SYMBOLP (name
))
3211 CHECK_STRING (name
);
3215 string
= SYMBOL_NAME (name
);
3217 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3218 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3224 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3225 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3226 The value is t if a symbol was found and deleted, nil otherwise.
3227 NAME may be a string or a symbol. If it is a symbol, that symbol
3228 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3229 OBARRAY defaults to the value of the variable `obarray'. */)
3231 Lisp_Object name
, obarray
;
3233 register Lisp_Object string
, tem
;
3236 if (NILP (obarray
)) obarray
= Vobarray
;
3237 obarray
= check_obarray (obarray
);
3240 string
= SYMBOL_NAME (name
);
3243 CHECK_STRING (name
);
3247 tem
= oblookup (obarray
, SDATA (string
),
3252 /* If arg was a symbol, don't delete anything but that symbol itself. */
3253 if (SYMBOLP (name
) && !EQ (name
, tem
))
3256 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3257 XSYMBOL (tem
)->constant
= 0;
3258 XSYMBOL (tem
)->indirect_variable
= 0;
3260 hash
= oblookup_last_bucket_number
;
3262 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3264 if (XSYMBOL (tem
)->next
)
3265 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3267 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3271 Lisp_Object tail
, following
;
3273 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3274 XSYMBOL (tail
)->next
;
3277 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3278 if (EQ (following
, tem
))
3280 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3289 /* Return the symbol in OBARRAY whose names matches the string
3290 of SIZE characters (SIZE_BYTE bytes) at PTR.
3291 If there is no such symbol in OBARRAY, return nil.
3293 Also store the bucket number in oblookup_last_bucket_number. */
3296 oblookup (obarray
, ptr
, size
, size_byte
)
3297 Lisp_Object obarray
;
3298 register const char *ptr
;
3299 int size
, size_byte
;
3303 register Lisp_Object tail
;
3304 Lisp_Object bucket
, tem
;
3306 if (!VECTORP (obarray
)
3307 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3309 obarray
= check_obarray (obarray
);
3310 obsize
= XVECTOR (obarray
)->size
;
3312 /* This is sometimes needed in the middle of GC. */
3313 obsize
&= ~ARRAY_MARK_FLAG
;
3314 /* Combining next two lines breaks VMS C 2.3. */
3315 hash
= hash_string (ptr
, size_byte
);
3317 bucket
= XVECTOR (obarray
)->contents
[hash
];
3318 oblookup_last_bucket_number
= hash
;
3319 if (EQ (bucket
, make_number (0)))
3321 else if (!SYMBOLP (bucket
))
3322 error ("Bad data in guts of obarray"); /* Like CADR error message */
3324 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3326 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3327 && SCHARS (SYMBOL_NAME (tail
)) == size
3328 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3330 else if (XSYMBOL (tail
)->next
== 0)
3333 XSETINT (tem
, hash
);
3338 hash_string (ptr
, len
)
3339 const unsigned char *ptr
;
3342 register const unsigned char *p
= ptr
;
3343 register const unsigned char *end
= p
+ len
;
3344 register unsigned char c
;
3345 register int hash
= 0;
3350 if (c
>= 0140) c
-= 40;
3351 hash
= ((hash
<<3) + (hash
>>28) + c
);
3353 return hash
& 07777777777;
3357 map_obarray (obarray
, fn
, arg
)
3358 Lisp_Object obarray
;
3359 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3363 register Lisp_Object tail
;
3364 CHECK_VECTOR (obarray
);
3365 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3367 tail
= XVECTOR (obarray
)->contents
[i
];
3372 if (XSYMBOL (tail
)->next
== 0)
3374 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3380 mapatoms_1 (sym
, function
)
3381 Lisp_Object sym
, function
;
3383 call1 (function
, sym
);
3386 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3387 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3388 OBARRAY defaults to the value of `obarray'. */)
3390 Lisp_Object function
, obarray
;
3392 if (NILP (obarray
)) obarray
= Vobarray
;
3393 obarray
= check_obarray (obarray
);
3395 map_obarray (obarray
, mapatoms_1
, function
);
3399 #define OBARRAY_SIZE 1511
3404 Lisp_Object oblength
;
3408 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3410 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3411 Vobarray
= Fmake_vector (oblength
, make_number (0));
3412 initial_obarray
= Vobarray
;
3413 staticpro (&initial_obarray
);
3414 /* Intern nil in the obarray */
3415 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3416 XSYMBOL (Qnil
)->constant
= 1;
3418 /* These locals are to kludge around a pyramid compiler bug. */
3419 hash
= hash_string ("nil", 3);
3420 /* Separate statement here to avoid VAXC bug. */
3421 hash
%= OBARRAY_SIZE
;
3422 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3425 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3426 XSYMBOL (Qnil
)->function
= Qunbound
;
3427 XSYMBOL (Qunbound
)->value
= Qunbound
;
3428 XSYMBOL (Qunbound
)->function
= Qunbound
;
3431 XSYMBOL (Qnil
)->value
= Qnil
;
3432 XSYMBOL (Qnil
)->plist
= Qnil
;
3433 XSYMBOL (Qt
)->value
= Qt
;
3434 XSYMBOL (Qt
)->constant
= 1;
3436 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3439 Qvariable_documentation
= intern ("variable-documentation");
3440 staticpro (&Qvariable_documentation
);
3442 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3443 read_buffer
= (char *) xmalloc (read_buffer_size
);
3448 struct Lisp_Subr
*sname
;
3451 sym
= intern (sname
->symbol_name
);
3452 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3455 #ifdef NOTDEF /* use fset in subr.el now */
3457 defalias (sname
, string
)
3458 struct Lisp_Subr
*sname
;
3462 sym
= intern (string
);
3463 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3467 /* Define an "integer variable"; a symbol whose value is forwarded
3468 to a C variable of type int. Sample call: */
3469 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3471 defvar_int (namestring
, address
)
3475 Lisp_Object sym
, val
;
3476 sym
= intern (namestring
);
3477 val
= allocate_misc ();
3478 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3479 XINTFWD (val
)->intvar
= address
;
3480 SET_SYMBOL_VALUE (sym
, val
);
3483 /* Similar but define a variable whose value is t if address contains 1,
3484 nil if address contains 0 */
3486 defvar_bool (namestring
, address
)
3490 Lisp_Object sym
, val
;
3491 sym
= intern (namestring
);
3492 val
= allocate_misc ();
3493 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3494 XBOOLFWD (val
)->boolvar
= address
;
3495 SET_SYMBOL_VALUE (sym
, val
);
3496 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3499 /* Similar but define a variable whose value is the Lisp Object stored
3500 at address. Two versions: with and without gc-marking of the C
3501 variable. The nopro version is used when that variable will be
3502 gc-marked for some other reason, since marking the same slot twice
3503 can cause trouble with strings. */
3505 defvar_lisp_nopro (namestring
, address
)
3507 Lisp_Object
*address
;
3509 Lisp_Object sym
, val
;
3510 sym
= intern (namestring
);
3511 val
= allocate_misc ();
3512 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3513 XOBJFWD (val
)->objvar
= address
;
3514 SET_SYMBOL_VALUE (sym
, val
);
3518 defvar_lisp (namestring
, address
)
3520 Lisp_Object
*address
;
3522 defvar_lisp_nopro (namestring
, address
);
3523 staticpro (address
);
3526 /* Similar but define a variable whose value is the Lisp Object stored in
3527 the current buffer. address is the address of the slot in the buffer
3528 that is current now. */
3531 defvar_per_buffer (namestring
, address
, type
, doc
)
3533 Lisp_Object
*address
;
3537 Lisp_Object sym
, val
;
3540 sym
= intern (namestring
);
3541 val
= allocate_misc ();
3542 offset
= (char *)address
- (char *)current_buffer
;
3544 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3545 XBUFFER_OBJFWD (val
)->offset
= offset
;
3546 SET_SYMBOL_VALUE (sym
, val
);
3547 PER_BUFFER_SYMBOL (offset
) = sym
;
3548 PER_BUFFER_TYPE (offset
) = type
;
3550 if (PER_BUFFER_IDX (offset
) == 0)
3551 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3552 slot of buffer_local_flags */
3557 /* Similar but define a variable whose value is the Lisp Object stored
3558 at a particular offset in the current kboard object. */
3561 defvar_kboard (namestring
, offset
)
3565 Lisp_Object sym
, val
;
3566 sym
= intern (namestring
);
3567 val
= allocate_misc ();
3568 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3569 XKBOARD_OBJFWD (val
)->offset
= offset
;
3570 SET_SYMBOL_VALUE (sym
, val
);
3573 /* Record the value of load-path used at the start of dumping
3574 so we can see if the site changed it later during dumping. */
3575 static Lisp_Object dump_path
;
3581 int turn_off_warning
= 0;
3583 /* Compute the default load-path. */
3585 normal
= PATH_LOADSEARCH
;
3586 Vload_path
= decode_env_path (0, normal
);
3588 if (NILP (Vpurify_flag
))
3589 normal
= PATH_LOADSEARCH
;
3591 normal
= PATH_DUMPLOADSEARCH
;
3593 /* In a dumped Emacs, we normally have to reset the value of
3594 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3595 uses ../lisp, instead of the path of the installed elisp
3596 libraries. However, if it appears that Vload_path was changed
3597 from the default before dumping, don't override that value. */
3600 if (! NILP (Fequal (dump_path
, Vload_path
)))
3602 Vload_path
= decode_env_path (0, normal
);
3603 if (!NILP (Vinstallation_directory
))
3605 Lisp_Object tem
, tem1
, sitelisp
;
3607 /* Remove site-lisp dirs from path temporarily and store
3608 them in sitelisp, then conc them on at the end so
3609 they're always first in path. */
3613 tem
= Fcar (Vload_path
);
3614 tem1
= Fstring_match (build_string ("site-lisp"),
3618 Vload_path
= Fcdr (Vload_path
);
3619 sitelisp
= Fcons (tem
, sitelisp
);
3625 /* Add to the path the lisp subdir of the
3626 installation dir, if it exists. */
3627 tem
= Fexpand_file_name (build_string ("lisp"),
3628 Vinstallation_directory
);
3629 tem1
= Ffile_exists_p (tem
);
3632 if (NILP (Fmember (tem
, Vload_path
)))
3634 turn_off_warning
= 1;
3635 Vload_path
= Fcons (tem
, Vload_path
);
3639 /* That dir doesn't exist, so add the build-time
3640 Lisp dirs instead. */
3641 Vload_path
= nconc2 (Vload_path
, dump_path
);
3643 /* Add leim under the installation dir, if it exists. */
3644 tem
= Fexpand_file_name (build_string ("leim"),
3645 Vinstallation_directory
);
3646 tem1
= Ffile_exists_p (tem
);
3649 if (NILP (Fmember (tem
, Vload_path
)))
3650 Vload_path
= Fcons (tem
, Vload_path
);
3653 /* Add site-list under the installation dir, if it exists. */
3654 tem
= Fexpand_file_name (build_string ("site-lisp"),
3655 Vinstallation_directory
);
3656 tem1
= Ffile_exists_p (tem
);
3659 if (NILP (Fmember (tem
, Vload_path
)))
3660 Vload_path
= Fcons (tem
, Vload_path
);
3663 /* If Emacs was not built in the source directory,
3664 and it is run from where it was built, add to load-path
3665 the lisp, leim and site-lisp dirs under that directory. */
3667 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3671 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3672 Vinstallation_directory
);
3673 tem1
= Ffile_exists_p (tem
);
3675 /* Don't be fooled if they moved the entire source tree
3676 AFTER dumping Emacs. If the build directory is indeed
3677 different from the source dir, src/Makefile.in and
3678 src/Makefile will not be found together. */
3679 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3680 Vinstallation_directory
);
3681 tem2
= Ffile_exists_p (tem
);
3682 if (!NILP (tem1
) && NILP (tem2
))
3684 tem
= Fexpand_file_name (build_string ("lisp"),
3687 if (NILP (Fmember (tem
, Vload_path
)))
3688 Vload_path
= Fcons (tem
, Vload_path
);
3690 tem
= Fexpand_file_name (build_string ("leim"),
3693 if (NILP (Fmember (tem
, Vload_path
)))
3694 Vload_path
= Fcons (tem
, Vload_path
);
3696 tem
= Fexpand_file_name (build_string ("site-lisp"),
3699 if (NILP (Fmember (tem
, Vload_path
)))
3700 Vload_path
= Fcons (tem
, Vload_path
);
3703 if (!NILP (sitelisp
))
3704 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3710 /* NORMAL refers to the lisp dir in the source directory. */
3711 /* We used to add ../lisp at the front here, but
3712 that caused trouble because it was copied from dump_path
3713 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3714 It should be unnecessary. */
3715 Vload_path
= decode_env_path (0, normal
);
3716 dump_path
= Vload_path
;
3720 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3721 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3722 almost never correct, thereby causing a warning to be printed out that
3723 confuses users. Since PATH_LOADSEARCH is always overridden by the
3724 EMACSLOADPATH environment variable below, disable the warning on NT.
3725 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3726 the "standard" paths may not exist and would be overridden by
3727 EMACSLOADPATH as on NT. Since this depends on how the executable
3728 was build and packaged, turn off the warnings in general */
3730 /* Warn if dirs in the *standard* path don't exist. */
3731 if (!turn_off_warning
)
3733 Lisp_Object path_tail
;
3735 for (path_tail
= Vload_path
;
3737 path_tail
= XCDR (path_tail
))
3739 Lisp_Object dirfile
;
3740 dirfile
= Fcar (path_tail
);
3741 if (STRINGP (dirfile
))
3743 dirfile
= Fdirectory_file_name (dirfile
);
3744 if (access (SDATA (dirfile
), 0) < 0)
3745 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3750 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3752 /* If the EMACSLOADPATH environment variable is set, use its value.
3753 This doesn't apply if we're dumping. */
3755 if (NILP (Vpurify_flag
)
3756 && egetenv ("EMACSLOADPATH"))
3758 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3762 load_in_progress
= 0;
3763 Vload_file_name
= Qnil
;
3765 load_descriptor_list
= Qnil
;
3767 Vstandard_input
= Qt
;
3768 Vloads_in_progress
= Qnil
;
3771 /* Print a warning, using format string FORMAT, that directory DIRNAME
3772 does not exist. Print it on stderr and put it in *Message*. */
3775 dir_warning (format
, dirname
)
3777 Lisp_Object dirname
;
3780 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3782 fprintf (stderr
, format
, SDATA (dirname
));
3783 sprintf (buffer
, format
, SDATA (dirname
));
3784 /* Don't log the warning before we've initialized!! */
3786 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3793 defsubr (&Sread_from_string
);
3795 defsubr (&Sintern_soft
);
3796 defsubr (&Sunintern
);
3798 defsubr (&Seval_buffer
);
3799 defsubr (&Seval_region
);
3800 defsubr (&Sread_char
);
3801 defsubr (&Sread_char_exclusive
);
3802 defsubr (&Sread_event
);
3803 defsubr (&Sget_file_char
);
3804 defsubr (&Smapatoms
);
3805 defsubr (&Slocate_file_internal
);
3807 DEFVAR_LISP ("obarray", &Vobarray
,
3808 doc
: /* Symbol table for use by `intern' and `read'.
3809 It is a vector whose length ought to be prime for best results.
3810 The vector's contents don't make sense if examined from Lisp programs;
3811 to find all the symbols in an obarray, use `mapatoms'. */);
3813 DEFVAR_LISP ("values", &Vvalues
,
3814 doc
: /* List of values of all expressions which were read, evaluated and printed.
3815 Order is reverse chronological. */);
3817 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3818 doc
: /* Stream for read to get input from.
3819 See documentation of `read' for possible values. */);
3820 Vstandard_input
= Qt
;
3822 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3823 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3825 If this variable is a buffer, then only forms read from that buffer
3826 will be added to `read-symbol-positions-list'.
3827 If this variable is t, then all read forms will be added.
3828 The effect of all other values other than nil are not currently
3829 defined, although they may be in the future.
3831 The positions are relative to the last call to `read' or
3832 `read-from-string'. It is probably a bad idea to set this variable at
3833 the toplevel; bind it instead. */);
3834 Vread_with_symbol_positions
= Qnil
;
3836 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3837 doc
: /* A list mapping read symbols to their positions.
3838 This variable is modified during calls to `read' or
3839 `read-from-string', but only when `read-with-symbol-positions' is
3842 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3843 CHAR-POSITION is an integer giving the offset of that occurrence of the
3844 symbol from the position where `read' or `read-from-string' started.
3846 Note that a symbol will appear multiple times in this list, if it was
3847 read multiple times. The list is in the same order as the symbols
3849 Vread_symbol_positions_list
= Qnil
;
3851 DEFVAR_LISP ("load-path", &Vload_path
,
3852 doc
: /* *List of directories to search for files to load.
3853 Each element is a string (directory name) or nil (try default directory).
3854 Initialized based on EMACSLOADPATH environment variable, if any,
3855 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3857 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3858 doc
: /* *List of suffixes to try for files to load.
3859 This list should not include the empty string. */);
3860 Vload_suffixes
= Fcons (build_string (".elc"),
3861 Fcons (build_string (".el"), Qnil
));
3862 /* We don't use empty_string because it's not initialized yet. */
3863 default_suffixes
= Fcons (build_string (""), Qnil
);
3864 staticpro (&default_suffixes
);
3866 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3867 doc
: /* Non-nil iff inside of `load'. */);
3869 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3870 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3871 Each element looks like (FILENAME FORMS...).
3872 When `load' is run and the file-name argument is FILENAME,
3873 the FORMS in the corresponding element are executed at the end of loading.
3875 FILENAME must match exactly! Normally FILENAME is the name of a library,
3876 with no directory specified, since that is how `load' is normally called.
3877 An error in FORMS does not undo the load,
3878 but does prevent execution of the rest of the FORMS.
3879 FILENAME can also be a symbol (a feature) and FORMS are then executed
3880 when the corresponding call to `provide' is made. */);
3881 Vafter_load_alist
= Qnil
;
3883 DEFVAR_LISP ("load-history", &Vload_history
,
3884 doc
: /* Alist mapping source file names to symbols and features.
3885 Each alist element is a list that starts with a file name,
3886 except for one element (optional) that starts with nil and describes
3887 definitions evaluated from buffers not visiting files.
3888 The remaining elements of each list are symbols defined as variables
3889 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3890 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3891 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3892 and means that SYMBOL was an autoload before this file redefined it
3894 Vload_history
= Qnil
;
3896 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3897 doc
: /* Full name of file being loaded by `load'. */);
3898 Vload_file_name
= Qnil
;
3900 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3901 doc
: /* File name, including directory, of user's initialization file.
3902 If the file loaded had extension `.elc', and the corresponding source file
3903 exists, this variable contains the name of source file, suitable for use
3904 by functions like `custom-save-all' which edit the init file. */);
3905 Vuser_init_file
= Qnil
;
3907 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3908 doc
: /* Used for internal purposes by `load'. */);
3909 Vcurrent_load_list
= Qnil
;
3911 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3912 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3913 The default is nil, which means use the function `read'. */);
3914 Vload_read_function
= Qnil
;
3916 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3917 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3918 This function is for doing code conversion before reading the source file.
3919 If nil, loading is done without any code conversion.
3920 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3921 FULLNAME is the full name of FILE.
3922 See `load' for the meaning of the remaining arguments. */);
3923 Vload_source_file_function
= Qnil
;
3925 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3926 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3927 This is useful when the file being loaded is a temporary copy. */);
3928 load_force_doc_strings
= 0;
3930 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3931 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3932 This is normally bound by `load' and `eval-buffer' to control `read',
3933 and is not meant for users to change. */);
3934 load_convert_to_unibyte
= 0;
3936 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3937 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3938 You cannot count on them to still be there! */);
3940 = Fexpand_file_name (build_string ("../"),
3941 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3943 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3944 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3945 Vpreloaded_file_list
= Qnil
;
3947 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3948 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3949 Vbyte_boolean_vars
= Qnil
;
3951 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3952 doc
: /* Non-nil means load dangerous compiled Lisp files.
3953 Some versions of XEmacs use different byte codes than Emacs. These
3954 incompatible byte codes can make Emacs crash when it tries to execute
3956 load_dangerous_libraries
= 0;
3958 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3959 doc
: /* Regular expression matching safe to load compiled Lisp files.
3960 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3961 from the file, and matches them against this regular expression.
3962 When the regular expression matches, the file is considered to be safe
3963 to load. See also `load-dangerous-libraries'. */);
3964 Vbytecomp_version_regexp
3965 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3967 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
3968 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
3969 Veval_buffer_list
= Qnil
;
3971 /* Vsource_directory was initialized in init_lread. */
3973 load_descriptor_list
= Qnil
;
3974 staticpro (&load_descriptor_list
);
3976 Qcurrent_load_list
= intern ("current-load-list");
3977 staticpro (&Qcurrent_load_list
);
3979 Qstandard_input
= intern ("standard-input");
3980 staticpro (&Qstandard_input
);
3982 Qread_char
= intern ("read-char");
3983 staticpro (&Qread_char
);
3985 Qget_file_char
= intern ("get-file-char");
3986 staticpro (&Qget_file_char
);
3988 Qbackquote
= intern ("`");
3989 staticpro (&Qbackquote
);
3990 Qcomma
= intern (",");
3991 staticpro (&Qcomma
);
3992 Qcomma_at
= intern (",@");
3993 staticpro (&Qcomma_at
);
3994 Qcomma_dot
= intern (",.");
3995 staticpro (&Qcomma_dot
);
3997 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3998 staticpro (&Qinhibit_file_name_operation
);
4000 Qascii_character
= intern ("ascii-character");
4001 staticpro (&Qascii_character
);
4003 Qfunction
= intern ("function");
4004 staticpro (&Qfunction
);
4006 Qload
= intern ("load");
4009 Qload_file_name
= intern ("load-file-name");
4010 staticpro (&Qload_file_name
);
4012 Qeval_buffer_list
= intern ("eval-buffer-list");
4013 staticpro (&Qeval_buffer_list
);
4015 staticpro (&dump_path
);
4017 staticpro (&read_objects
);
4018 read_objects
= Qnil
;
4019 staticpro (&seen_list
);
4022 Vloads_in_progress
= Qnil
;
4023 staticpro (&Vloads_in_progress
);
4026 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4027 (do not change this comment) */