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
));
217 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
218 static void end_of_file_error
P_ (()) NO_RETURN
;
221 /* Handle unreading and rereading of characters.
222 Write READCHAR to read a character,
223 UNREAD(c) to unread c to be read again.
225 The READCHAR and UNREAD macros are meant for reading/unreading a
226 byte code; they do not handle multibyte characters. The caller
227 should manage them if necessary.
229 [ Actually that seems to be a lie; READCHAR will definitely read
230 multibyte characters from buffer sources, at least. Is the
231 comment just out of date?
232 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
235 #define READCHAR readchar (readcharfun)
236 #define UNREAD(c) unreadchar (readcharfun, c)
239 readchar (readcharfun
)
240 Lisp_Object readcharfun
;
247 if (BUFFERP (readcharfun
))
249 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
251 int pt_byte
= BUF_PT_BYTE (inbuffer
);
252 int orig_pt_byte
= pt_byte
;
254 if (readchar_backlog
> 0)
255 /* We get the address of the byte just passed,
256 which is the last byte of the character.
257 The other bytes in this character are consecutive with it,
258 because the gap can't be in the middle of a character. */
259 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
260 - --readchar_backlog
);
262 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
265 readchar_backlog
= -1;
267 if (! NILP (inbuffer
->enable_multibyte_characters
))
269 /* Fetch the character code from the buffer. */
270 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
271 BUF_INC_POS (inbuffer
, pt_byte
);
272 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
276 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
279 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
283 if (MARKERP (readcharfun
))
285 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
287 int bytepos
= marker_byte_position (readcharfun
);
288 int orig_bytepos
= bytepos
;
290 if (readchar_backlog
> 0)
291 /* We get the address of the byte just passed,
292 which is the last byte of the character.
293 The other bytes in this character are consecutive with it,
294 because the gap can't be in the middle of a character. */
295 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
296 - --readchar_backlog
);
298 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
301 readchar_backlog
= -1;
303 if (! NILP (inbuffer
->enable_multibyte_characters
))
305 /* Fetch the character code from the buffer. */
306 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
307 BUF_INC_POS (inbuffer
, bytepos
);
308 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
312 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
316 XMARKER (readcharfun
)->bytepos
= bytepos
;
317 XMARKER (readcharfun
)->charpos
++;
322 if (EQ (readcharfun
, Qlambda
))
323 return read_bytecode_char (0);
325 if (EQ (readcharfun
, Qget_file_char
))
329 /* Interrupted reads have been observed while reading over the network */
330 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
340 if (STRINGP (readcharfun
))
342 if (read_from_string_index
>= read_from_string_limit
)
345 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
346 read_from_string_index
,
347 read_from_string_index_byte
);
352 tem
= call0 (readcharfun
);
359 /* Unread the character C in the way appropriate for the stream READCHARFUN.
360 If the stream is a user function, call it with the char as argument. */
363 unreadchar (readcharfun
, c
)
364 Lisp_Object readcharfun
;
369 /* Don't back up the pointer if we're unreading the end-of-input mark,
370 since readchar didn't advance it when we read it. */
372 else if (BUFFERP (readcharfun
))
374 struct buffer
*b
= XBUFFER (readcharfun
);
375 int bytepos
= BUF_PT_BYTE (b
);
377 if (readchar_backlog
>= 0)
382 if (! NILP (b
->enable_multibyte_characters
))
383 BUF_DEC_POS (b
, bytepos
);
387 BUF_PT_BYTE (b
) = bytepos
;
390 else if (MARKERP (readcharfun
))
392 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
393 int bytepos
= XMARKER (readcharfun
)->bytepos
;
395 if (readchar_backlog
>= 0)
399 XMARKER (readcharfun
)->charpos
--;
400 if (! NILP (b
->enable_multibyte_characters
))
401 BUF_DEC_POS (b
, bytepos
);
405 XMARKER (readcharfun
)->bytepos
= bytepos
;
408 else if (STRINGP (readcharfun
))
410 read_from_string_index
--;
411 read_from_string_index_byte
412 = string_char_to_byte (readcharfun
, read_from_string_index
);
414 else if (EQ (readcharfun
, Qlambda
))
415 read_bytecode_char (1);
416 else if (EQ (readcharfun
, Qget_file_char
))
417 ungetc (c
, instream
);
419 call1 (readcharfun
, make_number (c
));
422 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
424 static Lisp_Object read0
P_ ((Lisp_Object
));
425 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
427 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
428 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
429 static int read_multibyte
P_ ((int, Lisp_Object
));
431 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
433 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
435 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
438 /* Get a character from the tty. */
440 extern Lisp_Object
read_char ();
442 /* Read input events until we get one that's acceptable for our purposes.
444 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
445 until we get a character we like, and then stuffed into
448 If ASCII_REQUIRED is non-zero, we check function key events to see
449 if the unmodified version of the symbol has a Qascii_character
450 property, and use that character, if present.
452 If ERROR_NONASCII is non-zero, we signal an error if the input we
453 get isn't an ASCII character with modifiers. If it's zero but
454 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
457 If INPUT_METHOD is nonzero, we invoke the current input method
458 if the character warrants that. */
461 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
463 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
465 Lisp_Object val
, delayed_switch_frame
;
467 #ifdef HAVE_WINDOW_SYSTEM
468 if (display_hourglass_p
)
472 delayed_switch_frame
= Qnil
;
474 /* Read until we get an acceptable event. */
476 val
= read_char (0, 0, 0,
477 (input_method
? Qnil
: Qt
),
483 /* switch-frame events are put off until after the next ASCII
484 character. This is better than signaling an error just because
485 the last characters were typed to a separate minibuffer frame,
486 for example. Eventually, some code which can deal with
487 switch-frame events will read it and process it. */
489 && EVENT_HAS_PARAMETERS (val
)
490 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
492 delayed_switch_frame
= val
;
498 /* Convert certain symbols to their ASCII equivalents. */
501 Lisp_Object tem
, tem1
;
502 tem
= Fget (val
, Qevent_symbol_element_mask
);
505 tem1
= Fget (Fcar (tem
), Qascii_character
);
506 /* Merge this symbol's modifier bits
507 with the ASCII equivalent of its basic code. */
509 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
513 /* If we don't have a character now, deal with it appropriately. */
518 Vunread_command_events
= Fcons (val
, Qnil
);
519 error ("Non-character input-event");
526 if (! NILP (delayed_switch_frame
))
527 unread_switch_frame
= delayed_switch_frame
;
531 #ifdef HAVE_WINDOW_SYSTEM
532 if (display_hourglass_p
)
541 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
542 doc
: /* Read a character from the command input (keyboard or macro).
543 It is returned as a number.
544 If the user generates an event which is not a character (i.e. a mouse
545 click or function key event), `read-char' signals an error. As an
546 exception, switch-frame events are put off until non-ASCII events can
548 If you want to read non-character events, or ignore them, call
549 `read-event' or `read-char-exclusive' instead.
551 If the optional argument PROMPT is non-nil, display that as a prompt.
552 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
553 input method is turned on in the current buffer, that input method
554 is used for reading a character. */)
555 (prompt
, inherit_input_method
)
556 Lisp_Object prompt
, inherit_input_method
;
559 message_with_string ("%s", prompt
, 0);
560 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
563 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
564 doc
: /* Read an event object from the input stream.
565 If the optional argument PROMPT is non-nil, display that as a prompt.
566 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
567 input method is turned on in the current buffer, that input method
568 is used for reading a character. */)
569 (prompt
, inherit_input_method
)
570 Lisp_Object prompt
, inherit_input_method
;
573 message_with_string ("%s", prompt
, 0);
574 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
577 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
578 doc
: /* Read a character from the command input (keyboard or macro).
579 It is returned as a number. Non-character events are ignored.
581 If the optional argument PROMPT is non-nil, display that as a prompt.
582 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
583 input method is turned on in the current buffer, that input method
584 is used for reading a character. */)
585 (prompt
, inherit_input_method
)
586 Lisp_Object prompt
, inherit_input_method
;
589 message_with_string ("%s", prompt
, 0);
590 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
593 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
594 doc
: /* Don't use this yourself. */)
597 register Lisp_Object val
;
598 XSETINT (val
, getc (instream
));
604 /* Value is non-zero if the file asswociated with file descriptor FD
605 is a compiled Lisp file that's safe to load. Only files compiled
606 with Emacs are safe to load. Files compiled with XEmacs can lead
607 to a crash in Fbyte_code because of an incompatible change in the
618 /* Read the first few bytes from the file, and look for a line
619 specifying the byte compiler version used. */
620 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
625 /* Skip to the next newline, skipping over the initial `ELC'
626 with NUL bytes following it. */
627 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
631 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
636 lseek (fd
, 0, SEEK_SET
);
641 /* Callback for record_unwind_protect. Restore the old load list OLD,
642 after loading a file successfully. */
645 record_load_unwind (old
)
648 return Vloads_in_progress
= old
;
651 /* This handler function is used via internal_condition_case_1. */
654 load_error_handler (data
)
660 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
661 doc
: /* Return the suffixes that `load' should try if a suffix is \
663 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
666 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
667 while (CONSP (suffixes
))
669 Lisp_Object exts
= Vload_file_rep_suffixes
;
670 suffix
= XCAR (suffixes
);
671 suffixes
= XCDR (suffixes
);
676 lst
= Fcons (concat2 (suffix
, ext
), lst
);
679 return Fnreverse (lst
);
682 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
683 doc
: /* Execute a file of Lisp code named FILE.
684 First try FILE with `.elc' appended, then try with `.el',
685 then try FILE unmodified (the exact suffixes in the exact order are
686 determined by `load-suffixes'). Environment variable references in
687 FILE are replaced with their values by calling `substitute-in-file-name'.
688 This function searches the directories in `load-path'.
690 If optional second arg NOERROR is non-nil,
691 report no error if FILE doesn't exist.
692 Print messages at start and end of loading unless
693 optional third arg NOMESSAGE is non-nil.
694 If optional fourth arg NOSUFFIX is non-nil, don't try adding
695 suffixes `.elc' or `.el' to the specified name FILE.
696 If optional fifth arg MUST-SUFFIX is non-nil, insist on
697 the suffix `.elc' or `.el'; don't accept just FILE unless
698 it ends in one of those suffixes or includes a directory name.
700 If this function fails to find a file, it may look for different
701 representations of that file before trying another file.
702 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
703 to the file name. Emacs uses this feature mainly to find compressed
704 versions of files when Auto Compression mode is enabled.
706 The exact suffixes that this function tries out, in the exact order,
707 are given by the value of the variable `load-file-rep-suffixes' if
708 NOSUFFIX is non-nil and by the return value of the function
709 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
710 MUST-SUFFIX are nil, this function first tries out the latter suffixes
713 Loading a file records its definitions, and its `provide' and
714 `require' calls, in an element of `load-history' whose
715 car is the file name loaded. See `load-history'.
717 Return t if the file exists and loads successfully. */)
718 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
719 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
721 register FILE *stream
;
722 register int fd
= -1;
723 int count
= SPECPDL_INDEX ();
725 struct gcpro gcpro1
, gcpro2
, gcpro3
;
726 Lisp_Object found
, efound
, hist_file_name
;
727 /* 1 means we printed the ".el is newer" message. */
729 /* 1 means we are loading a compiled file. */
741 /* If file name is magic, call the handler. */
742 /* This shouldn't be necessary any more now that `openp' handles it right.
743 handler = Ffind_file_name_handler (file, Qload);
745 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
747 /* Do this after the handler to avoid
748 the need to gcpro noerror, nomessage and nosuffix.
749 (Below here, we care only whether they are nil or not.)
750 The presence of this call is the result of a historical accident:
751 it used to be in every file-operation and when it got removed
752 everywhere, it accidentally stayed here. Since then, enough people
753 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
754 that it seemed risky to remove. */
755 if (! NILP (noerror
))
757 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
758 Qt
, load_error_handler
);
763 file
= Fsubstitute_in_file_name (file
);
766 /* Avoid weird lossage with null string as arg,
767 since it would try to load a directory as a Lisp file */
768 if (SCHARS (file
) > 0)
770 int size
= SBYTES (file
);
773 GCPRO2 (file
, found
);
775 if (! NILP (must_suffix
))
777 /* Don't insist on adding a suffix if FILE already ends with one. */
779 && !strcmp (SDATA (file
) + size
- 3, ".el"))
782 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
784 /* Don't insist on adding a suffix
785 if the argument includes a directory name. */
786 else if (! NILP (Ffile_name_directory (file
)))
790 fd
= openp (Vload_path
, file
,
791 (!NILP (nosuffix
) ? Qnil
792 : !NILP (must_suffix
) ? Fget_load_suffixes ()
793 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
794 tmp
[1] = Vload_file_rep_suffixes
,
803 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
807 /* Tell startup.el whether or not we found the user's init file. */
808 if (EQ (Qt
, Vuser_init_file
))
809 Vuser_init_file
= found
;
811 /* If FD is -2, that means openp found a magic file. */
814 if (NILP (Fequal (found
, file
)))
815 /* If FOUND is a different file name from FILE,
816 find its handler even if we have already inhibited
817 the `load' operation on FILE. */
818 handler
= Ffind_file_name_handler (found
, Qt
);
820 handler
= Ffind_file_name_handler (found
, Qload
);
821 if (! NILP (handler
))
822 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
825 /* Check if we're stuck in a recursive load cycle.
827 2000-09-21: It's not possible to just check for the file loaded
828 being a member of Vloads_in_progress. This fails because of the
829 way the byte compiler currently works; `provide's are not
830 evaluted, see font-lock.el/jit-lock.el as an example. This
831 leads to a certain amount of ``normal'' recursion.
833 Also, just loading a file recursively is not always an error in
834 the general case; the second load may do something different. */
838 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
839 if (!NILP (Fequal (found
, XCAR (tem
))))
845 signal_error ("Recursive load", 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 xsignal1 (Qend_of_file
, Vload_file_name
);
1344 xsignal0 (Qend_of_file
);
1347 /* UNIBYTE specifies how to set load_convert_to_unibyte
1348 for this invocation.
1349 READFUN, if non-nil, is used instead of `read'.
1351 START, END specify region to read in current buffer (from eval-region).
1352 If the input is not from a buffer, they must be nil. */
1355 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1356 printflag
, unibyte
, readfun
, start
, end
)
1357 Lisp_Object readcharfun
;
1359 Lisp_Object sourcename
;
1360 Lisp_Object (*evalfun
) ();
1362 Lisp_Object unibyte
, readfun
;
1363 Lisp_Object start
, end
;
1366 register Lisp_Object val
;
1367 int count
= SPECPDL_INDEX ();
1368 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1369 struct buffer
*b
= 0;
1370 int continue_reading_p
;
1371 /* Nonzero if reading an entire buffer. */
1372 int whole_buffer
= 0;
1373 /* 1 on the first time around. */
1376 if (MARKERP (readcharfun
))
1379 start
= readcharfun
;
1382 if (BUFFERP (readcharfun
))
1383 b
= XBUFFER (readcharfun
);
1384 else if (MARKERP (readcharfun
))
1385 b
= XMARKER (readcharfun
)->buffer
;
1387 /* We assume START is nil when input is not from a buffer. */
1388 if (! NILP (start
) && !b
)
1391 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1392 specbind (Qcurrent_load_list
, Qnil
);
1393 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1394 load_convert_to_unibyte
= !NILP (unibyte
);
1396 readchar_backlog
= -1;
1398 GCPRO4 (sourcename
, readfun
, start
, end
);
1400 /* Try to ensure sourcename is a truename, except whilst preloading. */
1401 if (NILP (Vpurify_flag
)
1402 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1403 && !NILP (Ffboundp (Qfile_truename
)))
1404 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1406 LOADHIST_ATTACH (sourcename
);
1408 continue_reading_p
= 1;
1409 while (continue_reading_p
)
1411 int count1
= SPECPDL_INDEX ();
1413 if (b
!= 0 && NILP (b
->name
))
1414 error ("Reading from killed buffer");
1418 /* Switch to the buffer we are reading from. */
1419 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1420 set_buffer_internal (b
);
1422 /* Save point in it. */
1423 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1424 /* Save ZV in it. */
1425 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1426 /* Those get unbound after we read one expression. */
1428 /* Set point and ZV around stuff to be read. */
1431 Fnarrow_to_region (make_number (BEGV
), end
);
1433 /* Just for cleanliness, convert END to a marker
1434 if it is an integer. */
1436 end
= Fpoint_max_marker ();
1439 /* On the first cycle, we can easily test here
1440 whether we are reading the whole buffer. */
1441 if (b
&& first_sexp
)
1442 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1449 while ((c
= READCHAR
) != '\n' && c
!= -1);
1454 unbind_to (count1
, Qnil
);
1458 /* Ignore whitespace here, so we can detect eof. */
1459 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1462 if (!NILP (Vpurify_flag
) && c
== '(')
1464 record_unwind_protect (unreadpure
, Qnil
);
1465 val
= read_list (-1, readcharfun
);
1470 read_objects
= Qnil
;
1471 if (!NILP (readfun
))
1473 val
= call1 (readfun
, readcharfun
);
1475 /* If READCHARFUN has set point to ZV, we should
1476 stop reading, even if the form read sets point
1477 to a different value when evaluated. */
1478 if (BUFFERP (readcharfun
))
1480 struct buffer
*b
= XBUFFER (readcharfun
);
1481 if (BUF_PT (b
) == BUF_ZV (b
))
1482 continue_reading_p
= 0;
1485 else if (! NILP (Vload_read_function
))
1486 val
= call1 (Vload_read_function
, readcharfun
);
1488 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1491 if (!NILP (start
) && continue_reading_p
)
1492 start
= Fpoint_marker ();
1494 /* Restore saved point and BEGV. */
1495 unbind_to (count1
, Qnil
);
1497 /* Now eval what we just read. */
1498 val
= (*evalfun
) (val
);
1502 Vvalues
= Fcons (val
, Vvalues
);
1503 if (EQ (Vstandard_output
, Qt
))
1512 build_load_history (sourcename
,
1513 stream
|| whole_buffer
);
1517 unbind_to (count
, Qnil
);
1520 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1521 doc
: /* Execute the current buffer as Lisp code.
1522 Programs can pass two arguments, BUFFER and PRINTFLAG.
1523 BUFFER is the buffer to evaluate (nil means use current buffer).
1524 PRINTFLAG controls printing of output:
1525 nil means discard it; anything else is stream for print.
1527 If the optional third argument FILENAME is non-nil,
1528 it specifies the file name to use for `load-history'.
1529 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1530 for this invocation.
1532 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1533 `print' and related functions should work normally even if PRINTFLAG is nil.
1535 This function preserves the position of point. */)
1536 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1537 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1539 int count
= SPECPDL_INDEX ();
1540 Lisp_Object tem
, buf
;
1543 buf
= Fcurrent_buffer ();
1545 buf
= Fget_buffer (buffer
);
1547 error ("No such buffer");
1549 if (NILP (printflag
) && NILP (do_allow_print
))
1554 if (NILP (filename
))
1555 filename
= XBUFFER (buf
)->filename
;
1557 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1558 specbind (Qstandard_output
, tem
);
1559 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1560 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1561 readevalloop (buf
, 0, filename
, Feval
,
1562 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1563 unbind_to (count
, Qnil
);
1568 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1569 doc
: /* Execute the region as Lisp code.
1570 When called from programs, expects two arguments,
1571 giving starting and ending indices in the current buffer
1572 of the text to be executed.
1573 Programs can pass third argument PRINTFLAG which controls output:
1574 nil means discard it; anything else is stream for printing it.
1575 Also the fourth argument READ-FUNCTION, if non-nil, is used
1576 instead of `read' to read each expression. It gets one argument
1577 which is the input stream for reading characters.
1579 This function does not move point. */)
1580 (start
, end
, printflag
, read_function
)
1581 Lisp_Object start
, end
, printflag
, read_function
;
1583 int count
= SPECPDL_INDEX ();
1584 Lisp_Object tem
, cbuf
;
1586 cbuf
= Fcurrent_buffer ();
1588 if (NILP (printflag
))
1592 specbind (Qstandard_output
, tem
);
1593 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1595 /* readevalloop calls functions which check the type of start and end. */
1596 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1597 !NILP (printflag
), Qnil
, read_function
,
1600 return unbind_to (count
, Qnil
);
1604 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1605 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1606 If STREAM is nil, use the value of `standard-input' (which see).
1607 STREAM or the value of `standard-input' may be:
1608 a buffer (read from point and advance it)
1609 a marker (read from where it points and advance it)
1610 a function (call it with no arguments for each character,
1611 call it with a char as argument to push a char back)
1612 a string (takes text from string, starting at the beginning)
1613 t (read text line using minibuffer and use it, or read from
1614 standard input in batch mode). */)
1619 stream
= Vstandard_input
;
1620 if (EQ (stream
, Qt
))
1621 stream
= Qread_char
;
1622 if (EQ (stream
, Qread_char
))
1623 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1625 return read_internal_start (stream
, Qnil
, Qnil
);
1628 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1629 doc
: /* Read one Lisp expression which is represented as text by STRING.
1630 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1631 START and END optionally delimit a substring of STRING from which to read;
1632 they default to 0 and (length STRING) respectively. */)
1633 (string
, start
, end
)
1634 Lisp_Object string
, start
, end
;
1637 CHECK_STRING (string
);
1638 /* read_internal_start sets read_from_string_index. */
1639 ret
= read_internal_start (string
, start
, end
);
1640 return Fcons (ret
, make_number (read_from_string_index
));
1643 /* Function to set up the global context we need in toplevel read
1646 read_internal_start (stream
, start
, end
)
1648 Lisp_Object start
; /* Only used when stream is a string. */
1649 Lisp_Object end
; /* Only used when stream is a string. */
1653 readchar_backlog
= -1;
1655 new_backquote_flag
= 0;
1656 read_objects
= Qnil
;
1657 if (EQ (Vread_with_symbol_positions
, Qt
)
1658 || EQ (Vread_with_symbol_positions
, stream
))
1659 Vread_symbol_positions_list
= Qnil
;
1661 if (STRINGP (stream
))
1663 int startval
, endval
;
1665 endval
= SCHARS (stream
);
1669 endval
= XINT (end
);
1670 if (endval
< 0 || endval
> SCHARS (stream
))
1671 args_out_of_range (stream
, end
);
1678 CHECK_NUMBER (start
);
1679 startval
= XINT (start
);
1680 if (startval
< 0 || startval
> endval
)
1681 args_out_of_range (stream
, start
);
1683 read_from_string_index
= startval
;
1684 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1685 read_from_string_limit
= endval
;
1688 retval
= read0 (stream
);
1689 if (EQ (Vread_with_symbol_positions
, Qt
)
1690 || EQ (Vread_with_symbol_positions
, stream
))
1691 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1696 /* Signal Qinvalid_read_syntax error.
1697 S is error string of length N (if > 0) */
1700 invalid_syntax (s
, n
)
1706 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1710 /* Use this for recursive reads, in contexts where internal tokens
1715 Lisp_Object readcharfun
;
1717 register Lisp_Object val
;
1720 val
= read1 (readcharfun
, &c
, 0);
1724 xsignal1 (Qinvalid_read_syntax
,
1725 Fmake_string (make_number (1), make_number (c
)));
1728 static int read_buffer_size
;
1729 static char *read_buffer
;
1731 /* Read multibyte form and return it as a character. C is a first
1732 byte of multibyte form, and rest of them are read from
1736 read_multibyte (c
, readcharfun
)
1738 Lisp_Object readcharfun
;
1740 /* We need the actual character code of this multibyte
1742 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1750 while ((c
= READCHAR
) >= 0xA0
1751 && len
< MAX_MULTIBYTE_LENGTH
)
1757 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1758 return STRING_CHAR (str
, len
);
1759 /* The byte sequence is not valid as multibyte. Unread all bytes
1760 but the first one, and return the first byte. */
1766 /* Read a \-escape sequence, assuming we already read the `\'.
1767 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1768 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1769 Otherwise store 0 into *BYTEREP. */
1772 read_escape (readcharfun
, stringp
, byterep
)
1773 Lisp_Object readcharfun
;
1777 register int c
= READCHAR
;
1778 /* \u allows up to four hex digits, \U up to eight. Default to the
1779 behaviour for \u, and change this value in the case that \U is seen. */
1780 int unicode_hex_count
= 4;
1787 end_of_file_error ();
1817 error ("Invalid escape character syntax");
1820 c
= read_escape (readcharfun
, 0, byterep
);
1821 return c
| meta_modifier
;
1826 error ("Invalid escape character syntax");
1829 c
= read_escape (readcharfun
, 0, byterep
);
1830 return c
| shift_modifier
;
1835 error ("Invalid escape character syntax");
1838 c
= read_escape (readcharfun
, 0, byterep
);
1839 return c
| hyper_modifier
;
1844 error ("Invalid escape character syntax");
1847 c
= read_escape (readcharfun
, 0, byterep
);
1848 return c
| alt_modifier
;
1859 c
= read_escape (readcharfun
, 0, byterep
);
1860 return c
| super_modifier
;
1865 error ("Invalid escape character syntax");
1869 c
= read_escape (readcharfun
, 0, byterep
);
1870 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1871 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1872 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1873 return c
| ctrl_modifier
;
1874 /* ASCII control chars are made from letters (both cases),
1875 as well as the non-letters within 0100...0137. */
1876 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1877 return (c
& (037 | ~0177));
1878 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1879 return (c
& (037 | ~0177));
1881 return c
| ctrl_modifier
;
1891 /* An octal escape, as in ANSI C. */
1893 register int i
= c
- '0';
1894 register int count
= 0;
1897 if ((c
= READCHAR
) >= '0' && c
<= '7')
1914 /* A hex escape, as in ANSI C. */
1920 if (c
>= '0' && c
<= '9')
1925 else if ((c
>= 'a' && c
<= 'f')
1926 || (c
>= 'A' && c
<= 'F'))
1929 if (c
>= 'a' && c
<= 'f')
1946 /* Post-Unicode-2.0: Up to eight hex chars. */
1947 unicode_hex_count
= 8;
1950 /* A Unicode escape. We only permit them in strings and characters,
1951 not arbitrarily in the source code, as in some other languages. */
1955 Lisp_Object lisp_char
;
1956 struct gcpro gcpro1
;
1958 while (++count
<= unicode_hex_count
)
1961 /* isdigit and isalpha may be locale-specific, which we don't
1963 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
1964 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
1965 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
1968 error ("Non-hex digit used for Unicode escape");
1973 GCPRO1 (readcharfun
);
1974 lisp_char
= call2 (intern ("decode-char"), intern ("ucs"),
1978 if (NILP (lisp_char
))
1980 error ("Unsupported Unicode code point: U+%x", (unsigned)i
);
1983 return XFASTINT (lisp_char
);
1987 if (BASE_LEADING_CODE_P (c
))
1988 c
= read_multibyte (c
, readcharfun
);
1993 /* Read an integer in radix RADIX using READCHARFUN to read
1994 characters. RADIX must be in the interval [2..36]; if it isn't, a
1995 read error is signaled . Value is the integer read. Signals an
1996 error if encountering invalid read syntax or if RADIX is out of
2000 read_integer (readcharfun
, radix
)
2001 Lisp_Object readcharfun
;
2004 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2005 EMACS_INT number
= 0;
2007 if (radix
< 2 || radix
> 36)
2011 number
= ndigits
= invalid_p
= 0;
2027 if (c
>= '0' && c
<= '9')
2029 else if (c
>= 'a' && c
<= 'z')
2030 digit
= c
- 'a' + 10;
2031 else if (c
>= 'A' && c
<= 'Z')
2032 digit
= c
- 'A' + 10;
2039 if (digit
< 0 || digit
>= radix
)
2042 number
= radix
* number
+ digit
;
2048 if (ndigits
== 0 || invalid_p
)
2051 sprintf (buf
, "integer, radix %d", radix
);
2052 invalid_syntax (buf
, 0);
2055 return make_number (sign
* number
);
2059 /* Convert unibyte text in read_buffer to multibyte.
2061 Initially, *P is a pointer after the end of the unibyte text, and
2062 the pointer *END points after the end of read_buffer.
2064 If read_buffer doesn't have enough room to hold the result
2065 of the conversion, reallocate it and adjust *P and *END.
2067 At the end, make *P point after the result of the conversion, and
2068 return in *NCHARS the number of characters in the converted
2072 to_multibyte (p
, end
, nchars
)
2078 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
2079 if (read_buffer_size
< 2 * nbytes
)
2081 int offset
= *p
- read_buffer
;
2082 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
2083 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
2084 *p
= read_buffer
+ offset
;
2085 *end
= read_buffer
+ read_buffer_size
;
2088 if (nbytes
!= *nchars
)
2089 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
2090 *p
- read_buffer
, nchars
);
2092 *p
= read_buffer
+ nbytes
;
2096 /* If the next token is ')' or ']' or '.', we store that character
2097 in *PCH and the return value is not interesting. Else, we store
2098 zero in *PCH and we read and return one lisp object.
2100 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2103 read1 (readcharfun
, pch
, first_in_list
)
2104 register Lisp_Object readcharfun
;
2109 int uninterned_symbol
= 0;
2117 end_of_file_error ();
2122 return read_list (0, readcharfun
);
2125 return read_vector (readcharfun
, 0);
2142 tmp
= read_vector (readcharfun
, 0);
2143 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
2144 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
2145 error ("Invalid size char-table");
2146 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2147 XCHAR_TABLE (tmp
)->top
= Qt
;
2156 tmp
= read_vector (readcharfun
, 0);
2157 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2158 error ("Invalid size char-table");
2159 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2160 XCHAR_TABLE (tmp
)->top
= Qnil
;
2163 invalid_syntax ("#^^", 3);
2165 invalid_syntax ("#^", 2);
2170 length
= read1 (readcharfun
, pch
, first_in_list
);
2174 Lisp_Object tmp
, val
;
2176 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2177 / BOOL_VECTOR_BITS_PER_CHAR
);
2180 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2181 if (size_in_chars
!= SCHARS (tmp
)
2182 /* We used to print 1 char too many
2183 when the number of bits was a multiple of 8.
2184 Accept such input in case it came from an old version. */
2185 && ! (XFASTINT (length
)
2186 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2187 invalid_syntax ("#&...", 5);
2189 val
= Fmake_bool_vector (length
, Qnil
);
2190 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2192 /* Clear the extraneous bits in the last byte. */
2193 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2194 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2195 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2198 invalid_syntax ("#&...", 5);
2202 /* Accept compiled functions at read-time so that we don't have to
2203 build them using function calls. */
2205 tmp
= read_vector (readcharfun
, 1);
2206 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2207 XVECTOR (tmp
)->contents
);
2212 struct gcpro gcpro1
;
2215 /* Read the string itself. */
2216 tmp
= read1 (readcharfun
, &ch
, 0);
2217 if (ch
!= 0 || !STRINGP (tmp
))
2218 invalid_syntax ("#", 1);
2220 /* Read the intervals and their properties. */
2223 Lisp_Object beg
, end
, plist
;
2225 beg
= read1 (readcharfun
, &ch
, 0);
2230 end
= read1 (readcharfun
, &ch
, 0);
2232 plist
= read1 (readcharfun
, &ch
, 0);
2234 invalid_syntax ("Invalid string property list", 0);
2235 Fset_text_properties (beg
, end
, plist
, tmp
);
2241 /* #@NUMBER is used to skip NUMBER following characters.
2242 That's used in .elc files to skip over doc strings
2243 and function definitions. */
2248 /* Read a decimal integer. */
2249 while ((c
= READCHAR
) >= 0
2250 && c
>= '0' && c
<= '9')
2258 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2260 /* If we are supposed to force doc strings into core right now,
2261 record the last string that we skipped,
2262 and record where in the file it comes from. */
2264 /* But first exchange saved_doc_string
2265 with prev_saved_doc_string, so we save two strings. */
2267 char *temp
= saved_doc_string
;
2268 int temp_size
= saved_doc_string_size
;
2269 file_offset temp_pos
= saved_doc_string_position
;
2270 int temp_len
= saved_doc_string_length
;
2272 saved_doc_string
= prev_saved_doc_string
;
2273 saved_doc_string_size
= prev_saved_doc_string_size
;
2274 saved_doc_string_position
= prev_saved_doc_string_position
;
2275 saved_doc_string_length
= prev_saved_doc_string_length
;
2277 prev_saved_doc_string
= temp
;
2278 prev_saved_doc_string_size
= temp_size
;
2279 prev_saved_doc_string_position
= temp_pos
;
2280 prev_saved_doc_string_length
= temp_len
;
2283 if (saved_doc_string_size
== 0)
2285 saved_doc_string_size
= nskip
+ 100;
2286 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2288 if (nskip
> saved_doc_string_size
)
2290 saved_doc_string_size
= nskip
+ 100;
2291 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2292 saved_doc_string_size
);
2295 saved_doc_string_position
= file_tell (instream
);
2297 /* Copy that many characters into saved_doc_string. */
2298 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2299 saved_doc_string
[i
] = c
= READCHAR
;
2301 saved_doc_string_length
= i
;
2305 /* Skip that many characters. */
2306 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2314 /* #! appears at the beginning of an executable file.
2315 Skip the first line. */
2316 while (c
!= '\n' && c
>= 0)
2321 return Vload_file_name
;
2323 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2324 /* #:foo is the uninterned symbol named foo. */
2327 uninterned_symbol
= 1;
2331 /* Reader forms that can reuse previously read objects. */
2332 if (c
>= '0' && c
<= '9')
2337 /* Read a non-negative integer. */
2338 while (c
>= '0' && c
<= '9')
2344 /* #n=object returns object, but associates it with n for #n#. */
2347 /* Make a placeholder for #n# to use temporarily */
2348 Lisp_Object placeholder
;
2351 placeholder
= Fcons(Qnil
, Qnil
);
2352 cell
= Fcons (make_number (n
), placeholder
);
2353 read_objects
= Fcons (cell
, read_objects
);
2355 /* Read the object itself. */
2356 tem
= read0 (readcharfun
);
2358 /* Now put it everywhere the placeholder was... */
2359 substitute_object_in_subtree (tem
, placeholder
);
2361 /* ...and #n# will use the real value from now on. */
2362 Fsetcdr (cell
, tem
);
2366 /* #n# returns a previously read object. */
2369 tem
= Fassq (make_number (n
), read_objects
);
2372 /* Fall through to error message. */
2374 else if (c
== 'r' || c
== 'R')
2375 return read_integer (readcharfun
, n
);
2377 /* Fall through to error message. */
2379 else if (c
== 'x' || c
== 'X')
2380 return read_integer (readcharfun
, 16);
2381 else if (c
== 'o' || c
== 'O')
2382 return read_integer (readcharfun
, 8);
2383 else if (c
== 'b' || c
== 'B')
2384 return read_integer (readcharfun
, 2);
2387 invalid_syntax ("#", 1);
2390 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2395 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2405 new_backquote_flag
++;
2406 value
= read0 (readcharfun
);
2407 new_backquote_flag
--;
2409 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2413 if (new_backquote_flag
)
2415 Lisp_Object comma_type
= Qnil
;
2420 comma_type
= Qcomma_at
;
2422 comma_type
= Qcomma_dot
;
2425 if (ch
>= 0) UNREAD (ch
);
2426 comma_type
= Qcomma
;
2429 new_backquote_flag
--;
2430 value
= read0 (readcharfun
);
2431 new_backquote_flag
++;
2432 return Fcons (comma_type
, Fcons (value
, Qnil
));
2445 end_of_file_error ();
2447 /* Accept `single space' syntax like (list ? x) where the
2448 whitespace character is SPC or TAB.
2449 Other literal whitespace like NL, CR, and FF are not accepted,
2450 as there are well-established escape sequences for these. */
2451 if (c
== ' ' || c
== '\t')
2452 return make_number (c
);
2455 c
= read_escape (readcharfun
, 0, &discard
);
2456 else if (BASE_LEADING_CODE_P (c
))
2457 c
= read_multibyte (c
, readcharfun
);
2459 next_char
= READCHAR
;
2460 if (next_char
== '.')
2462 /* Only a dotted-pair dot is valid after a char constant. */
2463 int next_next_char
= READCHAR
;
2464 UNREAD (next_next_char
);
2466 ok
= (next_next_char
<= 040
2467 || (next_next_char
< 0200
2468 && (index ("\"';([#?", next_next_char
)
2469 || (!first_in_list
&& next_next_char
== '`')
2470 || (new_backquote_flag
&& next_next_char
== ','))));
2474 ok
= (next_char
<= 040
2475 || (next_char
< 0200
2476 && (index ("\"';()[]#?", next_char
)
2477 || (!first_in_list
&& next_char
== '`')
2478 || (new_backquote_flag
&& next_char
== ','))));
2482 return make_number (c
);
2484 invalid_syntax ("?", 1);
2489 char *p
= read_buffer
;
2490 char *end
= read_buffer
+ read_buffer_size
;
2492 /* 1 if we saw an escape sequence specifying
2493 a multibyte character, or a multibyte character. */
2494 int force_multibyte
= 0;
2495 /* 1 if we saw an escape sequence specifying
2496 a single-byte character. */
2497 int force_singlebyte
= 0;
2498 /* 1 if read_buffer contains multibyte text now. */
2499 int is_multibyte
= 0;
2503 while ((c
= READCHAR
) >= 0
2506 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2508 int offset
= p
- read_buffer
;
2509 read_buffer
= (char *) xrealloc (read_buffer
,
2510 read_buffer_size
*= 2);
2511 p
= read_buffer
+ offset
;
2512 end
= read_buffer
+ read_buffer_size
;
2519 c
= read_escape (readcharfun
, 1, &byterep
);
2521 /* C is -1 if \ newline has just been seen */
2524 if (p
== read_buffer
)
2530 force_singlebyte
= 1;
2531 else if (byterep
== 2)
2532 force_multibyte
= 1;
2535 /* A character that must be multibyte forces multibyte. */
2536 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2537 force_multibyte
= 1;
2539 /* If we just discovered the need to be multibyte,
2540 convert the text accumulated thus far. */
2541 if (force_multibyte
&& ! is_multibyte
)
2544 to_multibyte (&p
, &end
, &nchars
);
2547 /* Allow `\C- ' and `\C-?'. */
2548 if (c
== (CHAR_CTL
| ' '))
2550 else if (c
== (CHAR_CTL
| '?'))
2555 /* Shift modifier is valid only with [A-Za-z]. */
2556 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2558 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2559 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2563 /* Move the meta bit to the right place for a string. */
2564 c
= (c
& ~CHAR_META
) | 0x80;
2565 if (c
& CHAR_MODIFIER_MASK
)
2566 error ("Invalid modifier in string");
2569 p
+= CHAR_STRING (c
, p
);
2577 end_of_file_error ();
2579 /* If purifying, and string starts with \ newline,
2580 return zero instead. This is for doc strings
2581 that we are really going to find in etc/DOC.nn.nn */
2582 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2583 return make_number (0);
2585 if (is_multibyte
|| force_singlebyte
)
2587 else if (load_convert_to_unibyte
)
2590 to_multibyte (&p
, &end
, &nchars
);
2591 if (p
- read_buffer
!= nchars
)
2593 string
= make_multibyte_string (read_buffer
, nchars
,
2595 return Fstring_make_unibyte (string
);
2597 /* We can make a unibyte string directly. */
2600 else if (EQ (readcharfun
, Qget_file_char
)
2601 || EQ (readcharfun
, Qlambda
))
2603 /* Nowadays, reading directly from a file is used only for
2604 compiled Emacs Lisp files, and those always use the
2605 Emacs internal encoding. Meanwhile, Qlambda is used
2606 for reading dynamic byte code (compiled with
2607 byte-compile-dynamic = t). So make the string multibyte
2608 if the string contains any multibyte sequences.
2609 (to_multibyte is a no-op if not.) */
2610 to_multibyte (&p
, &end
, &nchars
);
2611 is_multibyte
= (p
- read_buffer
) != nchars
;
2614 /* In all other cases, if we read these bytes as
2615 separate characters, treat them as separate characters now. */
2618 /* We want readchar_count to be the number of characters, not
2619 bytes. Hence we adjust for multibyte characters in the
2620 string. ... But it doesn't seem to be necessary, because
2621 READCHAR *does* read multibyte characters from buffers. */
2622 /* readchar_count -= (p - read_buffer) - nchars; */
2624 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2626 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2632 int next_char
= READCHAR
;
2635 if (next_char
<= 040
2636 || (next_char
< 0200
2637 && (index ("\"';([#?", next_char
)
2638 || (!first_in_list
&& next_char
== '`')
2639 || (new_backquote_flag
&& next_char
== ','))))
2645 /* Otherwise, we fall through! Note that the atom-reading loop
2646 below will now loop at least once, assuring that we will not
2647 try to UNREAD two characters in a row. */
2651 if (c
<= 040) goto retry
;
2653 char *p
= read_buffer
;
2657 char *end
= read_buffer
+ read_buffer_size
;
2661 || (!index ("\"';()[]#", c
)
2662 && !(!first_in_list
&& c
== '`')
2663 && !(new_backquote_flag
&& c
== ','))))
2665 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2667 int offset
= p
- read_buffer
;
2668 read_buffer
= (char *) xrealloc (read_buffer
,
2669 read_buffer_size
*= 2);
2670 p
= read_buffer
+ offset
;
2671 end
= read_buffer
+ read_buffer_size
;
2678 end_of_file_error ();
2682 if (! SINGLE_BYTE_CHAR_P (c
))
2683 p
+= CHAR_STRING (c
, p
);
2692 int offset
= p
- read_buffer
;
2693 read_buffer
= (char *) xrealloc (read_buffer
,
2694 read_buffer_size
*= 2);
2695 p
= read_buffer
+ offset
;
2696 end
= read_buffer
+ read_buffer_size
;
2703 if (!quoted
&& !uninterned_symbol
)
2706 register Lisp_Object val
;
2708 if (*p1
== '+' || *p1
== '-') p1
++;
2709 /* Is it an integer? */
2712 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2713 /* Integers can have trailing decimal points. */
2714 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2716 /* It is an integer. */
2720 if (sizeof (int) == sizeof (EMACS_INT
))
2721 XSETINT (val
, atoi (read_buffer
));
2722 else if (sizeof (long) == sizeof (EMACS_INT
))
2723 XSETINT (val
, atol (read_buffer
));
2729 if (isfloat_string (read_buffer
))
2731 /* Compute NaN and infinities using 0.0 in a variable,
2732 to cope with compilers that think they are smarter
2738 /* Negate the value ourselves. This treats 0, NaNs,
2739 and infinity properly on IEEE floating point hosts,
2740 and works around a common bug where atof ("-0.0")
2742 int negative
= read_buffer
[0] == '-';
2744 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2745 returns 1, is if the input ends in e+INF or e+NaN. */
2752 value
= zero
/ zero
;
2754 /* If that made a "negative" NaN, negate it. */
2758 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2761 u_minus_zero
.d
= - 0.0;
2762 for (i
= 0; i
< sizeof (double); i
++)
2763 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2769 /* Now VALUE is a positive NaN. */
2772 value
= atof (read_buffer
+ negative
);
2776 return make_float (negative
? - value
: value
);
2780 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2781 : intern (read_buffer
);
2782 if (EQ (Vread_with_symbol_positions
, Qt
)
2783 || EQ (Vread_with_symbol_positions
, readcharfun
))
2784 Vread_symbol_positions_list
=
2785 /* Kind of a hack; this will probably fail if characters
2786 in the symbol name were escaped. Not really a big
2788 Fcons (Fcons (result
,
2789 make_number (readchar_count
2790 - XFASTINT (Flength (Fsymbol_name (result
))))),
2791 Vread_symbol_positions_list
);
2799 /* List of nodes we've seen during substitute_object_in_subtree. */
2800 static Lisp_Object seen_list
;
2803 substitute_object_in_subtree (object
, placeholder
)
2805 Lisp_Object placeholder
;
2807 Lisp_Object check_object
;
2809 /* We haven't seen any objects when we start. */
2812 /* Make all the substitutions. */
2814 = substitute_object_recurse (object
, placeholder
, object
);
2816 /* Clear seen_list because we're done with it. */
2819 /* The returned object here is expected to always eq the
2821 if (!EQ (check_object
, object
))
2822 error ("Unexpected mutation error in reader");
2825 /* Feval doesn't get called from here, so no gc protection is needed. */
2826 #define SUBSTITUTE(get_val, set_val) \
2828 Lisp_Object old_value = get_val; \
2829 Lisp_Object true_value \
2830 = substitute_object_recurse (object, placeholder,\
2833 if (!EQ (old_value, true_value)) \
2840 substitute_object_recurse (object
, placeholder
, subtree
)
2842 Lisp_Object placeholder
;
2843 Lisp_Object subtree
;
2845 /* If we find the placeholder, return the target object. */
2846 if (EQ (placeholder
, subtree
))
2849 /* If we've been to this node before, don't explore it again. */
2850 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2853 /* If this node can be the entry point to a cycle, remember that
2854 we've seen it. It can only be such an entry point if it was made
2855 by #n=, which means that we can find it as a value in
2857 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2858 seen_list
= Fcons (subtree
, seen_list
);
2860 /* Recurse according to subtree's type.
2861 Every branch must return a Lisp_Object. */
2862 switch (XTYPE (subtree
))
2864 case Lisp_Vectorlike
:
2867 int length
= XINT (Flength(subtree
));
2868 for (i
= 0; i
< length
; i
++)
2870 Lisp_Object idx
= make_number (i
);
2871 SUBSTITUTE (Faref (subtree
, idx
),
2872 Faset (subtree
, idx
, true_value
));
2879 SUBSTITUTE (Fcar_safe (subtree
),
2880 Fsetcar (subtree
, true_value
));
2881 SUBSTITUTE (Fcdr_safe (subtree
),
2882 Fsetcdr (subtree
, true_value
));
2888 /* Check for text properties in each interval.
2889 substitute_in_interval contains part of the logic. */
2891 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2892 Lisp_Object arg
= Fcons (object
, placeholder
);
2894 traverse_intervals_noorder (root_interval
,
2895 &substitute_in_interval
, arg
);
2900 /* Other types don't recurse any further. */
2906 /* Helper function for substitute_object_recurse. */
2908 substitute_in_interval (interval
, arg
)
2912 Lisp_Object object
= Fcar (arg
);
2913 Lisp_Object placeholder
= Fcdr (arg
);
2915 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2934 if (*cp
== '+' || *cp
== '-')
2937 if (*cp
>= '0' && *cp
<= '9')
2940 while (*cp
>= '0' && *cp
<= '9')
2948 if (*cp
>= '0' && *cp
<= '9')
2951 while (*cp
>= '0' && *cp
<= '9')
2954 if (*cp
== 'e' || *cp
== 'E')
2958 if (*cp
== '+' || *cp
== '-')
2962 if (*cp
>= '0' && *cp
<= '9')
2965 while (*cp
>= '0' && *cp
<= '9')
2968 else if (cp
== start
)
2970 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2975 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2981 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2982 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2983 || state
== (DOT_CHAR
|TRAIL_INT
)
2984 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2985 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2986 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2991 read_vector (readcharfun
, bytecodeflag
)
2992 Lisp_Object readcharfun
;
2997 register Lisp_Object
*ptr
;
2998 register Lisp_Object tem
, item
, vector
;
2999 register struct Lisp_Cons
*otem
;
3002 tem
= read_list (1, readcharfun
);
3003 len
= Flength (tem
);
3004 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3006 size
= XVECTOR (vector
)->size
;
3007 ptr
= XVECTOR (vector
)->contents
;
3008 for (i
= 0; i
< size
; i
++)
3011 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3012 bytecode object, the docstring containing the bytecode and
3013 constants values must be treated as unibyte and passed to
3014 Fread, to get the actual bytecode string and constants vector. */
3015 if (bytecodeflag
&& load_force_doc_strings
)
3017 if (i
== COMPILED_BYTECODE
)
3019 if (!STRINGP (item
))
3020 error ("Invalid byte code");
3022 /* Delay handling the bytecode slot until we know whether
3023 it is lazily-loaded (we can tell by whether the
3024 constants slot is nil). */
3025 ptr
[COMPILED_CONSTANTS
] = item
;
3028 else if (i
== COMPILED_CONSTANTS
)
3030 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3034 /* Coerce string to unibyte (like string-as-unibyte,
3035 but without generating extra garbage and
3036 guaranteeing no change in the contents). */
3037 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3038 STRING_SET_UNIBYTE (bytestr
);
3040 item
= Fread (bytestr
);
3042 error ("Invalid byte code");
3044 otem
= XCONS (item
);
3045 bytestr
= XCAR (item
);
3050 /* Now handle the bytecode slot. */
3051 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3054 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3062 /* FLAG = 1 means check for ] to terminate rather than ) and .
3063 FLAG = -1 means check for starting with defun
3064 and make structure pure. */
3067 read_list (flag
, readcharfun
)
3069 register Lisp_Object readcharfun
;
3071 /* -1 means check next element for defun,
3072 0 means don't check,
3073 1 means already checked and found defun. */
3074 int defunflag
= flag
< 0 ? -1 : 0;
3075 Lisp_Object val
, tail
;
3076 register Lisp_Object elt
, tem
;
3077 struct gcpro gcpro1
, gcpro2
;
3078 /* 0 is the normal case.
3079 1 means this list is a doc reference; replace it with the number 0.
3080 2 means this list is a doc reference; replace it with the doc string. */
3081 int doc_reference
= 0;
3083 /* Initialize this to 1 if we are reading a list. */
3084 int first_in_list
= flag
<= 0;
3093 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3098 /* While building, if the list starts with #$, treat it specially. */
3099 if (EQ (elt
, Vload_file_name
)
3101 && !NILP (Vpurify_flag
))
3103 if (NILP (Vdoc_file_name
))
3104 /* We have not yet called Snarf-documentation, so assume
3105 this file is described in the DOC-MM.NN file
3106 and Snarf-documentation will fill in the right value later.
3107 For now, replace the whole list with 0. */
3110 /* We have already called Snarf-documentation, so make a relative
3111 file name for this file, so it can be found properly
3112 in the installed Lisp directory.
3113 We don't use Fexpand_file_name because that would make
3114 the directory absolute now. */
3115 elt
= concat2 (build_string ("../lisp/"),
3116 Ffile_name_nondirectory (elt
));
3118 else if (EQ (elt
, Vload_file_name
)
3120 && load_force_doc_strings
)
3129 invalid_syntax (") or . in a vector", 18);
3137 XSETCDR (tail
, read0 (readcharfun
));
3139 val
= read0 (readcharfun
);
3140 read1 (readcharfun
, &ch
, 0);
3144 if (doc_reference
== 1)
3145 return make_number (0);
3146 if (doc_reference
== 2)
3148 /* Get a doc string from the file we are loading.
3149 If it's in saved_doc_string, get it from there. */
3150 int pos
= XINT (XCDR (val
));
3151 /* Position is negative for user variables. */
3152 if (pos
< 0) pos
= -pos
;
3153 if (pos
>= saved_doc_string_position
3154 && pos
< (saved_doc_string_position
3155 + saved_doc_string_length
))
3157 int start
= pos
- saved_doc_string_position
;
3160 /* Process quoting with ^A,
3161 and find the end of the string,
3162 which is marked with ^_ (037). */
3163 for (from
= start
, to
= start
;
3164 saved_doc_string
[from
] != 037;)
3166 int c
= saved_doc_string
[from
++];
3169 c
= saved_doc_string
[from
++];
3171 saved_doc_string
[to
++] = c
;
3173 saved_doc_string
[to
++] = 0;
3175 saved_doc_string
[to
++] = 037;
3178 saved_doc_string
[to
++] = c
;
3181 return make_string (saved_doc_string
+ start
,
3184 /* Look in prev_saved_doc_string the same way. */
3185 else if (pos
>= prev_saved_doc_string_position
3186 && pos
< (prev_saved_doc_string_position
3187 + prev_saved_doc_string_length
))
3189 int start
= pos
- prev_saved_doc_string_position
;
3192 /* Process quoting with ^A,
3193 and find the end of the string,
3194 which is marked with ^_ (037). */
3195 for (from
= start
, to
= start
;
3196 prev_saved_doc_string
[from
] != 037;)
3198 int c
= prev_saved_doc_string
[from
++];
3201 c
= prev_saved_doc_string
[from
++];
3203 prev_saved_doc_string
[to
++] = c
;
3205 prev_saved_doc_string
[to
++] = 0;
3207 prev_saved_doc_string
[to
++] = 037;
3210 prev_saved_doc_string
[to
++] = c
;
3213 return make_string (prev_saved_doc_string
+ start
,
3217 return get_doc_string (val
, 0, 0);
3222 invalid_syntax (". in wrong context", 18);
3224 invalid_syntax ("] in a list", 11);
3226 tem
= (read_pure
&& flag
<= 0
3227 ? pure_cons (elt
, Qnil
)
3228 : Fcons (elt
, Qnil
));
3230 XSETCDR (tail
, tem
);
3235 defunflag
= EQ (elt
, Qdefun
);
3236 else if (defunflag
> 0)
3241 Lisp_Object Vobarray
;
3242 Lisp_Object initial_obarray
;
3244 /* oblookup stores the bucket number here, for the sake of Funintern. */
3246 int oblookup_last_bucket_number
;
3248 static int hash_string ();
3250 /* Get an error if OBARRAY is not an obarray.
3251 If it is one, return it. */
3254 check_obarray (obarray
)
3255 Lisp_Object obarray
;
3257 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3259 /* If Vobarray is now invalid, force it to be valid. */
3260 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3261 wrong_type_argument (Qvectorp
, obarray
);
3266 /* Intern the C string STR: return a symbol with that name,
3267 interned in the current obarray. */
3274 int len
= strlen (str
);
3275 Lisp_Object obarray
;
3278 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3279 obarray
= check_obarray (obarray
);
3280 tem
= oblookup (obarray
, str
, len
, len
);
3283 return Fintern (make_string (str
, len
), obarray
);
3286 /* Create an uninterned symbol with name STR. */
3292 int len
= strlen (str
);
3294 return Fmake_symbol ((!NILP (Vpurify_flag
)
3295 ? make_pure_string (str
, len
, len
, 0)
3296 : make_string (str
, len
)));
3299 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3300 doc
: /* Return the canonical symbol whose name is STRING.
3301 If there is none, one is created by this function and returned.
3302 A second optional argument specifies the obarray to use;
3303 it defaults to the value of `obarray'. */)
3305 Lisp_Object string
, obarray
;
3307 register Lisp_Object tem
, sym
, *ptr
;
3309 if (NILP (obarray
)) obarray
= Vobarray
;
3310 obarray
= check_obarray (obarray
);
3312 CHECK_STRING (string
);
3314 tem
= oblookup (obarray
, SDATA (string
),
3317 if (!INTEGERP (tem
))
3320 if (!NILP (Vpurify_flag
))
3321 string
= Fpurecopy (string
);
3322 sym
= Fmake_symbol (string
);
3324 if (EQ (obarray
, initial_obarray
))
3325 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3327 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3329 if ((SREF (string
, 0) == ':')
3330 && EQ (obarray
, initial_obarray
))
3332 XSYMBOL (sym
)->constant
= 1;
3333 XSYMBOL (sym
)->value
= sym
;
3336 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3338 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3340 XSYMBOL (sym
)->next
= 0;
3345 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3346 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3347 NAME may be a string or a symbol. If it is a symbol, that exact
3348 symbol is searched for.
3349 A second optional argument specifies the obarray to use;
3350 it defaults to the value of `obarray'. */)
3352 Lisp_Object name
, obarray
;
3354 register Lisp_Object tem
, string
;
3356 if (NILP (obarray
)) obarray
= Vobarray
;
3357 obarray
= check_obarray (obarray
);
3359 if (!SYMBOLP (name
))
3361 CHECK_STRING (name
);
3365 string
= SYMBOL_NAME (name
);
3367 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3368 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3374 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3375 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3376 The value is t if a symbol was found and deleted, nil otherwise.
3377 NAME may be a string or a symbol. If it is a symbol, that symbol
3378 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3379 OBARRAY defaults to the value of the variable `obarray'. */)
3381 Lisp_Object name
, obarray
;
3383 register Lisp_Object string
, tem
;
3386 if (NILP (obarray
)) obarray
= Vobarray
;
3387 obarray
= check_obarray (obarray
);
3390 string
= SYMBOL_NAME (name
);
3393 CHECK_STRING (name
);
3397 tem
= oblookup (obarray
, SDATA (string
),
3402 /* If arg was a symbol, don't delete anything but that symbol itself. */
3403 if (SYMBOLP (name
) && !EQ (name
, tem
))
3406 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3407 XSYMBOL (tem
)->constant
= 0;
3408 XSYMBOL (tem
)->indirect_variable
= 0;
3410 hash
= oblookup_last_bucket_number
;
3412 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3414 if (XSYMBOL (tem
)->next
)
3415 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3417 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3421 Lisp_Object tail
, following
;
3423 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3424 XSYMBOL (tail
)->next
;
3427 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3428 if (EQ (following
, tem
))
3430 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3439 /* Return the symbol in OBARRAY whose names matches the string
3440 of SIZE characters (SIZE_BYTE bytes) at PTR.
3441 If there is no such symbol in OBARRAY, return nil.
3443 Also store the bucket number in oblookup_last_bucket_number. */
3446 oblookup (obarray
, ptr
, size
, size_byte
)
3447 Lisp_Object obarray
;
3448 register const char *ptr
;
3449 int size
, size_byte
;
3453 register Lisp_Object tail
;
3454 Lisp_Object bucket
, tem
;
3456 if (!VECTORP (obarray
)
3457 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3459 obarray
= check_obarray (obarray
);
3460 obsize
= XVECTOR (obarray
)->size
;
3462 /* This is sometimes needed in the middle of GC. */
3463 obsize
&= ~ARRAY_MARK_FLAG
;
3464 /* Combining next two lines breaks VMS C 2.3. */
3465 hash
= hash_string (ptr
, size_byte
);
3467 bucket
= XVECTOR (obarray
)->contents
[hash
];
3468 oblookup_last_bucket_number
= hash
;
3469 if (EQ (bucket
, make_number (0)))
3471 else if (!SYMBOLP (bucket
))
3472 error ("Bad data in guts of obarray"); /* Like CADR error message */
3474 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3476 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3477 && SCHARS (SYMBOL_NAME (tail
)) == size
3478 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3480 else if (XSYMBOL (tail
)->next
== 0)
3483 XSETINT (tem
, hash
);
3488 hash_string (ptr
, len
)
3489 const unsigned char *ptr
;
3492 register const unsigned char *p
= ptr
;
3493 register const unsigned char *end
= p
+ len
;
3494 register unsigned char c
;
3495 register int hash
= 0;
3500 if (c
>= 0140) c
-= 40;
3501 hash
= ((hash
<<3) + (hash
>>28) + c
);
3503 return hash
& 07777777777;
3507 map_obarray (obarray
, fn
, arg
)
3508 Lisp_Object obarray
;
3509 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3513 register Lisp_Object tail
;
3514 CHECK_VECTOR (obarray
);
3515 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3517 tail
= XVECTOR (obarray
)->contents
[i
];
3522 if (XSYMBOL (tail
)->next
== 0)
3524 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3530 mapatoms_1 (sym
, function
)
3531 Lisp_Object sym
, function
;
3533 call1 (function
, sym
);
3536 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3537 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3538 OBARRAY defaults to the value of `obarray'. */)
3540 Lisp_Object function
, obarray
;
3542 if (NILP (obarray
)) obarray
= Vobarray
;
3543 obarray
= check_obarray (obarray
);
3545 map_obarray (obarray
, mapatoms_1
, function
);
3549 #define OBARRAY_SIZE 1511
3554 Lisp_Object oblength
;
3558 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3560 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3561 Vobarray
= Fmake_vector (oblength
, make_number (0));
3562 initial_obarray
= Vobarray
;
3563 staticpro (&initial_obarray
);
3564 /* Intern nil in the obarray */
3565 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3566 XSYMBOL (Qnil
)->constant
= 1;
3568 /* These locals are to kludge around a pyramid compiler bug. */
3569 hash
= hash_string ("nil", 3);
3570 /* Separate statement here to avoid VAXC bug. */
3571 hash
%= OBARRAY_SIZE
;
3572 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3575 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3576 XSYMBOL (Qnil
)->function
= Qunbound
;
3577 XSYMBOL (Qunbound
)->value
= Qunbound
;
3578 XSYMBOL (Qunbound
)->function
= Qunbound
;
3581 XSYMBOL (Qnil
)->value
= Qnil
;
3582 XSYMBOL (Qnil
)->plist
= Qnil
;
3583 XSYMBOL (Qt
)->value
= Qt
;
3584 XSYMBOL (Qt
)->constant
= 1;
3586 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3589 Qvariable_documentation
= intern ("variable-documentation");
3590 staticpro (&Qvariable_documentation
);
3592 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3593 read_buffer
= (char *) xmalloc (read_buffer_size
);
3598 struct Lisp_Subr
*sname
;
3601 sym
= intern (sname
->symbol_name
);
3602 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3605 #ifdef NOTDEF /* use fset in subr.el now */
3607 defalias (sname
, string
)
3608 struct Lisp_Subr
*sname
;
3612 sym
= intern (string
);
3613 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3617 /* Define an "integer variable"; a symbol whose value is forwarded
3618 to a C variable of type int. Sample call: */
3619 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3621 defvar_int (namestring
, address
)
3625 Lisp_Object sym
, val
;
3626 sym
= intern (namestring
);
3627 val
= allocate_misc ();
3628 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3629 XINTFWD (val
)->intvar
= address
;
3630 SET_SYMBOL_VALUE (sym
, val
);
3633 /* Similar but define a variable whose value is t if address contains 1,
3634 nil if address contains 0 */
3636 defvar_bool (namestring
, address
)
3640 Lisp_Object sym
, val
;
3641 sym
= intern (namestring
);
3642 val
= allocate_misc ();
3643 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3644 XBOOLFWD (val
)->boolvar
= address
;
3645 SET_SYMBOL_VALUE (sym
, val
);
3646 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3649 /* Similar but define a variable whose value is the Lisp Object stored
3650 at address. Two versions: with and without gc-marking of the C
3651 variable. The nopro version is used when that variable will be
3652 gc-marked for some other reason, since marking the same slot twice
3653 can cause trouble with strings. */
3655 defvar_lisp_nopro (namestring
, address
)
3657 Lisp_Object
*address
;
3659 Lisp_Object sym
, val
;
3660 sym
= intern (namestring
);
3661 val
= allocate_misc ();
3662 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3663 XOBJFWD (val
)->objvar
= address
;
3664 SET_SYMBOL_VALUE (sym
, val
);
3668 defvar_lisp (namestring
, address
)
3670 Lisp_Object
*address
;
3672 defvar_lisp_nopro (namestring
, address
);
3673 staticpro (address
);
3676 /* Similar but define a variable whose value is the Lisp Object stored in
3677 the current buffer. address is the address of the slot in the buffer
3678 that is current now. */
3681 defvar_per_buffer (namestring
, address
, type
, doc
)
3683 Lisp_Object
*address
;
3687 Lisp_Object sym
, val
;
3690 sym
= intern (namestring
);
3691 val
= allocate_misc ();
3692 offset
= (char *)address
- (char *)current_buffer
;
3694 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3695 XBUFFER_OBJFWD (val
)->offset
= offset
;
3696 SET_SYMBOL_VALUE (sym
, val
);
3697 PER_BUFFER_SYMBOL (offset
) = sym
;
3698 PER_BUFFER_TYPE (offset
) = type
;
3700 if (PER_BUFFER_IDX (offset
) == 0)
3701 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3702 slot of buffer_local_flags */
3707 /* Similar but define a variable whose value is the Lisp Object stored
3708 at a particular offset in the current kboard object. */
3711 defvar_kboard (namestring
, offset
)
3715 Lisp_Object sym
, val
;
3716 sym
= intern (namestring
);
3717 val
= allocate_misc ();
3718 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3719 XKBOARD_OBJFWD (val
)->offset
= offset
;
3720 SET_SYMBOL_VALUE (sym
, val
);
3723 /* Record the value of load-path used at the start of dumping
3724 so we can see if the site changed it later during dumping. */
3725 static Lisp_Object dump_path
;
3731 int turn_off_warning
= 0;
3733 /* Compute the default load-path. */
3735 normal
= PATH_LOADSEARCH
;
3736 Vload_path
= decode_env_path (0, normal
);
3738 if (NILP (Vpurify_flag
))
3739 normal
= PATH_LOADSEARCH
;
3741 normal
= PATH_DUMPLOADSEARCH
;
3743 /* In a dumped Emacs, we normally have to reset the value of
3744 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3745 uses ../lisp, instead of the path of the installed elisp
3746 libraries. However, if it appears that Vload_path was changed
3747 from the default before dumping, don't override that value. */
3750 if (! NILP (Fequal (dump_path
, Vload_path
)))
3752 Vload_path
= decode_env_path (0, normal
);
3753 if (!NILP (Vinstallation_directory
))
3755 Lisp_Object tem
, tem1
, sitelisp
;
3757 /* Remove site-lisp dirs from path temporarily and store
3758 them in sitelisp, then conc them on at the end so
3759 they're always first in path. */
3763 tem
= Fcar (Vload_path
);
3764 tem1
= Fstring_match (build_string ("site-lisp"),
3768 Vload_path
= Fcdr (Vload_path
);
3769 sitelisp
= Fcons (tem
, sitelisp
);
3775 /* Add to the path the lisp subdir of the
3776 installation dir, if it exists. */
3777 tem
= Fexpand_file_name (build_string ("lisp"),
3778 Vinstallation_directory
);
3779 tem1
= Ffile_exists_p (tem
);
3782 if (NILP (Fmember (tem
, Vload_path
)))
3784 turn_off_warning
= 1;
3785 Vload_path
= Fcons (tem
, Vload_path
);
3789 /* That dir doesn't exist, so add the build-time
3790 Lisp dirs instead. */
3791 Vload_path
= nconc2 (Vload_path
, dump_path
);
3793 /* Add leim under the installation dir, if it exists. */
3794 tem
= Fexpand_file_name (build_string ("leim"),
3795 Vinstallation_directory
);
3796 tem1
= Ffile_exists_p (tem
);
3799 if (NILP (Fmember (tem
, Vload_path
)))
3800 Vload_path
= Fcons (tem
, Vload_path
);
3803 /* Add site-list under the installation dir, if it exists. */
3804 tem
= Fexpand_file_name (build_string ("site-lisp"),
3805 Vinstallation_directory
);
3806 tem1
= Ffile_exists_p (tem
);
3809 if (NILP (Fmember (tem
, Vload_path
)))
3810 Vload_path
= Fcons (tem
, Vload_path
);
3813 /* If Emacs was not built in the source directory,
3814 and it is run from where it was built, add to load-path
3815 the lisp, leim and site-lisp dirs under that directory. */
3817 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3821 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3822 Vinstallation_directory
);
3823 tem1
= Ffile_exists_p (tem
);
3825 /* Don't be fooled if they moved the entire source tree
3826 AFTER dumping Emacs. If the build directory is indeed
3827 different from the source dir, src/Makefile.in and
3828 src/Makefile will not be found together. */
3829 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3830 Vinstallation_directory
);
3831 tem2
= Ffile_exists_p (tem
);
3832 if (!NILP (tem1
) && NILP (tem2
))
3834 tem
= Fexpand_file_name (build_string ("lisp"),
3837 if (NILP (Fmember (tem
, Vload_path
)))
3838 Vload_path
= Fcons (tem
, Vload_path
);
3840 tem
= Fexpand_file_name (build_string ("leim"),
3843 if (NILP (Fmember (tem
, Vload_path
)))
3844 Vload_path
= Fcons (tem
, Vload_path
);
3846 tem
= Fexpand_file_name (build_string ("site-lisp"),
3849 if (NILP (Fmember (tem
, Vload_path
)))
3850 Vload_path
= Fcons (tem
, Vload_path
);
3853 if (!NILP (sitelisp
))
3854 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3860 /* NORMAL refers to the lisp dir in the source directory. */
3861 /* We used to add ../lisp at the front here, but
3862 that caused trouble because it was copied from dump_path
3863 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3864 It should be unnecessary. */
3865 Vload_path
= decode_env_path (0, normal
);
3866 dump_path
= Vload_path
;
3870 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3871 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3872 almost never correct, thereby causing a warning to be printed out that
3873 confuses users. Since PATH_LOADSEARCH is always overridden by the
3874 EMACSLOADPATH environment variable below, disable the warning on NT.
3875 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3876 the "standard" paths may not exist and would be overridden by
3877 EMACSLOADPATH as on NT. Since this depends on how the executable
3878 was build and packaged, turn off the warnings in general */
3880 /* Warn if dirs in the *standard* path don't exist. */
3881 if (!turn_off_warning
)
3883 Lisp_Object path_tail
;
3885 for (path_tail
= Vload_path
;
3887 path_tail
= XCDR (path_tail
))
3889 Lisp_Object dirfile
;
3890 dirfile
= Fcar (path_tail
);
3891 if (STRINGP (dirfile
))
3893 dirfile
= Fdirectory_file_name (dirfile
);
3894 if (access (SDATA (dirfile
), 0) < 0)
3895 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3900 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3902 /* If the EMACSLOADPATH environment variable is set, use its value.
3903 This doesn't apply if we're dumping. */
3905 if (NILP (Vpurify_flag
)
3906 && egetenv ("EMACSLOADPATH"))
3908 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3912 load_in_progress
= 0;
3913 Vload_file_name
= Qnil
;
3915 load_descriptor_list
= Qnil
;
3917 Vstandard_input
= Qt
;
3918 Vloads_in_progress
= Qnil
;
3921 /* Print a warning, using format string FORMAT, that directory DIRNAME
3922 does not exist. Print it on stderr and put it in *Message*. */
3925 dir_warning (format
, dirname
)
3927 Lisp_Object dirname
;
3930 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3932 fprintf (stderr
, format
, SDATA (dirname
));
3933 sprintf (buffer
, format
, SDATA (dirname
));
3934 /* Don't log the warning before we've initialized!! */
3936 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3943 defsubr (&Sread_from_string
);
3945 defsubr (&Sintern_soft
);
3946 defsubr (&Sunintern
);
3947 defsubr (&Sget_load_suffixes
);
3949 defsubr (&Seval_buffer
);
3950 defsubr (&Seval_region
);
3951 defsubr (&Sread_char
);
3952 defsubr (&Sread_char_exclusive
);
3953 defsubr (&Sread_event
);
3954 defsubr (&Sget_file_char
);
3955 defsubr (&Smapatoms
);
3956 defsubr (&Slocate_file_internal
);
3958 DEFVAR_LISP ("obarray", &Vobarray
,
3959 doc
: /* Symbol table for use by `intern' and `read'.
3960 It is a vector whose length ought to be prime for best results.
3961 The vector's contents don't make sense if examined from Lisp programs;
3962 to find all the symbols in an obarray, use `mapatoms'. */);
3964 DEFVAR_LISP ("values", &Vvalues
,
3965 doc
: /* List of values of all expressions which were read, evaluated and printed.
3966 Order is reverse chronological. */);
3968 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3969 doc
: /* Stream for read to get input from.
3970 See documentation of `read' for possible values. */);
3971 Vstandard_input
= Qt
;
3973 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3974 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3976 If this variable is a buffer, then only forms read from that buffer
3977 will be added to `read-symbol-positions-list'.
3978 If this variable is t, then all read forms will be added.
3979 The effect of all other values other than nil are not currently
3980 defined, although they may be in the future.
3982 The positions are relative to the last call to `read' or
3983 `read-from-string'. It is probably a bad idea to set this variable at
3984 the toplevel; bind it instead. */);
3985 Vread_with_symbol_positions
= Qnil
;
3987 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3988 doc
: /* A list mapping read symbols to their positions.
3989 This variable is modified during calls to `read' or
3990 `read-from-string', but only when `read-with-symbol-positions' is
3993 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3994 CHAR-POSITION is an integer giving the offset of that occurrence of the
3995 symbol from the position where `read' or `read-from-string' started.
3997 Note that a symbol will appear multiple times in this list, if it was
3998 read multiple times. The list is in the same order as the symbols
4000 Vread_symbol_positions_list
= Qnil
;
4002 DEFVAR_LISP ("load-path", &Vload_path
,
4003 doc
: /* *List of directories to search for files to load.
4004 Each element is a string (directory name) or nil (try default directory).
4005 Initialized based on EMACSLOADPATH environment variable, if any,
4006 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4008 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4009 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4010 This list should not include the empty string.
4011 `load' and related functions try to append these suffixes, in order,
4012 to the specified file name if a Lisp suffix is allowed or required. */);
4013 Vload_suffixes
= Fcons (build_string (".elc"),
4014 Fcons (build_string (".el"), Qnil
));
4015 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4016 doc
: /* List of suffixes that indicate representations of \
4018 This list should normally start with the empty string.
4020 Enabling Auto Compression mode appends the suffixes in
4021 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4022 mode removes them again. `load' and related functions use this list to
4023 determine whether they should look for compressed versions of a file
4024 and, if so, which suffixes they should try to append to the file name
4025 in order to do so. However, if you want to customize which suffixes
4026 the loading functions recognize as compression suffixes, you should
4027 customize `jka-compr-load-suffixes' rather than the present variable. */);
4028 /* We don't use empty_string because it's not initialized yet. */
4029 Vload_file_rep_suffixes
= Fcons (build_string (""), Qnil
);
4031 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4032 doc
: /* Non-nil iff inside of `load'. */);
4034 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4035 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4036 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4038 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4039 a symbol \(a feature name).
4041 When `load' is run and the file-name argument matches an element's
4042 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4043 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4045 An error in FORMS does not undo the load, but does prevent execution of
4046 the rest of the FORMS. */);
4047 Vafter_load_alist
= Qnil
;
4049 DEFVAR_LISP ("load-history", &Vload_history
,
4050 doc
: /* Alist mapping file names to symbols and features.
4051 Each alist element is a list that starts with a file name,
4052 except for one element (optional) that starts with nil and describes
4053 definitions evaluated from buffers not visiting files.
4055 The file name is absolute and is the true file name (i.e. it doesn't
4056 contain symbolic links) of the loaded file.
4058 The remaining elements of each list are symbols defined as variables
4059 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4060 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
4061 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
4062 and means that SYMBOL was an autoload before this file redefined it
4065 During preloading, the file name recorded is relative to the main Lisp
4066 directory. These file names are converted to absolute at startup. */);
4067 Vload_history
= Qnil
;
4069 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4070 doc
: /* Full name of file being loaded by `load'. */);
4071 Vload_file_name
= Qnil
;
4073 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4074 doc
: /* File name, including directory, of user's initialization file.
4075 If the file loaded had extension `.elc', and the corresponding source file
4076 exists, this variable contains the name of source file, suitable for use
4077 by functions like `custom-save-all' which edit the init file. */);
4078 Vuser_init_file
= Qnil
;
4080 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4081 doc
: /* Used for internal purposes by `load'. */);
4082 Vcurrent_load_list
= Qnil
;
4084 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4085 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4086 The default is nil, which means use the function `read'. */);
4087 Vload_read_function
= Qnil
;
4089 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4090 doc
: /* Function called in `load' for loading an Emacs lisp source file.
4091 This function is for doing code conversion before reading the source file.
4092 If nil, loading is done without any code conversion.
4093 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4094 FULLNAME is the full name of FILE.
4095 See `load' for the meaning of the remaining arguments. */);
4096 Vload_source_file_function
= Qnil
;
4098 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4099 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4100 This is useful when the file being loaded is a temporary copy. */);
4101 load_force_doc_strings
= 0;
4103 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4104 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4105 This is normally bound by `load' and `eval-buffer' to control `read',
4106 and is not meant for users to change. */);
4107 load_convert_to_unibyte
= 0;
4109 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4110 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4111 You cannot count on them to still be there! */);
4113 = Fexpand_file_name (build_string ("../"),
4114 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4116 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4117 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4118 Vpreloaded_file_list
= Qnil
;
4120 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4121 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4122 Vbyte_boolean_vars
= Qnil
;
4124 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4125 doc
: /* Non-nil means load dangerous compiled Lisp files.
4126 Some versions of XEmacs use different byte codes than Emacs. These
4127 incompatible byte codes can make Emacs crash when it tries to execute
4129 load_dangerous_libraries
= 0;
4131 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4132 doc
: /* Regular expression matching safe to load compiled Lisp files.
4133 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4134 from the file, and matches them against this regular expression.
4135 When the regular expression matches, the file is considered to be safe
4136 to load. See also `load-dangerous-libraries'. */);
4137 Vbytecomp_version_regexp
4138 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4140 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4141 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4142 Veval_buffer_list
= Qnil
;
4144 /* Vsource_directory was initialized in init_lread. */
4146 load_descriptor_list
= Qnil
;
4147 staticpro (&load_descriptor_list
);
4149 Qcurrent_load_list
= intern ("current-load-list");
4150 staticpro (&Qcurrent_load_list
);
4152 Qstandard_input
= intern ("standard-input");
4153 staticpro (&Qstandard_input
);
4155 Qread_char
= intern ("read-char");
4156 staticpro (&Qread_char
);
4158 Qget_file_char
= intern ("get-file-char");
4159 staticpro (&Qget_file_char
);
4161 Qbackquote
= intern ("`");
4162 staticpro (&Qbackquote
);
4163 Qcomma
= intern (",");
4164 staticpro (&Qcomma
);
4165 Qcomma_at
= intern (",@");
4166 staticpro (&Qcomma_at
);
4167 Qcomma_dot
= intern (",.");
4168 staticpro (&Qcomma_dot
);
4170 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4171 staticpro (&Qinhibit_file_name_operation
);
4173 Qascii_character
= intern ("ascii-character");
4174 staticpro (&Qascii_character
);
4176 Qfunction
= intern ("function");
4177 staticpro (&Qfunction
);
4179 Qload
= intern ("load");
4182 Qload_file_name
= intern ("load-file-name");
4183 staticpro (&Qload_file_name
);
4185 Qeval_buffer_list
= intern ("eval-buffer-list");
4186 staticpro (&Qeval_buffer_list
);
4188 Qfile_truename
= intern ("file-truename");
4189 staticpro (&Qfile_truename
) ;
4191 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4192 staticpro (&Qdo_after_load_evaluation
) ;
4194 staticpro (&dump_path
);
4196 staticpro (&read_objects
);
4197 read_objects
= Qnil
;
4198 staticpro (&seen_list
);
4201 Vloads_in_progress
= Qnil
;
4202 staticpro (&Vloads_in_progress
);
4205 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4206 (do not change this comment) */