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 (BVAR (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 (BVAR (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 (BVAR (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 (BVAR (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 This function will normally skip directories, so if you want it to find
1255 directories, make sure the PREDICATE function returns `dir-ok' for them. */)
1256 (Lisp_Object filename
, Lisp_Object path
, Lisp_Object suffixes
, Lisp_Object predicate
)
1259 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1260 if (NILP (predicate
) && fd
> 0)
1265 static Lisp_Object Qdir_ok
;
1267 /* Search for a file whose name is STR, looking in directories
1268 in the Lisp list PATH, and trying suffixes from SUFFIX.
1269 On success, returns a file descriptor. On failure, returns -1.
1271 SUFFIXES is a list of strings containing possible suffixes.
1272 The empty suffix is automatically added if the list is empty.
1274 PREDICATE non-nil means don't open the files,
1275 just look for one that satisfies the predicate. In this case,
1276 returns 1 on success. The predicate can be a lisp function or
1277 an integer to pass to `access' (in which case file-name-handlers
1280 If STOREPTR is nonzero, it points to a slot where the name of
1281 the file actually found should be stored as a Lisp string.
1282 nil is stored there on failure.
1284 If the file we find is remote, return -2
1285 but store the found remote file name in *STOREPTR. */
1288 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1293 register char *fn
= buf
;
1296 Lisp_Object filename
;
1298 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1299 Lisp_Object string
, tail
, encoded_fn
;
1300 int max_suffix_len
= 0;
1304 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1306 CHECK_STRING_CAR (tail
);
1307 max_suffix_len
= max (max_suffix_len
,
1308 SBYTES (XCAR (tail
)));
1311 string
= filename
= encoded_fn
= Qnil
;
1312 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1317 if (complete_filename_p (str
))
1320 for (; CONSP (path
); path
= XCDR (path
))
1322 filename
= Fexpand_file_name (str
, XCAR (path
));
1323 if (!complete_filename_p (filename
))
1324 /* If there are non-absolute elts in PATH (eg ".") */
1325 /* Of course, this could conceivably lose if luser sets
1326 default-directory to be something non-absolute... */
1328 filename
= Fexpand_file_name (filename
, BVAR (current_buffer
, directory
));
1329 if (!complete_filename_p (filename
))
1330 /* Give up on this path element! */
1334 /* Calculate maximum size of any filename made from
1335 this path element/specified file name and any possible suffix. */
1336 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1337 if (fn_size
< want_size
)
1338 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1340 /* Loop over suffixes. */
1341 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1342 CONSP (tail
); tail
= XCDR (tail
))
1344 int lsuffix
= SBYTES (XCAR (tail
));
1345 Lisp_Object handler
;
1348 /* Concatenate path element/specified name with the suffix.
1349 If the directory starts with /:, remove that. */
1350 if (SCHARS (filename
) > 2
1351 && SREF (filename
, 0) == '/'
1352 && SREF (filename
, 1) == ':')
1354 strncpy (fn
, SSDATA (filename
) + 2,
1355 SBYTES (filename
) - 2);
1356 fn
[SBYTES (filename
) - 2] = 0;
1360 strncpy (fn
, SSDATA (filename
),
1362 fn
[SBYTES (filename
)] = 0;
1365 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1366 strncat (fn
, SSDATA (XCAR (tail
)), lsuffix
);
1368 /* Check that the file exists and is not a directory. */
1369 /* We used to only check for handlers on non-absolute file names:
1373 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1374 It's not clear why that was the case and it breaks things like
1375 (load "/bar.el") where the file is actually "/bar.el.gz". */
1376 string
= build_string (fn
);
1377 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1378 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1380 if (NILP (predicate
))
1381 exists
= !NILP (Ffile_readable_p (string
));
1384 Lisp_Object tmp
= call1 (predicate
, string
);
1385 exists
= !NILP (tmp
)
1386 && (EQ (tmp
, Qdir_ok
)
1387 || NILP (Ffile_directory_p (string
)));
1392 /* We succeeded; return this descriptor and filename. */
1403 encoded_fn
= ENCODE_FILE (string
);
1404 pfn
= SSDATA (encoded_fn
);
1405 exists
= (stat (pfn
, &st
) == 0 && ! S_ISDIR (st
.st_mode
));
1408 /* Check that we can access or open it. */
1409 if (NATNUMP (predicate
))
1410 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1412 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1416 /* We succeeded; return this descriptor and filename. */
1434 /* Merge the list we've accumulated of globals from the current input source
1435 into the load_history variable. The details depend on whether
1436 the source has an associated file name or not.
1438 FILENAME is the file name that we are loading from.
1439 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1442 build_load_history (Lisp_Object filename
, int entire
)
1444 register Lisp_Object tail
, prev
, newelt
;
1445 register Lisp_Object tem
, tem2
;
1446 register int foundit
= 0;
1448 tail
= Vload_history
;
1451 while (CONSP (tail
))
1455 /* Find the feature's previous assoc list... */
1456 if (!NILP (Fequal (filename
, Fcar (tem
))))
1460 /* If we're loading the entire file, remove old data. */
1464 Vload_history
= XCDR (tail
);
1466 Fsetcdr (prev
, XCDR (tail
));
1469 /* Otherwise, cons on new symbols that are not already members. */
1472 tem2
= Vcurrent_load_list
;
1474 while (CONSP (tem2
))
1476 newelt
= XCAR (tem2
);
1478 if (NILP (Fmember (newelt
, tem
)))
1479 Fsetcar (tail
, Fcons (XCAR (tem
),
1480 Fcons (newelt
, XCDR (tem
))));
1493 /* If we're loading an entire file, cons the new assoc onto the
1494 front of load-history, the most-recently-loaded position. Also
1495 do this if we didn't find an existing member for the file. */
1496 if (entire
|| !foundit
)
1497 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1502 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1509 readevalloop_1 (Lisp_Object old
)
1511 load_convert_to_unibyte
= ! NILP (old
);
1515 /* Signal an `end-of-file' error, if possible with file name
1519 end_of_file_error (void)
1521 if (STRINGP (Vload_file_name
))
1522 xsignal1 (Qend_of_file
, Vload_file_name
);
1524 xsignal0 (Qend_of_file
);
1527 /* UNIBYTE specifies how to set load_convert_to_unibyte
1528 for this invocation.
1529 READFUN, if non-nil, is used instead of `read'.
1531 START, END specify region to read in current buffer (from eval-region).
1532 If the input is not from a buffer, they must be nil. */
1535 readevalloop (Lisp_Object readcharfun
,
1537 Lisp_Object sourcename
,
1538 Lisp_Object (*evalfun
) (Lisp_Object
),
1540 Lisp_Object unibyte
, Lisp_Object readfun
,
1541 Lisp_Object start
, Lisp_Object end
)
1544 register Lisp_Object val
;
1545 int count
= SPECPDL_INDEX ();
1546 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1547 struct buffer
*b
= 0;
1548 int continue_reading_p
;
1549 /* Nonzero if reading an entire buffer. */
1550 int whole_buffer
= 0;
1551 /* 1 on the first time around. */
1554 if (MARKERP (readcharfun
))
1557 start
= readcharfun
;
1560 if (BUFFERP (readcharfun
))
1561 b
= XBUFFER (readcharfun
);
1562 else if (MARKERP (readcharfun
))
1563 b
= XMARKER (readcharfun
)->buffer
;
1565 /* We assume START is nil when input is not from a buffer. */
1566 if (! NILP (start
) && !b
)
1569 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1570 specbind (Qcurrent_load_list
, Qnil
);
1571 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1572 load_convert_to_unibyte
= !NILP (unibyte
);
1574 GCPRO4 (sourcename
, readfun
, start
, end
);
1576 /* Try to ensure sourcename is a truename, except whilst preloading. */
1577 if (NILP (Vpurify_flag
)
1578 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1579 && !NILP (Ffboundp (Qfile_truename
)))
1580 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1582 LOADHIST_ATTACH (sourcename
);
1584 continue_reading_p
= 1;
1585 while (continue_reading_p
)
1587 int count1
= SPECPDL_INDEX ();
1589 if (b
!= 0 && NILP (BVAR (b
, name
)))
1590 error ("Reading from killed buffer");
1594 /* Switch to the buffer we are reading from. */
1595 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1596 set_buffer_internal (b
);
1598 /* Save point in it. */
1599 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1600 /* Save ZV in it. */
1601 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1602 /* Those get unbound after we read one expression. */
1604 /* Set point and ZV around stuff to be read. */
1607 Fnarrow_to_region (make_number (BEGV
), end
);
1609 /* Just for cleanliness, convert END to a marker
1610 if it is an integer. */
1612 end
= Fpoint_max_marker ();
1615 /* On the first cycle, we can easily test here
1616 whether we are reading the whole buffer. */
1617 if (b
&& first_sexp
)
1618 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1625 while ((c
= READCHAR
) != '\n' && c
!= -1);
1630 unbind_to (count1
, Qnil
);
1634 /* Ignore whitespace here, so we can detect eof. */
1635 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1636 || c
== 0x8a0) /* NBSP */
1639 if (!NILP (Vpurify_flag
) && c
== '(')
1641 record_unwind_protect (unreadpure
, Qnil
);
1642 val
= read_list (-1, readcharfun
);
1647 read_objects
= Qnil
;
1648 if (!NILP (readfun
))
1650 val
= call1 (readfun
, readcharfun
);
1652 /* If READCHARFUN has set point to ZV, we should
1653 stop reading, even if the form read sets point
1654 to a different value when evaluated. */
1655 if (BUFFERP (readcharfun
))
1657 struct buffer
*b
= XBUFFER (readcharfun
);
1658 if (BUF_PT (b
) == BUF_ZV (b
))
1659 continue_reading_p
= 0;
1662 else if (! NILP (Vload_read_function
))
1663 val
= call1 (Vload_read_function
, readcharfun
);
1665 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1668 if (!NILP (start
) && continue_reading_p
)
1669 start
= Fpoint_marker ();
1671 /* Restore saved point and BEGV. */
1672 unbind_to (count1
, Qnil
);
1674 /* Now eval what we just read. */
1675 val
= (*evalfun
) (val
);
1679 Vvalues
= Fcons (val
, Vvalues
);
1680 if (EQ (Vstandard_output
, Qt
))
1689 build_load_history (sourcename
,
1690 stream
|| whole_buffer
);
1694 unbind_to (count
, Qnil
);
1697 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1698 doc
: /* Execute the current buffer as Lisp code.
1699 When called from a Lisp program (i.e., not interactively), this
1700 function accepts up to five optional arguments:
1701 BUFFER is the buffer to evaluate (nil means use current buffer).
1702 PRINTFLAG controls printing of output:
1703 A value of nil means discard it; anything else is stream for print.
1704 FILENAME specifies the file name to use for `load-history'.
1705 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1707 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1708 functions should work normally even if PRINTFLAG is nil.
1710 This function preserves the position of point. */)
1711 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1713 int count
= SPECPDL_INDEX ();
1714 Lisp_Object tem
, buf
;
1717 buf
= Fcurrent_buffer ();
1719 buf
= Fget_buffer (buffer
);
1721 error ("No such buffer");
1723 if (NILP (printflag
) && NILP (do_allow_print
))
1728 if (NILP (filename
))
1729 filename
= BVAR (XBUFFER (buf
), filename
);
1731 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1732 specbind (Qstandard_output
, tem
);
1733 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1734 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1735 readevalloop (buf
, 0, filename
, Feval
,
1736 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1737 unbind_to (count
, Qnil
);
1742 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1743 doc
: /* Execute the region as Lisp code.
1744 When called from programs, expects two arguments,
1745 giving starting and ending indices in the current buffer
1746 of the text to be executed.
1747 Programs can pass third argument PRINTFLAG which controls output:
1748 A value of nil means discard it; anything else is stream for printing it.
1749 Also the fourth argument READ-FUNCTION, if non-nil, is used
1750 instead of `read' to read each expression. It gets one argument
1751 which is the input stream for reading characters.
1753 This function does not move point. */)
1754 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1756 int count
= SPECPDL_INDEX ();
1757 Lisp_Object tem
, cbuf
;
1759 cbuf
= Fcurrent_buffer ();
1761 if (NILP (printflag
))
1765 specbind (Qstandard_output
, tem
);
1766 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1768 /* readevalloop calls functions which check the type of start and end. */
1769 readevalloop (cbuf
, 0, BVAR (XBUFFER (cbuf
), filename
), Feval
,
1770 !NILP (printflag
), Qnil
, read_function
,
1773 return unbind_to (count
, Qnil
);
1777 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1778 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1779 If STREAM is nil, use the value of `standard-input' (which see).
1780 STREAM or the value of `standard-input' may be:
1781 a buffer (read from point and advance it)
1782 a marker (read from where it points and advance it)
1783 a function (call it with no arguments for each character,
1784 call it with a char as argument to push a char back)
1785 a string (takes text from string, starting at the beginning)
1786 t (read text line using minibuffer and use it, or read from
1787 standard input in batch mode). */)
1788 (Lisp_Object stream
)
1791 stream
= Vstandard_input
;
1792 if (EQ (stream
, Qt
))
1793 stream
= Qread_char
;
1794 if (EQ (stream
, Qread_char
))
1795 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1797 return read_internal_start (stream
, Qnil
, Qnil
);
1800 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1801 doc
: /* Read one Lisp expression which is represented as text by STRING.
1802 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1803 START and END optionally delimit a substring of STRING from which to read;
1804 they default to 0 and (length STRING) respectively. */)
1805 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1808 CHECK_STRING (string
);
1809 /* read_internal_start sets read_from_string_index. */
1810 ret
= read_internal_start (string
, start
, end
);
1811 return Fcons (ret
, make_number (read_from_string_index
));
1814 /* Function to set up the global context we need in toplevel read
1817 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1818 /* start, end only used when stream is a string. */
1823 new_backquote_flag
= 0;
1824 read_objects
= Qnil
;
1825 if (EQ (Vread_with_symbol_positions
, Qt
)
1826 || EQ (Vread_with_symbol_positions
, stream
))
1827 Vread_symbol_positions_list
= Qnil
;
1829 if (STRINGP (stream
)
1830 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1832 EMACS_INT startval
, endval
;
1835 if (STRINGP (stream
))
1838 string
= XCAR (stream
);
1841 endval
= SCHARS (string
);
1845 endval
= XINT (end
);
1846 if (endval
< 0 || endval
> SCHARS (string
))
1847 args_out_of_range (string
, end
);
1854 CHECK_NUMBER (start
);
1855 startval
= XINT (start
);
1856 if (startval
< 0 || startval
> endval
)
1857 args_out_of_range (string
, start
);
1859 read_from_string_index
= startval
;
1860 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1861 read_from_string_limit
= endval
;
1864 retval
= read0 (stream
);
1865 if (EQ (Vread_with_symbol_positions
, Qt
)
1866 || EQ (Vread_with_symbol_positions
, stream
))
1867 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1872 /* Signal Qinvalid_read_syntax error.
1873 S is error string of length N (if > 0) */
1876 invalid_syntax (const char *s
, int n
)
1880 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1884 /* Use this for recursive reads, in contexts where internal tokens
1888 read0 (Lisp_Object readcharfun
)
1890 register Lisp_Object val
;
1893 val
= read1 (readcharfun
, &c
, 0);
1897 xsignal1 (Qinvalid_read_syntax
,
1898 Fmake_string (make_number (1), make_number (c
)));
1901 static int read_buffer_size
;
1902 static char *read_buffer
;
1904 /* Read a \-escape sequence, assuming we already read the `\'.
1905 If the escape sequence forces unibyte, return eight-bit char. */
1908 read_escape (Lisp_Object readcharfun
, int stringp
)
1910 register int c
= READCHAR
;
1911 /* \u allows up to four hex digits, \U up to eight. Default to the
1912 behavior for \u, and change this value in the case that \U is seen. */
1913 int unicode_hex_count
= 4;
1918 end_of_file_error ();
1948 error ("Invalid escape character syntax");
1951 c
= read_escape (readcharfun
, 0);
1952 return c
| meta_modifier
;
1957 error ("Invalid escape character syntax");
1960 c
= read_escape (readcharfun
, 0);
1961 return c
| shift_modifier
;
1966 error ("Invalid escape character syntax");
1969 c
= read_escape (readcharfun
, 0);
1970 return c
| hyper_modifier
;
1975 error ("Invalid escape character syntax");
1978 c
= read_escape (readcharfun
, 0);
1979 return c
| alt_modifier
;
1983 if (stringp
|| c
!= '-')
1990 c
= read_escape (readcharfun
, 0);
1991 return c
| super_modifier
;
1996 error ("Invalid escape character syntax");
2000 c
= read_escape (readcharfun
, 0);
2001 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2002 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2003 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2004 return c
| ctrl_modifier
;
2005 /* ASCII control chars are made from letters (both cases),
2006 as well as the non-letters within 0100...0137. */
2007 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2008 return (c
& (037 | ~0177));
2009 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2010 return (c
& (037 | ~0177));
2012 return c
| ctrl_modifier
;
2022 /* An octal escape, as in ANSI C. */
2024 register int i
= c
- '0';
2025 register int count
= 0;
2028 if ((c
= READCHAR
) >= '0' && c
<= '7')
2040 if (i
>= 0x80 && i
< 0x100)
2041 i
= BYTE8_TO_CHAR (i
);
2046 /* A hex escape, as in ANSI C. */
2053 if (c
>= '0' && c
<= '9')
2058 else if ((c
>= 'a' && c
<= 'f')
2059 || (c
>= 'A' && c
<= 'F'))
2062 if (c
>= 'a' && c
<= 'f')
2075 if (count
< 3 && i
>= 0x80)
2076 return BYTE8_TO_CHAR (i
);
2081 /* Post-Unicode-2.0: Up to eight hex chars. */
2082 unicode_hex_count
= 8;
2085 /* A Unicode escape. We only permit them in strings and characters,
2086 not arbitrarily in the source code, as in some other languages. */
2091 while (++count
<= unicode_hex_count
)
2094 /* isdigit and isalpha may be locale-specific, which we don't
2096 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2097 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2098 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2101 error ("Non-hex digit used for Unicode escape");
2106 error ("Non-Unicode character: 0x%x", i
);
2115 /* Read an integer in radix RADIX using READCHARFUN to read
2116 characters. RADIX must be in the interval [2..36]; if it isn't, a
2117 read error is signaled . Value is the integer read. Signals an
2118 error if encountering invalid read syntax or if RADIX is out of
2122 read_integer (Lisp_Object readcharfun
, int radix
)
2124 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2125 /* We use a floating point number because */
2128 if (radix
< 2 || radix
> 36)
2132 number
= ndigits
= invalid_p
= 0;
2148 if (c
>= '0' && c
<= '9')
2150 else if (c
>= 'a' && c
<= 'z')
2151 digit
= c
- 'a' + 10;
2152 else if (c
>= 'A' && c
<= 'Z')
2153 digit
= c
- 'A' + 10;
2160 if (digit
< 0 || digit
>= radix
)
2163 number
= radix
* number
+ digit
;
2169 if (ndigits
== 0 || invalid_p
)
2172 sprintf (buf
, "integer, radix %d", radix
);
2173 invalid_syntax (buf
, 0);
2176 return make_fixnum_or_float (sign
* number
);
2180 /* If the next token is ')' or ']' or '.', we store that character
2181 in *PCH and the return value is not interesting. Else, we store
2182 zero in *PCH and we read and return one lisp object.
2184 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2187 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2190 int uninterned_symbol
= 0;
2198 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2200 end_of_file_error ();
2205 return read_list (0, readcharfun
);
2208 return read_vector (readcharfun
, 0);
2224 /* Accept extended format for hashtables (extensible to
2226 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2227 Lisp_Object tmp
= read_list (0, readcharfun
);
2228 Lisp_Object head
= CAR_SAFE (tmp
);
2229 Lisp_Object data
= Qnil
;
2230 Lisp_Object val
= Qnil
;
2231 /* The size is 2 * number of allowed keywords to
2233 Lisp_Object params
[10];
2235 Lisp_Object key
= Qnil
;
2236 int param_count
= 0;
2238 if (!EQ (head
, Qhash_table
))
2239 error ("Invalid extended read marker at head of #s list "
2240 "(only hash-table allowed)");
2242 tmp
= CDR_SAFE (tmp
);
2244 /* This is repetitive but fast and simple. */
2245 params
[param_count
] = QCsize
;
2246 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2247 if (!NILP (params
[param_count
+ 1]))
2250 params
[param_count
] = QCtest
;
2251 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2252 if (!NILP (params
[param_count
+ 1]))
2255 params
[param_count
] = QCweakness
;
2256 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2257 if (!NILP (params
[param_count
+ 1]))
2260 params
[param_count
] = QCrehash_size
;
2261 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2262 if (!NILP (params
[param_count
+ 1]))
2265 params
[param_count
] = QCrehash_threshold
;
2266 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2267 if (!NILP (params
[param_count
+ 1]))
2270 /* This is the hashtable data. */
2271 data
= Fplist_get (tmp
, Qdata
);
2273 /* Now use params to make a new hashtable and fill it. */
2274 ht
= Fmake_hash_table (param_count
, params
);
2276 while (CONSP (data
))
2281 error ("Odd number of elements in hashtable data");
2284 Fputhash (key
, val
, ht
);
2290 invalid_syntax ("#", 1);
2298 tmp
= read_vector (readcharfun
, 0);
2299 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2300 error ("Invalid size char-table");
2301 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2312 tmp
= read_vector (readcharfun
, 0);
2313 if (!INTEGERP (AREF (tmp
, 0)))
2314 error ("Invalid depth in char-table");
2315 depth
= XINT (AREF (tmp
, 0));
2316 if (depth
< 1 || depth
> 3)
2317 error ("Invalid depth in char-table");
2318 size
= XVECTOR (tmp
)->size
- 2;
2319 if (chartab_size
[depth
] != size
)
2320 error ("Invalid size char-table");
2321 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2324 invalid_syntax ("#^^", 3);
2326 invalid_syntax ("#^", 2);
2331 length
= read1 (readcharfun
, pch
, first_in_list
);
2335 Lisp_Object tmp
, val
;
2337 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2338 / BOOL_VECTOR_BITS_PER_CHAR
);
2341 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2342 if (STRING_MULTIBYTE (tmp
)
2343 || (size_in_chars
!= SCHARS (tmp
)
2344 /* We used to print 1 char too many
2345 when the number of bits was a multiple of 8.
2346 Accept such input in case it came from an old
2348 && ! (XFASTINT (length
)
2349 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2350 invalid_syntax ("#&...", 5);
2352 val
= Fmake_bool_vector (length
, Qnil
);
2353 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2354 /* Clear the extraneous bits in the last byte. */
2355 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2356 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2357 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2360 invalid_syntax ("#&...", 5);
2364 /* Accept compiled functions at read-time so that we don't have to
2365 build them using function calls. */
2367 tmp
= read_vector (readcharfun
, 1);
2368 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2369 XVECTOR (tmp
)->contents
);
2374 struct gcpro gcpro1
;
2377 /* Read the string itself. */
2378 tmp
= read1 (readcharfun
, &ch
, 0);
2379 if (ch
!= 0 || !STRINGP (tmp
))
2380 invalid_syntax ("#", 1);
2382 /* Read the intervals and their properties. */
2385 Lisp_Object beg
, end
, plist
;
2387 beg
= read1 (readcharfun
, &ch
, 0);
2392 end
= read1 (readcharfun
, &ch
, 0);
2394 plist
= read1 (readcharfun
, &ch
, 0);
2396 invalid_syntax ("Invalid string property list", 0);
2397 Fset_text_properties (beg
, end
, plist
, tmp
);
2403 /* #@NUMBER is used to skip NUMBER following characters.
2404 That's used in .elc files to skip over doc strings
2405 and function definitions. */
2411 /* Read a decimal integer. */
2412 while ((c
= READCHAR
) >= 0
2413 && c
>= '0' && c
<= '9')
2421 if (load_force_doc_strings
2422 && (EQ (readcharfun
, Qget_file_char
)
2423 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2425 /* If we are supposed to force doc strings into core right now,
2426 record the last string that we skipped,
2427 and record where in the file it comes from. */
2429 /* But first exchange saved_doc_string
2430 with prev_saved_doc_string, so we save two strings. */
2432 char *temp
= saved_doc_string
;
2433 int temp_size
= saved_doc_string_size
;
2434 file_offset temp_pos
= saved_doc_string_position
;
2435 int temp_len
= saved_doc_string_length
;
2437 saved_doc_string
= prev_saved_doc_string
;
2438 saved_doc_string_size
= prev_saved_doc_string_size
;
2439 saved_doc_string_position
= prev_saved_doc_string_position
;
2440 saved_doc_string_length
= prev_saved_doc_string_length
;
2442 prev_saved_doc_string
= temp
;
2443 prev_saved_doc_string_size
= temp_size
;
2444 prev_saved_doc_string_position
= temp_pos
;
2445 prev_saved_doc_string_length
= temp_len
;
2448 if (saved_doc_string_size
== 0)
2450 saved_doc_string_size
= nskip
+ 100;
2451 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2453 if (nskip
> saved_doc_string_size
)
2455 saved_doc_string_size
= nskip
+ 100;
2456 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2457 saved_doc_string_size
);
2460 saved_doc_string_position
= file_tell (instream
);
2462 /* Copy that many characters into saved_doc_string. */
2463 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2464 saved_doc_string
[i
] = c
= READCHAR
;
2466 saved_doc_string_length
= i
;
2470 /* Skip that many characters. */
2471 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2480 /* #! appears at the beginning of an executable file.
2481 Skip the first line. */
2482 while (c
!= '\n' && c
>= 0)
2487 return Vload_file_name
;
2489 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2490 /* #:foo is the uninterned symbol named foo. */
2493 uninterned_symbol
= 1;
2497 /* Reader forms that can reuse previously read objects. */
2498 if (c
>= '0' && c
<= '9')
2503 /* Read a non-negative integer. */
2504 while (c
>= '0' && c
<= '9')
2510 /* #n=object returns object, but associates it with n for #n#. */
2511 if (c
== '=' && !NILP (Vread_circle
))
2513 /* Make a placeholder for #n# to use temporarily */
2514 Lisp_Object placeholder
;
2517 placeholder
= Fcons (Qnil
, Qnil
);
2518 cell
= Fcons (make_number (n
), placeholder
);
2519 read_objects
= Fcons (cell
, read_objects
);
2521 /* Read the object itself. */
2522 tem
= read0 (readcharfun
);
2524 /* Now put it everywhere the placeholder was... */
2525 substitute_object_in_subtree (tem
, placeholder
);
2527 /* ...and #n# will use the real value from now on. */
2528 Fsetcdr (cell
, tem
);
2532 /* #n# returns a previously read object. */
2533 if (c
== '#' && !NILP (Vread_circle
))
2535 tem
= Fassq (make_number (n
), read_objects
);
2538 /* Fall through to error message. */
2540 else if (c
== 'r' || c
== 'R')
2541 return read_integer (readcharfun
, n
);
2543 /* Fall through to error message. */
2545 else if (c
== 'x' || c
== 'X')
2546 return read_integer (readcharfun
, 16);
2547 else if (c
== 'o' || c
== 'O')
2548 return read_integer (readcharfun
, 8);
2549 else if (c
== 'b' || c
== 'B')
2550 return read_integer (readcharfun
, 2);
2553 invalid_syntax ("#", 1);
2556 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2561 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2566 int next_char
= READCHAR
;
2568 /* Transition from old-style to new-style:
2569 If we see "(`" it used to mean old-style, which usually works
2570 fine because ` should almost never appear in such a position
2571 for new-style. But occasionally we need "(`" to mean new
2572 style, so we try to distinguish the two by the fact that we
2573 can either write "( `foo" or "(` foo", where the first
2574 intends to use new-style whereas the second intends to use
2575 old-style. For Emacs-25, we should completely remove this
2576 first_in_list exception (old-style can still be obtained via
2578 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2580 Vold_style_backquotes
= Qt
;
2587 new_backquote_flag
++;
2588 value
= read0 (readcharfun
);
2589 new_backquote_flag
--;
2591 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2596 int next_char
= READCHAR
;
2598 /* Transition from old-style to new-style:
2599 It used to be impossible to have a new-style , other than within
2600 a new-style `. This is sufficient when ` and , are used in the
2601 normal way, but ` and , can also appear in args to macros that
2602 will not interpret them in the usual way, in which case , may be
2603 used without any ` anywhere near.
2604 So we now use the same heuristic as for backquote: old-style
2605 unquotes are only recognized when first on a list, and when
2606 followed by a space.
2607 Because it's more difficult to peak 2 chars ahead, a new-style
2608 ,@ can still not be used outside of a `, unless it's in the middle
2610 if (new_backquote_flag
2612 || (next_char
!= ' ' && next_char
!= '@'))
2614 Lisp_Object comma_type
= Qnil
;
2619 comma_type
= Qcomma_at
;
2621 comma_type
= Qcomma_dot
;
2624 if (ch
>= 0) UNREAD (ch
);
2625 comma_type
= Qcomma
;
2628 value
= read0 (readcharfun
);
2629 return Fcons (comma_type
, Fcons (value
, Qnil
));
2633 Vold_style_backquotes
= Qt
;
2645 end_of_file_error ();
2647 /* Accept `single space' syntax like (list ? x) where the
2648 whitespace character is SPC or TAB.
2649 Other literal whitespace like NL, CR, and FF are not accepted,
2650 as there are well-established escape sequences for these. */
2651 if (c
== ' ' || c
== '\t')
2652 return make_number (c
);
2655 c
= read_escape (readcharfun
, 0);
2656 modifiers
= c
& CHAR_MODIFIER_MASK
;
2657 c
&= ~CHAR_MODIFIER_MASK
;
2658 if (CHAR_BYTE8_P (c
))
2659 c
= CHAR_TO_BYTE8 (c
);
2662 next_char
= READCHAR
;
2663 ok
= (next_char
<= 040
2664 || (next_char
< 0200
2665 && (strchr ("\"';()[]#?`,.", next_char
))));
2668 return make_number (c
);
2670 invalid_syntax ("?", 1);
2675 char *p
= read_buffer
;
2676 char *end
= read_buffer
+ read_buffer_size
;
2678 /* Nonzero if we saw an escape sequence specifying
2679 a multibyte character. */
2680 int force_multibyte
= 0;
2681 /* Nonzero if we saw an escape sequence specifying
2682 a single-byte character. */
2683 int force_singlebyte
= 0;
2687 while ((c
= READCHAR
) >= 0
2690 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2692 int offset
= p
- read_buffer
;
2693 read_buffer
= (char *) xrealloc (read_buffer
,
2694 read_buffer_size
*= 2);
2695 p
= read_buffer
+ offset
;
2696 end
= read_buffer
+ read_buffer_size
;
2703 c
= read_escape (readcharfun
, 1);
2705 /* C is -1 if \ newline has just been seen */
2708 if (p
== read_buffer
)
2713 modifiers
= c
& CHAR_MODIFIER_MASK
;
2714 c
= c
& ~CHAR_MODIFIER_MASK
;
2716 if (CHAR_BYTE8_P (c
))
2717 force_singlebyte
= 1;
2718 else if (! ASCII_CHAR_P (c
))
2719 force_multibyte
= 1;
2720 else /* i.e. ASCII_CHAR_P (c) */
2722 /* Allow `\C- ' and `\C-?'. */
2723 if (modifiers
== CHAR_CTL
)
2726 c
= 0, modifiers
= 0;
2728 c
= 127, modifiers
= 0;
2730 if (modifiers
& CHAR_SHIFT
)
2732 /* Shift modifier is valid only with [A-Za-z]. */
2733 if (c
>= 'A' && c
<= 'Z')
2734 modifiers
&= ~CHAR_SHIFT
;
2735 else if (c
>= 'a' && c
<= 'z')
2736 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2739 if (modifiers
& CHAR_META
)
2741 /* Move the meta bit to the right place for a
2743 modifiers
&= ~CHAR_META
;
2744 c
= BYTE8_TO_CHAR (c
| 0x80);
2745 force_singlebyte
= 1;
2749 /* Any modifiers remaining are invalid. */
2751 error ("Invalid modifier in string");
2752 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2756 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2757 if (CHAR_BYTE8_P (c
))
2758 force_singlebyte
= 1;
2759 else if (! ASCII_CHAR_P (c
))
2760 force_multibyte
= 1;
2766 end_of_file_error ();
2768 /* If purifying, and string starts with \ newline,
2769 return zero instead. This is for doc strings
2770 that we are really going to find in etc/DOC.nn.nn */
2771 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2772 return make_number (0);
2774 if (force_multibyte
)
2775 /* READ_BUFFER already contains valid multibyte forms. */
2777 else if (force_singlebyte
)
2779 nchars
= str_as_unibyte ((unsigned char *) read_buffer
,
2781 p
= read_buffer
+ nchars
;
2784 /* Otherwise, READ_BUFFER contains only ASCII. */
2787 /* We want readchar_count to be the number of characters, not
2788 bytes. Hence we adjust for multibyte characters in the
2789 string. ... But it doesn't seem to be necessary, because
2790 READCHAR *does* read multibyte characters from buffers. */
2791 /* readchar_count -= (p - read_buffer) - nchars; */
2793 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2795 || (p
- read_buffer
!= nchars
)));
2796 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2798 || (p
- read_buffer
!= nchars
)));
2803 int next_char
= READCHAR
;
2806 if (next_char
<= 040
2807 || (next_char
< 0200
2808 && (strchr ("\"';([#?`,", next_char
))))
2814 /* Otherwise, we fall through! Note that the atom-reading loop
2815 below will now loop at least once, assuring that we will not
2816 try to UNREAD two characters in a row. */
2820 if (c
<= 040) goto retry
;
2821 if (c
== 0x8a0) /* NBSP */
2824 char *p
= read_buffer
;
2828 char *end
= read_buffer
+ read_buffer_size
;
2832 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2834 int offset
= p
- read_buffer
;
2835 read_buffer
= (char *) xrealloc (read_buffer
,
2836 read_buffer_size
*= 2);
2837 p
= read_buffer
+ offset
;
2838 end
= read_buffer
+ read_buffer_size
;
2845 end_of_file_error ();
2850 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2855 && c
!= 0x8a0 /* NBSP */
2857 || !(strchr ("\"';()[]#`,", c
))));
2861 int offset
= p
- read_buffer
;
2862 read_buffer
= (char *) xrealloc (read_buffer
,
2863 read_buffer_size
*= 2);
2864 p
= read_buffer
+ offset
;
2865 end
= read_buffer
+ read_buffer_size
;
2872 if (!quoted
&& !uninterned_symbol
)
2876 if (*p1
== '+' || *p1
== '-') p1
++;
2877 /* Is it an integer? */
2880 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2881 /* Integers can have trailing decimal points. */
2882 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2884 /* It is an integer. */
2889 /* EMACS_INT n = atol (read_buffer); */
2890 char *endptr
= NULL
;
2891 EMACS_INT n
= (errno
= 0,
2892 strtol (read_buffer
, &endptr
, 10));
2893 if (errno
== ERANGE
&& endptr
)
2896 = Fcons (make_string (read_buffer
,
2897 endptr
- read_buffer
),
2899 xsignal (Qoverflow_error
, args
);
2901 return make_fixnum_or_float (n
);
2905 if (isfloat_string (read_buffer
, 0))
2907 /* Compute NaN and infinities using 0.0 in a variable,
2908 to cope with compilers that think they are smarter
2914 /* Negate the value ourselves. This treats 0, NaNs,
2915 and infinity properly on IEEE floating point hosts,
2916 and works around a common bug where atof ("-0.0")
2918 int negative
= read_buffer
[0] == '-';
2920 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2921 returns 1, is if the input ends in e+INF or e+NaN. */
2928 value
= zero
/ zero
;
2930 /* If that made a "negative" NaN, negate it. */
2934 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2937 u_minus_zero
.d
= - 0.0;
2938 for (i
= 0; i
< sizeof (double); i
++)
2939 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2945 /* Now VALUE is a positive NaN. */
2948 value
= atof (read_buffer
+ negative
);
2952 return make_float (negative
? - value
: value
);
2956 Lisp_Object name
, result
;
2957 EMACS_INT nbytes
= p
- read_buffer
;
2960 ? multibyte_chars_in_text ((unsigned char *) read_buffer
,
2964 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
2965 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
2967 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
2968 result
= (uninterned_symbol
? Fmake_symbol (name
)
2969 : Fintern (name
, Qnil
));
2971 if (EQ (Vread_with_symbol_positions
, Qt
)
2972 || EQ (Vread_with_symbol_positions
, readcharfun
))
2973 Vread_symbol_positions_list
=
2974 /* Kind of a hack; this will probably fail if characters
2975 in the symbol name were escaped. Not really a big
2977 Fcons (Fcons (result
,
2978 make_number (readchar_count
2979 - XFASTINT (Flength (Fsymbol_name (result
))))),
2980 Vread_symbol_positions_list
);
2988 /* List of nodes we've seen during substitute_object_in_subtree. */
2989 static Lisp_Object seen_list
;
2992 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
2994 Lisp_Object check_object
;
2996 /* We haven't seen any objects when we start. */
2999 /* Make all the substitutions. */
3001 = substitute_object_recurse (object
, placeholder
, object
);
3003 /* Clear seen_list because we're done with it. */
3006 /* The returned object here is expected to always eq the
3008 if (!EQ (check_object
, object
))
3009 error ("Unexpected mutation error in reader");
3012 /* Feval doesn't get called from here, so no gc protection is needed. */
3013 #define SUBSTITUTE(get_val, set_val) \
3015 Lisp_Object old_value = get_val; \
3016 Lisp_Object true_value \
3017 = substitute_object_recurse (object, placeholder, \
3020 if (!EQ (old_value, true_value)) \
3027 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3029 /* If we find the placeholder, return the target object. */
3030 if (EQ (placeholder
, subtree
))
3033 /* If we've been to this node before, don't explore it again. */
3034 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3037 /* If this node can be the entry point to a cycle, remember that
3038 we've seen it. It can only be such an entry point if it was made
3039 by #n=, which means that we can find it as a value in
3041 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3042 seen_list
= Fcons (subtree
, seen_list
);
3044 /* Recurse according to subtree's type.
3045 Every branch must return a Lisp_Object. */
3046 switch (XTYPE (subtree
))
3048 case Lisp_Vectorlike
:
3051 if (BOOL_VECTOR_P (subtree
))
3052 return subtree
; /* No sub-objects anyway. */
3053 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3054 || COMPILEDP (subtree
))
3055 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3056 else if (VECTORP (subtree
))
3057 length
= ASIZE (subtree
);
3059 /* An unknown pseudovector may contain non-Lisp fields, so we
3060 can't just blindly traverse all its fields. We used to call
3061 `Flength' which signaled `sequencep', so I just preserved this
3063 wrong_type_argument (Qsequencep
, subtree
);
3065 for (i
= 0; i
< length
; i
++)
3066 SUBSTITUTE (AREF (subtree
, i
),
3067 ASET (subtree
, i
, true_value
));
3073 SUBSTITUTE (XCAR (subtree
),
3074 XSETCAR (subtree
, true_value
));
3075 SUBSTITUTE (XCDR (subtree
),
3076 XSETCDR (subtree
, true_value
));
3082 /* Check for text properties in each interval.
3083 substitute_in_interval contains part of the logic. */
3085 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3086 Lisp_Object arg
= Fcons (object
, placeholder
);
3088 traverse_intervals_noorder (root_interval
,
3089 &substitute_in_interval
, arg
);
3094 /* Other types don't recurse any further. */
3100 /* Helper function for substitute_object_recurse. */
3102 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3104 Lisp_Object object
= Fcar (arg
);
3105 Lisp_Object placeholder
= Fcdr (arg
);
3107 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3118 isfloat_string (const char *cp
, int ignore_trailing
)
3121 const char *start
= cp
;
3124 if (*cp
== '+' || *cp
== '-')
3127 if (*cp
>= '0' && *cp
<= '9')
3130 while (*cp
>= '0' && *cp
<= '9')
3138 if (*cp
>= '0' && *cp
<= '9')
3141 while (*cp
>= '0' && *cp
<= '9')
3144 if (*cp
== 'e' || *cp
== 'E')
3148 if (*cp
== '+' || *cp
== '-')
3152 if (*cp
>= '0' && *cp
<= '9')
3155 while (*cp
>= '0' && *cp
<= '9')
3158 else if (cp
== start
)
3160 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3165 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3171 return ((ignore_trailing
3172 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3173 || *cp
== '\r' || *cp
== '\f')
3174 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3175 || state
== (DOT_CHAR
|TRAIL_INT
)
3176 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3177 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3178 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3183 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3187 register Lisp_Object
*ptr
;
3188 register Lisp_Object tem
, item
, vector
;
3189 register struct Lisp_Cons
*otem
;
3192 tem
= read_list (1, readcharfun
);
3193 len
= Flength (tem
);
3194 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3196 size
= XVECTOR (vector
)->size
;
3197 ptr
= XVECTOR (vector
)->contents
;
3198 for (i
= 0; i
< size
; i
++)
3201 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3202 bytecode object, the docstring containing the bytecode and
3203 constants values must be treated as unibyte and passed to
3204 Fread, to get the actual bytecode string and constants vector. */
3205 if (bytecodeflag
&& load_force_doc_strings
)
3207 if (i
== COMPILED_BYTECODE
)
3209 if (!STRINGP (item
))
3210 error ("Invalid byte code");
3212 /* Delay handling the bytecode slot until we know whether
3213 it is lazily-loaded (we can tell by whether the
3214 constants slot is nil). */
3215 ptr
[COMPILED_CONSTANTS
] = item
;
3218 else if (i
== COMPILED_CONSTANTS
)
3220 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3224 /* Coerce string to unibyte (like string-as-unibyte,
3225 but without generating extra garbage and
3226 guaranteeing no change in the contents). */
3227 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3228 STRING_SET_UNIBYTE (bytestr
);
3230 item
= Fread (Fcons (bytestr
, readcharfun
));
3232 error ("Invalid byte code");
3234 otem
= XCONS (item
);
3235 bytestr
= XCAR (item
);
3240 /* Now handle the bytecode slot. */
3241 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3243 else if (i
== COMPILED_DOC_STRING
3245 && ! STRING_MULTIBYTE (item
))
3247 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3248 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3250 item
= Fstring_as_multibyte (item
);
3253 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3261 /* FLAG = 1 means check for ] to terminate rather than ) and .
3262 FLAG = -1 means check for starting with defun
3263 and make structure pure. */
3266 read_list (int flag
, register Lisp_Object readcharfun
)
3268 /* -1 means check next element for defun,
3269 0 means don't check,
3270 1 means already checked and found defun. */
3271 int defunflag
= flag
< 0 ? -1 : 0;
3272 Lisp_Object val
, tail
;
3273 register Lisp_Object elt
, tem
;
3274 struct gcpro gcpro1
, gcpro2
;
3275 /* 0 is the normal case.
3276 1 means this list is a doc reference; replace it with the number 0.
3277 2 means this list is a doc reference; replace it with the doc string. */
3278 int doc_reference
= 0;
3280 /* Initialize this to 1 if we are reading a list. */
3281 int first_in_list
= flag
<= 0;
3290 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3295 /* While building, if the list starts with #$, treat it specially. */
3296 if (EQ (elt
, Vload_file_name
)
3298 && !NILP (Vpurify_flag
))
3300 if (NILP (Vdoc_file_name
))
3301 /* We have not yet called Snarf-documentation, so assume
3302 this file is described in the DOC-MM.NN file
3303 and Snarf-documentation will fill in the right value later.
3304 For now, replace the whole list with 0. */
3307 /* We have already called Snarf-documentation, so make a relative
3308 file name for this file, so it can be found properly
3309 in the installed Lisp directory.
3310 We don't use Fexpand_file_name because that would make
3311 the directory absolute now. */
3312 elt
= concat2 (build_string ("../lisp/"),
3313 Ffile_name_nondirectory (elt
));
3315 else if (EQ (elt
, Vload_file_name
)
3317 && load_force_doc_strings
)
3326 invalid_syntax (") or . in a vector", 18);
3334 XSETCDR (tail
, read0 (readcharfun
));
3336 val
= read0 (readcharfun
);
3337 read1 (readcharfun
, &ch
, 0);
3341 if (doc_reference
== 1)
3342 return make_number (0);
3343 if (doc_reference
== 2)
3345 /* Get a doc string from the file we are loading.
3346 If it's in saved_doc_string, get it from there.
3348 Here, we don't know if the string is a
3349 bytecode string or a doc string. As a
3350 bytecode string must be unibyte, we always
3351 return a unibyte string. If it is actually a
3352 doc string, caller must make it
3355 int pos
= XINT (XCDR (val
));
3356 /* Position is negative for user variables. */
3357 if (pos
< 0) pos
= -pos
;
3358 if (pos
>= saved_doc_string_position
3359 && pos
< (saved_doc_string_position
3360 + saved_doc_string_length
))
3362 int start
= pos
- saved_doc_string_position
;
3365 /* Process quoting with ^A,
3366 and find the end of the string,
3367 which is marked with ^_ (037). */
3368 for (from
= start
, to
= start
;
3369 saved_doc_string
[from
] != 037;)
3371 int c
= saved_doc_string
[from
++];
3374 c
= saved_doc_string
[from
++];
3376 saved_doc_string
[to
++] = c
;
3378 saved_doc_string
[to
++] = 0;
3380 saved_doc_string
[to
++] = 037;
3383 saved_doc_string
[to
++] = c
;
3386 return make_unibyte_string (saved_doc_string
+ start
,
3389 /* Look in prev_saved_doc_string the same way. */
3390 else if (pos
>= prev_saved_doc_string_position
3391 && pos
< (prev_saved_doc_string_position
3392 + prev_saved_doc_string_length
))
3394 int start
= pos
- prev_saved_doc_string_position
;
3397 /* Process quoting with ^A,
3398 and find the end of the string,
3399 which is marked with ^_ (037). */
3400 for (from
= start
, to
= start
;
3401 prev_saved_doc_string
[from
] != 037;)
3403 int c
= prev_saved_doc_string
[from
++];
3406 c
= prev_saved_doc_string
[from
++];
3408 prev_saved_doc_string
[to
++] = c
;
3410 prev_saved_doc_string
[to
++] = 0;
3412 prev_saved_doc_string
[to
++] = 037;
3415 prev_saved_doc_string
[to
++] = c
;
3418 return make_unibyte_string (prev_saved_doc_string
3423 return get_doc_string (val
, 1, 0);
3428 invalid_syntax (". in wrong context", 18);
3430 invalid_syntax ("] in a list", 11);
3432 tem
= (read_pure
&& flag
<= 0
3433 ? pure_cons (elt
, Qnil
)
3434 : Fcons (elt
, Qnil
));
3436 XSETCDR (tail
, tem
);
3441 defunflag
= EQ (elt
, Qdefun
);
3442 else if (defunflag
> 0)
3447 Lisp_Object initial_obarray
;
3449 /* oblookup stores the bucket number here, for the sake of Funintern. */
3451 int oblookup_last_bucket_number
;
3453 static int hash_string (const char *ptr
, int len
);
3455 /* Get an error if OBARRAY is not an obarray.
3456 If it is one, return it. */
3459 check_obarray (Lisp_Object obarray
)
3461 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3463 /* If Vobarray is now invalid, force it to be valid. */
3464 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3465 wrong_type_argument (Qvectorp
, obarray
);
3470 /* Intern the C string STR: return a symbol with that name,
3471 interned in the current obarray. */
3474 intern (const char *str
)
3477 int len
= strlen (str
);
3478 Lisp_Object obarray
;
3481 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3482 obarray
= check_obarray (obarray
);
3483 tem
= oblookup (obarray
, str
, len
, len
);
3486 return Fintern (make_string (str
, len
), obarray
);
3490 intern_c_string (const char *str
)
3493 int len
= strlen (str
);
3494 Lisp_Object obarray
;
3497 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3498 obarray
= check_obarray (obarray
);
3499 tem
= oblookup (obarray
, str
, len
, len
);
3503 if (NILP (Vpurify_flag
))
3504 /* Creating a non-pure string from a string literal not
3505 implemented yet. We could just use make_string here and live
3506 with the extra copy. */
3509 return Fintern (make_pure_c_string (str
), obarray
);
3512 /* Create an uninterned symbol with name STR. */
3515 make_symbol (const char *str
)
3517 int len
= strlen (str
);
3519 return Fmake_symbol (!NILP (Vpurify_flag
)
3520 ? make_pure_string (str
, len
, len
, 0)
3521 : make_string (str
, len
));
3524 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3525 doc
: /* Return the canonical symbol whose name is STRING.
3526 If there is none, one is created by this function and returned.
3527 A second optional argument specifies the obarray to use;
3528 it defaults to the value of `obarray'. */)
3529 (Lisp_Object string
, Lisp_Object obarray
)
3531 register Lisp_Object tem
, sym
, *ptr
;
3533 if (NILP (obarray
)) obarray
= Vobarray
;
3534 obarray
= check_obarray (obarray
);
3536 CHECK_STRING (string
);
3538 tem
= oblookup (obarray
, SSDATA (string
),
3541 if (!INTEGERP (tem
))
3544 if (!NILP (Vpurify_flag
))
3545 string
= Fpurecopy (string
);
3546 sym
= Fmake_symbol (string
);
3548 if (EQ (obarray
, initial_obarray
))
3549 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3551 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3553 if ((SREF (string
, 0) == ':')
3554 && EQ (obarray
, initial_obarray
))
3556 XSYMBOL (sym
)->constant
= 1;
3557 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3558 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3561 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3563 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3565 XSYMBOL (sym
)->next
= 0;
3570 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3571 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3572 NAME may be a string or a symbol. If it is a symbol, that exact
3573 symbol is searched for.
3574 A second optional argument specifies the obarray to use;
3575 it defaults to the value of `obarray'. */)
3576 (Lisp_Object name
, Lisp_Object obarray
)
3578 register Lisp_Object tem
, string
;
3580 if (NILP (obarray
)) obarray
= Vobarray
;
3581 obarray
= check_obarray (obarray
);
3583 if (!SYMBOLP (name
))
3585 CHECK_STRING (name
);
3589 string
= SYMBOL_NAME (name
);
3591 tem
= oblookup (obarray
, SSDATA (string
), SCHARS (string
), SBYTES (string
));
3592 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3598 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3599 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3600 The value is t if a symbol was found and deleted, nil otherwise.
3601 NAME may be a string or a symbol. If it is a symbol, that symbol
3602 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3603 OBARRAY defaults to the value of the variable `obarray'. */)
3604 (Lisp_Object name
, Lisp_Object obarray
)
3606 register Lisp_Object string
, tem
;
3609 if (NILP (obarray
)) obarray
= Vobarray
;
3610 obarray
= check_obarray (obarray
);
3613 string
= SYMBOL_NAME (name
);
3616 CHECK_STRING (name
);
3620 tem
= oblookup (obarray
, SSDATA (string
),
3625 /* If arg was a symbol, don't delete anything but that symbol itself. */
3626 if (SYMBOLP (name
) && !EQ (name
, tem
))
3629 /* There are plenty of other symbols which will screw up the Emacs
3630 session if we unintern them, as well as even more ways to use
3631 `setq' or `fset' or whatnot to make the Emacs session
3632 unusable. Let's not go down this silly road. --Stef */
3633 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3634 error ("Attempt to unintern t or nil"); */
3636 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3638 hash
= oblookup_last_bucket_number
;
3640 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3642 if (XSYMBOL (tem
)->next
)
3643 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3645 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3649 Lisp_Object tail
, following
;
3651 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3652 XSYMBOL (tail
)->next
;
3655 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3656 if (EQ (following
, tem
))
3658 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3667 /* Return the symbol in OBARRAY whose names matches the string
3668 of SIZE characters (SIZE_BYTE bytes) at PTR.
3669 If there is no such symbol in OBARRAY, return nil.
3671 Also store the bucket number in oblookup_last_bucket_number. */
3674 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3678 register Lisp_Object tail
;
3679 Lisp_Object bucket
, tem
;
3681 if (!VECTORP (obarray
)
3682 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3684 obarray
= check_obarray (obarray
);
3685 obsize
= XVECTOR (obarray
)->size
;
3687 /* This is sometimes needed in the middle of GC. */
3688 obsize
&= ~ARRAY_MARK_FLAG
;
3689 hash
= hash_string (ptr
, size_byte
) % obsize
;
3690 bucket
= XVECTOR (obarray
)->contents
[hash
];
3691 oblookup_last_bucket_number
= hash
;
3692 if (EQ (bucket
, make_number (0)))
3694 else if (!SYMBOLP (bucket
))
3695 error ("Bad data in guts of obarray"); /* Like CADR error message */
3697 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3699 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3700 && SCHARS (SYMBOL_NAME (tail
)) == size
3701 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3703 else if (XSYMBOL (tail
)->next
== 0)
3706 XSETINT (tem
, hash
);
3711 hash_string (const char *ptr
, int len
)
3713 register const char *p
= ptr
;
3714 register const char *end
= p
+ len
;
3715 register unsigned char c
;
3716 register int hash
= 0;
3721 if (c
>= 0140) c
-= 40;
3722 hash
= ((hash
<<3) + (hash
>>28) + c
);
3724 return hash
& 07777777777;
3728 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3731 register Lisp_Object tail
;
3732 CHECK_VECTOR (obarray
);
3733 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3735 tail
= XVECTOR (obarray
)->contents
[i
];
3740 if (XSYMBOL (tail
)->next
== 0)
3742 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3748 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3750 call1 (function
, sym
);
3753 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3754 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3755 OBARRAY defaults to the value of `obarray'. */)
3756 (Lisp_Object function
, Lisp_Object obarray
)
3758 if (NILP (obarray
)) obarray
= Vobarray
;
3759 obarray
= check_obarray (obarray
);
3761 map_obarray (obarray
, mapatoms_1
, function
);
3765 #define OBARRAY_SIZE 1511
3770 Lisp_Object oblength
;
3772 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3774 Vobarray
= Fmake_vector (oblength
, make_number (0));
3775 initial_obarray
= Vobarray
;
3776 staticpro (&initial_obarray
);
3778 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3779 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3780 NILP (Vpurify_flag) check in intern_c_string. */
3781 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3782 Qnil
= intern_c_string ("nil");
3784 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3785 so those two need to be fixed manally. */
3786 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3787 XSYMBOL (Qunbound
)->function
= Qunbound
;
3788 XSYMBOL (Qunbound
)->plist
= Qnil
;
3789 /* XSYMBOL (Qnil)->function = Qunbound; */
3790 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3791 XSYMBOL (Qnil
)->constant
= 1;
3792 XSYMBOL (Qnil
)->plist
= Qnil
;
3794 Qt
= intern_c_string ("t");
3795 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3796 XSYMBOL (Qt
)->constant
= 1;
3798 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3801 Qvariable_documentation
= intern_c_string ("variable-documentation");
3802 staticpro (&Qvariable_documentation
);
3804 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3805 read_buffer
= (char *) xmalloc (read_buffer_size
);
3809 defsubr (struct Lisp_Subr
*sname
)
3812 sym
= intern_c_string (sname
->symbol_name
);
3813 XSETPVECTYPE (sname
, PVEC_SUBR
);
3814 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3817 #ifdef NOTDEF /* use fset in subr.el now */
3819 defalias (sname
, string
)
3820 struct Lisp_Subr
*sname
;
3824 sym
= intern (string
);
3825 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3829 /* Define an "integer variable"; a symbol whose value is forwarded to a
3830 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3831 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3833 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3834 const char *namestring
, EMACS_INT
*address
)
3837 sym
= intern_c_string (namestring
);
3838 i_fwd
->type
= Lisp_Fwd_Int
;
3839 i_fwd
->intvar
= address
;
3840 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3841 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3844 /* Similar but define a variable whose value is t if address contains 1,
3845 nil if address contains 0. */
3847 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3848 const char *namestring
, int *address
)
3851 sym
= intern_c_string (namestring
);
3852 b_fwd
->type
= Lisp_Fwd_Bool
;
3853 b_fwd
->boolvar
= address
;
3854 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3855 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3856 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3859 /* Similar but define a variable whose value is the Lisp Object stored
3860 at address. Two versions: with and without gc-marking of the C
3861 variable. The nopro version is used when that variable will be
3862 gc-marked for some other reason, since marking the same slot twice
3863 can cause trouble with strings. */
3865 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
3866 const char *namestring
, Lisp_Object
*address
)
3869 sym
= intern_c_string (namestring
);
3870 o_fwd
->type
= Lisp_Fwd_Obj
;
3871 o_fwd
->objvar
= address
;
3872 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3873 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
3877 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
3878 const char *namestring
, Lisp_Object
*address
)
3880 defvar_lisp_nopro (o_fwd
, namestring
, address
);
3881 staticpro (address
);
3884 /* Similar but define a variable whose value is the Lisp Object stored
3885 at a particular offset in the current kboard object. */
3888 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
3889 const char *namestring
, int offset
)
3892 sym
= intern_c_string (namestring
);
3893 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
3894 ko_fwd
->offset
= offset
;
3895 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3896 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
3899 /* Record the value of load-path used at the start of dumping
3900 so we can see if the site changed it later during dumping. */
3901 static Lisp_Object dump_path
;
3907 int turn_off_warning
= 0;
3909 /* Compute the default load-path. */
3911 normal
= PATH_LOADSEARCH
;
3912 Vload_path
= decode_env_path (0, normal
);
3914 if (NILP (Vpurify_flag
))
3915 normal
= PATH_LOADSEARCH
;
3917 normal
= PATH_DUMPLOADSEARCH
;
3919 /* In a dumped Emacs, we normally have to reset the value of
3920 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3921 uses ../lisp, instead of the path of the installed elisp
3922 libraries. However, if it appears that Vload_path was changed
3923 from the default before dumping, don't override that value. */
3926 if (! NILP (Fequal (dump_path
, Vload_path
)))
3928 Vload_path
= decode_env_path (0, normal
);
3929 if (!NILP (Vinstallation_directory
))
3931 Lisp_Object tem
, tem1
, sitelisp
;
3933 /* Remove site-lisp dirs from path temporarily and store
3934 them in sitelisp, then conc them on at the end so
3935 they're always first in path. */
3939 tem
= Fcar (Vload_path
);
3940 tem1
= Fstring_match (build_string ("site-lisp"),
3944 Vload_path
= Fcdr (Vload_path
);
3945 sitelisp
= Fcons (tem
, sitelisp
);
3951 /* Add to the path the lisp subdir of the
3952 installation dir, if it exists. */
3953 tem
= Fexpand_file_name (build_string ("lisp"),
3954 Vinstallation_directory
);
3955 tem1
= Ffile_exists_p (tem
);
3958 if (NILP (Fmember (tem
, Vload_path
)))
3960 turn_off_warning
= 1;
3961 Vload_path
= Fcons (tem
, Vload_path
);
3965 /* That dir doesn't exist, so add the build-time
3966 Lisp dirs instead. */
3967 Vload_path
= nconc2 (Vload_path
, dump_path
);
3969 /* Add leim under the installation dir, if it exists. */
3970 tem
= Fexpand_file_name (build_string ("leim"),
3971 Vinstallation_directory
);
3972 tem1
= Ffile_exists_p (tem
);
3975 if (NILP (Fmember (tem
, Vload_path
)))
3976 Vload_path
= Fcons (tem
, Vload_path
);
3979 /* Add site-lisp under the installation dir, if it exists. */
3980 tem
= Fexpand_file_name (build_string ("site-lisp"),
3981 Vinstallation_directory
);
3982 tem1
= Ffile_exists_p (tem
);
3985 if (NILP (Fmember (tem
, Vload_path
)))
3986 Vload_path
= Fcons (tem
, Vload_path
);
3989 /* If Emacs was not built in the source directory,
3990 and it is run from where it was built, add to load-path
3991 the lisp, leim and site-lisp dirs under that directory. */
3993 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3997 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3998 Vinstallation_directory
);
3999 tem1
= Ffile_exists_p (tem
);
4001 /* Don't be fooled if they moved the entire source tree
4002 AFTER dumping Emacs. If the build directory is indeed
4003 different from the source dir, src/Makefile.in and
4004 src/Makefile will not be found together. */
4005 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4006 Vinstallation_directory
);
4007 tem2
= Ffile_exists_p (tem
);
4008 if (!NILP (tem1
) && NILP (tem2
))
4010 tem
= Fexpand_file_name (build_string ("lisp"),
4013 if (NILP (Fmember (tem
, Vload_path
)))
4014 Vload_path
= Fcons (tem
, Vload_path
);
4016 tem
= Fexpand_file_name (build_string ("leim"),
4019 if (NILP (Fmember (tem
, Vload_path
)))
4020 Vload_path
= Fcons (tem
, Vload_path
);
4022 tem
= Fexpand_file_name (build_string ("site-lisp"),
4025 if (NILP (Fmember (tem
, Vload_path
)))
4026 Vload_path
= Fcons (tem
, Vload_path
);
4029 if (!NILP (sitelisp
) && !no_site_lisp
)
4030 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4036 /* NORMAL refers to the lisp dir in the source directory. */
4037 /* We used to add ../lisp at the front here, but
4038 that caused trouble because it was copied from dump_path
4039 into Vload_path, above, when Vinstallation_directory was non-nil.
4040 It should be unnecessary. */
4041 Vload_path
= decode_env_path (0, normal
);
4042 dump_path
= Vload_path
;
4046 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4047 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4048 almost never correct, thereby causing a warning to be printed out that
4049 confuses users. Since PATH_LOADSEARCH is always overridden by the
4050 EMACSLOADPATH environment variable below, disable the warning on NT. */
4052 /* Warn if dirs in the *standard* path don't exist. */
4053 if (!turn_off_warning
)
4055 Lisp_Object path_tail
;
4057 for (path_tail
= Vload_path
;
4059 path_tail
= XCDR (path_tail
))
4061 Lisp_Object dirfile
;
4062 dirfile
= Fcar (path_tail
);
4063 if (STRINGP (dirfile
))
4065 dirfile
= Fdirectory_file_name (dirfile
);
4066 if (access (SSDATA (dirfile
), 0) < 0)
4067 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4072 #endif /* !(WINDOWSNT || HAVE_NS) */
4074 /* If the EMACSLOADPATH environment variable is set, use its value.
4075 This doesn't apply if we're dumping. */
4077 if (NILP (Vpurify_flag
)
4078 && egetenv ("EMACSLOADPATH"))
4080 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4084 load_in_progress
= 0;
4085 Vload_file_name
= Qnil
;
4087 load_descriptor_list
= Qnil
;
4089 Vstandard_input
= Qt
;
4090 Vloads_in_progress
= Qnil
;
4093 /* Print a warning, using format string FORMAT, that directory DIRNAME
4094 does not exist. Print it on stderr and put it in *Messages*. */
4097 dir_warning (const char *format
, Lisp_Object dirname
)
4100 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4102 fprintf (stderr
, format
, SDATA (dirname
));
4103 sprintf (buffer
, format
, SDATA (dirname
));
4104 /* Don't log the warning before we've initialized!! */
4106 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4110 syms_of_lread (void)
4113 defsubr (&Sread_from_string
);
4115 defsubr (&Sintern_soft
);
4116 defsubr (&Sunintern
);
4117 defsubr (&Sget_load_suffixes
);
4119 defsubr (&Seval_buffer
);
4120 defsubr (&Seval_region
);
4121 defsubr (&Sread_char
);
4122 defsubr (&Sread_char_exclusive
);
4123 defsubr (&Sread_event
);
4124 defsubr (&Sget_file_char
);
4125 defsubr (&Smapatoms
);
4126 defsubr (&Slocate_file_internal
);
4128 DEFVAR_LISP ("obarray", Vobarray
,
4129 doc
: /* Symbol table for use by `intern' and `read'.
4130 It is a vector whose length ought to be prime for best results.
4131 The vector's contents don't make sense if examined from Lisp programs;
4132 to find all the symbols in an obarray, use `mapatoms'. */);
4134 DEFVAR_LISP ("values", Vvalues
,
4135 doc
: /* List of values of all expressions which were read, evaluated and printed.
4136 Order is reverse chronological. */);
4138 DEFVAR_LISP ("standard-input", Vstandard_input
,
4139 doc
: /* Stream for read to get input from.
4140 See documentation of `read' for possible values. */);
4141 Vstandard_input
= Qt
;
4143 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4144 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4146 If this variable is a buffer, then only forms read from that buffer
4147 will be added to `read-symbol-positions-list'.
4148 If this variable is t, then all read forms will be added.
4149 The effect of all other values other than nil are not currently
4150 defined, although they may be in the future.
4152 The positions are relative to the last call to `read' or
4153 `read-from-string'. It is probably a bad idea to set this variable at
4154 the toplevel; bind it instead. */);
4155 Vread_with_symbol_positions
= Qnil
;
4157 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4158 doc
: /* A list mapping read symbols to their positions.
4159 This variable is modified during calls to `read' or
4160 `read-from-string', but only when `read-with-symbol-positions' is
4163 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4164 CHAR-POSITION is an integer giving the offset of that occurrence of the
4165 symbol from the position where `read' or `read-from-string' started.
4167 Note that a symbol will appear multiple times in this list, if it was
4168 read multiple times. The list is in the same order as the symbols
4170 Vread_symbol_positions_list
= Qnil
;
4172 DEFVAR_LISP ("read-circle", Vread_circle
,
4173 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4176 DEFVAR_LISP ("load-path", Vload_path
,
4177 doc
: /* *List of directories to search for files to load.
4178 Each element is a string (directory name) or nil (try default directory).
4179 Initialized based on EMACSLOADPATH environment variable, if any,
4180 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4182 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4183 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4184 This list should not include the empty string.
4185 `load' and related functions try to append these suffixes, in order,
4186 to the specified file name if a Lisp suffix is allowed or required. */);
4187 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4188 Fcons (make_pure_c_string (".el"), Qnil
));
4189 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4190 doc
: /* List of suffixes that indicate representations of \
4192 This list should normally start with the empty string.
4194 Enabling Auto Compression mode appends the suffixes in
4195 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4196 mode removes them again. `load' and related functions use this list to
4197 determine whether they should look for compressed versions of a file
4198 and, if so, which suffixes they should try to append to the file name
4199 in order to do so. However, if you want to customize which suffixes
4200 the loading functions recognize as compression suffixes, you should
4201 customize `jka-compr-load-suffixes' rather than the present variable. */);
4202 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4204 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4205 doc
: /* Non-nil if inside of `load'. */);
4206 Qload_in_progress
= intern_c_string ("load-in-progress");
4207 staticpro (&Qload_in_progress
);
4209 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4210 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4211 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4213 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4214 a symbol \(a feature name).
4216 When `load' is run and the file-name argument matches an element's
4217 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4218 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4220 An error in FORMS does not undo the load, but does prevent execution of
4221 the rest of the FORMS. */);
4222 Vafter_load_alist
= Qnil
;
4224 DEFVAR_LISP ("load-history", Vload_history
,
4225 doc
: /* Alist mapping loaded file names to symbols and features.
4226 Each alist element should be a list (FILE-NAME ENTRIES...), where
4227 FILE-NAME is the name of a file that has been loaded into Emacs.
4228 The file name is absolute and true (i.e. it doesn't contain symlinks).
4229 As an exception, one of the alist elements may have FILE-NAME nil,
4230 for symbols and features not associated with any file.
4232 The remaining ENTRIES in the alist element describe the functions and
4233 variables defined in that file, the features provided, and the
4234 features required. Each entry has the form `(provide . FEATURE)',
4235 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4236 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4237 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4238 SYMBOL was an autoload before this file redefined it as a function.
4240 During preloading, the file name recorded is relative to the main Lisp
4241 directory. These file names are converted to absolute at startup. */);
4242 Vload_history
= Qnil
;
4244 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4245 doc
: /* Full name of file being loaded by `load'. */);
4246 Vload_file_name
= Qnil
;
4248 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4249 doc
: /* File name, including directory, of user's initialization file.
4250 If the file loaded had extension `.elc', and the corresponding source file
4251 exists, this variable contains the name of source file, suitable for use
4252 by functions like `custom-save-all' which edit the init file.
4253 While Emacs loads and evaluates the init file, value is the real name
4254 of the file, regardless of whether or not it has the `.elc' extension. */);
4255 Vuser_init_file
= Qnil
;
4257 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4258 doc
: /* Used for internal purposes by `load'. */);
4259 Vcurrent_load_list
= Qnil
;
4261 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4262 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4263 The default is nil, which means use the function `read'. */);
4264 Vload_read_function
= Qnil
;
4266 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4267 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4268 This function is for doing code conversion before reading the source file.
4269 If nil, loading is done without any code conversion.
4270 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4271 FULLNAME is the full name of FILE.
4272 See `load' for the meaning of the remaining arguments. */);
4273 Vload_source_file_function
= Qnil
;
4275 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4276 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4277 This is useful when the file being loaded is a temporary copy. */);
4278 load_force_doc_strings
= 0;
4280 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4281 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4282 This is normally bound by `load' and `eval-buffer' to control `read',
4283 and is not meant for users to change. */);
4284 load_convert_to_unibyte
= 0;
4286 DEFVAR_LISP ("source-directory", Vsource_directory
,
4287 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4288 You cannot count on them to still be there! */);
4290 = Fexpand_file_name (build_string ("../"),
4291 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4293 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4294 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4295 Vpreloaded_file_list
= Qnil
;
4297 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4298 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4299 Vbyte_boolean_vars
= Qnil
;
4301 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4302 doc
: /* Non-nil means load dangerous compiled Lisp files.
4303 Some versions of XEmacs use different byte codes than Emacs. These
4304 incompatible byte codes can make Emacs crash when it tries to execute
4306 load_dangerous_libraries
= 0;
4308 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4309 doc
: /* Non-nil means force printing messages when loading Lisp files.
4310 This overrides the value of the NOMESSAGE argument to `load'. */);
4311 force_load_messages
= 0;
4313 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4314 doc
: /* Regular expression matching safe to load compiled Lisp files.
4315 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4316 from the file, and matches them against this regular expression.
4317 When the regular expression matches, the file is considered to be safe
4318 to load. See also `load-dangerous-libraries'. */);
4319 Vbytecomp_version_regexp
4320 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4322 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4323 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4324 Veval_buffer_list
= Qnil
;
4326 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4327 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4328 Vold_style_backquotes
= Qnil
;
4329 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4330 staticpro (&Qold_style_backquotes
);
4332 /* Vsource_directory was initialized in init_lread. */
4334 load_descriptor_list
= Qnil
;
4335 staticpro (&load_descriptor_list
);
4337 Qcurrent_load_list
= intern_c_string ("current-load-list");
4338 staticpro (&Qcurrent_load_list
);
4340 Qstandard_input
= intern_c_string ("standard-input");
4341 staticpro (&Qstandard_input
);
4343 Qread_char
= intern_c_string ("read-char");
4344 staticpro (&Qread_char
);
4346 Qget_file_char
= intern_c_string ("get-file-char");
4347 staticpro (&Qget_file_char
);
4349 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4350 staticpro (&Qget_emacs_mule_file_char
);
4352 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4353 staticpro (&Qload_force_doc_strings
);
4355 Qbackquote
= intern_c_string ("`");
4356 staticpro (&Qbackquote
);
4357 Qcomma
= intern_c_string (",");
4358 staticpro (&Qcomma
);
4359 Qcomma_at
= intern_c_string (",@");
4360 staticpro (&Qcomma_at
);
4361 Qcomma_dot
= intern_c_string (",.");
4362 staticpro (&Qcomma_dot
);
4364 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4365 staticpro (&Qinhibit_file_name_operation
);
4367 Qascii_character
= intern_c_string ("ascii-character");
4368 staticpro (&Qascii_character
);
4370 Qfunction
= intern_c_string ("function");
4371 staticpro (&Qfunction
);
4373 Qload
= intern_c_string ("load");
4376 Qload_file_name
= intern_c_string ("load-file-name");
4377 staticpro (&Qload_file_name
);
4379 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4380 staticpro (&Qeval_buffer_list
);
4382 Qfile_truename
= intern_c_string ("file-truename");
4383 staticpro (&Qfile_truename
) ;
4385 Qdir_ok
= intern_c_string ("dir-ok");
4386 staticpro (&Qdir_ok
);
4388 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4389 staticpro (&Qdo_after_load_evaluation
) ;
4391 staticpro (&dump_path
);
4393 staticpro (&read_objects
);
4394 read_objects
= Qnil
;
4395 staticpro (&seen_list
);
4398 Vloads_in_progress
= Qnil
;
4399 staticpro (&Vloads_in_progress
);
4401 Qhash_table
= intern_c_string ("hash-table");
4402 staticpro (&Qhash_table
);
4403 Qdata
= intern_c_string ("data");
4405 Qtest
= intern_c_string ("test");
4407 Qsize
= intern_c_string ("size");
4409 Qweakness
= intern_c_string ("weakness");
4410 staticpro (&Qweakness
);
4411 Qrehash_size
= intern_c_string ("rehash-size");
4412 staticpro (&Qrehash_size
);
4413 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4414 staticpro (&Qrehash_threshold
);