1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
31 #include "intervals.h"
33 #include "character.h"
39 #include "termhooks.h"
43 #include <sys/inode.h>
48 #include <unistd.h> /* to get X_OK */
65 #endif /* HAVE_SETLOCALE */
75 #define file_offset off_t
76 #define file_tell ftello
78 #define file_offset long
79 #define file_tell ftell
86 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
87 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
88 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
89 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
90 Lisp_Object Qinhibit_file_name_operation
;
91 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
93 /* Used instead of Qget_file_char while loading *.elc files compiled
94 by Emacs 21 or older. */
95 static Lisp_Object Qget_emacs_mule_file_char
;
97 static Lisp_Object Qload_force_doc_strings
;
99 extern Lisp_Object Qevent_symbol_element_mask
;
100 extern Lisp_Object Qfile_exists_p
;
102 /* non-zero iff inside `load' */
103 int load_in_progress
;
105 /* Directory in which the sources were found. */
106 Lisp_Object Vsource_directory
;
108 /* Search path and suffixes for files to be loaded. */
109 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
111 /* File name of user's init file. */
112 Lisp_Object Vuser_init_file
;
114 /* This is the user-visible association list that maps features to
115 lists of defs in their load files. */
116 Lisp_Object Vload_history
;
118 /* This is used to build the load history. */
119 Lisp_Object Vcurrent_load_list
;
121 /* List of files that were preloaded. */
122 Lisp_Object Vpreloaded_file_list
;
124 /* Name of file actually being read by `load'. */
125 Lisp_Object Vload_file_name
;
127 /* Function to use for reading, in `load' and friends. */
128 Lisp_Object Vload_read_function
;
130 /* The association list of objects read with the #n=object form.
131 Each member of the list has the form (n . object), and is used to
132 look up the object for the corresponding #n# construct.
133 It must be set to nil before all top-level calls to read0. */
134 Lisp_Object read_objects
;
136 /* Nonzero means load should forcibly load all dynamic doc strings. */
137 static int load_force_doc_strings
;
139 /* Nonzero means read should convert strings to unibyte. */
140 static int load_convert_to_unibyte
;
142 /* Nonzero means READCHAR should read bytes one by one (not character)
143 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
144 This is set to 1 by read1 temporarily while handling #@NUMBER. */
145 static int load_each_byte
;
147 /* Function to use for loading an Emacs lisp source file (not
148 compiled) instead of readevalloop. */
149 Lisp_Object Vload_source_file_function
;
151 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
152 Lisp_Object Vbyte_boolean_vars
;
154 /* Whether or not to add a `read-positions' property to symbols
156 Lisp_Object Vread_with_symbol_positions
;
158 /* List of (SYMBOL . POSITION) accumulated so far. */
159 Lisp_Object Vread_symbol_positions_list
;
161 /* List of descriptors now open for Fload. */
162 static Lisp_Object load_descriptor_list
;
164 /* File for get_file_char to read from. Use by load. */
165 static FILE *instream
;
167 /* When nonzero, read conses in pure space */
168 static int read_pure
;
170 /* For use within read-from-string (this reader is non-reentrant!!) */
171 static int read_from_string_index
;
172 static int read_from_string_index_byte
;
173 static int read_from_string_limit
;
175 /* Number of characters read in the current call to Fread or
176 Fread_from_string. */
177 static int readchar_count
;
179 /* This contains the last string skipped with #@. */
180 static char *saved_doc_string
;
181 /* Length of buffer allocated in saved_doc_string. */
182 static int saved_doc_string_size
;
183 /* Length of actual data in saved_doc_string. */
184 static int saved_doc_string_length
;
185 /* This is the file position that string came from. */
186 static file_offset saved_doc_string_position
;
188 /* This contains the previous string skipped with #@.
189 We copy it from saved_doc_string when a new string
190 is put in saved_doc_string. */
191 static char *prev_saved_doc_string
;
192 /* Length of buffer allocated in prev_saved_doc_string. */
193 static int prev_saved_doc_string_size
;
194 /* Length of actual data in prev_saved_doc_string. */
195 static int prev_saved_doc_string_length
;
196 /* This is the file position that string came from. */
197 static file_offset prev_saved_doc_string_position
;
199 /* Nonzero means inside a new-style backquote
200 with no surrounding parentheses.
201 Fread initializes this to zero, so we need not specbind it
202 or worry about what happens to it when there is an error. */
203 static int new_backquote_flag
;
205 /* A list of file names for files being loaded in Fload. Used to
206 check for recursive loads. */
208 static Lisp_Object Vloads_in_progress
;
210 /* Non-zero means load dangerous compiled Lisp files. */
212 int load_dangerous_libraries
;
214 /* A regular expression used to detect files compiled with Emacs. */
216 static Lisp_Object Vbytecomp_version_regexp
;
218 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
221 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
222 Lisp_Object (*) (), int,
223 Lisp_Object
, Lisp_Object
,
224 Lisp_Object
, Lisp_Object
));
225 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
226 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
229 /* Functions that read one byte from the current source READCHARFUN
230 or unreads one byte. If the integer argument C is -1, it returns
231 one read byte, or -1 when there's no more byte in the source. If C
232 is 0 or positive, it unreads C, and the return value is not
235 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
236 static int readbyte_from_file
P_ ((int, Lisp_Object
));
237 static int readbyte_from_string
P_ ((int, Lisp_Object
));
239 /* Handle unreading and rereading of characters.
240 Write READCHAR to read a character,
241 UNREAD(c) to unread c to be read again.
243 These macros correctly read/unread multibyte characters. */
245 #define READCHAR readchar (readcharfun)
246 #define UNREAD(c) unreadchar (readcharfun, c)
248 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
249 Qlambda, or a cons, we use this to keep an unread character because
250 a file stream can't handle multibyte-char unreading. The value -1
251 means that there's no unread character. */
252 static int unread_char
;
255 readchar (readcharfun
)
256 Lisp_Object readcharfun
;
260 int (*readbyte
) P_ ((int, Lisp_Object
));
261 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
263 int emacs_mule_encoding
= 0;
267 if (BUFFERP (readcharfun
))
269 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
271 int pt_byte
= BUF_PT_BYTE (inbuffer
);
273 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
276 if (! NILP (inbuffer
->enable_multibyte_characters
))
278 /* Fetch the character code from the buffer. */
279 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
280 BUF_INC_POS (inbuffer
, pt_byte
);
281 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
285 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
286 if (! ASCII_BYTE_P (c
))
287 c
= BYTE8_TO_CHAR (c
);
290 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
294 if (MARKERP (readcharfun
))
296 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
298 int bytepos
= marker_byte_position (readcharfun
);
300 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
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
);
313 if (! ASCII_BYTE_P (c
))
314 c
= BYTE8_TO_CHAR (c
);
318 XMARKER (readcharfun
)->bytepos
= bytepos
;
319 XMARKER (readcharfun
)->charpos
++;
324 if (EQ (readcharfun
, Qlambda
))
326 readbyte
= readbyte_for_lambda
;
330 if (EQ (readcharfun
, Qget_file_char
))
332 readbyte
= readbyte_from_file
;
336 if (STRINGP (readcharfun
))
338 if (read_from_string_index
>= read_from_string_limit
)
341 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
342 read_from_string_index
,
343 read_from_string_index_byte
);
348 if (CONSP (readcharfun
))
350 /* This is the case that read_vector is reading from a unibyte
351 string that contains a byte sequence previously skipped
352 because of #@NUMBER. The car part of readcharfun is that
353 string, and the cdr part is a value of readcharfun given to
355 readbyte
= readbyte_from_string
;
356 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
357 emacs_mule_encoding
= 1;
361 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
363 readbyte
= readbyte_from_file
;
364 emacs_mule_encoding
= 1;
368 tem
= call0 (readcharfun
);
375 if (unread_char
>= 0)
381 c
= (*readbyte
) (-1, readcharfun
);
382 if (c
< 0 || ASCII_BYTE_P (c
) || load_each_byte
)
384 if (emacs_mule_encoding
)
385 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
388 len
= BYTES_BY_CHAR_HEAD (c
);
391 c
= (*readbyte
) (-1, readcharfun
);
392 if (c
< 0 || ! TRAILING_CODE_P (c
))
395 (*readbyte
) (buf
[i
], readcharfun
);
396 return BYTE8_TO_CHAR (buf
[0]);
400 return STRING_CHAR (buf
, i
);
403 /* Unread the character C in the way appropriate for the stream READCHARFUN.
404 If the stream is a user function, call it with the char as argument. */
407 unreadchar (readcharfun
, c
)
408 Lisp_Object readcharfun
;
413 /* Don't back up the pointer if we're unreading the end-of-input mark,
414 since readchar didn't advance it when we read it. */
416 else if (BUFFERP (readcharfun
))
418 struct buffer
*b
= XBUFFER (readcharfun
);
419 int bytepos
= BUF_PT_BYTE (b
);
422 if (! NILP (b
->enable_multibyte_characters
))
423 BUF_DEC_POS (b
, bytepos
);
427 BUF_PT_BYTE (b
) = bytepos
;
429 else if (MARKERP (readcharfun
))
431 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
432 int bytepos
= XMARKER (readcharfun
)->bytepos
;
434 XMARKER (readcharfun
)->charpos
--;
435 if (! NILP (b
->enable_multibyte_characters
))
436 BUF_DEC_POS (b
, bytepos
);
440 XMARKER (readcharfun
)->bytepos
= bytepos
;
442 else if (STRINGP (readcharfun
))
444 read_from_string_index
--;
445 read_from_string_index_byte
446 = string_char_to_byte (readcharfun
, read_from_string_index
);
448 else if (CONSP (readcharfun
))
452 else if (EQ (readcharfun
, Qlambda
))
456 else if (EQ (readcharfun
, Qget_file_char
)
457 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
460 ungetc (c
, instream
);
465 call1 (readcharfun
, make_number (c
));
469 readbyte_for_lambda (c
, readcharfun
)
471 Lisp_Object readcharfun
;
473 return read_bytecode_char (c
>= 0);
478 readbyte_from_file (c
, readcharfun
)
480 Lisp_Object readcharfun
;
484 ungetc (c
, instream
);
490 /* Interrupted reads have been observed while reading over the network */
491 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
498 return (c
== EOF
? -1 : c
);
502 readbyte_from_string (c
, readcharfun
)
504 Lisp_Object readcharfun
;
506 Lisp_Object string
= XCAR (readcharfun
);
510 read_from_string_index
--;
511 read_from_string_index_byte
512 = string_char_to_byte (string
, read_from_string_index
);
515 if (read_from_string_index
>= read_from_string_limit
)
518 FETCH_STRING_CHAR_ADVANCE (c
, string
,
519 read_from_string_index
,
520 read_from_string_index_byte
);
525 /* Read one non-ASCII character from INSTREAM. The character is
526 encoded in `emacs-mule' and the first byte is already read in
529 extern char emacs_mule_bytes
[256];
532 read_emacs_mule_char (c
, readbyte
, readcharfun
)
534 int (*readbyte
) P_ ((int, Lisp_Object
));
535 Lisp_Object readcharfun
;
537 /* Emacs-mule coding uses at most 4-byte for one character. */
538 unsigned char buf
[4];
539 int len
= emacs_mule_bytes
[c
];
540 struct charset
*charset
;
545 /* C is not a valid leading-code of `emacs-mule'. */
546 return BYTE8_TO_CHAR (c
);
552 c
= (*readbyte
) (-1, readcharfun
);
556 (*readbyte
) (buf
[i
], readcharfun
);
557 return BYTE8_TO_CHAR (buf
[0]);
564 charset
= emacs_mule_charset
[buf
[0]];
565 code
= buf
[1] & 0x7F;
569 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
570 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
572 charset
= emacs_mule_charset
[buf
[1]];
573 code
= buf
[2] & 0x7F;
577 charset
= emacs_mule_charset
[buf
[0]];
578 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
583 charset
= emacs_mule_charset
[buf
[1]];
584 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
586 c
= DECODE_CHAR (charset
, code
);
588 Fsignal (Qinvalid_read_syntax
,
589 Fcons (build_string ("invalid multibyte form"), Qnil
));
594 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
596 static Lisp_Object read0
P_ ((Lisp_Object
));
597 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
599 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
600 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
602 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
604 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
606 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
609 /* Get a character from the tty. */
611 extern Lisp_Object
read_char ();
613 /* Read input events until we get one that's acceptable for our purposes.
615 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
616 until we get a character we like, and then stuffed into
619 If ASCII_REQUIRED is non-zero, we check function key events to see
620 if the unmodified version of the symbol has a Qascii_character
621 property, and use that character, if present.
623 If ERROR_NONASCII is non-zero, we signal an error if the input we
624 get isn't an ASCII character with modifiers. If it's zero but
625 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
628 If INPUT_METHOD is nonzero, we invoke the current input method
629 if the character warrants that. */
632 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
634 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
636 register Lisp_Object val
, delayed_switch_frame
;
638 #ifdef HAVE_WINDOW_SYSTEM
639 if (display_hourglass_p
)
643 delayed_switch_frame
= Qnil
;
645 /* Read until we get an acceptable event. */
647 val
= read_char (0, 0, 0,
648 (input_method
? Qnil
: Qt
),
654 /* switch-frame events are put off until after the next ASCII
655 character. This is better than signaling an error just because
656 the last characters were typed to a separate minibuffer frame,
657 for example. Eventually, some code which can deal with
658 switch-frame events will read it and process it. */
660 && EVENT_HAS_PARAMETERS (val
)
661 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
663 delayed_switch_frame
= val
;
669 /* Convert certain symbols to their ASCII equivalents. */
672 Lisp_Object tem
, tem1
;
673 tem
= Fget (val
, Qevent_symbol_element_mask
);
676 tem1
= Fget (Fcar (tem
), Qascii_character
);
677 /* Merge this symbol's modifier bits
678 with the ASCII equivalent of its basic code. */
680 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
684 /* If we don't have a character now, deal with it appropriately. */
689 Vunread_command_events
= Fcons (val
, Qnil
);
690 error ("Non-character input-event");
697 if (! NILP (delayed_switch_frame
))
698 unread_switch_frame
= delayed_switch_frame
;
702 #ifdef HAVE_WINDOW_SYSTEM
703 if (display_hourglass_p
)
712 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
713 doc
: /* Read a character from the command input (keyboard or macro).
714 It is returned as a number.
715 If the user generates an event which is not a character (i.e. a mouse
716 click or function key event), `read-char' signals an error. As an
717 exception, switch-frame events are put off until non-ASCII events can
719 If you want to read non-character events, or ignore them, call
720 `read-event' or `read-char-exclusive' instead.
722 If the optional argument PROMPT is non-nil, display that as a prompt.
723 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
724 input method is turned on in the current buffer, that input method
725 is used for reading a character. */)
726 (prompt
, inherit_input_method
)
727 Lisp_Object prompt
, inherit_input_method
;
730 message_with_string ("%s", prompt
, 0);
731 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
734 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
735 doc
: /* Read an event object from the input stream.
736 If the optional argument PROMPT is non-nil, display that as a prompt.
737 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
738 input method is turned on in the current buffer, that input method
739 is used for reading a character. */)
740 (prompt
, inherit_input_method
)
741 Lisp_Object prompt
, inherit_input_method
;
744 message_with_string ("%s", prompt
, 0);
745 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
748 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
749 doc
: /* Read a character from the command input (keyboard or macro).
750 It is returned as a number. Non-character events are ignored.
752 If the optional argument PROMPT is non-nil, display that as a prompt.
753 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
754 input method is turned on in the current buffer, that input method
755 is used for reading a character. */)
756 (prompt
, inherit_input_method
)
757 Lisp_Object prompt
, inherit_input_method
;
760 message_with_string ("%s", prompt
, 0);
761 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
764 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
765 doc
: /* Don't use this yourself. */)
768 register Lisp_Object val
;
769 XSETINT (val
, getc (instream
));
775 /* Value is a version number of byte compiled code if the file
776 asswociated with file descriptor FD is a compiled Lisp file that's
777 safe to load. Only files compiled with Emacs are safe to load.
778 Files compiled with XEmacs can lead to a crash in Fbyte_code
779 because of an incompatible change in the byte compiler. */
790 /* Read the first few bytes from the file, and look for a line
791 specifying the byte compiler version used. */
792 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
797 /* Skip to the next newline, skipping over the initial `ELC'
798 with NUL bytes following it, but note the version. */
799 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
804 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
811 lseek (fd
, 0, SEEK_SET
);
816 /* Callback for record_unwind_protect. Restore the old load list OLD,
817 after loading a file successfully. */
820 record_load_unwind (old
)
823 return Vloads_in_progress
= old
;
826 /* This handler function is used via internal_condition_case_1. */
829 load_error_handler (data
)
835 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
836 doc
: /* Execute a file of Lisp code named FILE.
837 First try FILE with `.elc' appended, then try with `.el',
838 then try FILE unmodified (the exact suffixes are determined by
839 `load-suffixes'). Environment variable references in FILE
840 are replaced with their values by calling `substitute-in-file-name'.
841 This function searches the directories in `load-path'.
842 If optional second arg NOERROR is non-nil,
843 report no error if FILE doesn't exist.
844 Print messages at start and end of loading unless
845 optional third arg NOMESSAGE is non-nil.
846 If optional fourth arg NOSUFFIX is non-nil, don't try adding
847 suffixes `.elc' or `.el' to the specified name FILE.
848 If optional fifth arg MUST-SUFFIX is non-nil, insist on
849 the suffix `.elc' or `.el'; don't accept just FILE unless
850 it ends in one of those suffixes or includes a directory name.
852 Loading a file records its definitions, and its `provide' and
853 `require' calls, in an element of `load-history' whose
854 car is the file name loaded. See `load-history'.
856 Return t if file exists. */)
857 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
858 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
860 register FILE *stream
;
861 register int fd
= -1;
862 int count
= SPECPDL_INDEX ();
864 struct gcpro gcpro1
, gcpro2
;
865 Lisp_Object found
, efound
;
866 /* 1 means we printed the ".el is newer" message. */
868 /* 1 means we are loading a compiled file. */
881 /* If file name is magic, call the handler. */
882 /* This shouldn't be necessary any more now that `openp' handles it right.
883 handler = Ffind_file_name_handler (file, Qload);
885 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
887 /* Do this after the handler to avoid
888 the need to gcpro noerror, nomessage and nosuffix.
889 (Below here, we care only whether they are nil or not.)
890 The presence of this call is the result of a historical accident:
891 it used to be in every file-operations and when it got removed
892 everywhere, it accidentally stayed here. Since then, enough people
893 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
894 that it seemed risky to remove. */
895 if (! NILP (noerror
))
897 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
898 Qt
, load_error_handler
);
903 file
= Fsubstitute_in_file_name (file
);
906 /* Avoid weird lossage with null string as arg,
907 since it would try to load a directory as a Lisp file */
908 if (SCHARS (file
) > 0)
910 int size
= SBYTES (file
);
914 GCPRO2 (file
, found
);
916 if (! NILP (must_suffix
))
918 /* Don't insist on adding a suffix if FILE already ends with one. */
920 && !strcmp (SDATA (file
) + size
- 3, ".el"))
923 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
925 /* Don't insist on adding a suffix
926 if the argument includes a directory name. */
927 else if (! NILP (Ffile_name_directory (file
)))
931 fd
= openp (Vload_path
, file
,
932 (!NILP (nosuffix
) ? Qnil
933 : !NILP (must_suffix
) ? Vload_suffixes
934 : Fappend (2, (tmp
[0] = Vload_suffixes
,
935 tmp
[1] = default_suffixes
,
944 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
945 Fcons (file
, Qnil
)));
950 /* Tell startup.el whether or not we found the user's init file. */
951 if (EQ (Qt
, Vuser_init_file
))
952 Vuser_init_file
= found
;
954 /* If FD is -2, that means openp found a magic file. */
957 if (NILP (Fequal (found
, file
)))
958 /* If FOUND is a different file name from FILE,
959 find its handler even if we have already inhibited
960 the `load' operation on FILE. */
961 handler
= Ffind_file_name_handler (found
, Qt
);
963 handler
= Ffind_file_name_handler (found
, Qload
);
964 if (! NILP (handler
))
965 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
968 /* Check if we're stuck in a recursive load cycle.
970 2000-09-21: It's not possible to just check for the file loaded
971 being a member of Vloads_in_progress. This fails because of the
972 way the byte compiler currently works; `provide's are not
973 evaluted, see font-lock.el/jit-lock.el as an example. This
974 leads to a certain amount of ``normal'' recursion.
976 Also, just loading a file recursively is not always an error in
977 the general case; the second load may do something different. */
981 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
982 if (!NILP (Fequal (found
, XCAR (tem
))))
985 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
986 Fcons (found
, Vloads_in_progress
)));
987 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
988 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
992 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
994 || (version
= safe_to_load_p (fd
)) > 0)
995 /* Load .elc files directly, but not when they are
996 remote and have no handler! */
1003 GCPRO2 (file
, found
);
1006 && ! (version
= safe_to_load_p (fd
)))
1009 if (!load_dangerous_libraries
)
1013 error ("File `%s' was not compiled in Emacs",
1016 else if (!NILP (nomessage
))
1017 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1022 efound
= ENCODE_FILE (found
);
1027 stat ((char *)SDATA (efound
), &s1
);
1028 SSET (efound
, SBYTES (efound
) - 1, 0);
1029 result
= stat ((char *)SDATA (efound
), &s2
);
1030 SSET (efound
, SBYTES (efound
) - 1, 'c');
1032 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1034 /* Make the progress messages mention that source is newer. */
1037 /* If we won't print another message, mention this anyway. */
1038 if (!NILP (nomessage
))
1040 Lisp_Object msg_file
;
1041 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1042 message_with_string ("Source file `%s' newer than byte-compiled file",
1051 /* We are loading a source file (*.el). */
1052 if (!NILP (Vload_source_file_function
))
1058 val
= call4 (Vload_source_file_function
, found
, file
,
1059 NILP (noerror
) ? Qnil
: Qt
,
1060 NILP (nomessage
) ? Qnil
: Qt
);
1061 return unbind_to (count
, val
);
1065 GCPRO2 (file
, found
);
1069 efound
= ENCODE_FILE (found
);
1070 stream
= fopen ((char *) SDATA (efound
), fmode
);
1071 #else /* not WINDOWSNT */
1072 stream
= fdopen (fd
, fmode
);
1073 #endif /* not WINDOWSNT */
1077 error ("Failure to create stdio stream for %s", SDATA (file
));
1080 if (! NILP (Vpurify_flag
))
1081 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1083 if (NILP (nomessage
))
1086 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1089 message_with_string ("Loading %s (source)...", file
, 1);
1091 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1093 else /* The typical case; compiled file newer than source file. */
1094 message_with_string ("Loading %s...", file
, 1);
1097 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1098 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1099 specbind (Qload_file_name
, found
);
1100 specbind (Qinhibit_file_name_operation
, Qnil
);
1101 load_descriptor_list
1102 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1104 if (! version
|| version
>= 22)
1105 readevalloop (Qget_file_char
, stream
,
1106 (! NILP (Vpurify_flag
) ? file
: found
),
1107 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1110 /* We can't handle a file which was compiled with
1111 byte-compile-dynamic by older version of Emacs. */
1112 specbind (Qload_force_doc_strings
, Qt
);
1113 readevalloop (Qget_emacs_mule_file_char
, stream
, file
, Feval
,
1114 0, Qnil
, Qnil
, Qnil
, Qnil
);
1116 unbind_to (count
, Qnil
);
1118 /* Run any load-hooks for this file. */
1119 temp
= Fassoc (file
, Vafter_load_alist
);
1121 Fprogn (Fcdr (temp
));
1124 if (saved_doc_string
)
1125 free (saved_doc_string
);
1126 saved_doc_string
= 0;
1127 saved_doc_string_size
= 0;
1129 if (prev_saved_doc_string
)
1130 xfree (prev_saved_doc_string
);
1131 prev_saved_doc_string
= 0;
1132 prev_saved_doc_string_size
= 0;
1134 if (!noninteractive
&& NILP (nomessage
))
1137 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1140 message_with_string ("Loading %s (source)...done", file
, 1);
1142 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1144 else /* The typical case; compiled file newer than source file. */
1145 message_with_string ("Loading %s...done", file
, 1);
1148 if (!NILP (Fequal (build_string ("obsolete"),
1149 Ffile_name_nondirectory
1150 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1151 message_with_string ("Package %s is obsolete", file
, 1);
1157 load_unwind (arg
) /* used as unwind-protect function in load */
1160 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1163 if (--load_in_progress
< 0) load_in_progress
= 0;
1168 load_descriptor_unwind (oldlist
)
1169 Lisp_Object oldlist
;
1171 load_descriptor_list
= oldlist
;
1175 /* Close all descriptors in use for Floads.
1176 This is used when starting a subprocess. */
1183 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1184 emacs_close (XFASTINT (XCAR (tail
)));
1189 complete_filename_p (pathname
)
1190 Lisp_Object pathname
;
1192 register const unsigned char *s
= SDATA (pathname
);
1193 return (IS_DIRECTORY_SEP (s
[0])
1194 || (SCHARS (pathname
) > 2
1195 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1205 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1206 doc
: /* Search for FILENAME through PATH.
1207 Returns the file's name in absolute form, or nil if not found.
1208 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1209 file name when searching.
1210 If non-nil, PREDICATE is used instead of `file-readable-p'.
1211 PREDICATE can also be an integer to pass to the access(2) function,
1212 in which case file-name-handlers are ignored. */)
1213 (filename
, path
, suffixes
, predicate
)
1214 Lisp_Object filename
, path
, suffixes
, predicate
;
1217 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1218 if (NILP (predicate
) && fd
> 0)
1224 /* Search for a file whose name is STR, looking in directories
1225 in the Lisp list PATH, and trying suffixes from SUFFIX.
1226 On success, returns a file descriptor. On failure, returns -1.
1228 SUFFIXES is a list of strings containing possible suffixes.
1229 The empty suffix is automatically added iff the list is empty.
1231 PREDICATE non-nil means don't open the files,
1232 just look for one that satisfies the predicate. In this case,
1233 returns 1 on success. The predicate can be a lisp function or
1234 an integer to pass to `access' (in which case file-name-handlers
1237 If STOREPTR is nonzero, it points to a slot where the name of
1238 the file actually found should be stored as a Lisp string.
1239 nil is stored there on failure.
1241 If the file we find is remote, return -2
1242 but store the found remote file name in *STOREPTR. */
1245 openp (path
, str
, suffixes
, storeptr
, predicate
)
1246 Lisp_Object path
, str
;
1247 Lisp_Object suffixes
;
1248 Lisp_Object
*storeptr
;
1249 Lisp_Object predicate
;
1254 register char *fn
= buf
;
1257 Lisp_Object filename
;
1259 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1260 Lisp_Object string
, tail
, encoded_fn
;
1261 int max_suffix_len
= 0;
1265 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1267 CHECK_STRING_CAR (tail
);
1268 max_suffix_len
= max (max_suffix_len
,
1269 SBYTES (XCAR (tail
)));
1272 string
= filename
= Qnil
;
1273 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1278 if (complete_filename_p (str
))
1281 for (; CONSP (path
); path
= XCDR (path
))
1283 filename
= Fexpand_file_name (str
, XCAR (path
));
1284 if (!complete_filename_p (filename
))
1285 /* If there are non-absolute elts in PATH (eg ".") */
1286 /* Of course, this could conceivably lose if luser sets
1287 default-directory to be something non-absolute... */
1289 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1290 if (!complete_filename_p (filename
))
1291 /* Give up on this path element! */
1295 /* Calculate maximum size of any filename made from
1296 this path element/specified file name and any possible suffix. */
1297 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1298 if (fn_size
< want_size
)
1299 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1301 /* Loop over suffixes. */
1302 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1303 CONSP (tail
); tail
= XCDR (tail
))
1305 int lsuffix
= SBYTES (XCAR (tail
));
1306 Lisp_Object handler
;
1309 /* Concatenate path element/specified name with the suffix.
1310 If the directory starts with /:, remove that. */
1311 if (SCHARS (filename
) > 2
1312 && SREF (filename
, 0) == '/'
1313 && SREF (filename
, 1) == ':')
1315 strncpy (fn
, SDATA (filename
) + 2,
1316 SBYTES (filename
) - 2);
1317 fn
[SBYTES (filename
) - 2] = 0;
1321 strncpy (fn
, SDATA (filename
),
1323 fn
[SBYTES (filename
)] = 0;
1326 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1327 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1329 /* Check that the file exists and is not a directory. */
1330 /* We used to only check for handlers on non-absolute file names:
1334 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1335 It's not clear why that was the case and it breaks things like
1336 (load "/bar.el") where the file is actually "/bar.el.gz". */
1337 string
= build_string (fn
);
1338 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1339 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1341 if (NILP (predicate
))
1342 exists
= !NILP (Ffile_readable_p (string
));
1344 exists
= !NILP (call1 (predicate
, string
));
1345 if (exists
&& !NILP (Ffile_directory_p (string
)))
1350 /* We succeeded; return this descriptor and filename. */
1361 encoded_fn
= ENCODE_FILE (string
);
1362 pfn
= SDATA (encoded_fn
);
1363 exists
= (stat (pfn
, &st
) >= 0
1364 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1367 /* Check that we can access or open it. */
1368 if (NATNUMP (predicate
))
1369 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1371 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1375 /* We succeeded; return this descriptor and filename. */
1393 /* Merge the list we've accumulated of globals from the current input source
1394 into the load_history variable. The details depend on whether
1395 the source has an associated file name or not. */
1398 build_load_history (stream
, source
)
1402 register Lisp_Object tail
, prev
, newelt
;
1403 register Lisp_Object tem
, tem2
;
1404 register int foundit
, loading
;
1406 loading
= stream
|| !NARROWED
;
1408 tail
= Vload_history
;
1411 while (CONSP (tail
))
1415 /* Find the feature's previous assoc list... */
1416 if (!NILP (Fequal (source
, Fcar (tem
))))
1420 /* If we're loading, remove it. */
1424 Vload_history
= XCDR (tail
);
1426 Fsetcdr (prev
, XCDR (tail
));
1429 /* Otherwise, cons on new symbols that are not already members. */
1432 tem2
= Vcurrent_load_list
;
1434 while (CONSP (tem2
))
1436 newelt
= XCAR (tem2
);
1438 if (NILP (Fmember (newelt
, tem
)))
1439 Fsetcar (tail
, Fcons (XCAR (tem
),
1440 Fcons (newelt
, XCDR (tem
))));
1453 /* If we're loading, cons the new assoc onto the front of load-history,
1454 the most-recently-loaded position. Also do this if we didn't find
1455 an existing member for the current source. */
1456 if (loading
|| !foundit
)
1457 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1462 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1470 readevalloop_1 (old
)
1473 load_convert_to_unibyte
= ! NILP (old
);
1477 /* Signal an `end-of-file' error, if possible with file name
1481 end_of_file_error ()
1485 if (STRINGP (Vload_file_name
))
1486 data
= Fcons (Vload_file_name
, Qnil
);
1490 Fsignal (Qend_of_file
, data
);
1493 /* UNIBYTE specifies how to set load_convert_to_unibyte
1494 for this invocation.
1495 READFUN, if non-nil, is used instead of `read'.
1496 START, END is region in current buffer (from eval-region). */
1499 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1500 printflag
, unibyte
, readfun
, start
, end
)
1501 Lisp_Object readcharfun
;
1503 Lisp_Object sourcename
;
1504 Lisp_Object (*evalfun
) ();
1506 Lisp_Object unibyte
, readfun
;
1507 Lisp_Object start
, end
;
1510 register Lisp_Object val
;
1511 int count
= SPECPDL_INDEX ();
1512 struct gcpro gcpro1
;
1513 struct buffer
*b
= 0;
1514 int continue_reading_p
;
1516 if (BUFFERP (readcharfun
))
1517 b
= XBUFFER (readcharfun
);
1518 else if (MARKERP (readcharfun
))
1519 b
= XMARKER (readcharfun
)->buffer
;
1521 specbind (Qstandard_input
, readcharfun
);
1522 specbind (Qcurrent_load_list
, Qnil
);
1523 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1524 load_convert_to_unibyte
= !NILP (unibyte
);
1526 GCPRO1 (sourcename
);
1528 LOADHIST_ATTACH (sourcename
);
1530 continue_reading_p
= 1;
1531 while (continue_reading_p
)
1533 int count1
= SPECPDL_INDEX ();
1535 if (b
!= 0 && NILP (b
->name
))
1536 error ("Reading from killed buffer");
1540 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1541 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1543 Fnarrow_to_region (make_number (BEGV
), end
);
1551 while ((c
= READCHAR
) != '\n' && c
!= -1);
1556 unbind_to (count1
, Qnil
);
1560 /* Ignore whitespace here, so we can detect eof. */
1561 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1564 if (!NILP (Vpurify_flag
) && c
== '(')
1566 record_unwind_protect (unreadpure
, Qnil
);
1567 val
= read_list (-1, readcharfun
);
1572 read_objects
= Qnil
;
1573 if (!NILP (readfun
))
1575 val
= call1 (readfun
, readcharfun
);
1577 /* If READCHARFUN has set point to ZV, we should
1578 stop reading, even if the form read sets point
1579 to a different value when evaluated. */
1580 if (BUFFERP (readcharfun
))
1582 struct buffer
*b
= XBUFFER (readcharfun
);
1583 if (BUF_PT (b
) == BUF_ZV (b
))
1584 continue_reading_p
= 0;
1587 else if (! NILP (Vload_read_function
))
1588 val
= call1 (Vload_read_function
, readcharfun
);
1590 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1593 if (!NILP (start
) && continue_reading_p
)
1594 start
= Fpoint_marker ();
1595 unbind_to (count1
, Qnil
);
1597 val
= (*evalfun
) (val
);
1601 Vvalues
= Fcons (val
, Vvalues
);
1602 if (EQ (Vstandard_output
, Qt
))
1609 build_load_history (stream
, sourcename
);
1612 unbind_to (count
, Qnil
);
1615 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1616 doc
: /* Execute the current buffer as Lisp code.
1617 Programs can pass two arguments, BUFFER and PRINTFLAG.
1618 BUFFER is the buffer to evaluate (nil means use current buffer).
1619 PRINTFLAG controls printing of output:
1620 nil means discard it; anything else is stream for print.
1622 If the optional third argument FILENAME is non-nil,
1623 it specifies the file name to use for `load-history'.
1624 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1625 for this invocation.
1627 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1628 `print' and related functions should work normally even if PRINTFLAG is nil.
1630 This function preserves the position of point. */)
1631 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1632 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1634 int count
= SPECPDL_INDEX ();
1635 Lisp_Object tem
, buf
;
1638 buf
= Fcurrent_buffer ();
1640 buf
= Fget_buffer (buffer
);
1642 error ("No such buffer");
1644 if (NILP (printflag
) && NILP (do_allow_print
))
1649 if (NILP (filename
))
1650 filename
= XBUFFER (buf
)->filename
;
1652 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1653 specbind (Qstandard_output
, tem
);
1654 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1655 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1656 readevalloop (buf
, 0, filename
, Feval
,
1657 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1658 unbind_to (count
, Qnil
);
1663 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1664 doc
: /* Execute the region as Lisp code.
1665 When called from programs, expects two arguments,
1666 giving starting and ending indices in the current buffer
1667 of the text to be executed.
1668 Programs can pass third argument PRINTFLAG which controls output:
1669 nil means discard it; anything else is stream for printing it.
1670 Also the fourth argument READ-FUNCTION, if non-nil, is used
1671 instead of `read' to read each expression. It gets one argument
1672 which is the input stream for reading characters.
1674 This function does not move point. */)
1675 (start
, end
, printflag
, read_function
)
1676 Lisp_Object start
, end
, printflag
, read_function
;
1678 int count
= SPECPDL_INDEX ();
1679 Lisp_Object tem
, cbuf
;
1681 cbuf
= Fcurrent_buffer ();
1683 if (NILP (printflag
))
1687 specbind (Qstandard_output
, tem
);
1688 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1690 /* readevalloop calls functions which check the type of start and end. */
1691 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1692 !NILP (printflag
), Qnil
, read_function
,
1695 return unbind_to (count
, Qnil
);
1699 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1700 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1701 If STREAM is nil, use the value of `standard-input' (which see).
1702 STREAM or the value of `standard-input' may be:
1703 a buffer (read from point and advance it)
1704 a marker (read from where it points and advance it)
1705 a function (call it with no arguments for each character,
1706 call it with a char as argument to push a char back)
1707 a string (takes text from string, starting at the beginning)
1708 t (read text line using minibuffer and use it, or read from
1709 standard input in batch mode). */)
1714 stream
= Vstandard_input
;
1715 if (EQ (stream
, Qt
))
1716 stream
= Qread_char
;
1717 if (EQ (stream
, Qread_char
))
1718 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1720 return read_internal_start (stream
, Qnil
, Qnil
);
1723 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1724 doc
: /* Read one Lisp expression which is represented as text by STRING.
1725 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1726 START and END optionally delimit a substring of STRING from which to read;
1727 they default to 0 and (length STRING) respectively. */)
1728 (string
, start
, end
)
1729 Lisp_Object string
, start
, end
;
1732 CHECK_STRING (string
);
1733 /* read_internal_start sets read_from_string_index. */
1734 ret
= read_internal_start (string
, start
, end
);
1735 return Fcons (ret
, make_number (read_from_string_index
));
1738 /* Function to set up the global context we need in toplevel read
1741 read_internal_start (stream
, start
, end
)
1743 Lisp_Object start
; /* Only used when stream is a string. */
1744 Lisp_Object end
; /* Only used when stream is a string. */
1749 new_backquote_flag
= 0;
1750 read_objects
= Qnil
;
1751 if (EQ (Vread_with_symbol_positions
, Qt
)
1752 || EQ (Vread_with_symbol_positions
, stream
))
1753 Vread_symbol_positions_list
= Qnil
;
1755 if (STRINGP (stream
)
1756 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1758 int startval
, endval
;
1761 if (STRINGP (stream
))
1764 string
= XCAR (stream
);
1767 endval
= SCHARS (string
);
1771 endval
= XINT (end
);
1772 if (endval
< 0 || endval
> SCHARS (string
))
1773 args_out_of_range (string
, end
);
1780 CHECK_NUMBER (start
);
1781 startval
= XINT (start
);
1782 if (startval
< 0 || startval
> endval
)
1783 args_out_of_range (string
, start
);
1785 read_from_string_index
= startval
;
1786 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1787 read_from_string_limit
= endval
;
1790 retval
= read0 (stream
);
1791 if (EQ (Vread_with_symbol_positions
, Qt
)
1792 || EQ (Vread_with_symbol_positions
, stream
))
1793 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1797 /* Use this for recursive reads, in contexts where internal tokens
1802 Lisp_Object readcharfun
;
1804 register Lisp_Object val
;
1807 val
= read1 (readcharfun
, &c
, 0);
1809 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1816 static int read_buffer_size
;
1817 static char *read_buffer
;
1819 /* Read a \-escape sequence, assuming we already read the `\'.
1820 If the escape sequence forces unibyte, return eight-bit char. */
1823 read_escape (readcharfun
, stringp
)
1824 Lisp_Object readcharfun
;
1827 register int c
= READCHAR
;
1832 end_of_file_error ();
1862 error ("Invalid escape character syntax");
1865 c
= read_escape (readcharfun
, 0);
1866 return c
| meta_modifier
;
1871 error ("Invalid escape character syntax");
1874 c
= read_escape (readcharfun
, 0);
1875 return c
| shift_modifier
;
1880 error ("Invalid escape character syntax");
1883 c
= read_escape (readcharfun
, 0);
1884 return c
| hyper_modifier
;
1889 error ("Invalid escape character syntax");
1892 c
= read_escape (readcharfun
, 0);
1893 return c
| alt_modifier
;
1905 c
= read_escape (readcharfun
, 0);
1906 return c
| super_modifier
;
1911 error ("Invalid escape character syntax");
1915 c
= read_escape (readcharfun
, 0);
1916 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1917 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1918 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1919 return c
| ctrl_modifier
;
1920 /* ASCII control chars are made from letters (both cases),
1921 as well as the non-letters within 0100...0137. */
1922 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1923 return (c
& (037 | ~0177));
1924 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1925 return (c
& (037 | ~0177));
1927 return c
| ctrl_modifier
;
1937 /* An octal escape, as in ANSI C. */
1939 register int i
= c
- '0';
1940 register int count
= 0;
1943 if ((c
= READCHAR
) >= '0' && c
<= '7')
1955 if (i
>= 0x80 && i
< 0x100)
1956 i
= BYTE8_TO_CHAR (i
);
1961 /* A hex escape, as in ANSI C. */
1968 if (c
>= '0' && c
<= '9')
1973 else if ((c
>= 'a' && c
<= 'f')
1974 || (c
>= 'A' && c
<= 'F'))
1977 if (c
>= 'a' && c
<= 'f')
1990 if (count
< 3 && i
>= 0x80)
1991 return BYTE8_TO_CHAR (i
);
2001 /* Read an integer in radix RADIX using READCHARFUN to read
2002 characters. RADIX must be in the interval [2..36]; if it isn't, a
2003 read error is signaled . Value is the integer read. Signals an
2004 error if encountering invalid read syntax or if RADIX is out of
2008 read_integer (readcharfun
, radix
)
2009 Lisp_Object readcharfun
;
2012 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2013 EMACS_INT number
= 0;
2015 if (radix
< 2 || radix
> 36)
2019 number
= ndigits
= invalid_p
= 0;
2035 if (c
>= '0' && c
<= '9')
2037 else if (c
>= 'a' && c
<= 'z')
2038 digit
= c
- 'a' + 10;
2039 else if (c
>= 'A' && c
<= 'Z')
2040 digit
= c
- 'A' + 10;
2047 if (digit
< 0 || digit
>= radix
)
2050 number
= radix
* number
+ digit
;
2056 if (ndigits
== 0 || invalid_p
)
2059 sprintf (buf
, "integer, radix %d", radix
);
2060 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
2063 return make_number (sign
* number
);
2067 /* If the next token is ')' or ']' or '.', we store that character
2068 in *PCH and the return value is not interesting. Else, we store
2069 zero in *PCH and we read and return one lisp object.
2071 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2074 read1 (readcharfun
, pch
, first_in_list
)
2075 register Lisp_Object readcharfun
;
2080 int uninterned_symbol
= 0;
2089 end_of_file_error ();
2094 return read_list (0, readcharfun
);
2097 return read_vector (readcharfun
, 0);
2114 tmp
= read_vector (readcharfun
, 0);
2115 if (XVECTOR (tmp
)->size
< VECSIZE (struct Lisp_Char_Table
))
2116 error ("Invalid size char-table");
2117 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2128 tmp
= read_vector (readcharfun
, 0);
2129 if (!INTEGERP (AREF (tmp
, 0)))
2130 error ("Invalid depth in char-table");
2131 depth
= XINT (AREF (tmp
, 0));
2132 if (depth
< 1 || depth
> 3)
2133 error ("Invalid depth in char-table");
2134 size
= XVECTOR (tmp
)->size
- 2;
2135 if (chartab_size
[depth
] != size
)
2136 error ("Invalid size char-table");
2137 XSETSUB_CHAR_TABLE (tmp
, XSUB_CHAR_TABLE (tmp
));
2140 Fsignal (Qinvalid_read_syntax
,
2141 Fcons (make_string ("#^^", 3), Qnil
));
2143 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2148 length
= read1 (readcharfun
, pch
, first_in_list
);
2152 Lisp_Object tmp
, val
;
2154 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2155 / BOOL_VECTOR_BITS_PER_CHAR
);
2158 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2159 if (STRING_MULTIBYTE (tmp
)
2160 || (size_in_chars
!= SCHARS (tmp
)
2161 /* We used to print 1 char too many
2162 when the number of bits was a multiple of 8.
2163 Accept such input in case it came from an old
2165 && ! (XFASTINT (length
)
2166 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2167 Fsignal (Qinvalid_read_syntax
,
2168 Fcons (make_string ("#&...", 5), Qnil
));
2170 val
= Fmake_bool_vector (length
, Qnil
);
2171 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2173 /* Clear the extraneous bits in the last byte. */
2174 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2175 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2176 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2179 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2184 /* Accept compiled functions at read-time so that we don't have to
2185 build them using function calls. */
2187 tmp
= read_vector (readcharfun
, 1);
2188 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2189 XVECTOR (tmp
)->contents
);
2194 struct gcpro gcpro1
;
2197 /* Read the string itself. */
2198 tmp
= read1 (readcharfun
, &ch
, 0);
2199 if (ch
!= 0 || !STRINGP (tmp
))
2200 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2202 /* Read the intervals and their properties. */
2205 Lisp_Object beg
, end
, plist
;
2207 beg
= read1 (readcharfun
, &ch
, 0);
2212 end
= read1 (readcharfun
, &ch
, 0);
2214 plist
= read1 (readcharfun
, &ch
, 0);
2216 Fsignal (Qinvalid_read_syntax
,
2217 Fcons (build_string ("invalid string property list"),
2219 Fset_text_properties (beg
, end
, plist
, tmp
);
2225 /* #@NUMBER is used to skip NUMBER following characters.
2226 That's used in .elc files to skip over doc strings
2227 and function definitions. */
2233 /* Read a decimal integer. */
2234 while ((c
= READCHAR
) >= 0
2235 && c
>= '0' && c
<= '9')
2243 if (load_force_doc_strings
2244 && (EQ (readcharfun
, Qget_file_char
)
2245 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2247 /* If we are supposed to force doc strings into core right now,
2248 record the last string that we skipped,
2249 and record where in the file it comes from. */
2251 /* But first exchange saved_doc_string
2252 with prev_saved_doc_string, so we save two strings. */
2254 char *temp
= saved_doc_string
;
2255 int temp_size
= saved_doc_string_size
;
2256 file_offset temp_pos
= saved_doc_string_position
;
2257 int temp_len
= saved_doc_string_length
;
2259 saved_doc_string
= prev_saved_doc_string
;
2260 saved_doc_string_size
= prev_saved_doc_string_size
;
2261 saved_doc_string_position
= prev_saved_doc_string_position
;
2262 saved_doc_string_length
= prev_saved_doc_string_length
;
2264 prev_saved_doc_string
= temp
;
2265 prev_saved_doc_string_size
= temp_size
;
2266 prev_saved_doc_string_position
= temp_pos
;
2267 prev_saved_doc_string_length
= temp_len
;
2270 if (saved_doc_string_size
== 0)
2272 saved_doc_string_size
= nskip
+ 100;
2273 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2275 if (nskip
> saved_doc_string_size
)
2277 saved_doc_string_size
= nskip
+ 100;
2278 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2279 saved_doc_string_size
);
2282 saved_doc_string_position
= file_tell (instream
);
2284 /* Copy that many characters into saved_doc_string. */
2285 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2286 saved_doc_string
[i
] = c
= READCHAR
;
2288 saved_doc_string_length
= i
;
2292 /* Skip that many characters. */
2293 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2302 /* #! appears at the beginning of an executable file.
2303 Skip the first line. */
2304 while (c
!= '\n' && c
>= 0)
2309 return Vload_file_name
;
2311 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2312 /* #:foo is the uninterned symbol named foo. */
2315 uninterned_symbol
= 1;
2319 /* Reader forms that can reuse previously read objects. */
2320 if (c
>= '0' && c
<= '9')
2325 /* Read a non-negative integer. */
2326 while (c
>= '0' && c
<= '9')
2332 /* #n=object returns object, but associates it with n for #n#. */
2335 /* Make a placeholder for #n# to use temporarily */
2336 Lisp_Object placeholder
;
2339 placeholder
= Fcons(Qnil
, Qnil
);
2340 cell
= Fcons (make_number (n
), placeholder
);
2341 read_objects
= Fcons (cell
, read_objects
);
2343 /* Read the object itself. */
2344 tem
= read0 (readcharfun
);
2346 /* Now put it everywhere the placeholder was... */
2347 substitute_object_in_subtree (tem
, placeholder
);
2349 /* ...and #n# will use the real value from now on. */
2350 Fsetcdr (cell
, tem
);
2354 /* #n# returns a previously read object. */
2357 tem
= Fassq (make_number (n
), read_objects
);
2360 /* Fall through to error message. */
2362 else if (c
== 'r' || c
== 'R')
2363 return read_integer (readcharfun
, n
);
2365 /* Fall through to error message. */
2367 else if (c
== 'x' || c
== 'X')
2368 return read_integer (readcharfun
, 16);
2369 else if (c
== 'o' || c
== 'O')
2370 return read_integer (readcharfun
, 8);
2371 else if (c
== 'b' || c
== 'B')
2372 return read_integer (readcharfun
, 2);
2375 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2378 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2383 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2393 new_backquote_flag
++;
2394 value
= read0 (readcharfun
);
2395 new_backquote_flag
--;
2397 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2401 if (new_backquote_flag
)
2403 Lisp_Object comma_type
= Qnil
;
2408 comma_type
= Qcomma_at
;
2410 comma_type
= Qcomma_dot
;
2413 if (ch
>= 0) UNREAD (ch
);
2414 comma_type
= Qcomma
;
2417 new_backquote_flag
--;
2418 value
= read0 (readcharfun
);
2419 new_backquote_flag
++;
2420 return Fcons (comma_type
, Fcons (value
, Qnil
));
2433 end_of_file_error ();
2435 /* Accept `single space' syntax like (list ? x) where the
2436 whitespace character is SPC or TAB.
2437 Other literal whitespace like NL, CR, and FF are not accepted,
2438 as there are well-established escape sequences for these. */
2439 if (c
== ' ' || c
== '\t')
2440 return make_number (c
);
2443 c
= read_escape (readcharfun
, 0);
2444 modifiers
= c
& CHAR_MODIFIER_MASK
;
2445 c
&= ~CHAR_MODIFIER_MASK
;
2446 if (CHAR_BYTE8_P (c
))
2447 c
= CHAR_TO_BYTE8 (c
);
2450 next_char
= READCHAR
;
2451 if (next_char
== '.')
2453 /* Only a dotted-pair dot is valid after a char constant. */
2454 int next_next_char
= READCHAR
;
2455 UNREAD (next_next_char
);
2457 ok
= (next_next_char
<= 040
2458 || (next_next_char
< 0200
2459 && (index ("\"';([#?", next_next_char
)
2460 || (!first_in_list
&& next_next_char
== '`')
2461 || (new_backquote_flag
&& next_next_char
== ','))));
2465 ok
= (next_char
<= 040
2466 || (next_char
< 0200
2467 && (index ("\"';()[]#?", next_char
)
2468 || (!first_in_list
&& next_char
== '`')
2469 || (new_backquote_flag
&& next_char
== ','))));
2473 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2475 return make_number (c
);
2480 char *p
= read_buffer
;
2481 char *end
= read_buffer
+ read_buffer_size
;
2483 /* Nonzero if we saw an escape sequence specifying
2484 a multibyte character. */
2485 int force_multibyte
= 0;
2486 /* Nonzero if we saw an escape sequence specifying
2487 a single-byte character. */
2488 int force_singlebyte
= 0;
2492 while ((c
= READCHAR
) >= 0
2495 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2497 int offset
= p
- read_buffer
;
2498 read_buffer
= (char *) xrealloc (read_buffer
,
2499 read_buffer_size
*= 2);
2500 p
= read_buffer
+ offset
;
2501 end
= read_buffer
+ read_buffer_size
;
2508 c
= read_escape (readcharfun
, 1);
2510 /* C is -1 if \ newline has just been seen */
2513 if (p
== read_buffer
)
2518 modifiers
= c
& CHAR_MODIFIER_MASK
;
2519 c
= c
& ~CHAR_MODIFIER_MASK
;
2521 if (CHAR_BYTE8_P (c
))
2522 force_singlebyte
= 1;
2523 else if (! ASCII_CHAR_P (c
))
2524 force_multibyte
= 1;
2525 else /* i.e. ASCII_CHAR_P (c) */
2527 /* Allow `\C- ' and `\C-?'. */
2528 if (modifiers
== CHAR_CTL
)
2531 c
= 0, modifiers
= 0;
2533 c
= 127, modifiers
= 0;
2535 if (modifiers
& CHAR_SHIFT
)
2537 /* Shift modifier is valid only with [A-Za-z]. */
2538 if (c
>= 'A' && c
<= 'Z')
2539 modifiers
&= ~CHAR_SHIFT
;
2540 else if (c
>= 'a' && c
<= 'z')
2541 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2544 if (modifiers
& CHAR_META
)
2546 /* Move the meta bit to the right place for a
2548 modifiers
&= ~CHAR_META
;
2549 c
= BYTE8_TO_CHAR (c
| 0x80);
2550 force_singlebyte
= 1;
2554 /* Any modifiers remaining are invalid. */
2556 error ("Invalid modifier in string");
2557 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2561 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2562 if (CHAR_BYTE8_P (c
))
2563 force_singlebyte
= 1;
2564 else if (! ASCII_CHAR_P (c
))
2565 force_multibyte
= 1;
2571 end_of_file_error ();
2573 /* If purifying, and string starts with \ newline,
2574 return zero instead. This is for doc strings
2575 that we are really going to find in etc/DOC.nn.nn */
2576 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2577 return make_number (0);
2579 if (force_multibyte
)
2580 /* READ_BUFFER already contains valid multibyte forms. */
2582 else if (force_singlebyte
)
2584 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2585 p
= read_buffer
+ nchars
;
2588 /* Otherwise, READ_BUFFER contains only ASCII. */
2591 /* We want readchar_count to be the number of characters, not
2592 bytes. Hence we adjust for multibyte characters in the
2593 string. ... But it doesn't seem to be necessary, because
2594 READCHAR *does* read multibyte characters from buffers. */
2595 /* readchar_count -= (p - read_buffer) - nchars; */
2597 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2599 || (p
- read_buffer
!= nchars
)));
2600 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2602 || (p
- read_buffer
!= nchars
)));
2607 int next_char
= READCHAR
;
2610 if (next_char
<= 040
2611 || (next_char
< 0200
2612 && (index ("\"';([#?", next_char
)
2613 || (!first_in_list
&& next_char
== '`')
2614 || (new_backquote_flag
&& next_char
== ','))))
2620 /* Otherwise, we fall through! Note that the atom-reading loop
2621 below will now loop at least once, assuring that we will not
2622 try to UNREAD two characters in a row. */
2626 if (c
<= 040) goto retry
;
2628 char *p
= read_buffer
;
2632 char *end
= read_buffer
+ read_buffer_size
;
2636 || (!index ("\"';()[]#", c
)
2637 && !(!first_in_list
&& c
== '`')
2638 && !(new_backquote_flag
&& c
== ','))))
2640 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2642 int offset
= p
- read_buffer
;
2643 read_buffer
= (char *) xrealloc (read_buffer
,
2644 read_buffer_size
*= 2);
2645 p
= read_buffer
+ offset
;
2646 end
= read_buffer
+ read_buffer_size
;
2653 end_of_file_error ();
2657 p
+= CHAR_STRING (c
, p
);
2663 int offset
= p
- read_buffer
;
2664 read_buffer
= (char *) xrealloc (read_buffer
,
2665 read_buffer_size
*= 2);
2666 p
= read_buffer
+ offset
;
2667 end
= read_buffer
+ read_buffer_size
;
2674 if (!quoted
&& !uninterned_symbol
)
2677 register Lisp_Object val
;
2679 if (*p1
== '+' || *p1
== '-') p1
++;
2680 /* Is it an integer? */
2683 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2684 /* Integers can have trailing decimal points. */
2685 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2687 /* It is an integer. */
2691 /* Fixme: if we have strtol, use that, and check
2693 if (sizeof (int) == sizeof (EMACS_INT
))
2694 XSETINT (val
, atoi (read_buffer
));
2695 else if (sizeof (long) == sizeof (EMACS_INT
))
2696 XSETINT (val
, atol (read_buffer
));
2702 if (isfloat_string (read_buffer
))
2704 /* Compute NaN and infinities using 0.0 in a variable,
2705 to cope with compilers that think they are smarter
2711 /* Negate the value ourselves. This treats 0, NaNs,
2712 and infinity properly on IEEE floating point hosts,
2713 and works around a common bug where atof ("-0.0")
2715 int negative
= read_buffer
[0] == '-';
2717 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2718 returns 1, is if the input ends in e+INF or e+NaN. */
2725 value
= zero
/ zero
;
2727 /* If that made a "negative" NaN, negate it. */
2731 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2734 u_minus_zero
.d
= - 0.0;
2735 for (i
= 0; i
< sizeof (double); i
++)
2736 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2742 /* Now VALUE is a positive NaN. */
2745 value
= atof (read_buffer
+ negative
);
2749 return make_float (negative
? - value
: value
);
2753 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2754 : intern (read_buffer
);
2755 if (EQ (Vread_with_symbol_positions
, Qt
)
2756 || EQ (Vread_with_symbol_positions
, readcharfun
))
2757 Vread_symbol_positions_list
=
2758 /* Kind of a hack; this will probably fail if characters
2759 in the symbol name were escaped. Not really a big
2761 Fcons (Fcons (result
,
2762 make_number (readchar_count
2763 - XFASTINT (Flength (Fsymbol_name (result
))))),
2764 Vread_symbol_positions_list
);
2772 /* List of nodes we've seen during substitute_object_in_subtree. */
2773 static Lisp_Object seen_list
;
2776 substitute_object_in_subtree (object
, placeholder
)
2778 Lisp_Object placeholder
;
2780 Lisp_Object check_object
;
2782 /* We haven't seen any objects when we start. */
2785 /* Make all the substitutions. */
2787 = substitute_object_recurse (object
, placeholder
, object
);
2789 /* Clear seen_list because we're done with it. */
2792 /* The returned object here is expected to always eq the
2794 if (!EQ (check_object
, object
))
2795 error ("Unexpected mutation error in reader");
2798 /* Feval doesn't get called from here, so no gc protection is needed. */
2799 #define SUBSTITUTE(get_val, set_val) \
2801 Lisp_Object old_value = get_val; \
2802 Lisp_Object true_value \
2803 = substitute_object_recurse (object, placeholder,\
2806 if (!EQ (old_value, true_value)) \
2813 substitute_object_recurse (object
, placeholder
, subtree
)
2815 Lisp_Object placeholder
;
2816 Lisp_Object subtree
;
2818 /* If we find the placeholder, return the target object. */
2819 if (EQ (placeholder
, subtree
))
2822 /* If we've been to this node before, don't explore it again. */
2823 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2826 /* If this node can be the entry point to a cycle, remember that
2827 we've seen it. It can only be such an entry point if it was made
2828 by #n=, which means that we can find it as a value in
2830 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2831 seen_list
= Fcons (subtree
, seen_list
);
2833 /* Recurse according to subtree's type.
2834 Every branch must return a Lisp_Object. */
2835 switch (XTYPE (subtree
))
2837 case Lisp_Vectorlike
:
2840 int length
= XINT (Flength(subtree
));
2841 for (i
= 0; i
< length
; i
++)
2843 Lisp_Object idx
= make_number (i
);
2844 SUBSTITUTE (Faref (subtree
, idx
),
2845 Faset (subtree
, idx
, true_value
));
2852 SUBSTITUTE (Fcar_safe (subtree
),
2853 Fsetcar (subtree
, true_value
));
2854 SUBSTITUTE (Fcdr_safe (subtree
),
2855 Fsetcdr (subtree
, true_value
));
2861 /* Check for text properties in each interval.
2862 substitute_in_interval contains part of the logic. */
2864 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2865 Lisp_Object arg
= Fcons (object
, placeholder
);
2867 traverse_intervals_noorder (root_interval
,
2868 &substitute_in_interval
, arg
);
2873 /* Other types don't recurse any further. */
2879 /* Helper function for substitute_object_recurse. */
2881 substitute_in_interval (interval
, arg
)
2885 Lisp_Object object
= Fcar (arg
);
2886 Lisp_Object placeholder
= Fcdr (arg
);
2888 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2907 if (*cp
== '+' || *cp
== '-')
2910 if (*cp
>= '0' && *cp
<= '9')
2913 while (*cp
>= '0' && *cp
<= '9')
2921 if (*cp
>= '0' && *cp
<= '9')
2924 while (*cp
>= '0' && *cp
<= '9')
2927 if (*cp
== 'e' || *cp
== 'E')
2931 if (*cp
== '+' || *cp
== '-')
2935 if (*cp
>= '0' && *cp
<= '9')
2938 while (*cp
>= '0' && *cp
<= '9')
2941 else if (cp
== start
)
2943 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2948 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2954 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2955 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2956 || state
== (DOT_CHAR
|TRAIL_INT
)
2957 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2958 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2959 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2964 read_vector (readcharfun
, bytecodeflag
)
2965 Lisp_Object readcharfun
;
2970 register Lisp_Object
*ptr
;
2971 register Lisp_Object tem
, item
, vector
;
2972 register struct Lisp_Cons
*otem
;
2975 tem
= read_list (1, readcharfun
);
2976 len
= Flength (tem
);
2977 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2979 size
= XVECTOR (vector
)->size
;
2980 ptr
= XVECTOR (vector
)->contents
;
2981 for (i
= 0; i
< size
; i
++)
2984 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2985 bytecode object, the docstring containing the bytecode and
2986 constants values must be treated as unibyte and passed to
2987 Fread, to get the actual bytecode string and constants vector. */
2988 if (bytecodeflag
&& load_force_doc_strings
)
2990 if (i
== COMPILED_BYTECODE
)
2992 if (!STRINGP (item
))
2993 error ("Invalid byte code");
2995 /* Delay handling the bytecode slot until we know whether
2996 it is lazily-loaded (we can tell by whether the
2997 constants slot is nil). */
2998 ptr
[COMPILED_CONSTANTS
] = item
;
3001 else if (i
== COMPILED_CONSTANTS
)
3003 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3007 /* Coerce string to unibyte (like string-as-unibyte,
3008 but without generating extra garbage and
3009 guaranteeing no change in the contents). */
3010 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3011 STRING_SET_UNIBYTE (bytestr
);
3013 item
= Fread (Fcons (bytestr
, readcharfun
));
3015 error ("Invalid byte code");
3017 otem
= XCONS (item
);
3018 bytestr
= XCAR (item
);
3023 /* Now handle the bytecode slot. */
3024 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3026 else if (i
== COMPILED_DOC_STRING
3028 && ! STRING_MULTIBYTE (item
))
3030 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3031 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3033 item
= Fstring_as_multibyte (item
);
3036 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3044 /* FLAG = 1 means check for ] to terminate rather than ) and .
3045 FLAG = -1 means check for starting with defun
3046 and make structure pure. */
3049 read_list (flag
, readcharfun
)
3051 register Lisp_Object readcharfun
;
3053 /* -1 means check next element for defun,
3054 0 means don't check,
3055 1 means already checked and found defun. */
3056 int defunflag
= flag
< 0 ? -1 : 0;
3057 Lisp_Object val
, tail
;
3058 register Lisp_Object elt
, tem
;
3059 struct gcpro gcpro1
, gcpro2
;
3060 /* 0 is the normal case.
3061 1 means this list is a doc reference; replace it with the number 0.
3062 2 means this list is a doc reference; replace it with the doc string. */
3063 int doc_reference
= 0;
3065 /* Initialize this to 1 if we are reading a list. */
3066 int first_in_list
= flag
<= 0;
3075 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3080 /* While building, if the list starts with #$, treat it specially. */
3081 if (EQ (elt
, Vload_file_name
)
3083 && !NILP (Vpurify_flag
))
3085 if (NILP (Vdoc_file_name
))
3086 /* We have not yet called Snarf-documentation, so assume
3087 this file is described in the DOC-MM.NN file
3088 and Snarf-documentation will fill in the right value later.
3089 For now, replace the whole list with 0. */
3092 /* We have already called Snarf-documentation, so make a relative
3093 file name for this file, so it can be found properly
3094 in the installed Lisp directory.
3095 We don't use Fexpand_file_name because that would make
3096 the directory absolute now. */
3097 elt
= concat2 (build_string ("../lisp/"),
3098 Ffile_name_nondirectory (elt
));
3100 else if (EQ (elt
, Vload_file_name
)
3102 && load_force_doc_strings
)
3111 Fsignal (Qinvalid_read_syntax
,
3112 Fcons (make_string (") or . in a vector", 18), Qnil
));
3120 XSETCDR (tail
, read0 (readcharfun
));
3122 val
= read0 (readcharfun
);
3123 read1 (readcharfun
, &ch
, 0);
3127 if (doc_reference
== 1)
3128 return make_number (0);
3129 if (doc_reference
== 2)
3131 /* Get a doc string from the file we are loading.
3132 If it's in saved_doc_string, get it from there.
3134 Here, we don't know if the string is a
3135 bytecode string or a doc string. As a
3136 bytecode string must be unibyte, we always
3137 return a unibyte string. If it is actually a
3138 doc string, caller must make it
3141 int pos
= XINT (XCDR (val
));
3142 /* Position is negative for user variables. */
3143 if (pos
< 0) pos
= -pos
;
3144 if (pos
>= saved_doc_string_position
3145 && pos
< (saved_doc_string_position
3146 + saved_doc_string_length
))
3148 int start
= pos
- saved_doc_string_position
;
3151 /* Process quoting with ^A,
3152 and find the end of the string,
3153 which is marked with ^_ (037). */
3154 for (from
= start
, to
= start
;
3155 saved_doc_string
[from
] != 037;)
3157 int c
= saved_doc_string
[from
++];
3160 c
= saved_doc_string
[from
++];
3162 saved_doc_string
[to
++] = c
;
3164 saved_doc_string
[to
++] = 0;
3166 saved_doc_string
[to
++] = 037;
3169 saved_doc_string
[to
++] = c
;
3172 return make_unibyte_string (saved_doc_string
+ start
,
3175 /* Look in prev_saved_doc_string the same way. */
3176 else if (pos
>= prev_saved_doc_string_position
3177 && pos
< (prev_saved_doc_string_position
3178 + prev_saved_doc_string_length
))
3180 int start
= pos
- prev_saved_doc_string_position
;
3183 /* Process quoting with ^A,
3184 and find the end of the string,
3185 which is marked with ^_ (037). */
3186 for (from
= start
, to
= start
;
3187 prev_saved_doc_string
[from
] != 037;)
3189 int c
= prev_saved_doc_string
[from
++];
3192 c
= prev_saved_doc_string
[from
++];
3194 prev_saved_doc_string
[to
++] = c
;
3196 prev_saved_doc_string
[to
++] = 0;
3198 prev_saved_doc_string
[to
++] = 037;
3201 prev_saved_doc_string
[to
++] = c
;
3204 return make_unibyte_string (prev_saved_doc_string
3209 return get_doc_string (val
, 1, 0);
3214 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3216 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3218 tem
= (read_pure
&& flag
<= 0
3219 ? pure_cons (elt
, Qnil
)
3220 : Fcons (elt
, Qnil
));
3222 XSETCDR (tail
, tem
);
3227 defunflag
= EQ (elt
, Qdefun
);
3228 else if (defunflag
> 0)
3233 Lisp_Object Vobarray
;
3234 Lisp_Object initial_obarray
;
3236 /* oblookup stores the bucket number here, for the sake of Funintern. */
3238 int oblookup_last_bucket_number
;
3240 static int hash_string ();
3242 /* Get an error if OBARRAY is not an obarray.
3243 If it is one, return it. */
3246 check_obarray (obarray
)
3247 Lisp_Object obarray
;
3249 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3251 /* If Vobarray is now invalid, force it to be valid. */
3252 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3254 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3259 /* Intern the C string STR: return a symbol with that name,
3260 interned in the current obarray. */
3267 int len
= strlen (str
);
3268 Lisp_Object obarray
;
3271 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3272 obarray
= check_obarray (obarray
);
3273 tem
= oblookup (obarray
, str
, len
, len
);
3276 return Fintern (make_string (str
, len
), obarray
);
3279 /* Create an uninterned symbol with name STR. */
3285 int len
= strlen (str
);
3287 return Fmake_symbol ((!NILP (Vpurify_flag
)
3288 ? make_pure_string (str
, len
, len
, 0)
3289 : make_string (str
, len
)));
3292 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3293 doc
: /* Return the canonical symbol whose name is STRING.
3294 If there is none, one is created by this function and returned.
3295 A second optional argument specifies the obarray to use;
3296 it defaults to the value of `obarray'. */)
3298 Lisp_Object string
, obarray
;
3300 register Lisp_Object tem
, sym
, *ptr
;
3302 if (NILP (obarray
)) obarray
= Vobarray
;
3303 obarray
= check_obarray (obarray
);
3305 CHECK_STRING (string
);
3307 tem
= oblookup (obarray
, SDATA (string
),
3310 if (!INTEGERP (tem
))
3313 if (!NILP (Vpurify_flag
))
3314 string
= Fpurecopy (string
);
3315 sym
= Fmake_symbol (string
);
3317 if (EQ (obarray
, initial_obarray
))
3318 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3320 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3322 if ((SREF (string
, 0) == ':')
3323 && EQ (obarray
, initial_obarray
))
3325 XSYMBOL (sym
)->constant
= 1;
3326 XSYMBOL (sym
)->value
= sym
;
3329 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3331 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3333 XSYMBOL (sym
)->next
= 0;
3338 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3339 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3340 NAME may be a string or a symbol. If it is a symbol, that exact
3341 symbol is searched for.
3342 A second optional argument specifies the obarray to use;
3343 it defaults to the value of `obarray'. */)
3345 Lisp_Object name
, obarray
;
3347 register Lisp_Object tem
, string
;
3349 if (NILP (obarray
)) obarray
= Vobarray
;
3350 obarray
= check_obarray (obarray
);
3352 if (!SYMBOLP (name
))
3354 CHECK_STRING (name
);
3358 string
= SYMBOL_NAME (name
);
3360 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3361 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3367 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3368 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3369 The value is t if a symbol was found and deleted, nil otherwise.
3370 NAME may be a string or a symbol. If it is a symbol, that symbol
3371 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3372 OBARRAY defaults to the value of the variable `obarray'. */)
3374 Lisp_Object name
, obarray
;
3376 register Lisp_Object string
, tem
;
3379 if (NILP (obarray
)) obarray
= Vobarray
;
3380 obarray
= check_obarray (obarray
);
3383 string
= SYMBOL_NAME (name
);
3386 CHECK_STRING (name
);
3390 tem
= oblookup (obarray
, SDATA (string
),
3395 /* If arg was a symbol, don't delete anything but that symbol itself. */
3396 if (SYMBOLP (name
) && !EQ (name
, tem
))
3399 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3400 XSYMBOL (tem
)->constant
= 0;
3401 XSYMBOL (tem
)->indirect_variable
= 0;
3403 hash
= oblookup_last_bucket_number
;
3405 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3407 if (XSYMBOL (tem
)->next
)
3408 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3410 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3414 Lisp_Object tail
, following
;
3416 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3417 XSYMBOL (tail
)->next
;
3420 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3421 if (EQ (following
, tem
))
3423 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3432 /* Return the symbol in OBARRAY whose names matches the string
3433 of SIZE characters (SIZE_BYTE bytes) at PTR.
3434 If there is no such symbol in OBARRAY, return nil.
3436 Also store the bucket number in oblookup_last_bucket_number. */
3439 oblookup (obarray
, ptr
, size
, size_byte
)
3440 Lisp_Object obarray
;
3441 register const char *ptr
;
3442 int size
, size_byte
;
3446 register Lisp_Object tail
;
3447 Lisp_Object bucket
, tem
;
3449 if (!VECTORP (obarray
)
3450 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3452 obarray
= check_obarray (obarray
);
3453 obsize
= XVECTOR (obarray
)->size
;
3455 /* This is sometimes needed in the middle of GC. */
3456 obsize
&= ~ARRAY_MARK_FLAG
;
3457 /* Combining next two lines breaks VMS C 2.3. */
3458 hash
= hash_string (ptr
, size_byte
);
3460 bucket
= XVECTOR (obarray
)->contents
[hash
];
3461 oblookup_last_bucket_number
= hash
;
3462 if (EQ (bucket
, make_number (0)))
3464 else if (!SYMBOLP (bucket
))
3465 error ("Bad data in guts of obarray"); /* Like CADR error message */
3467 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3469 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3470 && SCHARS (SYMBOL_NAME (tail
)) == size
3471 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3473 else if (XSYMBOL (tail
)->next
== 0)
3476 XSETINT (tem
, hash
);
3481 hash_string (ptr
, len
)
3482 const unsigned char *ptr
;
3485 register const unsigned char *p
= ptr
;
3486 register const unsigned char *end
= p
+ len
;
3487 register unsigned char c
;
3488 register int hash
= 0;
3493 if (c
>= 0140) c
-= 40;
3494 hash
= ((hash
<<3) + (hash
>>28) + c
);
3496 return hash
& 07777777777;
3500 map_obarray (obarray
, fn
, arg
)
3501 Lisp_Object obarray
;
3502 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3506 register Lisp_Object tail
;
3507 CHECK_VECTOR (obarray
);
3508 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3510 tail
= XVECTOR (obarray
)->contents
[i
];
3515 if (XSYMBOL (tail
)->next
== 0)
3517 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3523 mapatoms_1 (sym
, function
)
3524 Lisp_Object sym
, function
;
3526 call1 (function
, sym
);
3529 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3530 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3531 OBARRAY defaults to the value of `obarray'. */)
3533 Lisp_Object function
, obarray
;
3535 if (NILP (obarray
)) obarray
= Vobarray
;
3536 obarray
= check_obarray (obarray
);
3538 map_obarray (obarray
, mapatoms_1
, function
);
3542 #define OBARRAY_SIZE 1511
3547 Lisp_Object oblength
;
3551 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3553 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3554 Vobarray
= Fmake_vector (oblength
, make_number (0));
3555 initial_obarray
= Vobarray
;
3556 staticpro (&initial_obarray
);
3557 /* Intern nil in the obarray */
3558 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3559 XSYMBOL (Qnil
)->constant
= 1;
3561 /* These locals are to kludge around a pyramid compiler bug. */
3562 hash
= hash_string ("nil", 3);
3563 /* Separate statement here to avoid VAXC bug. */
3564 hash
%= OBARRAY_SIZE
;
3565 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3568 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3569 XSYMBOL (Qnil
)->function
= Qunbound
;
3570 XSYMBOL (Qunbound
)->value
= Qunbound
;
3571 XSYMBOL (Qunbound
)->function
= Qunbound
;
3574 XSYMBOL (Qnil
)->value
= Qnil
;
3575 XSYMBOL (Qnil
)->plist
= Qnil
;
3576 XSYMBOL (Qt
)->value
= Qt
;
3577 XSYMBOL (Qt
)->constant
= 1;
3579 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3582 Qvariable_documentation
= intern ("variable-documentation");
3583 staticpro (&Qvariable_documentation
);
3585 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3586 read_buffer
= (char *) xmalloc (read_buffer_size
);
3591 struct Lisp_Subr
*sname
;
3594 sym
= intern (sname
->symbol_name
);
3595 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3598 #ifdef NOTDEF /* use fset in subr.el now */
3600 defalias (sname
, string
)
3601 struct Lisp_Subr
*sname
;
3605 sym
= intern (string
);
3606 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3610 /* Define an "integer variable"; a symbol whose value is forwarded
3611 to a C variable of type int. Sample call: */
3612 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3614 defvar_int (namestring
, address
)
3618 Lisp_Object sym
, val
;
3619 sym
= intern (namestring
);
3620 val
= allocate_misc ();
3621 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3622 XINTFWD (val
)->intvar
= address
;
3623 SET_SYMBOL_VALUE (sym
, val
);
3626 /* Similar but define a variable whose value is t if address contains 1,
3627 nil if address contains 0 */
3629 defvar_bool (namestring
, address
)
3633 Lisp_Object sym
, val
;
3634 sym
= intern (namestring
);
3635 val
= allocate_misc ();
3636 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3637 XBOOLFWD (val
)->boolvar
= address
;
3638 SET_SYMBOL_VALUE (sym
, val
);
3639 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3642 /* Similar but define a variable whose value is the Lisp Object stored
3643 at address. Two versions: with and without gc-marking of the C
3644 variable. The nopro version is used when that variable will be
3645 gc-marked for some other reason, since marking the same slot twice
3646 can cause trouble with strings. */
3648 defvar_lisp_nopro (namestring
, address
)
3650 Lisp_Object
*address
;
3652 Lisp_Object sym
, val
;
3653 sym
= intern (namestring
);
3654 val
= allocate_misc ();
3655 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3656 XOBJFWD (val
)->objvar
= address
;
3657 SET_SYMBOL_VALUE (sym
, val
);
3661 defvar_lisp (namestring
, address
)
3663 Lisp_Object
*address
;
3665 defvar_lisp_nopro (namestring
, address
);
3666 staticpro (address
);
3669 /* Similar but define a variable whose value is the Lisp Object stored in
3670 the current buffer. address is the address of the slot in the buffer
3671 that is current now. */
3674 defvar_per_buffer (namestring
, address
, type
, doc
)
3676 Lisp_Object
*address
;
3680 Lisp_Object sym
, val
;
3683 sym
= intern (namestring
);
3684 val
= allocate_misc ();
3685 offset
= (char *)address
- (char *)current_buffer
;
3687 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3688 XBUFFER_OBJFWD (val
)->offset
= offset
;
3689 SET_SYMBOL_VALUE (sym
, val
);
3690 PER_BUFFER_SYMBOL (offset
) = sym
;
3691 PER_BUFFER_TYPE (offset
) = type
;
3693 if (PER_BUFFER_IDX (offset
) == 0)
3694 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3695 slot of buffer_local_flags */
3700 /* Similar but define a variable whose value is the Lisp Object stored
3701 at a particular offset in the current kboard object. */
3704 defvar_kboard (namestring
, offset
)
3708 Lisp_Object sym
, val
;
3709 sym
= intern (namestring
);
3710 val
= allocate_misc ();
3711 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3712 XKBOARD_OBJFWD (val
)->offset
= offset
;
3713 SET_SYMBOL_VALUE (sym
, val
);
3716 /* Record the value of load-path used at the start of dumping
3717 so we can see if the site changed it later during dumping. */
3718 static Lisp_Object dump_path
;
3724 int turn_off_warning
= 0;
3726 /* Compute the default load-path. */
3728 normal
= PATH_LOADSEARCH
;
3729 Vload_path
= decode_env_path (0, normal
);
3731 if (NILP (Vpurify_flag
))
3732 normal
= PATH_LOADSEARCH
;
3734 normal
= PATH_DUMPLOADSEARCH
;
3736 /* In a dumped Emacs, we normally have to reset the value of
3737 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3738 uses ../lisp, instead of the path of the installed elisp
3739 libraries. However, if it appears that Vload_path was changed
3740 from the default before dumping, don't override that value. */
3743 if (! NILP (Fequal (dump_path
, Vload_path
)))
3745 Vload_path
= decode_env_path (0, normal
);
3746 if (!NILP (Vinstallation_directory
))
3748 Lisp_Object tem
, tem1
, sitelisp
;
3750 /* Remove site-lisp dirs from path temporarily and store
3751 them in sitelisp, then conc them on at the end so
3752 they're always first in path. */
3756 tem
= Fcar (Vload_path
);
3757 tem1
= Fstring_match (build_string ("site-lisp"),
3761 Vload_path
= Fcdr (Vload_path
);
3762 sitelisp
= Fcons (tem
, sitelisp
);
3768 /* Add to the path the lisp subdir of the
3769 installation dir, if it exists. */
3770 tem
= Fexpand_file_name (build_string ("lisp"),
3771 Vinstallation_directory
);
3772 tem1
= Ffile_exists_p (tem
);
3775 if (NILP (Fmember (tem
, Vload_path
)))
3777 turn_off_warning
= 1;
3778 Vload_path
= Fcons (tem
, Vload_path
);
3782 /* That dir doesn't exist, so add the build-time
3783 Lisp dirs instead. */
3784 Vload_path
= nconc2 (Vload_path
, dump_path
);
3786 /* Add leim under the installation dir, if it exists. */
3787 tem
= Fexpand_file_name (build_string ("leim"),
3788 Vinstallation_directory
);
3789 tem1
= Ffile_exists_p (tem
);
3792 if (NILP (Fmember (tem
, Vload_path
)))
3793 Vload_path
= Fcons (tem
, Vload_path
);
3796 /* Add site-list under the installation dir, if it exists. */
3797 tem
= Fexpand_file_name (build_string ("site-lisp"),
3798 Vinstallation_directory
);
3799 tem1
= Ffile_exists_p (tem
);
3802 if (NILP (Fmember (tem
, Vload_path
)))
3803 Vload_path
= Fcons (tem
, Vload_path
);
3806 /* If Emacs was not built in the source directory,
3807 and it is run from where it was built, add to load-path
3808 the lisp, leim and site-lisp dirs under that directory. */
3810 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3814 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3815 Vinstallation_directory
);
3816 tem1
= Ffile_exists_p (tem
);
3818 /* Don't be fooled if they moved the entire source tree
3819 AFTER dumping Emacs. If the build directory is indeed
3820 different from the source dir, src/Makefile.in and
3821 src/Makefile will not be found together. */
3822 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3823 Vinstallation_directory
);
3824 tem2
= Ffile_exists_p (tem
);
3825 if (!NILP (tem1
) && NILP (tem2
))
3827 tem
= Fexpand_file_name (build_string ("lisp"),
3830 if (NILP (Fmember (tem
, Vload_path
)))
3831 Vload_path
= Fcons (tem
, Vload_path
);
3833 tem
= Fexpand_file_name (build_string ("leim"),
3836 if (NILP (Fmember (tem
, Vload_path
)))
3837 Vload_path
= Fcons (tem
, Vload_path
);
3839 tem
= Fexpand_file_name (build_string ("site-lisp"),
3842 if (NILP (Fmember (tem
, Vload_path
)))
3843 Vload_path
= Fcons (tem
, Vload_path
);
3846 if (!NILP (sitelisp
))
3847 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3853 /* NORMAL refers to the lisp dir in the source directory. */
3854 /* We used to add ../lisp at the front here, but
3855 that caused trouble because it was copied from dump_path
3856 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3857 It should be unnecessary. */
3858 Vload_path
= decode_env_path (0, normal
);
3859 dump_path
= Vload_path
;
3863 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3864 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3865 almost never correct, thereby causing a warning to be printed out that
3866 confuses users. Since PATH_LOADSEARCH is always overridden by the
3867 EMACSLOADPATH environment variable below, disable the warning on NT.
3868 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3869 the "standard" paths may not exist and would be overridden by
3870 EMACSLOADPATH as on NT. Since this depends on how the executable
3871 was build and packaged, turn off the warnings in general */
3873 /* Warn if dirs in the *standard* path don't exist. */
3874 if (!turn_off_warning
)
3876 Lisp_Object path_tail
;
3878 for (path_tail
= Vload_path
;
3880 path_tail
= XCDR (path_tail
))
3882 Lisp_Object dirfile
;
3883 dirfile
= Fcar (path_tail
);
3884 if (STRINGP (dirfile
))
3886 dirfile
= Fdirectory_file_name (dirfile
);
3887 if (access (SDATA (dirfile
), 0) < 0)
3888 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3893 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3895 /* If the EMACSLOADPATH environment variable is set, use its value.
3896 This doesn't apply if we're dumping. */
3898 if (NILP (Vpurify_flag
)
3899 && egetenv ("EMACSLOADPATH"))
3901 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3905 load_in_progress
= 0;
3906 Vload_file_name
= Qnil
;
3908 load_descriptor_list
= Qnil
;
3910 Vstandard_input
= Qt
;
3911 Vloads_in_progress
= Qnil
;
3914 /* Print a warning, using format string FORMAT, that directory DIRNAME
3915 does not exist. Print it on stderr and put it in *Message*. */
3918 dir_warning (format
, dirname
)
3920 Lisp_Object dirname
;
3923 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3925 fprintf (stderr
, format
, SDATA (dirname
));
3926 sprintf (buffer
, format
, SDATA (dirname
));
3927 /* Don't log the warning before we've initialized!! */
3929 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3936 defsubr (&Sread_from_string
);
3938 defsubr (&Sintern_soft
);
3939 defsubr (&Sunintern
);
3941 defsubr (&Seval_buffer
);
3942 defsubr (&Seval_region
);
3943 defsubr (&Sread_char
);
3944 defsubr (&Sread_char_exclusive
);
3945 defsubr (&Sread_event
);
3946 defsubr (&Sget_file_char
);
3947 defsubr (&Smapatoms
);
3948 defsubr (&Slocate_file_internal
);
3950 DEFVAR_LISP ("obarray", &Vobarray
,
3951 doc
: /* Symbol table for use by `intern' and `read'.
3952 It is a vector whose length ought to be prime for best results.
3953 The vector's contents don't make sense if examined from Lisp programs;
3954 to find all the symbols in an obarray, use `mapatoms'. */);
3956 DEFVAR_LISP ("values", &Vvalues
,
3957 doc
: /* List of values of all expressions which were read, evaluated and printed.
3958 Order is reverse chronological. */);
3960 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3961 doc
: /* Stream for read to get input from.
3962 See documentation of `read' for possible values. */);
3963 Vstandard_input
= Qt
;
3965 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3966 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3968 If this variable is a buffer, then only forms read from that buffer
3969 will be added to `read-symbol-positions-list'.
3970 If this variable is t, then all read forms will be added.
3971 The effect of all other values other than nil are not currently
3972 defined, although they may be in the future.
3974 The positions are relative to the last call to `read' or
3975 `read-from-string'. It is probably a bad idea to set this variable at
3976 the toplevel; bind it instead. */);
3977 Vread_with_symbol_positions
= Qnil
;
3979 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3980 doc
: /* A list mapping read symbols to their positions.
3981 This variable is modified during calls to `read' or
3982 `read-from-string', but only when `read-with-symbol-positions' is
3985 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3986 CHAR-POSITION is an integer giving the offset of that occurrence of the
3987 symbol from the position where `read' or `read-from-string' started.
3989 Note that a symbol will appear multiple times in this list, if it was
3990 read multiple times. The list is in the same order as the symbols
3992 Vread_symbol_positions_list
= Qnil
;
3994 DEFVAR_LISP ("load-path", &Vload_path
,
3995 doc
: /* *List of directories to search for files to load.
3996 Each element is a string (directory name) or nil (try default directory).
3997 Initialized based on EMACSLOADPATH environment variable, if any,
3998 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4000 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4001 doc
: /* *List of suffixes to try for files to load.
4002 This list should not include the empty string. */);
4003 Vload_suffixes
= Fcons (build_string (".elc"),
4004 Fcons (build_string (".el"), Qnil
));
4005 /* We don't use empty_string because it's not initialized yet. */
4006 default_suffixes
= Fcons (build_string (""), Qnil
);
4007 staticpro (&default_suffixes
);
4009 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4010 doc
: /* Non-nil iff inside of `load'. */);
4012 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4013 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4014 Each element looks like (FILENAME FORMS...).
4015 When `load' is run and the file-name argument is FILENAME,
4016 the FORMS in the corresponding element are executed at the end of loading.
4018 FILENAME must match exactly! Normally FILENAME is the name of a library,
4019 with no directory specified, since that is how `load' is normally called.
4020 An error in FORMS does not undo the load,
4021 but does prevent execution of the rest of the FORMS.
4022 FILENAME can also be a symbol (a feature) and FORMS are then executed
4023 when the corresponding call to `provide' is made. */);
4024 Vafter_load_alist
= Qnil
;
4026 DEFVAR_LISP ("load-history", &Vload_history
,
4027 doc
: /* Alist mapping file names to symbols and features.
4028 Each alist element is a list that starts with a file name,
4029 except for one element (optional) that starts with nil and describes
4030 definitions evaluated from buffers not visiting files.
4031 The remaining elements of each list are symbols defined as variables
4032 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4033 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
4034 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
4035 and means that SYMBOL was an autoload before this file redefined it
4038 For a preloaded file, the file name recorded is relative to the main Lisp
4039 directory. These names are converted to absolute by `file-loadhist-lookup'. */);
4040 Vload_history
= Qnil
;
4042 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4043 doc
: /* Full name of file being loaded by `load'. */);
4044 Vload_file_name
= Qnil
;
4046 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4047 doc
: /* File name, including directory, of user's initialization file.
4048 If the file loaded had extension `.elc', and the corresponding source file
4049 exists, this variable contains the name of source file, suitable for use
4050 by functions like `custom-save-all' which edit the init file. */);
4051 Vuser_init_file
= Qnil
;
4053 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4054 doc
: /* Used for internal purposes by `load'. */);
4055 Vcurrent_load_list
= Qnil
;
4057 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4058 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4059 The default is nil, which means use the function `read'. */);
4060 Vload_read_function
= Qnil
;
4062 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4063 doc
: /* Function called in `load' for loading an Emacs lisp source file.
4064 This function is for doing code conversion before reading the source file.
4065 If nil, loading is done without any code conversion.
4066 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4067 FULLNAME is the full name of FILE.
4068 See `load' for the meaning of the remaining arguments. */);
4069 Vload_source_file_function
= Qnil
;
4071 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4072 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4073 This is useful when the file being loaded is a temporary copy. */);
4074 load_force_doc_strings
= 0;
4076 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4077 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4078 This is normally bound by `load' and `eval-buffer' to control `read',
4079 and is not meant for users to change. */);
4080 load_convert_to_unibyte
= 0;
4082 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4083 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4084 You cannot count on them to still be there! */);
4086 = Fexpand_file_name (build_string ("../"),
4087 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4089 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4090 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4091 Vpreloaded_file_list
= Qnil
;
4093 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4094 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4095 Vbyte_boolean_vars
= Qnil
;
4097 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4098 doc
: /* Non-nil means load dangerous compiled Lisp files.
4099 Some versions of XEmacs use different byte codes than Emacs. These
4100 incompatible byte codes can make Emacs crash when it tries to execute
4102 load_dangerous_libraries
= 0;
4104 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4105 doc
: /* Regular expression matching safe to load compiled Lisp files.
4106 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4107 from the file, and matches them against this regular expression.
4108 When the regular expression matches, the file is considered to be safe
4109 to load. See also `load-dangerous-libraries'. */);
4110 Vbytecomp_version_regexp
4111 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4113 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4114 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4115 Veval_buffer_list
= Qnil
;
4117 /* Vsource_directory was initialized in init_lread. */
4119 load_descriptor_list
= Qnil
;
4120 staticpro (&load_descriptor_list
);
4122 Qcurrent_load_list
= intern ("current-load-list");
4123 staticpro (&Qcurrent_load_list
);
4125 Qstandard_input
= intern ("standard-input");
4126 staticpro (&Qstandard_input
);
4128 Qread_char
= intern ("read-char");
4129 staticpro (&Qread_char
);
4131 Qget_file_char
= intern ("get-file-char");
4132 staticpro (&Qget_file_char
);
4134 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4135 staticpro (&Qget_emacs_mule_file_char
);
4137 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4138 staticpro (&Qload_force_doc_strings
);
4140 Qbackquote
= intern ("`");
4141 staticpro (&Qbackquote
);
4142 Qcomma
= intern (",");
4143 staticpro (&Qcomma
);
4144 Qcomma_at
= intern (",@");
4145 staticpro (&Qcomma_at
);
4146 Qcomma_dot
= intern (",.");
4147 staticpro (&Qcomma_dot
);
4149 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4150 staticpro (&Qinhibit_file_name_operation
);
4152 Qascii_character
= intern ("ascii-character");
4153 staticpro (&Qascii_character
);
4155 Qfunction
= intern ("function");
4156 staticpro (&Qfunction
);
4158 Qload
= intern ("load");
4161 Qload_file_name
= intern ("load-file-name");
4162 staticpro (&Qload_file_name
);
4164 Qeval_buffer_list
= intern ("eval-buffer-list");
4165 staticpro (&Qeval_buffer_list
);
4167 staticpro (&dump_path
);
4169 staticpro (&read_objects
);
4170 read_objects
= Qnil
;
4171 staticpro (&seen_list
);
4174 Vloads_in_progress
= Qnil
;
4175 staticpro (&Vloads_in_progress
);
4178 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4179 (do not change this comment) */