1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
32 #include "intervals.h"
39 #include "termhooks.h"
43 #include <sys/inode.h>
48 #include <unistd.h> /* to get X_OK */
65 #endif /* HAVE_SETLOCALE */
75 #define file_offset off_t
76 #define file_tell ftello
78 #define file_offset long
79 #define file_tell ftell
86 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
87 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
88 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
89 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
90 Lisp_Object Qinhibit_file_name_operation
;
91 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
93 extern Lisp_Object Qevent_symbol_element_mask
;
94 extern Lisp_Object Qfile_exists_p
;
96 /* non-zero iff inside `load' */
99 /* Directory in which the sources were found. */
100 Lisp_Object Vsource_directory
;
102 /* Search path and suffixes for files to be loaded. */
103 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
105 /* File name of user's init file. */
106 Lisp_Object Vuser_init_file
;
108 /* This is the user-visible association list that maps features to
109 lists of defs in their load files. */
110 Lisp_Object Vload_history
;
112 /* This is used to build the load history. */
113 Lisp_Object Vcurrent_load_list
;
115 /* List of files that were preloaded. */
116 Lisp_Object Vpreloaded_file_list
;
118 /* Name of file actually being read by `load'. */
119 Lisp_Object Vload_file_name
;
121 /* Function to use for reading, in `load' and friends. */
122 Lisp_Object Vload_read_function
;
124 /* The association list of objects read with the #n=object form.
125 Each member of the list has the form (n . object), and is used to
126 look up the object for the corresponding #n# construct.
127 It must be set to nil before all top-level calls to read0. */
128 Lisp_Object read_objects
;
130 /* Nonzero means load should forcibly load all dynamic doc strings. */
131 static int load_force_doc_strings
;
133 /* Nonzero means read should convert strings to unibyte. */
134 static int load_convert_to_unibyte
;
136 /* Function to use for loading an Emacs lisp source file (not
137 compiled) instead of readevalloop. */
138 Lisp_Object Vload_source_file_function
;
140 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
141 Lisp_Object Vbyte_boolean_vars
;
143 /* Whether or not to add a `read-positions' property to symbols
145 Lisp_Object Vread_with_symbol_positions
;
147 /* List of (SYMBOL . POSITION) accumulated so far. */
148 Lisp_Object Vread_symbol_positions_list
;
150 /* List of descriptors now open for Fload. */
151 static Lisp_Object load_descriptor_list
;
153 /* File for get_file_char to read from. Use by load. */
154 static FILE *instream
;
156 /* When nonzero, read conses in pure space */
157 static int read_pure
;
159 /* For use within read-from-string (this reader is non-reentrant!!) */
160 static int read_from_string_index
;
161 static int read_from_string_index_byte
;
162 static int read_from_string_limit
;
164 /* Number of bytes left to read in the buffer character
165 that `readchar' has already advanced over. */
166 static int readchar_backlog
;
167 /* Number of characters read in the current call to Fread or
168 Fread_from_string. */
169 static int readchar_count
;
171 /* This contains the last string skipped with #@. */
172 static char *saved_doc_string
;
173 /* Length of buffer allocated in saved_doc_string. */
174 static int saved_doc_string_size
;
175 /* Length of actual data in saved_doc_string. */
176 static int saved_doc_string_length
;
177 /* This is the file position that string came from. */
178 static file_offset saved_doc_string_position
;
180 /* This contains the previous string skipped with #@.
181 We copy it from saved_doc_string when a new string
182 is put in saved_doc_string. */
183 static char *prev_saved_doc_string
;
184 /* Length of buffer allocated in prev_saved_doc_string. */
185 static int prev_saved_doc_string_size
;
186 /* Length of actual data in prev_saved_doc_string. */
187 static int prev_saved_doc_string_length
;
188 /* This is the file position that string came from. */
189 static file_offset prev_saved_doc_string_position
;
191 /* Nonzero means inside a new-style backquote
192 with no surrounding parentheses.
193 Fread initializes this to zero, so we need not specbind it
194 or worry about what happens to it when there is an error. */
195 static int new_backquote_flag
;
197 /* A list of file names for files being loaded in Fload. Used to
198 check for recursive loads. */
200 static Lisp_Object Vloads_in_progress
;
202 /* Non-zero means load dangerous compiled Lisp files. */
204 int load_dangerous_libraries
;
206 /* A regular expression used to detect files compiled with Emacs. */
208 static Lisp_Object Vbytecomp_version_regexp
;
210 static void to_multibyte
P_ ((char **, char **, int *));
211 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
212 Lisp_Object (*) (), int,
213 Lisp_Object
, Lisp_Object
,
214 Lisp_Object
, Lisp_Object
));
215 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
216 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
219 /* Handle unreading and rereading of characters.
220 Write READCHAR to read a character,
221 UNREAD(c) to unread c to be read again.
223 The READCHAR and UNREAD macros are meant for reading/unreading a
224 byte code; they do not handle multibyte characters. The caller
225 should manage them if necessary.
227 [ Actually that seems to be a lie; READCHAR will definitely read
228 multibyte characters from buffer sources, at least. Is the
229 comment just out of date?
230 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
233 #define READCHAR readchar (readcharfun)
234 #define UNREAD(c) unreadchar (readcharfun, c)
237 readchar (readcharfun
)
238 Lisp_Object readcharfun
;
245 if (BUFFERP (readcharfun
))
247 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
249 int pt_byte
= BUF_PT_BYTE (inbuffer
);
250 int orig_pt_byte
= pt_byte
;
252 if (readchar_backlog
> 0)
253 /* We get the address of the byte just passed,
254 which is the last byte of the character.
255 The other bytes in this character are consecutive with it,
256 because the gap can't be in the middle of a character. */
257 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
258 - --readchar_backlog
);
260 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
263 readchar_backlog
= -1;
265 if (! NILP (inbuffer
->enable_multibyte_characters
))
267 /* Fetch the character code from the buffer. */
268 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
269 BUF_INC_POS (inbuffer
, pt_byte
);
270 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
274 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
277 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
281 if (MARKERP (readcharfun
))
283 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
285 int bytepos
= marker_byte_position (readcharfun
);
286 int orig_bytepos
= bytepos
;
288 if (readchar_backlog
> 0)
289 /* We get the address of the byte just passed,
290 which is the last byte of the character.
291 The other bytes in this character are consecutive with it,
292 because the gap can't be in the middle of a character. */
293 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
294 - --readchar_backlog
);
296 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
299 readchar_backlog
= -1;
301 if (! NILP (inbuffer
->enable_multibyte_characters
))
303 /* Fetch the character code from the buffer. */
304 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
305 BUF_INC_POS (inbuffer
, bytepos
);
306 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
310 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
314 XMARKER (readcharfun
)->bytepos
= bytepos
;
315 XMARKER (readcharfun
)->charpos
++;
320 if (EQ (readcharfun
, Qlambda
))
321 return read_bytecode_char (0);
323 if (EQ (readcharfun
, Qget_file_char
))
327 /* Interrupted reads have been observed while reading over the network */
328 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
338 if (STRINGP (readcharfun
))
340 if (read_from_string_index
>= read_from_string_limit
)
343 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
344 read_from_string_index
,
345 read_from_string_index_byte
);
350 tem
= call0 (readcharfun
);
357 /* Unread the character C in the way appropriate for the stream READCHARFUN.
358 If the stream is a user function, call it with the char as argument. */
361 unreadchar (readcharfun
, c
)
362 Lisp_Object readcharfun
;
367 /* Don't back up the pointer if we're unreading the end-of-input mark,
368 since readchar didn't advance it when we read it. */
370 else if (BUFFERP (readcharfun
))
372 struct buffer
*b
= XBUFFER (readcharfun
);
373 int bytepos
= BUF_PT_BYTE (b
);
375 if (readchar_backlog
>= 0)
380 if (! NILP (b
->enable_multibyte_characters
))
381 BUF_DEC_POS (b
, bytepos
);
385 BUF_PT_BYTE (b
) = bytepos
;
388 else if (MARKERP (readcharfun
))
390 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
391 int bytepos
= XMARKER (readcharfun
)->bytepos
;
393 if (readchar_backlog
>= 0)
397 XMARKER (readcharfun
)->charpos
--;
398 if (! NILP (b
->enable_multibyte_characters
))
399 BUF_DEC_POS (b
, bytepos
);
403 XMARKER (readcharfun
)->bytepos
= bytepos
;
406 else if (STRINGP (readcharfun
))
408 read_from_string_index
--;
409 read_from_string_index_byte
410 = string_char_to_byte (readcharfun
, read_from_string_index
);
412 else if (EQ (readcharfun
, Qlambda
))
413 read_bytecode_char (1);
414 else if (EQ (readcharfun
, Qget_file_char
))
415 ungetc (c
, instream
);
417 call1 (readcharfun
, make_number (c
));
420 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
422 static Lisp_Object read0
P_ ((Lisp_Object
));
423 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
425 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
426 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
427 static int read_multibyte
P_ ((int, Lisp_Object
));
429 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
431 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
433 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
436 /* Get a character from the tty. */
438 extern Lisp_Object read_char
P_ ((int, int, Lisp_Object
*, Lisp_Object
, int *, jmp_buf *));
440 /* Read input events until we get one that's acceptable for our purposes.
442 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
443 until we get a character we like, and then stuffed into
446 If ASCII_REQUIRED is non-zero, we check function key events to see
447 if the unmodified version of the symbol has a Qascii_character
448 property, and use that character, if present.
450 If ERROR_NONASCII is non-zero, we signal an error if the input we
451 get isn't an ASCII character with modifiers. If it's zero but
452 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
455 If INPUT_METHOD is nonzero, we invoke the current input method
456 if the character warrants that. */
459 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
461 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
463 volatile register Lisp_Object val
, delayed_switch_frame
;
464 jmp_buf *volatile wrong_kboard_jmpbuf
= alloca (sizeof (jmp_buf));
466 #ifdef HAVE_WINDOW_SYSTEM
467 if (display_hourglass_p
)
471 delayed_switch_frame
= Qnil
;
473 /* Read until we get an acceptable event. */
475 setjmp (*wrong_kboard_jmpbuf
);
477 val
= read_char (0, 0, 0,
478 (input_method
? Qnil
: Qt
),
479 0, wrong_kboard_jmpbuf
);
484 /* switch-frame events are put off until after the next ASCII
485 character. This is better than signaling an error just because
486 the last characters were typed to a separate minibuffer frame,
487 for example. Eventually, some code which can deal with
488 switch-frame events will read it and process it. */
490 && EVENT_HAS_PARAMETERS (val
)
491 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
493 delayed_switch_frame
= val
;
499 /* Convert certain symbols to their ASCII equivalents. */
502 Lisp_Object tem
, tem1
;
503 tem
= Fget (val
, Qevent_symbol_element_mask
);
506 tem1
= Fget (Fcar (tem
), Qascii_character
);
507 /* Merge this symbol's modifier bits
508 with the ASCII equivalent of its basic code. */
510 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
514 /* If we don't have a character now, deal with it appropriately. */
519 Vunread_command_events
= Fcons (val
, Qnil
);
520 error ("Non-character input-event");
527 if (! NILP (delayed_switch_frame
))
528 unread_switch_frame
= delayed_switch_frame
;
532 #ifdef HAVE_WINDOW_SYSTEM
533 if (display_hourglass_p
)
542 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
543 doc
: /* Read a character from the command input (keyboard or macro).
544 It is returned as a number.
545 If the user generates an event which is not a character (i.e. a mouse
546 click or function key event), `read-char' signals an error. As an
547 exception, switch-frame events are put off until non-ASCII events can
549 If you want to read non-character events, or ignore them, call
550 `read-event' or `read-char-exclusive' instead.
552 If the optional argument PROMPT is non-nil, display that as a prompt.
553 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
554 input method is turned on in the current buffer, that input method
555 is used for reading a character. */)
556 (prompt
, inherit_input_method
)
557 Lisp_Object prompt
, inherit_input_method
;
560 message_with_string ("%s", prompt
, 0);
561 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
564 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
565 doc
: /* Read an event object from the input stream.
566 If the optional argument PROMPT is non-nil, display that as a prompt.
567 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
568 input method is turned on in the current buffer, that input method
569 is used for reading a character. */)
570 (prompt
, inherit_input_method
)
571 Lisp_Object prompt
, inherit_input_method
;
574 message_with_string ("%s", prompt
, 0);
575 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
578 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
579 doc
: /* Read a character from the command input (keyboard or macro).
580 It is returned as a number. Non-character events are ignored.
582 If the optional argument PROMPT is non-nil, display that as a prompt.
583 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
584 input method is turned on in the current buffer, that input method
585 is used for reading a character. */)
586 (prompt
, inherit_input_method
)
587 Lisp_Object prompt
, inherit_input_method
;
590 message_with_string ("%s", prompt
, 0);
591 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
594 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
595 doc
: /* Don't use this yourself. */)
598 register Lisp_Object val
;
599 XSETINT (val
, getc (instream
));
605 /* Value is non-zero if the file asswociated with file descriptor FD
606 is a compiled Lisp file that's safe to load. Only files compiled
607 with Emacs are safe to load. Files compiled with XEmacs can lead
608 to a crash in Fbyte_code because of an incompatible change in the
619 /* Read the first few bytes from the file, and look for a line
620 specifying the byte compiler version used. */
621 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
626 /* Skip to the next newline, skipping over the initial `ELC'
627 with NUL bytes following it. */
628 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
632 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
637 lseek (fd
, 0, SEEK_SET
);
642 /* Callback for record_unwind_protect. Restore the old load list OLD,
643 after loading a file successfully. */
646 record_load_unwind (old
)
649 return Vloads_in_progress
= old
;
652 /* This handler function is used via internal_condition_case_1. */
655 load_error_handler (data
)
661 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
662 doc
: /* Execute a file of Lisp code named FILE.
663 First try FILE with `.elc' appended, then try with `.el',
664 then try FILE unmodified (the exact suffixes are determined by
665 `load-suffixes'). Environment variable references in FILE
666 are replaced with their values by calling `substitute-in-file-name'.
667 This function searches the directories in `load-path'.
668 If optional second arg NOERROR is non-nil,
669 report no error if FILE doesn't exist.
670 Print messages at start and end of loading unless
671 optional third arg NOMESSAGE is non-nil.
672 If optional fourth arg NOSUFFIX is non-nil, don't try adding
673 suffixes `.elc' or `.el' to the specified name FILE.
674 If optional fifth arg MUST-SUFFIX is non-nil, insist on
675 the suffix `.elc' or `.el'; don't accept just FILE unless
676 it ends in one of those suffixes or includes a directory name.
678 Loading a file records its definitions, and its `provide' and
679 `require' calls, in an element of `load-history' whose
680 car is the file name loaded. See `load-history'.
682 Return t if file exists. */)
683 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
684 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
686 register FILE *stream
;
687 register int fd
= -1;
688 int count
= SPECPDL_INDEX ();
690 struct gcpro gcpro1
, gcpro2
;
691 Lisp_Object found
, efound
;
692 /* 1 means we printed the ".el is newer" message. */
694 /* 1 means we are loading a compiled file. */
705 /* If file name is magic, call the handler. */
706 /* This shouldn't be necessary any more now that `openp' handles it right.
707 handler = Ffind_file_name_handler (file, Qload);
709 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
711 /* Do this after the handler to avoid
712 the need to gcpro noerror, nomessage and nosuffix.
713 (Below here, we care only whether they are nil or not.)
714 The presence of this call is the result of a historical accident:
715 it used to be in every file-operations and when it got removed
716 everywhere, it accidentally stayed here. Since then, enough people
717 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
718 that it seemed risky to remove. */
719 if (! NILP (noerror
))
721 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
722 Qt
, load_error_handler
);
727 file
= Fsubstitute_in_file_name (file
);
730 /* Avoid weird lossage with null string as arg,
731 since it would try to load a directory as a Lisp file */
732 if (SCHARS (file
) > 0)
734 int size
= SBYTES (file
);
738 GCPRO2 (file
, found
);
740 if (! NILP (must_suffix
))
742 /* Don't insist on adding a suffix if FILE already ends with one. */
744 && !strcmp (SDATA (file
) + size
- 3, ".el"))
747 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
749 /* Don't insist on adding a suffix
750 if the argument includes a directory name. */
751 else if (! NILP (Ffile_name_directory (file
)))
755 fd
= openp (Vload_path
, file
,
756 (!NILP (nosuffix
) ? Qnil
757 : !NILP (must_suffix
) ? Vload_suffixes
758 : Fappend (2, (tmp
[0] = Vload_suffixes
,
759 tmp
[1] = default_suffixes
,
768 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
769 Fcons (file
, Qnil
)));
774 /* Tell startup.el whether or not we found the user's init file. */
775 if (EQ (Qt
, Vuser_init_file
))
776 Vuser_init_file
= found
;
778 /* If FD is -2, that means openp found a magic file. */
781 if (NILP (Fequal (found
, file
)))
782 /* If FOUND is a different file name from FILE,
783 find its handler even if we have already inhibited
784 the `load' operation on FILE. */
785 handler
= Ffind_file_name_handler (found
, Qt
);
787 handler
= Ffind_file_name_handler (found
, Qload
);
788 if (! NILP (handler
))
789 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
792 /* Check if we're stuck in a recursive load cycle.
794 2000-09-21: It's not possible to just check for the file loaded
795 being a member of Vloads_in_progress. This fails because of the
796 way the byte compiler currently works; `provide's are not
797 evaluted, see font-lock.el/jit-lock.el as an example. This
798 leads to a certain amount of ``normal'' recursion.
800 Also, just loading a file recursively is not always an error in
801 the general case; the second load may do something different. */
805 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
806 if (!NILP (Fequal (found
, XCAR (tem
))))
809 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
810 Fcons (found
, Vloads_in_progress
)));
811 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
812 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
815 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
817 /* Load .elc files directly, but not when they are
818 remote and have no handler! */
825 GCPRO2 (file
, found
);
827 if (!safe_to_load_p (fd
))
830 if (!load_dangerous_libraries
)
834 error ("File `%s' was not compiled in Emacs",
837 else if (!NILP (nomessage
))
838 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
843 efound
= ENCODE_FILE (found
);
848 stat ((char *)SDATA (efound
), &s1
);
849 SSET (efound
, SBYTES (efound
) - 1, 0);
850 result
= stat ((char *)SDATA (efound
), &s2
);
851 SSET (efound
, SBYTES (efound
) - 1, 'c');
853 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
855 /* Make the progress messages mention that source is newer. */
858 /* If we won't print another message, mention this anyway. */
859 if (!NILP (nomessage
))
861 Lisp_Object msg_file
;
862 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
863 message_with_string ("Source file `%s' newer than byte-compiled file",
872 /* We are loading a source file (*.el). */
873 if (!NILP (Vload_source_file_function
))
879 val
= call4 (Vload_source_file_function
, found
, file
,
880 NILP (noerror
) ? Qnil
: Qt
,
881 NILP (nomessage
) ? Qnil
: Qt
);
882 return unbind_to (count
, val
);
886 GCPRO2 (file
, found
);
890 efound
= ENCODE_FILE (found
);
891 stream
= fopen ((char *) SDATA (efound
), fmode
);
892 #else /* not WINDOWSNT */
893 stream
= fdopen (fd
, fmode
);
894 #endif /* not WINDOWSNT */
898 error ("Failure to create stdio stream for %s", SDATA (file
));
901 if (! NILP (Vpurify_flag
))
902 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
904 if (NILP (nomessage
))
907 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
910 message_with_string ("Loading %s (source)...", file
, 1);
912 message_with_string ("Loading %s (compiled; note, source file is newer)...",
914 else /* The typical case; compiled file newer than source file. */
915 message_with_string ("Loading %s...", file
, 1);
918 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
919 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
920 specbind (Qload_file_name
, found
);
921 specbind (Qinhibit_file_name_operation
, Qnil
);
923 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
925 readevalloop (Qget_file_char
, stream
, (! NILP (Vpurify_flag
) ? file
: found
),
926 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
927 unbind_to (count
, Qnil
);
929 /* Run any load-hooks for this file. */
930 temp
= Fassoc (file
, Vafter_load_alist
);
932 Fprogn (Fcdr (temp
));
935 if (saved_doc_string
)
936 free (saved_doc_string
);
937 saved_doc_string
= 0;
938 saved_doc_string_size
= 0;
940 if (prev_saved_doc_string
)
941 xfree (prev_saved_doc_string
);
942 prev_saved_doc_string
= 0;
943 prev_saved_doc_string_size
= 0;
945 if (!noninteractive
&& NILP (nomessage
))
948 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
951 message_with_string ("Loading %s (source)...done", file
, 1);
953 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
955 else /* The typical case; compiled file newer than source file. */
956 message_with_string ("Loading %s...done", file
, 1);
959 if (!NILP (Fequal (build_string ("obsolete"),
960 Ffile_name_nondirectory
961 (Fdirectory_file_name (Ffile_name_directory (found
))))))
962 message_with_string ("Package %s is obsolete", file
, 1);
968 load_unwind (arg
) /* used as unwind-protect function in load */
971 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
974 if (--load_in_progress
< 0) load_in_progress
= 0;
979 load_descriptor_unwind (oldlist
)
982 load_descriptor_list
= oldlist
;
986 /* Close all descriptors in use for Floads.
987 This is used when starting a subprocess. */
994 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
995 emacs_close (XFASTINT (XCAR (tail
)));
1000 complete_filename_p (pathname
)
1001 Lisp_Object pathname
;
1003 register const unsigned char *s
= SDATA (pathname
);
1004 return (IS_DIRECTORY_SEP (s
[0])
1005 || (SCHARS (pathname
) > 2
1006 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1016 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1017 doc
: /* Search for FILENAME through PATH.
1018 Returns the file's name in absolute form, or nil if not found.
1019 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1020 file name when searching.
1021 If non-nil, PREDICATE is used instead of `file-readable-p'.
1022 PREDICATE can also be an integer to pass to the access(2) function,
1023 in which case file-name-handlers are ignored. */)
1024 (filename
, path
, suffixes
, predicate
)
1025 Lisp_Object filename
, path
, suffixes
, predicate
;
1028 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1029 if (NILP (predicate
) && fd
> 0)
1035 /* Search for a file whose name is STR, looking in directories
1036 in the Lisp list PATH, and trying suffixes from SUFFIX.
1037 On success, returns a file descriptor. On failure, returns -1.
1039 SUFFIXES is a list of strings containing possible suffixes.
1040 The empty suffix is automatically added iff the list is empty.
1042 PREDICATE non-nil means don't open the files,
1043 just look for one that satisfies the predicate. In this case,
1044 returns 1 on success. The predicate can be a lisp function or
1045 an integer to pass to `access' (in which case file-name-handlers
1048 If STOREPTR is nonzero, it points to a slot where the name of
1049 the file actually found should be stored as a Lisp string.
1050 nil is stored there on failure.
1052 If the file we find is remote, return -2
1053 but store the found remote file name in *STOREPTR. */
1056 openp (path
, str
, suffixes
, storeptr
, predicate
)
1057 Lisp_Object path
, str
;
1058 Lisp_Object suffixes
;
1059 Lisp_Object
*storeptr
;
1060 Lisp_Object predicate
;
1065 register char *fn
= buf
;
1068 Lisp_Object filename
;
1070 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1071 Lisp_Object string
, tail
, encoded_fn
;
1072 int max_suffix_len
= 0;
1076 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1078 CHECK_STRING_CAR (tail
);
1079 max_suffix_len
= max (max_suffix_len
,
1080 SBYTES (XCAR (tail
)));
1083 string
= filename
= Qnil
;
1084 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1089 if (complete_filename_p (str
))
1092 for (; CONSP (path
); path
= XCDR (path
))
1094 filename
= Fexpand_file_name (str
, XCAR (path
));
1095 if (!complete_filename_p (filename
))
1096 /* If there are non-absolute elts in PATH (eg ".") */
1097 /* Of course, this could conceivably lose if luser sets
1098 default-directory to be something non-absolute... */
1100 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1101 if (!complete_filename_p (filename
))
1102 /* Give up on this path element! */
1106 /* Calculate maximum size of any filename made from
1107 this path element/specified file name and any possible suffix. */
1108 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1109 if (fn_size
< want_size
)
1110 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1112 /* Loop over suffixes. */
1113 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1114 CONSP (tail
); tail
= XCDR (tail
))
1116 int lsuffix
= SBYTES (XCAR (tail
));
1117 Lisp_Object handler
;
1120 /* Concatenate path element/specified name with the suffix.
1121 If the directory starts with /:, remove that. */
1122 if (SCHARS (filename
) > 2
1123 && SREF (filename
, 0) == '/'
1124 && SREF (filename
, 1) == ':')
1126 strncpy (fn
, SDATA (filename
) + 2,
1127 SBYTES (filename
) - 2);
1128 fn
[SBYTES (filename
) - 2] = 0;
1132 strncpy (fn
, SDATA (filename
),
1134 fn
[SBYTES (filename
)] = 0;
1137 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1138 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1140 /* Check that the file exists and is not a directory. */
1141 /* We used to only check for handlers on non-absolute file names:
1145 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1146 It's not clear why that was the case and it breaks things like
1147 (load "/bar.el") where the file is actually "/bar.el.gz". */
1148 string
= build_string (fn
);
1149 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1150 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1152 if (NILP (predicate
))
1153 exists
= !NILP (Ffile_readable_p (string
));
1155 exists
= !NILP (call1 (predicate
, string
));
1156 if (exists
&& !NILP (Ffile_directory_p (string
)))
1161 /* We succeeded; return this descriptor and filename. */
1172 encoded_fn
= ENCODE_FILE (string
);
1173 pfn
= SDATA (encoded_fn
);
1174 exists
= (stat (pfn
, &st
) >= 0
1175 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1178 /* Check that we can access or open it. */
1179 if (NATNUMP (predicate
))
1180 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1182 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1186 /* We succeeded; return this descriptor and filename. */
1204 /* Merge the list we've accumulated of globals from the current input source
1205 into the load_history variable. The details depend on whether
1206 the source has an associated file name or not.
1208 FILENAME is the file name that we are loading from.
1209 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1212 build_load_history (filename
, entire
)
1213 Lisp_Object filename
;
1216 register Lisp_Object tail
, prev
, newelt
;
1217 register Lisp_Object tem
, tem2
;
1218 register int foundit
= 0;
1220 tail
= Vload_history
;
1223 while (CONSP (tail
))
1227 /* Find the feature's previous assoc list... */
1228 if (!NILP (Fequal (filename
, Fcar (tem
))))
1232 /* If we're loading the entire file, remove old data. */
1236 Vload_history
= XCDR (tail
);
1238 Fsetcdr (prev
, XCDR (tail
));
1241 /* Otherwise, cons on new symbols that are not already members. */
1244 tem2
= Vcurrent_load_list
;
1246 while (CONSP (tem2
))
1248 newelt
= XCAR (tem2
);
1250 if (NILP (Fmember (newelt
, tem
)))
1251 Fsetcar (tail
, Fcons (XCAR (tem
),
1252 Fcons (newelt
, XCDR (tem
))));
1265 /* If we're loading an entire file, cons the new assoc onto the
1266 front of load-history, the most-recently-loaded position. Also
1267 do this if we didn't find an existing member for the file. */
1268 if (entire
|| !foundit
)
1269 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1274 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1282 readevalloop_1 (old
)
1285 load_convert_to_unibyte
= ! NILP (old
);
1289 /* Signal an `end-of-file' error, if possible with file name
1293 end_of_file_error ()
1297 if (STRINGP (Vload_file_name
))
1298 data
= Fcons (Vload_file_name
, Qnil
);
1302 Fsignal (Qend_of_file
, data
);
1305 /* UNIBYTE specifies how to set load_convert_to_unibyte
1306 for this invocation.
1307 READFUN, if non-nil, is used instead of `read'.
1308 START, END is region in current buffer (from eval-region). */
1311 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1312 printflag
, unibyte
, readfun
, start
, end
)
1313 Lisp_Object readcharfun
;
1315 Lisp_Object sourcename
;
1316 Lisp_Object (*evalfun
) ();
1318 Lisp_Object unibyte
, readfun
;
1319 Lisp_Object start
, end
;
1322 register Lisp_Object val
;
1323 int count
= SPECPDL_INDEX ();
1324 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1325 struct buffer
*b
= 0;
1326 int continue_reading_p
;
1328 if (BUFFERP (readcharfun
))
1329 b
= XBUFFER (readcharfun
);
1330 else if (MARKERP (readcharfun
))
1331 b
= XMARKER (readcharfun
)->buffer
;
1333 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1334 specbind (Qcurrent_load_list
, Qnil
);
1335 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1336 load_convert_to_unibyte
= !NILP (unibyte
);
1338 readchar_backlog
= -1;
1340 GCPRO4 (sourcename
, readfun
, start
, end
);
1342 LOADHIST_ATTACH (sourcename
);
1344 continue_reading_p
= 1;
1345 while (continue_reading_p
)
1347 int count1
= SPECPDL_INDEX ();
1349 if (b
!= 0 && NILP (b
->name
))
1350 error ("Reading from killed buffer");
1355 /* Switch to the buffer we are reading from. */
1356 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1357 set_buffer_internal (b
);
1359 /* Save point in it. */
1360 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1361 /* Save ZV in it. */
1362 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1363 /* Those get unbound after we read one expression. */
1365 /* Set point and ZV around stuff to be read. */
1367 Fnarrow_to_region (make_number (BEGV
), end
);
1375 while ((c
= READCHAR
) != '\n' && c
!= -1);
1380 unbind_to (count1
, Qnil
);
1384 /* Ignore whitespace here, so we can detect eof. */
1385 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1388 if (!NILP (Vpurify_flag
) && c
== '(')
1390 record_unwind_protect (unreadpure
, Qnil
);
1391 val
= read_list (-1, readcharfun
);
1396 read_objects
= Qnil
;
1397 if (!NILP (readfun
))
1399 val
= call1 (readfun
, readcharfun
);
1401 /* If READCHARFUN has set point to ZV, we should
1402 stop reading, even if the form read sets point
1403 to a different value when evaluated. */
1404 if (BUFFERP (readcharfun
))
1406 struct buffer
*b
= XBUFFER (readcharfun
);
1407 if (BUF_PT (b
) == BUF_ZV (b
))
1408 continue_reading_p
= 0;
1411 else if (! NILP (Vload_read_function
))
1412 val
= call1 (Vload_read_function
, readcharfun
);
1414 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1417 if (!NILP (start
) && continue_reading_p
)
1418 start
= Fpoint_marker ();
1419 unbind_to (count1
, Qnil
);
1421 val
= (*evalfun
) (val
);
1425 Vvalues
= Fcons (val
, Vvalues
);
1426 if (EQ (Vstandard_output
, Qt
))
1433 build_load_history (sourcename
,
1434 stream
|| (INTEGERP (start
) && INTEGERP (end
)
1435 && XINT (start
) == BEG
&& XINT (end
) == Z
));
1439 unbind_to (count
, Qnil
);
1442 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1443 doc
: /* Execute the current buffer as Lisp code.
1444 Programs can pass two arguments, BUFFER and PRINTFLAG.
1445 BUFFER is the buffer to evaluate (nil means use current buffer).
1446 PRINTFLAG controls printing of output:
1447 nil means discard it; anything else is stream for print.
1449 If the optional third argument FILENAME is non-nil,
1450 it specifies the file name to use for `load-history'.
1451 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1452 for this invocation.
1454 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1455 `print' and related functions should work normally even if PRINTFLAG is nil.
1457 This function preserves the position of point. */)
1458 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1459 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1461 int count
= SPECPDL_INDEX ();
1462 Lisp_Object tem
, buf
;
1465 buf
= Fcurrent_buffer ();
1467 buf
= Fget_buffer (buffer
);
1469 error ("No such buffer");
1471 if (NILP (printflag
) && NILP (do_allow_print
))
1476 if (NILP (filename
))
1477 filename
= XBUFFER (buf
)->filename
;
1479 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1480 specbind (Qstandard_output
, tem
);
1481 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1482 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1483 readevalloop (buf
, 0, filename
, Feval
,
1484 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1485 unbind_to (count
, Qnil
);
1490 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1491 doc
: /* Execute the region as Lisp code.
1492 When called from programs, expects two arguments,
1493 giving starting and ending indices in the current buffer
1494 of the text to be executed.
1495 Programs can pass third argument PRINTFLAG which controls output:
1496 nil means discard it; anything else is stream for printing it.
1497 Also the fourth argument READ-FUNCTION, if non-nil, is used
1498 instead of `read' to read each expression. It gets one argument
1499 which is the input stream for reading characters.
1501 This function does not move point. */)
1502 (start
, end
, printflag
, read_function
)
1503 Lisp_Object start
, end
, printflag
, read_function
;
1505 int count
= SPECPDL_INDEX ();
1506 Lisp_Object tem
, cbuf
;
1508 cbuf
= Fcurrent_buffer ();
1510 if (NILP (printflag
))
1514 specbind (Qstandard_output
, tem
);
1515 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1517 /* readevalloop calls functions which check the type of start and end. */
1518 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1519 !NILP (printflag
), Qnil
, read_function
,
1522 return unbind_to (count
, Qnil
);
1526 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1527 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1528 If STREAM is nil, use the value of `standard-input' (which see).
1529 STREAM or the value of `standard-input' may be:
1530 a buffer (read from point and advance it)
1531 a marker (read from where it points and advance it)
1532 a function (call it with no arguments for each character,
1533 call it with a char as argument to push a char back)
1534 a string (takes text from string, starting at the beginning)
1535 t (read text line using minibuffer and use it, or read from
1536 standard input in batch mode). */)
1541 stream
= Vstandard_input
;
1542 if (EQ (stream
, Qt
))
1543 stream
= Qread_char
;
1544 if (EQ (stream
, Qread_char
))
1545 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1547 return read_internal_start (stream
, Qnil
, Qnil
);
1550 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1551 doc
: /* Read one Lisp expression which is represented as text by STRING.
1552 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1553 START and END optionally delimit a substring of STRING from which to read;
1554 they default to 0 and (length STRING) respectively. */)
1555 (string
, start
, end
)
1556 Lisp_Object string
, start
, end
;
1559 CHECK_STRING (string
);
1560 /* read_internal_start sets read_from_string_index. */
1561 ret
= read_internal_start (string
, start
, end
);
1562 return Fcons (ret
, make_number (read_from_string_index
));
1565 /* Function to set up the global context we need in toplevel read
1568 read_internal_start (stream
, start
, end
)
1570 Lisp_Object start
; /* Only used when stream is a string. */
1571 Lisp_Object end
; /* Only used when stream is a string. */
1575 readchar_backlog
= -1;
1577 new_backquote_flag
= 0;
1578 read_objects
= Qnil
;
1579 if (EQ (Vread_with_symbol_positions
, Qt
)
1580 || EQ (Vread_with_symbol_positions
, stream
))
1581 Vread_symbol_positions_list
= Qnil
;
1583 if (STRINGP (stream
))
1585 int startval
, endval
;
1587 endval
= SCHARS (stream
);
1591 endval
= XINT (end
);
1592 if (endval
< 0 || endval
> SCHARS (stream
))
1593 args_out_of_range (stream
, end
);
1600 CHECK_NUMBER (start
);
1601 startval
= XINT (start
);
1602 if (startval
< 0 || startval
> endval
)
1603 args_out_of_range (stream
, start
);
1605 read_from_string_index
= startval
;
1606 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1607 read_from_string_limit
= endval
;
1610 retval
= read0 (stream
);
1611 if (EQ (Vread_with_symbol_positions
, Qt
)
1612 || EQ (Vread_with_symbol_positions
, stream
))
1613 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1617 /* Use this for recursive reads, in contexts where internal tokens
1622 Lisp_Object readcharfun
;
1624 register Lisp_Object val
;
1627 val
= read1 (readcharfun
, &c
, 0);
1629 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1636 static int read_buffer_size
;
1637 static char *read_buffer
;
1639 /* Read multibyte form and return it as a character. C is a first
1640 byte of multibyte form, and rest of them are read from
1644 read_multibyte (c
, readcharfun
)
1646 Lisp_Object readcharfun
;
1648 /* We need the actual character code of this multibyte
1650 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1658 while ((c
= READCHAR
) >= 0xA0
1659 && len
< MAX_MULTIBYTE_LENGTH
)
1665 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1666 return STRING_CHAR (str
, len
);
1667 /* The byte sequence is not valid as multibyte. Unread all bytes
1668 but the first one, and return the first byte. */
1674 /* Read a \-escape sequence, assuming we already read the `\'.
1675 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1676 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1677 Otherwise store 0 into *BYTEREP. */
1680 read_escape (readcharfun
, stringp
, byterep
)
1681 Lisp_Object readcharfun
;
1685 register int c
= READCHAR
;
1692 end_of_file_error ();
1722 error ("Invalid escape character syntax");
1725 c
= read_escape (readcharfun
, 0, byterep
);
1726 return c
| meta_modifier
;
1731 error ("Invalid escape character syntax");
1734 c
= read_escape (readcharfun
, 0, byterep
);
1735 return c
| shift_modifier
;
1740 error ("Invalid escape character syntax");
1743 c
= read_escape (readcharfun
, 0, byterep
);
1744 return c
| hyper_modifier
;
1749 error ("Invalid escape character syntax");
1752 c
= read_escape (readcharfun
, 0, byterep
);
1753 return c
| alt_modifier
;
1764 c
= read_escape (readcharfun
, 0, byterep
);
1765 return c
| super_modifier
;
1770 error ("Invalid escape character syntax");
1774 c
= read_escape (readcharfun
, 0, byterep
);
1775 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1776 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1777 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1778 return c
| ctrl_modifier
;
1779 /* ASCII control chars are made from letters (both cases),
1780 as well as the non-letters within 0100...0137. */
1781 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1782 return (c
& (037 | ~0177));
1783 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1784 return (c
& (037 | ~0177));
1786 return c
| ctrl_modifier
;
1796 /* An octal escape, as in ANSI C. */
1798 register int i
= c
- '0';
1799 register int count
= 0;
1802 if ((c
= READCHAR
) >= '0' && c
<= '7')
1819 /* A hex escape, as in ANSI C. */
1825 if (c
>= '0' && c
<= '9')
1830 else if ((c
>= 'a' && c
<= 'f')
1831 || (c
>= 'A' && c
<= 'F'))
1834 if (c
>= 'a' && c
<= 'f')
1851 if (BASE_LEADING_CODE_P (c
))
1852 c
= read_multibyte (c
, readcharfun
);
1858 /* Read an integer in radix RADIX using READCHARFUN to read
1859 characters. RADIX must be in the interval [2..36]; if it isn't, a
1860 read error is signaled . Value is the integer read. Signals an
1861 error if encountering invalid read syntax or if RADIX is out of
1865 read_integer (readcharfun
, radix
)
1866 Lisp_Object readcharfun
;
1869 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1870 EMACS_INT number
= 0;
1872 if (radix
< 2 || radix
> 36)
1876 number
= ndigits
= invalid_p
= 0;
1892 if (c
>= '0' && c
<= '9')
1894 else if (c
>= 'a' && c
<= 'z')
1895 digit
= c
- 'a' + 10;
1896 else if (c
>= 'A' && c
<= 'Z')
1897 digit
= c
- 'A' + 10;
1904 if (digit
< 0 || digit
>= radix
)
1907 number
= radix
* number
+ digit
;
1913 if (ndigits
== 0 || invalid_p
)
1916 sprintf (buf
, "integer, radix %d", radix
);
1917 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1920 return make_number (sign
* number
);
1924 /* Convert unibyte text in read_buffer to multibyte.
1926 Initially, *P is a pointer after the end of the unibyte text, and
1927 the pointer *END points after the end of read_buffer.
1929 If read_buffer doesn't have enough room to hold the result
1930 of the conversion, reallocate it and adjust *P and *END.
1932 At the end, make *P point after the result of the conversion, and
1933 return in *NCHARS the number of characters in the converted
1937 to_multibyte (p
, end
, nchars
)
1943 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1944 if (read_buffer_size
< 2 * nbytes
)
1946 int offset
= *p
- read_buffer
;
1947 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1948 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1949 *p
= read_buffer
+ offset
;
1950 *end
= read_buffer
+ read_buffer_size
;
1953 if (nbytes
!= *nchars
)
1954 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1955 *p
- read_buffer
, nchars
);
1957 *p
= read_buffer
+ nbytes
;
1961 /* If the next token is ')' or ']' or '.', we store that character
1962 in *PCH and the return value is not interesting. Else, we store
1963 zero in *PCH and we read and return one lisp object.
1965 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1968 read1 (readcharfun
, pch
, first_in_list
)
1969 register Lisp_Object readcharfun
;
1974 int uninterned_symbol
= 0;
1982 end_of_file_error ();
1987 return read_list (0, readcharfun
);
1990 return read_vector (readcharfun
, 0);
2007 tmp
= read_vector (readcharfun
, 0);
2008 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
2009 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
2010 error ("Invalid size char-table");
2011 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2012 XCHAR_TABLE (tmp
)->top
= Qt
;
2021 tmp
= read_vector (readcharfun
, 0);
2022 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2023 error ("Invalid size char-table");
2024 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2025 XCHAR_TABLE (tmp
)->top
= Qnil
;
2028 Fsignal (Qinvalid_read_syntax
,
2029 Fcons (make_string ("#^^", 3), Qnil
));
2031 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2036 length
= read1 (readcharfun
, pch
, first_in_list
);
2040 Lisp_Object tmp
, val
;
2042 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2043 / BOOL_VECTOR_BITS_PER_CHAR
);
2046 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2047 if (size_in_chars
!= SCHARS (tmp
)
2048 /* We used to print 1 char too many
2049 when the number of bits was a multiple of 8.
2050 Accept such input in case it came from an old version. */
2051 && ! (XFASTINT (length
)
2052 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2053 Fsignal (Qinvalid_read_syntax
,
2054 Fcons (make_string ("#&...", 5), Qnil
));
2056 val
= Fmake_bool_vector (length
, Qnil
);
2057 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2059 /* Clear the extraneous bits in the last byte. */
2060 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2061 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2062 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2065 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2070 /* Accept compiled functions at read-time so that we don't have to
2071 build them using function calls. */
2073 tmp
= read_vector (readcharfun
, 1);
2074 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2075 XVECTOR (tmp
)->contents
);
2080 struct gcpro gcpro1
;
2083 /* Read the string itself. */
2084 tmp
= read1 (readcharfun
, &ch
, 0);
2085 if (ch
!= 0 || !STRINGP (tmp
))
2086 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2088 /* Read the intervals and their properties. */
2091 Lisp_Object beg
, end
, plist
;
2093 beg
= read1 (readcharfun
, &ch
, 0);
2098 end
= read1 (readcharfun
, &ch
, 0);
2100 plist
= read1 (readcharfun
, &ch
, 0);
2102 Fsignal (Qinvalid_read_syntax
,
2103 Fcons (build_string ("invalid string property list"),
2105 Fset_text_properties (beg
, end
, plist
, tmp
);
2111 /* #@NUMBER is used to skip NUMBER following characters.
2112 That's used in .elc files to skip over doc strings
2113 and function definitions. */
2118 /* Read a decimal integer. */
2119 while ((c
= READCHAR
) >= 0
2120 && c
>= '0' && c
<= '9')
2128 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2130 /* If we are supposed to force doc strings into core right now,
2131 record the last string that we skipped,
2132 and record where in the file it comes from. */
2134 /* But first exchange saved_doc_string
2135 with prev_saved_doc_string, so we save two strings. */
2137 char *temp
= saved_doc_string
;
2138 int temp_size
= saved_doc_string_size
;
2139 file_offset temp_pos
= saved_doc_string_position
;
2140 int temp_len
= saved_doc_string_length
;
2142 saved_doc_string
= prev_saved_doc_string
;
2143 saved_doc_string_size
= prev_saved_doc_string_size
;
2144 saved_doc_string_position
= prev_saved_doc_string_position
;
2145 saved_doc_string_length
= prev_saved_doc_string_length
;
2147 prev_saved_doc_string
= temp
;
2148 prev_saved_doc_string_size
= temp_size
;
2149 prev_saved_doc_string_position
= temp_pos
;
2150 prev_saved_doc_string_length
= temp_len
;
2153 if (saved_doc_string_size
== 0)
2155 saved_doc_string_size
= nskip
+ 100;
2156 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2158 if (nskip
> saved_doc_string_size
)
2160 saved_doc_string_size
= nskip
+ 100;
2161 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2162 saved_doc_string_size
);
2165 saved_doc_string_position
= file_tell (instream
);
2167 /* Copy that many characters into saved_doc_string. */
2168 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2169 saved_doc_string
[i
] = c
= READCHAR
;
2171 saved_doc_string_length
= i
;
2175 /* Skip that many characters. */
2176 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2184 /* #! appears at the beginning of an executable file.
2185 Skip the first line. */
2186 while (c
!= '\n' && c
>= 0)
2191 return Vload_file_name
;
2193 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2194 /* #:foo is the uninterned symbol named foo. */
2197 uninterned_symbol
= 1;
2201 /* Reader forms that can reuse previously read objects. */
2202 if (c
>= '0' && c
<= '9')
2207 /* Read a non-negative integer. */
2208 while (c
>= '0' && c
<= '9')
2214 /* #n=object returns object, but associates it with n for #n#. */
2217 /* Make a placeholder for #n# to use temporarily */
2218 Lisp_Object placeholder
;
2221 placeholder
= Fcons(Qnil
, Qnil
);
2222 cell
= Fcons (make_number (n
), placeholder
);
2223 read_objects
= Fcons (cell
, read_objects
);
2225 /* Read the object itself. */
2226 tem
= read0 (readcharfun
);
2228 /* Now put it everywhere the placeholder was... */
2229 substitute_object_in_subtree (tem
, placeholder
);
2231 /* ...and #n# will use the real value from now on. */
2232 Fsetcdr (cell
, tem
);
2236 /* #n# returns a previously read object. */
2239 tem
= Fassq (make_number (n
), read_objects
);
2242 /* Fall through to error message. */
2244 else if (c
== 'r' || c
== 'R')
2245 return read_integer (readcharfun
, n
);
2247 /* Fall through to error message. */
2249 else if (c
== 'x' || c
== 'X')
2250 return read_integer (readcharfun
, 16);
2251 else if (c
== 'o' || c
== 'O')
2252 return read_integer (readcharfun
, 8);
2253 else if (c
== 'b' || c
== 'B')
2254 return read_integer (readcharfun
, 2);
2257 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2260 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2265 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2275 new_backquote_flag
++;
2276 value
= read0 (readcharfun
);
2277 new_backquote_flag
--;
2279 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2283 if (new_backquote_flag
)
2285 Lisp_Object comma_type
= Qnil
;
2290 comma_type
= Qcomma_at
;
2292 comma_type
= Qcomma_dot
;
2295 if (ch
>= 0) UNREAD (ch
);
2296 comma_type
= Qcomma
;
2299 new_backquote_flag
--;
2300 value
= read0 (readcharfun
);
2301 new_backquote_flag
++;
2302 return Fcons (comma_type
, Fcons (value
, Qnil
));
2315 end_of_file_error ();
2317 /* Accept `single space' syntax like (list ? x) where the
2318 whitespace character is SPC or TAB.
2319 Other literal whitespace like NL, CR, and FF are not accepted,
2320 as there are well-established escape sequences for these. */
2321 if (c
== ' ' || c
== '\t')
2322 return make_number (c
);
2325 c
= read_escape (readcharfun
, 0, &discard
);
2326 else if (BASE_LEADING_CODE_P (c
))
2327 c
= read_multibyte (c
, readcharfun
);
2329 next_char
= READCHAR
;
2330 if (next_char
== '.')
2332 /* Only a dotted-pair dot is valid after a char constant. */
2333 int next_next_char
= READCHAR
;
2334 UNREAD (next_next_char
);
2336 ok
= (next_next_char
<= 040
2337 || (next_next_char
< 0200
2338 && (index ("\"';([#?", next_next_char
)
2339 || (!first_in_list
&& next_next_char
== '`')
2340 || (new_backquote_flag
&& next_next_char
== ','))));
2344 ok
= (next_char
<= 040
2345 || (next_char
< 0200
2346 && (index ("\"';()[]#?", next_char
)
2347 || (!first_in_list
&& next_char
== '`')
2348 || (new_backquote_flag
&& next_char
== ','))));
2352 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2354 return make_number (c
);
2359 char *p
= read_buffer
;
2360 char *end
= read_buffer
+ read_buffer_size
;
2362 /* 1 if we saw an escape sequence specifying
2363 a multibyte character, or a multibyte character. */
2364 int force_multibyte
= 0;
2365 /* 1 if we saw an escape sequence specifying
2366 a single-byte character. */
2367 int force_singlebyte
= 0;
2368 /* 1 if read_buffer contains multibyte text now. */
2369 int is_multibyte
= 0;
2373 while ((c
= READCHAR
) >= 0
2376 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2378 int offset
= p
- read_buffer
;
2379 read_buffer
= (char *) xrealloc (read_buffer
,
2380 read_buffer_size
*= 2);
2381 p
= read_buffer
+ offset
;
2382 end
= read_buffer
+ read_buffer_size
;
2389 c
= read_escape (readcharfun
, 1, &byterep
);
2391 /* C is -1 if \ newline has just been seen */
2394 if (p
== read_buffer
)
2400 force_singlebyte
= 1;
2401 else if (byterep
== 2)
2402 force_multibyte
= 1;
2405 /* A character that must be multibyte forces multibyte. */
2406 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2407 force_multibyte
= 1;
2409 /* If we just discovered the need to be multibyte,
2410 convert the text accumulated thus far. */
2411 if (force_multibyte
&& ! is_multibyte
)
2414 to_multibyte (&p
, &end
, &nchars
);
2417 /* Allow `\C- ' and `\C-?'. */
2418 if (c
== (CHAR_CTL
| ' '))
2420 else if (c
== (CHAR_CTL
| '?'))
2425 /* Shift modifier is valid only with [A-Za-z]. */
2426 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2428 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2429 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2433 /* Move the meta bit to the right place for a string. */
2434 c
= (c
& ~CHAR_META
) | 0x80;
2435 if (c
& CHAR_MODIFIER_MASK
)
2436 error ("Invalid modifier in string");
2439 p
+= CHAR_STRING (c
, p
);
2447 end_of_file_error ();
2449 /* If purifying, and string starts with \ newline,
2450 return zero instead. This is for doc strings
2451 that we are really going to find in etc/DOC.nn.nn */
2452 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2453 return make_number (0);
2455 if (is_multibyte
|| force_singlebyte
)
2457 else if (load_convert_to_unibyte
)
2460 to_multibyte (&p
, &end
, &nchars
);
2461 if (p
- read_buffer
!= nchars
)
2463 string
= make_multibyte_string (read_buffer
, nchars
,
2465 return Fstring_make_unibyte (string
);
2467 /* We can make a unibyte string directly. */
2470 else if (EQ (readcharfun
, Qget_file_char
)
2471 || EQ (readcharfun
, Qlambda
))
2473 /* Nowadays, reading directly from a file is used only for
2474 compiled Emacs Lisp files, and those always use the
2475 Emacs internal encoding. Meanwhile, Qlambda is used
2476 for reading dynamic byte code (compiled with
2477 byte-compile-dynamic = t). So make the string multibyte
2478 if the string contains any multibyte sequences.
2479 (to_multibyte is a no-op if not.) */
2480 to_multibyte (&p
, &end
, &nchars
);
2481 is_multibyte
= (p
- read_buffer
) != nchars
;
2484 /* In all other cases, if we read these bytes as
2485 separate characters, treat them as separate characters now. */
2488 /* We want readchar_count to be the number of characters, not
2489 bytes. Hence we adjust for multibyte characters in the
2490 string. ... But it doesn't seem to be necessary, because
2491 READCHAR *does* read multibyte characters from buffers. */
2492 /* readchar_count -= (p - read_buffer) - nchars; */
2494 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2496 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2502 int next_char
= READCHAR
;
2505 if (next_char
<= 040
2506 || (next_char
< 0200
2507 && (index ("\"';([#?", next_char
)
2508 || (!first_in_list
&& next_char
== '`')
2509 || (new_backquote_flag
&& next_char
== ','))))
2515 /* Otherwise, we fall through! Note that the atom-reading loop
2516 below will now loop at least once, assuring that we will not
2517 try to UNREAD two characters in a row. */
2521 if (c
<= 040) goto retry
;
2523 char *p
= read_buffer
;
2527 char *end
= read_buffer
+ read_buffer_size
;
2531 || (!index ("\"';()[]#", c
)
2532 && !(!first_in_list
&& c
== '`')
2533 && !(new_backquote_flag
&& c
== ','))))
2535 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2537 int offset
= p
- read_buffer
;
2538 read_buffer
= (char *) xrealloc (read_buffer
,
2539 read_buffer_size
*= 2);
2540 p
= read_buffer
+ offset
;
2541 end
= read_buffer
+ read_buffer_size
;
2548 end_of_file_error ();
2552 if (! SINGLE_BYTE_CHAR_P (c
))
2553 p
+= CHAR_STRING (c
, p
);
2562 int offset
= p
- read_buffer
;
2563 read_buffer
= (char *) xrealloc (read_buffer
,
2564 read_buffer_size
*= 2);
2565 p
= read_buffer
+ offset
;
2566 end
= read_buffer
+ read_buffer_size
;
2573 if (!quoted
&& !uninterned_symbol
)
2576 register Lisp_Object val
;
2578 if (*p1
== '+' || *p1
== '-') p1
++;
2579 /* Is it an integer? */
2582 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2583 /* Integers can have trailing decimal points. */
2584 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2586 /* It is an integer. */
2590 if (sizeof (int) == sizeof (EMACS_INT
))
2591 XSETINT (val
, atoi (read_buffer
));
2592 else if (sizeof (long) == sizeof (EMACS_INT
))
2593 XSETINT (val
, atol (read_buffer
));
2599 if (isfloat_string (read_buffer
))
2601 /* Compute NaN and infinities using 0.0 in a variable,
2602 to cope with compilers that think they are smarter
2608 /* Negate the value ourselves. This treats 0, NaNs,
2609 and infinity properly on IEEE floating point hosts,
2610 and works around a common bug where atof ("-0.0")
2612 int negative
= read_buffer
[0] == '-';
2614 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2615 returns 1, is if the input ends in e+INF or e+NaN. */
2622 value
= zero
/ zero
;
2624 /* If that made a "negative" NaN, negate it. */
2628 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2631 u_minus_zero
.d
= - 0.0;
2632 for (i
= 0; i
< sizeof (double); i
++)
2633 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2639 /* Now VALUE is a positive NaN. */
2642 value
= atof (read_buffer
+ negative
);
2646 return make_float (negative
? - value
: value
);
2650 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2651 : intern (read_buffer
);
2652 if (EQ (Vread_with_symbol_positions
, Qt
)
2653 || EQ (Vread_with_symbol_positions
, readcharfun
))
2654 Vread_symbol_positions_list
=
2655 /* Kind of a hack; this will probably fail if characters
2656 in the symbol name were escaped. Not really a big
2658 Fcons (Fcons (result
,
2659 make_number (readchar_count
2660 - XFASTINT (Flength (Fsymbol_name (result
))))),
2661 Vread_symbol_positions_list
);
2669 /* List of nodes we've seen during substitute_object_in_subtree. */
2670 static Lisp_Object seen_list
;
2673 substitute_object_in_subtree (object
, placeholder
)
2675 Lisp_Object placeholder
;
2677 Lisp_Object check_object
;
2679 /* We haven't seen any objects when we start. */
2682 /* Make all the substitutions. */
2684 = substitute_object_recurse (object
, placeholder
, object
);
2686 /* Clear seen_list because we're done with it. */
2689 /* The returned object here is expected to always eq the
2691 if (!EQ (check_object
, object
))
2692 error ("Unexpected mutation error in reader");
2695 /* Feval doesn't get called from here, so no gc protection is needed. */
2696 #define SUBSTITUTE(get_val, set_val) \
2698 Lisp_Object old_value = get_val; \
2699 Lisp_Object true_value \
2700 = substitute_object_recurse (object, placeholder,\
2703 if (!EQ (old_value, true_value)) \
2710 substitute_object_recurse (object
, placeholder
, subtree
)
2712 Lisp_Object placeholder
;
2713 Lisp_Object subtree
;
2715 /* If we find the placeholder, return the target object. */
2716 if (EQ (placeholder
, subtree
))
2719 /* If we've been to this node before, don't explore it again. */
2720 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2723 /* If this node can be the entry point to a cycle, remember that
2724 we've seen it. It can only be such an entry point if it was made
2725 by #n=, which means that we can find it as a value in
2727 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2728 seen_list
= Fcons (subtree
, seen_list
);
2730 /* Recurse according to subtree's type.
2731 Every branch must return a Lisp_Object. */
2732 switch (XTYPE (subtree
))
2734 case Lisp_Vectorlike
:
2737 int length
= XINT (Flength(subtree
));
2738 for (i
= 0; i
< length
; i
++)
2740 Lisp_Object idx
= make_number (i
);
2741 SUBSTITUTE (Faref (subtree
, idx
),
2742 Faset (subtree
, idx
, true_value
));
2749 SUBSTITUTE (Fcar_safe (subtree
),
2750 Fsetcar (subtree
, true_value
));
2751 SUBSTITUTE (Fcdr_safe (subtree
),
2752 Fsetcdr (subtree
, true_value
));
2758 /* Check for text properties in each interval.
2759 substitute_in_interval contains part of the logic. */
2761 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2762 Lisp_Object arg
= Fcons (object
, placeholder
);
2764 traverse_intervals_noorder (root_interval
,
2765 &substitute_in_interval
, arg
);
2770 /* Other types don't recurse any further. */
2776 /* Helper function for substitute_object_recurse. */
2778 substitute_in_interval (interval
, arg
)
2782 Lisp_Object object
= Fcar (arg
);
2783 Lisp_Object placeholder
= Fcdr (arg
);
2785 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2804 if (*cp
== '+' || *cp
== '-')
2807 if (*cp
>= '0' && *cp
<= '9')
2810 while (*cp
>= '0' && *cp
<= '9')
2818 if (*cp
>= '0' && *cp
<= '9')
2821 while (*cp
>= '0' && *cp
<= '9')
2824 if (*cp
== 'e' || *cp
== 'E')
2828 if (*cp
== '+' || *cp
== '-')
2832 if (*cp
>= '0' && *cp
<= '9')
2835 while (*cp
>= '0' && *cp
<= '9')
2838 else if (cp
== start
)
2840 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2845 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2851 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2852 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2853 || state
== (DOT_CHAR
|TRAIL_INT
)
2854 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2855 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2856 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2861 read_vector (readcharfun
, bytecodeflag
)
2862 Lisp_Object readcharfun
;
2867 register Lisp_Object
*ptr
;
2868 register Lisp_Object tem
, item
, vector
;
2869 register struct Lisp_Cons
*otem
;
2872 tem
= read_list (1, readcharfun
);
2873 len
= Flength (tem
);
2874 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2876 size
= XVECTOR (vector
)->size
;
2877 ptr
= XVECTOR (vector
)->contents
;
2878 for (i
= 0; i
< size
; i
++)
2881 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2882 bytecode object, the docstring containing the bytecode and
2883 constants values must be treated as unibyte and passed to
2884 Fread, to get the actual bytecode string and constants vector. */
2885 if (bytecodeflag
&& load_force_doc_strings
)
2887 if (i
== COMPILED_BYTECODE
)
2889 if (!STRINGP (item
))
2890 error ("Invalid byte code");
2892 /* Delay handling the bytecode slot until we know whether
2893 it is lazily-loaded (we can tell by whether the
2894 constants slot is nil). */
2895 ptr
[COMPILED_CONSTANTS
] = item
;
2898 else if (i
== COMPILED_CONSTANTS
)
2900 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2904 /* Coerce string to unibyte (like string-as-unibyte,
2905 but without generating extra garbage and
2906 guaranteeing no change in the contents). */
2907 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2908 STRING_SET_UNIBYTE (bytestr
);
2910 item
= Fread (bytestr
);
2912 error ("Invalid byte code");
2914 otem
= XCONS (item
);
2915 bytestr
= XCAR (item
);
2920 /* Now handle the bytecode slot. */
2921 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2924 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2932 /* FLAG = 1 means check for ] to terminate rather than ) and .
2933 FLAG = -1 means check for starting with defun
2934 and make structure pure. */
2937 read_list (flag
, readcharfun
)
2939 register Lisp_Object readcharfun
;
2941 /* -1 means check next element for defun,
2942 0 means don't check,
2943 1 means already checked and found defun. */
2944 int defunflag
= flag
< 0 ? -1 : 0;
2945 Lisp_Object val
, tail
;
2946 register Lisp_Object elt
, tem
;
2947 struct gcpro gcpro1
, gcpro2
;
2948 /* 0 is the normal case.
2949 1 means this list is a doc reference; replace it with the number 0.
2950 2 means this list is a doc reference; replace it with the doc string. */
2951 int doc_reference
= 0;
2953 /* Initialize this to 1 if we are reading a list. */
2954 int first_in_list
= flag
<= 0;
2963 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2968 /* While building, if the list starts with #$, treat it specially. */
2969 if (EQ (elt
, Vload_file_name
)
2971 && !NILP (Vpurify_flag
))
2973 if (NILP (Vdoc_file_name
))
2974 /* We have not yet called Snarf-documentation, so assume
2975 this file is described in the DOC-MM.NN file
2976 and Snarf-documentation will fill in the right value later.
2977 For now, replace the whole list with 0. */
2980 /* We have already called Snarf-documentation, so make a relative
2981 file name for this file, so it can be found properly
2982 in the installed Lisp directory.
2983 We don't use Fexpand_file_name because that would make
2984 the directory absolute now. */
2985 elt
= concat2 (build_string ("../lisp/"),
2986 Ffile_name_nondirectory (elt
));
2988 else if (EQ (elt
, Vload_file_name
)
2990 && load_force_doc_strings
)
2999 Fsignal (Qinvalid_read_syntax
,
3000 Fcons (make_string (") or . in a vector", 18), Qnil
));
3008 XSETCDR (tail
, read0 (readcharfun
));
3010 val
= read0 (readcharfun
);
3011 read1 (readcharfun
, &ch
, 0);
3015 if (doc_reference
== 1)
3016 return make_number (0);
3017 if (doc_reference
== 2)
3019 /* Get a doc string from the file we are loading.
3020 If it's in saved_doc_string, get it from there. */
3021 int pos
= XINT (XCDR (val
));
3022 /* Position is negative for user variables. */
3023 if (pos
< 0) pos
= -pos
;
3024 if (pos
>= saved_doc_string_position
3025 && pos
< (saved_doc_string_position
3026 + saved_doc_string_length
))
3028 int start
= pos
- saved_doc_string_position
;
3031 /* Process quoting with ^A,
3032 and find the end of the string,
3033 which is marked with ^_ (037). */
3034 for (from
= start
, to
= start
;
3035 saved_doc_string
[from
] != 037;)
3037 int c
= saved_doc_string
[from
++];
3040 c
= saved_doc_string
[from
++];
3042 saved_doc_string
[to
++] = c
;
3044 saved_doc_string
[to
++] = 0;
3046 saved_doc_string
[to
++] = 037;
3049 saved_doc_string
[to
++] = c
;
3052 return make_string (saved_doc_string
+ start
,
3055 /* Look in prev_saved_doc_string the same way. */
3056 else if (pos
>= prev_saved_doc_string_position
3057 && pos
< (prev_saved_doc_string_position
3058 + prev_saved_doc_string_length
))
3060 int start
= pos
- prev_saved_doc_string_position
;
3063 /* Process quoting with ^A,
3064 and find the end of the string,
3065 which is marked with ^_ (037). */
3066 for (from
= start
, to
= start
;
3067 prev_saved_doc_string
[from
] != 037;)
3069 int c
= prev_saved_doc_string
[from
++];
3072 c
= prev_saved_doc_string
[from
++];
3074 prev_saved_doc_string
[to
++] = c
;
3076 prev_saved_doc_string
[to
++] = 0;
3078 prev_saved_doc_string
[to
++] = 037;
3081 prev_saved_doc_string
[to
++] = c
;
3084 return make_string (prev_saved_doc_string
+ start
,
3088 return get_doc_string (val
, 0, 0);
3093 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3095 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3097 tem
= (read_pure
&& flag
<= 0
3098 ? pure_cons (elt
, Qnil
)
3099 : Fcons (elt
, Qnil
));
3101 XSETCDR (tail
, tem
);
3106 defunflag
= EQ (elt
, Qdefun
);
3107 else if (defunflag
> 0)
3112 Lisp_Object Vobarray
;
3113 Lisp_Object initial_obarray
;
3115 /* oblookup stores the bucket number here, for the sake of Funintern. */
3117 int oblookup_last_bucket_number
;
3119 static int hash_string ();
3121 /* Get an error if OBARRAY is not an obarray.
3122 If it is one, return it. */
3125 check_obarray (obarray
)
3126 Lisp_Object obarray
;
3128 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3130 /* If Vobarray is now invalid, force it to be valid. */
3131 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3133 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3138 /* Intern the C string STR: return a symbol with that name,
3139 interned in the current obarray. */
3146 int len
= strlen (str
);
3147 Lisp_Object obarray
;
3150 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3151 obarray
= check_obarray (obarray
);
3152 tem
= oblookup (obarray
, str
, len
, len
);
3155 return Fintern (make_string (str
, len
), obarray
);
3158 /* Create an uninterned symbol with name STR. */
3164 int len
= strlen (str
);
3166 return Fmake_symbol ((!NILP (Vpurify_flag
)
3167 ? make_pure_string (str
, len
, len
, 0)
3168 : make_string (str
, len
)));
3171 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3172 doc
: /* Return the canonical symbol whose name is STRING.
3173 If there is none, one is created by this function and returned.
3174 A second optional argument specifies the obarray to use;
3175 it defaults to the value of `obarray'. */)
3177 Lisp_Object string
, obarray
;
3179 register Lisp_Object tem
, sym
, *ptr
;
3181 if (NILP (obarray
)) obarray
= Vobarray
;
3182 obarray
= check_obarray (obarray
);
3184 CHECK_STRING (string
);
3186 tem
= oblookup (obarray
, SDATA (string
),
3189 if (!INTEGERP (tem
))
3192 if (!NILP (Vpurify_flag
))
3193 string
= Fpurecopy (string
);
3194 sym
= Fmake_symbol (string
);
3196 if (EQ (obarray
, initial_obarray
))
3197 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3199 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3201 if ((SREF (string
, 0) == ':')
3202 && EQ (obarray
, initial_obarray
))
3204 XSYMBOL (sym
)->constant
= 1;
3205 XSYMBOL (sym
)->value
= sym
;
3208 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3210 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3212 XSYMBOL (sym
)->next
= 0;
3217 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3218 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3219 NAME may be a string or a symbol. If it is a symbol, that exact
3220 symbol is searched for.
3221 A second optional argument specifies the obarray to use;
3222 it defaults to the value of `obarray'. */)
3224 Lisp_Object name
, obarray
;
3226 register Lisp_Object tem
, string
;
3228 if (NILP (obarray
)) obarray
= Vobarray
;
3229 obarray
= check_obarray (obarray
);
3231 if (!SYMBOLP (name
))
3233 CHECK_STRING (name
);
3237 string
= SYMBOL_NAME (name
);
3239 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3240 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3246 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3247 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3248 The value is t if a symbol was found and deleted, nil otherwise.
3249 NAME may be a string or a symbol. If it is a symbol, that symbol
3250 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3251 OBARRAY defaults to the value of the variable `obarray'. */)
3253 Lisp_Object name
, obarray
;
3255 register Lisp_Object string
, tem
;
3258 if (NILP (obarray
)) obarray
= Vobarray
;
3259 obarray
= check_obarray (obarray
);
3262 string
= SYMBOL_NAME (name
);
3265 CHECK_STRING (name
);
3269 tem
= oblookup (obarray
, SDATA (string
),
3274 /* If arg was a symbol, don't delete anything but that symbol itself. */
3275 if (SYMBOLP (name
) && !EQ (name
, tem
))
3278 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3279 XSYMBOL (tem
)->constant
= 0;
3280 XSYMBOL (tem
)->indirect_variable
= 0;
3282 hash
= oblookup_last_bucket_number
;
3284 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3286 if (XSYMBOL (tem
)->next
)
3287 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3289 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3293 Lisp_Object tail
, following
;
3295 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3296 XSYMBOL (tail
)->next
;
3299 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3300 if (EQ (following
, tem
))
3302 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3311 /* Return the symbol in OBARRAY whose names matches the string
3312 of SIZE characters (SIZE_BYTE bytes) at PTR.
3313 If there is no such symbol in OBARRAY, return nil.
3315 Also store the bucket number in oblookup_last_bucket_number. */
3318 oblookup (obarray
, ptr
, size
, size_byte
)
3319 Lisp_Object obarray
;
3320 register const char *ptr
;
3321 int size
, size_byte
;
3325 register Lisp_Object tail
;
3326 Lisp_Object bucket
, tem
;
3328 if (!VECTORP (obarray
)
3329 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3331 obarray
= check_obarray (obarray
);
3332 obsize
= XVECTOR (obarray
)->size
;
3334 /* This is sometimes needed in the middle of GC. */
3335 obsize
&= ~ARRAY_MARK_FLAG
;
3336 /* Combining next two lines breaks VMS C 2.3. */
3337 hash
= hash_string (ptr
, size_byte
);
3339 bucket
= XVECTOR (obarray
)->contents
[hash
];
3340 oblookup_last_bucket_number
= hash
;
3341 if (EQ (bucket
, make_number (0)))
3343 else if (!SYMBOLP (bucket
))
3344 error ("Bad data in guts of obarray"); /* Like CADR error message */
3346 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3348 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3349 && SCHARS (SYMBOL_NAME (tail
)) == size
3350 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3352 else if (XSYMBOL (tail
)->next
== 0)
3355 XSETINT (tem
, hash
);
3360 hash_string (ptr
, len
)
3361 const unsigned char *ptr
;
3364 register const unsigned char *p
= ptr
;
3365 register const unsigned char *end
= p
+ len
;
3366 register unsigned char c
;
3367 register int hash
= 0;
3372 if (c
>= 0140) c
-= 40;
3373 hash
= ((hash
<<3) + (hash
>>28) + c
);
3375 return hash
& 07777777777;
3379 map_obarray (obarray
, fn
, arg
)
3380 Lisp_Object obarray
;
3381 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3385 register Lisp_Object tail
;
3386 CHECK_VECTOR (obarray
);
3387 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3389 tail
= XVECTOR (obarray
)->contents
[i
];
3394 if (XSYMBOL (tail
)->next
== 0)
3396 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3402 mapatoms_1 (sym
, function
)
3403 Lisp_Object sym
, function
;
3405 call1 (function
, sym
);
3408 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3409 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3410 OBARRAY defaults to the value of `obarray'. */)
3412 Lisp_Object function
, obarray
;
3414 if (NILP (obarray
)) obarray
= Vobarray
;
3415 obarray
= check_obarray (obarray
);
3417 map_obarray (obarray
, mapatoms_1
, function
);
3421 #define OBARRAY_SIZE 1511
3426 Lisp_Object oblength
;
3430 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3432 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3433 Vobarray
= Fmake_vector (oblength
, make_number (0));
3434 initial_obarray
= Vobarray
;
3435 staticpro (&initial_obarray
);
3436 /* Intern nil in the obarray */
3437 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3438 XSYMBOL (Qnil
)->constant
= 1;
3440 /* These locals are to kludge around a pyramid compiler bug. */
3441 hash
= hash_string ("nil", 3);
3442 /* Separate statement here to avoid VAXC bug. */
3443 hash
%= OBARRAY_SIZE
;
3444 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3447 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3448 XSYMBOL (Qnil
)->function
= Qunbound
;
3449 XSYMBOL (Qunbound
)->value
= Qunbound
;
3450 XSYMBOL (Qunbound
)->function
= Qunbound
;
3453 XSYMBOL (Qnil
)->value
= Qnil
;
3454 XSYMBOL (Qnil
)->plist
= Qnil
;
3455 XSYMBOL (Qt
)->value
= Qt
;
3456 XSYMBOL (Qt
)->constant
= 1;
3458 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3461 Qvariable_documentation
= intern ("variable-documentation");
3462 staticpro (&Qvariable_documentation
);
3464 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3465 read_buffer
= (char *) xmalloc (read_buffer_size
);
3470 struct Lisp_Subr
*sname
;
3473 sym
= intern (sname
->symbol_name
);
3474 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3477 #ifdef NOTDEF /* use fset in subr.el now */
3479 defalias (sname
, string
)
3480 struct Lisp_Subr
*sname
;
3484 sym
= intern (string
);
3485 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3489 /* Define an "integer variable"; a symbol whose value is forwarded
3490 to a C variable of type int. Sample call: */
3491 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3493 defvar_int (namestring
, address
)
3497 Lisp_Object sym
, val
;
3498 sym
= intern (namestring
);
3499 val
= allocate_misc ();
3500 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3501 XINTFWD (val
)->intvar
= address
;
3502 SET_SYMBOL_VALUE (sym
, val
);
3505 /* Similar but define a variable whose value is t if address contains 1,
3506 nil if address contains 0 */
3508 defvar_bool (namestring
, address
)
3512 Lisp_Object sym
, val
;
3513 sym
= intern (namestring
);
3514 val
= allocate_misc ();
3515 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3516 XBOOLFWD (val
)->boolvar
= address
;
3517 SET_SYMBOL_VALUE (sym
, val
);
3518 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3521 /* Similar but define a variable whose value is the Lisp Object stored
3522 at address. Two versions: with and without gc-marking of the C
3523 variable. The nopro version is used when that variable will be
3524 gc-marked for some other reason, since marking the same slot twice
3525 can cause trouble with strings. */
3527 defvar_lisp_nopro (namestring
, address
)
3529 Lisp_Object
*address
;
3531 Lisp_Object sym
, val
;
3532 sym
= intern (namestring
);
3533 val
= allocate_misc ();
3534 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3535 XOBJFWD (val
)->objvar
= address
;
3536 SET_SYMBOL_VALUE (sym
, val
);
3540 defvar_lisp (namestring
, address
)
3542 Lisp_Object
*address
;
3544 defvar_lisp_nopro (namestring
, address
);
3545 staticpro (address
);
3548 /* Similar but define a variable whose value is the Lisp Object stored in
3549 the current buffer. address is the address of the slot in the buffer
3550 that is current now. */
3553 defvar_per_buffer (namestring
, address
, type
, doc
)
3555 Lisp_Object
*address
;
3559 Lisp_Object sym
, val
;
3562 sym
= intern (namestring
);
3563 val
= allocate_misc ();
3564 offset
= (char *)address
- (char *)current_buffer
;
3566 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3567 XBUFFER_OBJFWD (val
)->offset
= offset
;
3568 SET_SYMBOL_VALUE (sym
, val
);
3569 PER_BUFFER_SYMBOL (offset
) = sym
;
3570 PER_BUFFER_TYPE (offset
) = type
;
3572 if (PER_BUFFER_IDX (offset
) == 0)
3573 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3574 slot of buffer_local_flags */
3579 /* Similar but define a variable whose value is the Lisp Object stored
3580 at a particular offset in the current kboard object. */
3583 defvar_kboard (namestring
, offset
)
3587 Lisp_Object sym
, val
;
3588 sym
= intern (namestring
);
3589 val
= allocate_misc ();
3590 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3591 XKBOARD_OBJFWD (val
)->offset
= offset
;
3592 SET_SYMBOL_VALUE (sym
, val
);
3595 /* Record the value of load-path used at the start of dumping
3596 so we can see if the site changed it later during dumping. */
3597 static Lisp_Object dump_path
;
3603 int turn_off_warning
= 0;
3605 /* Compute the default load-path. */
3607 normal
= PATH_LOADSEARCH
;
3608 Vload_path
= decode_env_path (0, normal
);
3610 if (NILP (Vpurify_flag
))
3611 normal
= PATH_LOADSEARCH
;
3613 normal
= PATH_DUMPLOADSEARCH
;
3615 /* In a dumped Emacs, we normally have to reset the value of
3616 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3617 uses ../lisp, instead of the path of the installed elisp
3618 libraries. However, if it appears that Vload_path was changed
3619 from the default before dumping, don't override that value. */
3622 if (! NILP (Fequal (dump_path
, Vload_path
)))
3624 Vload_path
= decode_env_path (0, normal
);
3625 if (!NILP (Vinstallation_directory
))
3627 Lisp_Object tem
, tem1
, sitelisp
;
3629 /* Remove site-lisp dirs from path temporarily and store
3630 them in sitelisp, then conc them on at the end so
3631 they're always first in path. */
3635 tem
= Fcar (Vload_path
);
3636 tem1
= Fstring_match (build_string ("site-lisp"),
3640 Vload_path
= Fcdr (Vload_path
);
3641 sitelisp
= Fcons (tem
, sitelisp
);
3647 /* Add to the path the lisp subdir of the
3648 installation dir, if it exists. */
3649 tem
= Fexpand_file_name (build_string ("lisp"),
3650 Vinstallation_directory
);
3651 tem1
= Ffile_exists_p (tem
);
3654 if (NILP (Fmember (tem
, Vload_path
)))
3656 turn_off_warning
= 1;
3657 Vload_path
= Fcons (tem
, Vload_path
);
3661 /* That dir doesn't exist, so add the build-time
3662 Lisp dirs instead. */
3663 Vload_path
= nconc2 (Vload_path
, dump_path
);
3665 /* Add leim under the installation dir, if it exists. */
3666 tem
= Fexpand_file_name (build_string ("leim"),
3667 Vinstallation_directory
);
3668 tem1
= Ffile_exists_p (tem
);
3671 if (NILP (Fmember (tem
, Vload_path
)))
3672 Vload_path
= Fcons (tem
, Vload_path
);
3675 /* Add site-list under the installation dir, if it exists. */
3676 tem
= Fexpand_file_name (build_string ("site-lisp"),
3677 Vinstallation_directory
);
3678 tem1
= Ffile_exists_p (tem
);
3681 if (NILP (Fmember (tem
, Vload_path
)))
3682 Vload_path
= Fcons (tem
, Vload_path
);
3685 /* If Emacs was not built in the source directory,
3686 and it is run from where it was built, add to load-path
3687 the lisp, leim and site-lisp dirs under that directory. */
3689 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3693 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3694 Vinstallation_directory
);
3695 tem1
= Ffile_exists_p (tem
);
3697 /* Don't be fooled if they moved the entire source tree
3698 AFTER dumping Emacs. If the build directory is indeed
3699 different from the source dir, src/Makefile.in and
3700 src/Makefile will not be found together. */
3701 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3702 Vinstallation_directory
);
3703 tem2
= Ffile_exists_p (tem
);
3704 if (!NILP (tem1
) && NILP (tem2
))
3706 tem
= Fexpand_file_name (build_string ("lisp"),
3709 if (NILP (Fmember (tem
, Vload_path
)))
3710 Vload_path
= Fcons (tem
, Vload_path
);
3712 tem
= Fexpand_file_name (build_string ("leim"),
3715 if (NILP (Fmember (tem
, Vload_path
)))
3716 Vload_path
= Fcons (tem
, Vload_path
);
3718 tem
= Fexpand_file_name (build_string ("site-lisp"),
3721 if (NILP (Fmember (tem
, Vload_path
)))
3722 Vload_path
= Fcons (tem
, Vload_path
);
3725 if (!NILP (sitelisp
))
3726 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3732 /* NORMAL refers to the lisp dir in the source directory. */
3733 /* We used to add ../lisp at the front here, but
3734 that caused trouble because it was copied from dump_path
3735 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3736 It should be unnecessary. */
3737 Vload_path
= decode_env_path (0, normal
);
3738 dump_path
= Vload_path
;
3742 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3743 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3744 almost never correct, thereby causing a warning to be printed out that
3745 confuses users. Since PATH_LOADSEARCH is always overridden by the
3746 EMACSLOADPATH environment variable below, disable the warning on NT.
3747 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3748 the "standard" paths may not exist and would be overridden by
3749 EMACSLOADPATH as on NT. Since this depends on how the executable
3750 was build and packaged, turn off the warnings in general */
3752 /* Warn if dirs in the *standard* path don't exist. */
3753 if (!turn_off_warning
)
3755 Lisp_Object path_tail
;
3757 for (path_tail
= Vload_path
;
3759 path_tail
= XCDR (path_tail
))
3761 Lisp_Object dirfile
;
3762 dirfile
= Fcar (path_tail
);
3763 if (STRINGP (dirfile
))
3765 dirfile
= Fdirectory_file_name (dirfile
);
3766 if (access (SDATA (dirfile
), 0) < 0)
3767 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3772 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3774 /* If the EMACSLOADPATH environment variable is set, use its value.
3775 This doesn't apply if we're dumping. */
3777 if (NILP (Vpurify_flag
)
3778 && egetenv ("EMACSLOADPATH"))
3780 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3784 load_in_progress
= 0;
3785 Vload_file_name
= Qnil
;
3787 load_descriptor_list
= Qnil
;
3789 Vstandard_input
= Qt
;
3790 Vloads_in_progress
= Qnil
;
3793 /* Print a warning, using format string FORMAT, that directory DIRNAME
3794 does not exist. Print it on stderr and put it in *Message*. */
3797 dir_warning (format
, dirname
)
3799 Lisp_Object dirname
;
3802 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3804 fprintf (stderr
, format
, SDATA (dirname
));
3805 sprintf (buffer
, format
, SDATA (dirname
));
3806 /* Don't log the warning before we've initialized!! */
3808 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3815 defsubr (&Sread_from_string
);
3817 defsubr (&Sintern_soft
);
3818 defsubr (&Sunintern
);
3820 defsubr (&Seval_buffer
);
3821 defsubr (&Seval_region
);
3822 defsubr (&Sread_char
);
3823 defsubr (&Sread_char_exclusive
);
3824 defsubr (&Sread_event
);
3825 defsubr (&Sget_file_char
);
3826 defsubr (&Smapatoms
);
3827 defsubr (&Slocate_file_internal
);
3829 DEFVAR_LISP ("obarray", &Vobarray
,
3830 doc
: /* Symbol table for use by `intern' and `read'.
3831 It is a vector whose length ought to be prime for best results.
3832 The vector's contents don't make sense if examined from Lisp programs;
3833 to find all the symbols in an obarray, use `mapatoms'. */);
3835 DEFVAR_LISP ("values", &Vvalues
,
3836 doc
: /* List of values of all expressions which were read, evaluated and printed.
3837 Order is reverse chronological. */);
3839 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3840 doc
: /* Stream for read to get input from.
3841 See documentation of `read' for possible values. */);
3842 Vstandard_input
= Qt
;
3844 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3845 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3847 If this variable is a buffer, then only forms read from that buffer
3848 will be added to `read-symbol-positions-list'.
3849 If this variable is t, then all read forms will be added.
3850 The effect of all other values other than nil are not currently
3851 defined, although they may be in the future.
3853 The positions are relative to the last call to `read' or
3854 `read-from-string'. It is probably a bad idea to set this variable at
3855 the toplevel; bind it instead. */);
3856 Vread_with_symbol_positions
= Qnil
;
3858 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3859 doc
: /* A list mapping read symbols to their positions.
3860 This variable is modified during calls to `read' or
3861 `read-from-string', but only when `read-with-symbol-positions' is
3864 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3865 CHAR-POSITION is an integer giving the offset of that occurrence of the
3866 symbol from the position where `read' or `read-from-string' started.
3868 Note that a symbol will appear multiple times in this list, if it was
3869 read multiple times. The list is in the same order as the symbols
3871 Vread_symbol_positions_list
= Qnil
;
3873 DEFVAR_LISP ("load-path", &Vload_path
,
3874 doc
: /* *List of directories to search for files to load.
3875 Each element is a string (directory name) or nil (try default directory).
3876 Initialized based on EMACSLOADPATH environment variable, if any,
3877 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3879 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3880 doc
: /* *List of suffixes to try for files to load.
3881 This list should not include the empty string. */);
3882 Vload_suffixes
= Fcons (build_string (".elc"),
3883 Fcons (build_string (".el"), Qnil
));
3884 /* We don't use empty_string because it's not initialized yet. */
3885 default_suffixes
= Fcons (build_string (""), Qnil
);
3886 staticpro (&default_suffixes
);
3888 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3889 doc
: /* Non-nil iff inside of `load'. */);
3891 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3892 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3893 Each element looks like (FILENAME FORMS...).
3894 When `load' is run and the file-name argument is FILENAME,
3895 the FORMS in the corresponding element are executed at the end of loading.
3897 FILENAME must match exactly! Normally FILENAME is the name of a library,
3898 with no directory specified, since that is how `load' is normally called.
3899 An error in FORMS does not undo the load,
3900 but does prevent execution of the rest of the FORMS.
3901 FILENAME can also be a symbol (a feature) and FORMS are then executed
3902 when the corresponding call to `provide' is made. */);
3903 Vafter_load_alist
= Qnil
;
3905 DEFVAR_LISP ("load-history", &Vload_history
,
3906 doc
: /* Alist mapping file names to symbols and features.
3907 Each alist element is a list that starts with a file name,
3908 except for one element (optional) that starts with nil and describes
3909 definitions evaluated from buffers not visiting files.
3910 The remaining elements of each list are symbols defined as variables
3911 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3912 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3913 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3914 and means that SYMBOL was an autoload before this file redefined it
3917 During preloading, the file name recorded is relative to the main Lisp
3918 directory. These file names are converted to absolute at startup. */);
3919 Vload_history
= Qnil
;
3921 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3922 doc
: /* Full name of file being loaded by `load'. */);
3923 Vload_file_name
= Qnil
;
3925 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3926 doc
: /* File name, including directory, of user's initialization file.
3927 If the file loaded had extension `.elc', and the corresponding source file
3928 exists, this variable contains the name of source file, suitable for use
3929 by functions like `custom-save-all' which edit the init file. */);
3930 Vuser_init_file
= Qnil
;
3932 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3933 doc
: /* Used for internal purposes by `load'. */);
3934 Vcurrent_load_list
= Qnil
;
3936 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3937 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3938 The default is nil, which means use the function `read'. */);
3939 Vload_read_function
= Qnil
;
3941 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3942 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3943 This function is for doing code conversion before reading the source file.
3944 If nil, loading is done without any code conversion.
3945 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3946 FULLNAME is the full name of FILE.
3947 See `load' for the meaning of the remaining arguments. */);
3948 Vload_source_file_function
= Qnil
;
3950 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3951 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3952 This is useful when the file being loaded is a temporary copy. */);
3953 load_force_doc_strings
= 0;
3955 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3956 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3957 This is normally bound by `load' and `eval-buffer' to control `read',
3958 and is not meant for users to change. */);
3959 load_convert_to_unibyte
= 0;
3961 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3962 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3963 You cannot count on them to still be there! */);
3965 = Fexpand_file_name (build_string ("../"),
3966 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3968 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3969 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3970 Vpreloaded_file_list
= Qnil
;
3972 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3973 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3974 Vbyte_boolean_vars
= Qnil
;
3976 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3977 doc
: /* Non-nil means load dangerous compiled Lisp files.
3978 Some versions of XEmacs use different byte codes than Emacs. These
3979 incompatible byte codes can make Emacs crash when it tries to execute
3981 load_dangerous_libraries
= 0;
3983 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3984 doc
: /* Regular expression matching safe to load compiled Lisp files.
3985 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3986 from the file, and matches them against this regular expression.
3987 When the regular expression matches, the file is considered to be safe
3988 to load. See also `load-dangerous-libraries'. */);
3989 Vbytecomp_version_regexp
3990 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3992 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
3993 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
3994 Veval_buffer_list
= Qnil
;
3996 /* Vsource_directory was initialized in init_lread. */
3998 load_descriptor_list
= Qnil
;
3999 staticpro (&load_descriptor_list
);
4001 Qcurrent_load_list
= intern ("current-load-list");
4002 staticpro (&Qcurrent_load_list
);
4004 Qstandard_input
= intern ("standard-input");
4005 staticpro (&Qstandard_input
);
4007 Qread_char
= intern ("read-char");
4008 staticpro (&Qread_char
);
4010 Qget_file_char
= intern ("get-file-char");
4011 staticpro (&Qget_file_char
);
4013 Qbackquote
= intern ("`");
4014 staticpro (&Qbackquote
);
4015 Qcomma
= intern (",");
4016 staticpro (&Qcomma
);
4017 Qcomma_at
= intern (",@");
4018 staticpro (&Qcomma_at
);
4019 Qcomma_dot
= intern (",.");
4020 staticpro (&Qcomma_dot
);
4022 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4023 staticpro (&Qinhibit_file_name_operation
);
4025 Qascii_character
= intern ("ascii-character");
4026 staticpro (&Qascii_character
);
4028 Qfunction
= intern ("function");
4029 staticpro (&Qfunction
);
4031 Qload
= intern ("load");
4034 Qload_file_name
= intern ("load-file-name");
4035 staticpro (&Qload_file_name
);
4037 Qeval_buffer_list
= intern ("eval-buffer-list");
4038 staticpro (&Qeval_buffer_list
);
4040 staticpro (&dump_path
);
4042 staticpro (&read_objects
);
4043 read_objects
= Qnil
;
4044 staticpro (&seen_list
);
4047 Vloads_in_progress
= Qnil
;
4048 staticpro (&Vloads_in_progress
);
4051 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4052 (do not change this comment) */