1 /* Lisp parsing and input streams.
3 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997,
4 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 2009, 2010, 2011 Free Software Foundation, Inc.
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 #include <sys/types.h>
31 #include "intervals.h"
33 #include "character.h"
40 #include "termhooks.h"
42 #include "blockinput.h"
53 #endif /* HAVE_SETLOCALE */
58 #define file_offset off_t
59 #define file_tell ftello
61 #define file_offset long
62 #define file_tell ftell
65 /* hash table read constants */
66 Lisp_Object Qhash_table
, Qdata
;
67 Lisp_Object Qtest
, Qsize
;
68 Lisp_Object Qweakness
;
69 Lisp_Object Qrehash_size
;
70 Lisp_Object Qrehash_threshold
;
72 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
73 Lisp_Object Qvariable_documentation
;
74 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
75 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
76 Lisp_Object Qinhibit_file_name_operation
;
77 Lisp_Object Qeval_buffer_list
;
78 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
80 /* Used instead of Qget_file_char while loading *.elc files compiled
81 by Emacs 21 or older. */
82 static Lisp_Object Qget_emacs_mule_file_char
;
84 static Lisp_Object Qload_force_doc_strings
;
86 static Lisp_Object Qload_in_progress
;
88 /* The association list of objects read with the #n=object form.
89 Each member of the list has the form (n . object), and is used to
90 look up the object for the corresponding #n# construct.
91 It must be set to nil before all top-level calls to read0. */
92 Lisp_Object read_objects
;
94 /* Nonzero means READCHAR should read bytes one by one (not character)
95 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
96 This is set to 1 by read1 temporarily while handling #@NUMBER. */
97 static int load_each_byte
;
99 /* List of descriptors now open for Fload. */
100 static Lisp_Object load_descriptor_list
;
102 /* File for get_file_char to read from. Use by load. */
103 static FILE *instream
;
105 /* When nonzero, read conses in pure space */
106 static int read_pure
;
108 /* For use within read-from-string (this reader is non-reentrant!!) */
109 static EMACS_INT read_from_string_index
;
110 static EMACS_INT read_from_string_index_byte
;
111 static EMACS_INT read_from_string_limit
;
113 /* Number of characters read in the current call to Fread or
114 Fread_from_string. */
115 static EMACS_INT readchar_count
;
117 /* This contains the last string skipped with #@. */
118 static char *saved_doc_string
;
119 /* Length of buffer allocated in saved_doc_string. */
120 static int saved_doc_string_size
;
121 /* Length of actual data in saved_doc_string. */
122 static int saved_doc_string_length
;
123 /* This is the file position that string came from. */
124 static file_offset saved_doc_string_position
;
126 /* This contains the previous string skipped with #@.
127 We copy it from saved_doc_string when a new string
128 is put in saved_doc_string. */
129 static char *prev_saved_doc_string
;
130 /* Length of buffer allocated in prev_saved_doc_string. */
131 static int prev_saved_doc_string_size
;
132 /* Length of actual data in prev_saved_doc_string. */
133 static int prev_saved_doc_string_length
;
134 /* This is the file position that string came from. */
135 static file_offset prev_saved_doc_string_position
;
137 /* Nonzero means inside a new-style backquote
138 with no surrounding parentheses.
139 Fread initializes this to zero, so we need not specbind it
140 or worry about what happens to it when there is an error. */
141 static int new_backquote_flag
;
142 static Lisp_Object Qold_style_backquotes
;
144 /* A list of file names for files being loaded in Fload. Used to
145 check for recursive loads. */
147 static Lisp_Object Vloads_in_progress
;
149 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object
),
152 static void readevalloop (Lisp_Object
, FILE*, Lisp_Object
,
153 Lisp_Object (*) (Lisp_Object
), int,
154 Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
);
156 static Lisp_Object
load_unwind (Lisp_Object
);
157 static Lisp_Object
load_descriptor_unwind (Lisp_Object
);
159 static void invalid_syntax (const char *, int) NO_RETURN
;
160 static void end_of_file_error (void) NO_RETURN
;
163 /* Functions that read one byte from the current source READCHARFUN
164 or unreads one byte. If the integer argument C is -1, it returns
165 one read byte, or -1 when there's no more byte in the source. If C
166 is 0 or positive, it unreads C, and the return value is not
169 static int readbyte_for_lambda (int, Lisp_Object
);
170 static int readbyte_from_file (int, Lisp_Object
);
171 static int readbyte_from_string (int, Lisp_Object
);
173 /* Handle unreading and rereading of characters.
174 Write READCHAR to read a character,
175 UNREAD(c) to unread c to be read again.
177 These macros correctly read/unread multibyte characters. */
179 #define READCHAR readchar (readcharfun, NULL)
180 #define UNREAD(c) unreadchar (readcharfun, c)
182 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
183 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
185 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
186 Qlambda, or a cons, we use this to keep an unread character because
187 a file stream can't handle multibyte-char unreading. The value -1
188 means that there's no unread character. */
189 static int unread_char
;
192 readchar (Lisp_Object readcharfun
, int *multibyte
)
196 int (*readbyte
) (int, Lisp_Object
);
197 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
199 int emacs_mule_encoding
= 0;
206 if (BUFFERP (readcharfun
))
208 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
210 EMACS_INT pt_byte
= BUF_PT_BYTE (inbuffer
);
212 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
215 if (! NILP (inbuffer
->enable_multibyte_characters
))
217 /* Fetch the character code from the buffer. */
218 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
219 BUF_INC_POS (inbuffer
, pt_byte
);
226 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
227 if (! ASCII_BYTE_P (c
))
228 c
= BYTE8_TO_CHAR (c
);
231 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
235 if (MARKERP (readcharfun
))
237 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
239 EMACS_INT bytepos
= marker_byte_position (readcharfun
);
241 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
244 if (! NILP (inbuffer
->enable_multibyte_characters
))
246 /* Fetch the character code from the buffer. */
247 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
248 BUF_INC_POS (inbuffer
, bytepos
);
255 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
256 if (! ASCII_BYTE_P (c
))
257 c
= BYTE8_TO_CHAR (c
);
261 XMARKER (readcharfun
)->bytepos
= bytepos
;
262 XMARKER (readcharfun
)->charpos
++;
267 if (EQ (readcharfun
, Qlambda
))
269 readbyte
= readbyte_for_lambda
;
273 if (EQ (readcharfun
, Qget_file_char
))
275 readbyte
= readbyte_from_file
;
279 if (STRINGP (readcharfun
))
281 if (read_from_string_index
>= read_from_string_limit
)
283 else if (STRING_MULTIBYTE (readcharfun
))
287 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
288 read_from_string_index
,
289 read_from_string_index_byte
);
293 c
= SREF (readcharfun
, read_from_string_index_byte
);
294 read_from_string_index
++;
295 read_from_string_index_byte
++;
300 if (CONSP (readcharfun
))
302 /* This is the case that read_vector is reading from a unibyte
303 string that contains a byte sequence previously skipped
304 because of #@NUMBER. The car part of readcharfun is that
305 string, and the cdr part is a value of readcharfun given to
307 readbyte
= readbyte_from_string
;
308 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
309 emacs_mule_encoding
= 1;
313 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
315 readbyte
= readbyte_from_file
;
316 emacs_mule_encoding
= 1;
320 tem
= call0 (readcharfun
);
327 if (unread_char
>= 0)
333 c
= (*readbyte
) (-1, readcharfun
);
334 if (c
< 0 || load_each_byte
)
338 if (ASCII_BYTE_P (c
))
340 if (emacs_mule_encoding
)
341 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
344 len
= BYTES_BY_CHAR_HEAD (c
);
347 c
= (*readbyte
) (-1, readcharfun
);
348 if (c
< 0 || ! TRAILING_CODE_P (c
))
351 (*readbyte
) (buf
[i
], readcharfun
);
352 return BYTE8_TO_CHAR (buf
[0]);
356 return STRING_CHAR (buf
);
359 /* Unread the character C in the way appropriate for the stream READCHARFUN.
360 If the stream is a user function, call it with the char as argument. */
363 unreadchar (Lisp_Object readcharfun
, int c
)
367 /* Don't back up the pointer if we're unreading the end-of-input mark,
368 since readchar didn't advance it when we read it. */
370 else if (BUFFERP (readcharfun
))
372 struct buffer
*b
= XBUFFER (readcharfun
);
373 EMACS_INT bytepos
= BUF_PT_BYTE (b
);
376 if (! NILP (b
->enable_multibyte_characters
))
377 BUF_DEC_POS (b
, bytepos
);
381 BUF_PT_BYTE (b
) = bytepos
;
383 else if (MARKERP (readcharfun
))
385 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
386 EMACS_INT bytepos
= XMARKER (readcharfun
)->bytepos
;
388 XMARKER (readcharfun
)->charpos
--;
389 if (! NILP (b
->enable_multibyte_characters
))
390 BUF_DEC_POS (b
, bytepos
);
394 XMARKER (readcharfun
)->bytepos
= bytepos
;
396 else if (STRINGP (readcharfun
))
398 read_from_string_index
--;
399 read_from_string_index_byte
400 = string_char_to_byte (readcharfun
, read_from_string_index
);
402 else if (CONSP (readcharfun
))
406 else if (EQ (readcharfun
, Qlambda
))
410 else if (EQ (readcharfun
, Qget_file_char
)
411 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
416 ungetc (c
, instream
);
423 call1 (readcharfun
, make_number (c
));
427 readbyte_for_lambda (int c
, Lisp_Object readcharfun
)
429 return read_bytecode_char (c
>= 0);
434 readbyte_from_file (int c
, Lisp_Object readcharfun
)
439 ungetc (c
, instream
);
448 /* Interrupted reads have been observed while reading over the network */
449 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
461 return (c
== EOF
? -1 : c
);
465 readbyte_from_string (int c
, Lisp_Object readcharfun
)
467 Lisp_Object string
= XCAR (readcharfun
);
471 read_from_string_index
--;
472 read_from_string_index_byte
473 = string_char_to_byte (string
, read_from_string_index
);
476 if (read_from_string_index
>= read_from_string_limit
)
479 FETCH_STRING_CHAR_ADVANCE (c
, string
,
480 read_from_string_index
,
481 read_from_string_index_byte
);
486 /* Read one non-ASCII character from INSTREAM. The character is
487 encoded in `emacs-mule' and the first byte is already read in
491 read_emacs_mule_char (int c
, int (*readbyte
) (int, Lisp_Object
), Lisp_Object readcharfun
)
493 /* Emacs-mule coding uses at most 4-byte for one character. */
494 unsigned char buf
[4];
495 int len
= emacs_mule_bytes
[c
];
496 struct charset
*charset
;
501 /* C is not a valid leading-code of `emacs-mule'. */
502 return BYTE8_TO_CHAR (c
);
508 c
= (*readbyte
) (-1, readcharfun
);
512 (*readbyte
) (buf
[i
], readcharfun
);
513 return BYTE8_TO_CHAR (buf
[0]);
520 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
521 code
= buf
[1] & 0x7F;
525 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
526 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
528 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
529 code
= buf
[2] & 0x7F;
533 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[0]]);
534 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
539 charset
= CHARSET_FROM_ID (emacs_mule_charset
[buf
[1]]);
540 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
542 c
= DECODE_CHAR (charset
, code
);
544 Fsignal (Qinvalid_read_syntax
,
545 Fcons (build_string ("invalid multibyte form"), Qnil
));
550 static Lisp_Object
read_internal_start (Lisp_Object
, Lisp_Object
,
552 static Lisp_Object
read0 (Lisp_Object
);
553 static Lisp_Object
read1 (Lisp_Object
, int *, int);
555 static Lisp_Object
read_list (int, Lisp_Object
);
556 static Lisp_Object
read_vector (Lisp_Object
, int);
558 static Lisp_Object
substitute_object_recurse (Lisp_Object
, Lisp_Object
,
560 static void substitute_object_in_subtree (Lisp_Object
,
562 static void substitute_in_interval (INTERVAL
, Lisp_Object
);
565 /* Get a character from the tty. */
567 /* Read input events until we get one that's acceptable for our purposes.
569 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
570 until we get a character we like, and then stuffed into
573 If ASCII_REQUIRED is non-zero, we check function key events to see
574 if the unmodified version of the symbol has a Qascii_character
575 property, and use that character, if present.
577 If ERROR_NONASCII is non-zero, we signal an error if the input we
578 get isn't an ASCII character with modifiers. If it's zero but
579 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
582 If INPUT_METHOD is nonzero, we invoke the current input method
583 if the character warrants that.
585 If SECONDS is a number, we wait that many seconds for input, and
586 return Qnil if no input arrives within that time. */
589 read_filtered_event (int no_switch_frame
, int ascii_required
,
590 int error_nonascii
, int input_method
, Lisp_Object seconds
)
592 Lisp_Object val
, delayed_switch_frame
;
595 #ifdef HAVE_WINDOW_SYSTEM
596 if (display_hourglass_p
)
600 delayed_switch_frame
= Qnil
;
602 /* Compute timeout. */
603 if (NUMBERP (seconds
))
605 EMACS_TIME wait_time
;
607 double duration
= extract_float (seconds
);
609 sec
= (int) duration
;
610 usec
= (duration
- sec
) * 1000000;
611 EMACS_GET_TIME (end_time
);
612 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
613 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
616 /* Read until we get an acceptable event. */
619 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
620 NUMBERP (seconds
) ? &end_time
: NULL
);
621 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
626 /* switch-frame events are put off until after the next ASCII
627 character. This is better than signaling an error just because
628 the last characters were typed to a separate minibuffer frame,
629 for example. Eventually, some code which can deal with
630 switch-frame events will read it and process it. */
632 && EVENT_HAS_PARAMETERS (val
)
633 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
635 delayed_switch_frame
= val
;
639 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
641 /* Convert certain symbols to their ASCII equivalents. */
644 Lisp_Object tem
, tem1
;
645 tem
= Fget (val
, Qevent_symbol_element_mask
);
648 tem1
= Fget (Fcar (tem
), Qascii_character
);
649 /* Merge this symbol's modifier bits
650 with the ASCII equivalent of its basic code. */
652 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
656 /* If we don't have a character now, deal with it appropriately. */
661 Vunread_command_events
= Fcons (val
, Qnil
);
662 error ("Non-character input-event");
669 if (! NILP (delayed_switch_frame
))
670 unread_switch_frame
= delayed_switch_frame
;
674 #ifdef HAVE_WINDOW_SYSTEM
675 if (display_hourglass_p
)
684 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
685 doc
: /* Read a character from the command input (keyboard or macro).
686 It is returned as a number.
687 If the character has modifiers, they are resolved and reflected to the
688 character code if possible (e.g. C-SPC -> 0).
690 If the user generates an event which is not a character (i.e. a mouse
691 click or function key event), `read-char' signals an error. As an
692 exception, switch-frame events are put off until non-character events
694 If you want to read non-character events, or ignore them, call
695 `read-event' or `read-char-exclusive' instead.
697 If the optional argument PROMPT is non-nil, display that as a prompt.
698 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
699 input method is turned on in the current buffer, that input method
700 is used for reading a character.
701 If the optional argument SECONDS is non-nil, it should be a number
702 specifying the maximum number of seconds to wait for input. If no
703 input arrives in that time, return nil. SECONDS may be a
704 floating-point value. */)
705 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
710 message_with_string ("%s", prompt
, 0);
711 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
713 return (NILP (val
) ? Qnil
714 : make_number (char_resolve_modifier_mask (XINT (val
))));
717 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
718 doc
: /* Read an event object from the input stream.
719 If the optional argument PROMPT is non-nil, display that as a prompt.
720 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
721 input method is turned on in the current buffer, that input method
722 is used for reading a character.
723 If the optional argument SECONDS is non-nil, it should be a number
724 specifying the maximum number of seconds to wait for input. If no
725 input arrives in that time, return nil. SECONDS may be a
726 floating-point value. */)
727 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
730 message_with_string ("%s", prompt
, 0);
731 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
734 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
735 doc
: /* Read a character from the command input (keyboard or macro).
736 It is returned as a number. Non-character events are ignored.
737 If the character has modifiers, they are resolved and reflected to the
738 character code if possible (e.g. C-SPC -> 0).
740 If the optional argument PROMPT is non-nil, display that as a prompt.
741 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
742 input method is turned on in the current buffer, that input method
743 is used for reading a character.
744 If the optional argument SECONDS is non-nil, it should be a number
745 specifying the maximum number of seconds to wait for input. If no
746 input arrives in that time, return nil. SECONDS may be a
747 floating-point value. */)
748 (Lisp_Object prompt
, Lisp_Object inherit_input_method
, Lisp_Object seconds
)
753 message_with_string ("%s", prompt
, 0);
755 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
757 return (NILP (val
) ? Qnil
758 : make_number (char_resolve_modifier_mask (XINT (val
))));
761 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
762 doc
: /* Don't use this yourself. */)
765 register Lisp_Object val
;
767 XSETINT (val
, getc (instream
));
774 /* Value is a version number of byte compiled code if the file
775 associated with file descriptor FD is a compiled Lisp file that's
776 safe to load. Only files compiled with Emacs are safe to load.
777 Files compiled with XEmacs can lead to a crash in Fbyte_code
778 because of an incompatible change in the byte compiler. */
781 safe_to_load_p (int fd
)
788 /* Read the first few bytes from the file, and look for a line
789 specifying the byte compiler version used. */
790 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
795 /* Skip to the next newline, skipping over the initial `ELC'
796 with NUL bytes following it, but note the version. */
797 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
802 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
809 lseek (fd
, 0, SEEK_SET
);
814 /* Callback for record_unwind_protect. Restore the old load list OLD,
815 after loading a file successfully. */
818 record_load_unwind (Lisp_Object old
)
820 return Vloads_in_progress
= old
;
823 /* This handler function is used via internal_condition_case_1. */
826 load_error_handler (Lisp_Object data
)
832 load_warn_old_style_backquotes (Lisp_Object file
)
834 if (!NILP (Vold_style_backquotes
))
837 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
844 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
845 doc
: /* Return the suffixes that `load' should try if a suffix is \
847 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
850 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
851 while (CONSP (suffixes
))
853 Lisp_Object exts
= Vload_file_rep_suffixes
;
854 suffix
= XCAR (suffixes
);
855 suffixes
= XCDR (suffixes
);
860 lst
= Fcons (concat2 (suffix
, ext
), lst
);
863 return Fnreverse (lst
);
866 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
867 doc
: /* Execute a file of Lisp code named FILE.
868 First try FILE with `.elc' appended, then try with `.el',
869 then try FILE unmodified (the exact suffixes in the exact order are
870 determined by `load-suffixes'). Environment variable references in
871 FILE are replaced with their values by calling `substitute-in-file-name'.
872 This function searches the directories in `load-path'.
874 If optional second arg NOERROR is non-nil,
875 report no error if FILE doesn't exist.
876 Print messages at start and end of loading unless
877 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
879 If optional fourth arg NOSUFFIX is non-nil, don't try adding
880 suffixes `.elc' or `.el' to the specified name FILE.
881 If optional fifth arg MUST-SUFFIX is non-nil, insist on
882 the suffix `.elc' or `.el'; don't accept just FILE unless
883 it ends in one of those suffixes or includes a directory name.
885 If this function fails to find a file, it may look for different
886 representations of that file before trying another file.
887 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
888 to the file name. Emacs uses this feature mainly to find compressed
889 versions of files when Auto Compression mode is enabled.
891 The exact suffixes that this function tries out, in the exact order,
892 are given by the value of the variable `load-file-rep-suffixes' if
893 NOSUFFIX is non-nil and by the return value of the function
894 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
895 MUST-SUFFIX are nil, this function first tries out the latter suffixes
898 Loading a file records its definitions, and its `provide' and
899 `require' calls, in an element of `load-history' whose
900 car is the file name loaded. See `load-history'.
902 While the file is in the process of being loaded, the variable
903 `load-in-progress' is non-nil and the variable `load-file-name'
904 is bound to the file's name.
906 Return t if the file exists and loads successfully. */)
907 (Lisp_Object file
, Lisp_Object noerror
, Lisp_Object nomessage
, Lisp_Object nosuffix
, Lisp_Object must_suffix
)
909 register FILE *stream
;
910 register int fd
= -1;
911 int count
= SPECPDL_INDEX ();
912 struct gcpro gcpro1
, gcpro2
, gcpro3
;
913 Lisp_Object found
, efound
, hist_file_name
;
914 /* 1 means we printed the ".el is newer" message. */
916 /* 1 means we are loading a compiled file. */
920 const char *fmode
= "r";
930 /* If file name is magic, call the handler. */
931 /* This shouldn't be necessary any more now that `openp' handles it right.
932 handler = Ffind_file_name_handler (file, Qload);
934 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
936 /* Do this after the handler to avoid
937 the need to gcpro noerror, nomessage and nosuffix.
938 (Below here, we care only whether they are nil or not.)
939 The presence of this call is the result of a historical accident:
940 it used to be in every file-operation and when it got removed
941 everywhere, it accidentally stayed here. Since then, enough people
942 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
943 that it seemed risky to remove. */
944 if (! NILP (noerror
))
946 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
947 Qt
, load_error_handler
);
952 file
= Fsubstitute_in_file_name (file
);
955 /* Avoid weird lossage with null string as arg,
956 since it would try to load a directory as a Lisp file */
957 if (SCHARS (file
) > 0)
959 int size
= SBYTES (file
);
962 GCPRO2 (file
, found
);
964 if (! NILP (must_suffix
))
966 /* Don't insist on adding a suffix if FILE already ends with one. */
968 && !strcmp (SDATA (file
) + size
- 3, ".el"))
971 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
973 /* Don't insist on adding a suffix
974 if the argument includes a directory name. */
975 else if (! NILP (Ffile_name_directory (file
)))
979 fd
= openp (Vload_path
, file
,
980 (!NILP (nosuffix
) ? Qnil
981 : !NILP (must_suffix
) ? Fget_load_suffixes ()
982 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
983 tmp
[1] = Vload_file_rep_suffixes
,
992 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
996 /* Tell startup.el whether or not we found the user's init file. */
997 if (EQ (Qt
, Vuser_init_file
))
998 Vuser_init_file
= found
;
1000 /* If FD is -2, that means openp found a magic file. */
1003 if (NILP (Fequal (found
, file
)))
1004 /* If FOUND is a different file name from FILE,
1005 find its handler even if we have already inhibited
1006 the `load' operation on FILE. */
1007 handler
= Ffind_file_name_handler (found
, Qt
);
1009 handler
= Ffind_file_name_handler (found
, Qload
);
1010 if (! NILP (handler
))
1011 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1014 /* Check if we're stuck in a recursive load cycle.
1016 2000-09-21: It's not possible to just check for the file loaded
1017 being a member of Vloads_in_progress. This fails because of the
1018 way the byte compiler currently works; `provide's are not
1019 evaluated, see font-lock.el/jit-lock.el as an example. This
1020 leads to a certain amount of ``normal'' recursion.
1022 Also, just loading a file recursively is not always an error in
1023 the general case; the second load may do something different. */
1027 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1028 if (!NILP (Fequal (found
, XCAR (tem
))) && (++count
> 3))
1032 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1034 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1035 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1038 /* Get the name for load-history. */
1039 hist_file_name
= (! NILP (Vpurify_flag
)
1040 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1041 tmp
[1] = Ffile_name_nondirectory (found
),
1047 /* Check for the presence of old-style quotes and warn about them. */
1048 specbind (Qold_style_backquotes
, Qnil
);
1049 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1051 if (!memcmp (SDATA (found
) + SBYTES (found
) - 4, ".elc", 4)
1052 || (fd
>= 0 && (version
= safe_to_load_p (fd
)) > 0))
1053 /* Load .elc files directly, but not when they are
1054 remote and have no handler! */
1061 GCPRO3 (file
, found
, hist_file_name
);
1064 && ! (version
= safe_to_load_p (fd
)))
1067 if (!load_dangerous_libraries
)
1071 error ("File `%s' was not compiled in Emacs",
1074 else if (!NILP (nomessage
) && !force_load_messages
)
1075 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1080 efound
= ENCODE_FILE (found
);
1085 stat ((char *)SDATA (efound
), &s1
);
1086 SSET (efound
, SBYTES (efound
) - 1, 0);
1087 result
= stat ((char *)SDATA (efound
), &s2
);
1088 SSET (efound
, SBYTES (efound
) - 1, 'c');
1090 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1092 /* Make the progress messages mention that source is newer. */
1095 /* If we won't print another message, mention this anyway. */
1096 if (!NILP (nomessage
) && !force_load_messages
)
1098 Lisp_Object msg_file
;
1099 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1100 message_with_string ("Source file `%s' newer than byte-compiled file",
1109 /* We are loading a source file (*.el). */
1110 if (!NILP (Vload_source_file_function
))
1116 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1117 NILP (noerror
) ? Qnil
: Qt
,
1118 (NILP (nomessage
) || force_load_messages
) ? Qnil
: Qt
);
1119 return unbind_to (count
, val
);
1123 GCPRO3 (file
, found
, hist_file_name
);
1127 efound
= ENCODE_FILE (found
);
1128 stream
= fopen ((char *) SDATA (efound
), fmode
);
1129 #else /* not WINDOWSNT */
1130 stream
= fdopen (fd
, fmode
);
1131 #endif /* not WINDOWSNT */
1135 error ("Failure to create stdio stream for %s", SDATA (file
));
1138 if (! NILP (Vpurify_flag
))
1139 Vpreloaded_file_list
= Fcons (Fpurecopy(file
), Vpreloaded_file_list
);
1141 if (NILP (nomessage
) || force_load_messages
)
1144 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1147 message_with_string ("Loading %s (source)...", file
, 1);
1149 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1151 else /* The typical case; compiled file newer than source file. */
1152 message_with_string ("Loading %s...", file
, 1);
1155 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1156 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1157 specbind (Qload_file_name
, found
);
1158 specbind (Qinhibit_file_name_operation
, Qnil
);
1159 load_descriptor_list
1160 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1161 specbind (Qload_in_progress
, Qt
);
1162 if (! version
|| version
>= 22)
1163 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1164 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1167 /* We can't handle a file which was compiled with
1168 byte-compile-dynamic by older version of Emacs. */
1169 specbind (Qload_force_doc_strings
, Qt
);
1170 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1171 0, Qnil
, Qnil
, Qnil
, Qnil
);
1173 unbind_to (count
, Qnil
);
1175 /* Run any eval-after-load forms for this file */
1176 if (!NILP (Ffboundp (Qdo_after_load_evaluation
)))
1177 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1181 xfree (saved_doc_string
);
1182 saved_doc_string
= 0;
1183 saved_doc_string_size
= 0;
1185 xfree (prev_saved_doc_string
);
1186 prev_saved_doc_string
= 0;
1187 prev_saved_doc_string_size
= 0;
1189 if (!noninteractive
&& (NILP (nomessage
) || force_load_messages
))
1192 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1195 message_with_string ("Loading %s (source)...done", file
, 1);
1197 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1199 else /* The typical case; compiled file newer than source file. */
1200 message_with_string ("Loading %s...done", file
, 1);
1207 load_unwind (Lisp_Object arg
) /* used as unwind-protect function in load */
1209 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1220 load_descriptor_unwind (Lisp_Object oldlist
)
1222 load_descriptor_list
= oldlist
;
1226 /* Close all descriptors in use for Floads.
1227 This is used when starting a subprocess. */
1230 close_load_descs (void)
1234 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1235 emacs_close (XFASTINT (XCAR (tail
)));
1240 complete_filename_p (Lisp_Object pathname
)
1242 register const unsigned char *s
= SDATA (pathname
);
1243 return (IS_DIRECTORY_SEP (s
[0])
1244 || (SCHARS (pathname
) > 2
1245 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2])));
1248 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1249 doc
: /* Search for FILENAME through PATH.
1250 Returns the file's name in absolute form, or nil if not found.
1251 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1252 file name when searching.
1253 If non-nil, PREDICATE is used instead of `file-readable-p'.
1254 PREDICATE can also be an integer to pass to the access(2) function,
1255 in which case file-name-handlers are ignored. */)
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)
1266 /* Search for a file whose name is STR, looking in directories
1267 in the Lisp list PATH, and trying suffixes from SUFFIX.
1268 On success, returns a file descriptor. On failure, returns -1.
1270 SUFFIXES is a list of strings containing possible suffixes.
1271 The empty suffix is automatically added if the list is empty.
1273 PREDICATE non-nil means don't open the files,
1274 just look for one that satisfies the predicate. In this case,
1275 returns 1 on success. The predicate can be a lisp function or
1276 an integer to pass to `access' (in which case file-name-handlers
1279 If STOREPTR is nonzero, it points to a slot where the name of
1280 the file actually found should be stored as a Lisp string.
1281 nil is stored there on failure.
1283 If the file we find is remote, return -2
1284 but store the found remote file name in *STOREPTR. */
1287 openp (Lisp_Object path
, Lisp_Object str
, Lisp_Object suffixes
, Lisp_Object
*storeptr
, Lisp_Object predicate
)
1292 register char *fn
= buf
;
1295 Lisp_Object filename
;
1297 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1298 Lisp_Object string
, tail
, encoded_fn
;
1299 int max_suffix_len
= 0;
1303 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1305 CHECK_STRING_CAR (tail
);
1306 max_suffix_len
= max (max_suffix_len
,
1307 SBYTES (XCAR (tail
)));
1310 string
= filename
= encoded_fn
= Qnil
;
1311 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1316 if (complete_filename_p (str
))
1319 for (; CONSP (path
); path
= XCDR (path
))
1321 filename
= Fexpand_file_name (str
, XCAR (path
));
1322 if (!complete_filename_p (filename
))
1323 /* If there are non-absolute elts in PATH (eg ".") */
1324 /* Of course, this could conceivably lose if luser sets
1325 default-directory to be something non-absolute... */
1327 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1328 if (!complete_filename_p (filename
))
1329 /* Give up on this path element! */
1333 /* Calculate maximum size of any filename made from
1334 this path element/specified file name and any possible suffix. */
1335 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1336 if (fn_size
< want_size
)
1337 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1339 /* Loop over suffixes. */
1340 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1341 CONSP (tail
); tail
= XCDR (tail
))
1343 int lsuffix
= SBYTES (XCAR (tail
));
1344 Lisp_Object handler
;
1347 /* Concatenate path element/specified name with the suffix.
1348 If the directory starts with /:, remove that. */
1349 if (SCHARS (filename
) > 2
1350 && SREF (filename
, 0) == '/'
1351 && SREF (filename
, 1) == ':')
1353 strncpy (fn
, SDATA (filename
) + 2,
1354 SBYTES (filename
) - 2);
1355 fn
[SBYTES (filename
) - 2] = 0;
1359 strncpy (fn
, SDATA (filename
),
1361 fn
[SBYTES (filename
)] = 0;
1364 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1365 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1367 /* Check that the file exists and is not a directory. */
1368 /* We used to only check for handlers on non-absolute file names:
1372 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1373 It's not clear why that was the case and it breaks things like
1374 (load "/bar.el") where the file is actually "/bar.el.gz". */
1375 string
= build_string (fn
);
1376 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1377 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1379 if (NILP (predicate
))
1380 exists
= !NILP (Ffile_readable_p (string
));
1382 exists
= !NILP (call1 (predicate
, string
));
1383 if (exists
&& !NILP (Ffile_directory_p (string
)))
1388 /* We succeeded; return this descriptor and filename. */
1399 encoded_fn
= ENCODE_FILE (string
);
1400 pfn
= SDATA (encoded_fn
);
1401 exists
= (stat (pfn
, &st
) >= 0
1402 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1405 /* Check that we can access or open it. */
1406 if (NATNUMP (predicate
))
1407 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1409 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1413 /* We succeeded; return this descriptor and filename. */
1431 /* Merge the list we've accumulated of globals from the current input source
1432 into the load_history variable. The details depend on whether
1433 the source has an associated file name or not.
1435 FILENAME is the file name that we are loading from.
1436 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1439 build_load_history (Lisp_Object filename
, int entire
)
1441 register Lisp_Object tail
, prev
, newelt
;
1442 register Lisp_Object tem
, tem2
;
1443 register int foundit
= 0;
1445 tail
= Vload_history
;
1448 while (CONSP (tail
))
1452 /* Find the feature's previous assoc list... */
1453 if (!NILP (Fequal (filename
, Fcar (tem
))))
1457 /* If we're loading the entire file, remove old data. */
1461 Vload_history
= XCDR (tail
);
1463 Fsetcdr (prev
, XCDR (tail
));
1466 /* Otherwise, cons on new symbols that are not already members. */
1469 tem2
= Vcurrent_load_list
;
1471 while (CONSP (tem2
))
1473 newelt
= XCAR (tem2
);
1475 if (NILP (Fmember (newelt
, tem
)))
1476 Fsetcar (tail
, Fcons (XCAR (tem
),
1477 Fcons (newelt
, XCDR (tem
))));
1490 /* If we're loading an entire file, cons the new assoc onto the
1491 front of load-history, the most-recently-loaded position. Also
1492 do this if we didn't find an existing member for the file. */
1493 if (entire
|| !foundit
)
1494 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1499 unreadpure (Lisp_Object junk
) /* Used as unwind-protect function in readevalloop */
1506 readevalloop_1 (Lisp_Object old
)
1508 load_convert_to_unibyte
= ! NILP (old
);
1512 /* Signal an `end-of-file' error, if possible with file name
1516 end_of_file_error (void)
1518 if (STRINGP (Vload_file_name
))
1519 xsignal1 (Qend_of_file
, Vload_file_name
);
1521 xsignal0 (Qend_of_file
);
1524 /* UNIBYTE specifies how to set load_convert_to_unibyte
1525 for this invocation.
1526 READFUN, if non-nil, is used instead of `read'.
1528 START, END specify region to read in current buffer (from eval-region).
1529 If the input is not from a buffer, they must be nil. */
1532 readevalloop (Lisp_Object readcharfun
,
1534 Lisp_Object sourcename
,
1535 Lisp_Object (*evalfun
) (Lisp_Object
),
1537 Lisp_Object unibyte
, Lisp_Object readfun
,
1538 Lisp_Object start
, Lisp_Object end
)
1541 register Lisp_Object val
;
1542 int count
= SPECPDL_INDEX ();
1543 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1544 struct buffer
*b
= 0;
1545 int continue_reading_p
;
1546 /* Nonzero if reading an entire buffer. */
1547 int whole_buffer
= 0;
1548 /* 1 on the first time around. */
1551 if (MARKERP (readcharfun
))
1554 start
= readcharfun
;
1557 if (BUFFERP (readcharfun
))
1558 b
= XBUFFER (readcharfun
);
1559 else if (MARKERP (readcharfun
))
1560 b
= XMARKER (readcharfun
)->buffer
;
1562 /* We assume START is nil when input is not from a buffer. */
1563 if (! NILP (start
) && !b
)
1566 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1567 specbind (Qcurrent_load_list
, Qnil
);
1568 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1569 load_convert_to_unibyte
= !NILP (unibyte
);
1571 GCPRO4 (sourcename
, readfun
, start
, end
);
1573 /* Try to ensure sourcename is a truename, except whilst preloading. */
1574 if (NILP (Vpurify_flag
)
1575 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1576 && !NILP (Ffboundp (Qfile_truename
)))
1577 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1579 LOADHIST_ATTACH (sourcename
);
1581 continue_reading_p
= 1;
1582 while (continue_reading_p
)
1584 int count1
= SPECPDL_INDEX ();
1586 if (b
!= 0 && NILP (b
->name
))
1587 error ("Reading from killed buffer");
1591 /* Switch to the buffer we are reading from. */
1592 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1593 set_buffer_internal (b
);
1595 /* Save point in it. */
1596 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1597 /* Save ZV in it. */
1598 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1599 /* Those get unbound after we read one expression. */
1601 /* Set point and ZV around stuff to be read. */
1604 Fnarrow_to_region (make_number (BEGV
), end
);
1606 /* Just for cleanliness, convert END to a marker
1607 if it is an integer. */
1609 end
= Fpoint_max_marker ();
1612 /* On the first cycle, we can easily test here
1613 whether we are reading the whole buffer. */
1614 if (b
&& first_sexp
)
1615 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1622 while ((c
= READCHAR
) != '\n' && c
!= -1);
1627 unbind_to (count1
, Qnil
);
1631 /* Ignore whitespace here, so we can detect eof. */
1632 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1633 || c
== 0x8a0) /* NBSP */
1636 if (!NILP (Vpurify_flag
) && c
== '(')
1638 record_unwind_protect (unreadpure
, Qnil
);
1639 val
= read_list (-1, readcharfun
);
1644 read_objects
= Qnil
;
1645 if (!NILP (readfun
))
1647 val
= call1 (readfun
, readcharfun
);
1649 /* If READCHARFUN has set point to ZV, we should
1650 stop reading, even if the form read sets point
1651 to a different value when evaluated. */
1652 if (BUFFERP (readcharfun
))
1654 struct buffer
*b
= XBUFFER (readcharfun
);
1655 if (BUF_PT (b
) == BUF_ZV (b
))
1656 continue_reading_p
= 0;
1659 else if (! NILP (Vload_read_function
))
1660 val
= call1 (Vload_read_function
, readcharfun
);
1662 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1665 if (!NILP (start
) && continue_reading_p
)
1666 start
= Fpoint_marker ();
1668 /* Restore saved point and BEGV. */
1669 unbind_to (count1
, Qnil
);
1671 /* Now eval what we just read. */
1672 val
= (*evalfun
) (val
);
1676 Vvalues
= Fcons (val
, Vvalues
);
1677 if (EQ (Vstandard_output
, Qt
))
1686 build_load_history (sourcename
,
1687 stream
|| whole_buffer
);
1691 unbind_to (count
, Qnil
);
1694 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1695 doc
: /* Execute the current buffer as Lisp code.
1696 When called from a Lisp program (i.e., not interactively), this
1697 function accepts up to five optional arguments:
1698 BUFFER is the buffer to evaluate (nil means use current buffer).
1699 PRINTFLAG controls printing of output:
1700 A value of nil means discard it; anything else is stream for print.
1701 FILENAME specifies the file name to use for `load-history'.
1702 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1704 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1705 functions should work normally even if PRINTFLAG is nil.
1707 This function preserves the position of point. */)
1708 (Lisp_Object buffer
, Lisp_Object printflag
, Lisp_Object filename
, Lisp_Object unibyte
, Lisp_Object do_allow_print
)
1710 int count
= SPECPDL_INDEX ();
1711 Lisp_Object tem
, buf
;
1714 buf
= Fcurrent_buffer ();
1716 buf
= Fget_buffer (buffer
);
1718 error ("No such buffer");
1720 if (NILP (printflag
) && NILP (do_allow_print
))
1725 if (NILP (filename
))
1726 filename
= XBUFFER (buf
)->filename
;
1728 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1729 specbind (Qstandard_output
, tem
);
1730 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1731 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1732 readevalloop (buf
, 0, filename
, Feval
,
1733 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1734 unbind_to (count
, Qnil
);
1739 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1740 doc
: /* Execute the region as Lisp code.
1741 When called from programs, expects two arguments,
1742 giving starting and ending indices in the current buffer
1743 of the text to be executed.
1744 Programs can pass third argument PRINTFLAG which controls output:
1745 A value of nil means discard it; anything else is stream for printing it.
1746 Also the fourth argument READ-FUNCTION, if non-nil, is used
1747 instead of `read' to read each expression. It gets one argument
1748 which is the input stream for reading characters.
1750 This function does not move point. */)
1751 (Lisp_Object start
, Lisp_Object end
, Lisp_Object printflag
, Lisp_Object read_function
)
1753 int count
= SPECPDL_INDEX ();
1754 Lisp_Object tem
, cbuf
;
1756 cbuf
= Fcurrent_buffer ();
1758 if (NILP (printflag
))
1762 specbind (Qstandard_output
, tem
);
1763 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1765 /* readevalloop calls functions which check the type of start and end. */
1766 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1767 !NILP (printflag
), Qnil
, read_function
,
1770 return unbind_to (count
, Qnil
);
1774 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1775 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1776 If STREAM is nil, use the value of `standard-input' (which see).
1777 STREAM or the value of `standard-input' may be:
1778 a buffer (read from point and advance it)
1779 a marker (read from where it points and advance it)
1780 a function (call it with no arguments for each character,
1781 call it with a char as argument to push a char back)
1782 a string (takes text from string, starting at the beginning)
1783 t (read text line using minibuffer and use it, or read from
1784 standard input in batch mode). */)
1785 (Lisp_Object stream
)
1788 stream
= Vstandard_input
;
1789 if (EQ (stream
, Qt
))
1790 stream
= Qread_char
;
1791 if (EQ (stream
, Qread_char
))
1792 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1794 return read_internal_start (stream
, Qnil
, Qnil
);
1797 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1798 doc
: /* Read one Lisp expression which is represented as text by STRING.
1799 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1800 START and END optionally delimit a substring of STRING from which to read;
1801 they default to 0 and (length STRING) respectively. */)
1802 (Lisp_Object string
, Lisp_Object start
, Lisp_Object end
)
1805 CHECK_STRING (string
);
1806 /* read_internal_start sets read_from_string_index. */
1807 ret
= read_internal_start (string
, start
, end
);
1808 return Fcons (ret
, make_number (read_from_string_index
));
1811 /* Function to set up the global context we need in toplevel read
1814 read_internal_start (Lisp_Object stream
, Lisp_Object start
, Lisp_Object end
)
1815 /* start, end only used when stream is a string. */
1820 new_backquote_flag
= 0;
1821 read_objects
= Qnil
;
1822 if (EQ (Vread_with_symbol_positions
, Qt
)
1823 || EQ (Vread_with_symbol_positions
, stream
))
1824 Vread_symbol_positions_list
= Qnil
;
1826 if (STRINGP (stream
)
1827 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1829 EMACS_INT startval
, endval
;
1832 if (STRINGP (stream
))
1835 string
= XCAR (stream
);
1838 endval
= SCHARS (string
);
1842 endval
= XINT (end
);
1843 if (endval
< 0 || endval
> SCHARS (string
))
1844 args_out_of_range (string
, end
);
1851 CHECK_NUMBER (start
);
1852 startval
= XINT (start
);
1853 if (startval
< 0 || startval
> endval
)
1854 args_out_of_range (string
, start
);
1856 read_from_string_index
= startval
;
1857 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1858 read_from_string_limit
= endval
;
1861 retval
= read0 (stream
);
1862 if (EQ (Vread_with_symbol_positions
, Qt
)
1863 || EQ (Vread_with_symbol_positions
, stream
))
1864 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1869 /* Signal Qinvalid_read_syntax error.
1870 S is error string of length N (if > 0) */
1873 invalid_syntax (const char *s
, int n
)
1877 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1881 /* Use this for recursive reads, in contexts where internal tokens
1885 read0 (Lisp_Object readcharfun
)
1887 register Lisp_Object val
;
1890 val
= read1 (readcharfun
, &c
, 0);
1894 xsignal1 (Qinvalid_read_syntax
,
1895 Fmake_string (make_number (1), make_number (c
)));
1898 static int read_buffer_size
;
1899 static char *read_buffer
;
1901 /* Read a \-escape sequence, assuming we already read the `\'.
1902 If the escape sequence forces unibyte, return eight-bit char. */
1905 read_escape (Lisp_Object readcharfun
, int stringp
)
1907 register int c
= READCHAR
;
1908 /* \u allows up to four hex digits, \U up to eight. Default to the
1909 behavior for \u, and change this value in the case that \U is seen. */
1910 int unicode_hex_count
= 4;
1915 end_of_file_error ();
1945 error ("Invalid escape character syntax");
1948 c
= read_escape (readcharfun
, 0);
1949 return c
| meta_modifier
;
1954 error ("Invalid escape character syntax");
1957 c
= read_escape (readcharfun
, 0);
1958 return c
| shift_modifier
;
1963 error ("Invalid escape character syntax");
1966 c
= read_escape (readcharfun
, 0);
1967 return c
| hyper_modifier
;
1972 error ("Invalid escape character syntax");
1975 c
= read_escape (readcharfun
, 0);
1976 return c
| alt_modifier
;
1980 if (stringp
|| c
!= '-')
1987 c
= read_escape (readcharfun
, 0);
1988 return c
| super_modifier
;
1993 error ("Invalid escape character syntax");
1997 c
= read_escape (readcharfun
, 0);
1998 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1999 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2000 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2001 return c
| ctrl_modifier
;
2002 /* ASCII control chars are made from letters (both cases),
2003 as well as the non-letters within 0100...0137. */
2004 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2005 return (c
& (037 | ~0177));
2006 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2007 return (c
& (037 | ~0177));
2009 return c
| ctrl_modifier
;
2019 /* An octal escape, as in ANSI C. */
2021 register int i
= c
- '0';
2022 register int count
= 0;
2025 if ((c
= READCHAR
) >= '0' && c
<= '7')
2037 if (i
>= 0x80 && i
< 0x100)
2038 i
= BYTE8_TO_CHAR (i
);
2043 /* A hex escape, as in ANSI C. */
2050 if (c
>= '0' && c
<= '9')
2055 else if ((c
>= 'a' && c
<= 'f')
2056 || (c
>= 'A' && c
<= 'F'))
2059 if (c
>= 'a' && c
<= 'f')
2072 if (count
< 3 && i
>= 0x80)
2073 return BYTE8_TO_CHAR (i
);
2078 /* Post-Unicode-2.0: Up to eight hex chars. */
2079 unicode_hex_count
= 8;
2082 /* A Unicode escape. We only permit them in strings and characters,
2083 not arbitrarily in the source code, as in some other languages. */
2088 while (++count
<= unicode_hex_count
)
2091 /* isdigit and isalpha may be locale-specific, which we don't
2093 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2094 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2095 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2098 error ("Non-hex digit used for Unicode escape");
2103 error ("Non-Unicode character: 0x%x", i
);
2112 /* Read an integer in radix RADIX using READCHARFUN to read
2113 characters. RADIX must be in the interval [2..36]; if it isn't, a
2114 read error is signaled . Value is the integer read. Signals an
2115 error if encountering invalid read syntax or if RADIX is out of
2119 read_integer (Lisp_Object readcharfun
, int radix
)
2121 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2122 /* We use a floating point number because */
2125 if (radix
< 2 || radix
> 36)
2129 number
= ndigits
= invalid_p
= 0;
2145 if (c
>= '0' && c
<= '9')
2147 else if (c
>= 'a' && c
<= 'z')
2148 digit
= c
- 'a' + 10;
2149 else if (c
>= 'A' && c
<= 'Z')
2150 digit
= c
- 'A' + 10;
2157 if (digit
< 0 || digit
>= radix
)
2160 number
= radix
* number
+ digit
;
2166 if (ndigits
== 0 || invalid_p
)
2169 sprintf (buf
, "integer, radix %d", radix
);
2170 invalid_syntax (buf
, 0);
2173 return make_fixnum_or_float (sign
* number
);
2177 /* If the next token is ')' or ']' or '.', we store that character
2178 in *PCH and the return value is not interesting. Else, we store
2179 zero in *PCH and we read and return one lisp object.
2181 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2184 read1 (register Lisp_Object readcharfun
, int *pch
, int first_in_list
)
2187 int uninterned_symbol
= 0;
2195 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2197 end_of_file_error ();
2202 return read_list (0, readcharfun
);
2205 return read_vector (readcharfun
, 0);
2221 /* Accept extended format for hashtables (extensible to
2223 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2224 Lisp_Object tmp
= read_list (0, readcharfun
);
2225 Lisp_Object head
= CAR_SAFE (tmp
);
2226 Lisp_Object data
= Qnil
;
2227 Lisp_Object val
= Qnil
;
2228 /* The size is 2 * number of allowed keywords to
2230 Lisp_Object params
[10];
2232 Lisp_Object key
= Qnil
;
2233 int param_count
= 0;
2235 if (!EQ (head
, Qhash_table
))
2236 error ("Invalid extended read marker at head of #s list "
2237 "(only hash-table allowed)");
2239 tmp
= CDR_SAFE (tmp
);
2241 /* This is repetitive but fast and simple. */
2242 params
[param_count
] = QCsize
;
2243 params
[param_count
+1] = Fplist_get (tmp
, Qsize
);
2244 if (!NILP (params
[param_count
+ 1]))
2247 params
[param_count
] = QCtest
;
2248 params
[param_count
+1] = Fplist_get (tmp
, Qtest
);
2249 if (!NILP (params
[param_count
+ 1]))
2252 params
[param_count
] = QCweakness
;
2253 params
[param_count
+1] = Fplist_get (tmp
, Qweakness
);
2254 if (!NILP (params
[param_count
+ 1]))
2257 params
[param_count
] = QCrehash_size
;
2258 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_size
);
2259 if (!NILP (params
[param_count
+ 1]))
2262 params
[param_count
] = QCrehash_threshold
;
2263 params
[param_count
+1] = Fplist_get (tmp
, Qrehash_threshold
);
2264 if (!NILP (params
[param_count
+ 1]))
2267 /* This is the hashtable data. */
2268 data
= Fplist_get (tmp
, Qdata
);
2270 /* Now use params to make a new hashtable and fill it. */
2271 ht
= Fmake_hash_table (param_count
, params
);
2273 while (CONSP (data
))
2278 error ("Odd number of elements in hashtable data");
2281 Fputhash (key
, val
, ht
);
2287 invalid_syntax ("#", 1);
2295 tmp
= read_vector (readcharfun
, 0);
2296 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2297 error ("Invalid size char-table");
2298 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2309 tmp
= read_vector (readcharfun
, 0);
2310 if (!INTEGERP (AREF (tmp
, 0)))
2311 error ("Invalid depth in char-table");
2312 depth
= XINT (AREF (tmp
, 0));
2313 if (depth
< 1 || depth
> 3)
2314 error ("Invalid depth in char-table");
2315 size
= XVECTOR (tmp
)->size
- 2;
2316 if (chartab_size
[depth
] != size
)
2317 error ("Invalid size char-table");
2318 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2321 invalid_syntax ("#^^", 3);
2323 invalid_syntax ("#^", 2);
2328 length
= read1 (readcharfun
, pch
, first_in_list
);
2332 Lisp_Object tmp
, val
;
2334 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2335 / BOOL_VECTOR_BITS_PER_CHAR
);
2338 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2339 if (STRING_MULTIBYTE (tmp
)
2340 || (size_in_chars
!= SCHARS (tmp
)
2341 /* We used to print 1 char too many
2342 when the number of bits was a multiple of 8.
2343 Accept such input in case it came from an old
2345 && ! (XFASTINT (length
)
2346 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2347 invalid_syntax ("#&...", 5);
2349 val
= Fmake_bool_vector (length
, Qnil
);
2350 memcpy (XBOOL_VECTOR (val
)->data
, SDATA (tmp
), size_in_chars
);
2351 /* Clear the extraneous bits in the last byte. */
2352 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2353 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2354 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2357 invalid_syntax ("#&...", 5);
2361 /* Accept compiled functions at read-time so that we don't have to
2362 build them using function calls. */
2364 tmp
= read_vector (readcharfun
, 1);
2365 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2366 XVECTOR (tmp
)->contents
);
2371 struct gcpro gcpro1
;
2374 /* Read the string itself. */
2375 tmp
= read1 (readcharfun
, &ch
, 0);
2376 if (ch
!= 0 || !STRINGP (tmp
))
2377 invalid_syntax ("#", 1);
2379 /* Read the intervals and their properties. */
2382 Lisp_Object beg
, end
, plist
;
2384 beg
= read1 (readcharfun
, &ch
, 0);
2389 end
= read1 (readcharfun
, &ch
, 0);
2391 plist
= read1 (readcharfun
, &ch
, 0);
2393 invalid_syntax ("Invalid string property list", 0);
2394 Fset_text_properties (beg
, end
, plist
, tmp
);
2400 /* #@NUMBER is used to skip NUMBER following characters.
2401 That's used in .elc files to skip over doc strings
2402 and function definitions. */
2408 /* Read a decimal integer. */
2409 while ((c
= READCHAR
) >= 0
2410 && c
>= '0' && c
<= '9')
2418 if (load_force_doc_strings
2419 && (EQ (readcharfun
, Qget_file_char
)
2420 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2422 /* If we are supposed to force doc strings into core right now,
2423 record the last string that we skipped,
2424 and record where in the file it comes from. */
2426 /* But first exchange saved_doc_string
2427 with prev_saved_doc_string, so we save two strings. */
2429 char *temp
= saved_doc_string
;
2430 int temp_size
= saved_doc_string_size
;
2431 file_offset temp_pos
= saved_doc_string_position
;
2432 int temp_len
= saved_doc_string_length
;
2434 saved_doc_string
= prev_saved_doc_string
;
2435 saved_doc_string_size
= prev_saved_doc_string_size
;
2436 saved_doc_string_position
= prev_saved_doc_string_position
;
2437 saved_doc_string_length
= prev_saved_doc_string_length
;
2439 prev_saved_doc_string
= temp
;
2440 prev_saved_doc_string_size
= temp_size
;
2441 prev_saved_doc_string_position
= temp_pos
;
2442 prev_saved_doc_string_length
= temp_len
;
2445 if (saved_doc_string_size
== 0)
2447 saved_doc_string_size
= nskip
+ 100;
2448 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2450 if (nskip
> saved_doc_string_size
)
2452 saved_doc_string_size
= nskip
+ 100;
2453 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2454 saved_doc_string_size
);
2457 saved_doc_string_position
= file_tell (instream
);
2459 /* Copy that many characters into saved_doc_string. */
2460 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2461 saved_doc_string
[i
] = c
= READCHAR
;
2463 saved_doc_string_length
= i
;
2467 /* Skip that many characters. */
2468 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2477 /* #! appears at the beginning of an executable file.
2478 Skip the first line. */
2479 while (c
!= '\n' && c
>= 0)
2484 return Vload_file_name
;
2486 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2487 /* #:foo is the uninterned symbol named foo. */
2490 uninterned_symbol
= 1;
2494 /* Reader forms that can reuse previously read objects. */
2495 if (c
>= '0' && c
<= '9')
2500 /* Read a non-negative integer. */
2501 while (c
>= '0' && c
<= '9')
2507 /* #n=object returns object, but associates it with n for #n#. */
2508 if (c
== '=' && !NILP (Vread_circle
))
2510 /* Make a placeholder for #n# to use temporarily */
2511 Lisp_Object placeholder
;
2514 placeholder
= Fcons (Qnil
, Qnil
);
2515 cell
= Fcons (make_number (n
), placeholder
);
2516 read_objects
= Fcons (cell
, read_objects
);
2518 /* Read the object itself. */
2519 tem
= read0 (readcharfun
);
2521 /* Now put it everywhere the placeholder was... */
2522 substitute_object_in_subtree (tem
, placeholder
);
2524 /* ...and #n# will use the real value from now on. */
2525 Fsetcdr (cell
, tem
);
2529 /* #n# returns a previously read object. */
2530 if (c
== '#' && !NILP (Vread_circle
))
2532 tem
= Fassq (make_number (n
), read_objects
);
2535 /* Fall through to error message. */
2537 else if (c
== 'r' || c
== 'R')
2538 return read_integer (readcharfun
, n
);
2540 /* Fall through to error message. */
2542 else if (c
== 'x' || c
== 'X')
2543 return read_integer (readcharfun
, 16);
2544 else if (c
== 'o' || c
== 'O')
2545 return read_integer (readcharfun
, 8);
2546 else if (c
== 'b' || c
== 'B')
2547 return read_integer (readcharfun
, 2);
2550 invalid_syntax ("#", 1);
2553 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2558 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2563 int next_char
= READCHAR
;
2565 /* Transition from old-style to new-style:
2566 If we see "(`" it used to mean old-style, which usually works
2567 fine because ` should almost never appear in such a position
2568 for new-style. But occasionally we need "(`" to mean new
2569 style, so we try to distinguish the two by the fact that we
2570 can either write "( `foo" or "(` foo", where the first
2571 intends to use new-style whereas the second intends to use
2572 old-style. For Emacs-25, we should completely remove this
2573 first_in_list exception (old-style can still be obtained via
2575 if (!new_backquote_flag
&& first_in_list
&& next_char
== ' ')
2577 Vold_style_backquotes
= Qt
;
2584 new_backquote_flag
++;
2585 value
= read0 (readcharfun
);
2586 new_backquote_flag
--;
2588 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2593 int next_char
= READCHAR
;
2595 /* Transition from old-style to new-style:
2596 It used to be impossible to have a new-style , other than within
2597 a new-style `. This is sufficient when ` and , are used in the
2598 normal way, but ` and , can also appear in args to macros that
2599 will not interpret them in the usual way, in which case , may be
2600 used without any ` anywhere near.
2601 So we now use the same heuristic as for backquote: old-style
2602 unquotes are only recognized when first on a list, and when
2603 followed by a space.
2604 Because it's more difficult to peak 2 chars ahead, a new-style
2605 ,@ can still not be used outside of a `, unless it's in the middle
2607 if (new_backquote_flag
2609 || (next_char
!= ' ' && next_char
!= '@'))
2611 Lisp_Object comma_type
= Qnil
;
2616 comma_type
= Qcomma_at
;
2618 comma_type
= Qcomma_dot
;
2621 if (ch
>= 0) UNREAD (ch
);
2622 comma_type
= Qcomma
;
2625 value
= read0 (readcharfun
);
2626 return Fcons (comma_type
, Fcons (value
, Qnil
));
2630 Vold_style_backquotes
= Qt
;
2642 end_of_file_error ();
2644 /* Accept `single space' syntax like (list ? x) where the
2645 whitespace character is SPC or TAB.
2646 Other literal whitespace like NL, CR, and FF are not accepted,
2647 as there are well-established escape sequences for these. */
2648 if (c
== ' ' || c
== '\t')
2649 return make_number (c
);
2652 c
= read_escape (readcharfun
, 0);
2653 modifiers
= c
& CHAR_MODIFIER_MASK
;
2654 c
&= ~CHAR_MODIFIER_MASK
;
2655 if (CHAR_BYTE8_P (c
))
2656 c
= CHAR_TO_BYTE8 (c
);
2659 next_char
= READCHAR
;
2660 ok
= (next_char
<= 040
2661 || (next_char
< 0200
2662 && (strchr ("\"';()[]#?`,.", next_char
))));
2665 return make_number (c
);
2667 invalid_syntax ("?", 1);
2672 char *p
= read_buffer
;
2673 char *end
= read_buffer
+ read_buffer_size
;
2675 /* Nonzero if we saw an escape sequence specifying
2676 a multibyte character. */
2677 int force_multibyte
= 0;
2678 /* Nonzero if we saw an escape sequence specifying
2679 a single-byte character. */
2680 int force_singlebyte
= 0;
2684 while ((c
= READCHAR
) >= 0
2687 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2689 int offset
= p
- read_buffer
;
2690 read_buffer
= (char *) xrealloc (read_buffer
,
2691 read_buffer_size
*= 2);
2692 p
= read_buffer
+ offset
;
2693 end
= read_buffer
+ read_buffer_size
;
2700 c
= read_escape (readcharfun
, 1);
2702 /* C is -1 if \ newline has just been seen */
2705 if (p
== read_buffer
)
2710 modifiers
= c
& CHAR_MODIFIER_MASK
;
2711 c
= c
& ~CHAR_MODIFIER_MASK
;
2713 if (CHAR_BYTE8_P (c
))
2714 force_singlebyte
= 1;
2715 else if (! ASCII_CHAR_P (c
))
2716 force_multibyte
= 1;
2717 else /* i.e. ASCII_CHAR_P (c) */
2719 /* Allow `\C- ' and `\C-?'. */
2720 if (modifiers
== CHAR_CTL
)
2723 c
= 0, modifiers
= 0;
2725 c
= 127, modifiers
= 0;
2727 if (modifiers
& CHAR_SHIFT
)
2729 /* Shift modifier is valid only with [A-Za-z]. */
2730 if (c
>= 'A' && c
<= 'Z')
2731 modifiers
&= ~CHAR_SHIFT
;
2732 else if (c
>= 'a' && c
<= 'z')
2733 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2736 if (modifiers
& CHAR_META
)
2738 /* Move the meta bit to the right place for a
2740 modifiers
&= ~CHAR_META
;
2741 c
= BYTE8_TO_CHAR (c
| 0x80);
2742 force_singlebyte
= 1;
2746 /* Any modifiers remaining are invalid. */
2748 error ("Invalid modifier in string");
2749 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2753 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2754 if (CHAR_BYTE8_P (c
))
2755 force_singlebyte
= 1;
2756 else if (! ASCII_CHAR_P (c
))
2757 force_multibyte
= 1;
2763 end_of_file_error ();
2765 /* If purifying, and string starts with \ newline,
2766 return zero instead. This is for doc strings
2767 that we are really going to find in etc/DOC.nn.nn */
2768 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2769 return make_number (0);
2771 if (force_multibyte
)
2772 /* READ_BUFFER already contains valid multibyte forms. */
2774 else if (force_singlebyte
)
2776 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2777 p
= read_buffer
+ nchars
;
2780 /* Otherwise, READ_BUFFER contains only ASCII. */
2783 /* We want readchar_count to be the number of characters, not
2784 bytes. Hence we adjust for multibyte characters in the
2785 string. ... But it doesn't seem to be necessary, because
2786 READCHAR *does* read multibyte characters from buffers. */
2787 /* readchar_count -= (p - read_buffer) - nchars; */
2789 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2791 || (p
- read_buffer
!= nchars
)));
2792 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2794 || (p
- read_buffer
!= nchars
)));
2799 int next_char
= READCHAR
;
2802 if (next_char
<= 040
2803 || (next_char
< 0200
2804 && (strchr ("\"';([#?`,", next_char
))))
2810 /* Otherwise, we fall through! Note that the atom-reading loop
2811 below will now loop at least once, assuring that we will not
2812 try to UNREAD two characters in a row. */
2816 if (c
<= 040) goto retry
;
2817 if (c
== 0x8a0) /* NBSP */
2820 char *p
= read_buffer
;
2824 char *end
= read_buffer
+ read_buffer_size
;
2828 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2830 int offset
= p
- read_buffer
;
2831 read_buffer
= (char *) xrealloc (read_buffer
,
2832 read_buffer_size
*= 2);
2833 p
= read_buffer
+ offset
;
2834 end
= read_buffer
+ read_buffer_size
;
2841 end_of_file_error ();
2846 p
+= CHAR_STRING (c
, p
);
2851 && c
!= 0x8a0 /* NBSP */
2853 || !(strchr ("\"';()[]#`,", c
))));
2857 int offset
= p
- read_buffer
;
2858 read_buffer
= (char *) xrealloc (read_buffer
,
2859 read_buffer_size
*= 2);
2860 p
= read_buffer
+ offset
;
2861 end
= read_buffer
+ read_buffer_size
;
2868 if (!quoted
&& !uninterned_symbol
)
2872 if (*p1
== '+' || *p1
== '-') p1
++;
2873 /* Is it an integer? */
2876 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2877 /* Integers can have trailing decimal points. */
2878 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2880 /* It is an integer. */
2885 /* EMACS_INT n = atol (read_buffer); */
2886 char *endptr
= NULL
;
2887 EMACS_INT n
= (errno
= 0,
2888 strtol (read_buffer
, &endptr
, 10));
2889 if (errno
== ERANGE
&& endptr
)
2892 = Fcons (make_string (read_buffer
,
2893 endptr
- read_buffer
),
2895 xsignal (Qoverflow_error
, args
);
2897 return make_fixnum_or_float (n
);
2901 if (isfloat_string (read_buffer
, 0))
2903 /* Compute NaN and infinities using 0.0 in a variable,
2904 to cope with compilers that think they are smarter
2910 /* Negate the value ourselves. This treats 0, NaNs,
2911 and infinity properly on IEEE floating point hosts,
2912 and works around a common bug where atof ("-0.0")
2914 int negative
= read_buffer
[0] == '-';
2916 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2917 returns 1, is if the input ends in e+INF or e+NaN. */
2924 value
= zero
/ zero
;
2926 /* If that made a "negative" NaN, negate it. */
2930 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2933 u_minus_zero
.d
= - 0.0;
2934 for (i
= 0; i
< sizeof (double); i
++)
2935 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2941 /* Now VALUE is a positive NaN. */
2944 value
= atof (read_buffer
+ negative
);
2948 return make_float (negative
? - value
: value
);
2952 Lisp_Object name
, result
;
2953 EMACS_INT nbytes
= p
- read_buffer
;
2955 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
2958 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
2959 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
2961 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
2962 result
= (uninterned_symbol
? Fmake_symbol (name
)
2963 : Fintern (name
, Qnil
));
2965 if (EQ (Vread_with_symbol_positions
, Qt
)
2966 || EQ (Vread_with_symbol_positions
, readcharfun
))
2967 Vread_symbol_positions_list
=
2968 /* Kind of a hack; this will probably fail if characters
2969 in the symbol name were escaped. Not really a big
2971 Fcons (Fcons (result
,
2972 make_number (readchar_count
2973 - XFASTINT (Flength (Fsymbol_name (result
))))),
2974 Vread_symbol_positions_list
);
2982 /* List of nodes we've seen during substitute_object_in_subtree. */
2983 static Lisp_Object seen_list
;
2986 substitute_object_in_subtree (Lisp_Object object
, Lisp_Object placeholder
)
2988 Lisp_Object check_object
;
2990 /* We haven't seen any objects when we start. */
2993 /* Make all the substitutions. */
2995 = substitute_object_recurse (object
, placeholder
, object
);
2997 /* Clear seen_list because we're done with it. */
3000 /* The returned object here is expected to always eq the
3002 if (!EQ (check_object
, object
))
3003 error ("Unexpected mutation error in reader");
3006 /* Feval doesn't get called from here, so no gc protection is needed. */
3007 #define SUBSTITUTE(get_val, set_val) \
3009 Lisp_Object old_value = get_val; \
3010 Lisp_Object true_value \
3011 = substitute_object_recurse (object, placeholder, \
3014 if (!EQ (old_value, true_value)) \
3021 substitute_object_recurse (Lisp_Object object
, Lisp_Object placeholder
, Lisp_Object subtree
)
3023 /* If we find the placeholder, return the target object. */
3024 if (EQ (placeholder
, subtree
))
3027 /* If we've been to this node before, don't explore it again. */
3028 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3031 /* If this node can be the entry point to a cycle, remember that
3032 we've seen it. It can only be such an entry point if it was made
3033 by #n=, which means that we can find it as a value in
3035 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3036 seen_list
= Fcons (subtree
, seen_list
);
3038 /* Recurse according to subtree's type.
3039 Every branch must return a Lisp_Object. */
3040 switch (XTYPE (subtree
))
3042 case Lisp_Vectorlike
:
3045 if (BOOL_VECTOR_P (subtree
))
3046 return subtree
; /* No sub-objects anyway. */
3047 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3048 || COMPILEDP (subtree
))
3049 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3050 else if (VECTORP (subtree
))
3051 length
= ASIZE (subtree
);
3053 /* An unknown pseudovector may contain non-Lisp fields, so we
3054 can't just blindly traverse all its fields. We used to call
3055 `Flength' which signaled `sequencep', so I just preserved this
3057 wrong_type_argument (Qsequencep
, subtree
);
3059 for (i
= 0; i
< length
; i
++)
3060 SUBSTITUTE (AREF (subtree
, i
),
3061 ASET (subtree
, i
, true_value
));
3067 SUBSTITUTE (XCAR (subtree
),
3068 XSETCAR (subtree
, true_value
));
3069 SUBSTITUTE (XCDR (subtree
),
3070 XSETCDR (subtree
, true_value
));
3076 /* Check for text properties in each interval.
3077 substitute_in_interval contains part of the logic. */
3079 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3080 Lisp_Object arg
= Fcons (object
, placeholder
);
3082 traverse_intervals_noorder (root_interval
,
3083 &substitute_in_interval
, arg
);
3088 /* Other types don't recurse any further. */
3094 /* Helper function for substitute_object_recurse. */
3096 substitute_in_interval (INTERVAL interval
, Lisp_Object arg
)
3098 Lisp_Object object
= Fcar (arg
);
3099 Lisp_Object placeholder
= Fcdr (arg
);
3101 SUBSTITUTE (interval
->plist
, interval
->plist
= true_value
);
3112 isfloat_string (const char *cp
, int ignore_trailing
)
3115 const char *start
= cp
;
3118 if (*cp
== '+' || *cp
== '-')
3121 if (*cp
>= '0' && *cp
<= '9')
3124 while (*cp
>= '0' && *cp
<= '9')
3132 if (*cp
>= '0' && *cp
<= '9')
3135 while (*cp
>= '0' && *cp
<= '9')
3138 if (*cp
== 'e' || *cp
== 'E')
3142 if (*cp
== '+' || *cp
== '-')
3146 if (*cp
>= '0' && *cp
<= '9')
3149 while (*cp
>= '0' && *cp
<= '9')
3152 else if (cp
== start
)
3154 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3159 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3165 return ((ignore_trailing
3166 || *cp
== 0 || *cp
== ' ' || *cp
== '\t' || *cp
== '\n'
3167 || *cp
== '\r' || *cp
== '\f')
3168 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3169 || state
== (DOT_CHAR
|TRAIL_INT
)
3170 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3171 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3172 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3177 read_vector (Lisp_Object readcharfun
, int bytecodeflag
)
3181 register Lisp_Object
*ptr
;
3182 register Lisp_Object tem
, item
, vector
;
3183 register struct Lisp_Cons
*otem
;
3186 tem
= read_list (1, readcharfun
);
3187 len
= Flength (tem
);
3188 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3190 size
= XVECTOR (vector
)->size
;
3191 ptr
= XVECTOR (vector
)->contents
;
3192 for (i
= 0; i
< size
; i
++)
3195 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3196 bytecode object, the docstring containing the bytecode and
3197 constants values must be treated as unibyte and passed to
3198 Fread, to get the actual bytecode string and constants vector. */
3199 if (bytecodeflag
&& load_force_doc_strings
)
3201 if (i
== COMPILED_BYTECODE
)
3203 if (!STRINGP (item
))
3204 error ("Invalid byte code");
3206 /* Delay handling the bytecode slot until we know whether
3207 it is lazily-loaded (we can tell by whether the
3208 constants slot is nil). */
3209 ptr
[COMPILED_CONSTANTS
] = item
;
3212 else if (i
== COMPILED_CONSTANTS
)
3214 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3218 /* Coerce string to unibyte (like string-as-unibyte,
3219 but without generating extra garbage and
3220 guaranteeing no change in the contents). */
3221 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3222 STRING_SET_UNIBYTE (bytestr
);
3224 item
= Fread (Fcons (bytestr
, readcharfun
));
3226 error ("Invalid byte code");
3228 otem
= XCONS (item
);
3229 bytestr
= XCAR (item
);
3234 /* Now handle the bytecode slot. */
3235 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3237 else if (i
== COMPILED_DOC_STRING
3239 && ! STRING_MULTIBYTE (item
))
3241 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3242 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3244 item
= Fstring_as_multibyte (item
);
3247 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3255 /* FLAG = 1 means check for ] to terminate rather than ) and .
3256 FLAG = -1 means check for starting with defun
3257 and make structure pure. */
3260 read_list (int flag
, register Lisp_Object readcharfun
)
3262 /* -1 means check next element for defun,
3263 0 means don't check,
3264 1 means already checked and found defun. */
3265 int defunflag
= flag
< 0 ? -1 : 0;
3266 Lisp_Object val
, tail
;
3267 register Lisp_Object elt
, tem
;
3268 struct gcpro gcpro1
, gcpro2
;
3269 /* 0 is the normal case.
3270 1 means this list is a doc reference; replace it with the number 0.
3271 2 means this list is a doc reference; replace it with the doc string. */
3272 int doc_reference
= 0;
3274 /* Initialize this to 1 if we are reading a list. */
3275 int first_in_list
= flag
<= 0;
3284 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3289 /* While building, if the list starts with #$, treat it specially. */
3290 if (EQ (elt
, Vload_file_name
)
3292 && !NILP (Vpurify_flag
))
3294 if (NILP (Vdoc_file_name
))
3295 /* We have not yet called Snarf-documentation, so assume
3296 this file is described in the DOC-MM.NN file
3297 and Snarf-documentation will fill in the right value later.
3298 For now, replace the whole list with 0. */
3301 /* We have already called Snarf-documentation, so make a relative
3302 file name for this file, so it can be found properly
3303 in the installed Lisp directory.
3304 We don't use Fexpand_file_name because that would make
3305 the directory absolute now. */
3306 elt
= concat2 (build_string ("../lisp/"),
3307 Ffile_name_nondirectory (elt
));
3309 else if (EQ (elt
, Vload_file_name
)
3311 && load_force_doc_strings
)
3320 invalid_syntax (") or . in a vector", 18);
3328 XSETCDR (tail
, read0 (readcharfun
));
3330 val
= read0 (readcharfun
);
3331 read1 (readcharfun
, &ch
, 0);
3335 if (doc_reference
== 1)
3336 return make_number (0);
3337 if (doc_reference
== 2)
3339 /* Get a doc string from the file we are loading.
3340 If it's in saved_doc_string, get it from there.
3342 Here, we don't know if the string is a
3343 bytecode string or a doc string. As a
3344 bytecode string must be unibyte, we always
3345 return a unibyte string. If it is actually a
3346 doc string, caller must make it
3349 int pos
= XINT (XCDR (val
));
3350 /* Position is negative for user variables. */
3351 if (pos
< 0) pos
= -pos
;
3352 if (pos
>= saved_doc_string_position
3353 && pos
< (saved_doc_string_position
3354 + saved_doc_string_length
))
3356 int start
= pos
- saved_doc_string_position
;
3359 /* Process quoting with ^A,
3360 and find the end of the string,
3361 which is marked with ^_ (037). */
3362 for (from
= start
, to
= start
;
3363 saved_doc_string
[from
] != 037;)
3365 int c
= saved_doc_string
[from
++];
3368 c
= saved_doc_string
[from
++];
3370 saved_doc_string
[to
++] = c
;
3372 saved_doc_string
[to
++] = 0;
3374 saved_doc_string
[to
++] = 037;
3377 saved_doc_string
[to
++] = c
;
3380 return make_unibyte_string (saved_doc_string
+ start
,
3383 /* Look in prev_saved_doc_string the same way. */
3384 else if (pos
>= prev_saved_doc_string_position
3385 && pos
< (prev_saved_doc_string_position
3386 + prev_saved_doc_string_length
))
3388 int start
= pos
- prev_saved_doc_string_position
;
3391 /* Process quoting with ^A,
3392 and find the end of the string,
3393 which is marked with ^_ (037). */
3394 for (from
= start
, to
= start
;
3395 prev_saved_doc_string
[from
] != 037;)
3397 int c
= prev_saved_doc_string
[from
++];
3400 c
= prev_saved_doc_string
[from
++];
3402 prev_saved_doc_string
[to
++] = c
;
3404 prev_saved_doc_string
[to
++] = 0;
3406 prev_saved_doc_string
[to
++] = 037;
3409 prev_saved_doc_string
[to
++] = c
;
3412 return make_unibyte_string (prev_saved_doc_string
3417 return get_doc_string (val
, 1, 0);
3422 invalid_syntax (". in wrong context", 18);
3424 invalid_syntax ("] in a list", 11);
3426 tem
= (read_pure
&& flag
<= 0
3427 ? pure_cons (elt
, Qnil
)
3428 : Fcons (elt
, Qnil
));
3430 XSETCDR (tail
, tem
);
3435 defunflag
= EQ (elt
, Qdefun
);
3436 else if (defunflag
> 0)
3441 Lisp_Object initial_obarray
;
3443 /* oblookup stores the bucket number here, for the sake of Funintern. */
3445 int oblookup_last_bucket_number
;
3447 static int hash_string (const unsigned char *ptr
, int len
);
3449 /* Get an error if OBARRAY is not an obarray.
3450 If it is one, return it. */
3453 check_obarray (Lisp_Object obarray
)
3455 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3457 /* If Vobarray is now invalid, force it to be valid. */
3458 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3459 wrong_type_argument (Qvectorp
, obarray
);
3464 /* Intern the C string STR: return a symbol with that name,
3465 interned in the current obarray. */
3468 intern (const char *str
)
3471 int len
= strlen (str
);
3472 Lisp_Object obarray
;
3475 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3476 obarray
= check_obarray (obarray
);
3477 tem
= oblookup (obarray
, str
, len
, len
);
3480 return Fintern (make_string (str
, len
), obarray
);
3484 intern_c_string (const char *str
)
3487 int len
= strlen (str
);
3488 Lisp_Object obarray
;
3491 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3492 obarray
= check_obarray (obarray
);
3493 tem
= oblookup (obarray
, str
, len
, len
);
3497 if (NILP (Vpurify_flag
))
3498 /* Creating a non-pure string from a string literal not
3499 implemented yet. We could just use make_string here and live
3500 with the extra copy. */
3503 return Fintern (make_pure_c_string (str
), obarray
);
3506 /* Create an uninterned symbol with name STR. */
3509 make_symbol (const char *str
)
3511 int len
= strlen (str
);
3513 return Fmake_symbol (!NILP (Vpurify_flag
)
3514 ? make_pure_string (str
, len
, len
, 0)
3515 : make_string (str
, len
));
3518 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3519 doc
: /* Return the canonical symbol whose name is STRING.
3520 If there is none, one is created by this function and returned.
3521 A second optional argument specifies the obarray to use;
3522 it defaults to the value of `obarray'. */)
3523 (Lisp_Object string
, Lisp_Object obarray
)
3525 register Lisp_Object tem
, sym
, *ptr
;
3527 if (NILP (obarray
)) obarray
= Vobarray
;
3528 obarray
= check_obarray (obarray
);
3530 CHECK_STRING (string
);
3532 tem
= oblookup (obarray
, SDATA (string
),
3535 if (!INTEGERP (tem
))
3538 if (!NILP (Vpurify_flag
))
3539 string
= Fpurecopy (string
);
3540 sym
= Fmake_symbol (string
);
3542 if (EQ (obarray
, initial_obarray
))
3543 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3545 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3547 if ((SREF (string
, 0) == ':')
3548 && EQ (obarray
, initial_obarray
))
3550 XSYMBOL (sym
)->constant
= 1;
3551 XSYMBOL (sym
)->redirect
= SYMBOL_PLAINVAL
;
3552 SET_SYMBOL_VAL (XSYMBOL (sym
), sym
);
3555 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3557 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3559 XSYMBOL (sym
)->next
= 0;
3564 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3565 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3566 NAME may be a string or a symbol. If it is a symbol, that exact
3567 symbol is searched for.
3568 A second optional argument specifies the obarray to use;
3569 it defaults to the value of `obarray'. */)
3570 (Lisp_Object name
, Lisp_Object obarray
)
3572 register Lisp_Object tem
, string
;
3574 if (NILP (obarray
)) obarray
= Vobarray
;
3575 obarray
= check_obarray (obarray
);
3577 if (!SYMBOLP (name
))
3579 CHECK_STRING (name
);
3583 string
= SYMBOL_NAME (name
);
3585 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3586 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3592 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3593 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3594 The value is t if a symbol was found and deleted, nil otherwise.
3595 NAME may be a string or a symbol. If it is a symbol, that symbol
3596 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3597 OBARRAY defaults to the value of the variable `obarray'. */)
3598 (Lisp_Object name
, Lisp_Object obarray
)
3600 register Lisp_Object string
, tem
;
3603 if (NILP (obarray
)) obarray
= Vobarray
;
3604 obarray
= check_obarray (obarray
);
3607 string
= SYMBOL_NAME (name
);
3610 CHECK_STRING (name
);
3614 tem
= oblookup (obarray
, SDATA (string
),
3619 /* If arg was a symbol, don't delete anything but that symbol itself. */
3620 if (SYMBOLP (name
) && !EQ (name
, tem
))
3623 /* There are plenty of other symbols which will screw up the Emacs
3624 session if we unintern them, as well as even more ways to use
3625 `setq' or `fset' or whatnot to make the Emacs session
3626 unusable. Let's not go down this silly road. --Stef */
3627 /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3628 error ("Attempt to unintern t or nil"); */
3630 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3632 hash
= oblookup_last_bucket_number
;
3634 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3636 if (XSYMBOL (tem
)->next
)
3637 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3639 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3643 Lisp_Object tail
, following
;
3645 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3646 XSYMBOL (tail
)->next
;
3649 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3650 if (EQ (following
, tem
))
3652 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3661 /* Return the symbol in OBARRAY whose names matches the string
3662 of SIZE characters (SIZE_BYTE bytes) at PTR.
3663 If there is no such symbol in OBARRAY, return nil.
3665 Also store the bucket number in oblookup_last_bucket_number. */
3668 oblookup (Lisp_Object obarray
, register const char *ptr
, EMACS_INT size
, EMACS_INT size_byte
)
3672 register Lisp_Object tail
;
3673 Lisp_Object bucket
, tem
;
3675 if (!VECTORP (obarray
)
3676 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3678 obarray
= check_obarray (obarray
);
3679 obsize
= XVECTOR (obarray
)->size
;
3681 /* This is sometimes needed in the middle of GC. */
3682 obsize
&= ~ARRAY_MARK_FLAG
;
3683 hash
= hash_string (ptr
, size_byte
) % obsize
;
3684 bucket
= XVECTOR (obarray
)->contents
[hash
];
3685 oblookup_last_bucket_number
= hash
;
3686 if (EQ (bucket
, make_number (0)))
3688 else if (!SYMBOLP (bucket
))
3689 error ("Bad data in guts of obarray"); /* Like CADR error message */
3691 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3693 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3694 && SCHARS (SYMBOL_NAME (tail
)) == size
3695 && !memcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3697 else if (XSYMBOL (tail
)->next
== 0)
3700 XSETINT (tem
, hash
);
3705 hash_string (const unsigned char *ptr
, int len
)
3707 register const unsigned char *p
= ptr
;
3708 register const unsigned char *end
= p
+ len
;
3709 register unsigned char c
;
3710 register int hash
= 0;
3715 if (c
>= 0140) c
-= 40;
3716 hash
= ((hash
<<3) + (hash
>>28) + c
);
3718 return hash
& 07777777777;
3722 map_obarray (Lisp_Object obarray
, void (*fn
) (Lisp_Object
, Lisp_Object
), Lisp_Object arg
)
3725 register Lisp_Object tail
;
3726 CHECK_VECTOR (obarray
);
3727 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3729 tail
= XVECTOR (obarray
)->contents
[i
];
3734 if (XSYMBOL (tail
)->next
== 0)
3736 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3742 mapatoms_1 (Lisp_Object sym
, Lisp_Object function
)
3744 call1 (function
, sym
);
3747 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3748 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3749 OBARRAY defaults to the value of `obarray'. */)
3750 (Lisp_Object function
, Lisp_Object obarray
)
3752 if (NILP (obarray
)) obarray
= Vobarray
;
3753 obarray
= check_obarray (obarray
);
3755 map_obarray (obarray
, mapatoms_1
, function
);
3759 #define OBARRAY_SIZE 1511
3764 Lisp_Object oblength
;
3766 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3768 Vobarray
= Fmake_vector (oblength
, make_number (0));
3769 initial_obarray
= Vobarray
;
3770 staticpro (&initial_obarray
);
3772 Qunbound
= Fmake_symbol (make_pure_c_string ("unbound"));
3773 /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3774 NILP (Vpurify_flag) check in intern_c_string. */
3775 Qnil
= make_number (-1); Vpurify_flag
= make_number (1);
3776 Qnil
= intern_c_string ("nil");
3778 /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3779 so those two need to be fixed manally. */
3780 SET_SYMBOL_VAL (XSYMBOL (Qunbound
), Qunbound
);
3781 XSYMBOL (Qunbound
)->function
= Qunbound
;
3782 XSYMBOL (Qunbound
)->plist
= Qnil
;
3783 /* XSYMBOL (Qnil)->function = Qunbound; */
3784 SET_SYMBOL_VAL (XSYMBOL (Qnil
), Qnil
);
3785 XSYMBOL (Qnil
)->constant
= 1;
3786 XSYMBOL (Qnil
)->plist
= Qnil
;
3788 Qt
= intern_c_string ("t");
3789 SET_SYMBOL_VAL (XSYMBOL (Qt
), Qt
);
3790 XSYMBOL (Qt
)->constant
= 1;
3792 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3795 Qvariable_documentation
= intern_c_string ("variable-documentation");
3796 staticpro (&Qvariable_documentation
);
3798 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3799 read_buffer
= (char *) xmalloc (read_buffer_size
);
3803 defsubr (struct Lisp_Subr
*sname
)
3806 sym
= intern_c_string (sname
->symbol_name
);
3807 XSETPVECTYPE (sname
, PVEC_SUBR
);
3808 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3811 #ifdef NOTDEF /* use fset in subr.el now */
3813 defalias (sname
, string
)
3814 struct Lisp_Subr
*sname
;
3818 sym
= intern (string
);
3819 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3823 /* Define an "integer variable"; a symbol whose value is forwarded to a
3824 C variable of type int. Sample call (munged w "xx" to fool make-docfile):
3825 DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3827 defvar_int (struct Lisp_Intfwd
*i_fwd
,
3828 const char *namestring
, EMACS_INT
*address
)
3831 sym
= intern_c_string (namestring
);
3832 i_fwd
->type
= Lisp_Fwd_Int
;
3833 i_fwd
->intvar
= address
;
3834 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3835 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)i_fwd
);
3838 /* Similar but define a variable whose value is t if address contains 1,
3839 nil if address contains 0. */
3841 defvar_bool (struct Lisp_Boolfwd
*b_fwd
,
3842 const char *namestring
, int *address
)
3845 sym
= intern_c_string (namestring
);
3846 b_fwd
->type
= Lisp_Fwd_Bool
;
3847 b_fwd
->boolvar
= address
;
3848 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3849 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)b_fwd
);
3850 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3853 /* Similar but define a variable whose value is the Lisp Object stored
3854 at address. Two versions: with and without gc-marking of the C
3855 variable. The nopro version is used when that variable will be
3856 gc-marked for some other reason, since marking the same slot twice
3857 can cause trouble with strings. */
3859 defvar_lisp_nopro (struct Lisp_Objfwd
*o_fwd
,
3860 const char *namestring
, Lisp_Object
*address
)
3863 sym
= intern_c_string (namestring
);
3864 o_fwd
->type
= Lisp_Fwd_Obj
;
3865 o_fwd
->objvar
= address
;
3866 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3867 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)o_fwd
);
3871 defvar_lisp (struct Lisp_Objfwd
*o_fwd
,
3872 const char *namestring
, Lisp_Object
*address
)
3874 defvar_lisp_nopro (o_fwd
, namestring
, address
);
3875 staticpro (address
);
3878 /* Similar but define a variable whose value is the Lisp Object stored
3879 at a particular offset in the current kboard object. */
3882 defvar_kboard (struct Lisp_Kboard_Objfwd
*ko_fwd
,
3883 const char *namestring
, int offset
)
3886 sym
= intern_c_string (namestring
);
3887 ko_fwd
->type
= Lisp_Fwd_Kboard_Obj
;
3888 ko_fwd
->offset
= offset
;
3889 XSYMBOL (sym
)->redirect
= SYMBOL_FORWARDED
;
3890 SET_SYMBOL_FWD (XSYMBOL (sym
), (union Lisp_Fwd
*)ko_fwd
);
3893 /* Record the value of load-path used at the start of dumping
3894 so we can see if the site changed it later during dumping. */
3895 static Lisp_Object dump_path
;
3901 int turn_off_warning
= 0;
3903 /* Compute the default load-path. */
3905 normal
= PATH_LOADSEARCH
;
3906 Vload_path
= decode_env_path (0, normal
);
3908 if (NILP (Vpurify_flag
))
3909 normal
= PATH_LOADSEARCH
;
3911 normal
= PATH_DUMPLOADSEARCH
;
3913 /* In a dumped Emacs, we normally have to reset the value of
3914 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3915 uses ../lisp, instead of the path of the installed elisp
3916 libraries. However, if it appears that Vload_path was changed
3917 from the default before dumping, don't override that value. */
3920 if (! NILP (Fequal (dump_path
, Vload_path
)))
3922 Vload_path
= decode_env_path (0, normal
);
3923 if (!NILP (Vinstallation_directory
))
3925 Lisp_Object tem
, tem1
, sitelisp
;
3927 /* Remove site-lisp dirs from path temporarily and store
3928 them in sitelisp, then conc them on at the end so
3929 they're always first in path. */
3933 tem
= Fcar (Vload_path
);
3934 tem1
= Fstring_match (build_string ("site-lisp"),
3938 Vload_path
= Fcdr (Vload_path
);
3939 sitelisp
= Fcons (tem
, sitelisp
);
3945 /* Add to the path the lisp subdir of the
3946 installation dir, if it exists. */
3947 tem
= Fexpand_file_name (build_string ("lisp"),
3948 Vinstallation_directory
);
3949 tem1
= Ffile_exists_p (tem
);
3952 if (NILP (Fmember (tem
, Vload_path
)))
3954 turn_off_warning
= 1;
3955 Vload_path
= Fcons (tem
, Vload_path
);
3959 /* That dir doesn't exist, so add the build-time
3960 Lisp dirs instead. */
3961 Vload_path
= nconc2 (Vload_path
, dump_path
);
3963 /* Add leim under the installation dir, if it exists. */
3964 tem
= Fexpand_file_name (build_string ("leim"),
3965 Vinstallation_directory
);
3966 tem1
= Ffile_exists_p (tem
);
3969 if (NILP (Fmember (tem
, Vload_path
)))
3970 Vload_path
= Fcons (tem
, Vload_path
);
3973 /* Add site-lisp under the installation dir, if it exists. */
3974 tem
= Fexpand_file_name (build_string ("site-lisp"),
3975 Vinstallation_directory
);
3976 tem1
= Ffile_exists_p (tem
);
3979 if (NILP (Fmember (tem
, Vload_path
)))
3980 Vload_path
= Fcons (tem
, Vload_path
);
3983 /* If Emacs was not built in the source directory,
3984 and it is run from where it was built, add to load-path
3985 the lisp, leim and site-lisp dirs under that directory. */
3987 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3991 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3992 Vinstallation_directory
);
3993 tem1
= Ffile_exists_p (tem
);
3995 /* Don't be fooled if they moved the entire source tree
3996 AFTER dumping Emacs. If the build directory is indeed
3997 different from the source dir, src/Makefile.in and
3998 src/Makefile will not be found together. */
3999 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4000 Vinstallation_directory
);
4001 tem2
= Ffile_exists_p (tem
);
4002 if (!NILP (tem1
) && NILP (tem2
))
4004 tem
= Fexpand_file_name (build_string ("lisp"),
4007 if (NILP (Fmember (tem
, Vload_path
)))
4008 Vload_path
= Fcons (tem
, Vload_path
);
4010 tem
= Fexpand_file_name (build_string ("leim"),
4013 if (NILP (Fmember (tem
, Vload_path
)))
4014 Vload_path
= Fcons (tem
, Vload_path
);
4016 tem
= Fexpand_file_name (build_string ("site-lisp"),
4019 if (NILP (Fmember (tem
, Vload_path
)))
4020 Vload_path
= Fcons (tem
, Vload_path
);
4023 if (!NILP (sitelisp
) && !no_site_lisp
)
4024 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4030 /* NORMAL refers to the lisp dir in the source directory. */
4031 /* We used to add ../lisp at the front here, but
4032 that caused trouble because it was copied from dump_path
4033 into Vload_path, above, when Vinstallation_directory was non-nil.
4034 It should be unnecessary. */
4035 Vload_path
= decode_env_path (0, normal
);
4036 dump_path
= Vload_path
;
4040 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4041 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4042 almost never correct, thereby causing a warning to be printed out that
4043 confuses users. Since PATH_LOADSEARCH is always overridden by the
4044 EMACSLOADPATH environment variable below, disable the warning on NT. */
4046 /* Warn if dirs in the *standard* path don't exist. */
4047 if (!turn_off_warning
)
4049 Lisp_Object path_tail
;
4051 for (path_tail
= Vload_path
;
4053 path_tail
= XCDR (path_tail
))
4055 Lisp_Object dirfile
;
4056 dirfile
= Fcar (path_tail
);
4057 if (STRINGP (dirfile
))
4059 dirfile
= Fdirectory_file_name (dirfile
);
4060 if (access (SDATA (dirfile
), 0) < 0)
4061 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4066 #endif /* !(WINDOWSNT || HAVE_NS) */
4068 /* If the EMACSLOADPATH environment variable is set, use its value.
4069 This doesn't apply if we're dumping. */
4071 if (NILP (Vpurify_flag
)
4072 && egetenv ("EMACSLOADPATH"))
4074 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4078 load_in_progress
= 0;
4079 Vload_file_name
= Qnil
;
4081 load_descriptor_list
= Qnil
;
4083 Vstandard_input
= Qt
;
4084 Vloads_in_progress
= Qnil
;
4087 /* Print a warning, using format string FORMAT, that directory DIRNAME
4088 does not exist. Print it on stderr and put it in *Messages*. */
4091 dir_warning (const char *format
, Lisp_Object dirname
)
4094 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4096 fprintf (stderr
, format
, SDATA (dirname
));
4097 sprintf (buffer
, format
, SDATA (dirname
));
4098 /* Don't log the warning before we've initialized!! */
4100 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4104 syms_of_lread (void)
4107 defsubr (&Sread_from_string
);
4109 defsubr (&Sintern_soft
);
4110 defsubr (&Sunintern
);
4111 defsubr (&Sget_load_suffixes
);
4113 defsubr (&Seval_buffer
);
4114 defsubr (&Seval_region
);
4115 defsubr (&Sread_char
);
4116 defsubr (&Sread_char_exclusive
);
4117 defsubr (&Sread_event
);
4118 defsubr (&Sget_file_char
);
4119 defsubr (&Smapatoms
);
4120 defsubr (&Slocate_file_internal
);
4122 DEFVAR_LISP ("obarray", Vobarray
,
4123 doc
: /* Symbol table for use by `intern' and `read'.
4124 It is a vector whose length ought to be prime for best results.
4125 The vector's contents don't make sense if examined from Lisp programs;
4126 to find all the symbols in an obarray, use `mapatoms'. */);
4128 DEFVAR_LISP ("values", Vvalues
,
4129 doc
: /* List of values of all expressions which were read, evaluated and printed.
4130 Order is reverse chronological. */);
4132 DEFVAR_LISP ("standard-input", Vstandard_input
,
4133 doc
: /* Stream for read to get input from.
4134 See documentation of `read' for possible values. */);
4135 Vstandard_input
= Qt
;
4137 DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions
,
4138 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4140 If this variable is a buffer, then only forms read from that buffer
4141 will be added to `read-symbol-positions-list'.
4142 If this variable is t, then all read forms will be added.
4143 The effect of all other values other than nil are not currently
4144 defined, although they may be in the future.
4146 The positions are relative to the last call to `read' or
4147 `read-from-string'. It is probably a bad idea to set this variable at
4148 the toplevel; bind it instead. */);
4149 Vread_with_symbol_positions
= Qnil
;
4151 DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list
,
4152 doc
: /* A list mapping read symbols to their positions.
4153 This variable is modified during calls to `read' or
4154 `read-from-string', but only when `read-with-symbol-positions' is
4157 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4158 CHAR-POSITION is an integer giving the offset of that occurrence of the
4159 symbol from the position where `read' or `read-from-string' started.
4161 Note that a symbol will appear multiple times in this list, if it was
4162 read multiple times. The list is in the same order as the symbols
4164 Vread_symbol_positions_list
= Qnil
;
4166 DEFVAR_LISP ("read-circle", Vread_circle
,
4167 doc
: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
4170 DEFVAR_LISP ("load-path", Vload_path
,
4171 doc
: /* *List of directories to search for files to load.
4172 Each element is a string (directory name) or nil (try default directory).
4173 Initialized based on EMACSLOADPATH environment variable, if any,
4174 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4176 DEFVAR_LISP ("load-suffixes", Vload_suffixes
,
4177 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4178 This list should not include the empty string.
4179 `load' and related functions try to append these suffixes, in order,
4180 to the specified file name if a Lisp suffix is allowed or required. */);
4181 Vload_suffixes
= Fcons (make_pure_c_string (".elc"),
4182 Fcons (make_pure_c_string (".el"), Qnil
));
4183 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes
,
4184 doc
: /* List of suffixes that indicate representations of \
4186 This list should normally start with the empty string.
4188 Enabling Auto Compression mode appends the suffixes in
4189 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4190 mode removes them again. `load' and related functions use this list to
4191 determine whether they should look for compressed versions of a file
4192 and, if so, which suffixes they should try to append to the file name
4193 in order to do so. However, if you want to customize which suffixes
4194 the loading functions recognize as compression suffixes, you should
4195 customize `jka-compr-load-suffixes' rather than the present variable. */);
4196 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4198 DEFVAR_BOOL ("load-in-progress", load_in_progress
,
4199 doc
: /* Non-nil if inside of `load'. */);
4200 Qload_in_progress
= intern_c_string ("load-in-progress");
4201 staticpro (&Qload_in_progress
);
4203 DEFVAR_LISP ("after-load-alist", Vafter_load_alist
,
4204 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4205 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4207 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4208 a symbol \(a feature name).
4210 When `load' is run and the file-name argument matches an element's
4211 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4212 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4214 An error in FORMS does not undo the load, but does prevent execution of
4215 the rest of the FORMS. */);
4216 Vafter_load_alist
= Qnil
;
4218 DEFVAR_LISP ("load-history", Vload_history
,
4219 doc
: /* Alist mapping loaded file names to symbols and features.
4220 Each alist element should be a list (FILE-NAME ENTRIES...), where
4221 FILE-NAME is the name of a file that has been loaded into Emacs.
4222 The file name is absolute and true (i.e. it doesn't contain symlinks).
4223 As an exception, one of the alist elements may have FILE-NAME nil,
4224 for symbols and features not associated with any file.
4226 The remaining ENTRIES in the alist element describe the functions and
4227 variables defined in that file, the features provided, and the
4228 features required. Each entry has the form `(provide . FEATURE)',
4229 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4230 `(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t
4231 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4232 SYMBOL was an autoload before this file redefined it as a function.
4234 During preloading, the file name recorded is relative to the main Lisp
4235 directory. These file names are converted to absolute at startup. */);
4236 Vload_history
= Qnil
;
4238 DEFVAR_LISP ("load-file-name", Vload_file_name
,
4239 doc
: /* Full name of file being loaded by `load'. */);
4240 Vload_file_name
= Qnil
;
4242 DEFVAR_LISP ("user-init-file", Vuser_init_file
,
4243 doc
: /* File name, including directory, of user's initialization file.
4244 If the file loaded had extension `.elc', and the corresponding source file
4245 exists, this variable contains the name of source file, suitable for use
4246 by functions like `custom-save-all' which edit the init file.
4247 While Emacs loads and evaluates the init file, value is the real name
4248 of the file, regardless of whether or not it has the `.elc' extension. */);
4249 Vuser_init_file
= Qnil
;
4251 DEFVAR_LISP ("current-load-list", Vcurrent_load_list
,
4252 doc
: /* Used for internal purposes by `load'. */);
4253 Vcurrent_load_list
= Qnil
;
4255 DEFVAR_LISP ("load-read-function", Vload_read_function
,
4256 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4257 The default is nil, which means use the function `read'. */);
4258 Vload_read_function
= Qnil
;
4260 DEFVAR_LISP ("load-source-file-function", Vload_source_file_function
,
4261 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4262 This function is for doing code conversion before reading the source file.
4263 If nil, loading is done without any code conversion.
4264 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4265 FULLNAME is the full name of FILE.
4266 See `load' for the meaning of the remaining arguments. */);
4267 Vload_source_file_function
= Qnil
;
4269 DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings
,
4270 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4271 This is useful when the file being loaded is a temporary copy. */);
4272 load_force_doc_strings
= 0;
4274 DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte
,
4275 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4276 This is normally bound by `load' and `eval-buffer' to control `read',
4277 and is not meant for users to change. */);
4278 load_convert_to_unibyte
= 0;
4280 DEFVAR_LISP ("source-directory", Vsource_directory
,
4281 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4282 You cannot count on them to still be there! */);
4284 = Fexpand_file_name (build_string ("../"),
4285 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4287 DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list
,
4288 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4289 Vpreloaded_file_list
= Qnil
;
4291 DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars
,
4292 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4293 Vbyte_boolean_vars
= Qnil
;
4295 DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries
,
4296 doc
: /* Non-nil means load dangerous compiled Lisp files.
4297 Some versions of XEmacs use different byte codes than Emacs. These
4298 incompatible byte codes can make Emacs crash when it tries to execute
4300 load_dangerous_libraries
= 0;
4302 DEFVAR_BOOL ("force-load-messages", force_load_messages
,
4303 doc
: /* Non-nil means force printing messages when loading Lisp files.
4304 This overrides the value of the NOMESSAGE argument to `load'. */);
4305 force_load_messages
= 0;
4307 DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp
,
4308 doc
: /* Regular expression matching safe to load compiled Lisp files.
4309 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4310 from the file, and matches them against this regular expression.
4311 When the regular expression matches, the file is considered to be safe
4312 to load. See also `load-dangerous-libraries'. */);
4313 Vbytecomp_version_regexp
4314 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4316 DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list
,
4317 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4318 Veval_buffer_list
= Qnil
;
4320 DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes
,
4321 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4322 Vold_style_backquotes
= Qnil
;
4323 Qold_style_backquotes
= intern_c_string ("old-style-backquotes");
4324 staticpro (&Qold_style_backquotes
);
4326 /* Vsource_directory was initialized in init_lread. */
4328 load_descriptor_list
= Qnil
;
4329 staticpro (&load_descriptor_list
);
4331 Qcurrent_load_list
= intern_c_string ("current-load-list");
4332 staticpro (&Qcurrent_load_list
);
4334 Qstandard_input
= intern_c_string ("standard-input");
4335 staticpro (&Qstandard_input
);
4337 Qread_char
= intern_c_string ("read-char");
4338 staticpro (&Qread_char
);
4340 Qget_file_char
= intern_c_string ("get-file-char");
4341 staticpro (&Qget_file_char
);
4343 Qget_emacs_mule_file_char
= intern_c_string ("get-emacs-mule-file-char");
4344 staticpro (&Qget_emacs_mule_file_char
);
4346 Qload_force_doc_strings
= intern_c_string ("load-force-doc-strings");
4347 staticpro (&Qload_force_doc_strings
);
4349 Qbackquote
= intern_c_string ("`");
4350 staticpro (&Qbackquote
);
4351 Qcomma
= intern_c_string (",");
4352 staticpro (&Qcomma
);
4353 Qcomma_at
= intern_c_string (",@");
4354 staticpro (&Qcomma_at
);
4355 Qcomma_dot
= intern_c_string (",.");
4356 staticpro (&Qcomma_dot
);
4358 Qinhibit_file_name_operation
= intern_c_string ("inhibit-file-name-operation");
4359 staticpro (&Qinhibit_file_name_operation
);
4361 Qascii_character
= intern_c_string ("ascii-character");
4362 staticpro (&Qascii_character
);
4364 Qfunction
= intern_c_string ("function");
4365 staticpro (&Qfunction
);
4367 Qload
= intern_c_string ("load");
4370 Qload_file_name
= intern_c_string ("load-file-name");
4371 staticpro (&Qload_file_name
);
4373 Qeval_buffer_list
= intern_c_string ("eval-buffer-list");
4374 staticpro (&Qeval_buffer_list
);
4376 Qfile_truename
= intern_c_string ("file-truename");
4377 staticpro (&Qfile_truename
) ;
4379 Qdo_after_load_evaluation
= intern_c_string ("do-after-load-evaluation");
4380 staticpro (&Qdo_after_load_evaluation
) ;
4382 staticpro (&dump_path
);
4384 staticpro (&read_objects
);
4385 read_objects
= Qnil
;
4386 staticpro (&seen_list
);
4389 Vloads_in_progress
= Qnil
;
4390 staticpro (&Vloads_in_progress
);
4392 Qhash_table
= intern_c_string ("hash-table");
4393 staticpro (&Qhash_table
);
4394 Qdata
= intern_c_string ("data");
4396 Qtest
= intern_c_string ("test");
4398 Qsize
= intern_c_string ("size");
4400 Qweakness
= intern_c_string ("weakness");
4401 staticpro (&Qweakness
);
4402 Qrehash_size
= intern_c_string ("rehash-size");
4403 staticpro (&Qrehash_size
);
4404 Qrehash_threshold
= intern_c_string ("rehash-threshold");
4405 staticpro (&Qrehash_threshold
);