1 /* Lisp parsing and input streams.
3 Copyright (C) 1985-1989, 1993-1995, 1997-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23 #include <sys/types.h>
29 #include "intervals.h"
31 #include "character.h"
38 #include "termhooks.h"
40 #include "blockinput.h"
51 #endif /* HAVE_SETLOCALE */
56 #define file_offset off_t
57 #define file_tell ftello
59 #define file_offset long
60 #define file_tell ftell
63 /* hash table read constants */
64 Lisp_Object Qhash_table
, Qdata
;
65 Lisp_Object Qtest
, Qsize
;
66 Lisp_Object Qweakness
;
67 Lisp_Object Qrehash_size
;
68 Lisp_Object Qrehash_threshold
;
70 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
71 Lisp_Object Qvariable_documentation
;
72 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
73 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
74 Lisp_Object Qinhibit_file_name_operation
;
75 Lisp_Object Qeval_buffer_list
;
76 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
78 /* Used instead of Qget_file_char while loading *.elc files compiled
79 by Emacs 21 or older. */
80 static Lisp_Object Qget_emacs_mule_file_char
;
82 static Lisp_Object Qload_force_doc_strings
;
84 static Lisp_Object Qload_in_progress
;
86 /* The association list of objects read with the #n=object form.
87 Each member of the list has the form (n . object), and is used to
88 look up the object for the corresponding #n# construct.
89 It must be set to nil before all top-level calls to read0. */
90 Lisp_Object read_objects
;
92 /* Nonzero means READCHAR should read bytes one by one (not character)
93 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
94 This is set to 1 by read1 temporarily while handling #@NUMBER. */
95 static int load_each_byte
;
97 /* List of descriptors now open for Fload. */
98 static Lisp_Object load_descriptor_list
;
100 /* File for get_file_char to read from. Use by load. */
101 static FILE *instream
;
103 /* When nonzero, read conses in pure space */
104 static int read_pure
;
106 /* For use within read-from-string (this reader is non-reentrant!!) */
107 static EMACS_INT read_from_string_index
;
108 static EMACS_INT read_from_string_index_byte
;
109 static EMACS_INT read_from_string_limit
;
111 /* Number of characters read in the current call to Fread or
112 Fread_from_string. */
113 static EMACS_INT readchar_count
;
115 /* This contains the last string skipped with #@. */
116 static char *saved_doc_string
;
117 /* Length of buffer allocated in saved_doc_string. */
118 static int saved_doc_string_size
;
119 /* Length of actual data in saved_doc_string. */
120 static int saved_doc_string_length
;
121 /* This is the file position that string came from. */
122 static file_offset saved_doc_string_position
;
124 /* This contains the previous string skipped with #@.
125 We copy it from saved_doc_string when a new string
126 is put in saved_doc_string. */
127 static char *prev_saved_doc_string
;
128 /* Length of buffer allocated in prev_saved_doc_string. */
129 static int prev_saved_doc_string_size
;
130 /* Length of actual data in prev_saved_doc_string. */
131 static int prev_saved_doc_string_length
;
132 /* This is the file position that string came from. */
133 static file_offset prev_saved_doc_string_position
;
135 /* Nonzero means inside a new-style backquote
136 with no surrounding parentheses.
137 Fread initializes this to zero, so we need not specbind it
138 or worry about what happens to it when there is an error. */
139 static int new_backquote_flag
;
140 static Lisp_Object Qold_style_backquotes
;
142 /* A list of file names for files being loaded in Fload. Used to
143 check for recursive loads. */
145 static Lisp_Object Vloads_in_progress
;
147 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
150 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
,
151 Lisp_Object (*) (Lisp_Object
), int,
152 Lisp_Object
, Lisp_Object
,
153 Lisp_Object
, Lisp_Object
);
154 static Lisp_Object
load_unwind (Lisp_Object
);
155 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
157 static void invalid_syntax (const char *, int) NO_RETURN
;
158 static void end_of_file_error (void) NO_RETURN
;
161 /* Functions that read one byte from the current source READCHARFUN
162 or unreads one byte. If the integer argument C is -1, it returns
163 one read byte, or -1 when there's no more byte in the source. If C
164 is 0 or positive, it unreads C, and the return value is not
167 static int readbyte_for_lambda (int, Lisp_Object
);
168 static int readbyte_from_file (int, Lisp_Object
);
169 static int readbyte_from_string (int, Lisp_Object
);
171 /* Handle unreading and rereading of characters.
172 Write READCHAR to read a character,
173 UNREAD(c) to unread c to be read again.
175 These macros correctly read/unread multibyte characters. */
177 #define READCHAR readchar (readcharfun, NULL)
178 #define UNREAD(c) unreadchar (readcharfun, c)
180 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
181 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
183 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
184 Qlambda, or a cons, we use this to keep an unread character because
185 a file stream can't handle multibyte-char unreading. The value -1
186 means that there's no unread character. */
187 static int unread_char
;
190 readchar (Lisp_Object readcharfun
, int *multibyte
)
194 int (*readbyte
) (int, Lisp_Object
);
195 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
197 int emacs_mule_encoding
= 0;
204 if (BUFFERP (readcharfun
))
206 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
208 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
210 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
213 if (! NILP (inbuffer
->enable_multibyte_characters
))
215 /* Fetch the character code from the buffer. */
216 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
217 BUF_INC_POS (inbuffer
, pt_byte
);
224 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
225 if (! ASCII_BYTE_P (c
))
226 c
= BYTE8_TO_CHAR (c
);
229 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
233 if (MARKERP (readcharfun
))
235 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
237 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
239 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
242 if (! NILP (inbuffer
->enable_multibyte_characters
))
244 /* Fetch the character code from the buffer. */
245 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
246 BUF_INC_POS (inbuffer
, bytepos
);
253 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
254 if (! ASCII_BYTE_P (c
))
255 c
= BYTE8_TO_CHAR (c
);
259 XMARKER (readcharfun
)->bytepos
= bytepos
;
260 XMARKER (readcharfun
)->charpos
++;
265 if (EQ (readcharfun
, Qlambda
))
267 readbyte
= readbyte_for_lambda
;
271 if (EQ (readcharfun
, Qget_file_char
))
273 readbyte
= readbyte_from_file
;
277 if (STRINGP (readcharfun
))
279 if (read_from_string_index
>= read_from_string_limit
)
281 else if (STRING_MULTIBYTE (readcharfun
))
285 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
286 read_from_string_index
,
287 read_from_string_index_byte
);
291 c
= SREF (readcharfun
, read_from_string_index_byte
);
292 read_from_string_index
++;
293 read_from_string_index_byte
++;
298 if (CONSP (readcharfun
))
300 /* This is the case that read_vector is reading from a unibyte
301 string that contains a byte sequence previously skipped
302 because of #@NUMBER. The car part of readcharfun is that
303 string, and the cdr part is a value of readcharfun given to
305 readbyte
= readbyte_from_string
;
306 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
307 emacs_mule_encoding
= 1;
311 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
313 readbyte
= readbyte_from_file
;
314 emacs_mule_encoding
= 1;
318 tem
= call0 (readcharfun
);
325 if (unread_char
>= 0)
331 c
= (*readbyte
) (-1, readcharfun
);
332 if (c
< 0 || load_each_byte
)
336 if (ASCII_BYTE_P (c
))
338 if (emacs_mule_encoding
)
339 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
342 len
= BYTES_BY_CHAR_HEAD (c
);
345 c
= (*readbyte
) (-1, readcharfun
);
346 if (c
< 0 || ! TRAILING_CODE_P (c
))
349 (*readbyte
) (buf
[i
], readcharfun
);
350 return BYTE8_TO_CHAR (buf
[0]);
354 return STRING_CHAR (buf
);
357 /* Unread the character C in the way appropriate for the stream READCHARFUN.
358 If the stream is a user function, call it with the char as argument. */
361 unreadchar (Lisp_Object readcharfun
, int c
)
365 /* Don't back up the pointer if we're unreading the end-of-input mark,
366 since readchar didn't advance it when we read it. */
368 else if (BUFFERP (readcharfun
))
370 struct buffer
*b
= XBUFFER (readcharfun
);
371 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
374 if (! NILP (b
->enable_multibyte_characters
))
375 BUF_DEC_POS (b
, bytepos
);
379 BUF_PT_BYTE (b
) = bytepos
;
381 else if (MARKERP (readcharfun
))
383 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
384 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
386 XMARKER (readcharfun
)->charpos
--;
387 if (! NILP (b
->enable_multibyte_characters
))
388 BUF_DEC_POS (b
, bytepos
);
392 XMARKER (readcharfun
)->bytepos
= bytepos
;
394 else if (STRINGP (readcharfun
))
396 read_from_string_index
--;
397 read_from_string_index_byte
398 = string_char_to_byte (readcharfun
, read_from_string_index
);
400 else if (CONSP (readcharfun
))
404 else if (EQ (readcharfun
, Qlambda
))
408 else if (EQ (readcharfun
, Qget_file_char
)
409 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
414 ungetc (c
, instream
);
421 call1 (readcharfun
, make_number (c
));
425 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
427 return read_bytecode_char (c
>= 0);
432 readbyte_from_file (int c
, Lisp_Object readcharfun
)
437 ungetc (c
, instream
);
446 /* Interrupted reads have been observed while reading over the network */
447 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
459 return (c
== EOF
? -1 : c
);
463 readbyte_from_string (int c
, Lisp_Object readcharfun
)
465 Lisp_Object string
= XCAR (readcharfun
);
469 read_from_string_index
--;
470 read_from_string_index_byte
471 = string_char_to_byte (string
, read_from_string_index
);
474 if (read_from_string_index
>= read_from_string_limit
)
477 FETCH_STRING_CHAR_ADVANCE (c
, string
,
478 read_from_string_index
,
479 read_from_string_index_byte
);
484 /* Read one non-ASCII character from INSTREAM. The character is
485 encoded in `emacs-mule' and the first byte is already read in
489 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
491 /* Emacs-mule coding uses at most 4-byte for one character. */
492 unsigned char buf
[4];
493 int len
= emacs_mule_bytes
[c
];
494 struct charset
*charset
;
499 /* C is not a valid leading-code of `emacs-mule'. */
500 return BYTE8_TO_CHAR (c
);
506 c
= (*readbyte
) (-1, readcharfun
);
510 (*readbyte
) (buf
[i
], readcharfun
);
511 return BYTE8_TO_CHAR (buf
[0]);
518 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
519 code
= buf
[1] & 0x7F;
523 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
524 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
526 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
527 code
= buf
[2] & 0x7F;
531 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
532 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
537 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
538 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
540 c
= DECODE_CHAR (charset
, code
);
542 Fsignal (Qinvalid_read_syntax
,
543 Fcons (build_string ("invalid multibyte form"), Qnil
));
548 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
550 static Lisp_Object
read0 (Lisp_Object
);
551 static Lisp_Object
read1 (Lisp_Object
, int *, int);
553 static Lisp_Object
read_list (int, Lisp_Object
);
554 static Lisp_Object
read_vector (Lisp_Object
, int);
556 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
558 static void substitute_object_in_subtree (Lisp_Object
,
560 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
563 /* Get a character from the tty. */
565 /* Read input events until we get one that's acceptable for our purposes.
567 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
568 until we get a character we like, and then stuffed into
571 If ASCII_REQUIRED is non-zero, we check function key events to see
572 if the unmodified version of the symbol has a Qascii_character
573 property, and use that character, if present.
575 If ERROR_NONASCII is non-zero, we signal an error if the input we
576 get isn't an ASCII character with modifiers. If it's zero but
577 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
580 If INPUT_METHOD is nonzero, we invoke the current input method
581 if the character warrants that.
583 If SECONDS is a number, we wait that many seconds for input, and
584 return Qnil if no input arrives within that time. */
587 read_filtered_event (int no_switch_frame
, int ascii_required
,
588 int error_nonascii
, int input_method
, Lisp_Object seconds
)
590 Lisp_Object val
, delayed_switch_frame
;
593 #ifdef HAVE_WINDOW_SYSTEM
594 if (display_hourglass_p
)
598 delayed_switch_frame
= Qnil
;
600 /* Compute timeout. */
601 if (NUMBERP (seconds
))
603 EMACS_TIME wait_time
;
605 double duration
= extract_float (seconds
);
607 sec
= (int) duration
;
608 usec
= (duration
- sec
) * 1000000;
609 EMACS_GET_TIME (end_time
);
610 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
611 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
614 /* Read until we get an acceptable event. */
617 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
618 NUMBERP (seconds
) ? &end_time
: NULL
);
619 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
624 /* switch-frame events are put off until after the next ASCII
625 character. This is better than signaling an error just because
626 the last characters were typed to a separate minibuffer frame,
627 for example. Eventually, some code which can deal with
628 switch-frame events will read it and process it. */
630 && EVENT_HAS_PARAMETERS (val
)
631 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
633 delayed_switch_frame
= val
;
637 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
639 /* Convert certain symbols to their ASCII equivalents. */
642 Lisp_Object tem
, tem1
;
643 tem
= Fget (val
, Qevent_symbol_element_mask
);
646 tem1
= Fget (Fcar (tem
), Qascii_character
);
647 /* Merge this symbol's modifier bits
648 with the ASCII equivalent of its basic code. */
650 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
654 /* If we don't have a character now, deal with it appropriately. */
659 Vunread_command_events
= Fcons (val
, Qnil
);
660 error ("Non-character input-event");
667 if (! NILP (delayed_switch_frame
))
668 unread_switch_frame
= delayed_switch_frame
;
672 #ifdef HAVE_WINDOW_SYSTEM
673 if (display_hourglass_p
)
682 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
683 doc
: /* Read a character from the command input (keyboard or macro).
684 It is returned as a number.
685 If the character has modifiers, they are resolved and reflected to the
686 character code if possible (e.g. C-SPC -> 0).
688 If the user generates an event which is not a character (i.e. a mouse
689 click or function key event), `read-char' signals an error. As an
690 exception, switch-frame events are put off until non-character events
692 If you want to read non-character events, or ignore them, call
693 `read-event' or `read-char-exclusive' instead.
695 If the optional argument PROMPT is non-nil, display that as a prompt.
696 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
697 input method is turned on in the current buffer, that input method
698 is used for reading a character.
699 If the optional argument SECONDS is non-nil, it should be a number
700 specifying the maximum number of seconds to wait for input. If no
701 input arrives in that time, return nil. SECONDS may be a
702 floating-point value. */)
703 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
708 message_with_string ("%s", prompt
, 0);
709 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
711 return (NILP (val
) ? Qnil
712 : make_number (char_resolve_modifier_mask (XINT (val
))));
715 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
716 doc
: /* Read an event object from the input stream.
717 If the optional argument PROMPT is non-nil, display that as a prompt.
718 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
719 input method is turned on in the current buffer, that input method
720 is used for reading a character.
721 If the optional argument SECONDS is non-nil, it should be a number
722 specifying the maximum number of seconds to wait for input. If no
723 input arrives in that time, return nil. SECONDS may be a
724 floating-point value. */)
725 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
728 message_with_string ("%s", prompt
, 0);
729 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
732 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
733 doc
: /* Read a character from the command input (keyboard or macro).
734 It is returned as a number. Non-character events are ignored.
735 If the character has modifiers, they are resolved and reflected to the
736 character code if possible (e.g. C-SPC -> 0).
738 If the optional argument PROMPT is non-nil, display that as a prompt.
739 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
740 input method is turned on in the current buffer, that input method
741 is used for reading a character.
742 If the optional argument SECONDS is non-nil, it should be a number
743 specifying the maximum number of seconds to wait for input. If no
744 input arrives in that time, return nil. SECONDS may be a
745 floating-point value. */)
746 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
751 message_with_string ("%s", prompt
, 0);
753 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
755 return (NILP (val
) ? Qnil
756 : make_number (char_resolve_modifier_mask (XINT (val
))));
759 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
760 doc
: /* Don't use this yourself. */)
763 register Lisp_Object val
;
765 XSETINT (val
, getc (instream
));
772 /* Value is a version number of byte compiled code if the file
773 associated with file descriptor FD is a compiled Lisp file that's
774 safe to load. Only files compiled with Emacs are safe to load.
775 Files compiled with XEmacs can lead to a crash in Fbyte_code
776 because of an incompatible change in the byte compiler. */
779 safe_to_load_p (int fd
)
786 /* Read the first few bytes from the file, and look for a line
787 specifying the byte compiler version used. */
788 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
793 /* Skip to the next newline, skipping over the initial `ELC'
794 with NUL bytes following it, but note the version. */
795 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
800 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
807 lseek (fd
, 0, SEEK_SET
);
812 /* Callback for record_unwind_protect. Restore the old load list OLD,
813 after loading a file successfully. */
816 record_load_unwind (Lisp_Object old
)
818 return Vloads_in_progress
= old
;
821 /* This handler function is used via internal_condition_case_1. */
824 load_error_handler (Lisp_Object data
)
830 load_warn_old_style_backquotes (Lisp_Object file
)
832 if (!NILP (Vold_style_backquotes
))
835 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
842 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
843 doc
: /* Return the suffixes that `load' should try if a suffix is \
845 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
848 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
849 while (CONSP (suffixes
))
851 Lisp_Object exts
= Vload_file_rep_suffixes
;
852 suffix
= XCAR (suffixes
);
853 suffixes
= XCDR (suffixes
);
858 lst
= Fcons (concat2 (suffix
, ext
), lst
);
861 return Fnreverse (lst
);
864 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
865 doc
: /* Execute a file of Lisp code named FILE.
866 First try FILE with `.elc' appended, then try with `.el',
867 then try FILE unmodified (the exact suffixes in the exact order are
868 determined by `load-suffixes'). Environment variable references in
869 FILE are replaced with their values by calling `substitute-in-file-name'.
870 This function searches the directories in `load-path'.
872 If optional second arg NOERROR is non-nil,
873 report no error if FILE doesn't exist.
874 Print messages at start and end of loading unless
875 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
877 If optional fourth arg NOSUFFIX is non-nil, don't try adding
878 suffixes `.elc' or `.el' to the specified name FILE.
879 If optional fifth arg MUST-SUFFIX is non-nil, insist on
880 the suffix `.elc' or `.el'; don't accept just FILE unless
881 it ends in one of those suffixes or includes a directory name.
883 If this function fails to find a file, it may look for different
884 representations of that file before trying another file.
885 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
886 to the file name. Emacs uses this feature mainly to find compressed
887 versions of files when Auto Compression mode is enabled.
889 The exact suffixes that this function tries out, in the exact order,
890 are given by the value of the variable `load-file-rep-suffixes' if
891 NOSUFFIX is non-nil and by the return value of the function
892 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
893 MUST-SUFFIX are nil, this function first tries out the latter suffixes
896 Loading a file records its definitions, and its `provide' and
897 `require' calls, in an element of `load-history' whose
898 car is the file name loaded. See `load-history'.
900 While the file is in the process of being loaded, the variable
901 `load-in-progress' is non-nil and the variable `load-file-name'
902 is bound to the file's name.
904 Return t if the file exists and loads successfully. */)
905 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
907 register FILE *stream
;
908 register int fd
= -1;
909 int count
= SPECPDL_INDEX ();
910 struct gcpro gcpro1
, gcpro2
, gcpro3
;
911 Lisp_Object found
, efound
, hist_file_name
;
912 /* 1 means we printed the ".el is newer" message. */
914 /* 1 means we are loading a compiled file. */
918 const char *fmode
= "r";
928 /* If file name is magic, call the handler. */
929 /* This shouldn't be necessary any more now that `openp' handles it right.
930 handler = Ffind_file_name_handler (file, Qload);
932 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
934 /* Do this after the handler to avoid
935 the need to gcpro noerror, nomessage and nosuffix.
936 (Below here, we care only whether they are nil or not.)
937 The presence of this call is the result of a historical accident:
938 it used to be in every file-operation and when it got removed
939 everywhere, it accidentally stayed here. Since then, enough people
940 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
941 that it seemed risky to remove. */
942 if (! NILP (noerror
))
944 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
945 Qt
, load_error_handler
);
950 file
= Fsubstitute_in_file_name (file
);
953 /* Avoid weird lossage with null string as arg,
954 since it would try to load a directory as a Lisp file */
955 if (SCHARS (file
) > 0)
957 int size
= SBYTES (file
);
960 GCPRO2 (file
, found
);
962 if (! NILP (must_suffix
))
964 /* Don't insist on adding a suffix if FILE already ends with one. */
966 && !strcmp (SSDATA (file
) + size
- 3, ".el"))
969 && !strcmp (SSDATA (file
) + size
- 4, ".elc"))
971 /* Don't insist on adding a suffix
972 if the argument includes a directory name. */
973 else if (! NILP (Ffile_name_directory (file
)))
977 fd
= openp (Vload_path
, file
,
978 (!NILP (nosuffix
) ? Qnil
979 : !NILP (must_suffix
) ? Fget_load_suffixes ()
980 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
981 tmp
[1] = Vload_file_rep_suffixes
,
990 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
994 /* Tell startup.el whether or not we found the user's init file. */
995 if (EQ (Qt
, Vuser_init_file
))
996 Vuser_init_file
= found
;
998 /* If FD is -2, that means openp found a magic file. */
1001 if (NILP (Fequal (found
, file
)))
1002 /* If FOUND is a different file name from FILE,
1003 find its handler even if we have already inhibited
1004 the `load' operation on FILE. */
1005 handler
= Ffind_file_name_handler (found
, Qt
);
1007 handler
= Ffind_file_name_handler (found
, Qload
);
1008 if (! NILP (handler
))
1009 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1012 /* Check if we're stuck in a recursive load cycle.
1014 2000-09-21: It's not possible to just check for the file loaded
1015 being a member of Vloads_in_progress. This fails because of the
1016 way the byte compiler currently works; `provide's are not
1017 evaluated, see font-lock.el/jit-lock.el as an example. This
1018 leads to a certain amount of ``normal'' recursion.
1020 Also, just loading a file recursively is not always an error in
1021 the general case; the second load may do something different. */
1025 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1026 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1030 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1032 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1033 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1036 /* Get the name for load-history. */
1037 hist_file_name
= (! NILP (Vpurify_flag
)
1038 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1039 tmp
[1] = Ffile_name_nondirectory (found
),
1045 /* Check for the presence of old-style quotes and warn about them. */
1046 specbind (Qold_style_backquotes
, Qnil
);
1047 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1049 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1050 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1051 /* Load .elc files directly, but not when they are
1052 remote and have no handler! */
1059 GCPRO3 (file
, found
, hist_file_name
);
1062 && ! (version
= safe_to_load_p (fd
)))
1065 if (!load_dangerous_libraries
)
1069 error ("File `%s' was not compiled in Emacs",
1072 else if (!NILP (nomessage
) && !force_load_messages
)
1073 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1078 efound
= ENCODE_FILE (found
);
1083 stat (SSDATA (efound
), &s1
);
1084 SSET (efound
, SBYTES (efound
) - 1, 0);
1085 result
= stat (SSDATA (efound
), &s2
);
1086 SSET (efound
, SBYTES (efound
) - 1, 'c');
1088 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1090 /* Make the progress messages mention that source is newer. */
1093 /* If we won't print another message, mention this anyway. */
1094 if (!NILP (nomessage
) && !force_load_messages
)
1096 Lisp_Object msg_file
;
1097 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1098 message_with_string ("Source file `%s' newer than byte-compiled file",
1107 /* We are loading a source file (*.el). */
1108 if (!NILP (Vload_source_file_function
))
1114 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1115 NILP (noerror
) ? Qnil
: Qt
,
1116 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1117 return unbind_to (count
, val
);
1121 GCPRO3 (file
, found
, hist_file_name
);
1125 efound
= ENCODE_FILE (found
);
1126 stream
= fopen (SSDATA (efound
), fmode
);
1127 #else /* not WINDOWSNT */
1128 stream
= fdopen (fd
, fmode
);
1129 #endif /* not WINDOWSNT */
1133 error ("Failure to create stdio stream for %s", SDATA (file
));
1136 if (! NILP (Vpurify_flag
))
1137 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1139 if (NILP (nomessage
) || force_load_messages
)
1142 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1145 message_with_string ("Loading %s (source)...", file
, 1);
1147 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1149 else /* The typical case; compiled file newer than source file. */
1150 message_with_string ("Loading %s...", file
, 1);
1153 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1154 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1155 specbind (Qload_file_name
, found
);
1156 specbind (Qinhibit_file_name_operation
, Qnil
);
1157 load_descriptor_list
1158 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1159 specbind (Qload_in_progress
, Qt
);
1160 if (! version
|| version
>= 22)
1161 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1162 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1165 /* We can't handle a file which was compiled with
1166 byte-compile-dynamic by older version of Emacs. */
1167 specbind (Qload_force_doc_strings
, Qt
);
1168 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1169 0, Qnil
, Qnil
, Qnil
, Qnil
);
1171 unbind_to (count
, Qnil
);
1173 /* Run any eval-after-load forms for this file */
1174 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1175 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1179 xfree (saved_doc_string
);
1180 saved_doc_string
= 0;
1181 saved_doc_string_size
= 0;
1183 xfree (prev_saved_doc_string
);
1184 prev_saved_doc_string
= 0;
1185 prev_saved_doc_string_size
= 0;
1187 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1190 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1193 message_with_string ("Loading %s (source)...done", file
, 1);
1195 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1197 else /* The typical case; compiled file newer than source file. */
1198 message_with_string ("Loading %s...done", file
, 1);
1205 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1207 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1218 load_descriptor_unwind (Lisp_Object oldlist
)
1220 load_descriptor_list
= oldlist
;
1224 /* Close all descriptors in use for Floads.
1225 This is used when starting a subprocess. */
1228 close_load_descs (void)
1232 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1233 emacs_close (XFASTINT (XCAR (tail
)));
1238 complete_filename_p (Lisp_Object pathname
)
1240 register const unsigned char *s
= SDATA (pathname
);
1241 return (IS_DIRECTORY_SEP (s
[0])
1242 || (SCHARS (pathname
) > 2
1243 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1246 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1247 doc
: /* Search for FILENAME through PATH.
1248 Returns the file's name in absolute form, or nil if not found.
1249 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1250 file name when searching.
1251 If non-nil, PREDICATE is used instead of `file-readable-p'.
1252 PREDICATE can also be an integer to pass to the access(2) function,
1253 in which case file-name-handlers are ignored. */)
1254 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1257 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1258 if (NILP (predicate
) && fd
> 0)
1264 /* Search for a file whose name is STR, looking in directories
1265 in the Lisp list PATH, and trying suffixes from SUFFIX.
1266 On success, returns a file descriptor. On failure, returns -1.
1268 SUFFIXES is a list of strings containing possible suffixes.
1269 The empty suffix is automatically added if the list is empty.
1271 PREDICATE non-nil means don't open the files,
1272 just look for one that satisfies the predicate. In this case,
1273 returns 1 on success. The predicate can be a lisp function or
1274 an integer to pass to `access' (in which case file-name-handlers
1277 If STOREPTR is nonzero, it points to a slot where the name of
1278 the file actually found should be stored as a Lisp string.
1279 nil is stored there on failure.
1281 If the file we find is remote, return -2
1282 but store the found remote file name in *STOREPTR. */
1285 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1290 register char *fn
= buf
;
1293 Lisp_Object filename
;
1295 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1296 Lisp_Object string
, tail
, encoded_fn
;
1297 int max_suffix_len
= 0;
1301 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1303 CHECK_STRING_CAR (tail
);
1304 max_suffix_len
= max (max_suffix_len
,
1305 SBYTES (XCAR (tail
)));
1308 string
= filename
= encoded_fn
= Qnil
;
1309 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1314 if (complete_filename_p (str
))
1317 for (; CONSP (path
); path
= XCDR (path
))
1319 filename
= Fexpand_file_name (str
, XCAR (path
));
1320 if (!complete_filename_p (filename
))
1321 /* If there are non-absolute elts in PATH (eg ".") */
1322 /* Of course, this could conceivably lose if luser sets
1323 default-directory to be something non-absolute... */
1325 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1326 if (!complete_filename_p (filename
))
1327 /* Give up on this path element! */
1331 /* Calculate maximum size of any filename made from
1332 this path element/specified file name and any possible suffix. */
1333 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1334 if (fn_size
< want_size
)
1335 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1337 /* Loop over suffixes. */
1338 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1339 CONSP (tail
); tail
= XCDR (tail
))
1341 int lsuffix
= SBYTES (XCAR (tail
));
1342 Lisp_Object handler
;
1345 /* Concatenate path element/specified name with the suffix.
1346 If the directory starts with /:, remove that. */
1347 if (SCHARS (filename
) > 2
1348 && SREF (filename
, 0) == '/'
1349 && SREF (filename
, 1) == ':')
1351 strncpy (fn
, SSDATA (filename
) + 2,
1352 SBYTES (filename
) - 2);
1353 fn
[SBYTES (filename
) - 2] = 0;
1357 strncpy (fn
, SSDATA (filename
),
1359 fn
[SBYTES (filename
)] = 0;
1362 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1363 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1365 /* Check that the file exists and is not a directory. */
1366 /* We used to only check for handlers on non-absolute file names:
1370 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1371 It's not clear why that was the case and it breaks things like
1372 (load "/bar.el") where the file is actually "/bar.el.gz". */
1373 string
= build_string (fn
);
1374 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1375 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1377 if (NILP (predicate
))
1378 exists
= !NILP (Ffile_readable_p (string
));
1380 exists
= !NILP (call1 (predicate
, string
));
1381 if (exists
&& !NILP (Ffile_directory_p (string
)))
1386 /* We succeeded; return this descriptor and filename. */
1397 encoded_fn
= ENCODE_FILE (string
);
1398 pfn
= SSDATA (encoded_fn
);
1399 exists
= (stat (pfn
, &st
) >= 0
1400 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1403 /* Check that we can access or open it. */
1404 if (NATNUMP (predicate
))
1405 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1407 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1411 /* We succeeded; return this descriptor and filename. */
1429 /* Merge the list we've accumulated of globals from the current input source
1430 into the load_history variable. The details depend on whether
1431 the source has an associated file name or not.
1433 FILENAME is the file name that we are loading from.
1434 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1437 build_load_history (Lisp_Object filename
, int entire
)
1439 register Lisp_Object tail
, prev
, newelt
;
1440 register Lisp_Object tem
, tem2
;
1441 register int foundit
= 0;
1443 tail
= Vload_history
;
1446 while (CONSP (tail
))
1450 /* Find the feature's previous assoc list... */
1451 if (!NILP (Fequal (filename
, Fcar (tem
))))
1455 /* If we're loading the entire file, remove old data. */
1459 Vload_history
= XCDR (tail
);
1461 Fsetcdr (prev
, XCDR (tail
));
1464 /* Otherwise, cons on new symbols that are not already members. */
1467 tem2
= Vcurrent_load_list
;
1469 while (CONSP (tem2
))
1471 newelt
= XCAR (tem2
);
1473 if (NILP (Fmember (newelt
, tem
)))
1474 Fsetcar (tail
, Fcons (XCAR (tem
),
1475 Fcons (newelt
, XCDR (tem
))));
1488 /* If we're loading an entire file, cons the new assoc onto the
1489 front of load-history, the most-recently-loaded position. Also
1490 do this if we didn't find an existing member for the file. */
1491 if (entire
|| !foundit
)
1492 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1497 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1504 readevalloop_1 (Lisp_Object old
)
1506 load_convert_to_unibyte
= ! NILP (old
);
1510 /* Signal an `end-of-file' error, if possible with file name
1514 end_of_file_error (void)
1516 if (STRINGP (Vload_file_name
))
1517 xsignal1 (Qend_of_file
, Vload_file_name
);
1519 xsignal0 (Qend_of_file
);
1522 /* UNIBYTE specifies how to set load_convert_to_unibyte
1523 for this invocation.
1524 READFUN, if non-nil, is used instead of `read'.
1526 START, END specify region to read in current buffer (from eval-region).
1527 If the input is not from a buffer, they must be nil. */
1530 readevalloop (Lisp_Object readcharfun
,
1532 Lisp_Object sourcename
,
1533 Lisp_Object (*evalfun
) (Lisp_Object
),
1535 Lisp_Object unibyte
, Lisp_Object readfun
,
1536 Lisp_Object start
, Lisp_Object end
)
1539 register Lisp_Object val
;
1540 int count
= SPECPDL_INDEX ();
1541 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1542 struct buffer
*b
= 0;
1543 int continue_reading_p
;
1544 /* Nonzero if reading an entire buffer. */
1545 int whole_buffer
= 0;
1546 /* 1 on the first time around. */
1549 if (MARKERP (readcharfun
))
1552 start
= readcharfun
;
1555 if (BUFFERP (readcharfun
))
1556 b
= XBUFFER (readcharfun
);
1557 else if (MARKERP (readcharfun
))
1558 b
= XMARKER (readcharfun
)->buffer
;
1560 /* We assume START is nil when input is not from a buffer. */
1561 if (! NILP (start
) && !b
)
1564 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1565 specbind (Qcurrent_load_list
, Qnil
);
1566 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1567 load_convert_to_unibyte
= !NILP (unibyte
);
1569 GCPRO4 (sourcename
, readfun
, start
, end
);
1571 /* Try to ensure sourcename is a truename, except whilst preloading. */
1572 if (NILP (Vpurify_flag
)
1573 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1574 && !NILP (Ffboundp (Qfile_truename
)))
1575 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1577 LOADHIST_ATTACH (sourcename
);
1579 continue_reading_p
= 1;
1580 while (continue_reading_p
)
1582 int count1
= SPECPDL_INDEX ();
1584 if (b
!= 0 && NILP (b
->name
))
1585 error ("Reading from killed buffer");
1589 /* Switch to the buffer we are reading from. */
1590 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1591 set_buffer_internal (b
);
1593 /* Save point in it. */
1594 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1595 /* Save ZV in it. */
1596 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1597 /* Those get unbound after we read one expression. */
1599 /* Set point and ZV around stuff to be read. */
1602 Fnarrow_to_region (make_number (BEGV
), end
);
1604 /* Just for cleanliness, convert END to a marker
1605 if it is an integer. */
1607 end
= Fpoint_max_marker ();
1610 /* On the first cycle, we can easily test here
1611 whether we are reading the whole buffer. */
1612 if (b
&& first_sexp
)
1613 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1620 while ((c
= READCHAR
) != '\n' && c
!= -1);
1625 unbind_to (count1
, Qnil
);
1629 /* Ignore whitespace here, so we can detect eof. */
1630 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1631 || c
== 0x8a0) /* NBSP */
1634 if (!NILP (Vpurify_flag
) && c
== '(')
1636 record_unwind_protect (unreadpure
, Qnil
);
1637 val
= read_list (-1, readcharfun
);
1642 read_objects
= Qnil
;
1643 if (!NILP (readfun
))
1645 val
= call1 (readfun
, readcharfun
);
1647 /* If READCHARFUN has set point to ZV, we should
1648 stop reading, even if the form read sets point
1649 to a different value when evaluated. */
1650 if (BUFFERP (readcharfun
))
1652 struct buffer
*b
= XBUFFER (readcharfun
);
1653 if (BUF_PT (b
) == BUF_ZV (b
))
1654 continue_reading_p
= 0;
1657 else if (! NILP (Vload_read_function
))
1658 val
= call1 (Vload_read_function
, readcharfun
);
1660 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1663 if (!NILP (start
) && continue_reading_p
)
1664 start
= Fpoint_marker ();
1666 /* Restore saved point and BEGV. */
1667 unbind_to (count1
, Qnil
);
1669 /* Now eval what we just read. */
1670 val
= (*evalfun
) (val
);
1674 Vvalues
= Fcons (val
, Vvalues
);
1675 if (EQ (Vstandard_output
, Qt
))
1684 build_load_history (sourcename
,
1685 stream
|| whole_buffer
);
1689 unbind_to (count
, Qnil
);
1692 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1693 doc
: /* Execute the current buffer as Lisp code.
1694 When called from a Lisp program (i.e., not interactively), this
1695 function accepts up to five optional arguments:
1696 BUFFER is the buffer to evaluate (nil means use current buffer).
1697 PRINTFLAG controls printing of output:
1698 A value of nil means discard it; anything else is stream for print.
1699 FILENAME specifies the file name to use for `load-history'.
1700 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1702 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1703 functions should work normally even if PRINTFLAG is nil.
1705 This function preserves the position of point. */)
1706 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1708 int count
= SPECPDL_INDEX ();
1709 Lisp_Object tem
, buf
;
1712 buf
= Fcurrent_buffer ();
1714 buf
= Fget_buffer (buffer
);
1716 error ("No such buffer");
1718 if (NILP (printflag
) && NILP (do_allow_print
))
1723 if (NILP (filename
))
1724 filename
= XBUFFER (buf
)->filename
;
1726 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1727 specbind (Qstandard_output
, tem
);
1728 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1729 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1730 readevalloop (buf
, 0, filename
, Feval
,
1731 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1732 unbind_to (count
, Qnil
);
1737 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1738 doc
: /* Execute the region as Lisp code.
1739 When called from programs, expects two arguments,
1740 giving starting and ending indices in the current buffer
1741 of the text to be executed.
1742 Programs can pass third argument PRINTFLAG which controls output:
1743 A value of nil means discard it; anything else is stream for printing it.
1744 Also the fourth argument READ-FUNCTION, if non-nil, is used
1745 instead of `read' to read each expression. It gets one argument
1746 which is the input stream for reading characters.
1748 This function does not move point. */)
1749 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1751 int count
= SPECPDL_INDEX ();
1752 Lisp_Object tem
, cbuf
;
1754 cbuf
= Fcurrent_buffer ();
1756 if (NILP (printflag
))
1760 specbind (Qstandard_output
, tem
);
1761 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1763 /* readevalloop calls functions which check the type of start and end. */
1764 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1765 !NILP (printflag
), Qnil
, read_function
,
1768 return unbind_to (count
, Qnil
);
1772 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1773 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1774 If STREAM is nil, use the value of `standard-input' (which see).
1775 STREAM or the value of `standard-input' may be:
1776 a buffer (read from point and advance it)
1777 a marker (read from where it points and advance it)
1778 a function (call it with no arguments for each character,
1779 call it with a char as argument to push a char back)
1780 a string (takes text from string, starting at the beginning)
1781 t (read text line using minibuffer and use it, or read from
1782 standard input in batch mode). */)
1783 (Lisp_Object stream
)
1786 stream
= Vstandard_input
;
1787 if (EQ (stream
, Qt
))
1788 stream
= Qread_char
;
1789 if (EQ (stream
, Qread_char
))
1790 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1792 return read_internal_start (stream
, Qnil
, Qnil
);
1795 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1796 doc
: /* Read one Lisp expression which is represented as text by STRING.
1797 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1798 START and END optionally delimit a substring of STRING from which to read;
1799 they default to 0 and (length STRING) respectively. */)
1800 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1803 CHECK_STRING (string
);
1804 /* read_internal_start sets read_from_string_index. */
1805 ret
= read_internal_start (string
, start
, end
);
1806 return Fcons (ret
, make_number (read_from_string_index
));
1809 /* Function to set up the global context we need in toplevel read
1812 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1813 /* start, end only used when stream is a string. */
1818 new_backquote_flag
= 0;
1819 read_objects
= Qnil
;
1820 if (EQ (Vread_with_symbol_positions
, Qt
)
1821 || EQ (Vread_with_symbol_positions
, stream
))
1822 Vread_symbol_positions_list
= Qnil
;
1824 if (STRINGP (stream
)
1825 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1827 EMACS_INT startval
, endval
;
1830 if (STRINGP (stream
))
1833 string
= XCAR (stream
);
1836 endval
= SCHARS (string
);
1840 endval
= XINT (end
);
1841 if (endval
< 0 || endval
> SCHARS (string
))
1842 args_out_of_range (string
, end
);
1849 CHECK_NUMBER (start
);
1850 startval
= XINT (start
);
1851 if (startval
< 0 || startval
> endval
)
1852 args_out_of_range (string
, start
);
1854 read_from_string_index
= startval
;
1855 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1856 read_from_string_limit
= endval
;
1859 retval
= read0 (stream
);
1860 if (EQ (Vread_with_symbol_positions
, Qt
)
1861 || EQ (Vread_with_symbol_positions
, stream
))
1862 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1867 /* Signal Qinvalid_read_syntax error.
1868 S is error string of length N (if > 0) */
1871 invalid_syntax (const char *s
, int n
)
1875 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1879 /* Use this for recursive reads, in contexts where internal tokens
1883 read0 (Lisp_Object readcharfun
)
1885 register Lisp_Object val
;
1888 val
= read1 (readcharfun
, &c
, 0);
1892 xsignal1 (Qinvalid_read_syntax
,
1893 Fmake_string (make_number (1), make_number (c
)));
1896 static int read_buffer_size
;
1897 static char *read_buffer
;
1899 /* Read a \-escape sequence, assuming we already read the `\'.
1900 If the escape sequence forces unibyte, return eight-bit char. */
1903 read_escape (Lisp_Object readcharfun
, int stringp
)
1905 register int c
= READCHAR
;
1906 /* \u allows up to four hex digits, \U up to eight. Default to the
1907 behavior for \u, and change this value in the case that \U is seen. */
1908 int unicode_hex_count
= 4;
1913 end_of_file_error ();
1943 error ("Invalid escape character syntax");
1946 c
= read_escape (readcharfun
, 0);
1947 return c
| meta_modifier
;
1952 error ("Invalid escape character syntax");
1955 c
= read_escape (readcharfun
, 0);
1956 return c
| shift_modifier
;
1961 error ("Invalid escape character syntax");
1964 c
= read_escape (readcharfun
, 0);
1965 return c
| hyper_modifier
;
1970 error ("Invalid escape character syntax");
1973 c
= read_escape (readcharfun
, 0);
1974 return c
| alt_modifier
;
1978 if (stringp
|| c
!= '-')
1985 c
= read_escape (readcharfun
, 0);
1986 return c
| super_modifier
;
1991 error ("Invalid escape character syntax");
1995 c
= read_escape (readcharfun
, 0);
1996 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1997 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1998 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1999 return c
| ctrl_modifier
;
2000 /* ASCII control chars are made from letters (both cases),
2001 as well as the non-letters within 0100...0137. */
2002 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2003 return (c
& (037 | ~0177));
2004 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2005 return (c
& (037 | ~0177));
2007 return c
| ctrl_modifier
;
2017 /* An octal escape, as in ANSI C. */
2019 register int i
= c
- '0';
2020 register int count
= 0;
2023 if ((c
= READCHAR
) >= '0' && c
<= '7')
2035 if (i
>= 0x80 && i
< 0x100)
2036 i
= BYTE8_TO_CHAR (i
);
2041 /* A hex escape, as in ANSI C. */
2048 if (c
>= '0' && c
<= '9')
2053 else if ((c
>= 'a' && c
<= 'f')
2054 || (c
>= 'A' && c
<= 'F'))
2057 if (c
>= 'a' && c
<= 'f')
2070 if (count
< 3 && i
>= 0x80)
2071 return BYTE8_TO_CHAR (i
);
2076 /* Post-Unicode-2.0: Up to eight hex chars. */
2077 unicode_hex_count
= 8;
2080 /* A Unicode escape. We only permit them in strings and characters,
2081 not arbitrarily in the source code, as in some other languages. */
2086 while (++count
<= unicode_hex_count
)
2089 /* isdigit and isalpha may be locale-specific, which we don't
2091 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2092 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2093 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2096 error ("Non-hex digit used for Unicode escape");
2101 error ("Non-Unicode character: 0x%x", i
);
2110 /* Read an integer in radix RADIX using READCHARFUN to read
2111 characters. RADIX must be in the interval [2..36]; if it isn't, a
2112 read error is signaled . Value is the integer read. Signals an
2113 error if encountering invalid read syntax or if RADIX is out of
2117 read_integer (Lisp_Object readcharfun
, int radix
)
2119 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2120 /* We use a floating point number because */
2123 if (radix
< 2 || radix
> 36)
2127 number
= ndigits
= invalid_p
= 0;
2143 if (c
>= '0' && c
<= '9')
2145 else if (c
>= 'a' && c
<= 'z')
2146 digit
= c
- 'a' + 10;
2147 else if (c
>= 'A' && c
<= 'Z')
2148 digit
= c
- 'A' + 10;
2155 if (digit
< 0 || digit
>= radix
)
2158 number
= radix
* number
+ digit
;
2164 if (ndigits
== 0 || invalid_p
)
2167 sprintf (buf
, "integer, radix %d", radix
);
2168 invalid_syntax (buf
, 0);
2171 return make_fixnum_or_float (sign
* number
);
2175 /* If the next token is ')' or ']' or '.', we store that character
2176 in *PCH and the return value is not interesting. Else, we store
2177 zero in *PCH and we read and return one lisp object.
2179 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2182 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2185 int uninterned_symbol
= 0;
2193 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2195 end_of_file_error ();
2200 return read_list (0, readcharfun
);
2203 return read_vector (readcharfun
, 0);
2219 /* Accept extended format for hashtables (extensible to
2221 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2222 Lisp_Object tmp
= read_list (0, readcharfun
);
2223 Lisp_Object head
= CAR_SAFE (tmp
);
2224 Lisp_Object data
= Qnil
;
2225 Lisp_Object val
= Qnil
;
2226 /* The size is 2 * number of allowed keywords to
2228 Lisp_Object params
[10];
2230 Lisp_Object key
= Qnil
;
2231 int param_count
= 0;
2233 if (!EQ (head
, Qhash_table
))
2234 error ("Invalid extended read marker at head of #s list "
2235 "(only hash-table allowed)");
2237 tmp
= CDR_SAFE (tmp
);
2239 /* This is repetitive but fast and simple. */
2240 params
[param_count
] = QCsize
;
2241 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2242 if (!NILP (params
[param_count
+ 1]))
2245 params
[param_count
] = QCtest
;
2246 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2247 if (!NILP (params
[param_count
+ 1]))
2250 params
[param_count
] = QCweakness
;
2251 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2252 if (!NILP (params
[param_count
+ 1]))
2255 params
[param_count
] = QCrehash_size
;
2256 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2257 if (!NILP (params
[param_count
+ 1]))
2260 params
[param_count
] = QCrehash_threshold
;
2261 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2262 if (!NILP (params
[param_count
+ 1]))
2265 /* This is the hashtable data. */
2266 data
= Fplist_get (tmp
, Qdata
);
2268 /* Now use params to make a new hashtable and fill it. */
2269 ht
= Fmake_hash_table (param_count
, params
);
2271 while (CONSP (data
))
2276 error ("Odd number of elements in hashtable data");
2279 Fputhash (key
, val
, ht
);
2285 invalid_syntax ("#", 1);
2293 tmp
= read_vector (readcharfun
, 0);
2294 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2295 error ("Invalid size char-table");
2296 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2307 tmp
= read_vector (readcharfun
, 0);
2308 if (!INTEGERP (AREF (tmp
, 0)))
2309 error ("Invalid depth in char-table");
2310 depth
= XINT (AREF (tmp
, 0));
2311 if (depth
< 1 || depth
> 3)
2312 error ("Invalid depth in char-table");
2313 size
= XVECTOR (tmp
)->size
- 2;
2314 if (chartab_size
[depth
] != size
)
2315 error ("Invalid size char-table");
2316 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2319 invalid_syntax ("#^^", 3);
2321 invalid_syntax ("#^", 2);
2326 length
= read1 (readcharfun
, pch
, first_in_list
);
2330 Lisp_Object tmp
, val
;
2332 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2333 / BOOL_VECTOR_BITS_PER_CHAR
);
2336 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2337 if (STRING_MULTIBYTE (tmp
)
2338 || (size_in_chars
!= SCHARS (tmp
)
2339 /* We used to print 1 char too many
2340 when the number of bits was a multiple of 8.
2341 Accept such input in case it came from an old
2343 && ! (XFASTINT (length
)
2344 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2345 invalid_syntax ("#&...", 5);
2347 val
= Fmake_bool_vector (length
, Qnil
);
2348 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2349 /* Clear the extraneous bits in the last byte. */
2350 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2351 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2352 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2355 invalid_syntax ("#&...", 5);
2359 /* Accept compiled functions at read-time so that we don't have to
2360 build them using function calls. */
2362 tmp
= read_vector (readcharfun
, 1);
2363 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2364 XVECTOR (tmp
)->contents
);
2369 struct gcpro gcpro1
;
2372 /* Read the string itself. */
2373 tmp
= read1 (readcharfun
, &ch
, 0);
2374 if (ch
!= 0 || !STRINGP (tmp
))
2375 invalid_syntax ("#", 1);
2377 /* Read the intervals and their properties. */
2380 Lisp_Object beg
, end
, plist
;
2382 beg
= read1 (readcharfun
, &ch
, 0);
2387 end
= read1 (readcharfun
, &ch
, 0);
2389 plist
= read1 (readcharfun
, &ch
, 0);
2391 invalid_syntax ("Invalid string property list", 0);
2392 Fset_text_properties (beg
, end
, plist
, tmp
);
2398 /* #@NUMBER is used to skip NUMBER following characters.
2399 That's used in .elc files to skip over doc strings
2400 and function definitions. */
2406 /* Read a decimal integer. */
2407 while ((c
= READCHAR
) >= 0
2408 && c
>= '0' && c
<= '9')
2416 if (load_force_doc_strings
2417 && (EQ (readcharfun
, Qget_file_char
)
2418 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2420 /* If we are supposed to force doc strings into core right now,
2421 record the last string that we skipped,
2422 and record where in the file it comes from. */
2424 /* But first exchange saved_doc_string
2425 with prev_saved_doc_string, so we save two strings. */
2427 char *temp
= saved_doc_string
;
2428 int temp_size
= saved_doc_string_size
;
2429 file_offset temp_pos
= saved_doc_string_position
;
2430 int temp_len
= saved_doc_string_length
;
2432 saved_doc_string
= prev_saved_doc_string
;
2433 saved_doc_string_size
= prev_saved_doc_string_size
;
2434 saved_doc_string_position
= prev_saved_doc_string_position
;
2435 saved_doc_string_length
= prev_saved_doc_string_length
;
2437 prev_saved_doc_string
= temp
;
2438 prev_saved_doc_string_size
= temp_size
;
2439 prev_saved_doc_string_position
= temp_pos
;
2440 prev_saved_doc_string_length
= temp_len
;
2443 if (saved_doc_string_size
== 0)
2445 saved_doc_string_size
= nskip
+ 100;
2446 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2448 if (nskip
> saved_doc_string_size
)
2450 saved_doc_string_size
= nskip
+ 100;
2451 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2452 saved_doc_string_size
);
2455 saved_doc_string_position
= file_tell (instream
);
2457 /* Copy that many characters into saved_doc_string. */
2458 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2459 saved_doc_string
[i
] = c
= READCHAR
;
2461 saved_doc_string_length
= i
;
2465 /* Skip that many characters. */
2466 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2475 /* #! appears at the beginning of an executable file.
2476 Skip the first line. */
2477 while (c
!= '\n' && c
>= 0)
2482 return Vload_file_name
;
2484 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2485 /* #:foo is the uninterned symbol named foo. */
2488 uninterned_symbol
= 1;
2492 /* Reader forms that can reuse previously read objects. */
2493 if (c
>= '0' && c
<= '9')
2498 /* Read a non-negative integer. */
2499 while (c
>= '0' && c
<= '9')
2505 /* #n=object returns object, but associates it with n for #n#. */
2506 if (c
== '=' && !NILP (Vread_circle
))
2508 /* Make a placeholder for #n# to use temporarily */
2509 Lisp_Object placeholder
;
2512 placeholder
= Fcons (Qnil
, Qnil
);
2513 cell
= Fcons (make_number (n
), placeholder
);
2514 read_objects
= Fcons (cell
, read_objects
);
2516 /* Read the object itself. */
2517 tem
= read0 (readcharfun
);
2519 /* Now put it everywhere the placeholder was... */
2520 substitute_object_in_subtree (tem
, placeholder
);
2522 /* ...and #n# will use the real value from now on. */
2523 Fsetcdr (cell
, tem
);
2527 /* #n# returns a previously read object. */
2528 if (c
== '#' && !NILP (Vread_circle
))
2530 tem
= Fassq (make_number (n
), read_objects
);
2533 /* Fall through to error message. */
2535 else if (c
== 'r' || c
== 'R')
2536 return read_integer (readcharfun
, n
);
2538 /* Fall through to error message. */
2540 else if (c
== 'x' || c
== 'X')
2541 return read_integer (readcharfun
, 16);
2542 else if (c
== 'o' || c
== 'O')
2543 return read_integer (readcharfun
, 8);
2544 else if (c
== 'b' || c
== 'B')
2545 return read_integer (readcharfun
, 2);
2548 invalid_syntax ("#", 1);
2551 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2556 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2561 int next_char
= READCHAR
;
2563 /* Transition from old-style to new-style:
2564 If we see "(`" it used to mean old-style, which usually works
2565 fine because ` should almost never appear in such a position
2566 for new-style. But occasionally we need "(`" to mean new
2567 style, so we try to distinguish the two by the fact that we
2568 can either write "( `foo" or "(` foo", where the first
2569 intends to use new-style whereas the second intends to use
2570 old-style. For Emacs-25, we should completely remove this
2571 first_in_list exception (old-style can still be obtained via
2573 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2575 Vold_style_backquotes
= Qt
;
2582 new_backquote_flag
++;
2583 value
= read0 (readcharfun
);
2584 new_backquote_flag
--;
2586 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2591 int next_char
= READCHAR
;
2593 /* Transition from old-style to new-style:
2594 It used to be impossible to have a new-style , other than within
2595 a new-style `. This is sufficient when ` and , are used in the
2596 normal way, but ` and , can also appear in args to macros that
2597 will not interpret them in the usual way, in which case , may be
2598 used without any ` anywhere near.
2599 So we now use the same heuristic as for backquote: old-style
2600 unquotes are only recognized when first on a list, and when
2601 followed by a space.
2602 Because it's more difficult to peak 2 chars ahead, a new-style
2603 ,@ can still not be used outside of a `, unless it's in the middle
2605 if (new_backquote_flag
2607 || (next_char
!= ' ' && next_char
!= '@'))
2609 Lisp_Object comma_type
= Qnil
;
2614 comma_type
= Qcomma_at
;
2616 comma_type
= Qcomma_dot
;
2619 if (ch
>= 0) UNREAD (ch
);
2620 comma_type
= Qcomma
;
2623 value
= read0 (readcharfun
);
2624 return Fcons (comma_type
, Fcons (value
, Qnil
));
2628 Vold_style_backquotes
= Qt
;
2640 end_of_file_error ();
2642 /* Accept `single space' syntax like (list ? x) where the
2643 whitespace character is SPC or TAB.
2644 Other literal whitespace like NL, CR, and FF are not accepted,
2645 as there are well-established escape sequences for these. */
2646 if (c
== ' ' || c
== '\t')
2647 return make_number (c
);
2650 c
= read_escape (readcharfun
, 0);
2651 modifiers
= c
& CHAR_MODIFIER_MASK
;
2652 c
&= ~CHAR_MODIFIER_MASK
;
2653 if (CHAR_BYTE8_P (c
))
2654 c
= CHAR_TO_BYTE8 (c
);
2657 next_char
= READCHAR
;
2658 ok
= (next_char
<= 040
2659 || (next_char
< 0200
2660 && (strchr ("\"';()[]#?`,.", next_char
))));
2663 return make_number (c
);
2665 invalid_syntax ("?", 1);
2670 char *p
= read_buffer
;
2671 char *end
= read_buffer
+ read_buffer_size
;
2673 /* Nonzero if we saw an escape sequence specifying
2674 a multibyte character. */
2675 int force_multibyte
= 0;
2676 /* Nonzero if we saw an escape sequence specifying
2677 a single-byte character. */
2678 int force_singlebyte
= 0;
2682 while ((c
= READCHAR
) >= 0
2685 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2687 int offset
= p
- read_buffer
;
2688 read_buffer
= (char *) xrealloc (read_buffer
,
2689 read_buffer_size
*= 2);
2690 p
= read_buffer
+ offset
;
2691 end
= read_buffer
+ read_buffer_size
;
2698 c
= read_escape (readcharfun
, 1);
2700 /* C is -1 if \ newline has just been seen */
2703 if (p
== read_buffer
)
2708 modifiers
= c
& CHAR_MODIFIER_MASK
;
2709 c
= c
& ~CHAR_MODIFIER_MASK
;
2711 if (CHAR_BYTE8_P (c
))
2712 force_singlebyte
= 1;
2713 else if (! ASCII_CHAR_P (c
))
2714 force_multibyte
= 1;
2715 else /* i.e. ASCII_CHAR_P (c) */
2717 /* Allow `\C- ' and `\C-?'. */
2718 if (modifiers
== CHAR_CTL
)
2721 c
= 0, modifiers
= 0;
2723 c
= 127, modifiers
= 0;
2725 if (modifiers
& CHAR_SHIFT
)
2727 /* Shift modifier is valid only with [A-Za-z]. */
2728 if (c
>= 'A' && c
<= 'Z')
2729 modifiers
&= ~CHAR_SHIFT
;
2730 else if (c
>= 'a' && c
<= 'z')
2731 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2734 if (modifiers
& CHAR_META
)
2736 /* Move the meta bit to the right place for a
2738 modifiers
&= ~CHAR_META
;
2739 c
= BYTE8_TO_CHAR (c
| 0x80);
2740 force_singlebyte
= 1;
2744 /* Any modifiers remaining are invalid. */
2746 error ("Invalid modifier in string");
2747 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2751 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2752 if (CHAR_BYTE8_P (c
))
2753 force_singlebyte
= 1;
2754 else if (! ASCII_CHAR_P (c
))
2755 force_multibyte
= 1;
2761 end_of_file_error ();
2763 /* If purifying, and string starts with \ newline,
2764 return zero instead. This is for doc strings
2765 that we are really going to find in etc/DOC.nn.nn */
2766 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2767 return make_number (0);
2769 if (force_multibyte
)
2770 /* READ_BUFFER already contains valid multibyte forms. */
2772 else if (force_singlebyte
)
2774 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2776 p
= read_buffer
+ nchars
;
2779 /* Otherwise, READ_BUFFER contains only ASCII. */
2782 /* We want readchar_count to be the number of characters, not
2783 bytes. Hence we adjust for multibyte characters in the
2784 string. ... But it doesn't seem to be necessary, because
2785 READCHAR *does* read multibyte characters from buffers. */
2786 /* readchar_count -= (p - read_buffer) - nchars; */
2788 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2790 || (p
- read_buffer
!= nchars
)));
2791 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2793 || (p
- read_buffer
!= nchars
)));
2798 int next_char
= READCHAR
;
2801 if (next_char
<= 040
2802 || (next_char
< 0200
2803 && (strchr ("\"';([#?`,", next_char
))))
2809 /* Otherwise, we fall through! Note that the atom-reading loop
2810 below will now loop at least once, assuring that we will not
2811 try to UNREAD two characters in a row. */
2815 if (c
<= 040) goto retry
;
2816 if (c
== 0x8a0) /* NBSP */
2819 char *p
= read_buffer
;
2823 char *end
= read_buffer
+ read_buffer_size
;
2827 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2829 int offset
= p
- read_buffer
;
2830 read_buffer
= (char *) xrealloc (read_buffer
,
2831 read_buffer_size
*= 2);
2832 p
= read_buffer
+ offset
;
2833 end
= read_buffer
+ read_buffer_size
;
2840 end_of_file_error ();
2845 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2850 && c
!= 0x8a0 /* NBSP */
2852 || !(strchr ("\"';()[]#`,", c
))));
2856 int offset
= p
- read_buffer
;
2857 read_buffer
= (char *) xrealloc (read_buffer
,
2858 read_buffer_size
*= 2);
2859 p
= read_buffer
+ offset
;
2860 end
= read_buffer
+ read_buffer_size
;
2867 if (!quoted
&& !uninterned_symbol
)
2871 if (*p1
== '+' || *p1
== '-') p1
++;
2872 /* Is it an integer? */
2875 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2876 /* Integers can have trailing decimal points. */
2877 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2879 /* It is an integer. */
2884 /* EMACS_INT n = atol (read_buffer); */
2885 char *endptr
= NULL
;
2886 EMACS_INT n
= (errno
= 0,
2887 strtol (read_buffer
, &endptr
, 10));
2888 if (errno
== ERANGE
&& endptr
)
2891 = Fcons (make_string (read_buffer
,
2892 endptr
- read_buffer
),
2894 xsignal (Qoverflow_error
, args
);
2896 return make_fixnum_or_float (n
);
2900 if (isfloat_string (read_buffer
, 0))
2902 /* Compute NaN and infinities using 0.0 in a variable,
2903 to cope with compilers that think they are smarter
2909 /* Negate the value ourselves. This treats 0, NaNs,
2910 and infinity properly on IEEE floating point hosts,
2911 and works around a common bug where atof ("-0.0")
2913 int negative
= read_buffer
[0] == '-';
2915 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2916 returns 1, is if the input ends in e+INF or e+NaN. */
2923 value
= zero
/ zero
;
2925 /* If that made a "negative" NaN, negate it. */
2929 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2932 u_minus_zero
.d
= - 0.0;
2933 for (i
= 0; i
< sizeof (double); i
++)
2934 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2940 /* Now VALUE is a positive NaN. */
2943 value
= atof (read_buffer
+ negative
);
2947 return make_float (negative
? - value
: value
);
2951 Lisp_Object name
, result
;
2952 EMACS_INT nbytes
= p
- read_buffer
;
2955 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
2959 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
2960 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
2962 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
2963 result
= (uninterned_symbol
? Fmake_symbol (name
)
2964 : Fintern (name
, Qnil
));
2966 if (EQ (Vread_with_symbol_positions
, Qt
)
2967 || EQ (Vread_with_symbol_positions
, readcharfun
))
2968 Vread_symbol_positions_list
=
2969 /* Kind of a hack; this will probably fail if characters
2970 in the symbol name were escaped. Not really a big
2972 Fcons (Fcons (result
,
2973 make_number (readchar_count
2974 - XFASTINT (Flength (Fsymbol_name (result
))))),
2975 Vread_symbol_positions_list
);
2983 /* List of nodes we've seen during substitute_object_in_subtree. */
2984 static Lisp_Object seen_list
;
2987 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
2989 Lisp_Object check_object
;
2991 /* We haven't seen any objects when we start. */
2994 /* Make all the substitutions. */
2996 = substitute_object_recurse (object
, placeholder
, object
);
2998 /* Clear seen_list because we're done with it. */
3001 /* The returned object here is expected to always eq the
3003 if (!EQ (check_object
, object
))
3004 error ("Unexpected mutation error in reader");
3007 /* Feval doesn't get called from here, so no gc protection is needed. */
3008 #define SUBSTITUTE(get_val, set_val) \
3010 Lisp_Object old_value = get_val; \
3011 Lisp_Object true_value \
3012 = substitute_object_recurse (object, placeholder, \
3015 if (!EQ (old_value, true_value)) \
3022 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3024 /* If we find the placeholder, return the target object. */
3025 if (EQ (placeholder
, subtree
))
3028 /* If we've been to this node before, don't explore it again. */
3029 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3032 /* If this node can be the entry point to a cycle, remember that
3033 we've seen it. It can only be such an entry point if it was made
3034 by #n=, which means that we can find it as a value in
3036 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3037 seen_list
= Fcons (subtree
, seen_list
);
3039 /* Recurse according to subtree's type.
3040 Every branch must return a Lisp_Object. */
3041 switch (XTYPE (subtree
))
3043 case Lisp_Vectorlike
:
3046 if (BOOL_VECTOR_P (subtree
))
3047 return subtree
; /* No sub-objects anyway. */
3048 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3049 || COMPILEDP (subtree
))
3050 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3051 else if (VECTORP (subtree
))
3052 length
= ASIZE (subtree
);
3054 /* An unknown pseudovector may contain non-Lisp fields, so we
3055 can't just blindly traverse all its fields. We used to call
3056 `Flength' which signaled `sequencep', so I just preserved this
3058 wrong_type_argument (Qsequencep
, subtree
);
3060 for (i
= 0; i
< length
; i
++)
3061 SUBSTITUTE (AREF (subtree
, i
),
3062 ASET (subtree
, i
, true_value
));
3068 SUBSTITUTE (XCAR (subtree
),
3069 XSETCAR (subtree
, true_value
));
3070 SUBSTITUTE (XCDR (subtree
),
3071 XSETCDR (subtree
, true_value
));
3077 /* Check for text properties in each interval.
3078 substitute_in_interval contains part of the logic. */
3080 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3081 Lisp_Object arg
= Fcons (object
, placeholder
);
3083 traverse_intervals_noorder (root_interval
,
3084 &substitute_in_interval
, arg
);
3089 /* Other types don't recurse any further. */
3095 /* Helper function for substitute_object_recurse. */
3097 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3099 Lisp_Object object
= Fcar (arg
);
3100 Lisp_Object placeholder
= Fcdr (arg
);
3102 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3113 isfloat_string (const char *cp
, int ignore_trailing
)
3116 const char *start
= cp
;
3119 if (*cp
== '+' || *cp
== '-')
3122 if (*cp
>= '0' && *cp
<= '9')
3125 while (*cp
>= '0' && *cp
<= '9')
3133 if (*cp
>= '0' && *cp
<= '9')
3136 while (*cp
>= '0' && *cp
<= '9')
3139 if (*cp
== 'e' || *cp
== 'E')
3143 if (*cp
== '+' || *cp
== '-')
3147 if (*cp
>= '0' && *cp
<= '9')
3150 while (*cp
>= '0' && *cp
<= '9')
3153 else if (cp
== start
)
3155 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3160 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3166 return ((ignore_trailing
3167 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3168 || *cp
== '\r' || *cp
== '\f')
3169 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3170 || state
== (DOT_CHAR
|TRAIL_INT
)
3171 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3172 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3173 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3178 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3182 register Lisp_Object
*ptr
;
3183 register Lisp_Object tem
, item
, vector
;
3184 register struct Lisp_Cons
*otem
;
3187 tem
= read_list (1, readcharfun
);
3188 len
= Flength (tem
);
3189 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3191 size
= XVECTOR (vector
)->size
;
3192 ptr
= XVECTOR (vector
)->contents
;
3193 for (i
= 0; i
< size
; i
++)
3196 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3197 bytecode object, the docstring containing the bytecode and
3198 constants values must be treated as unibyte and passed to
3199 Fread, to get the actual bytecode string and constants vector. */
3200 if (bytecodeflag
&& load_force_doc_strings
)
3202 if (i
== COMPILED_BYTECODE
)
3204 if (!STRINGP (item
))
3205 error ("Invalid byte code");
3207 /* Delay handling the bytecode slot until we know whether
3208 it is lazily-loaded (we can tell by whether the
3209 constants slot is nil). */
3210 ptr
[COMPILED_CONSTANTS
] = item
;
3213 else if (i
== COMPILED_CONSTANTS
)
3215 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3219 /* Coerce string to unibyte (like string-as-unibyte,
3220 but without generating extra garbage and
3221 guaranteeing no change in the contents). */
3222 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3223 STRING_SET_UNIBYTE (bytestr
);
3225 item
= Fread (Fcons (bytestr
, readcharfun
));
3227 error ("Invalid byte code");
3229 otem
= XCONS (item
);
3230 bytestr
= XCAR (item
);
3235 /* Now handle the bytecode slot. */
3236 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3238 else if (i
== COMPILED_DOC_STRING
3240 && ! STRING_MULTIBYTE (item
))
3242 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3243 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3245 item
= Fstring_as_multibyte (item
);
3248 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3256 /* FLAG = 1 means check for ] to terminate rather than ) and .
3257 FLAG = -1 means check for starting with defun
3258 and make structure pure. */
3261 read_list (int flag
, register Lisp_Object readcharfun
)
3263 /* -1 means check next element for defun,
3264 0 means don't check,
3265 1 means already checked and found defun. */
3266 int defunflag
= flag
< 0 ? -1 : 0;
3267 Lisp_Object val
, tail
;
3268 register Lisp_Object elt
, tem
;
3269 struct gcpro gcpro1
, gcpro2
;
3270 /* 0 is the normal case.
3271 1 means this list is a doc reference; replace it with the number 0.
3272 2 means this list is a doc reference; replace it with the doc string. */
3273 int doc_reference
= 0;
3275 /* Initialize this to 1 if we are reading a list. */
3276 int first_in_list
= flag
<= 0;
3285 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3290 /* While building, if the list starts with #$, treat it specially. */
3291 if (EQ (elt
, Vload_file_name
)
3293 && !NILP (Vpurify_flag
))
3295 if (NILP (Vdoc_file_name
))
3296 /* We have not yet called Snarf-documentation, so assume
3297 this file is described in the DOC-MM.NN file
3298 and Snarf-documentation will fill in the right value later.
3299 For now, replace the whole list with 0. */
3302 /* We have already called Snarf-documentation, so make a relative
3303 file name for this file, so it can be found properly
3304 in the installed Lisp directory.
3305 We don't use Fexpand_file_name because that would make
3306 the directory absolute now. */
3307 elt
= concat2 (build_string ("../lisp/"),
3308 Ffile_name_nondirectory (elt
));
3310 else if (EQ (elt
, Vload_file_name
)
3312 && load_force_doc_strings
)
3321 invalid_syntax (") or . in a vector", 18);
3329 XSETCDR (tail
, read0 (readcharfun
));
3331 val
= read0 (readcharfun
);
3332 read1 (readcharfun
, &ch
, 0);
3336 if (doc_reference
== 1)
3337 return make_number (0);
3338 if (doc_reference
== 2)
3340 /* Get a doc string from the file we are loading.
3341 If it's in saved_doc_string, get it from there.
3343 Here, we don't know if the string is a
3344 bytecode string or a doc string. As a
3345 bytecode string must be unibyte, we always
3346 return a unibyte string. If it is actually a
3347 doc string, caller must make it
3350 int pos
= XINT (XCDR (val
));
3351 /* Position is negative for user variables. */
3352 if (pos
< 0) pos
= -pos
;
3353 if (pos
>= saved_doc_string_position
3354 && pos
< (saved_doc_string_position
3355 + saved_doc_string_length
))
3357 int start
= pos
- saved_doc_string_position
;
3360 /* Process quoting with ^A,
3361 and find the end of the string,
3362 which is marked with ^_ (037). */
3363 for (from
= start
, to
= start
;
3364 saved_doc_string
[from
] != 037;)
3366 int c
= saved_doc_string
[from
++];
3369 c
= saved_doc_string
[from
++];
3371 saved_doc_string
[to
++] = c
;
3373 saved_doc_string
[to
++] = 0;
3375 saved_doc_string
[to
++] = 037;
3378 saved_doc_string
[to
++] = c
;
3381 return make_unibyte_string (saved_doc_string
+ start
,
3384 /* Look in prev_saved_doc_string the same way. */
3385 else if (pos
>= prev_saved_doc_string_position
3386 && pos
< (prev_saved_doc_string_position
3387 + prev_saved_doc_string_length
))
3389 int start
= pos
- prev_saved_doc_string_position
;
3392 /* Process quoting with ^A,
3393 and find the end of the string,
3394 which is marked with ^_ (037). */
3395 for (from
= start
, to
= start
;
3396 prev_saved_doc_string
[from
] != 037;)
3398 int c
= prev_saved_doc_string
[from
++];
3401 c
= prev_saved_doc_string
[from
++];
3403 prev_saved_doc_string
[to
++] = c
;
3405 prev_saved_doc_string
[to
++] = 0;
3407 prev_saved_doc_string
[to
++] = 037;
3410 prev_saved_doc_string
[to
++] = c
;
3413 return make_unibyte_string (prev_saved_doc_string
3418 return get_doc_string (val
, 1, 0);
3423 invalid_syntax (". in wrong context", 18);
3425 invalid_syntax ("] in a list", 11);
3427 tem
= (read_pure
&& flag
<= 0
3428 ? pure_cons (elt
, Qnil
)
3429 : Fcons (elt
, Qnil
));
3431 XSETCDR (tail
, tem
);
3436 defunflag
= EQ (elt
, Qdefun
);
3437 else if (defunflag
> 0)
3442 Lisp_Object initial_obarray
;
3444 /* oblookup stores the bucket number here, for the sake of Funintern. */
3446 int oblookup_last_bucket_number
;
3448 static int hash_string (const char *ptr
, int len
);
3450 /* Get an error if OBARRAY is not an obarray.
3451 If it is one, return it. */
3454 check_obarray (Lisp_Object obarray
)
3456 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3458 /* If Vobarray is now invalid, force it to be valid. */
3459 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3460 wrong_type_argument (Qvectorp
, obarray
);
3465 /* Intern the C string STR: return a symbol with that name,
3466 interned in the current obarray. */
3469 intern (const char *str
)
3472 int len
= strlen (str
);
3473 Lisp_Object obarray
;
3476 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3477 obarray
= check_obarray (obarray
);
3478 tem
= oblookup (obarray
, str
, len
, len
);
3481 return Fintern (make_string (str
, len
), obarray
);
3485 intern_c_string (const char *str
)
3488 int len
= strlen (str
);
3489 Lisp_Object obarray
;
3492 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3493 obarray
= check_obarray (obarray
);
3494 tem
= oblookup (obarray
, str
, len
, len
);
3498 if (NILP (Vpurify_flag
))
3499 /* Creating a non-pure string from a string literal not
3500 implemented yet. We could just use make_string here and live
3501 with the extra copy. */
3504 return Fintern (make_pure_c_string (str
), obarray
);
3507 /* Create an uninterned symbol with name STR. */
3510 make_symbol (const char *str
)
3512 int len
= strlen (str
);
3514 return Fmake_symbol (!NILP (Vpurify_flag
)
3515 ? make_pure_string (str
, len
, len
, 0)
3516 : make_string (str
, len
));
3519 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3520 doc
: /* Return the canonical symbol whose name is STRING.
3521 If there is none, one is created by this function and returned.
3522 A second optional argument specifies the obarray to use;
3523 it defaults to the value of `obarray'. */)
3524 (Lisp_Object string
, Lisp_Object obarray
)
3526 register Lisp_Object tem
, sym
, *ptr
;
3528 if (NILP (obarray
)) obarray
= Vobarray
;
3529 obarray
= check_obarray (obarray
);
3531 CHECK_STRING (string
);
3533 tem
= oblookup (obarray
, SSDATA (string
),
3536 if (!INTEGERP (tem
))
3539 if (!NILP (Vpurify_flag
))
3540 string
= Fpurecopy (string
);
3541 sym
= Fmake_symbol (string
);
3543 if (EQ (obarray
, initial_obarray
))
3544 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3546 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3548 if ((SREF (string
, 0) == ':')
3549 && EQ (obarray
, initial_obarray
))
3551 XSYMBOL (sym
)->constant
= 1;
3552 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3553 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3556 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3558 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3560 XSYMBOL (sym
)->next
= 0;
3565 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3566 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3567 NAME may be a string or a symbol. If it is a symbol, that exact
3568 symbol is searched for.
3569 A second optional argument specifies the obarray to use;
3570 it defaults to the value of `obarray'. */)
3571 (Lisp_Object name
, Lisp_Object obarray
)
3573 register Lisp_Object tem
, string
;
3575 if (NILP (obarray
)) obarray
= Vobarray
;
3576 obarray
= check_obarray (obarray
);
3578 if (!SYMBOLP (name
))
3580 CHECK_STRING (name
);
3584 string
= SYMBOL_NAME (name
);
3586 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3587 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3593 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3594 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3595 The value is t if a symbol was found and deleted, nil otherwise.
3596 NAME may be a string or a symbol. If it is a symbol, that symbol
3597 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3598 OBARRAY defaults to the value of the variable `obarray'. */)
3599 (Lisp_Object name
, Lisp_Object obarray
)
3601 register Lisp_Object string
, tem
;
3604 if (NILP (obarray
)) obarray
= Vobarray
;
3605 obarray
= check_obarray (obarray
);
3608 string
= SYMBOL_NAME (name
);
3611 CHECK_STRING (name
);
3615 tem
= oblookup (obarray
, SSDATA (string
),
3620 /* If arg was a symbol, don't delete anything but that symbol itself. */
3621 if (SYMBOLP (name
) && !EQ (name
, tem
))
3624 /* There are plenty of other symbols which will screw up the Emacs
3625 session if we unintern them, as well as even more ways to use
3626 `setq' or `fset' or whatnot to make the Emacs session
3627 unusable. Let's not go down this silly road. --Stef */
3628 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3629 error ("Attempt to unintern t or nil"); */
3631 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3633 hash
= oblookup_last_bucket_number
;
3635 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3637 if (XSYMBOL (tem
)->next
)
3638 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3640 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3644 Lisp_Object tail
, following
;
3646 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3647 XSYMBOL (tail
)->next
;
3650 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3651 if (EQ (following
, tem
))
3653 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3662 /* Return the symbol in OBARRAY whose names matches the string
3663 of SIZE characters (SIZE_BYTE bytes) at PTR.
3664 If there is no such symbol in OBARRAY, return nil.
3666 Also store the bucket number in oblookup_last_bucket_number. */
3669 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3673 register Lisp_Object tail
;
3674 Lisp_Object bucket
, tem
;
3676 if (!VECTORP (obarray
)
3677 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3679 obarray
= check_obarray (obarray
);
3680 obsize
= XVECTOR (obarray
)->size
;
3682 /* This is sometimes needed in the middle of GC. */
3683 obsize
&= ~ARRAY_MARK_FLAG
;
3684 hash
= hash_string (ptr
, size_byte
) % obsize
;
3685 bucket
= XVECTOR (obarray
)->contents
[hash
];
3686 oblookup_last_bucket_number
= hash
;
3687 if (EQ (bucket
, make_number (0)))
3689 else if (!SYMBOLP (bucket
))
3690 error ("Bad data in guts of obarray"); /* Like CADR error message */
3692 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3694 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3695 && SCHARS (SYMBOL_NAME (tail
)) == size
3696 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3698 else if (XSYMBOL (tail
)->next
== 0)
3701 XSETINT (tem
, hash
);
3706 hash_string (const char *ptr
, int len
)
3708 register const char *p
= ptr
;
3709 register const char *end
= p
+ len
;
3710 register unsigned char c
;
3711 register int hash
= 0;
3716 if (c
>= 0140) c
-= 40;
3717 hash
= ((hash
<<3) + (hash
>>28) + c
);
3719 return hash
& 07777777777;
3723 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3726 register Lisp_Object tail
;
3727 CHECK_VECTOR (obarray
);
3728 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3730 tail
= XVECTOR (obarray
)->contents
[i
];
3735 if (XSYMBOL (tail
)->next
== 0)
3737 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3743 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3745 call1 (function
, sym
);
3748 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3749 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3750 OBARRAY defaults to the value of `obarray'. */)
3751 (Lisp_Object function
, Lisp_Object obarray
)
3753 if (NILP (obarray
)) obarray
= Vobarray
;
3754 obarray
= check_obarray (obarray
);
3756 map_obarray (obarray
, mapatoms_1
, function
);
3760 #define OBARRAY_SIZE 1511
3765 Lisp_Object oblength
;
3767 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3769 Vobarray
= Fmake_vector (oblength
, make_number (0));
3770 initial_obarray
= Vobarray
;
3771 staticpro (&initial_obarray
);
3773 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3774 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3775 NILP (Vpurify_flag) check in intern_c_string. */
3776 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3777 Qnil
= intern_c_string ("nil");
3779 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3780 so those two need to be fixed manally. */
3781 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3782 XSYMBOL (Qunbound
)->function
= Qunbound
;
3783 XSYMBOL (Qunbound
)->plist
= Qnil
;
3784 /* XSYMBOL (Qnil)->function = Qunbound; */
3785 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3786 XSYMBOL (Qnil
)->constant
= 1;
3787 XSYMBOL (Qnil
)->plist
= Qnil
;
3789 Qt
= intern_c_string ("t");
3790 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3791 XSYMBOL (Qt
)->constant
= 1;
3793 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3796 Qvariable_documentation
= intern_c_string ("variable-documentation");
3797 staticpro (&Qvariable_documentation
);
3799 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3800 read_buffer
= (char *) xmalloc (read_buffer_size
);
3804 defsubr (struct Lisp_Subr
*sname
)
3807 sym
= intern_c_string (sname
->symbol_name
);
3808 XSETPVECTYPE (sname
, PVEC_SUBR
);
3809 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3812 #ifdef NOTDEF /* use fset in subr.el now */
3814 defalias (sname
, string
)
3815 struct Lisp_Subr
*sname
;
3819 sym
= intern (string
);
3820 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3824 /* Define an "integer variable"; a symbol whose value is forwarded to a
3825 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3826 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3828 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3829 const char *namestring
, EMACS_INT
*address
)
3832 sym
= intern_c_string (namestring
);
3833 i_fwd
->type
= Lisp_Fwd_Int
;
3834 i_fwd
->intvar
= address
;
3835 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3836 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3839 /* Similar but define a variable whose value is t if address contains 1,
3840 nil if address contains 0. */
3842 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3843 const char *namestring
, int *address
)
3846 sym
= intern_c_string (namestring
);
3847 b_fwd
->type
= Lisp_Fwd_Bool
;
3848 b_fwd
->boolvar
= address
;
3849 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3850 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3851 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3854 /* Similar but define a variable whose value is the Lisp Object stored
3855 at address. Two versions: with and without gc-marking of the C
3856 variable. The nopro version is used when that variable will be
3857 gc-marked for some other reason, since marking the same slot twice
3858 can cause trouble with strings. */
3860 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
3861 const char *namestring
, Lisp_Object
*address
)
3864 sym
= intern_c_string (namestring
);
3865 o_fwd
->type
= Lisp_Fwd_Obj
;
3866 o_fwd
->objvar
= address
;
3867 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3868 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
3872 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
3873 const char *namestring
, Lisp_Object
*address
)
3875 defvar_lisp_nopro (o_fwd
, namestring
, address
);
3876 staticpro (address
);
3879 /* Similar but define a variable whose value is the Lisp Object stored
3880 at a particular offset in the current kboard object. */
3883 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
3884 const char *namestring
, int offset
)
3887 sym
= intern_c_string (namestring
);
3888 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
3889 ko_fwd
->offset
= offset
;
3890 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3891 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
3894 /* Record the value of load-path used at the start of dumping
3895 so we can see if the site changed it later during dumping. */
3896 static Lisp_Object dump_path
;
3902 int turn_off_warning
= 0;
3904 /* Compute the default load-path. */
3906 normal
= PATH_LOADSEARCH
;
3907 Vload_path
= decode_env_path (0, normal
);
3909 if (NILP (Vpurify_flag
))
3910 normal
= PATH_LOADSEARCH
;
3912 normal
= PATH_DUMPLOADSEARCH
;
3914 /* In a dumped Emacs, we normally have to reset the value of
3915 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3916 uses ../lisp, instead of the path of the installed elisp
3917 libraries. However, if it appears that Vload_path was changed
3918 from the default before dumping, don't override that value. */
3921 if (! NILP (Fequal (dump_path
, Vload_path
)))
3923 Vload_path
= decode_env_path (0, normal
);
3924 if (!NILP (Vinstallation_directory
))
3926 Lisp_Object tem
, tem1
, sitelisp
;
3928 /* Remove site-lisp dirs from path temporarily and store
3929 them in sitelisp, then conc them on at the end so
3930 they're always first in path. */
3934 tem
= Fcar (Vload_path
);
3935 tem1
= Fstring_match (build_string ("site-lisp"),
3939 Vload_path
= Fcdr (Vload_path
);
3940 sitelisp
= Fcons (tem
, sitelisp
);
3946 /* Add to the path the lisp subdir of the
3947 installation dir, if it exists. */
3948 tem
= Fexpand_file_name (build_string ("lisp"),
3949 Vinstallation_directory
);
3950 tem1
= Ffile_exists_p (tem
);
3953 if (NILP (Fmember (tem
, Vload_path
)))
3955 turn_off_warning
= 1;
3956 Vload_path
= Fcons (tem
, Vload_path
);
3960 /* That dir doesn't exist, so add the build-time
3961 Lisp dirs instead. */
3962 Vload_path
= nconc2 (Vload_path
, dump_path
);
3964 /* Add leim under the installation dir, if it exists. */
3965 tem
= Fexpand_file_name (build_string ("leim"),
3966 Vinstallation_directory
);
3967 tem1
= Ffile_exists_p (tem
);
3970 if (NILP (Fmember (tem
, Vload_path
)))
3971 Vload_path
= Fcons (tem
, Vload_path
);
3974 /* Add site-lisp under the installation dir, if it exists. */
3975 tem
= Fexpand_file_name (build_string ("site-lisp"),
3976 Vinstallation_directory
);
3977 tem1
= Ffile_exists_p (tem
);
3980 if (NILP (Fmember (tem
, Vload_path
)))
3981 Vload_path
= Fcons (tem
, Vload_path
);
3984 /* If Emacs was not built in the source directory,
3985 and it is run from where it was built, add to load-path
3986 the lisp, leim and site-lisp dirs under that directory. */
3988 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3992 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3993 Vinstallation_directory
);
3994 tem1
= Ffile_exists_p (tem
);
3996 /* Don't be fooled if they moved the entire source tree
3997 AFTER dumping Emacs. If the build directory is indeed
3998 different from the source dir, src/Makefile.in and
3999 src/Makefile will not be found together. */
4000 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4001 Vinstallation_directory
);
4002 tem2
= Ffile_exists_p (tem
);
4003 if (!NILP (tem1
) && NILP (tem2
))
4005 tem
= Fexpand_file_name (build_string ("lisp"),
4008 if (NILP (Fmember (tem
, Vload_path
)))
4009 Vload_path
= Fcons (tem
, Vload_path
);
4011 tem
= Fexpand_file_name (build_string ("leim"),
4014 if (NILP (Fmember (tem
, Vload_path
)))
4015 Vload_path
= Fcons (tem
, Vload_path
);
4017 tem
= Fexpand_file_name (build_string ("site-lisp"),
4020 if (NILP (Fmember (tem
, Vload_path
)))
4021 Vload_path
= Fcons (tem
, Vload_path
);
4024 if (!NILP (sitelisp
) && !no_site_lisp
)
4025 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4031 /* NORMAL refers to the lisp dir in the source directory. */
4032 /* We used to add ../lisp at the front here, but
4033 that caused trouble because it was copied from dump_path
4034 into Vload_path, above, when Vinstallation_directory was non-nil.
4035 It should be unnecessary. */
4036 Vload_path
= decode_env_path (0, normal
);
4037 dump_path
= Vload_path
;
4041 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4042 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4043 almost never correct, thereby causing a warning to be printed out that
4044 confuses users. Since PATH_LOADSEARCH is always overridden by the
4045 EMACSLOADPATH environment variable below, disable the warning on NT. */
4047 /* Warn if dirs in the *standard* path don't exist. */
4048 if (!turn_off_warning
)
4050 Lisp_Object path_tail
;
4052 for (path_tail
= Vload_path
;
4054 path_tail
= XCDR (path_tail
))
4056 Lisp_Object dirfile
;
4057 dirfile
= Fcar (path_tail
);
4058 if (STRINGP (dirfile
))
4060 dirfile
= Fdirectory_file_name (dirfile
);
4061 if (access (SSDATA (dirfile
), 0) < 0)
4062 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4067 #endif /* !(WINDOWSNT || HAVE_NS) */
4069 /* If the EMACSLOADPATH environment variable is set, use its value.
4070 This doesn't apply if we're dumping. */
4072 if (NILP (Vpurify_flag
)
4073 && egetenv ("EMACSLOADPATH"))
4075 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4079 load_in_progress
= 0;
4080 Vload_file_name
= Qnil
;
4082 load_descriptor_list
= Qnil
;
4084 Vstandard_input
= Qt
;
4085 Vloads_in_progress
= Qnil
;
4088 /* Print a warning, using format string FORMAT, that directory DIRNAME
4089 does not exist. Print it on stderr and put it in *Messages*. */
4092 dir_warning (const char *format
, Lisp_Object dirname
)
4095 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4097 fprintf (stderr
, format
, SDATA (dirname
));
4098 sprintf (buffer
, format
, SDATA (dirname
));
4099 /* Don't log the warning before we've initialized!! */
4101 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4105 syms_of_lread (void)
4108 defsubr (&Sread_from_string
);
4110 defsubr (&Sintern_soft
);
4111 defsubr (&Sunintern
);
4112 defsubr (&Sget_load_suffixes
);
4114 defsubr (&Seval_buffer
);
4115 defsubr (&Seval_region
);
4116 defsubr (&Sread_char
);
4117 defsubr (&Sread_char_exclusive
);
4118 defsubr (&Sread_event
);
4119 defsubr (&Sget_file_char
);
4120 defsubr (&Smapatoms
);
4121 defsubr (&Slocate_file_internal
);
4123 DEFVAR_LISP ("obarray", Vobarray
,
4124 doc
: /* Symbol table for use by `intern' and `read'.
4125 It is a vector whose length ought to be prime for best results.
4126 The vector's contents don't make sense if examined from Lisp programs;
4127 to find all the symbols in an obarray, use `mapatoms'. */);
4129 DEFVAR_LISP ("values", Vvalues
,
4130 doc
: /* List of values of all expressions which were read, evaluated and printed.
4131 Order is reverse chronological. */);
4133 DEFVAR_LISP ("standard-input", Vstandard_input
,
4134 doc
: /* Stream for read to get input from.
4135 See documentation of `read' for possible values. */);
4136 Vstandard_input
= Qt
;
4138 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4139 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4141 If this variable is a buffer, then only forms read from that buffer
4142 will be added to `read-symbol-positions-list'.
4143 If this variable is t, then all read forms will be added.
4144 The effect of all other values other than nil are not currently
4145 defined, although they may be in the future.
4147 The positions are relative to the last call to `read' or
4148 `read-from-string'. It is probably a bad idea to set this variable at
4149 the toplevel; bind it instead. */);
4150 Vread_with_symbol_positions
= Qnil
;
4152 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4153 doc
: /* A list mapping read symbols to their positions.
4154 This variable is modified during calls to `read' or
4155 `read-from-string', but only when `read-with-symbol-positions' is
4158 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4159 CHAR-POSITION is an integer giving the offset of that occurrence of the
4160 symbol from the position where `read' or `read-from-string' started.
4162 Note that a symbol will appear multiple times in this list, if it was
4163 read multiple times. The list is in the same order as the symbols
4165 Vread_symbol_positions_list
= Qnil
;
4167 DEFVAR_LISP ("read-circle", Vread_circle
,
4168 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4171 DEFVAR_LISP ("load-path", Vload_path
,
4172 doc
: /* *List of directories to search for files to load.
4173 Each element is a string (directory name) or nil (try default directory).
4174 Initialized based on EMACSLOADPATH environment variable, if any,
4175 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4177 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4178 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4179 This list should not include the empty string.
4180 `load' and related functions try to append these suffixes, in order,
4181 to the specified file name if a Lisp suffix is allowed or required. */);
4182 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4183 Fcons (make_pure_c_string (".el"), Qnil
));
4184 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4185 doc
: /* List of suffixes that indicate representations of \
4187 This list should normally start with the empty string.
4189 Enabling Auto Compression mode appends the suffixes in
4190 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4191 mode removes them again. `load' and related functions use this list to
4192 determine whether they should look for compressed versions of a file
4193 and, if so, which suffixes they should try to append to the file name
4194 in order to do so. However, if you want to customize which suffixes
4195 the loading functions recognize as compression suffixes, you should
4196 customize `jka-compr-load-suffixes' rather than the present variable. */);
4197 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4199 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4200 doc
: /* Non-nil if inside of `load'. */);
4201 Qload_in_progress
= intern_c_string ("load-in-progress");
4202 staticpro (&Qload_in_progress
);
4204 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4205 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4206 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4208 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4209 a symbol \(a feature name).
4211 When `load' is run and the file-name argument matches an element's
4212 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4213 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4215 An error in FORMS does not undo the load, but does prevent execution of
4216 the rest of the FORMS. */);
4217 Vafter_load_alist
= Qnil
;
4219 DEFVAR_LISP ("load-history", Vload_history
,
4220 doc
: /* Alist mapping loaded file names to symbols and features.
4221 Each alist element should be a list (FILE-NAME ENTRIES...), where
4222 FILE-NAME is the name of a file that has been loaded into Emacs.
4223 The file name is absolute and true (i.e. it doesn't contain symlinks).
4224 As an exception, one of the alist elements may have FILE-NAME nil,
4225 for symbols and features not associated with any file.
4227 The remaining ENTRIES in the alist element describe the functions and
4228 variables defined in that file, the features provided, and the
4229 features required. Each entry has the form `(provide . FEATURE)',
4230 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4231 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4232 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4233 SYMBOL was an autoload before this file redefined it as a function.
4235 During preloading, the file name recorded is relative to the main Lisp
4236 directory. These file names are converted to absolute at startup. */);
4237 Vload_history
= Qnil
;
4239 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4240 doc
: /* Full name of file being loaded by `load'. */);
4241 Vload_file_name
= Qnil
;
4243 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4244 doc
: /* File name, including directory, of user's initialization file.
4245 If the file loaded had extension `.elc', and the corresponding source file
4246 exists, this variable contains the name of source file, suitable for use
4247 by functions like `custom-save-all' which edit the init file.
4248 While Emacs loads and evaluates the init file, value is the real name
4249 of the file, regardless of whether or not it has the `.elc' extension. */);
4250 Vuser_init_file
= Qnil
;
4252 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4253 doc
: /* Used for internal purposes by `load'. */);
4254 Vcurrent_load_list
= Qnil
;
4256 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4257 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4258 The default is nil, which means use the function `read'. */);
4259 Vload_read_function
= Qnil
;
4261 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4262 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4263 This function is for doing code conversion before reading the source file.
4264 If nil, loading is done without any code conversion.
4265 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4266 FULLNAME is the full name of FILE.
4267 See `load' for the meaning of the remaining arguments. */);
4268 Vload_source_file_function
= Qnil
;
4270 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4271 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4272 This is useful when the file being loaded is a temporary copy. */);
4273 load_force_doc_strings
= 0;
4275 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4276 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4277 This is normally bound by `load' and `eval-buffer' to control `read',
4278 and is not meant for users to change. */);
4279 load_convert_to_unibyte
= 0;
4281 DEFVAR_LISP ("source-directory", Vsource_directory
,
4282 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4283 You cannot count on them to still be there! */);
4285 = Fexpand_file_name (build_string ("../"),
4286 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4288 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4289 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4290 Vpreloaded_file_list
= Qnil
;
4292 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4293 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4294 Vbyte_boolean_vars
= Qnil
;
4296 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4297 doc
: /* Non-nil means load dangerous compiled Lisp files.
4298 Some versions of XEmacs use different byte codes than Emacs. These
4299 incompatible byte codes can make Emacs crash when it tries to execute
4301 load_dangerous_libraries
= 0;
4303 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4304 doc
: /* Non-nil means force printing messages when loading Lisp files.
4305 This overrides the value of the NOMESSAGE argument to `load'. */);
4306 force_load_messages
= 0;
4308 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4309 doc
: /* Regular expression matching safe to load compiled Lisp files.
4310 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4311 from the file, and matches them against this regular expression.
4312 When the regular expression matches, the file is considered to be safe
4313 to load. See also `load-dangerous-libraries'. */);
4314 Vbytecomp_version_regexp
4315 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4317 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4318 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4319 Veval_buffer_list
= Qnil
;
4321 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4322 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4323 Vold_style_backquotes
= Qnil
;
4324 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4325 staticpro (&Qold_style_backquotes
);
4327 /* Vsource_directory was initialized in init_lread. */
4329 load_descriptor_list
= Qnil
;
4330 staticpro (&load_descriptor_list
);
4332 Qcurrent_load_list
= intern_c_string ("current-load-list");
4333 staticpro (&Qcurrent_load_list
);
4335 Qstandard_input
= intern_c_string ("standard-input");
4336 staticpro (&Qstandard_input
);
4338 Qread_char
= intern_c_string ("read-char");
4339 staticpro (&Qread_char
);
4341 Qget_file_char
= intern_c_string ("get-file-char");
4342 staticpro (&Qget_file_char
);
4344 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4345 staticpro (&Qget_emacs_mule_file_char
);
4347 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4348 staticpro (&Qload_force_doc_strings
);
4350 Qbackquote
= intern_c_string ("`");
4351 staticpro (&Qbackquote
);
4352 Qcomma
= intern_c_string (",");
4353 staticpro (&Qcomma
);
4354 Qcomma_at
= intern_c_string (",@");
4355 staticpro (&Qcomma_at
);
4356 Qcomma_dot
= intern_c_string (",.");
4357 staticpro (&Qcomma_dot
);
4359 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4360 staticpro (&Qinhibit_file_name_operation
);
4362 Qascii_character
= intern_c_string ("ascii-character");
4363 staticpro (&Qascii_character
);
4365 Qfunction
= intern_c_string ("function");
4366 staticpro (&Qfunction
);
4368 Qload
= intern_c_string ("load");
4371 Qload_file_name
= intern_c_string ("load-file-name");
4372 staticpro (&Qload_file_name
);
4374 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4375 staticpro (&Qeval_buffer_list
);
4377 Qfile_truename
= intern_c_string ("file-truename");
4378 staticpro (&Qfile_truename
) ;
4380 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4381 staticpro (&Qdo_after_load_evaluation
) ;
4383 staticpro (&dump_path
);
4385 staticpro (&read_objects
);
4386 read_objects
= Qnil
;
4387 staticpro (&seen_list
);
4390 Vloads_in_progress
= Qnil
;
4391 staticpro (&Vloads_in_progress
);
4393 Qhash_table
= intern_c_string ("hash-table");
4394 staticpro (&Qhash_table
);
4395 Qdata
= intern_c_string ("data");
4397 Qtest
= intern_c_string ("test");
4399 Qsize
= intern_c_string ("size");
4401 Qweakness
= intern_c_string ("weakness");
4402 staticpro (&Qweakness
);
4403 Qrehash_size
= intern_c_string ("rehash-size");
4404 staticpro (&Qrehash_size
);
4405 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4406 staticpro (&Qrehash_threshold
);