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, 2006, 2007 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 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
31 #include "intervals.h"
37 #include "termhooks.h"
39 #include "blockinput.h"
42 #include <sys/inode.h>
47 #include <unistd.h> /* to get X_OK */
64 #endif /* HAVE_SETLOCALE */
74 #define file_offset off_t
75 #define file_tell ftello
77 #define file_offset long
78 #define file_tell ftell
85 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
86 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
87 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
88 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
89 Lisp_Object Qinhibit_file_name_operation
;
90 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
91 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
93 extern Lisp_Object Qevent_symbol_element_mask
;
94 extern Lisp_Object Qfile_exists_p
;
96 /* non-zero if 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
, Vload_file_rep_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
;
196 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
198 /* A list of file names for files being loaded in Fload. Used to
199 check for recursive loads. */
201 static Lisp_Object Vloads_in_progress
;
203 /* Non-zero means load dangerous compiled Lisp files. */
205 int load_dangerous_libraries
;
207 /* A regular expression used to detect files compiled with Emacs. */
209 static Lisp_Object Vbytecomp_version_regexp
;
211 static void to_multibyte
P_ ((char **, char **, int *));
212 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
213 Lisp_Object (*) (), int,
214 Lisp_Object
, Lisp_Object
,
215 Lisp_Object
, Lisp_Object
));
216 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
217 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
219 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
220 static void end_of_file_error
P_ (()) NO_RETURN
;
223 /* Handle unreading and rereading of characters.
224 Write READCHAR to read a character,
225 UNREAD(c) to unread c to be read again.
227 The READCHAR and UNREAD macros are meant for reading/unreading a
228 byte code; they do not handle multibyte characters. The caller
229 should manage them if necessary.
231 [ Actually that seems to be a lie; READCHAR will definitely read
232 multibyte characters from buffer sources, at least. Is the
233 comment just out of date?
234 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
237 #define READCHAR readchar (readcharfun)
238 #define UNREAD(c) unreadchar (readcharfun, c)
241 readchar (readcharfun
)
242 Lisp_Object readcharfun
;
249 if (BUFFERP (readcharfun
))
251 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
253 int pt_byte
= BUF_PT_BYTE (inbuffer
);
254 int orig_pt_byte
= pt_byte
;
256 if (readchar_backlog
> 0)
257 /* We get the address of the byte just passed,
258 which is the last byte of the character.
259 The other bytes in this character are consecutive with it,
260 because the gap can't be in the middle of a character. */
261 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
262 - --readchar_backlog
);
264 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
267 readchar_backlog
= -1;
269 if (! NILP (inbuffer
->enable_multibyte_characters
))
271 /* Fetch the character code from the buffer. */
272 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
273 BUF_INC_POS (inbuffer
, pt_byte
);
274 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
278 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
281 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
285 if (MARKERP (readcharfun
))
287 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
289 int bytepos
= marker_byte_position (readcharfun
);
290 int orig_bytepos
= bytepos
;
292 if (readchar_backlog
> 0)
293 /* We get the address of the byte just passed,
294 which is the last byte of the character.
295 The other bytes in this character are consecutive with it,
296 because the gap can't be in the middle of a character. */
297 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
298 - --readchar_backlog
);
300 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
303 readchar_backlog
= -1;
305 if (! NILP (inbuffer
->enable_multibyte_characters
))
307 /* Fetch the character code from the buffer. */
308 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
309 BUF_INC_POS (inbuffer
, bytepos
);
310 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
314 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
318 XMARKER (readcharfun
)->bytepos
= bytepos
;
319 XMARKER (readcharfun
)->charpos
++;
324 if (EQ (readcharfun
, Qlambda
))
325 return read_bytecode_char (0);
327 if (EQ (readcharfun
, Qget_file_char
))
332 /* Interrupted reads have been observed while reading over the network */
333 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
346 if (STRINGP (readcharfun
))
348 if (read_from_string_index
>= read_from_string_limit
)
351 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
352 read_from_string_index
,
353 read_from_string_index_byte
);
358 tem
= call0 (readcharfun
);
365 /* Unread the character C in the way appropriate for the stream READCHARFUN.
366 If the stream is a user function, call it with the char as argument. */
369 unreadchar (readcharfun
, c
)
370 Lisp_Object readcharfun
;
375 /* Don't back up the pointer if we're unreading the end-of-input mark,
376 since readchar didn't advance it when we read it. */
378 else if (BUFFERP (readcharfun
))
380 struct buffer
*b
= XBUFFER (readcharfun
);
381 int bytepos
= BUF_PT_BYTE (b
);
383 if (readchar_backlog
>= 0)
388 if (! NILP (b
->enable_multibyte_characters
))
389 BUF_DEC_POS (b
, bytepos
);
393 BUF_PT_BYTE (b
) = bytepos
;
396 else if (MARKERP (readcharfun
))
398 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
399 int bytepos
= XMARKER (readcharfun
)->bytepos
;
401 if (readchar_backlog
>= 0)
405 XMARKER (readcharfun
)->charpos
--;
406 if (! NILP (b
->enable_multibyte_characters
))
407 BUF_DEC_POS (b
, bytepos
);
411 XMARKER (readcharfun
)->bytepos
= bytepos
;
414 else if (STRINGP (readcharfun
))
416 read_from_string_index
--;
417 read_from_string_index_byte
418 = string_char_to_byte (readcharfun
, read_from_string_index
);
420 else if (EQ (readcharfun
, Qlambda
))
421 read_bytecode_char (1);
422 else if (EQ (readcharfun
, Qget_file_char
))
425 ungetc (c
, instream
);
429 call1 (readcharfun
, make_number (c
));
432 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
434 static Lisp_Object read0
P_ ((Lisp_Object
));
435 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
437 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
438 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
439 static int read_multibyte
P_ ((int, Lisp_Object
));
441 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
443 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
445 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
448 /* Get a character from the tty. */
450 extern Lisp_Object
read_char ();
452 /* Read input events until we get one that's acceptable for our purposes.
454 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
455 until we get a character we like, and then stuffed into
458 If ASCII_REQUIRED is non-zero, we check function key events to see
459 if the unmodified version of the symbol has a Qascii_character
460 property, and use that character, if present.
462 If ERROR_NONASCII is non-zero, we signal an error if the input we
463 get isn't an ASCII character with modifiers. If it's zero but
464 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
467 If INPUT_METHOD is nonzero, we invoke the current input method
468 if the character warrants that.
470 If SECONDS is a number, we wait that many seconds for input, and
471 return Qnil if no input arrives within that time. */
474 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
475 input_method
, seconds
)
476 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
479 Lisp_Object val
, delayed_switch_frame
;
482 #ifdef HAVE_WINDOW_SYSTEM
483 if (display_hourglass_p
)
487 delayed_switch_frame
= Qnil
;
489 /* Compute timeout. */
490 if (NUMBERP (seconds
))
492 EMACS_TIME wait_time
;
494 double duration
= extract_float (seconds
);
496 sec
= (int) duration
;
497 usec
= (duration
- sec
) * 1000000;
498 EMACS_GET_TIME (end_time
);
499 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
500 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
503 /* Read until we get an acceptable event. */
505 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
506 NUMBERP (seconds
) ? &end_time
: NULL
);
511 /* switch-frame events are put off until after the next ASCII
512 character. This is better than signaling an error just because
513 the last characters were typed to a separate minibuffer frame,
514 for example. Eventually, some code which can deal with
515 switch-frame events will read it and process it. */
517 && EVENT_HAS_PARAMETERS (val
)
518 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
520 delayed_switch_frame
= val
;
524 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
526 /* Convert certain symbols to their ASCII equivalents. */
529 Lisp_Object tem
, tem1
;
530 tem
= Fget (val
, Qevent_symbol_element_mask
);
533 tem1
= Fget (Fcar (tem
), Qascii_character
);
534 /* Merge this symbol's modifier bits
535 with the ASCII equivalent of its basic code. */
537 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
541 /* If we don't have a character now, deal with it appropriately. */
546 Vunread_command_events
= Fcons (val
, Qnil
);
547 error ("Non-character input-event");
554 if (! NILP (delayed_switch_frame
))
555 unread_switch_frame
= delayed_switch_frame
;
559 #ifdef HAVE_WINDOW_SYSTEM
560 if (display_hourglass_p
)
569 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
570 doc
: /* Read a character from the command input (keyboard or macro).
571 It is returned as a number.
572 If the user generates an event which is not a character (i.e. a mouse
573 click or function key event), `read-char' signals an error. As an
574 exception, switch-frame events are put off until non-ASCII events can
576 If you want to read non-character events, or ignore them, call
577 `read-event' or `read-char-exclusive' instead.
579 If the optional argument PROMPT is non-nil, display that as a prompt.
580 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
581 input method is turned on in the current buffer, that input method
582 is used for reading a character.
583 If the optional argument SECONDS is non-nil, it should be a number
584 specifying the maximum number of seconds to wait for input. If no
585 input arrives in that time, return nil. SECONDS may be a
586 floating-point value. */)
587 (prompt
, inherit_input_method
, seconds
)
588 Lisp_Object prompt
, inherit_input_method
, seconds
;
591 message_with_string ("%s", prompt
, 0);
592 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
595 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
596 doc
: /* Read an event object from the input stream.
597 If the optional argument PROMPT is non-nil, display that as a prompt.
598 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
599 input method is turned on in the current buffer, that input method
600 is used for reading a character.
601 If the optional argument SECONDS is non-nil, it should be a number
602 specifying the maximum number of seconds to wait for input. If no
603 input arrives in that time, return nil. SECONDS may be a
604 floating-point value. */)
605 (prompt
, inherit_input_method
, seconds
)
606 Lisp_Object prompt
, inherit_input_method
, seconds
;
609 message_with_string ("%s", prompt
, 0);
610 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
613 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
614 doc
: /* Read a character from the command input (keyboard or macro).
615 It is returned as a number. Non-character events are ignored.
617 If the optional argument PROMPT is non-nil, display that as a prompt.
618 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
619 input method is turned on in the current buffer, that input method
620 is used for reading a character.
621 If the optional argument SECONDS is non-nil, it should be a number
622 specifying the maximum number of seconds to wait for input. If no
623 input arrives in that time, return nil. SECONDS may be a
624 floating-point value. */)
625 (prompt
, inherit_input_method
, seconds
)
626 Lisp_Object prompt
, inherit_input_method
, seconds
;
629 message_with_string ("%s", prompt
, 0);
630 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
633 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
634 doc
: /* Don't use this yourself. */)
637 register Lisp_Object val
;
639 XSETINT (val
, getc (instream
));
646 /* Value is non-zero if the file asswociated with file descriptor FD
647 is a compiled Lisp file that's safe to load. Only files compiled
648 with Emacs are safe to load. Files compiled with XEmacs can lead
649 to a crash in Fbyte_code because of an incompatible change in the
660 /* Read the first few bytes from the file, and look for a line
661 specifying the byte compiler version used. */
662 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
667 /* Skip to the next newline, skipping over the initial `ELC'
668 with NUL bytes following it. */
669 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
673 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
678 lseek (fd
, 0, SEEK_SET
);
683 /* Callback for record_unwind_protect. Restore the old load list OLD,
684 after loading a file successfully. */
687 record_load_unwind (old
)
690 return Vloads_in_progress
= old
;
693 /* This handler function is used via internal_condition_case_1. */
696 load_error_handler (data
)
703 load_warn_old_style_backquotes (file
)
706 if (!NILP (Vold_style_backquotes
))
709 args
[0] = build_string ("!! File %s uses old-style backquotes !!");
716 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
717 doc
: /* Return the suffixes that `load' should try if a suffix is \
719 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
722 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
723 while (CONSP (suffixes
))
725 Lisp_Object exts
= Vload_file_rep_suffixes
;
726 suffix
= XCAR (suffixes
);
727 suffixes
= XCDR (suffixes
);
732 lst
= Fcons (concat2 (suffix
, ext
), lst
);
735 return Fnreverse (lst
);
738 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
739 doc
: /* Execute a file of Lisp code named FILE.
740 First try FILE with `.elc' appended, then try with `.el',
741 then try FILE unmodified (the exact suffixes in the exact order are
742 determined by `load-suffixes'). Environment variable references in
743 FILE are replaced with their values by calling `substitute-in-file-name'.
744 This function searches the directories in `load-path'.
746 If optional second arg NOERROR is non-nil,
747 report no error if FILE doesn't exist.
748 Print messages at start and end of loading unless
749 optional third arg NOMESSAGE is non-nil.
750 If optional fourth arg NOSUFFIX is non-nil, don't try adding
751 suffixes `.elc' or `.el' to the specified name FILE.
752 If optional fifth arg MUST-SUFFIX is non-nil, insist on
753 the suffix `.elc' or `.el'; don't accept just FILE unless
754 it ends in one of those suffixes or includes a directory name.
756 If this function fails to find a file, it may look for different
757 representations of that file before trying another file.
758 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
759 to the file name. Emacs uses this feature mainly to find compressed
760 versions of files when Auto Compression mode is enabled.
762 The exact suffixes that this function tries out, in the exact order,
763 are given by the value of the variable `load-file-rep-suffixes' if
764 NOSUFFIX is non-nil and by the return value of the function
765 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
766 MUST-SUFFIX are nil, this function first tries out the latter suffixes
769 Loading a file records its definitions, and its `provide' and
770 `require' calls, in an element of `load-history' whose
771 car is the file name loaded. See `load-history'.
773 Return t if the file exists and loads successfully. */)
774 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
775 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
777 register FILE *stream
;
778 register int fd
= -1;
779 int count
= SPECPDL_INDEX ();
780 struct gcpro gcpro1
, gcpro2
, gcpro3
;
781 Lisp_Object found
, efound
, hist_file_name
;
782 /* 1 means we printed the ".el is newer" message. */
784 /* 1 means we are loading a compiled file. */
796 /* If file name is magic, call the handler. */
797 /* This shouldn't be necessary any more now that `openp' handles it right.
798 handler = Ffind_file_name_handler (file, Qload);
800 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
802 /* Do this after the handler to avoid
803 the need to gcpro noerror, nomessage and nosuffix.
804 (Below here, we care only whether they are nil or not.)
805 The presence of this call is the result of a historical accident:
806 it used to be in every file-operation and when it got removed
807 everywhere, it accidentally stayed here. Since then, enough people
808 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
809 that it seemed risky to remove. */
810 if (! NILP (noerror
))
812 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
813 Qt
, load_error_handler
);
818 file
= Fsubstitute_in_file_name (file
);
821 /* Avoid weird lossage with null string as arg,
822 since it would try to load a directory as a Lisp file */
823 if (SCHARS (file
) > 0)
825 int size
= SBYTES (file
);
828 GCPRO2 (file
, found
);
830 if (! NILP (must_suffix
))
832 /* Don't insist on adding a suffix if FILE already ends with one. */
834 && !strcmp (SDATA (file
) + size
- 3, ".el"))
837 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
839 /* Don't insist on adding a suffix
840 if the argument includes a directory name. */
841 else if (! NILP (Ffile_name_directory (file
)))
845 fd
= openp (Vload_path
, file
,
846 (!NILP (nosuffix
) ? Qnil
847 : !NILP (must_suffix
) ? Fget_load_suffixes ()
848 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
849 tmp
[1] = Vload_file_rep_suffixes
,
858 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
862 /* Tell startup.el whether or not we found the user's init file. */
863 if (EQ (Qt
, Vuser_init_file
))
864 Vuser_init_file
= found
;
866 /* If FD is -2, that means openp found a magic file. */
869 if (NILP (Fequal (found
, file
)))
870 /* If FOUND is a different file name from FILE,
871 find its handler even if we have already inhibited
872 the `load' operation on FILE. */
873 handler
= Ffind_file_name_handler (found
, Qt
);
875 handler
= Ffind_file_name_handler (found
, Qload
);
876 if (! NILP (handler
))
877 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
880 /* Check if we're stuck in a recursive load cycle.
882 2000-09-21: It's not possible to just check for the file loaded
883 being a member of Vloads_in_progress. This fails because of the
884 way the byte compiler currently works; `provide's are not
885 evaluted, see font-lock.el/jit-lock.el as an example. This
886 leads to a certain amount of ``normal'' recursion.
888 Also, just loading a file recursively is not always an error in
889 the general case; the second load may do something different. */
893 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
894 if (!NILP (Fequal (found
, XCAR (tem
))))
900 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
902 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
903 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
906 /* Get the name for load-history. */
907 hist_file_name
= (! NILP (Vpurify_flag
)
908 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
909 tmp
[1] = Ffile_name_nondirectory (found
),
913 /* Check fore the presence of old-style quotes and warn about them. */
914 specbind (Qold_style_backquotes
, Qnil
);
915 record_unwind_protect (load_warn_old_style_backquotes
, file
);
917 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
919 /* Load .elc files directly, but not when they are
920 remote and have no handler! */
927 GCPRO3 (file
, found
, hist_file_name
);
929 if (!safe_to_load_p (fd
))
932 if (!load_dangerous_libraries
)
936 error ("File `%s' was not compiled in Emacs",
939 else if (!NILP (nomessage
))
940 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
945 efound
= ENCODE_FILE (found
);
950 stat ((char *)SDATA (efound
), &s1
);
951 SSET (efound
, SBYTES (efound
) - 1, 0);
952 result
= stat ((char *)SDATA (efound
), &s2
);
953 SSET (efound
, SBYTES (efound
) - 1, 'c');
955 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
957 /* Make the progress messages mention that source is newer. */
960 /* If we won't print another message, mention this anyway. */
961 if (!NILP (nomessage
))
963 Lisp_Object msg_file
;
964 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
965 message_with_string ("Source file `%s' newer than byte-compiled file",
974 /* We are loading a source file (*.el). */
975 if (!NILP (Vload_source_file_function
))
981 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
982 NILP (noerror
) ? Qnil
: Qt
,
983 NILP (nomessage
) ? Qnil
: Qt
);
984 return unbind_to (count
, val
);
988 GCPRO3 (file
, found
, hist_file_name
);
992 efound
= ENCODE_FILE (found
);
993 stream
= fopen ((char *) SDATA (efound
), fmode
);
994 #else /* not WINDOWSNT */
995 stream
= fdopen (fd
, fmode
);
996 #endif /* not WINDOWSNT */
1000 error ("Failure to create stdio stream for %s", SDATA (file
));
1003 if (! NILP (Vpurify_flag
))
1004 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1006 if (NILP (nomessage
))
1009 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1012 message_with_string ("Loading %s (source)...", file
, 1);
1014 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1016 else /* The typical case; compiled file newer than source file. */
1017 message_with_string ("Loading %s...", file
, 1);
1020 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1021 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1022 specbind (Qload_file_name
, found
);
1023 specbind (Qinhibit_file_name_operation
, Qnil
);
1024 load_descriptor_list
1025 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1027 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1028 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1029 unbind_to (count
, Qnil
);
1031 /* Run any eval-after-load forms for this file */
1032 if (NILP (Vpurify_flag
)
1033 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1034 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1038 if (saved_doc_string
)
1039 free (saved_doc_string
);
1040 saved_doc_string
= 0;
1041 saved_doc_string_size
= 0;
1043 if (prev_saved_doc_string
)
1044 xfree (prev_saved_doc_string
);
1045 prev_saved_doc_string
= 0;
1046 prev_saved_doc_string_size
= 0;
1048 if (!noninteractive
&& NILP (nomessage
))
1051 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1054 message_with_string ("Loading %s (source)...done", file
, 1);
1056 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1058 else /* The typical case; compiled file newer than source file. */
1059 message_with_string ("Loading %s...done", file
, 1);
1062 if (!NILP (Fequal (build_string ("obsolete"),
1063 Ffile_name_nondirectory
1064 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1065 message_with_string ("Package %s is obsolete", file
, 1);
1071 load_unwind (arg
) /* used as unwind-protect function in load */
1074 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1081 if (--load_in_progress
< 0) load_in_progress
= 0;
1086 load_descriptor_unwind (oldlist
)
1087 Lisp_Object oldlist
;
1089 load_descriptor_list
= oldlist
;
1093 /* Close all descriptors in use for Floads.
1094 This is used when starting a subprocess. */
1101 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1102 emacs_close (XFASTINT (XCAR (tail
)));
1107 complete_filename_p (pathname
)
1108 Lisp_Object pathname
;
1110 register const unsigned char *s
= SDATA (pathname
);
1111 return (IS_DIRECTORY_SEP (s
[0])
1112 || (SCHARS (pathname
) > 2
1113 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1123 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1124 doc
: /* Search for FILENAME through PATH.
1125 Returns the file's name in absolute form, or nil if not found.
1126 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1127 file name when searching.
1128 If non-nil, PREDICATE is used instead of `file-readable-p'.
1129 PREDICATE can also be an integer to pass to the access(2) function,
1130 in which case file-name-handlers are ignored. */)
1131 (filename
, path
, suffixes
, predicate
)
1132 Lisp_Object filename
, path
, suffixes
, predicate
;
1135 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1136 if (NILP (predicate
) && fd
> 0)
1142 /* Search for a file whose name is STR, looking in directories
1143 in the Lisp list PATH, and trying suffixes from SUFFIX.
1144 On success, returns a file descriptor. On failure, returns -1.
1146 SUFFIXES is a list of strings containing possible suffixes.
1147 The empty suffix is automatically added if the list is empty.
1149 PREDICATE non-nil means don't open the files,
1150 just look for one that satisfies the predicate. In this case,
1151 returns 1 on success. The predicate can be a lisp function or
1152 an integer to pass to `access' (in which case file-name-handlers
1155 If STOREPTR is nonzero, it points to a slot where the name of
1156 the file actually found should be stored as a Lisp string.
1157 nil is stored there on failure.
1159 If the file we find is remote, return -2
1160 but store the found remote file name in *STOREPTR. */
1163 openp (path
, str
, suffixes
, storeptr
, predicate
)
1164 Lisp_Object path
, str
;
1165 Lisp_Object suffixes
;
1166 Lisp_Object
*storeptr
;
1167 Lisp_Object predicate
;
1172 register char *fn
= buf
;
1175 Lisp_Object filename
;
1177 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1178 Lisp_Object string
, tail
, encoded_fn
;
1179 int max_suffix_len
= 0;
1183 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1185 CHECK_STRING_CAR (tail
);
1186 max_suffix_len
= max (max_suffix_len
,
1187 SBYTES (XCAR (tail
)));
1190 string
= filename
= encoded_fn
= Qnil
;
1191 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1196 if (complete_filename_p (str
))
1199 for (; CONSP (path
); path
= XCDR (path
))
1201 filename
= Fexpand_file_name (str
, XCAR (path
));
1202 if (!complete_filename_p (filename
))
1203 /* If there are non-absolute elts in PATH (eg ".") */
1204 /* Of course, this could conceivably lose if luser sets
1205 default-directory to be something non-absolute... */
1207 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1208 if (!complete_filename_p (filename
))
1209 /* Give up on this path element! */
1213 /* Calculate maximum size of any filename made from
1214 this path element/specified file name and any possible suffix. */
1215 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1216 if (fn_size
< want_size
)
1217 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1219 /* Loop over suffixes. */
1220 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1221 CONSP (tail
); tail
= XCDR (tail
))
1223 int lsuffix
= SBYTES (XCAR (tail
));
1224 Lisp_Object handler
;
1227 /* Concatenate path element/specified name with the suffix.
1228 If the directory starts with /:, remove that. */
1229 if (SCHARS (filename
) > 2
1230 && SREF (filename
, 0) == '/'
1231 && SREF (filename
, 1) == ':')
1233 strncpy (fn
, SDATA (filename
) + 2,
1234 SBYTES (filename
) - 2);
1235 fn
[SBYTES (filename
) - 2] = 0;
1239 strncpy (fn
, SDATA (filename
),
1241 fn
[SBYTES (filename
)] = 0;
1244 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1245 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1247 /* Check that the file exists and is not a directory. */
1248 /* We used to only check for handlers on non-absolute file names:
1252 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1253 It's not clear why that was the case and it breaks things like
1254 (load "/bar.el") where the file is actually "/bar.el.gz". */
1255 string
= build_string (fn
);
1256 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1257 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1259 if (NILP (predicate
))
1260 exists
= !NILP (Ffile_readable_p (string
));
1262 exists
= !NILP (call1 (predicate
, string
));
1263 if (exists
&& !NILP (Ffile_directory_p (string
)))
1268 /* We succeeded; return this descriptor and filename. */
1279 encoded_fn
= ENCODE_FILE (string
);
1280 pfn
= SDATA (encoded_fn
);
1281 exists
= (stat (pfn
, &st
) >= 0
1282 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1285 /* Check that we can access or open it. */
1286 if (NATNUMP (predicate
))
1287 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1289 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1293 /* We succeeded; return this descriptor and filename. */
1311 /* Merge the list we've accumulated of globals from the current input source
1312 into the load_history variable. The details depend on whether
1313 the source has an associated file name or not.
1315 FILENAME is the file name that we are loading from.
1316 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1319 build_load_history (filename
, entire
)
1320 Lisp_Object filename
;
1323 register Lisp_Object tail
, prev
, newelt
;
1324 register Lisp_Object tem
, tem2
;
1325 register int foundit
= 0;
1327 tail
= Vload_history
;
1330 while (CONSP (tail
))
1334 /* Find the feature's previous assoc list... */
1335 if (!NILP (Fequal (filename
, Fcar (tem
))))
1339 /* If we're loading the entire file, remove old data. */
1343 Vload_history
= XCDR (tail
);
1345 Fsetcdr (prev
, XCDR (tail
));
1348 /* Otherwise, cons on new symbols that are not already members. */
1351 tem2
= Vcurrent_load_list
;
1353 while (CONSP (tem2
))
1355 newelt
= XCAR (tem2
);
1357 if (NILP (Fmember (newelt
, tem
)))
1358 Fsetcar (tail
, Fcons (XCAR (tem
),
1359 Fcons (newelt
, XCDR (tem
))));
1372 /* If we're loading an entire file, cons the new assoc onto the
1373 front of load-history, the most-recently-loaded position. Also
1374 do this if we didn't find an existing member for the file. */
1375 if (entire
|| !foundit
)
1376 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1381 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1389 readevalloop_1 (old
)
1392 load_convert_to_unibyte
= ! NILP (old
);
1396 /* Signal an `end-of-file' error, if possible with file name
1400 end_of_file_error ()
1402 if (STRINGP (Vload_file_name
))
1403 xsignal1 (Qend_of_file
, Vload_file_name
);
1405 xsignal0 (Qend_of_file
);
1408 /* UNIBYTE specifies how to set load_convert_to_unibyte
1409 for this invocation.
1410 READFUN, if non-nil, is used instead of `read'.
1412 START, END specify region to read in current buffer (from eval-region).
1413 If the input is not from a buffer, they must be nil. */
1416 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1417 printflag
, unibyte
, readfun
, start
, end
)
1418 Lisp_Object readcharfun
;
1420 Lisp_Object sourcename
;
1421 Lisp_Object (*evalfun
) ();
1423 Lisp_Object unibyte
, readfun
;
1424 Lisp_Object start
, end
;
1427 register Lisp_Object val
;
1428 int count
= SPECPDL_INDEX ();
1429 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1430 struct buffer
*b
= 0;
1431 int continue_reading_p
;
1432 /* Nonzero if reading an entire buffer. */
1433 int whole_buffer
= 0;
1434 /* 1 on the first time around. */
1437 if (MARKERP (readcharfun
))
1440 start
= readcharfun
;
1443 if (BUFFERP (readcharfun
))
1444 b
= XBUFFER (readcharfun
);
1445 else if (MARKERP (readcharfun
))
1446 b
= XMARKER (readcharfun
)->buffer
;
1448 /* We assume START is nil when input is not from a buffer. */
1449 if (! NILP (start
) && !b
)
1452 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1453 specbind (Qcurrent_load_list
, Qnil
);
1454 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1455 load_convert_to_unibyte
= !NILP (unibyte
);
1457 readchar_backlog
= -1;
1459 GCPRO4 (sourcename
, readfun
, start
, end
);
1461 /* Try to ensure sourcename is a truename, except whilst preloading. */
1462 if (NILP (Vpurify_flag
)
1463 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1464 && !NILP (Ffboundp (Qfile_truename
)))
1465 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1467 LOADHIST_ATTACH (sourcename
);
1469 continue_reading_p
= 1;
1470 while (continue_reading_p
)
1472 int count1
= SPECPDL_INDEX ();
1474 if (b
!= 0 && NILP (b
->name
))
1475 error ("Reading from killed buffer");
1479 /* Switch to the buffer we are reading from. */
1480 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1481 set_buffer_internal (b
);
1483 /* Save point in it. */
1484 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1485 /* Save ZV in it. */
1486 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1487 /* Those get unbound after we read one expression. */
1489 /* Set point and ZV around stuff to be read. */
1492 Fnarrow_to_region (make_number (BEGV
), end
);
1494 /* Just for cleanliness, convert END to a marker
1495 if it is an integer. */
1497 end
= Fpoint_max_marker ();
1500 /* On the first cycle, we can easily test here
1501 whether we are reading the whole buffer. */
1502 if (b
&& first_sexp
)
1503 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1510 while ((c
= READCHAR
) != '\n' && c
!= -1);
1515 unbind_to (count1
, Qnil
);
1519 /* Ignore whitespace here, so we can detect eof. */
1520 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1521 || c
== 0x8a0) /* NBSP */
1524 if (!NILP (Vpurify_flag
) && c
== '(')
1526 record_unwind_protect (unreadpure
, Qnil
);
1527 val
= read_list (-1, readcharfun
);
1532 read_objects
= Qnil
;
1533 if (!NILP (readfun
))
1535 val
= call1 (readfun
, readcharfun
);
1537 /* If READCHARFUN has set point to ZV, we should
1538 stop reading, even if the form read sets point
1539 to a different value when evaluated. */
1540 if (BUFFERP (readcharfun
))
1542 struct buffer
*b
= XBUFFER (readcharfun
);
1543 if (BUF_PT (b
) == BUF_ZV (b
))
1544 continue_reading_p
= 0;
1547 else if (! NILP (Vload_read_function
))
1548 val
= call1 (Vload_read_function
, readcharfun
);
1550 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1553 if (!NILP (start
) && continue_reading_p
)
1554 start
= Fpoint_marker ();
1556 /* Restore saved point and BEGV. */
1557 unbind_to (count1
, Qnil
);
1559 /* Now eval what we just read. */
1560 val
= (*evalfun
) (val
);
1564 Vvalues
= Fcons (val
, Vvalues
);
1565 if (EQ (Vstandard_output
, Qt
))
1574 build_load_history (sourcename
,
1575 stream
|| whole_buffer
);
1579 unbind_to (count
, Qnil
);
1582 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1583 doc
: /* Execute the current buffer as Lisp code.
1584 Programs can pass two arguments, BUFFER and PRINTFLAG.
1585 BUFFER is the buffer to evaluate (nil means use current buffer).
1586 PRINTFLAG controls printing of output:
1587 A value of nil means discard it; anything else is stream for print.
1589 If the optional third argument FILENAME is non-nil,
1590 it specifies the file name to use for `load-history'.
1591 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1592 for this invocation.
1594 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1595 `print' and related functions should work normally even if PRINTFLAG is nil.
1597 This function preserves the position of point. */)
1598 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1599 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1601 int count
= SPECPDL_INDEX ();
1602 Lisp_Object tem
, buf
;
1605 buf
= Fcurrent_buffer ();
1607 buf
= Fget_buffer (buffer
);
1609 error ("No such buffer");
1611 if (NILP (printflag
) && NILP (do_allow_print
))
1616 if (NILP (filename
))
1617 filename
= XBUFFER (buf
)->filename
;
1619 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1620 specbind (Qstandard_output
, tem
);
1621 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1622 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1623 readevalloop (buf
, 0, filename
, Feval
,
1624 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1625 unbind_to (count
, Qnil
);
1630 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1631 doc
: /* Execute the region as Lisp code.
1632 When called from programs, expects two arguments,
1633 giving starting and ending indices in the current buffer
1634 of the text to be executed.
1635 Programs can pass third argument PRINTFLAG which controls output:
1636 A value of nil means discard it; anything else is stream for printing it.
1637 Also the fourth argument READ-FUNCTION, if non-nil, is used
1638 instead of `read' to read each expression. It gets one argument
1639 which is the input stream for reading characters.
1641 This function does not move point. */)
1642 (start
, end
, printflag
, read_function
)
1643 Lisp_Object start
, end
, printflag
, read_function
;
1645 int count
= SPECPDL_INDEX ();
1646 Lisp_Object tem
, cbuf
;
1648 cbuf
= Fcurrent_buffer ();
1650 if (NILP (printflag
))
1654 specbind (Qstandard_output
, tem
);
1655 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1657 /* readevalloop calls functions which check the type of start and end. */
1658 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1659 !NILP (printflag
), Qnil
, read_function
,
1662 return unbind_to (count
, Qnil
);
1666 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1667 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1668 If STREAM is nil, use the value of `standard-input' (which see).
1669 STREAM or the value of `standard-input' may be:
1670 a buffer (read from point and advance it)
1671 a marker (read from where it points and advance it)
1672 a function (call it with no arguments for each character,
1673 call it with a char as argument to push a char back)
1674 a string (takes text from string, starting at the beginning)
1675 t (read text line using minibuffer and use it, or read from
1676 standard input in batch mode). */)
1681 stream
= Vstandard_input
;
1682 if (EQ (stream
, Qt
))
1683 stream
= Qread_char
;
1684 if (EQ (stream
, Qread_char
))
1685 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1687 return read_internal_start (stream
, Qnil
, Qnil
);
1690 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1691 doc
: /* Read one Lisp expression which is represented as text by STRING.
1692 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1693 START and END optionally delimit a substring of STRING from which to read;
1694 they default to 0 and (length STRING) respectively. */)
1695 (string
, start
, end
)
1696 Lisp_Object string
, start
, end
;
1699 CHECK_STRING (string
);
1700 /* read_internal_start sets read_from_string_index. */
1701 ret
= read_internal_start (string
, start
, end
);
1702 return Fcons (ret
, make_number (read_from_string_index
));
1705 /* Function to set up the global context we need in toplevel read
1708 read_internal_start (stream
, start
, end
)
1710 Lisp_Object start
; /* Only used when stream is a string. */
1711 Lisp_Object end
; /* Only used when stream is a string. */
1715 readchar_backlog
= -1;
1717 new_backquote_flag
= 0;
1718 read_objects
= Qnil
;
1719 if (EQ (Vread_with_symbol_positions
, Qt
)
1720 || EQ (Vread_with_symbol_positions
, stream
))
1721 Vread_symbol_positions_list
= Qnil
;
1723 if (STRINGP (stream
))
1725 int startval
, endval
;
1727 endval
= SCHARS (stream
);
1731 endval
= XINT (end
);
1732 if (endval
< 0 || endval
> SCHARS (stream
))
1733 args_out_of_range (stream
, end
);
1740 CHECK_NUMBER (start
);
1741 startval
= XINT (start
);
1742 if (startval
< 0 || startval
> endval
)
1743 args_out_of_range (stream
, start
);
1745 read_from_string_index
= startval
;
1746 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1747 read_from_string_limit
= endval
;
1750 retval
= read0 (stream
);
1751 if (EQ (Vread_with_symbol_positions
, Qt
)
1752 || EQ (Vread_with_symbol_positions
, stream
))
1753 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1758 /* Signal Qinvalid_read_syntax error.
1759 S is error string of length N (if > 0) */
1762 invalid_syntax (s
, n
)
1768 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1772 /* Use this for recursive reads, in contexts where internal tokens
1777 Lisp_Object readcharfun
;
1779 register Lisp_Object val
;
1782 val
= read1 (readcharfun
, &c
, 0);
1786 xsignal1 (Qinvalid_read_syntax
,
1787 Fmake_string (make_number (1), make_number (c
)));
1790 static int read_buffer_size
;
1791 static char *read_buffer
;
1793 /* Read multibyte form and return it as a character. C is a first
1794 byte of multibyte form, and rest of them are read from
1798 read_multibyte (c
, readcharfun
)
1800 Lisp_Object readcharfun
;
1802 /* We need the actual character code of this multibyte
1804 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1812 while ((c
= READCHAR
) >= 0xA0
1813 && len
< MAX_MULTIBYTE_LENGTH
)
1819 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1820 return STRING_CHAR (str
, len
);
1821 /* The byte sequence is not valid as multibyte. Unread all bytes
1822 but the first one, and return the first byte. */
1828 /* Read a \-escape sequence, assuming we already read the `\'.
1829 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1830 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1831 Otherwise store 0 into *BYTEREP. */
1834 read_escape (readcharfun
, stringp
, byterep
)
1835 Lisp_Object readcharfun
;
1839 register int c
= READCHAR
;
1840 /* \u allows up to four hex digits, \U up to eight. Default to the
1841 behaviour for \u, and change this value in the case that \U is seen. */
1842 int unicode_hex_count
= 4;
1849 end_of_file_error ();
1879 error ("Invalid escape character syntax");
1882 c
= read_escape (readcharfun
, 0, byterep
);
1883 return c
| meta_modifier
;
1888 error ("Invalid escape character syntax");
1891 c
= read_escape (readcharfun
, 0, byterep
);
1892 return c
| shift_modifier
;
1897 error ("Invalid escape character syntax");
1900 c
= read_escape (readcharfun
, 0, byterep
);
1901 return c
| hyper_modifier
;
1906 error ("Invalid escape character syntax");
1909 c
= read_escape (readcharfun
, 0, byterep
);
1910 return c
| alt_modifier
;
1914 if (stringp
|| c
!= '-')
1921 c
= read_escape (readcharfun
, 0, byterep
);
1922 return c
| super_modifier
;
1927 error ("Invalid escape character syntax");
1931 c
= read_escape (readcharfun
, 0, byterep
);
1932 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1933 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1934 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1935 return c
| ctrl_modifier
;
1936 /* ASCII control chars are made from letters (both cases),
1937 as well as the non-letters within 0100...0137. */
1938 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1939 return (c
& (037 | ~0177));
1940 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1941 return (c
& (037 | ~0177));
1943 return c
| ctrl_modifier
;
1953 /* An octal escape, as in ANSI C. */
1955 register int i
= c
- '0';
1956 register int count
= 0;
1959 if ((c
= READCHAR
) >= '0' && c
<= '7')
1976 /* A hex escape, as in ANSI C. */
1982 if (c
>= '0' && c
<= '9')
1987 else if ((c
>= 'a' && c
<= 'f')
1988 || (c
>= 'A' && c
<= 'F'))
1991 if (c
>= 'a' && c
<= 'f')
2008 /* Post-Unicode-2.0: Up to eight hex chars. */
2009 unicode_hex_count
= 8;
2012 /* A Unicode escape. We only permit them in strings and characters,
2013 not arbitrarily in the source code, as in some other languages. */
2017 Lisp_Object lisp_char
;
2018 struct gcpro gcpro1
;
2020 while (++count
<= unicode_hex_count
)
2023 /* isdigit and isalpha may be locale-specific, which we don't
2025 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2026 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2027 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2030 error ("Non-hex digit used for Unicode escape");
2035 GCPRO1 (readcharfun
);
2036 lisp_char
= call2 (intern ("decode-char"), intern ("ucs"),
2040 if (NILP (lisp_char
))
2042 error ("Unsupported Unicode code point: U+%x", (unsigned)i
);
2045 return XFASTINT (lisp_char
);
2049 if (BASE_LEADING_CODE_P (c
))
2050 c
= read_multibyte (c
, readcharfun
);
2055 /* Read an integer in radix RADIX using READCHARFUN to read
2056 characters. RADIX must be in the interval [2..36]; if it isn't, a
2057 read error is signaled . Value is the integer read. Signals an
2058 error if encountering invalid read syntax or if RADIX is out of
2062 read_integer (readcharfun
, radix
)
2063 Lisp_Object readcharfun
;
2066 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2067 EMACS_INT number
= 0;
2069 if (radix
< 2 || radix
> 36)
2073 number
= ndigits
= invalid_p
= 0;
2089 if (c
>= '0' && c
<= '9')
2091 else if (c
>= 'a' && c
<= 'z')
2092 digit
= c
- 'a' + 10;
2093 else if (c
>= 'A' && c
<= 'Z')
2094 digit
= c
- 'A' + 10;
2101 if (digit
< 0 || digit
>= radix
)
2104 number
= radix
* number
+ digit
;
2110 if (ndigits
== 0 || invalid_p
)
2113 sprintf (buf
, "integer, radix %d", radix
);
2114 invalid_syntax (buf
, 0);
2117 return make_number (sign
* number
);
2121 /* Convert unibyte text in read_buffer to multibyte.
2123 Initially, *P is a pointer after the end of the unibyte text, and
2124 the pointer *END points after the end of read_buffer.
2126 If read_buffer doesn't have enough room to hold the result
2127 of the conversion, reallocate it and adjust *P and *END.
2129 At the end, make *P point after the result of the conversion, and
2130 return in *NCHARS the number of characters in the converted
2134 to_multibyte (p
, end
, nchars
)
2140 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
2141 if (read_buffer_size
< 2 * nbytes
)
2143 int offset
= *p
- read_buffer
;
2144 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
2145 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
2146 *p
= read_buffer
+ offset
;
2147 *end
= read_buffer
+ read_buffer_size
;
2150 if (nbytes
!= *nchars
)
2151 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
2152 *p
- read_buffer
, nchars
);
2154 *p
= read_buffer
+ nbytes
;
2158 /* If the next token is ')' or ']' or '.', we store that character
2159 in *PCH and the return value is not interesting. Else, we store
2160 zero in *PCH and we read and return one lisp object.
2162 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2165 read1 (readcharfun
, pch
, first_in_list
)
2166 register Lisp_Object readcharfun
;
2171 int uninterned_symbol
= 0;
2179 end_of_file_error ();
2184 return read_list (0, readcharfun
);
2187 return read_vector (readcharfun
, 0);
2204 tmp
= read_vector (readcharfun
, 0);
2205 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
2206 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
2207 error ("Invalid size char-table");
2208 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2209 XCHAR_TABLE (tmp
)->top
= Qt
;
2218 tmp
= read_vector (readcharfun
, 0);
2219 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2220 error ("Invalid size char-table");
2221 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2222 XCHAR_TABLE (tmp
)->top
= Qnil
;
2225 invalid_syntax ("#^^", 3);
2227 invalid_syntax ("#^", 2);
2232 length
= read1 (readcharfun
, pch
, first_in_list
);
2236 Lisp_Object tmp
, val
;
2238 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2239 / BOOL_VECTOR_BITS_PER_CHAR
);
2242 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2243 if (size_in_chars
!= SCHARS (tmp
)
2244 /* We used to print 1 char too many
2245 when the number of bits was a multiple of 8.
2246 Accept such input in case it came from an old version. */
2247 && ! (XFASTINT (length
)
2248 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2249 invalid_syntax ("#&...", 5);
2251 val
= Fmake_bool_vector (length
, Qnil
);
2252 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2254 /* Clear the extraneous bits in the last byte. */
2255 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2256 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2257 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2260 invalid_syntax ("#&...", 5);
2264 /* Accept compiled functions at read-time so that we don't have to
2265 build them using function calls. */
2267 tmp
= read_vector (readcharfun
, 1);
2268 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2269 XVECTOR (tmp
)->contents
);
2274 struct gcpro gcpro1
;
2277 /* Read the string itself. */
2278 tmp
= read1 (readcharfun
, &ch
, 0);
2279 if (ch
!= 0 || !STRINGP (tmp
))
2280 invalid_syntax ("#", 1);
2282 /* Read the intervals and their properties. */
2285 Lisp_Object beg
, end
, plist
;
2287 beg
= read1 (readcharfun
, &ch
, 0);
2292 end
= read1 (readcharfun
, &ch
, 0);
2294 plist
= read1 (readcharfun
, &ch
, 0);
2296 invalid_syntax ("Invalid string property list", 0);
2297 Fset_text_properties (beg
, end
, plist
, tmp
);
2303 /* #@NUMBER is used to skip NUMBER following characters.
2304 That's used in .elc files to skip over doc strings
2305 and function definitions. */
2310 /* Read a decimal integer. */
2311 while ((c
= READCHAR
) >= 0
2312 && c
>= '0' && c
<= '9')
2320 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2322 /* If we are supposed to force doc strings into core right now,
2323 record the last string that we skipped,
2324 and record where in the file it comes from. */
2326 /* But first exchange saved_doc_string
2327 with prev_saved_doc_string, so we save two strings. */
2329 char *temp
= saved_doc_string
;
2330 int temp_size
= saved_doc_string_size
;
2331 file_offset temp_pos
= saved_doc_string_position
;
2332 int temp_len
= saved_doc_string_length
;
2334 saved_doc_string
= prev_saved_doc_string
;
2335 saved_doc_string_size
= prev_saved_doc_string_size
;
2336 saved_doc_string_position
= prev_saved_doc_string_position
;
2337 saved_doc_string_length
= prev_saved_doc_string_length
;
2339 prev_saved_doc_string
= temp
;
2340 prev_saved_doc_string_size
= temp_size
;
2341 prev_saved_doc_string_position
= temp_pos
;
2342 prev_saved_doc_string_length
= temp_len
;
2345 if (saved_doc_string_size
== 0)
2347 saved_doc_string_size
= nskip
+ 100;
2348 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2350 if (nskip
> saved_doc_string_size
)
2352 saved_doc_string_size
= nskip
+ 100;
2353 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2354 saved_doc_string_size
);
2357 saved_doc_string_position
= file_tell (instream
);
2359 /* Copy that many characters into saved_doc_string. */
2360 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2361 saved_doc_string
[i
] = c
= READCHAR
;
2363 saved_doc_string_length
= i
;
2367 /* Skip that many characters. */
2368 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2376 /* #! appears at the beginning of an executable file.
2377 Skip the first line. */
2378 while (c
!= '\n' && c
>= 0)
2383 return Vload_file_name
;
2385 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2386 /* #:foo is the uninterned symbol named foo. */
2389 uninterned_symbol
= 1;
2393 /* Reader forms that can reuse previously read objects. */
2394 if (c
>= '0' && c
<= '9')
2399 /* Read a non-negative integer. */
2400 while (c
>= '0' && c
<= '9')
2406 /* #n=object returns object, but associates it with n for #n#. */
2409 /* Make a placeholder for #n# to use temporarily */
2410 Lisp_Object placeholder
;
2413 placeholder
= Fcons(Qnil
, Qnil
);
2414 cell
= Fcons (make_number (n
), placeholder
);
2415 read_objects
= Fcons (cell
, read_objects
);
2417 /* Read the object itself. */
2418 tem
= read0 (readcharfun
);
2420 /* Now put it everywhere the placeholder was... */
2421 substitute_object_in_subtree (tem
, placeholder
);
2423 /* ...and #n# will use the real value from now on. */
2424 Fsetcdr (cell
, tem
);
2428 /* #n# returns a previously read object. */
2431 tem
= Fassq (make_number (n
), read_objects
);
2434 /* Fall through to error message. */
2436 else if (c
== 'r' || c
== 'R')
2437 return read_integer (readcharfun
, n
);
2439 /* Fall through to error message. */
2441 else if (c
== 'x' || c
== 'X')
2442 return read_integer (readcharfun
, 16);
2443 else if (c
== 'o' || c
== 'O')
2444 return read_integer (readcharfun
, 8);
2445 else if (c
== 'b' || c
== 'B')
2446 return read_integer (readcharfun
, 2);
2449 invalid_syntax ("#", 1);
2452 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2457 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2463 Vold_style_backquotes
= Qt
;
2470 new_backquote_flag
++;
2471 value
= read0 (readcharfun
);
2472 new_backquote_flag
--;
2474 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2478 if (new_backquote_flag
)
2480 Lisp_Object comma_type
= Qnil
;
2485 comma_type
= Qcomma_at
;
2487 comma_type
= Qcomma_dot
;
2490 if (ch
>= 0) UNREAD (ch
);
2491 comma_type
= Qcomma
;
2494 new_backquote_flag
--;
2495 value
= read0 (readcharfun
);
2496 new_backquote_flag
++;
2497 return Fcons (comma_type
, Fcons (value
, Qnil
));
2501 Vold_style_backquotes
= Qt
;
2513 end_of_file_error ();
2515 /* Accept `single space' syntax like (list ? x) where the
2516 whitespace character is SPC or TAB.
2517 Other literal whitespace like NL, CR, and FF are not accepted,
2518 as there are well-established escape sequences for these. */
2519 if (c
== ' ' || c
== '\t')
2520 return make_number (c
);
2523 c
= read_escape (readcharfun
, 0, &discard
);
2524 else if (BASE_LEADING_CODE_P (c
))
2525 c
= read_multibyte (c
, readcharfun
);
2527 next_char
= READCHAR
;
2528 if (next_char
== '.')
2530 /* Only a dotted-pair dot is valid after a char constant. */
2531 int next_next_char
= READCHAR
;
2532 UNREAD (next_next_char
);
2534 ok
= (next_next_char
<= 040
2535 || (next_next_char
< 0200
2536 && (index ("\"';([#?", next_next_char
)
2537 || (!first_in_list
&& next_next_char
== '`')
2538 || (new_backquote_flag
&& next_next_char
== ','))));
2542 ok
= (next_char
<= 040
2543 || (next_char
< 0200
2544 && (index ("\"';()[]#?", next_char
)
2545 || (!first_in_list
&& next_char
== '`')
2546 || (new_backquote_flag
&& next_char
== ','))));
2550 return make_number (c
);
2552 invalid_syntax ("?", 1);
2557 char *p
= read_buffer
;
2558 char *end
= read_buffer
+ read_buffer_size
;
2560 /* 1 if we saw an escape sequence specifying
2561 a multibyte character, or a multibyte character. */
2562 int force_multibyte
= 0;
2563 /* 1 if we saw an escape sequence specifying
2564 a single-byte character. */
2565 int force_singlebyte
= 0;
2566 /* 1 if read_buffer contains multibyte text now. */
2567 int is_multibyte
= 0;
2571 while ((c
= READCHAR
) >= 0
2574 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2576 int offset
= p
- read_buffer
;
2577 read_buffer
= (char *) xrealloc (read_buffer
,
2578 read_buffer_size
*= 2);
2579 p
= read_buffer
+ offset
;
2580 end
= read_buffer
+ read_buffer_size
;
2587 c
= read_escape (readcharfun
, 1, &byterep
);
2589 /* C is -1 if \ newline has just been seen */
2592 if (p
== read_buffer
)
2598 force_singlebyte
= 1;
2599 else if (byterep
== 2)
2600 force_multibyte
= 1;
2603 /* A character that must be multibyte forces multibyte. */
2604 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2605 force_multibyte
= 1;
2607 /* If we just discovered the need to be multibyte,
2608 convert the text accumulated thus far. */
2609 if (force_multibyte
&& ! is_multibyte
)
2612 to_multibyte (&p
, &end
, &nchars
);
2615 /* Allow `\C- ' and `\C-?'. */
2616 if (c
== (CHAR_CTL
| ' '))
2618 else if (c
== (CHAR_CTL
| '?'))
2623 /* Shift modifier is valid only with [A-Za-z]. */
2624 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2626 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2627 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2631 /* Move the meta bit to the right place for a string. */
2632 c
= (c
& ~CHAR_META
) | 0x80;
2633 if (c
& CHAR_MODIFIER_MASK
)
2634 error ("Invalid modifier in string");
2637 p
+= CHAR_STRING (c
, p
);
2645 end_of_file_error ();
2647 /* If purifying, and string starts with \ newline,
2648 return zero instead. This is for doc strings
2649 that we are really going to find in etc/DOC.nn.nn */
2650 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2651 return make_number (0);
2653 if (is_multibyte
|| force_singlebyte
)
2655 else if (load_convert_to_unibyte
)
2658 to_multibyte (&p
, &end
, &nchars
);
2659 if (p
- read_buffer
!= nchars
)
2661 string
= make_multibyte_string (read_buffer
, nchars
,
2663 return Fstring_make_unibyte (string
);
2665 /* We can make a unibyte string directly. */
2668 else if (EQ (readcharfun
, Qget_file_char
)
2669 || EQ (readcharfun
, Qlambda
))
2671 /* Nowadays, reading directly from a file is used only for
2672 compiled Emacs Lisp files, and those always use the
2673 Emacs internal encoding. Meanwhile, Qlambda is used
2674 for reading dynamic byte code (compiled with
2675 byte-compile-dynamic = t). So make the string multibyte
2676 if the string contains any multibyte sequences.
2677 (to_multibyte is a no-op if not.) */
2678 to_multibyte (&p
, &end
, &nchars
);
2679 is_multibyte
= (p
- read_buffer
) != nchars
;
2682 /* In all other cases, if we read these bytes as
2683 separate characters, treat them as separate characters now. */
2686 /* We want readchar_count to be the number of characters, not
2687 bytes. Hence we adjust for multibyte characters in the
2688 string. ... But it doesn't seem to be necessary, because
2689 READCHAR *does* read multibyte characters from buffers. */
2690 /* readchar_count -= (p - read_buffer) - nchars; */
2692 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2694 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2700 int next_char
= READCHAR
;
2703 if (next_char
<= 040
2704 || (next_char
< 0200
2705 && (index ("\"';([#?", next_char
)
2706 || (!first_in_list
&& next_char
== '`')
2707 || (new_backquote_flag
&& next_char
== ','))))
2713 /* Otherwise, we fall through! Note that the atom-reading loop
2714 below will now loop at least once, assuring that we will not
2715 try to UNREAD two characters in a row. */
2719 if (c
<= 040) goto retry
;
2720 if (c
== 0x8a0) /* NBSP */
2723 char *p
= read_buffer
;
2727 char *end
= read_buffer
+ read_buffer_size
;
2730 && c
!= 0x8a0 /* NBSP */
2732 || (!index ("\"';()[]#", c
)
2733 && !(!first_in_list
&& c
== '`')
2734 && !(new_backquote_flag
&& c
== ','))))
2736 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2738 int offset
= p
- read_buffer
;
2739 read_buffer
= (char *) xrealloc (read_buffer
,
2740 read_buffer_size
*= 2);
2741 p
= read_buffer
+ offset
;
2742 end
= read_buffer
+ read_buffer_size
;
2749 end_of_file_error ();
2753 if (! SINGLE_BYTE_CHAR_P (c
))
2754 p
+= CHAR_STRING (c
, p
);
2763 int offset
= p
- read_buffer
;
2764 read_buffer
= (char *) xrealloc (read_buffer
,
2765 read_buffer_size
*= 2);
2766 p
= read_buffer
+ offset
;
2767 end
= read_buffer
+ read_buffer_size
;
2774 if (!quoted
&& !uninterned_symbol
)
2777 register Lisp_Object val
;
2779 if (*p1
== '+' || *p1
== '-') p1
++;
2780 /* Is it an integer? */
2783 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2784 /* Integers can have trailing decimal points. */
2785 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2787 /* It is an integer. */
2791 if (sizeof (int) == sizeof (EMACS_INT
))
2792 XSETINT (val
, atoi (read_buffer
));
2793 else if (sizeof (long) == sizeof (EMACS_INT
))
2794 XSETINT (val
, atol (read_buffer
));
2800 if (isfloat_string (read_buffer
))
2802 /* Compute NaN and infinities using 0.0 in a variable,
2803 to cope with compilers that think they are smarter
2809 /* Negate the value ourselves. This treats 0, NaNs,
2810 and infinity properly on IEEE floating point hosts,
2811 and works around a common bug where atof ("-0.0")
2813 int negative
= read_buffer
[0] == '-';
2815 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2816 returns 1, is if the input ends in e+INF or e+NaN. */
2823 value
= zero
/ zero
;
2825 /* If that made a "negative" NaN, negate it. */
2829 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2832 u_minus_zero
.d
= - 0.0;
2833 for (i
= 0; i
< sizeof (double); i
++)
2834 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2840 /* Now VALUE is a positive NaN. */
2843 value
= atof (read_buffer
+ negative
);
2847 return make_float (negative
? - value
: value
);
2851 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2852 : intern (read_buffer
);
2853 if (EQ (Vread_with_symbol_positions
, Qt
)
2854 || EQ (Vread_with_symbol_positions
, readcharfun
))
2855 Vread_symbol_positions_list
=
2856 /* Kind of a hack; this will probably fail if characters
2857 in the symbol name were escaped. Not really a big
2859 Fcons (Fcons (result
,
2860 make_number (readchar_count
2861 - XFASTINT (Flength (Fsymbol_name (result
))))),
2862 Vread_symbol_positions_list
);
2870 /* List of nodes we've seen during substitute_object_in_subtree. */
2871 static Lisp_Object seen_list
;
2874 substitute_object_in_subtree (object
, placeholder
)
2876 Lisp_Object placeholder
;
2878 Lisp_Object check_object
;
2880 /* We haven't seen any objects when we start. */
2883 /* Make all the substitutions. */
2885 = substitute_object_recurse (object
, placeholder
, object
);
2887 /* Clear seen_list because we're done with it. */
2890 /* The returned object here is expected to always eq the
2892 if (!EQ (check_object
, object
))
2893 error ("Unexpected mutation error in reader");
2896 /* Feval doesn't get called from here, so no gc protection is needed. */
2897 #define SUBSTITUTE(get_val, set_val) \
2899 Lisp_Object old_value = get_val; \
2900 Lisp_Object true_value \
2901 = substitute_object_recurse (object, placeholder,\
2904 if (!EQ (old_value, true_value)) \
2911 substitute_object_recurse (object
, placeholder
, subtree
)
2913 Lisp_Object placeholder
;
2914 Lisp_Object subtree
;
2916 /* If we find the placeholder, return the target object. */
2917 if (EQ (placeholder
, subtree
))
2920 /* If we've been to this node before, don't explore it again. */
2921 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2924 /* If this node can be the entry point to a cycle, remember that
2925 we've seen it. It can only be such an entry point if it was made
2926 by #n=, which means that we can find it as a value in
2928 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2929 seen_list
= Fcons (subtree
, seen_list
);
2931 /* Recurse according to subtree's type.
2932 Every branch must return a Lisp_Object. */
2933 switch (XTYPE (subtree
))
2935 case Lisp_Vectorlike
:
2938 int length
= XINT (Flength(subtree
));
2939 for (i
= 0; i
< length
; i
++)
2941 Lisp_Object idx
= make_number (i
);
2942 SUBSTITUTE (Faref (subtree
, idx
),
2943 Faset (subtree
, idx
, true_value
));
2950 SUBSTITUTE (Fcar_safe (subtree
),
2951 Fsetcar (subtree
, true_value
));
2952 SUBSTITUTE (Fcdr_safe (subtree
),
2953 Fsetcdr (subtree
, true_value
));
2959 /* Check for text properties in each interval.
2960 substitute_in_interval contains part of the logic. */
2962 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2963 Lisp_Object arg
= Fcons (object
, placeholder
);
2965 traverse_intervals_noorder (root_interval
,
2966 &substitute_in_interval
, arg
);
2971 /* Other types don't recurse any further. */
2977 /* Helper function for substitute_object_recurse. */
2979 substitute_in_interval (interval
, arg
)
2983 Lisp_Object object
= Fcar (arg
);
2984 Lisp_Object placeholder
= Fcdr (arg
);
2986 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3005 if (*cp
== '+' || *cp
== '-')
3008 if (*cp
>= '0' && *cp
<= '9')
3011 while (*cp
>= '0' && *cp
<= '9')
3019 if (*cp
>= '0' && *cp
<= '9')
3022 while (*cp
>= '0' && *cp
<= '9')
3025 if (*cp
== 'e' || *cp
== 'E')
3029 if (*cp
== '+' || *cp
== '-')
3033 if (*cp
>= '0' && *cp
<= '9')
3036 while (*cp
>= '0' && *cp
<= '9')
3039 else if (cp
== start
)
3041 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3046 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3052 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3053 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3054 || state
== (DOT_CHAR
|TRAIL_INT
)
3055 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3056 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3057 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3062 read_vector (readcharfun
, bytecodeflag
)
3063 Lisp_Object readcharfun
;
3068 register Lisp_Object
*ptr
;
3069 register Lisp_Object tem
, item
, vector
;
3070 register struct Lisp_Cons
*otem
;
3073 tem
= read_list (1, readcharfun
);
3074 len
= Flength (tem
);
3075 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3077 size
= XVECTOR (vector
)->size
;
3078 ptr
= XVECTOR (vector
)->contents
;
3079 for (i
= 0; i
< size
; i
++)
3082 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3083 bytecode object, the docstring containing the bytecode and
3084 constants values must be treated as unibyte and passed to
3085 Fread, to get the actual bytecode string and constants vector. */
3086 if (bytecodeflag
&& load_force_doc_strings
)
3088 if (i
== COMPILED_BYTECODE
)
3090 if (!STRINGP (item
))
3091 error ("Invalid byte code");
3093 /* Delay handling the bytecode slot until we know whether
3094 it is lazily-loaded (we can tell by whether the
3095 constants slot is nil). */
3096 ptr
[COMPILED_CONSTANTS
] = item
;
3099 else if (i
== COMPILED_CONSTANTS
)
3101 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3105 /* Coerce string to unibyte (like string-as-unibyte,
3106 but without generating extra garbage and
3107 guaranteeing no change in the contents). */
3108 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3109 STRING_SET_UNIBYTE (bytestr
);
3111 item
= Fread (bytestr
);
3113 error ("Invalid byte code");
3115 otem
= XCONS (item
);
3116 bytestr
= XCAR (item
);
3121 /* Now handle the bytecode slot. */
3122 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3125 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3133 /* FLAG = 1 means check for ] to terminate rather than ) and .
3134 FLAG = -1 means check for starting with defun
3135 and make structure pure. */
3138 read_list (flag
, readcharfun
)
3140 register Lisp_Object readcharfun
;
3142 /* -1 means check next element for defun,
3143 0 means don't check,
3144 1 means already checked and found defun. */
3145 int defunflag
= flag
< 0 ? -1 : 0;
3146 Lisp_Object val
, tail
;
3147 register Lisp_Object elt
, tem
;
3148 struct gcpro gcpro1
, gcpro2
;
3149 /* 0 is the normal case.
3150 1 means this list is a doc reference; replace it with the number 0.
3151 2 means this list is a doc reference; replace it with the doc string. */
3152 int doc_reference
= 0;
3154 /* Initialize this to 1 if we are reading a list. */
3155 int first_in_list
= flag
<= 0;
3164 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3169 /* While building, if the list starts with #$, treat it specially. */
3170 if (EQ (elt
, Vload_file_name
)
3172 && !NILP (Vpurify_flag
))
3174 if (NILP (Vdoc_file_name
))
3175 /* We have not yet called Snarf-documentation, so assume
3176 this file is described in the DOC-MM.NN file
3177 and Snarf-documentation will fill in the right value later.
3178 For now, replace the whole list with 0. */
3181 /* We have already called Snarf-documentation, so make a relative
3182 file name for this file, so it can be found properly
3183 in the installed Lisp directory.
3184 We don't use Fexpand_file_name because that would make
3185 the directory absolute now. */
3186 elt
= concat2 (build_string ("../lisp/"),
3187 Ffile_name_nondirectory (elt
));
3189 else if (EQ (elt
, Vload_file_name
)
3191 && load_force_doc_strings
)
3200 invalid_syntax (") or . in a vector", 18);
3208 XSETCDR (tail
, read0 (readcharfun
));
3210 val
= read0 (readcharfun
);
3211 read1 (readcharfun
, &ch
, 0);
3215 if (doc_reference
== 1)
3216 return make_number (0);
3217 if (doc_reference
== 2)
3219 /* Get a doc string from the file we are loading.
3220 If it's in saved_doc_string, get it from there. */
3221 int pos
= XINT (XCDR (val
));
3222 /* Position is negative for user variables. */
3223 if (pos
< 0) pos
= -pos
;
3224 if (pos
>= saved_doc_string_position
3225 && pos
< (saved_doc_string_position
3226 + saved_doc_string_length
))
3228 int start
= pos
- saved_doc_string_position
;
3231 /* Process quoting with ^A,
3232 and find the end of the string,
3233 which is marked with ^_ (037). */
3234 for (from
= start
, to
= start
;
3235 saved_doc_string
[from
] != 037;)
3237 int c
= saved_doc_string
[from
++];
3240 c
= saved_doc_string
[from
++];
3242 saved_doc_string
[to
++] = c
;
3244 saved_doc_string
[to
++] = 0;
3246 saved_doc_string
[to
++] = 037;
3249 saved_doc_string
[to
++] = c
;
3252 return make_string (saved_doc_string
+ start
,
3255 /* Look in prev_saved_doc_string the same way. */
3256 else if (pos
>= prev_saved_doc_string_position
3257 && pos
< (prev_saved_doc_string_position
3258 + prev_saved_doc_string_length
))
3260 int start
= pos
- prev_saved_doc_string_position
;
3263 /* Process quoting with ^A,
3264 and find the end of the string,
3265 which is marked with ^_ (037). */
3266 for (from
= start
, to
= start
;
3267 prev_saved_doc_string
[from
] != 037;)
3269 int c
= prev_saved_doc_string
[from
++];
3272 c
= prev_saved_doc_string
[from
++];
3274 prev_saved_doc_string
[to
++] = c
;
3276 prev_saved_doc_string
[to
++] = 0;
3278 prev_saved_doc_string
[to
++] = 037;
3281 prev_saved_doc_string
[to
++] = c
;
3284 return make_string (prev_saved_doc_string
+ start
,
3288 return get_doc_string (val
, 0, 0);
3293 invalid_syntax (". in wrong context", 18);
3295 invalid_syntax ("] in a list", 11);
3297 tem
= (read_pure
&& flag
<= 0
3298 ? pure_cons (elt
, Qnil
)
3299 : Fcons (elt
, Qnil
));
3301 XSETCDR (tail
, tem
);
3306 defunflag
= EQ (elt
, Qdefun
);
3307 else if (defunflag
> 0)
3312 Lisp_Object Vobarray
;
3313 Lisp_Object initial_obarray
;
3315 /* oblookup stores the bucket number here, for the sake of Funintern. */
3317 int oblookup_last_bucket_number
;
3319 static int hash_string ();
3321 /* Get an error if OBARRAY is not an obarray.
3322 If it is one, return it. */
3325 check_obarray (obarray
)
3326 Lisp_Object obarray
;
3328 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3330 /* If Vobarray is now invalid, force it to be valid. */
3331 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3332 wrong_type_argument (Qvectorp
, obarray
);
3337 /* Intern the C string STR: return a symbol with that name,
3338 interned in the current obarray. */
3345 int len
= strlen (str
);
3346 Lisp_Object obarray
;
3349 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3350 obarray
= check_obarray (obarray
);
3351 tem
= oblookup (obarray
, str
, len
, len
);
3354 return Fintern (make_string (str
, len
), obarray
);
3357 /* Create an uninterned symbol with name STR. */
3363 int len
= strlen (str
);
3365 return Fmake_symbol ((!NILP (Vpurify_flag
)
3366 ? make_pure_string (str
, len
, len
, 0)
3367 : make_string (str
, len
)));
3370 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3371 doc
: /* Return the canonical symbol whose name is STRING.
3372 If there is none, one is created by this function and returned.
3373 A second optional argument specifies the obarray to use;
3374 it defaults to the value of `obarray'. */)
3376 Lisp_Object string
, obarray
;
3378 register Lisp_Object tem
, sym
, *ptr
;
3380 if (NILP (obarray
)) obarray
= Vobarray
;
3381 obarray
= check_obarray (obarray
);
3383 CHECK_STRING (string
);
3385 tem
= oblookup (obarray
, SDATA (string
),
3388 if (!INTEGERP (tem
))
3391 if (!NILP (Vpurify_flag
))
3392 string
= Fpurecopy (string
);
3393 sym
= Fmake_symbol (string
);
3395 if (EQ (obarray
, initial_obarray
))
3396 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3398 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3400 if ((SREF (string
, 0) == ':')
3401 && EQ (obarray
, initial_obarray
))
3403 XSYMBOL (sym
)->constant
= 1;
3404 XSYMBOL (sym
)->value
= sym
;
3407 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3409 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3411 XSYMBOL (sym
)->next
= 0;
3416 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3417 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3418 NAME may be a string or a symbol. If it is a symbol, that exact
3419 symbol is searched for.
3420 A second optional argument specifies the obarray to use;
3421 it defaults to the value of `obarray'. */)
3423 Lisp_Object name
, obarray
;
3425 register Lisp_Object tem
, string
;
3427 if (NILP (obarray
)) obarray
= Vobarray
;
3428 obarray
= check_obarray (obarray
);
3430 if (!SYMBOLP (name
))
3432 CHECK_STRING (name
);
3436 string
= SYMBOL_NAME (name
);
3438 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3439 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3445 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3446 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3447 The value is t if a symbol was found and deleted, nil otherwise.
3448 NAME may be a string or a symbol. If it is a symbol, that symbol
3449 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3450 OBARRAY defaults to the value of the variable `obarray'. */)
3452 Lisp_Object name
, obarray
;
3454 register Lisp_Object string
, tem
;
3457 if (NILP (obarray
)) obarray
= Vobarray
;
3458 obarray
= check_obarray (obarray
);
3461 string
= SYMBOL_NAME (name
);
3464 CHECK_STRING (name
);
3468 tem
= oblookup (obarray
, SDATA (string
),
3473 /* If arg was a symbol, don't delete anything but that symbol itself. */
3474 if (SYMBOLP (name
) && !EQ (name
, tem
))
3477 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3478 XSYMBOL (tem
)->constant
= 0;
3479 XSYMBOL (tem
)->indirect_variable
= 0;
3481 hash
= oblookup_last_bucket_number
;
3483 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3485 if (XSYMBOL (tem
)->next
)
3486 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3488 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3492 Lisp_Object tail
, following
;
3494 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3495 XSYMBOL (tail
)->next
;
3498 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3499 if (EQ (following
, tem
))
3501 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3510 /* Return the symbol in OBARRAY whose names matches the string
3511 of SIZE characters (SIZE_BYTE bytes) at PTR.
3512 If there is no such symbol in OBARRAY, return nil.
3514 Also store the bucket number in oblookup_last_bucket_number. */
3517 oblookup (obarray
, ptr
, size
, size_byte
)
3518 Lisp_Object obarray
;
3519 register const char *ptr
;
3520 int size
, size_byte
;
3524 register Lisp_Object tail
;
3525 Lisp_Object bucket
, tem
;
3527 if (!VECTORP (obarray
)
3528 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3530 obarray
= check_obarray (obarray
);
3531 obsize
= XVECTOR (obarray
)->size
;
3533 /* This is sometimes needed in the middle of GC. */
3534 obsize
&= ~ARRAY_MARK_FLAG
;
3535 /* Combining next two lines breaks VMS C 2.3. */
3536 hash
= hash_string (ptr
, size_byte
);
3538 bucket
= XVECTOR (obarray
)->contents
[hash
];
3539 oblookup_last_bucket_number
= hash
;
3540 if (EQ (bucket
, make_number (0)))
3542 else if (!SYMBOLP (bucket
))
3543 error ("Bad data in guts of obarray"); /* Like CADR error message */
3545 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3547 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3548 && SCHARS (SYMBOL_NAME (tail
)) == size
3549 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3551 else if (XSYMBOL (tail
)->next
== 0)
3554 XSETINT (tem
, hash
);
3559 hash_string (ptr
, len
)
3560 const unsigned char *ptr
;
3563 register const unsigned char *p
= ptr
;
3564 register const unsigned char *end
= p
+ len
;
3565 register unsigned char c
;
3566 register int hash
= 0;
3571 if (c
>= 0140) c
-= 40;
3572 hash
= ((hash
<<3) + (hash
>>28) + c
);
3574 return hash
& 07777777777;
3578 map_obarray (obarray
, fn
, arg
)
3579 Lisp_Object obarray
;
3580 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3584 register Lisp_Object tail
;
3585 CHECK_VECTOR (obarray
);
3586 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3588 tail
= XVECTOR (obarray
)->contents
[i
];
3593 if (XSYMBOL (tail
)->next
== 0)
3595 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3601 mapatoms_1 (sym
, function
)
3602 Lisp_Object sym
, function
;
3604 call1 (function
, sym
);
3607 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3608 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3609 OBARRAY defaults to the value of `obarray'. */)
3611 Lisp_Object function
, obarray
;
3613 if (NILP (obarray
)) obarray
= Vobarray
;
3614 obarray
= check_obarray (obarray
);
3616 map_obarray (obarray
, mapatoms_1
, function
);
3620 #define OBARRAY_SIZE 1511
3625 Lisp_Object oblength
;
3629 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3631 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3632 Vobarray
= Fmake_vector (oblength
, make_number (0));
3633 initial_obarray
= Vobarray
;
3634 staticpro (&initial_obarray
);
3635 /* Intern nil in the obarray */
3636 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3637 XSYMBOL (Qnil
)->constant
= 1;
3639 /* These locals are to kludge around a pyramid compiler bug. */
3640 hash
= hash_string ("nil", 3);
3641 /* Separate statement here to avoid VAXC bug. */
3642 hash
%= OBARRAY_SIZE
;
3643 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3646 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3647 XSYMBOL (Qnil
)->function
= Qunbound
;
3648 XSYMBOL (Qunbound
)->value
= Qunbound
;
3649 XSYMBOL (Qunbound
)->function
= Qunbound
;
3652 XSYMBOL (Qnil
)->value
= Qnil
;
3653 XSYMBOL (Qnil
)->plist
= Qnil
;
3654 XSYMBOL (Qt
)->value
= Qt
;
3655 XSYMBOL (Qt
)->constant
= 1;
3657 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3660 Qvariable_documentation
= intern ("variable-documentation");
3661 staticpro (&Qvariable_documentation
);
3663 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3664 read_buffer
= (char *) xmalloc (read_buffer_size
);
3669 struct Lisp_Subr
*sname
;
3672 sym
= intern (sname
->symbol_name
);
3673 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3676 #ifdef NOTDEF /* use fset in subr.el now */
3678 defalias (sname
, string
)
3679 struct Lisp_Subr
*sname
;
3683 sym
= intern (string
);
3684 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3688 /* Define an "integer variable"; a symbol whose value is forwarded
3689 to a C variable of type int. Sample call: */
3690 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3692 defvar_int (namestring
, address
)
3696 Lisp_Object sym
, val
;
3697 sym
= intern (namestring
);
3698 val
= allocate_misc ();
3699 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3700 XINTFWD (val
)->intvar
= address
;
3701 SET_SYMBOL_VALUE (sym
, val
);
3704 /* Similar but define a variable whose value is t if address contains 1,
3705 nil if address contains 0 */
3707 defvar_bool (namestring
, address
)
3711 Lisp_Object sym
, val
;
3712 sym
= intern (namestring
);
3713 val
= allocate_misc ();
3714 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3715 XBOOLFWD (val
)->boolvar
= address
;
3716 SET_SYMBOL_VALUE (sym
, val
);
3717 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3720 /* Similar but define a variable whose value is the Lisp Object stored
3721 at address. Two versions: with and without gc-marking of the C
3722 variable. The nopro version is used when that variable will be
3723 gc-marked for some other reason, since marking the same slot twice
3724 can cause trouble with strings. */
3726 defvar_lisp_nopro (namestring
, address
)
3728 Lisp_Object
*address
;
3730 Lisp_Object sym
, val
;
3731 sym
= intern (namestring
);
3732 val
= allocate_misc ();
3733 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3734 XOBJFWD (val
)->objvar
= address
;
3735 SET_SYMBOL_VALUE (sym
, val
);
3739 defvar_lisp (namestring
, address
)
3741 Lisp_Object
*address
;
3743 defvar_lisp_nopro (namestring
, address
);
3744 staticpro (address
);
3747 /* Similar but define a variable whose value is the Lisp Object stored in
3748 the current buffer. address is the address of the slot in the buffer
3749 that is current now. */
3752 defvar_per_buffer (namestring
, address
, type
, doc
)
3754 Lisp_Object
*address
;
3758 Lisp_Object sym
, val
;
3761 sym
= intern (namestring
);
3762 val
= allocate_misc ();
3763 offset
= (char *)address
- (char *)current_buffer
;
3765 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3766 XBUFFER_OBJFWD (val
)->offset
= offset
;
3767 SET_SYMBOL_VALUE (sym
, val
);
3768 PER_BUFFER_SYMBOL (offset
) = sym
;
3769 PER_BUFFER_TYPE (offset
) = type
;
3771 if (PER_BUFFER_IDX (offset
) == 0)
3772 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3773 slot of buffer_local_flags */
3778 /* Similar but define a variable whose value is the Lisp Object stored
3779 at a particular offset in the current kboard object. */
3782 defvar_kboard (namestring
, offset
)
3786 Lisp_Object sym
, val
;
3787 sym
= intern (namestring
);
3788 val
= allocate_misc ();
3789 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3790 XKBOARD_OBJFWD (val
)->offset
= offset
;
3791 SET_SYMBOL_VALUE (sym
, val
);
3794 /* Record the value of load-path used at the start of dumping
3795 so we can see if the site changed it later during dumping. */
3796 static Lisp_Object dump_path
;
3802 int turn_off_warning
= 0;
3804 /* Compute the default load-path. */
3806 normal
= PATH_LOADSEARCH
;
3807 Vload_path
= decode_env_path (0, normal
);
3809 if (NILP (Vpurify_flag
))
3810 normal
= PATH_LOADSEARCH
;
3812 normal
= PATH_DUMPLOADSEARCH
;
3814 /* In a dumped Emacs, we normally have to reset the value of
3815 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3816 uses ../lisp, instead of the path of the installed elisp
3817 libraries. However, if it appears that Vload_path was changed
3818 from the default before dumping, don't override that value. */
3821 if (! NILP (Fequal (dump_path
, Vload_path
)))
3823 Vload_path
= decode_env_path (0, normal
);
3824 if (!NILP (Vinstallation_directory
))
3826 Lisp_Object tem
, tem1
, sitelisp
;
3828 /* Remove site-lisp dirs from path temporarily and store
3829 them in sitelisp, then conc them on at the end so
3830 they're always first in path. */
3834 tem
= Fcar (Vload_path
);
3835 tem1
= Fstring_match (build_string ("site-lisp"),
3839 Vload_path
= Fcdr (Vload_path
);
3840 sitelisp
= Fcons (tem
, sitelisp
);
3846 /* Add to the path the lisp subdir of the
3847 installation dir, if it exists. */
3848 tem
= Fexpand_file_name (build_string ("lisp"),
3849 Vinstallation_directory
);
3850 tem1
= Ffile_exists_p (tem
);
3853 if (NILP (Fmember (tem
, Vload_path
)))
3855 turn_off_warning
= 1;
3856 Vload_path
= Fcons (tem
, Vload_path
);
3860 /* That dir doesn't exist, so add the build-time
3861 Lisp dirs instead. */
3862 Vload_path
= nconc2 (Vload_path
, dump_path
);
3864 /* Add leim under the installation dir, if it exists. */
3865 tem
= Fexpand_file_name (build_string ("leim"),
3866 Vinstallation_directory
);
3867 tem1
= Ffile_exists_p (tem
);
3870 if (NILP (Fmember (tem
, Vload_path
)))
3871 Vload_path
= Fcons (tem
, Vload_path
);
3874 /* Add site-list under the installation dir, if it exists. */
3875 tem
= Fexpand_file_name (build_string ("site-lisp"),
3876 Vinstallation_directory
);
3877 tem1
= Ffile_exists_p (tem
);
3880 if (NILP (Fmember (tem
, Vload_path
)))
3881 Vload_path
= Fcons (tem
, Vload_path
);
3884 /* If Emacs was not built in the source directory,
3885 and it is run from where it was built, add to load-path
3886 the lisp, leim and site-lisp dirs under that directory. */
3888 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3892 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3893 Vinstallation_directory
);
3894 tem1
= Ffile_exists_p (tem
);
3896 /* Don't be fooled if they moved the entire source tree
3897 AFTER dumping Emacs. If the build directory is indeed
3898 different from the source dir, src/Makefile.in and
3899 src/Makefile will not be found together. */
3900 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3901 Vinstallation_directory
);
3902 tem2
= Ffile_exists_p (tem
);
3903 if (!NILP (tem1
) && NILP (tem2
))
3905 tem
= Fexpand_file_name (build_string ("lisp"),
3908 if (NILP (Fmember (tem
, Vload_path
)))
3909 Vload_path
= Fcons (tem
, Vload_path
);
3911 tem
= Fexpand_file_name (build_string ("leim"),
3914 if (NILP (Fmember (tem
, Vload_path
)))
3915 Vload_path
= Fcons (tem
, Vload_path
);
3917 tem
= Fexpand_file_name (build_string ("site-lisp"),
3920 if (NILP (Fmember (tem
, Vload_path
)))
3921 Vload_path
= Fcons (tem
, Vload_path
);
3924 if (!NILP (sitelisp
))
3925 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3931 /* NORMAL refers to the lisp dir in the source directory. */
3932 /* We used to add ../lisp at the front here, but
3933 that caused trouble because it was copied from dump_path
3934 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3935 It should be unnecessary. */
3936 Vload_path
= decode_env_path (0, normal
);
3937 dump_path
= Vload_path
;
3941 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3942 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3943 almost never correct, thereby causing a warning to be printed out that
3944 confuses users. Since PATH_LOADSEARCH is always overridden by the
3945 EMACSLOADPATH environment variable below, disable the warning on NT.
3946 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3947 the "standard" paths may not exist and would be overridden by
3948 EMACSLOADPATH as on NT. Since this depends on how the executable
3949 was build and packaged, turn off the warnings in general */
3951 /* Warn if dirs in the *standard* path don't exist. */
3952 if (!turn_off_warning
)
3954 Lisp_Object path_tail
;
3956 for (path_tail
= Vload_path
;
3958 path_tail
= XCDR (path_tail
))
3960 Lisp_Object dirfile
;
3961 dirfile
= Fcar (path_tail
);
3962 if (STRINGP (dirfile
))
3964 dirfile
= Fdirectory_file_name (dirfile
);
3965 if (access (SDATA (dirfile
), 0) < 0)
3966 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3971 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3973 /* If the EMACSLOADPATH environment variable is set, use its value.
3974 This doesn't apply if we're dumping. */
3976 if (NILP (Vpurify_flag
)
3977 && egetenv ("EMACSLOADPATH"))
3979 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3983 load_in_progress
= 0;
3984 Vload_file_name
= Qnil
;
3986 load_descriptor_list
= Qnil
;
3988 Vstandard_input
= Qt
;
3989 Vloads_in_progress
= Qnil
;
3992 /* Print a warning, using format string FORMAT, that directory DIRNAME
3993 does not exist. Print it on stderr and put it in *Message*. */
3996 dir_warning (format
, dirname
)
3998 Lisp_Object dirname
;
4001 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4003 fprintf (stderr
, format
, SDATA (dirname
));
4004 sprintf (buffer
, format
, SDATA (dirname
));
4005 /* Don't log the warning before we've initialized!! */
4007 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4014 defsubr (&Sread_from_string
);
4016 defsubr (&Sintern_soft
);
4017 defsubr (&Sunintern
);
4018 defsubr (&Sget_load_suffixes
);
4020 defsubr (&Seval_buffer
);
4021 defsubr (&Seval_region
);
4022 defsubr (&Sread_char
);
4023 defsubr (&Sread_char_exclusive
);
4024 defsubr (&Sread_event
);
4025 defsubr (&Sget_file_char
);
4026 defsubr (&Smapatoms
);
4027 defsubr (&Slocate_file_internal
);
4029 DEFVAR_LISP ("obarray", &Vobarray
,
4030 doc
: /* Symbol table for use by `intern' and `read'.
4031 It is a vector whose length ought to be prime for best results.
4032 The vector's contents don't make sense if examined from Lisp programs;
4033 to find all the symbols in an obarray, use `mapatoms'. */);
4035 DEFVAR_LISP ("values", &Vvalues
,
4036 doc
: /* List of values of all expressions which were read, evaluated and printed.
4037 Order is reverse chronological. */);
4039 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4040 doc
: /* Stream for read to get input from.
4041 See documentation of `read' for possible values. */);
4042 Vstandard_input
= Qt
;
4044 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4045 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4047 If this variable is a buffer, then only forms read from that buffer
4048 will be added to `read-symbol-positions-list'.
4049 If this variable is t, then all read forms will be added.
4050 The effect of all other values other than nil are not currently
4051 defined, although they may be in the future.
4053 The positions are relative to the last call to `read' or
4054 `read-from-string'. It is probably a bad idea to set this variable at
4055 the toplevel; bind it instead. */);
4056 Vread_with_symbol_positions
= Qnil
;
4058 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4059 doc
: /* A list mapping read symbols to their positions.
4060 This variable is modified during calls to `read' or
4061 `read-from-string', but only when `read-with-symbol-positions' is
4064 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4065 CHAR-POSITION is an integer giving the offset of that occurrence of the
4066 symbol from the position where `read' or `read-from-string' started.
4068 Note that a symbol will appear multiple times in this list, if it was
4069 read multiple times. The list is in the same order as the symbols
4071 Vread_symbol_positions_list
= Qnil
;
4073 DEFVAR_LISP ("load-path", &Vload_path
,
4074 doc
: /* *List of directories to search for files to load.
4075 Each element is a string (directory name) or nil (try default directory).
4076 Initialized based on EMACSLOADPATH environment variable, if any,
4077 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4079 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4080 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4081 This list should not include the empty string.
4082 `load' and related functions try to append these suffixes, in order,
4083 to the specified file name if a Lisp suffix is allowed or required. */);
4084 Vload_suffixes
= Fcons (build_string (".elc"),
4085 Fcons (build_string (".el"), Qnil
));
4086 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4087 doc
: /* List of suffixes that indicate representations of \
4089 This list should normally start with the empty string.
4091 Enabling Auto Compression mode appends the suffixes in
4092 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4093 mode removes them again. `load' and related functions use this list to
4094 determine whether they should look for compressed versions of a file
4095 and, if so, which suffixes they should try to append to the file name
4096 in order to do so. However, if you want to customize which suffixes
4097 the loading functions recognize as compression suffixes, you should
4098 customize `jka-compr-load-suffixes' rather than the present variable. */);
4099 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4101 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4102 doc
: /* Non-nil if inside of `load'. */);
4104 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4105 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4106 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4108 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4109 a symbol \(a feature name).
4111 When `load' is run and the file-name argument matches an element's
4112 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4113 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4115 An error in FORMS does not undo the load, but does prevent execution of
4116 the rest of the FORMS. */);
4117 Vafter_load_alist
= Qnil
;
4119 DEFVAR_LISP ("load-history", &Vload_history
,
4120 doc
: /* Alist mapping file names to symbols and features.
4121 Each alist element is a list that starts with a file name,
4122 except for one element (optional) that starts with nil and describes
4123 definitions evaluated from buffers not visiting files.
4125 The file name is absolute and is the true file name (i.e. it doesn't
4126 contain symbolic links) of the loaded file.
4128 The remaining elements of each list are symbols defined as variables
4129 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4130 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4131 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4132 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
4133 this file redefined it as a function.
4135 During preloading, the file name recorded is relative to the main Lisp
4136 directory. These file names are converted to absolute at startup. */);
4137 Vload_history
= Qnil
;
4139 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4140 doc
: /* Full name of file being loaded by `load'. */);
4141 Vload_file_name
= Qnil
;
4143 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4144 doc
: /* File name, including directory, of user's initialization file.
4145 If the file loaded had extension `.elc', and the corresponding source file
4146 exists, this variable contains the name of source file, suitable for use
4147 by functions like `custom-save-all' which edit the init file.
4148 While Emacs loads and evaluates the init file, value is the real name
4149 of the file, regardless of whether or not it has the `.elc' extension. */);
4150 Vuser_init_file
= Qnil
;
4152 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4153 doc
: /* Used for internal purposes by `load'. */);
4154 Vcurrent_load_list
= Qnil
;
4156 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4157 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4158 The default is nil, which means use the function `read'. */);
4159 Vload_read_function
= Qnil
;
4161 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4162 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4163 This function is for doing code conversion before reading the source file.
4164 If nil, loading is done without any code conversion.
4165 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4166 FULLNAME is the full name of FILE.
4167 See `load' for the meaning of the remaining arguments. */);
4168 Vload_source_file_function
= Qnil
;
4170 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4171 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4172 This is useful when the file being loaded is a temporary copy. */);
4173 load_force_doc_strings
= 0;
4175 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4176 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4177 This is normally bound by `load' and `eval-buffer' to control `read',
4178 and is not meant for users to change. */);
4179 load_convert_to_unibyte
= 0;
4181 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4182 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4183 You cannot count on them to still be there! */);
4185 = Fexpand_file_name (build_string ("../"),
4186 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4188 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4189 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4190 Vpreloaded_file_list
= Qnil
;
4192 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4193 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4194 Vbyte_boolean_vars
= Qnil
;
4196 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4197 doc
: /* Non-nil means load dangerous compiled Lisp files.
4198 Some versions of XEmacs use different byte codes than Emacs. These
4199 incompatible byte codes can make Emacs crash when it tries to execute
4201 load_dangerous_libraries
= 0;
4203 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4204 doc
: /* Regular expression matching safe to load compiled Lisp files.
4205 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4206 from the file, and matches them against this regular expression.
4207 When the regular expression matches, the file is considered to be safe
4208 to load. See also `load-dangerous-libraries'. */);
4209 Vbytecomp_version_regexp
4210 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4212 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4213 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4214 Veval_buffer_list
= Qnil
;
4216 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4217 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4218 Vold_style_backquotes
= Qnil
;
4219 Qold_style_backquotes
= intern ("old-style-backquotes");
4220 staticpro (&Qold_style_backquotes
);
4222 /* Vsource_directory was initialized in init_lread. */
4224 load_descriptor_list
= Qnil
;
4225 staticpro (&load_descriptor_list
);
4227 Qcurrent_load_list
= intern ("current-load-list");
4228 staticpro (&Qcurrent_load_list
);
4230 Qstandard_input
= intern ("standard-input");
4231 staticpro (&Qstandard_input
);
4233 Qread_char
= intern ("read-char");
4234 staticpro (&Qread_char
);
4236 Qget_file_char
= intern ("get-file-char");
4237 staticpro (&Qget_file_char
);
4239 Qbackquote
= intern ("`");
4240 staticpro (&Qbackquote
);
4241 Qcomma
= intern (",");
4242 staticpro (&Qcomma
);
4243 Qcomma_at
= intern (",@");
4244 staticpro (&Qcomma_at
);
4245 Qcomma_dot
= intern (",.");
4246 staticpro (&Qcomma_dot
);
4248 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4249 staticpro (&Qinhibit_file_name_operation
);
4251 Qascii_character
= intern ("ascii-character");
4252 staticpro (&Qascii_character
);
4254 Qfunction
= intern ("function");
4255 staticpro (&Qfunction
);
4257 Qload
= intern ("load");
4260 Qload_file_name
= intern ("load-file-name");
4261 staticpro (&Qload_file_name
);
4263 Qeval_buffer_list
= intern ("eval-buffer-list");
4264 staticpro (&Qeval_buffer_list
);
4266 Qfile_truename
= intern ("file-truename");
4267 staticpro (&Qfile_truename
) ;
4269 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4270 staticpro (&Qdo_after_load_evaluation
) ;
4272 staticpro (&dump_path
);
4274 staticpro (&read_objects
);
4275 read_objects
= Qnil
;
4276 staticpro (&seen_list
);
4279 Vloads_in_progress
= Qnil
;
4280 staticpro (&Vloads_in_progress
);
4283 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4284 (do not change this comment) */