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 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
31 #include "intervals.h"
37 #include "termhooks.h"
41 #include <sys/inode.h>
46 #include <unistd.h> /* to get X_OK */
63 #endif /* HAVE_SETLOCALE */
73 #define file_offset off_t
74 #define file_tell ftello
76 #define file_offset long
77 #define file_tell ftell
84 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
85 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
86 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
87 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
88 Lisp_Object Qinhibit_file_name_operation
;
89 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
90 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
92 extern Lisp_Object Qevent_symbol_element_mask
;
93 extern Lisp_Object Qfile_exists_p
;
95 /* non-zero iff inside `load' */
98 /* Directory in which the sources were found. */
99 Lisp_Object Vsource_directory
;
101 /* Search path and suffixes for files to be loaded. */
102 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
104 /* File name of user's init file. */
105 Lisp_Object Vuser_init_file
;
107 /* This is the user-visible association list that maps features to
108 lists of defs in their load files. */
109 Lisp_Object Vload_history
;
111 /* This is used to build the load history. */
112 Lisp_Object Vcurrent_load_list
;
114 /* List of files that were preloaded. */
115 Lisp_Object Vpreloaded_file_list
;
117 /* Name of file actually being read by `load'. */
118 Lisp_Object Vload_file_name
;
120 /* Function to use for reading, in `load' and friends. */
121 Lisp_Object Vload_read_function
;
123 /* The association list of objects read with the #n=object form.
124 Each member of the list has the form (n . object), and is used to
125 look up the object for the corresponding #n# construct.
126 It must be set to nil before all top-level calls to read0. */
127 Lisp_Object read_objects
;
129 /* Nonzero means load should forcibly load all dynamic doc strings. */
130 static int load_force_doc_strings
;
132 /* Nonzero means read should convert strings to unibyte. */
133 static int load_convert_to_unibyte
;
135 /* Function to use for loading an Emacs lisp source file (not
136 compiled) instead of readevalloop. */
137 Lisp_Object Vload_source_file_function
;
139 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
140 Lisp_Object Vbyte_boolean_vars
;
142 /* Whether or not to add a `read-positions' property to symbols
144 Lisp_Object Vread_with_symbol_positions
;
146 /* List of (SYMBOL . POSITION) accumulated so far. */
147 Lisp_Object Vread_symbol_positions_list
;
149 /* List of descriptors now open for Fload. */
150 static Lisp_Object load_descriptor_list
;
152 /* File for get_file_char to read from. Use by load. */
153 static FILE *instream
;
155 /* When nonzero, read conses in pure space */
156 static int read_pure
;
158 /* For use within read-from-string (this reader is non-reentrant!!) */
159 static int read_from_string_index
;
160 static int read_from_string_index_byte
;
161 static int read_from_string_limit
;
163 /* Number of bytes left to read in the buffer character
164 that `readchar' has already advanced over. */
165 static int readchar_backlog
;
166 /* Number of characters read in the current call to Fread or
167 Fread_from_string. */
168 static int readchar_count
;
170 /* This contains the last string skipped with #@. */
171 static char *saved_doc_string
;
172 /* Length of buffer allocated in saved_doc_string. */
173 static int saved_doc_string_size
;
174 /* Length of actual data in saved_doc_string. */
175 static int saved_doc_string_length
;
176 /* This is the file position that string came from. */
177 static file_offset saved_doc_string_position
;
179 /* This contains the previous string skipped with #@.
180 We copy it from saved_doc_string when a new string
181 is put in saved_doc_string. */
182 static char *prev_saved_doc_string
;
183 /* Length of buffer allocated in prev_saved_doc_string. */
184 static int prev_saved_doc_string_size
;
185 /* Length of actual data in prev_saved_doc_string. */
186 static int prev_saved_doc_string_length
;
187 /* This is the file position that string came from. */
188 static file_offset prev_saved_doc_string_position
;
190 /* Nonzero means inside a new-style backquote
191 with no surrounding parentheses.
192 Fread initializes this to zero, so we need not specbind it
193 or worry about what happens to it when there is an error. */
194 static int new_backquote_flag
;
196 /* A list of file names for files being loaded in Fload. Used to
197 check for recursive loads. */
199 static Lisp_Object Vloads_in_progress
;
201 /* Non-zero means load dangerous compiled Lisp files. */
203 int load_dangerous_libraries
;
205 /* A regular expression used to detect files compiled with Emacs. */
207 static Lisp_Object Vbytecomp_version_regexp
;
209 static void to_multibyte
P_ ((char **, char **, int *));
210 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
211 Lisp_Object (*) (), int,
212 Lisp_Object
, Lisp_Object
,
213 Lisp_Object
, Lisp_Object
));
214 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
215 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
218 /* Handle unreading and rereading of characters.
219 Write READCHAR to read a character,
220 UNREAD(c) to unread c to be read again.
222 The READCHAR and UNREAD macros are meant for reading/unreading a
223 byte code; they do not handle multibyte characters. The caller
224 should manage them if necessary.
226 [ Actually that seems to be a lie; READCHAR will definitely read
227 multibyte characters from buffer sources, at least. Is the
228 comment just out of date?
229 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
232 #define READCHAR readchar (readcharfun)
233 #define UNREAD(c) unreadchar (readcharfun, c)
236 readchar (readcharfun
)
237 Lisp_Object readcharfun
;
244 if (BUFFERP (readcharfun
))
246 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
248 int pt_byte
= BUF_PT_BYTE (inbuffer
);
249 int orig_pt_byte
= pt_byte
;
251 if (readchar_backlog
> 0)
252 /* We get the address of the byte just passed,
253 which is the last byte of the character.
254 The other bytes in this character are consecutive with it,
255 because the gap can't be in the middle of a character. */
256 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
257 - --readchar_backlog
);
259 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
262 readchar_backlog
= -1;
264 if (! NILP (inbuffer
->enable_multibyte_characters
))
266 /* Fetch the character code from the buffer. */
267 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
268 BUF_INC_POS (inbuffer
, pt_byte
);
269 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
273 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
276 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
280 if (MARKERP (readcharfun
))
282 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
284 int bytepos
= marker_byte_position (readcharfun
);
285 int orig_bytepos
= bytepos
;
287 if (readchar_backlog
> 0)
288 /* We get the address of the byte just passed,
289 which is the last byte of the character.
290 The other bytes in this character are consecutive with it,
291 because the gap can't be in the middle of a character. */
292 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
293 - --readchar_backlog
);
295 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
298 readchar_backlog
= -1;
300 if (! NILP (inbuffer
->enable_multibyte_characters
))
302 /* Fetch the character code from the buffer. */
303 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
304 BUF_INC_POS (inbuffer
, bytepos
);
305 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
309 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
313 XMARKER (readcharfun
)->bytepos
= bytepos
;
314 XMARKER (readcharfun
)->charpos
++;
319 if (EQ (readcharfun
, Qlambda
))
320 return read_bytecode_char (0);
322 if (EQ (readcharfun
, Qget_file_char
))
326 /* Interrupted reads have been observed while reading over the network */
327 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
337 if (STRINGP (readcharfun
))
339 if (read_from_string_index
>= read_from_string_limit
)
342 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
343 read_from_string_index
,
344 read_from_string_index_byte
);
349 tem
= call0 (readcharfun
);
356 /* Unread the character C in the way appropriate for the stream READCHARFUN.
357 If the stream is a user function, call it with the char as argument. */
360 unreadchar (readcharfun
, c
)
361 Lisp_Object readcharfun
;
366 /* Don't back up the pointer if we're unreading the end-of-input mark,
367 since readchar didn't advance it when we read it. */
369 else if (BUFFERP (readcharfun
))
371 struct buffer
*b
= XBUFFER (readcharfun
);
372 int bytepos
= BUF_PT_BYTE (b
);
374 if (readchar_backlog
>= 0)
379 if (! NILP (b
->enable_multibyte_characters
))
380 BUF_DEC_POS (b
, bytepos
);
384 BUF_PT_BYTE (b
) = bytepos
;
387 else if (MARKERP (readcharfun
))
389 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
390 int bytepos
= XMARKER (readcharfun
)->bytepos
;
392 if (readchar_backlog
>= 0)
396 XMARKER (readcharfun
)->charpos
--;
397 if (! NILP (b
->enable_multibyte_characters
))
398 BUF_DEC_POS (b
, bytepos
);
402 XMARKER (readcharfun
)->bytepos
= bytepos
;
405 else if (STRINGP (readcharfun
))
407 read_from_string_index
--;
408 read_from_string_index_byte
409 = string_char_to_byte (readcharfun
, read_from_string_index
);
411 else if (EQ (readcharfun
, Qlambda
))
412 read_bytecode_char (1);
413 else if (EQ (readcharfun
, Qget_file_char
))
414 ungetc (c
, instream
);
416 call1 (readcharfun
, make_number (c
));
419 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
421 static Lisp_Object read0
P_ ((Lisp_Object
));
422 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
424 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
425 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
426 static int read_multibyte
P_ ((int, Lisp_Object
));
428 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
430 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
432 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
435 /* Get a character from the tty. */
437 extern Lisp_Object
read_char ();
439 /* Read input events until we get one that's acceptable for our purposes.
441 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
442 until we get a character we like, and then stuffed into
445 If ASCII_REQUIRED is non-zero, we check function key events to see
446 if the unmodified version of the symbol has a Qascii_character
447 property, and use that character, if present.
449 If ERROR_NONASCII is non-zero, we signal an error if the input we
450 get isn't an ASCII character with modifiers. If it's zero but
451 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
454 If INPUT_METHOD is nonzero, we invoke the current input method
455 if the character warrants that. */
458 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
460 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
462 Lisp_Object val
, delayed_switch_frame
;
464 #ifdef HAVE_WINDOW_SYSTEM
465 if (display_hourglass_p
)
469 delayed_switch_frame
= Qnil
;
471 /* Read until we get an acceptable event. */
473 val
= read_char (0, 0, 0,
474 (input_method
? Qnil
: Qt
),
480 /* switch-frame events are put off until after the next ASCII
481 character. This is better than signaling an error just because
482 the last characters were typed to a separate minibuffer frame,
483 for example. Eventually, some code which can deal with
484 switch-frame events will read it and process it. */
486 && EVENT_HAS_PARAMETERS (val
)
487 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
489 delayed_switch_frame
= val
;
495 /* Convert certain symbols to their ASCII equivalents. */
498 Lisp_Object tem
, tem1
;
499 tem
= Fget (val
, Qevent_symbol_element_mask
);
502 tem1
= Fget (Fcar (tem
), Qascii_character
);
503 /* Merge this symbol's modifier bits
504 with the ASCII equivalent of its basic code. */
506 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
510 /* If we don't have a character now, deal with it appropriately. */
515 Vunread_command_events
= Fcons (val
, Qnil
);
516 error ("Non-character input-event");
523 if (! NILP (delayed_switch_frame
))
524 unread_switch_frame
= delayed_switch_frame
;
528 #ifdef HAVE_WINDOW_SYSTEM
529 if (display_hourglass_p
)
538 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
539 doc
: /* Read a character from the command input (keyboard or macro).
540 It is returned as a number.
541 If the user generates an event which is not a character (i.e. a mouse
542 click or function key event), `read-char' signals an error. As an
543 exception, switch-frame events are put off until non-ASCII events can
545 If you want to read non-character events, or ignore them, call
546 `read-event' or `read-char-exclusive' instead.
548 If the optional argument PROMPT is non-nil, display that as a prompt.
549 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
550 input method is turned on in the current buffer, that input method
551 is used for reading a character. */)
552 (prompt
, inherit_input_method
)
553 Lisp_Object prompt
, inherit_input_method
;
556 message_with_string ("%s", prompt
, 0);
557 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
560 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
561 doc
: /* Read an event object from the input stream.
562 If the optional argument PROMPT is non-nil, display that as a prompt.
563 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
564 input method is turned on in the current buffer, that input method
565 is used for reading a character. */)
566 (prompt
, inherit_input_method
)
567 Lisp_Object prompt
, inherit_input_method
;
570 message_with_string ("%s", prompt
, 0);
571 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
574 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
575 doc
: /* Read a character from the command input (keyboard or macro).
576 It is returned as a number. Non-character events are ignored.
578 If the optional argument PROMPT is non-nil, display that as a prompt.
579 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
580 input method is turned on in the current buffer, that input method
581 is used for reading a character. */)
582 (prompt
, inherit_input_method
)
583 Lisp_Object prompt
, inherit_input_method
;
586 message_with_string ("%s", prompt
, 0);
587 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
590 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
591 doc
: /* Don't use this yourself. */)
594 register Lisp_Object val
;
595 XSETINT (val
, getc (instream
));
601 /* Value is non-zero if the file asswociated with file descriptor FD
602 is a compiled Lisp file that's safe to load. Only files compiled
603 with Emacs are safe to load. Files compiled with XEmacs can lead
604 to a crash in Fbyte_code because of an incompatible change in the
615 /* Read the first few bytes from the file, and look for a line
616 specifying the byte compiler version used. */
617 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
622 /* Skip to the next newline, skipping over the initial `ELC'
623 with NUL bytes following it. */
624 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
628 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
633 lseek (fd
, 0, SEEK_SET
);
638 /* Callback for record_unwind_protect. Restore the old load list OLD,
639 after loading a file successfully. */
642 record_load_unwind (old
)
645 return Vloads_in_progress
= old
;
648 /* This handler function is used via internal_condition_case_1. */
651 load_error_handler (data
)
657 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
658 doc
: /* Return the suffixes that `load' should try if a suffix is \
660 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
663 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
664 while (CONSP (suffixes
))
666 Lisp_Object exts
= Vload_file_rep_suffixes
;
667 suffix
= XCAR (suffixes
);
668 suffixes
= XCDR (suffixes
);
673 lst
= Fcons (concat2 (suffix
, ext
), lst
);
676 return Fnreverse (lst
);
679 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
680 doc
: /* Execute a file of Lisp code named FILE.
681 First try FILE with `.elc' appended, then try with `.el',
682 then try FILE unmodified (the exact suffixes in the exact order are
683 determined by `load-suffixes'). Environment variable references in
684 FILE are replaced with their values by calling `substitute-in-file-name'.
685 This function searches the directories in `load-path'.
687 If optional second arg NOERROR is non-nil,
688 report no error if FILE doesn't exist.
689 Print messages at start and end of loading unless
690 optional third arg NOMESSAGE is non-nil.
691 If optional fourth arg NOSUFFIX is non-nil, don't try adding
692 suffixes `.elc' or `.el' to the specified name FILE.
693 If optional fifth arg MUST-SUFFIX is non-nil, insist on
694 the suffix `.elc' or `.el'; don't accept just FILE unless
695 it ends in one of those suffixes or includes a directory name.
697 If this function fails to find a file, it may look for different
698 representations of that file before trying another file.
699 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
700 to the file name. Emacs uses this feature mainly to find compressed
701 versions of files when Auto Compression mode is enabled.
703 The exact suffixes that this function tries out, in the exact order,
704 are given by the value of the variable `load-file-rep-suffixes' if
705 NOSUFFIX is non-nil and by the return value of the function
706 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
707 MUST-SUFFIX are nil, this function first tries out the latter suffixes
710 Loading a file records its definitions, and its `provide' and
711 `require' calls, in an element of `load-history' whose
712 car is the file name loaded. See `load-history'.
714 Return t if the file exists and loads successfully. */)
715 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
716 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
718 register FILE *stream
;
719 register int fd
= -1;
720 int count
= SPECPDL_INDEX ();
722 struct gcpro gcpro1
, gcpro2
, gcpro3
;
723 Lisp_Object found
, efound
, hist_file_name
;
724 /* 1 means we printed the ".el is newer" message. */
726 /* 1 means we are loading a compiled file. */
738 /* If file name is magic, call the handler. */
739 /* This shouldn't be necessary any more now that `openp' handles it right.
740 handler = Ffind_file_name_handler (file, Qload);
742 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
744 /* Do this after the handler to avoid
745 the need to gcpro noerror, nomessage and nosuffix.
746 (Below here, we care only whether they are nil or not.)
747 The presence of this call is the result of a historical accident:
748 it used to be in every file-operation and when it got removed
749 everywhere, it accidentally stayed here. Since then, enough people
750 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
751 that it seemed risky to remove. */
752 if (! NILP (noerror
))
754 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
755 Qt
, load_error_handler
);
760 file
= Fsubstitute_in_file_name (file
);
763 /* Avoid weird lossage with null string as arg,
764 since it would try to load a directory as a Lisp file */
765 if (SCHARS (file
) > 0)
767 int size
= SBYTES (file
);
770 GCPRO2 (file
, found
);
772 if (! NILP (must_suffix
))
774 /* Don't insist on adding a suffix if FILE already ends with one. */
776 && !strcmp (SDATA (file
) + size
- 3, ".el"))
779 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
781 /* Don't insist on adding a suffix
782 if the argument includes a directory name. */
783 else if (! NILP (Ffile_name_directory (file
)))
787 fd
= openp (Vload_path
, file
,
788 (!NILP (nosuffix
) ? Qnil
789 : !NILP (must_suffix
) ? Fget_load_suffixes ()
790 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
791 tmp
[1] = Vload_file_rep_suffixes
,
800 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
801 Fcons (file
, Qnil
)));
806 /* Tell startup.el whether or not we found the user's init file. */
807 if (EQ (Qt
, Vuser_init_file
))
808 Vuser_init_file
= found
;
810 /* If FD is -2, that means openp found a magic file. */
813 if (NILP (Fequal (found
, file
)))
814 /* If FOUND is a different file name from FILE,
815 find its handler even if we have already inhibited
816 the `load' operation on FILE. */
817 handler
= Ffind_file_name_handler (found
, Qt
);
819 handler
= Ffind_file_name_handler (found
, Qload
);
820 if (! NILP (handler
))
821 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
824 /* Check if we're stuck in a recursive load cycle.
826 2000-09-21: It's not possible to just check for the file loaded
827 being a member of Vloads_in_progress. This fails because of the
828 way the byte compiler currently works; `provide's are not
829 evaluted, see font-lock.el/jit-lock.el as an example. This
830 leads to a certain amount of ``normal'' recursion.
832 Also, just loading a file recursively is not always an error in
833 the general case; the second load may do something different. */
837 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
838 if (!NILP (Fequal (found
, XCAR (tem
))))
844 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
845 Fcons (found
, Vloads_in_progress
)));
847 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
848 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
851 /* Get the name for load-history. */
852 hist_file_name
= (! NILP (Vpurify_flag
)
853 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
854 tmp
[1] = Ffile_name_nondirectory (found
),
858 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
860 /* Load .elc files directly, but not when they are
861 remote and have no handler! */
868 GCPRO3 (file
, found
, hist_file_name
);
870 if (!safe_to_load_p (fd
))
873 if (!load_dangerous_libraries
)
877 error ("File `%s' was not compiled in Emacs",
880 else if (!NILP (nomessage
))
881 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
886 efound
= ENCODE_FILE (found
);
891 stat ((char *)SDATA (efound
), &s1
);
892 SSET (efound
, SBYTES (efound
) - 1, 0);
893 result
= stat ((char *)SDATA (efound
), &s2
);
894 SSET (efound
, SBYTES (efound
) - 1, 'c');
896 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
898 /* Make the progress messages mention that source is newer. */
901 /* If we won't print another message, mention this anyway. */
902 if (!NILP (nomessage
))
904 Lisp_Object msg_file
;
905 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
906 message_with_string ("Source file `%s' newer than byte-compiled file",
915 /* We are loading a source file (*.el). */
916 if (!NILP (Vload_source_file_function
))
922 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
923 NILP (noerror
) ? Qnil
: Qt
,
924 NILP (nomessage
) ? Qnil
: Qt
);
925 return unbind_to (count
, val
);
929 GCPRO3 (file
, found
, hist_file_name
);
933 efound
= ENCODE_FILE (found
);
934 stream
= fopen ((char *) SDATA (efound
), fmode
);
935 #else /* not WINDOWSNT */
936 stream
= fdopen (fd
, fmode
);
937 #endif /* not WINDOWSNT */
941 error ("Failure to create stdio stream for %s", SDATA (file
));
944 if (! NILP (Vpurify_flag
))
945 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
947 if (NILP (nomessage
))
950 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
953 message_with_string ("Loading %s (source)...", file
, 1);
955 message_with_string ("Loading %s (compiled; note, source file is newer)...",
957 else /* The typical case; compiled file newer than source file. */
958 message_with_string ("Loading %s...", file
, 1);
961 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
962 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
963 specbind (Qload_file_name
, found
);
964 specbind (Qinhibit_file_name_operation
, Qnil
);
966 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
968 readevalloop (Qget_file_char
, stream
, hist_file_name
,
969 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
970 unbind_to (count
, Qnil
);
972 /* Run any eval-after-load forms for this file */
973 if (NILP (Vpurify_flag
)
974 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
975 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
979 if (saved_doc_string
)
980 free (saved_doc_string
);
981 saved_doc_string
= 0;
982 saved_doc_string_size
= 0;
984 if (prev_saved_doc_string
)
985 xfree (prev_saved_doc_string
);
986 prev_saved_doc_string
= 0;
987 prev_saved_doc_string_size
= 0;
989 if (!noninteractive
&& NILP (nomessage
))
992 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
995 message_with_string ("Loading %s (source)...done", file
, 1);
997 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
999 else /* The typical case; compiled file newer than source file. */
1000 message_with_string ("Loading %s...done", file
, 1);
1003 if (!NILP (Fequal (build_string ("obsolete"),
1004 Ffile_name_nondirectory
1005 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1006 message_with_string ("Package %s is obsolete", file
, 1);
1012 load_unwind (arg
) /* used as unwind-protect function in load */
1015 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1018 if (--load_in_progress
< 0) load_in_progress
= 0;
1023 load_descriptor_unwind (oldlist
)
1024 Lisp_Object oldlist
;
1026 load_descriptor_list
= oldlist
;
1030 /* Close all descriptors in use for Floads.
1031 This is used when starting a subprocess. */
1038 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1039 emacs_close (XFASTINT (XCAR (tail
)));
1044 complete_filename_p (pathname
)
1045 Lisp_Object pathname
;
1047 register const unsigned char *s
= SDATA (pathname
);
1048 return (IS_DIRECTORY_SEP (s
[0])
1049 || (SCHARS (pathname
) > 2
1050 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1060 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1061 doc
: /* Search for FILENAME through PATH.
1062 Returns the file's name in absolute form, or nil if not found.
1063 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1064 file name when searching.
1065 If non-nil, PREDICATE is used instead of `file-readable-p'.
1066 PREDICATE can also be an integer to pass to the access(2) function,
1067 in which case file-name-handlers are ignored. */)
1068 (filename
, path
, suffixes
, predicate
)
1069 Lisp_Object filename
, path
, suffixes
, predicate
;
1072 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1073 if (NILP (predicate
) && fd
> 0)
1079 /* Search for a file whose name is STR, looking in directories
1080 in the Lisp list PATH, and trying suffixes from SUFFIX.
1081 On success, returns a file descriptor. On failure, returns -1.
1083 SUFFIXES is a list of strings containing possible suffixes.
1084 The empty suffix is automatically added iff the list is empty.
1086 PREDICATE non-nil means don't open the files,
1087 just look for one that satisfies the predicate. In this case,
1088 returns 1 on success. The predicate can be a lisp function or
1089 an integer to pass to `access' (in which case file-name-handlers
1092 If STOREPTR is nonzero, it points to a slot where the name of
1093 the file actually found should be stored as a Lisp string.
1094 nil is stored there on failure.
1096 If the file we find is remote, return -2
1097 but store the found remote file name in *STOREPTR. */
1100 openp (path
, str
, suffixes
, storeptr
, predicate
)
1101 Lisp_Object path
, str
;
1102 Lisp_Object suffixes
;
1103 Lisp_Object
*storeptr
;
1104 Lisp_Object predicate
;
1109 register char *fn
= buf
;
1112 Lisp_Object filename
;
1114 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1115 Lisp_Object string
, tail
, encoded_fn
;
1116 int max_suffix_len
= 0;
1120 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1122 CHECK_STRING_CAR (tail
);
1123 max_suffix_len
= max (max_suffix_len
,
1124 SBYTES (XCAR (tail
)));
1127 string
= filename
= encoded_fn
= Qnil
;
1128 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1133 if (complete_filename_p (str
))
1136 for (; CONSP (path
); path
= XCDR (path
))
1138 filename
= Fexpand_file_name (str
, XCAR (path
));
1139 if (!complete_filename_p (filename
))
1140 /* If there are non-absolute elts in PATH (eg ".") */
1141 /* Of course, this could conceivably lose if luser sets
1142 default-directory to be something non-absolute... */
1144 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1145 if (!complete_filename_p (filename
))
1146 /* Give up on this path element! */
1150 /* Calculate maximum size of any filename made from
1151 this path element/specified file name and any possible suffix. */
1152 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1153 if (fn_size
< want_size
)
1154 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1156 /* Loop over suffixes. */
1157 for (tail
= NILP (suffixes
) ? Fcons (build_string (""), Qnil
) : suffixes
;
1158 CONSP (tail
); tail
= XCDR (tail
))
1160 int lsuffix
= SBYTES (XCAR (tail
));
1161 Lisp_Object handler
;
1164 /* Concatenate path element/specified name with the suffix.
1165 If the directory starts with /:, remove that. */
1166 if (SCHARS (filename
) > 2
1167 && SREF (filename
, 0) == '/'
1168 && SREF (filename
, 1) == ':')
1170 strncpy (fn
, SDATA (filename
) + 2,
1171 SBYTES (filename
) - 2);
1172 fn
[SBYTES (filename
) - 2] = 0;
1176 strncpy (fn
, SDATA (filename
),
1178 fn
[SBYTES (filename
)] = 0;
1181 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1182 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1184 /* Check that the file exists and is not a directory. */
1185 /* We used to only check for handlers on non-absolute file names:
1189 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1190 It's not clear why that was the case and it breaks things like
1191 (load "/bar.el") where the file is actually "/bar.el.gz". */
1192 string
= build_string (fn
);
1193 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1194 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1196 if (NILP (predicate
))
1197 exists
= !NILP (Ffile_readable_p (string
));
1199 exists
= !NILP (call1 (predicate
, string
));
1200 if (exists
&& !NILP (Ffile_directory_p (string
)))
1205 /* We succeeded; return this descriptor and filename. */
1216 encoded_fn
= ENCODE_FILE (string
);
1217 pfn
= SDATA (encoded_fn
);
1218 exists
= (stat (pfn
, &st
) >= 0
1219 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1222 /* Check that we can access or open it. */
1223 if (NATNUMP (predicate
))
1224 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1226 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1230 /* We succeeded; return this descriptor and filename. */
1248 /* Merge the list we've accumulated of globals from the current input source
1249 into the load_history variable. The details depend on whether
1250 the source has an associated file name or not.
1252 FILENAME is the file name that we are loading from.
1253 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1256 build_load_history (filename
, entire
)
1257 Lisp_Object filename
;
1260 register Lisp_Object tail
, prev
, newelt
;
1261 register Lisp_Object tem
, tem2
;
1262 register int foundit
= 0;
1264 tail
= Vload_history
;
1267 while (CONSP (tail
))
1271 /* Find the feature's previous assoc list... */
1272 if (!NILP (Fequal (filename
, Fcar (tem
))))
1276 /* If we're loading the entire file, remove old data. */
1280 Vload_history
= XCDR (tail
);
1282 Fsetcdr (prev
, XCDR (tail
));
1285 /* Otherwise, cons on new symbols that are not already members. */
1288 tem2
= Vcurrent_load_list
;
1290 while (CONSP (tem2
))
1292 newelt
= XCAR (tem2
);
1294 if (NILP (Fmember (newelt
, tem
)))
1295 Fsetcar (tail
, Fcons (XCAR (tem
),
1296 Fcons (newelt
, XCDR (tem
))));
1309 /* If we're loading an entire file, cons the new assoc onto the
1310 front of load-history, the most-recently-loaded position. Also
1311 do this if we didn't find an existing member for the file. */
1312 if (entire
|| !foundit
)
1313 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1318 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1326 readevalloop_1 (old
)
1329 load_convert_to_unibyte
= ! NILP (old
);
1333 /* Signal an `end-of-file' error, if possible with file name
1337 end_of_file_error ()
1341 if (STRINGP (Vload_file_name
))
1342 data
= Fcons (Vload_file_name
, Qnil
);
1346 Fsignal (Qend_of_file
, data
);
1349 /* UNIBYTE specifies how to set load_convert_to_unibyte
1350 for this invocation.
1351 READFUN, if non-nil, is used instead of `read'.
1353 START, END specify region to read in current buffer (from eval-region).
1354 If the input is not from a buffer, they must be nil. */
1357 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1358 printflag
, unibyte
, readfun
, start
, end
)
1359 Lisp_Object readcharfun
;
1361 Lisp_Object sourcename
;
1362 Lisp_Object (*evalfun
) ();
1364 Lisp_Object unibyte
, readfun
;
1365 Lisp_Object start
, end
;
1368 register Lisp_Object val
;
1369 int count
= SPECPDL_INDEX ();
1370 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1371 struct buffer
*b
= 0;
1372 int continue_reading_p
;
1373 /* Nonzero if reading an entire buffer. */
1374 int whole_buffer
= 0;
1375 /* 1 on the first time around. */
1378 if (MARKERP (readcharfun
))
1381 start
= readcharfun
;
1384 if (BUFFERP (readcharfun
))
1385 b
= XBUFFER (readcharfun
);
1386 else if (MARKERP (readcharfun
))
1387 b
= XMARKER (readcharfun
)->buffer
;
1389 /* We assume START is nil when input is not from a buffer. */
1390 if (! NILP (start
) && !b
)
1393 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1394 specbind (Qcurrent_load_list
, Qnil
);
1395 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1396 load_convert_to_unibyte
= !NILP (unibyte
);
1398 readchar_backlog
= -1;
1400 GCPRO4 (sourcename
, readfun
, start
, end
);
1402 /* Try to ensure sourcename is a truename, except whilst preloading. */
1403 if (NILP (Vpurify_flag
)
1404 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1405 && !NILP (Ffboundp (Qfile_truename
)))
1406 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1408 LOADHIST_ATTACH (sourcename
);
1410 continue_reading_p
= 1;
1411 while (continue_reading_p
)
1413 int count1
= SPECPDL_INDEX ();
1415 if (b
!= 0 && NILP (b
->name
))
1416 error ("Reading from killed buffer");
1420 /* Switch to the buffer we are reading from. */
1421 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1422 set_buffer_internal (b
);
1424 /* Save point in it. */
1425 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1426 /* Save ZV in it. */
1427 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1428 /* Those get unbound after we read one expression. */
1430 /* Set point and ZV around stuff to be read. */
1433 Fnarrow_to_region (make_number (BEGV
), end
);
1435 /* Just for cleanliness, convert END to a marker
1436 if it is an integer. */
1438 end
= Fpoint_max_marker ();
1441 /* On the first cycle, we can easily test here
1442 whether we are reading the whole buffer. */
1443 if (b
&& first_sexp
)
1444 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1451 while ((c
= READCHAR
) != '\n' && c
!= -1);
1456 unbind_to (count1
, Qnil
);
1460 /* Ignore whitespace here, so we can detect eof. */
1461 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1464 if (!NILP (Vpurify_flag
) && c
== '(')
1466 record_unwind_protect (unreadpure
, Qnil
);
1467 val
= read_list (-1, readcharfun
);
1472 read_objects
= Qnil
;
1473 if (!NILP (readfun
))
1475 val
= call1 (readfun
, readcharfun
);
1477 /* If READCHARFUN has set point to ZV, we should
1478 stop reading, even if the form read sets point
1479 to a different value when evaluated. */
1480 if (BUFFERP (readcharfun
))
1482 struct buffer
*b
= XBUFFER (readcharfun
);
1483 if (BUF_PT (b
) == BUF_ZV (b
))
1484 continue_reading_p
= 0;
1487 else if (! NILP (Vload_read_function
))
1488 val
= call1 (Vload_read_function
, readcharfun
);
1490 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1493 if (!NILP (start
) && continue_reading_p
)
1494 start
= Fpoint_marker ();
1496 /* Restore saved point and BEGV. */
1497 unbind_to (count1
, Qnil
);
1499 /* Now eval what we just read. */
1500 val
= (*evalfun
) (val
);
1504 Vvalues
= Fcons (val
, Vvalues
);
1505 if (EQ (Vstandard_output
, Qt
))
1514 build_load_history (sourcename
,
1515 stream
|| whole_buffer
);
1519 unbind_to (count
, Qnil
);
1522 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1523 doc
: /* Execute the current buffer as Lisp code.
1524 Programs can pass two arguments, BUFFER and PRINTFLAG.
1525 BUFFER is the buffer to evaluate (nil means use current buffer).
1526 PRINTFLAG controls printing of output:
1527 nil means discard it; anything else is stream for print.
1529 If the optional third argument FILENAME is non-nil,
1530 it specifies the file name to use for `load-history'.
1531 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1532 for this invocation.
1534 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1535 `print' and related functions should work normally even if PRINTFLAG is nil.
1537 This function preserves the position of point. */)
1538 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1539 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1541 int count
= SPECPDL_INDEX ();
1542 Lisp_Object tem
, buf
;
1545 buf
= Fcurrent_buffer ();
1547 buf
= Fget_buffer (buffer
);
1549 error ("No such buffer");
1551 if (NILP (printflag
) && NILP (do_allow_print
))
1556 if (NILP (filename
))
1557 filename
= XBUFFER (buf
)->filename
;
1559 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1560 specbind (Qstandard_output
, tem
);
1561 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1562 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1563 readevalloop (buf
, 0, filename
, Feval
,
1564 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1565 unbind_to (count
, Qnil
);
1570 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1571 doc
: /* Execute the region as Lisp code.
1572 When called from programs, expects two arguments,
1573 giving starting and ending indices in the current buffer
1574 of the text to be executed.
1575 Programs can pass third argument PRINTFLAG which controls output:
1576 nil means discard it; anything else is stream for printing it.
1577 Also the fourth argument READ-FUNCTION, if non-nil, is used
1578 instead of `read' to read each expression. It gets one argument
1579 which is the input stream for reading characters.
1581 This function does not move point. */)
1582 (start
, end
, printflag
, read_function
)
1583 Lisp_Object start
, end
, printflag
, read_function
;
1585 int count
= SPECPDL_INDEX ();
1586 Lisp_Object tem
, cbuf
;
1588 cbuf
= Fcurrent_buffer ();
1590 if (NILP (printflag
))
1594 specbind (Qstandard_output
, tem
);
1595 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1597 /* readevalloop calls functions which check the type of start and end. */
1598 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1599 !NILP (printflag
), Qnil
, read_function
,
1602 return unbind_to (count
, Qnil
);
1606 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1607 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1608 If STREAM is nil, use the value of `standard-input' (which see).
1609 STREAM or the value of `standard-input' may be:
1610 a buffer (read from point and advance it)
1611 a marker (read from where it points and advance it)
1612 a function (call it with no arguments for each character,
1613 call it with a char as argument to push a char back)
1614 a string (takes text from string, starting at the beginning)
1615 t (read text line using minibuffer and use it, or read from
1616 standard input in batch mode). */)
1621 stream
= Vstandard_input
;
1622 if (EQ (stream
, Qt
))
1623 stream
= Qread_char
;
1624 if (EQ (stream
, Qread_char
))
1625 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1627 return read_internal_start (stream
, Qnil
, Qnil
);
1630 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1631 doc
: /* Read one Lisp expression which is represented as text by STRING.
1632 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1633 START and END optionally delimit a substring of STRING from which to read;
1634 they default to 0 and (length STRING) respectively. */)
1635 (string
, start
, end
)
1636 Lisp_Object string
, start
, end
;
1639 CHECK_STRING (string
);
1640 /* read_internal_start sets read_from_string_index. */
1641 ret
= read_internal_start (string
, start
, end
);
1642 return Fcons (ret
, make_number (read_from_string_index
));
1645 /* Function to set up the global context we need in toplevel read
1648 read_internal_start (stream
, start
, end
)
1650 Lisp_Object start
; /* Only used when stream is a string. */
1651 Lisp_Object end
; /* Only used when stream is a string. */
1655 readchar_backlog
= -1;
1657 new_backquote_flag
= 0;
1658 read_objects
= Qnil
;
1659 if (EQ (Vread_with_symbol_positions
, Qt
)
1660 || EQ (Vread_with_symbol_positions
, stream
))
1661 Vread_symbol_positions_list
= Qnil
;
1663 if (STRINGP (stream
))
1665 int startval
, endval
;
1667 endval
= SCHARS (stream
);
1671 endval
= XINT (end
);
1672 if (endval
< 0 || endval
> SCHARS (stream
))
1673 args_out_of_range (stream
, end
);
1680 CHECK_NUMBER (start
);
1681 startval
= XINT (start
);
1682 if (startval
< 0 || startval
> endval
)
1683 args_out_of_range (stream
, start
);
1685 read_from_string_index
= startval
;
1686 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1687 read_from_string_limit
= endval
;
1690 retval
= read0 (stream
);
1691 if (EQ (Vread_with_symbol_positions
, Qt
)
1692 || EQ (Vread_with_symbol_positions
, stream
))
1693 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1697 /* Use this for recursive reads, in contexts where internal tokens
1702 Lisp_Object readcharfun
;
1704 register Lisp_Object val
;
1707 val
= read1 (readcharfun
, &c
, 0);
1709 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1716 static int read_buffer_size
;
1717 static char *read_buffer
;
1719 /* Read multibyte form and return it as a character. C is a first
1720 byte of multibyte form, and rest of them are read from
1724 read_multibyte (c
, readcharfun
)
1726 Lisp_Object readcharfun
;
1728 /* We need the actual character code of this multibyte
1730 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1738 while ((c
= READCHAR
) >= 0xA0
1739 && len
< MAX_MULTIBYTE_LENGTH
)
1745 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1746 return STRING_CHAR (str
, len
);
1747 /* The byte sequence is not valid as multibyte. Unread all bytes
1748 but the first one, and return the first byte. */
1754 /* Read a \-escape sequence, assuming we already read the `\'.
1755 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1756 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1757 Otherwise store 0 into *BYTEREP. */
1760 read_escape (readcharfun
, stringp
, byterep
)
1761 Lisp_Object readcharfun
;
1765 register int c
= READCHAR
;
1766 /* \u allows up to four hex digits, \U up to eight. Default to the
1767 behaviour for \u, and change this value in the case that \U is seen. */
1768 int unicode_hex_count
= 4;
1775 end_of_file_error ();
1805 error ("Invalid escape character syntax");
1808 c
= read_escape (readcharfun
, 0, byterep
);
1809 return c
| meta_modifier
;
1814 error ("Invalid escape character syntax");
1817 c
= read_escape (readcharfun
, 0, byterep
);
1818 return c
| shift_modifier
;
1823 error ("Invalid escape character syntax");
1826 c
= read_escape (readcharfun
, 0, byterep
);
1827 return c
| hyper_modifier
;
1832 error ("Invalid escape character syntax");
1835 c
= read_escape (readcharfun
, 0, byterep
);
1836 return c
| alt_modifier
;
1847 c
= read_escape (readcharfun
, 0, byterep
);
1848 return c
| super_modifier
;
1853 error ("Invalid escape character syntax");
1857 c
= read_escape (readcharfun
, 0, byterep
);
1858 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1859 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1860 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1861 return c
| ctrl_modifier
;
1862 /* ASCII control chars are made from letters (both cases),
1863 as well as the non-letters within 0100...0137. */
1864 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1865 return (c
& (037 | ~0177));
1866 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1867 return (c
& (037 | ~0177));
1869 return c
| ctrl_modifier
;
1879 /* An octal escape, as in ANSI C. */
1881 register int i
= c
- '0';
1882 register int count
= 0;
1885 if ((c
= READCHAR
) >= '0' && c
<= '7')
1902 /* A hex escape, as in ANSI C. */
1908 if (c
>= '0' && c
<= '9')
1913 else if ((c
>= 'a' && c
<= 'f')
1914 || (c
>= 'A' && c
<= 'F'))
1917 if (c
>= 'a' && c
<= 'f')
1934 /* Post-Unicode-2.0: Up to eight hex chars. */
1935 unicode_hex_count
= 8;
1938 /* A Unicode escape. We only permit them in strings and characters,
1939 not arbitrarily in the source code, as in some other languages. */
1943 Lisp_Object lisp_char
;
1944 struct gcpro gcpro1
;
1946 while (++count
<= unicode_hex_count
)
1949 /* isdigit and isalpha may be locale-specific, which we don't
1951 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
1952 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
1953 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
1956 error ("Non-hex digit used for Unicode escape");
1961 GCPRO1 (readcharfun
);
1962 lisp_char
= call2 (intern ("decode-char"), intern ("ucs"),
1966 if (NILP (lisp_char
))
1968 error ("Unsupported Unicode code point: U+%x", (unsigned)i
);
1971 return XFASTINT (lisp_char
);
1975 if (BASE_LEADING_CODE_P (c
))
1976 c
= read_multibyte (c
, readcharfun
);
1982 /* Read an integer in radix RADIX using READCHARFUN to read
1983 characters. RADIX must be in the interval [2..36]; if it isn't, a
1984 read error is signaled . Value is the integer read. Signals an
1985 error if encountering invalid read syntax or if RADIX is out of
1989 read_integer (readcharfun
, radix
)
1990 Lisp_Object readcharfun
;
1993 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1994 EMACS_INT number
= 0;
1996 if (radix
< 2 || radix
> 36)
2000 number
= ndigits
= invalid_p
= 0;
2016 if (c
>= '0' && c
<= '9')
2018 else if (c
>= 'a' && c
<= 'z')
2019 digit
= c
- 'a' + 10;
2020 else if (c
>= 'A' && c
<= 'Z')
2021 digit
= c
- 'A' + 10;
2028 if (digit
< 0 || digit
>= radix
)
2031 number
= radix
* number
+ digit
;
2037 if (ndigits
== 0 || invalid_p
)
2040 sprintf (buf
, "integer, radix %d", radix
);
2041 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
2044 return make_number (sign
* number
);
2048 /* Convert unibyte text in read_buffer to multibyte.
2050 Initially, *P is a pointer after the end of the unibyte text, and
2051 the pointer *END points after the end of read_buffer.
2053 If read_buffer doesn't have enough room to hold the result
2054 of the conversion, reallocate it and adjust *P and *END.
2056 At the end, make *P point after the result of the conversion, and
2057 return in *NCHARS the number of characters in the converted
2061 to_multibyte (p
, end
, nchars
)
2067 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
2068 if (read_buffer_size
< 2 * nbytes
)
2070 int offset
= *p
- read_buffer
;
2071 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
2072 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
2073 *p
= read_buffer
+ offset
;
2074 *end
= read_buffer
+ read_buffer_size
;
2077 if (nbytes
!= *nchars
)
2078 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
2079 *p
- read_buffer
, nchars
);
2081 *p
= read_buffer
+ nbytes
;
2085 /* If the next token is ')' or ']' or '.', we store that character
2086 in *PCH and the return value is not interesting. Else, we store
2087 zero in *PCH and we read and return one lisp object.
2089 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2092 read1 (readcharfun
, pch
, first_in_list
)
2093 register Lisp_Object readcharfun
;
2098 int uninterned_symbol
= 0;
2106 end_of_file_error ();
2111 return read_list (0, readcharfun
);
2114 return read_vector (readcharfun
, 0);
2131 tmp
= read_vector (readcharfun
, 0);
2132 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
2133 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
2134 error ("Invalid size char-table");
2135 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2136 XCHAR_TABLE (tmp
)->top
= Qt
;
2145 tmp
= read_vector (readcharfun
, 0);
2146 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2147 error ("Invalid size char-table");
2148 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2149 XCHAR_TABLE (tmp
)->top
= Qnil
;
2152 Fsignal (Qinvalid_read_syntax
,
2153 Fcons (make_string ("#^^", 3), Qnil
));
2155 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2160 length
= read1 (readcharfun
, pch
, first_in_list
);
2164 Lisp_Object tmp
, val
;
2166 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2167 / BOOL_VECTOR_BITS_PER_CHAR
);
2170 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2171 if (size_in_chars
!= SCHARS (tmp
)
2172 /* We used to print 1 char too many
2173 when the number of bits was a multiple of 8.
2174 Accept such input in case it came from an old version. */
2175 && ! (XFASTINT (length
)
2176 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2177 Fsignal (Qinvalid_read_syntax
,
2178 Fcons (make_string ("#&...", 5), Qnil
));
2180 val
= Fmake_bool_vector (length
, Qnil
);
2181 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2183 /* Clear the extraneous bits in the last byte. */
2184 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2185 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2186 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2189 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2194 /* Accept compiled functions at read-time so that we don't have to
2195 build them using function calls. */
2197 tmp
= read_vector (readcharfun
, 1);
2198 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2199 XVECTOR (tmp
)->contents
);
2204 struct gcpro gcpro1
;
2207 /* Read the string itself. */
2208 tmp
= read1 (readcharfun
, &ch
, 0);
2209 if (ch
!= 0 || !STRINGP (tmp
))
2210 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2212 /* Read the intervals and their properties. */
2215 Lisp_Object beg
, end
, plist
;
2217 beg
= read1 (readcharfun
, &ch
, 0);
2222 end
= read1 (readcharfun
, &ch
, 0);
2224 plist
= read1 (readcharfun
, &ch
, 0);
2226 Fsignal (Qinvalid_read_syntax
,
2227 Fcons (build_string ("invalid string property list"),
2229 Fset_text_properties (beg
, end
, plist
, tmp
);
2235 /* #@NUMBER is used to skip NUMBER following characters.
2236 That's used in .elc files to skip over doc strings
2237 and function definitions. */
2242 /* Read a decimal integer. */
2243 while ((c
= READCHAR
) >= 0
2244 && c
>= '0' && c
<= '9')
2252 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2254 /* If we are supposed to force doc strings into core right now,
2255 record the last string that we skipped,
2256 and record where in the file it comes from. */
2258 /* But first exchange saved_doc_string
2259 with prev_saved_doc_string, so we save two strings. */
2261 char *temp
= saved_doc_string
;
2262 int temp_size
= saved_doc_string_size
;
2263 file_offset temp_pos
= saved_doc_string_position
;
2264 int temp_len
= saved_doc_string_length
;
2266 saved_doc_string
= prev_saved_doc_string
;
2267 saved_doc_string_size
= prev_saved_doc_string_size
;
2268 saved_doc_string_position
= prev_saved_doc_string_position
;
2269 saved_doc_string_length
= prev_saved_doc_string_length
;
2271 prev_saved_doc_string
= temp
;
2272 prev_saved_doc_string_size
= temp_size
;
2273 prev_saved_doc_string_position
= temp_pos
;
2274 prev_saved_doc_string_length
= temp_len
;
2277 if (saved_doc_string_size
== 0)
2279 saved_doc_string_size
= nskip
+ 100;
2280 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2282 if (nskip
> saved_doc_string_size
)
2284 saved_doc_string_size
= nskip
+ 100;
2285 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2286 saved_doc_string_size
);
2289 saved_doc_string_position
= file_tell (instream
);
2291 /* Copy that many characters into saved_doc_string. */
2292 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2293 saved_doc_string
[i
] = c
= READCHAR
;
2295 saved_doc_string_length
= i
;
2299 /* Skip that many characters. */
2300 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2308 /* #! appears at the beginning of an executable file.
2309 Skip the first line. */
2310 while (c
!= '\n' && c
>= 0)
2315 return Vload_file_name
;
2317 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2318 /* #:foo is the uninterned symbol named foo. */
2321 uninterned_symbol
= 1;
2325 /* Reader forms that can reuse previously read objects. */
2326 if (c
>= '0' && c
<= '9')
2331 /* Read a non-negative integer. */
2332 while (c
>= '0' && c
<= '9')
2338 /* #n=object returns object, but associates it with n for #n#. */
2341 /* Make a placeholder for #n# to use temporarily */
2342 Lisp_Object placeholder
;
2345 placeholder
= Fcons(Qnil
, Qnil
);
2346 cell
= Fcons (make_number (n
), placeholder
);
2347 read_objects
= Fcons (cell
, read_objects
);
2349 /* Read the object itself. */
2350 tem
= read0 (readcharfun
);
2352 /* Now put it everywhere the placeholder was... */
2353 substitute_object_in_subtree (tem
, placeholder
);
2355 /* ...and #n# will use the real value from now on. */
2356 Fsetcdr (cell
, tem
);
2360 /* #n# returns a previously read object. */
2363 tem
= Fassq (make_number (n
), read_objects
);
2366 /* Fall through to error message. */
2368 else if (c
== 'r' || c
== 'R')
2369 return read_integer (readcharfun
, n
);
2371 /* Fall through to error message. */
2373 else if (c
== 'x' || c
== 'X')
2374 return read_integer (readcharfun
, 16);
2375 else if (c
== 'o' || c
== 'O')
2376 return read_integer (readcharfun
, 8);
2377 else if (c
== 'b' || c
== 'B')
2378 return read_integer (readcharfun
, 2);
2381 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2384 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2389 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2399 new_backquote_flag
++;
2400 value
= read0 (readcharfun
);
2401 new_backquote_flag
--;
2403 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2407 if (new_backquote_flag
)
2409 Lisp_Object comma_type
= Qnil
;
2414 comma_type
= Qcomma_at
;
2416 comma_type
= Qcomma_dot
;
2419 if (ch
>= 0) UNREAD (ch
);
2420 comma_type
= Qcomma
;
2423 new_backquote_flag
--;
2424 value
= read0 (readcharfun
);
2425 new_backquote_flag
++;
2426 return Fcons (comma_type
, Fcons (value
, Qnil
));
2439 end_of_file_error ();
2441 /* Accept `single space' syntax like (list ? x) where the
2442 whitespace character is SPC or TAB.
2443 Other literal whitespace like NL, CR, and FF are not accepted,
2444 as there are well-established escape sequences for these. */
2445 if (c
== ' ' || c
== '\t')
2446 return make_number (c
);
2449 c
= read_escape (readcharfun
, 0, &discard
);
2450 else if (BASE_LEADING_CODE_P (c
))
2451 c
= read_multibyte (c
, readcharfun
);
2453 next_char
= READCHAR
;
2454 if (next_char
== '.')
2456 /* Only a dotted-pair dot is valid after a char constant. */
2457 int next_next_char
= READCHAR
;
2458 UNREAD (next_next_char
);
2460 ok
= (next_next_char
<= 040
2461 || (next_next_char
< 0200
2462 && (index ("\"';([#?", next_next_char
)
2463 || (!first_in_list
&& next_next_char
== '`')
2464 || (new_backquote_flag
&& next_next_char
== ','))));
2468 ok
= (next_char
<= 040
2469 || (next_char
< 0200
2470 && (index ("\"';()[]#?", next_char
)
2471 || (!first_in_list
&& next_char
== '`')
2472 || (new_backquote_flag
&& next_char
== ','))));
2476 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2478 return make_number (c
);
2483 char *p
= read_buffer
;
2484 char *end
= read_buffer
+ read_buffer_size
;
2486 /* 1 if we saw an escape sequence specifying
2487 a multibyte character, or a multibyte character. */
2488 int force_multibyte
= 0;
2489 /* 1 if we saw an escape sequence specifying
2490 a single-byte character. */
2491 int force_singlebyte
= 0;
2492 /* 1 if read_buffer contains multibyte text now. */
2493 int is_multibyte
= 0;
2497 while ((c
= READCHAR
) >= 0
2500 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2502 int offset
= p
- read_buffer
;
2503 read_buffer
= (char *) xrealloc (read_buffer
,
2504 read_buffer_size
*= 2);
2505 p
= read_buffer
+ offset
;
2506 end
= read_buffer
+ read_buffer_size
;
2513 c
= read_escape (readcharfun
, 1, &byterep
);
2515 /* C is -1 if \ newline has just been seen */
2518 if (p
== read_buffer
)
2524 force_singlebyte
= 1;
2525 else if (byterep
== 2)
2526 force_multibyte
= 1;
2529 /* A character that must be multibyte forces multibyte. */
2530 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2531 force_multibyte
= 1;
2533 /* If we just discovered the need to be multibyte,
2534 convert the text accumulated thus far. */
2535 if (force_multibyte
&& ! is_multibyte
)
2538 to_multibyte (&p
, &end
, &nchars
);
2541 /* Allow `\C- ' and `\C-?'. */
2542 if (c
== (CHAR_CTL
| ' '))
2544 else if (c
== (CHAR_CTL
| '?'))
2549 /* Shift modifier is valid only with [A-Za-z]. */
2550 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2552 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2553 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2557 /* Move the meta bit to the right place for a string. */
2558 c
= (c
& ~CHAR_META
) | 0x80;
2559 if (c
& CHAR_MODIFIER_MASK
)
2560 error ("Invalid modifier in string");
2563 p
+= CHAR_STRING (c
, p
);
2571 end_of_file_error ();
2573 /* If purifying, and string starts with \ newline,
2574 return zero instead. This is for doc strings
2575 that we are really going to find in etc/DOC.nn.nn */
2576 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2577 return make_number (0);
2579 if (is_multibyte
|| force_singlebyte
)
2581 else if (load_convert_to_unibyte
)
2584 to_multibyte (&p
, &end
, &nchars
);
2585 if (p
- read_buffer
!= nchars
)
2587 string
= make_multibyte_string (read_buffer
, nchars
,
2589 return Fstring_make_unibyte (string
);
2591 /* We can make a unibyte string directly. */
2594 else if (EQ (readcharfun
, Qget_file_char
)
2595 || EQ (readcharfun
, Qlambda
))
2597 /* Nowadays, reading directly from a file is used only for
2598 compiled Emacs Lisp files, and those always use the
2599 Emacs internal encoding. Meanwhile, Qlambda is used
2600 for reading dynamic byte code (compiled with
2601 byte-compile-dynamic = t). So make the string multibyte
2602 if the string contains any multibyte sequences.
2603 (to_multibyte is a no-op if not.) */
2604 to_multibyte (&p
, &end
, &nchars
);
2605 is_multibyte
= (p
- read_buffer
) != nchars
;
2608 /* In all other cases, if we read these bytes as
2609 separate characters, treat them as separate characters now. */
2612 /* We want readchar_count to be the number of characters, not
2613 bytes. Hence we adjust for multibyte characters in the
2614 string. ... But it doesn't seem to be necessary, because
2615 READCHAR *does* read multibyte characters from buffers. */
2616 /* readchar_count -= (p - read_buffer) - nchars; */
2618 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2620 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2626 int next_char
= READCHAR
;
2629 if (next_char
<= 040
2630 || (next_char
< 0200
2631 && (index ("\"';([#?", next_char
)
2632 || (!first_in_list
&& next_char
== '`')
2633 || (new_backquote_flag
&& next_char
== ','))))
2639 /* Otherwise, we fall through! Note that the atom-reading loop
2640 below will now loop at least once, assuring that we will not
2641 try to UNREAD two characters in a row. */
2645 if (c
<= 040) goto retry
;
2647 char *p
= read_buffer
;
2651 char *end
= read_buffer
+ read_buffer_size
;
2655 || (!index ("\"';()[]#", c
)
2656 && !(!first_in_list
&& c
== '`')
2657 && !(new_backquote_flag
&& c
== ','))))
2659 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2661 int offset
= p
- read_buffer
;
2662 read_buffer
= (char *) xrealloc (read_buffer
,
2663 read_buffer_size
*= 2);
2664 p
= read_buffer
+ offset
;
2665 end
= read_buffer
+ read_buffer_size
;
2672 end_of_file_error ();
2676 if (! SINGLE_BYTE_CHAR_P (c
))
2677 p
+= CHAR_STRING (c
, p
);
2686 int offset
= p
- read_buffer
;
2687 read_buffer
= (char *) xrealloc (read_buffer
,
2688 read_buffer_size
*= 2);
2689 p
= read_buffer
+ offset
;
2690 end
= read_buffer
+ read_buffer_size
;
2697 if (!quoted
&& !uninterned_symbol
)
2700 register Lisp_Object val
;
2702 if (*p1
== '+' || *p1
== '-') p1
++;
2703 /* Is it an integer? */
2706 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2707 /* Integers can have trailing decimal points. */
2708 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2710 /* It is an integer. */
2714 if (sizeof (int) == sizeof (EMACS_INT
))
2715 XSETINT (val
, atoi (read_buffer
));
2716 else if (sizeof (long) == sizeof (EMACS_INT
))
2717 XSETINT (val
, atol (read_buffer
));
2723 if (isfloat_string (read_buffer
))
2725 /* Compute NaN and infinities using 0.0 in a variable,
2726 to cope with compilers that think they are smarter
2732 /* Negate the value ourselves. This treats 0, NaNs,
2733 and infinity properly on IEEE floating point hosts,
2734 and works around a common bug where atof ("-0.0")
2736 int negative
= read_buffer
[0] == '-';
2738 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2739 returns 1, is if the input ends in e+INF or e+NaN. */
2746 value
= zero
/ zero
;
2748 /* If that made a "negative" NaN, negate it. */
2752 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2755 u_minus_zero
.d
= - 0.0;
2756 for (i
= 0; i
< sizeof (double); i
++)
2757 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2763 /* Now VALUE is a positive NaN. */
2766 value
= atof (read_buffer
+ negative
);
2770 return make_float (negative
? - value
: value
);
2774 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2775 : intern (read_buffer
);
2776 if (EQ (Vread_with_symbol_positions
, Qt
)
2777 || EQ (Vread_with_symbol_positions
, readcharfun
))
2778 Vread_symbol_positions_list
=
2779 /* Kind of a hack; this will probably fail if characters
2780 in the symbol name were escaped. Not really a big
2782 Fcons (Fcons (result
,
2783 make_number (readchar_count
2784 - XFASTINT (Flength (Fsymbol_name (result
))))),
2785 Vread_symbol_positions_list
);
2793 /* List of nodes we've seen during substitute_object_in_subtree. */
2794 static Lisp_Object seen_list
;
2797 substitute_object_in_subtree (object
, placeholder
)
2799 Lisp_Object placeholder
;
2801 Lisp_Object check_object
;
2803 /* We haven't seen any objects when we start. */
2806 /* Make all the substitutions. */
2808 = substitute_object_recurse (object
, placeholder
, object
);
2810 /* Clear seen_list because we're done with it. */
2813 /* The returned object here is expected to always eq the
2815 if (!EQ (check_object
, object
))
2816 error ("Unexpected mutation error in reader");
2819 /* Feval doesn't get called from here, so no gc protection is needed. */
2820 #define SUBSTITUTE(get_val, set_val) \
2822 Lisp_Object old_value = get_val; \
2823 Lisp_Object true_value \
2824 = substitute_object_recurse (object, placeholder,\
2827 if (!EQ (old_value, true_value)) \
2834 substitute_object_recurse (object
, placeholder
, subtree
)
2836 Lisp_Object placeholder
;
2837 Lisp_Object subtree
;
2839 /* If we find the placeholder, return the target object. */
2840 if (EQ (placeholder
, subtree
))
2843 /* If we've been to this node before, don't explore it again. */
2844 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2847 /* If this node can be the entry point to a cycle, remember that
2848 we've seen it. It can only be such an entry point if it was made
2849 by #n=, which means that we can find it as a value in
2851 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2852 seen_list
= Fcons (subtree
, seen_list
);
2854 /* Recurse according to subtree's type.
2855 Every branch must return a Lisp_Object. */
2856 switch (XTYPE (subtree
))
2858 case Lisp_Vectorlike
:
2861 int length
= XINT (Flength(subtree
));
2862 for (i
= 0; i
< length
; i
++)
2864 Lisp_Object idx
= make_number (i
);
2865 SUBSTITUTE (Faref (subtree
, idx
),
2866 Faset (subtree
, idx
, true_value
));
2873 SUBSTITUTE (Fcar_safe (subtree
),
2874 Fsetcar (subtree
, true_value
));
2875 SUBSTITUTE (Fcdr_safe (subtree
),
2876 Fsetcdr (subtree
, true_value
));
2882 /* Check for text properties in each interval.
2883 substitute_in_interval contains part of the logic. */
2885 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2886 Lisp_Object arg
= Fcons (object
, placeholder
);
2888 traverse_intervals_noorder (root_interval
,
2889 &substitute_in_interval
, arg
);
2894 /* Other types don't recurse any further. */
2900 /* Helper function for substitute_object_recurse. */
2902 substitute_in_interval (interval
, arg
)
2906 Lisp_Object object
= Fcar (arg
);
2907 Lisp_Object placeholder
= Fcdr (arg
);
2909 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2928 if (*cp
== '+' || *cp
== '-')
2931 if (*cp
>= '0' && *cp
<= '9')
2934 while (*cp
>= '0' && *cp
<= '9')
2942 if (*cp
>= '0' && *cp
<= '9')
2945 while (*cp
>= '0' && *cp
<= '9')
2948 if (*cp
== 'e' || *cp
== 'E')
2952 if (*cp
== '+' || *cp
== '-')
2956 if (*cp
>= '0' && *cp
<= '9')
2959 while (*cp
>= '0' && *cp
<= '9')
2962 else if (cp
== start
)
2964 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2969 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2975 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2976 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2977 || state
== (DOT_CHAR
|TRAIL_INT
)
2978 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2979 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2980 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2985 read_vector (readcharfun
, bytecodeflag
)
2986 Lisp_Object readcharfun
;
2991 register Lisp_Object
*ptr
;
2992 register Lisp_Object tem
, item
, vector
;
2993 register struct Lisp_Cons
*otem
;
2996 tem
= read_list (1, readcharfun
);
2997 len
= Flength (tem
);
2998 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3000 size
= XVECTOR (vector
)->size
;
3001 ptr
= XVECTOR (vector
)->contents
;
3002 for (i
= 0; i
< size
; i
++)
3005 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3006 bytecode object, the docstring containing the bytecode and
3007 constants values must be treated as unibyte and passed to
3008 Fread, to get the actual bytecode string and constants vector. */
3009 if (bytecodeflag
&& load_force_doc_strings
)
3011 if (i
== COMPILED_BYTECODE
)
3013 if (!STRINGP (item
))
3014 error ("Invalid byte code");
3016 /* Delay handling the bytecode slot until we know whether
3017 it is lazily-loaded (we can tell by whether the
3018 constants slot is nil). */
3019 ptr
[COMPILED_CONSTANTS
] = item
;
3022 else if (i
== COMPILED_CONSTANTS
)
3024 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3028 /* Coerce string to unibyte (like string-as-unibyte,
3029 but without generating extra garbage and
3030 guaranteeing no change in the contents). */
3031 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3032 STRING_SET_UNIBYTE (bytestr
);
3034 item
= Fread (bytestr
);
3036 error ("Invalid byte code");
3038 otem
= XCONS (item
);
3039 bytestr
= XCAR (item
);
3044 /* Now handle the bytecode slot. */
3045 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3048 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3056 /* FLAG = 1 means check for ] to terminate rather than ) and .
3057 FLAG = -1 means check for starting with defun
3058 and make structure pure. */
3061 read_list (flag
, readcharfun
)
3063 register Lisp_Object readcharfun
;
3065 /* -1 means check next element for defun,
3066 0 means don't check,
3067 1 means already checked and found defun. */
3068 int defunflag
= flag
< 0 ? -1 : 0;
3069 Lisp_Object val
, tail
;
3070 register Lisp_Object elt
, tem
;
3071 struct gcpro gcpro1
, gcpro2
;
3072 /* 0 is the normal case.
3073 1 means this list is a doc reference; replace it with the number 0.
3074 2 means this list is a doc reference; replace it with the doc string. */
3075 int doc_reference
= 0;
3077 /* Initialize this to 1 if we are reading a list. */
3078 int first_in_list
= flag
<= 0;
3087 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3092 /* While building, if the list starts with #$, treat it specially. */
3093 if (EQ (elt
, Vload_file_name
)
3095 && !NILP (Vpurify_flag
))
3097 if (NILP (Vdoc_file_name
))
3098 /* We have not yet called Snarf-documentation, so assume
3099 this file is described in the DOC-MM.NN file
3100 and Snarf-documentation will fill in the right value later.
3101 For now, replace the whole list with 0. */
3104 /* We have already called Snarf-documentation, so make a relative
3105 file name for this file, so it can be found properly
3106 in the installed Lisp directory.
3107 We don't use Fexpand_file_name because that would make
3108 the directory absolute now. */
3109 elt
= concat2 (build_string ("../lisp/"),
3110 Ffile_name_nondirectory (elt
));
3112 else if (EQ (elt
, Vload_file_name
)
3114 && load_force_doc_strings
)
3123 Fsignal (Qinvalid_read_syntax
,
3124 Fcons (make_string (") or . in a vector", 18), Qnil
));
3132 XSETCDR (tail
, read0 (readcharfun
));
3134 val
= read0 (readcharfun
);
3135 read1 (readcharfun
, &ch
, 0);
3139 if (doc_reference
== 1)
3140 return make_number (0);
3141 if (doc_reference
== 2)
3143 /* Get a doc string from the file we are loading.
3144 If it's in saved_doc_string, get it from there. */
3145 int pos
= XINT (XCDR (val
));
3146 /* Position is negative for user variables. */
3147 if (pos
< 0) pos
= -pos
;
3148 if (pos
>= saved_doc_string_position
3149 && pos
< (saved_doc_string_position
3150 + saved_doc_string_length
))
3152 int start
= pos
- saved_doc_string_position
;
3155 /* Process quoting with ^A,
3156 and find the end of the string,
3157 which is marked with ^_ (037). */
3158 for (from
= start
, to
= start
;
3159 saved_doc_string
[from
] != 037;)
3161 int c
= saved_doc_string
[from
++];
3164 c
= saved_doc_string
[from
++];
3166 saved_doc_string
[to
++] = c
;
3168 saved_doc_string
[to
++] = 0;
3170 saved_doc_string
[to
++] = 037;
3173 saved_doc_string
[to
++] = c
;
3176 return make_string (saved_doc_string
+ start
,
3179 /* Look in prev_saved_doc_string the same way. */
3180 else if (pos
>= prev_saved_doc_string_position
3181 && pos
< (prev_saved_doc_string_position
3182 + prev_saved_doc_string_length
))
3184 int start
= pos
- prev_saved_doc_string_position
;
3187 /* Process quoting with ^A,
3188 and find the end of the string,
3189 which is marked with ^_ (037). */
3190 for (from
= start
, to
= start
;
3191 prev_saved_doc_string
[from
] != 037;)
3193 int c
= prev_saved_doc_string
[from
++];
3196 c
= prev_saved_doc_string
[from
++];
3198 prev_saved_doc_string
[to
++] = c
;
3200 prev_saved_doc_string
[to
++] = 0;
3202 prev_saved_doc_string
[to
++] = 037;
3205 prev_saved_doc_string
[to
++] = c
;
3208 return make_string (prev_saved_doc_string
+ start
,
3212 return get_doc_string (val
, 0, 0);
3217 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3219 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3221 tem
= (read_pure
&& flag
<= 0
3222 ? pure_cons (elt
, Qnil
)
3223 : Fcons (elt
, Qnil
));
3225 XSETCDR (tail
, tem
);
3230 defunflag
= EQ (elt
, Qdefun
);
3231 else if (defunflag
> 0)
3236 Lisp_Object Vobarray
;
3237 Lisp_Object initial_obarray
;
3239 /* oblookup stores the bucket number here, for the sake of Funintern. */
3241 int oblookup_last_bucket_number
;
3243 static int hash_string ();
3245 /* Get an error if OBARRAY is not an obarray.
3246 If it is one, return it. */
3249 check_obarray (obarray
)
3250 Lisp_Object obarray
;
3252 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3254 /* If Vobarray is now invalid, force it to be valid. */
3255 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3257 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3262 /* Intern the C string STR: return a symbol with that name,
3263 interned in the current obarray. */
3270 int len
= strlen (str
);
3271 Lisp_Object obarray
;
3274 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3275 obarray
= check_obarray (obarray
);
3276 tem
= oblookup (obarray
, str
, len
, len
);
3279 return Fintern (make_string (str
, len
), obarray
);
3282 /* Create an uninterned symbol with name STR. */
3288 int len
= strlen (str
);
3290 return Fmake_symbol ((!NILP (Vpurify_flag
)
3291 ? make_pure_string (str
, len
, len
, 0)
3292 : make_string (str
, len
)));
3295 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3296 doc
: /* Return the canonical symbol whose name is STRING.
3297 If there is none, one is created by this function and returned.
3298 A second optional argument specifies the obarray to use;
3299 it defaults to the value of `obarray'. */)
3301 Lisp_Object string
, obarray
;
3303 register Lisp_Object tem
, sym
, *ptr
;
3305 if (NILP (obarray
)) obarray
= Vobarray
;
3306 obarray
= check_obarray (obarray
);
3308 CHECK_STRING (string
);
3310 tem
= oblookup (obarray
, SDATA (string
),
3313 if (!INTEGERP (tem
))
3316 if (!NILP (Vpurify_flag
))
3317 string
= Fpurecopy (string
);
3318 sym
= Fmake_symbol (string
);
3320 if (EQ (obarray
, initial_obarray
))
3321 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3323 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3325 if ((SREF (string
, 0) == ':')
3326 && EQ (obarray
, initial_obarray
))
3328 XSYMBOL (sym
)->constant
= 1;
3329 XSYMBOL (sym
)->value
= sym
;
3332 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3334 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3336 XSYMBOL (sym
)->next
= 0;
3341 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3342 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3343 NAME may be a string or a symbol. If it is a symbol, that exact
3344 symbol is searched for.
3345 A second optional argument specifies the obarray to use;
3346 it defaults to the value of `obarray'. */)
3348 Lisp_Object name
, obarray
;
3350 register Lisp_Object tem
, string
;
3352 if (NILP (obarray
)) obarray
= Vobarray
;
3353 obarray
= check_obarray (obarray
);
3355 if (!SYMBOLP (name
))
3357 CHECK_STRING (name
);
3361 string
= SYMBOL_NAME (name
);
3363 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3364 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3370 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3371 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3372 The value is t if a symbol was found and deleted, nil otherwise.
3373 NAME may be a string or a symbol. If it is a symbol, that symbol
3374 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3375 OBARRAY defaults to the value of the variable `obarray'. */)
3377 Lisp_Object name
, obarray
;
3379 register Lisp_Object string
, tem
;
3382 if (NILP (obarray
)) obarray
= Vobarray
;
3383 obarray
= check_obarray (obarray
);
3386 string
= SYMBOL_NAME (name
);
3389 CHECK_STRING (name
);
3393 tem
= oblookup (obarray
, SDATA (string
),
3398 /* If arg was a symbol, don't delete anything but that symbol itself. */
3399 if (SYMBOLP (name
) && !EQ (name
, tem
))
3402 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3403 XSYMBOL (tem
)->constant
= 0;
3404 XSYMBOL (tem
)->indirect_variable
= 0;
3406 hash
= oblookup_last_bucket_number
;
3408 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3410 if (XSYMBOL (tem
)->next
)
3411 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3413 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3417 Lisp_Object tail
, following
;
3419 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3420 XSYMBOL (tail
)->next
;
3423 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3424 if (EQ (following
, tem
))
3426 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3435 /* Return the symbol in OBARRAY whose names matches the string
3436 of SIZE characters (SIZE_BYTE bytes) at PTR.
3437 If there is no such symbol in OBARRAY, return nil.
3439 Also store the bucket number in oblookup_last_bucket_number. */
3442 oblookup (obarray
, ptr
, size
, size_byte
)
3443 Lisp_Object obarray
;
3444 register const char *ptr
;
3445 int size
, size_byte
;
3449 register Lisp_Object tail
;
3450 Lisp_Object bucket
, tem
;
3452 if (!VECTORP (obarray
)
3453 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3455 obarray
= check_obarray (obarray
);
3456 obsize
= XVECTOR (obarray
)->size
;
3458 /* This is sometimes needed in the middle of GC. */
3459 obsize
&= ~ARRAY_MARK_FLAG
;
3460 /* Combining next two lines breaks VMS C 2.3. */
3461 hash
= hash_string (ptr
, size_byte
);
3463 bucket
= XVECTOR (obarray
)->contents
[hash
];
3464 oblookup_last_bucket_number
= hash
;
3465 if (EQ (bucket
, make_number (0)))
3467 else if (!SYMBOLP (bucket
))
3468 error ("Bad data in guts of obarray"); /* Like CADR error message */
3470 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3472 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3473 && SCHARS (SYMBOL_NAME (tail
)) == size
3474 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3476 else if (XSYMBOL (tail
)->next
== 0)
3479 XSETINT (tem
, hash
);
3484 hash_string (ptr
, len
)
3485 const unsigned char *ptr
;
3488 register const unsigned char *p
= ptr
;
3489 register const unsigned char *end
= p
+ len
;
3490 register unsigned char c
;
3491 register int hash
= 0;
3496 if (c
>= 0140) c
-= 40;
3497 hash
= ((hash
<<3) + (hash
>>28) + c
);
3499 return hash
& 07777777777;
3503 map_obarray (obarray
, fn
, arg
)
3504 Lisp_Object obarray
;
3505 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3509 register Lisp_Object tail
;
3510 CHECK_VECTOR (obarray
);
3511 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3513 tail
= XVECTOR (obarray
)->contents
[i
];
3518 if (XSYMBOL (tail
)->next
== 0)
3520 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3526 mapatoms_1 (sym
, function
)
3527 Lisp_Object sym
, function
;
3529 call1 (function
, sym
);
3532 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3533 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3534 OBARRAY defaults to the value of `obarray'. */)
3536 Lisp_Object function
, obarray
;
3538 if (NILP (obarray
)) obarray
= Vobarray
;
3539 obarray
= check_obarray (obarray
);
3541 map_obarray (obarray
, mapatoms_1
, function
);
3545 #define OBARRAY_SIZE 1511
3550 Lisp_Object oblength
;
3554 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3556 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3557 Vobarray
= Fmake_vector (oblength
, make_number (0));
3558 initial_obarray
= Vobarray
;
3559 staticpro (&initial_obarray
);
3560 /* Intern nil in the obarray */
3561 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3562 XSYMBOL (Qnil
)->constant
= 1;
3564 /* These locals are to kludge around a pyramid compiler bug. */
3565 hash
= hash_string ("nil", 3);
3566 /* Separate statement here to avoid VAXC bug. */
3567 hash
%= OBARRAY_SIZE
;
3568 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3571 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3572 XSYMBOL (Qnil
)->function
= Qunbound
;
3573 XSYMBOL (Qunbound
)->value
= Qunbound
;
3574 XSYMBOL (Qunbound
)->function
= Qunbound
;
3577 XSYMBOL (Qnil
)->value
= Qnil
;
3578 XSYMBOL (Qnil
)->plist
= Qnil
;
3579 XSYMBOL (Qt
)->value
= Qt
;
3580 XSYMBOL (Qt
)->constant
= 1;
3582 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3585 Qvariable_documentation
= intern ("variable-documentation");
3586 staticpro (&Qvariable_documentation
);
3588 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3589 read_buffer
= (char *) xmalloc (read_buffer_size
);
3594 struct Lisp_Subr
*sname
;
3597 sym
= intern (sname
->symbol_name
);
3598 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3601 #ifdef NOTDEF /* use fset in subr.el now */
3603 defalias (sname
, string
)
3604 struct Lisp_Subr
*sname
;
3608 sym
= intern (string
);
3609 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3613 /* Define an "integer variable"; a symbol whose value is forwarded
3614 to a C variable of type int. Sample call: */
3615 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3617 defvar_int (namestring
, address
)
3621 Lisp_Object sym
, val
;
3622 sym
= intern (namestring
);
3623 val
= allocate_misc ();
3624 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3625 XINTFWD (val
)->intvar
= address
;
3626 SET_SYMBOL_VALUE (sym
, val
);
3629 /* Similar but define a variable whose value is t if address contains 1,
3630 nil if address contains 0 */
3632 defvar_bool (namestring
, address
)
3636 Lisp_Object sym
, val
;
3637 sym
= intern (namestring
);
3638 val
= allocate_misc ();
3639 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3640 XBOOLFWD (val
)->boolvar
= address
;
3641 SET_SYMBOL_VALUE (sym
, val
);
3642 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3645 /* Similar but define a variable whose value is the Lisp Object stored
3646 at address. Two versions: with and without gc-marking of the C
3647 variable. The nopro version is used when that variable will be
3648 gc-marked for some other reason, since marking the same slot twice
3649 can cause trouble with strings. */
3651 defvar_lisp_nopro (namestring
, address
)
3653 Lisp_Object
*address
;
3655 Lisp_Object sym
, val
;
3656 sym
= intern (namestring
);
3657 val
= allocate_misc ();
3658 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3659 XOBJFWD (val
)->objvar
= address
;
3660 SET_SYMBOL_VALUE (sym
, val
);
3664 defvar_lisp (namestring
, address
)
3666 Lisp_Object
*address
;
3668 defvar_lisp_nopro (namestring
, address
);
3669 staticpro (address
);
3672 /* Similar but define a variable whose value is the Lisp Object stored in
3673 the current buffer. address is the address of the slot in the buffer
3674 that is current now. */
3677 defvar_per_buffer (namestring
, address
, type
, doc
)
3679 Lisp_Object
*address
;
3683 Lisp_Object sym
, val
;
3686 sym
= intern (namestring
);
3687 val
= allocate_misc ();
3688 offset
= (char *)address
- (char *)current_buffer
;
3690 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3691 XBUFFER_OBJFWD (val
)->offset
= offset
;
3692 SET_SYMBOL_VALUE (sym
, val
);
3693 PER_BUFFER_SYMBOL (offset
) = sym
;
3694 PER_BUFFER_TYPE (offset
) = type
;
3696 if (PER_BUFFER_IDX (offset
) == 0)
3697 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3698 slot of buffer_local_flags */
3703 /* Similar but define a variable whose value is the Lisp Object stored
3704 at a particular offset in the current kboard object. */
3707 defvar_kboard (namestring
, offset
)
3711 Lisp_Object sym
, val
;
3712 sym
= intern (namestring
);
3713 val
= allocate_misc ();
3714 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3715 XKBOARD_OBJFWD (val
)->offset
= offset
;
3716 SET_SYMBOL_VALUE (sym
, val
);
3719 /* Record the value of load-path used at the start of dumping
3720 so we can see if the site changed it later during dumping. */
3721 static Lisp_Object dump_path
;
3727 int turn_off_warning
= 0;
3729 /* Compute the default load-path. */
3731 normal
= PATH_LOADSEARCH
;
3732 Vload_path
= decode_env_path (0, normal
);
3734 if (NILP (Vpurify_flag
))
3735 normal
= PATH_LOADSEARCH
;
3737 normal
= PATH_DUMPLOADSEARCH
;
3739 /* In a dumped Emacs, we normally have to reset the value of
3740 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3741 uses ../lisp, instead of the path of the installed elisp
3742 libraries. However, if it appears that Vload_path was changed
3743 from the default before dumping, don't override that value. */
3746 if (! NILP (Fequal (dump_path
, Vload_path
)))
3748 Vload_path
= decode_env_path (0, normal
);
3749 if (!NILP (Vinstallation_directory
))
3751 Lisp_Object tem
, tem1
, sitelisp
;
3753 /* Remove site-lisp dirs from path temporarily and store
3754 them in sitelisp, then conc them on at the end so
3755 they're always first in path. */
3759 tem
= Fcar (Vload_path
);
3760 tem1
= Fstring_match (build_string ("site-lisp"),
3764 Vload_path
= Fcdr (Vload_path
);
3765 sitelisp
= Fcons (tem
, sitelisp
);
3771 /* Add to the path the lisp subdir of the
3772 installation dir, if it exists. */
3773 tem
= Fexpand_file_name (build_string ("lisp"),
3774 Vinstallation_directory
);
3775 tem1
= Ffile_exists_p (tem
);
3778 if (NILP (Fmember (tem
, Vload_path
)))
3780 turn_off_warning
= 1;
3781 Vload_path
= Fcons (tem
, Vload_path
);
3785 /* That dir doesn't exist, so add the build-time
3786 Lisp dirs instead. */
3787 Vload_path
= nconc2 (Vload_path
, dump_path
);
3789 /* Add leim under the installation dir, if it exists. */
3790 tem
= Fexpand_file_name (build_string ("leim"),
3791 Vinstallation_directory
);
3792 tem1
= Ffile_exists_p (tem
);
3795 if (NILP (Fmember (tem
, Vload_path
)))
3796 Vload_path
= Fcons (tem
, Vload_path
);
3799 /* Add site-list under the installation dir, if it exists. */
3800 tem
= Fexpand_file_name (build_string ("site-lisp"),
3801 Vinstallation_directory
);
3802 tem1
= Ffile_exists_p (tem
);
3805 if (NILP (Fmember (tem
, Vload_path
)))
3806 Vload_path
= Fcons (tem
, Vload_path
);
3809 /* If Emacs was not built in the source directory,
3810 and it is run from where it was built, add to load-path
3811 the lisp, leim and site-lisp dirs under that directory. */
3813 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3817 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3818 Vinstallation_directory
);
3819 tem1
= Ffile_exists_p (tem
);
3821 /* Don't be fooled if they moved the entire source tree
3822 AFTER dumping Emacs. If the build directory is indeed
3823 different from the source dir, src/Makefile.in and
3824 src/Makefile will not be found together. */
3825 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3826 Vinstallation_directory
);
3827 tem2
= Ffile_exists_p (tem
);
3828 if (!NILP (tem1
) && NILP (tem2
))
3830 tem
= Fexpand_file_name (build_string ("lisp"),
3833 if (NILP (Fmember (tem
, Vload_path
)))
3834 Vload_path
= Fcons (tem
, Vload_path
);
3836 tem
= Fexpand_file_name (build_string ("leim"),
3839 if (NILP (Fmember (tem
, Vload_path
)))
3840 Vload_path
= Fcons (tem
, Vload_path
);
3842 tem
= Fexpand_file_name (build_string ("site-lisp"),
3845 if (NILP (Fmember (tem
, Vload_path
)))
3846 Vload_path
= Fcons (tem
, Vload_path
);
3849 if (!NILP (sitelisp
))
3850 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3856 /* NORMAL refers to the lisp dir in the source directory. */
3857 /* We used to add ../lisp at the front here, but
3858 that caused trouble because it was copied from dump_path
3859 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3860 It should be unnecessary. */
3861 Vload_path
= decode_env_path (0, normal
);
3862 dump_path
= Vload_path
;
3866 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3867 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3868 almost never correct, thereby causing a warning to be printed out that
3869 confuses users. Since PATH_LOADSEARCH is always overridden by the
3870 EMACSLOADPATH environment variable below, disable the warning on NT.
3871 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3872 the "standard" paths may not exist and would be overridden by
3873 EMACSLOADPATH as on NT. Since this depends on how the executable
3874 was build and packaged, turn off the warnings in general */
3876 /* Warn if dirs in the *standard* path don't exist. */
3877 if (!turn_off_warning
)
3879 Lisp_Object path_tail
;
3881 for (path_tail
= Vload_path
;
3883 path_tail
= XCDR (path_tail
))
3885 Lisp_Object dirfile
;
3886 dirfile
= Fcar (path_tail
);
3887 if (STRINGP (dirfile
))
3889 dirfile
= Fdirectory_file_name (dirfile
);
3890 if (access (SDATA (dirfile
), 0) < 0)
3891 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3896 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3898 /* If the EMACSLOADPATH environment variable is set, use its value.
3899 This doesn't apply if we're dumping. */
3901 if (NILP (Vpurify_flag
)
3902 && egetenv ("EMACSLOADPATH"))
3904 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3908 load_in_progress
= 0;
3909 Vload_file_name
= Qnil
;
3911 load_descriptor_list
= Qnil
;
3913 Vstandard_input
= Qt
;
3914 Vloads_in_progress
= Qnil
;
3917 /* Print a warning, using format string FORMAT, that directory DIRNAME
3918 does not exist. Print it on stderr and put it in *Message*. */
3921 dir_warning (format
, dirname
)
3923 Lisp_Object dirname
;
3926 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3928 fprintf (stderr
, format
, SDATA (dirname
));
3929 sprintf (buffer
, format
, SDATA (dirname
));
3930 /* Don't log the warning before we've initialized!! */
3932 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3939 defsubr (&Sread_from_string
);
3941 defsubr (&Sintern_soft
);
3942 defsubr (&Sunintern
);
3943 defsubr (&Sget_load_suffixes
);
3945 defsubr (&Seval_buffer
);
3946 defsubr (&Seval_region
);
3947 defsubr (&Sread_char
);
3948 defsubr (&Sread_char_exclusive
);
3949 defsubr (&Sread_event
);
3950 defsubr (&Sget_file_char
);
3951 defsubr (&Smapatoms
);
3952 defsubr (&Slocate_file_internal
);
3954 DEFVAR_LISP ("obarray", &Vobarray
,
3955 doc
: /* Symbol table for use by `intern' and `read'.
3956 It is a vector whose length ought to be prime for best results.
3957 The vector's contents don't make sense if examined from Lisp programs;
3958 to find all the symbols in an obarray, use `mapatoms'. */);
3960 DEFVAR_LISP ("values", &Vvalues
,
3961 doc
: /* List of values of all expressions which were read, evaluated and printed.
3962 Order is reverse chronological. */);
3964 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3965 doc
: /* Stream for read to get input from.
3966 See documentation of `read' for possible values. */);
3967 Vstandard_input
= Qt
;
3969 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3970 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3972 If this variable is a buffer, then only forms read from that buffer
3973 will be added to `read-symbol-positions-list'.
3974 If this variable is t, then all read forms will be added.
3975 The effect of all other values other than nil are not currently
3976 defined, although they may be in the future.
3978 The positions are relative to the last call to `read' or
3979 `read-from-string'. It is probably a bad idea to set this variable at
3980 the toplevel; bind it instead. */);
3981 Vread_with_symbol_positions
= Qnil
;
3983 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3984 doc
: /* A list mapping read symbols to their positions.
3985 This variable is modified during calls to `read' or
3986 `read-from-string', but only when `read-with-symbol-positions' is
3989 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3990 CHAR-POSITION is an integer giving the offset of that occurrence of the
3991 symbol from the position where `read' or `read-from-string' started.
3993 Note that a symbol will appear multiple times in this list, if it was
3994 read multiple times. The list is in the same order as the symbols
3996 Vread_symbol_positions_list
= Qnil
;
3998 DEFVAR_LISP ("load-path", &Vload_path
,
3999 doc
: /* *List of directories to search for files to load.
4000 Each element is a string (directory name) or nil (try default directory).
4001 Initialized based on EMACSLOADPATH environment variable, if any,
4002 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4004 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4005 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4006 This list should not include the empty string.
4007 `load' and related functions try to append these suffixes, in order,
4008 to the specified file name if a Lisp suffix is allowed or required. */);
4009 Vload_suffixes
= Fcons (build_string (".elc"),
4010 Fcons (build_string (".el"), Qnil
));
4011 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4012 doc
: /* List of suffixes that indicate representations of \
4014 This list should normally start with the empty string.
4016 Enabling Auto Compression mode appends the suffixes in
4017 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4018 mode removes them again. `load' and related functions use this list to
4019 determine whether they should look for compressed versions of a file
4020 and, if so, which suffixes they should try to append to the file name
4021 in order to do so. However, if you want to customize which suffixes
4022 the loading functions recognize as compression suffixes, you should
4023 customize `jka-compr-load-suffixes' rather than the present variable. */);
4024 /* We don't use empty_string because it's not initialized yet. */
4025 Vload_file_rep_suffixes
= Fcons (build_string (""), Qnil
);
4027 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4028 doc
: /* Non-nil iff inside of `load'. */);
4030 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4031 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4032 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4034 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4035 a symbol \(a feature name).
4037 When `load' is run and the file-name argument matches an element's
4038 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4039 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4041 An error in FORMS does not undo the load, but does prevent execution of
4042 the rest of the FORMS. */);
4043 Vafter_load_alist
= Qnil
;
4045 DEFVAR_LISP ("load-history", &Vload_history
,
4046 doc
: /* Alist mapping file names to symbols and features.
4047 Each alist element is a list that starts with a file name,
4048 except for one element (optional) that starts with nil and describes
4049 definitions evaluated from buffers not visiting files.
4051 The file name is absolute and is the true file name (i.e. it doesn't
4052 contain symbolic links) of the loaded file.
4054 The remaining elements of each list are symbols defined as variables
4055 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4056 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
4057 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
4058 and means that SYMBOL was an autoload before this file redefined it
4061 During preloading, the file name recorded is relative to the main Lisp
4062 directory. These file names are converted to absolute at startup. */);
4063 Vload_history
= Qnil
;
4065 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4066 doc
: /* Full name of file being loaded by `load'. */);
4067 Vload_file_name
= Qnil
;
4069 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4070 doc
: /* File name, including directory, of user's initialization file.
4071 If the file loaded had extension `.elc', and the corresponding source file
4072 exists, this variable contains the name of source file, suitable for use
4073 by functions like `custom-save-all' which edit the init file. */);
4074 Vuser_init_file
= Qnil
;
4076 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4077 doc
: /* Used for internal purposes by `load'. */);
4078 Vcurrent_load_list
= Qnil
;
4080 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4081 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4082 The default is nil, which means use the function `read'. */);
4083 Vload_read_function
= Qnil
;
4085 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4086 doc
: /* Function called in `load' for loading an Emacs lisp source file.
4087 This function is for doing code conversion before reading the source file.
4088 If nil, loading is done without any code conversion.
4089 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4090 FULLNAME is the full name of FILE.
4091 See `load' for the meaning of the remaining arguments. */);
4092 Vload_source_file_function
= Qnil
;
4094 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4095 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4096 This is useful when the file being loaded is a temporary copy. */);
4097 load_force_doc_strings
= 0;
4099 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4100 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4101 This is normally bound by `load' and `eval-buffer' to control `read',
4102 and is not meant for users to change. */);
4103 load_convert_to_unibyte
= 0;
4105 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4106 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4107 You cannot count on them to still be there! */);
4109 = Fexpand_file_name (build_string ("../"),
4110 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4112 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4113 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4114 Vpreloaded_file_list
= Qnil
;
4116 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4117 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4118 Vbyte_boolean_vars
= Qnil
;
4120 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4121 doc
: /* Non-nil means load dangerous compiled Lisp files.
4122 Some versions of XEmacs use different byte codes than Emacs. These
4123 incompatible byte codes can make Emacs crash when it tries to execute
4125 load_dangerous_libraries
= 0;
4127 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4128 doc
: /* Regular expression matching safe to load compiled Lisp files.
4129 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4130 from the file, and matches them against this regular expression.
4131 When the regular expression matches, the file is considered to be safe
4132 to load. See also `load-dangerous-libraries'. */);
4133 Vbytecomp_version_regexp
4134 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4136 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4137 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4138 Veval_buffer_list
= Qnil
;
4140 /* Vsource_directory was initialized in init_lread. */
4142 load_descriptor_list
= Qnil
;
4143 staticpro (&load_descriptor_list
);
4145 Qcurrent_load_list
= intern ("current-load-list");
4146 staticpro (&Qcurrent_load_list
);
4148 Qstandard_input
= intern ("standard-input");
4149 staticpro (&Qstandard_input
);
4151 Qread_char
= intern ("read-char");
4152 staticpro (&Qread_char
);
4154 Qget_file_char
= intern ("get-file-char");
4155 staticpro (&Qget_file_char
);
4157 Qbackquote
= intern ("`");
4158 staticpro (&Qbackquote
);
4159 Qcomma
= intern (",");
4160 staticpro (&Qcomma
);
4161 Qcomma_at
= intern (",@");
4162 staticpro (&Qcomma_at
);
4163 Qcomma_dot
= intern (",.");
4164 staticpro (&Qcomma_dot
);
4166 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4167 staticpro (&Qinhibit_file_name_operation
);
4169 Qascii_character
= intern ("ascii-character");
4170 staticpro (&Qascii_character
);
4172 Qfunction
= intern ("function");
4173 staticpro (&Qfunction
);
4175 Qload
= intern ("load");
4178 Qload_file_name
= intern ("load-file-name");
4179 staticpro (&Qload_file_name
);
4181 Qeval_buffer_list
= intern ("eval-buffer-list");
4182 staticpro (&Qeval_buffer_list
);
4184 Qfile_truename
= intern ("file-truename");
4185 staticpro (&Qfile_truename
) ;
4187 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4188 staticpro (&Qdo_after_load_evaluation
) ;
4190 staticpro (&dump_path
);
4192 staticpro (&read_objects
);
4193 read_objects
= Qnil
;
4194 staticpro (&seen_list
);
4197 Vloads_in_progress
= Qnil
;
4198 staticpro (&Vloads_in_progress
);
4201 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4202 (do not change this comment) */