1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
32 #include "intervals.h"
34 #include "character.h"
41 #include "termhooks.h"
43 #include "blockinput.h"
47 #include <unistd.h> /* to get X_OK */
64 #endif /* HAVE_SETLOCALE */
74 #define file_offset off_t
75 #define file_tell ftello
77 #define file_offset long
78 #define file_tell ftell
85 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
86 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
87 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
88 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
89 Lisp_Object Qinhibit_file_name_operation
;
90 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
91 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
93 /* Used instead of Qget_file_char while loading *.elc files compiled
94 by Emacs 21 or older. */
95 static Lisp_Object Qget_emacs_mule_file_char
;
97 static Lisp_Object Qload_force_doc_strings
;
99 extern Lisp_Object Qevent_symbol_element_mask
;
100 extern Lisp_Object Qfile_exists_p
;
102 /* non-zero if inside `load' */
103 int load_in_progress
;
105 /* Directory in which the sources were found. */
106 Lisp_Object Vsource_directory
;
108 /* Search path and suffixes for files to be loaded. */
109 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
111 /* File name of user's init file. */
112 Lisp_Object Vuser_init_file
;
114 /* This is the user-visible association list that maps features to
115 lists of defs in their load files. */
116 Lisp_Object Vload_history
;
118 /* This is used to build the load history. */
119 Lisp_Object Vcurrent_load_list
;
121 /* List of files that were preloaded. */
122 Lisp_Object Vpreloaded_file_list
;
124 /* Name of file actually being read by `load'. */
125 Lisp_Object Vload_file_name
;
127 /* Function to use for reading, in `load' and friends. */
128 Lisp_Object Vload_read_function
;
130 /* The association list of objects read with the #n=object form.
131 Each member of the list has the form (n . object), and is used to
132 look up the object for the corresponding #n# construct.
133 It must be set to nil before all top-level calls to read0. */
134 Lisp_Object read_objects
;
136 /* Nonzero means load should forcibly load all dynamic doc strings. */
137 static int load_force_doc_strings
;
139 /* Nonzero means read should convert strings to unibyte. */
140 static int load_convert_to_unibyte
;
142 /* Nonzero means READCHAR should read bytes one by one (not character)
143 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
144 This is set to 1 by read1 temporarily while handling #@NUMBER. */
145 static int load_each_byte
;
147 /* Function to use for loading an Emacs Lisp source file (not
148 compiled) instead of readevalloop. */
149 Lisp_Object Vload_source_file_function
;
151 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
152 Lisp_Object Vbyte_boolean_vars
;
154 /* Whether or not to add a `read-positions' property to symbols
156 Lisp_Object Vread_with_symbol_positions
;
158 /* List of (SYMBOL . POSITION) accumulated so far. */
159 Lisp_Object Vread_symbol_positions_list
;
161 /* List of descriptors now open for Fload. */
162 static Lisp_Object load_descriptor_list
;
164 /* File for get_file_char to read from. Use by load. */
165 static FILE *instream
;
167 /* When nonzero, read conses in pure space */
168 static int read_pure
;
170 /* For use within read-from-string (this reader is non-reentrant!!) */
171 static int read_from_string_index
;
172 static int read_from_string_index_byte
;
173 static int read_from_string_limit
;
175 /* Number of characters read in the current call to Fread or
176 Fread_from_string. */
177 static int readchar_count
;
179 /* This contains the last string skipped with #@. */
180 static char *saved_doc_string
;
181 /* Length of buffer allocated in saved_doc_string. */
182 static int saved_doc_string_size
;
183 /* Length of actual data in saved_doc_string. */
184 static int saved_doc_string_length
;
185 /* This is the file position that string came from. */
186 static file_offset saved_doc_string_position
;
188 /* This contains the previous string skipped with #@.
189 We copy it from saved_doc_string when a new string
190 is put in saved_doc_string. */
191 static char *prev_saved_doc_string
;
192 /* Length of buffer allocated in prev_saved_doc_string. */
193 static int prev_saved_doc_string_size
;
194 /* Length of actual data in prev_saved_doc_string. */
195 static int prev_saved_doc_string_length
;
196 /* This is the file position that string came from. */
197 static file_offset prev_saved_doc_string_position
;
199 /* Nonzero means inside a new-style backquote
200 with no surrounding parentheses.
201 Fread initializes this to zero, so we need not specbind it
202 or worry about what happens to it when there is an error. */
203 static int new_backquote_flag
;
204 static Lisp_Object Vold_style_backquotes
, Qold_style_backquotes
;
206 /* A list of file names for files being loaded in Fload. Used to
207 check for recursive loads. */
209 static Lisp_Object Vloads_in_progress
;
211 /* Non-zero means load dangerous compiled Lisp files. */
213 int load_dangerous_libraries
;
215 /* A regular expression used to detect files compiled with Emacs. */
217 static Lisp_Object Vbytecomp_version_regexp
;
219 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
222 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
223 Lisp_Object (*) (), int,
224 Lisp_Object
, Lisp_Object
,
225 Lisp_Object
, Lisp_Object
));
226 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
227 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
229 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
230 static void end_of_file_error
P_ (()) NO_RETURN
;
233 /* Functions that read one byte from the current source READCHARFUN
234 or unreads one byte. If the integer argument C is -1, it returns
235 one read byte, or -1 when there's no more byte in the source. If C
236 is 0 or positive, it unreads C, and the return value is not
239 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
240 static int readbyte_from_file
P_ ((int, Lisp_Object
));
241 static int readbyte_from_string
P_ ((int, Lisp_Object
));
243 /* Handle unreading and rereading of characters.
244 Write READCHAR to read a character,
245 UNREAD(c) to unread c to be read again.
247 These macros correctly read/unread multibyte characters. */
249 #define READCHAR readchar (readcharfun, NULL)
250 #define UNREAD(c) unreadchar (readcharfun, c)
252 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
253 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
255 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
256 Qlambda, or a cons, we use this to keep an unread character because
257 a file stream can't handle multibyte-char unreading. The value -1
258 means that there's no unread character. */
259 static int unread_char
;
262 readchar (readcharfun
, multibyte
)
263 Lisp_Object readcharfun
;
268 int (*readbyte
) P_ ((int, Lisp_Object
));
269 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
271 int emacs_mule_encoding
= 0;
278 if (BUFFERP (readcharfun
))
280 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
282 int pt_byte
= BUF_PT_BYTE (inbuffer
);
284 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
287 if (! NILP (inbuffer
->enable_multibyte_characters
))
289 /* Fetch the character code from the buffer. */
290 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
291 BUF_INC_POS (inbuffer
, pt_byte
);
292 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
298 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
299 if (! ASCII_BYTE_P (c
))
300 c
= BYTE8_TO_CHAR (c
);
303 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
307 if (MARKERP (readcharfun
))
309 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
311 int bytepos
= marker_byte_position (readcharfun
);
313 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
316 if (! NILP (inbuffer
->enable_multibyte_characters
))
318 /* Fetch the character code from the buffer. */
319 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
320 BUF_INC_POS (inbuffer
, bytepos
);
321 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
327 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
328 if (! ASCII_BYTE_P (c
))
329 c
= BYTE8_TO_CHAR (c
);
333 XMARKER (readcharfun
)->bytepos
= bytepos
;
334 XMARKER (readcharfun
)->charpos
++;
339 if (EQ (readcharfun
, Qlambda
))
341 readbyte
= readbyte_for_lambda
;
345 if (EQ (readcharfun
, Qget_file_char
))
347 readbyte
= readbyte_from_file
;
351 if (STRINGP (readcharfun
))
353 if (read_from_string_index
>= read_from_string_limit
)
355 else if (STRING_MULTIBYTE (readcharfun
))
359 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, readcharfun
,
360 read_from_string_index
,
361 read_from_string_index_byte
);
365 c
= SREF (readcharfun
, read_from_string_index_byte
);
366 read_from_string_index
++;
367 read_from_string_index_byte
++;
372 if (CONSP (readcharfun
))
374 /* This is the case that read_vector is reading from a unibyte
375 string that contains a byte sequence previously skipped
376 because of #@NUMBER. The car part of readcharfun is that
377 string, and the cdr part is a value of readcharfun given to
379 readbyte
= readbyte_from_string
;
380 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
381 emacs_mule_encoding
= 1;
385 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
387 readbyte
= readbyte_from_file
;
388 emacs_mule_encoding
= 1;
392 tem
= call0 (readcharfun
);
399 if (unread_char
>= 0)
405 c
= (*readbyte
) (-1, readcharfun
);
406 if (c
< 0 || load_each_byte
)
410 if (ASCII_BYTE_P (c
))
412 if (emacs_mule_encoding
)
413 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
416 len
= BYTES_BY_CHAR_HEAD (c
);
419 c
= (*readbyte
) (-1, readcharfun
);
420 if (c
< 0 || ! TRAILING_CODE_P (c
))
423 (*readbyte
) (buf
[i
], readcharfun
);
424 return BYTE8_TO_CHAR (buf
[0]);
428 return STRING_CHAR (buf
, i
);
431 /* Unread the character C in the way appropriate for the stream READCHARFUN.
432 If the stream is a user function, call it with the char as argument. */
435 unreadchar (readcharfun
, c
)
436 Lisp_Object readcharfun
;
441 /* Don't back up the pointer if we're unreading the end-of-input mark,
442 since readchar didn't advance it when we read it. */
444 else if (BUFFERP (readcharfun
))
446 struct buffer
*b
= XBUFFER (readcharfun
);
447 int bytepos
= BUF_PT_BYTE (b
);
450 if (! NILP (b
->enable_multibyte_characters
))
451 BUF_DEC_POS (b
, bytepos
);
455 BUF_PT_BYTE (b
) = bytepos
;
457 else if (MARKERP (readcharfun
))
459 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
460 int bytepos
= XMARKER (readcharfun
)->bytepos
;
462 XMARKER (readcharfun
)->charpos
--;
463 if (! NILP (b
->enable_multibyte_characters
))
464 BUF_DEC_POS (b
, bytepos
);
468 XMARKER (readcharfun
)->bytepos
= bytepos
;
470 else if (STRINGP (readcharfun
))
472 read_from_string_index
--;
473 read_from_string_index_byte
474 = string_char_to_byte (readcharfun
, read_from_string_index
);
476 else if (CONSP (readcharfun
))
480 else if (EQ (readcharfun
, Qlambda
))
484 else if (EQ (readcharfun
, Qget_file_char
)
485 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
490 ungetc (c
, instream
);
497 call1 (readcharfun
, make_number (c
));
501 readbyte_for_lambda (c
, readcharfun
)
503 Lisp_Object readcharfun
;
505 return read_bytecode_char (c
>= 0);
510 readbyte_from_file (c
, readcharfun
)
512 Lisp_Object readcharfun
;
517 ungetc (c
, instream
);
526 /* Interrupted reads have been observed while reading over the network */
527 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
539 return (c
== EOF
? -1 : c
);
543 readbyte_from_string (c
, readcharfun
)
545 Lisp_Object readcharfun
;
547 Lisp_Object string
= XCAR (readcharfun
);
551 read_from_string_index
--;
552 read_from_string_index_byte
553 = string_char_to_byte (string
, read_from_string_index
);
556 if (read_from_string_index
>= read_from_string_limit
)
559 FETCH_STRING_CHAR_ADVANCE (c
, string
,
560 read_from_string_index
,
561 read_from_string_index_byte
);
566 /* Read one non-ASCII character from INSTREAM. The character is
567 encoded in `emacs-mule' and the first byte is already read in
570 extern char emacs_mule_bytes
[256];
573 read_emacs_mule_char (c
, readbyte
, readcharfun
)
575 int (*readbyte
) P_ ((int, Lisp_Object
));
576 Lisp_Object readcharfun
;
578 /* Emacs-mule coding uses at most 4-byte for one character. */
579 unsigned char buf
[4];
580 int len
= emacs_mule_bytes
[c
];
581 struct charset
*charset
;
586 /* C is not a valid leading-code of `emacs-mule'. */
587 return BYTE8_TO_CHAR (c
);
593 c
= (*readbyte
) (-1, readcharfun
);
597 (*readbyte
) (buf
[i
], readcharfun
);
598 return BYTE8_TO_CHAR (buf
[0]);
605 charset
= emacs_mule_charset
[buf
[0]];
606 code
= buf
[1] & 0x7F;
610 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
611 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
613 charset
= emacs_mule_charset
[buf
[1]];
614 code
= buf
[2] & 0x7F;
618 charset
= emacs_mule_charset
[buf
[0]];
619 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
624 charset
= emacs_mule_charset
[buf
[1]];
625 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
627 c
= DECODE_CHAR (charset
, code
);
629 Fsignal (Qinvalid_read_syntax
,
630 Fcons (build_string ("invalid multibyte form"), Qnil
));
635 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
637 static Lisp_Object read0
P_ ((Lisp_Object
));
638 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
640 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
641 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
643 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
645 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
647 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
650 /* Get a character from the tty. */
652 /* Read input events until we get one that's acceptable for our purposes.
654 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
655 until we get a character we like, and then stuffed into
658 If ASCII_REQUIRED is non-zero, we check function key events to see
659 if the unmodified version of the symbol has a Qascii_character
660 property, and use that character, if present.
662 If ERROR_NONASCII is non-zero, we signal an error if the input we
663 get isn't an ASCII character with modifiers. If it's zero but
664 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
667 If INPUT_METHOD is nonzero, we invoke the current input method
668 if the character warrants that.
670 If SECONDS is a number, we wait that many seconds for input, and
671 return Qnil if no input arrives within that time. */
674 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
675 input_method
, seconds
)
676 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
679 Lisp_Object val
, delayed_switch_frame
;
682 #ifdef HAVE_WINDOW_SYSTEM
683 if (display_hourglass_p
)
687 delayed_switch_frame
= Qnil
;
689 /* Compute timeout. */
690 if (NUMBERP (seconds
))
692 EMACS_TIME wait_time
;
694 double duration
= extract_float (seconds
);
696 sec
= (int) duration
;
697 usec
= (duration
- sec
) * 1000000;
698 EMACS_GET_TIME (end_time
);
699 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
700 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
703 /* Read until we get an acceptable event. */
706 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
707 NUMBERP (seconds
) ? &end_time
: NULL
);
708 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
713 /* switch-frame events are put off until after the next ASCII
714 character. This is better than signaling an error just because
715 the last characters were typed to a separate minibuffer frame,
716 for example. Eventually, some code which can deal with
717 switch-frame events will read it and process it. */
719 && EVENT_HAS_PARAMETERS (val
)
720 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
722 delayed_switch_frame
= val
;
726 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
728 /* Convert certain symbols to their ASCII equivalents. */
731 Lisp_Object tem
, tem1
;
732 tem
= Fget (val
, Qevent_symbol_element_mask
);
735 tem1
= Fget (Fcar (tem
), Qascii_character
);
736 /* Merge this symbol's modifier bits
737 with the ASCII equivalent of its basic code. */
739 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
743 /* If we don't have a character now, deal with it appropriately. */
748 Vunread_command_events
= Fcons (val
, Qnil
);
749 error ("Non-character input-event");
756 if (! NILP (delayed_switch_frame
))
757 unread_switch_frame
= delayed_switch_frame
;
761 #ifdef HAVE_WINDOW_SYSTEM
762 if (display_hourglass_p
)
771 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
772 doc
: /* Read a character from the command input (keyboard or macro).
773 It is returned as a number.
774 If the character has modifiers, they are resolved and reflected to the
775 character code if possible (e.g. C-SPC -> 0).
777 If the user generates an event which is not a character (i.e. a mouse
778 click or function key event), `read-char' signals an error. As an
779 exception, switch-frame events are put off until non-character events
781 If you want to read non-character events, or ignore them, call
782 `read-event' or `read-char-exclusive' instead.
784 If the optional argument PROMPT is non-nil, display that as a prompt.
785 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
786 input method is turned on in the current buffer, that input method
787 is used for reading a character.
788 If the optional argument SECONDS is non-nil, it should be a number
789 specifying the maximum number of seconds to wait for input. If no
790 input arrives in that time, return nil. SECONDS may be a
791 floating-point value. */)
792 (prompt
, inherit_input_method
, seconds
)
793 Lisp_Object prompt
, inherit_input_method
, seconds
;
799 message_with_string ("%s", prompt
, 0);
800 val
= read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
802 return make_number (char_resolve_modifier_mask (c
));
805 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
806 doc
: /* Read an event object from the input stream.
807 If the optional argument PROMPT is non-nil, display that as a prompt.
808 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
809 input method is turned on in the current buffer, that input method
810 is used for reading a character.
811 If the optional argument SECONDS is non-nil, it should be a number
812 specifying the maximum number of seconds to wait for input. If no
813 input arrives in that time, return nil. SECONDS may be a
814 floating-point value. */)
815 (prompt
, inherit_input_method
, seconds
)
816 Lisp_Object prompt
, inherit_input_method
, seconds
;
819 message_with_string ("%s", prompt
, 0);
820 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
823 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
824 doc
: /* Read a character from the command input (keyboard or macro).
825 It is returned as a number. Non-character events are ignored.
826 If the character has modifiers, they are resolved and reflected to the
827 character code if possible (e.g. C-SPC -> 0).
829 If the optional argument PROMPT is non-nil, display that as a prompt.
830 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
831 input method is turned on in the current buffer, that input method
832 is used for reading a character.
833 If the optional argument SECONDS is non-nil, it should be a number
834 specifying the maximum number of seconds to wait for input. If no
835 input arrives in that time, return nil. SECONDS may be a
836 floating-point value. */)
837 (prompt
, inherit_input_method
, seconds
)
838 Lisp_Object prompt
, inherit_input_method
, seconds
;
844 message_with_string ("%s", prompt
, 0);
845 val
= read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
847 return make_number (char_resolve_modifier_mask (c
));
850 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
851 doc
: /* Don't use this yourself. */)
854 register Lisp_Object val
;
856 XSETINT (val
, getc (instream
));
863 /* Value is a version number of byte compiled code if the file
864 associated with file descriptor FD is a compiled Lisp file that's
865 safe to load. Only files compiled with Emacs are safe to load.
866 Files compiled with XEmacs can lead to a crash in Fbyte_code
867 because of an incompatible change in the byte compiler. */
878 /* Read the first few bytes from the file, and look for a line
879 specifying the byte compiler version used. */
880 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
885 /* Skip to the next newline, skipping over the initial `ELC'
886 with NUL bytes following it, but note the version. */
887 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
892 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
899 lseek (fd
, 0, SEEK_SET
);
904 /* Callback for record_unwind_protect. Restore the old load list OLD,
905 after loading a file successfully. */
908 record_load_unwind (old
)
911 return Vloads_in_progress
= old
;
914 /* This handler function is used via internal_condition_case_1. */
917 load_error_handler (data
)
924 load_warn_old_style_backquotes (file
)
927 if (!NILP (Vold_style_backquotes
))
930 args
[0] = build_string ("Loading `%s': old-style backquotes detected!");
937 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
938 doc
: /* Return the suffixes that `load' should try if a suffix is \
940 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
943 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
944 while (CONSP (suffixes
))
946 Lisp_Object exts
= Vload_file_rep_suffixes
;
947 suffix
= XCAR (suffixes
);
948 suffixes
= XCDR (suffixes
);
953 lst
= Fcons (concat2 (suffix
, ext
), lst
);
956 return Fnreverse (lst
);
959 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
960 doc
: /* Execute a file of Lisp code named FILE.
961 First try FILE with `.elc' appended, then try with `.el',
962 then try FILE unmodified (the exact suffixes in the exact order are
963 determined by `load-suffixes'). Environment variable references in
964 FILE are replaced with their values by calling `substitute-in-file-name'.
965 This function searches the directories in `load-path'.
967 If optional second arg NOERROR is non-nil,
968 report no error if FILE doesn't exist.
969 Print messages at start and end of loading unless
970 optional third arg NOMESSAGE is non-nil.
971 If optional fourth arg NOSUFFIX is non-nil, don't try adding
972 suffixes `.elc' or `.el' to the specified name FILE.
973 If optional fifth arg MUST-SUFFIX is non-nil, insist on
974 the suffix `.elc' or `.el'; don't accept just FILE unless
975 it ends in one of those suffixes or includes a directory name.
977 If this function fails to find a file, it may look for different
978 representations of that file before trying another file.
979 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
980 to the file name. Emacs uses this feature mainly to find compressed
981 versions of files when Auto Compression mode is enabled.
983 The exact suffixes that this function tries out, in the exact order,
984 are given by the value of the variable `load-file-rep-suffixes' if
985 NOSUFFIX is non-nil and by the return value of the function
986 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
987 MUST-SUFFIX are nil, this function first tries out the latter suffixes
990 Loading a file records its definitions, and its `provide' and
991 `require' calls, in an element of `load-history' whose
992 car is the file name loaded. See `load-history'.
994 Return t if the file exists and loads successfully. */)
995 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
996 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
998 register FILE *stream
;
999 register int fd
= -1;
1000 int count
= SPECPDL_INDEX ();
1001 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1002 Lisp_Object found
, efound
, hist_file_name
;
1003 /* 1 means we printed the ".el is newer" message. */
1005 /* 1 means we are loading a compiled file. */
1007 Lisp_Object handler
;
1017 CHECK_STRING (file
);
1019 /* If file name is magic, call the handler. */
1020 /* This shouldn't be necessary any more now that `openp' handles it right.
1021 handler = Ffind_file_name_handler (file, Qload);
1022 if (!NILP (handler))
1023 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1025 /* Do this after the handler to avoid
1026 the need to gcpro noerror, nomessage and nosuffix.
1027 (Below here, we care only whether they are nil or not.)
1028 The presence of this call is the result of a historical accident:
1029 it used to be in every file-operation and when it got removed
1030 everywhere, it accidentally stayed here. Since then, enough people
1031 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1032 that it seemed risky to remove. */
1033 if (! NILP (noerror
))
1035 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
1036 Qt
, load_error_handler
);
1041 file
= Fsubstitute_in_file_name (file
);
1044 /* Avoid weird lossage with null string as arg,
1045 since it would try to load a directory as a Lisp file */
1046 if (SCHARS (file
) > 0)
1048 int size
= SBYTES (file
);
1051 GCPRO2 (file
, found
);
1053 if (! NILP (must_suffix
))
1055 /* Don't insist on adding a suffix if FILE already ends with one. */
1057 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1060 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1062 /* Don't insist on adding a suffix
1063 if the argument includes a directory name. */
1064 else if (! NILP (Ffile_name_directory (file
)))
1068 fd
= openp (Vload_path
, file
,
1069 (!NILP (nosuffix
) ? Qnil
1070 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1071 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1072 tmp
[1] = Vload_file_rep_suffixes
,
1081 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1085 /* Tell startup.el whether or not we found the user's init file. */
1086 if (EQ (Qt
, Vuser_init_file
))
1087 Vuser_init_file
= found
;
1089 /* If FD is -2, that means openp found a magic file. */
1092 if (NILP (Fequal (found
, file
)))
1093 /* If FOUND is a different file name from FILE,
1094 find its handler even if we have already inhibited
1095 the `load' operation on FILE. */
1096 handler
= Ffind_file_name_handler (found
, Qt
);
1098 handler
= Ffind_file_name_handler (found
, Qload
);
1099 if (! NILP (handler
))
1100 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1103 /* Check if we're stuck in a recursive load cycle.
1105 2000-09-21: It's not possible to just check for the file loaded
1106 being a member of Vloads_in_progress. This fails because of the
1107 way the byte compiler currently works; `provide's are not
1108 evaluted, see font-lock.el/jit-lock.el as an example. This
1109 leads to a certain amount of ``normal'' recursion.
1111 Also, just loading a file recursively is not always an error in
1112 the general case; the second load may do something different. */
1116 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1117 if (!NILP (Fequal (found
, XCAR (tem
))))
1123 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1125 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1126 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1129 /* Get the name for load-history. */
1130 hist_file_name
= (! NILP (Vpurify_flag
)
1131 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1132 tmp
[1] = Ffile_name_nondirectory (found
),
1138 /* Check for the presence of old-style quotes and warn about them. */
1139 specbind (Qold_style_backquotes
, Qnil
);
1140 record_unwind_protect (load_warn_old_style_backquotes
, file
);
1142 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1144 || (version
= safe_to_load_p (fd
)) > 0)
1145 /* Load .elc files directly, but not when they are
1146 remote and have no handler! */
1153 GCPRO3 (file
, found
, hist_file_name
);
1156 && ! (version
= safe_to_load_p (fd
)))
1159 if (!load_dangerous_libraries
)
1163 error ("File `%s' was not compiled in Emacs",
1166 else if (!NILP (nomessage
))
1167 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1172 efound
= ENCODE_FILE (found
);
1177 stat ((char *)SDATA (efound
), &s1
);
1178 SSET (efound
, SBYTES (efound
) - 1, 0);
1179 result
= stat ((char *)SDATA (efound
), &s2
);
1180 SSET (efound
, SBYTES (efound
) - 1, 'c');
1182 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1184 /* Make the progress messages mention that source is newer. */
1187 /* If we won't print another message, mention this anyway. */
1188 if (!NILP (nomessage
))
1190 Lisp_Object msg_file
;
1191 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1192 message_with_string ("Source file `%s' newer than byte-compiled file",
1201 /* We are loading a source file (*.el). */
1202 if (!NILP (Vload_source_file_function
))
1208 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1209 NILP (noerror
) ? Qnil
: Qt
,
1210 NILP (nomessage
) ? Qnil
: Qt
);
1211 return unbind_to (count
, val
);
1215 GCPRO3 (file
, found
, hist_file_name
);
1219 efound
= ENCODE_FILE (found
);
1220 stream
= fopen ((char *) SDATA (efound
), fmode
);
1221 #else /* not WINDOWSNT */
1222 stream
= fdopen (fd
, fmode
);
1223 #endif /* not WINDOWSNT */
1227 error ("Failure to create stdio stream for %s", SDATA (file
));
1230 if (! NILP (Vpurify_flag
))
1231 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1233 if (NILP (nomessage
))
1236 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1239 message_with_string ("Loading %s (source)...", file
, 1);
1241 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1243 else /* The typical case; compiled file newer than source file. */
1244 message_with_string ("Loading %s...", file
, 1);
1247 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1248 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1249 specbind (Qload_file_name
, found
);
1250 specbind (Qinhibit_file_name_operation
, Qnil
);
1251 load_descriptor_list
1252 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1254 if (! version
|| version
>= 22)
1255 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1256 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1259 /* We can't handle a file which was compiled with
1260 byte-compile-dynamic by older version of Emacs. */
1261 specbind (Qload_force_doc_strings
, Qt
);
1262 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1263 0, Qnil
, Qnil
, Qnil
, Qnil
);
1265 unbind_to (count
, Qnil
);
1267 /* Run any eval-after-load forms for this file */
1268 if (NILP (Vpurify_flag
)
1269 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1270 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1274 if (saved_doc_string
)
1275 free (saved_doc_string
);
1276 saved_doc_string
= 0;
1277 saved_doc_string_size
= 0;
1279 if (prev_saved_doc_string
)
1280 xfree (prev_saved_doc_string
);
1281 prev_saved_doc_string
= 0;
1282 prev_saved_doc_string_size
= 0;
1284 if (!noninteractive
&& NILP (nomessage
))
1287 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1290 message_with_string ("Loading %s (source)...done", file
, 1);
1292 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1294 else /* The typical case; compiled file newer than source file. */
1295 message_with_string ("Loading %s...done", file
, 1);
1298 if (!NILP (Fequal (build_string ("obsolete"),
1299 Ffile_name_nondirectory
1300 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1301 message_with_string ("Package %s is obsolete", file
, 1);
1307 load_unwind (arg
) /* used as unwind-protect function in load */
1310 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1317 if (--load_in_progress
< 0) load_in_progress
= 0;
1322 load_descriptor_unwind (oldlist
)
1323 Lisp_Object oldlist
;
1325 load_descriptor_list
= oldlist
;
1329 /* Close all descriptors in use for Floads.
1330 This is used when starting a subprocess. */
1337 for (tail
= load_descriptor_list
; CONSP (tail
); tail
= XCDR (tail
))
1338 emacs_close (XFASTINT (XCAR (tail
)));
1343 complete_filename_p (pathname
)
1344 Lisp_Object pathname
;
1346 register const unsigned char *s
= SDATA (pathname
);
1347 return (IS_DIRECTORY_SEP (s
[0])
1348 || (SCHARS (pathname
) > 2
1349 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1356 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1357 doc
: /* Search for FILENAME through PATH.
1358 Returns the file's name in absolute form, or nil if not found.
1359 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1360 file name when searching.
1361 If non-nil, PREDICATE is used instead of `file-readable-p'.
1362 PREDICATE can also be an integer to pass to the access(2) function,
1363 in which case file-name-handlers are ignored. */)
1364 (filename
, path
, suffixes
, predicate
)
1365 Lisp_Object filename
, path
, suffixes
, predicate
;
1368 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1369 if (NILP (predicate
) && fd
> 0)
1375 /* Search for a file whose name is STR, looking in directories
1376 in the Lisp list PATH, and trying suffixes from SUFFIX.
1377 On success, returns a file descriptor. On failure, returns -1.
1379 SUFFIXES is a list of strings containing possible suffixes.
1380 The empty suffix is automatically added if the list is empty.
1382 PREDICATE non-nil means don't open the files,
1383 just look for one that satisfies the predicate. In this case,
1384 returns 1 on success. The predicate can be a lisp function or
1385 an integer to pass to `access' (in which case file-name-handlers
1388 If STOREPTR is nonzero, it points to a slot where the name of
1389 the file actually found should be stored as a Lisp string.
1390 nil is stored there on failure.
1392 If the file we find is remote, return -2
1393 but store the found remote file name in *STOREPTR. */
1396 openp (path
, str
, suffixes
, storeptr
, predicate
)
1397 Lisp_Object path
, str
;
1398 Lisp_Object suffixes
;
1399 Lisp_Object
*storeptr
;
1400 Lisp_Object predicate
;
1405 register char *fn
= buf
;
1408 Lisp_Object filename
;
1410 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1411 Lisp_Object string
, tail
, encoded_fn
;
1412 int max_suffix_len
= 0;
1416 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1418 CHECK_STRING_CAR (tail
);
1419 max_suffix_len
= max (max_suffix_len
,
1420 SBYTES (XCAR (tail
)));
1423 string
= filename
= encoded_fn
= Qnil
;
1424 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1429 if (complete_filename_p (str
))
1432 for (; CONSP (path
); path
= XCDR (path
))
1434 filename
= Fexpand_file_name (str
, XCAR (path
));
1435 if (!complete_filename_p (filename
))
1436 /* If there are non-absolute elts in PATH (eg ".") */
1437 /* Of course, this could conceivably lose if luser sets
1438 default-directory to be something non-absolute... */
1440 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1441 if (!complete_filename_p (filename
))
1442 /* Give up on this path element! */
1446 /* Calculate maximum size of any filename made from
1447 this path element/specified file name and any possible suffix. */
1448 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1449 if (fn_size
< want_size
)
1450 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1452 /* Loop over suffixes. */
1453 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1454 CONSP (tail
); tail
= XCDR (tail
))
1456 int lsuffix
= SBYTES (XCAR (tail
));
1457 Lisp_Object handler
;
1460 /* Concatenate path element/specified name with the suffix.
1461 If the directory starts with /:, remove that. */
1462 if (SCHARS (filename
) > 2
1463 && SREF (filename
, 0) == '/'
1464 && SREF (filename
, 1) == ':')
1466 strncpy (fn
, SDATA (filename
) + 2,
1467 SBYTES (filename
) - 2);
1468 fn
[SBYTES (filename
) - 2] = 0;
1472 strncpy (fn
, SDATA (filename
),
1474 fn
[SBYTES (filename
)] = 0;
1477 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1478 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1480 /* Check that the file exists and is not a directory. */
1481 /* We used to only check for handlers on non-absolute file names:
1485 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1486 It's not clear why that was the case and it breaks things like
1487 (load "/bar.el") where the file is actually "/bar.el.gz". */
1488 string
= build_string (fn
);
1489 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1490 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1492 if (NILP (predicate
))
1493 exists
= !NILP (Ffile_readable_p (string
));
1495 exists
= !NILP (call1 (predicate
, string
));
1496 if (exists
&& !NILP (Ffile_directory_p (string
)))
1501 /* We succeeded; return this descriptor and filename. */
1512 encoded_fn
= ENCODE_FILE (string
);
1513 pfn
= SDATA (encoded_fn
);
1514 exists
= (stat (pfn
, &st
) >= 0
1515 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1518 /* Check that we can access or open it. */
1519 if (NATNUMP (predicate
))
1520 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1522 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1526 /* We succeeded; return this descriptor and filename. */
1544 /* Merge the list we've accumulated of globals from the current input source
1545 into the load_history variable. The details depend on whether
1546 the source has an associated file name or not.
1548 FILENAME is the file name that we are loading from.
1549 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1552 build_load_history (filename
, entire
)
1553 Lisp_Object filename
;
1556 register Lisp_Object tail
, prev
, newelt
;
1557 register Lisp_Object tem
, tem2
;
1558 register int foundit
= 0;
1560 tail
= Vload_history
;
1563 while (CONSP (tail
))
1567 /* Find the feature's previous assoc list... */
1568 if (!NILP (Fequal (filename
, Fcar (tem
))))
1572 /* If we're loading the entire file, remove old data. */
1576 Vload_history
= XCDR (tail
);
1578 Fsetcdr (prev
, XCDR (tail
));
1581 /* Otherwise, cons on new symbols that are not already members. */
1584 tem2
= Vcurrent_load_list
;
1586 while (CONSP (tem2
))
1588 newelt
= XCAR (tem2
);
1590 if (NILP (Fmember (newelt
, tem
)))
1591 Fsetcar (tail
, Fcons (XCAR (tem
),
1592 Fcons (newelt
, XCDR (tem
))));
1605 /* If we're loading an entire file, cons the new assoc onto the
1606 front of load-history, the most-recently-loaded position. Also
1607 do this if we didn't find an existing member for the file. */
1608 if (entire
|| !foundit
)
1609 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1614 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1622 readevalloop_1 (old
)
1625 load_convert_to_unibyte
= ! NILP (old
);
1629 /* Signal an `end-of-file' error, if possible with file name
1633 end_of_file_error ()
1635 if (STRINGP (Vload_file_name
))
1636 xsignal1 (Qend_of_file
, Vload_file_name
);
1638 xsignal0 (Qend_of_file
);
1641 /* UNIBYTE specifies how to set load_convert_to_unibyte
1642 for this invocation.
1643 READFUN, if non-nil, is used instead of `read'.
1645 START, END specify region to read in current buffer (from eval-region).
1646 If the input is not from a buffer, they must be nil. */
1649 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1650 printflag
, unibyte
, readfun
, start
, end
)
1651 Lisp_Object readcharfun
;
1653 Lisp_Object sourcename
;
1654 Lisp_Object (*evalfun
) ();
1656 Lisp_Object unibyte
, readfun
;
1657 Lisp_Object start
, end
;
1660 register Lisp_Object val
;
1661 int count
= SPECPDL_INDEX ();
1662 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1663 struct buffer
*b
= 0;
1664 int continue_reading_p
;
1665 /* Nonzero if reading an entire buffer. */
1666 int whole_buffer
= 0;
1667 /* 1 on the first time around. */
1670 if (MARKERP (readcharfun
))
1673 start
= readcharfun
;
1676 if (BUFFERP (readcharfun
))
1677 b
= XBUFFER (readcharfun
);
1678 else if (MARKERP (readcharfun
))
1679 b
= XMARKER (readcharfun
)->buffer
;
1681 /* We assume START is nil when input is not from a buffer. */
1682 if (! NILP (start
) && !b
)
1685 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1686 specbind (Qcurrent_load_list
, Qnil
);
1687 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1688 load_convert_to_unibyte
= !NILP (unibyte
);
1690 GCPRO4 (sourcename
, readfun
, start
, end
);
1692 /* Try to ensure sourcename is a truename, except whilst preloading. */
1693 if (NILP (Vpurify_flag
)
1694 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1695 && !NILP (Ffboundp (Qfile_truename
)))
1696 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1698 LOADHIST_ATTACH (sourcename
);
1700 continue_reading_p
= 1;
1701 while (continue_reading_p
)
1703 int count1
= SPECPDL_INDEX ();
1705 if (b
!= 0 && NILP (b
->name
))
1706 error ("Reading from killed buffer");
1710 /* Switch to the buffer we are reading from. */
1711 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1712 set_buffer_internal (b
);
1714 /* Save point in it. */
1715 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1716 /* Save ZV in it. */
1717 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1718 /* Those get unbound after we read one expression. */
1720 /* Set point and ZV around stuff to be read. */
1723 Fnarrow_to_region (make_number (BEGV
), end
);
1725 /* Just for cleanliness, convert END to a marker
1726 if it is an integer. */
1728 end
= Fpoint_max_marker ();
1731 /* On the first cycle, we can easily test here
1732 whether we are reading the whole buffer. */
1733 if (b
&& first_sexp
)
1734 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1741 while ((c
= READCHAR
) != '\n' && c
!= -1);
1746 unbind_to (count1
, Qnil
);
1750 /* Ignore whitespace here, so we can detect eof. */
1751 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r'
1752 || c
== 0x8a0) /* NBSP */
1755 if (!NILP (Vpurify_flag
) && c
== '(')
1757 record_unwind_protect (unreadpure
, Qnil
);
1758 val
= read_list (-1, readcharfun
);
1763 read_objects
= Qnil
;
1764 if (!NILP (readfun
))
1766 val
= call1 (readfun
, readcharfun
);
1768 /* If READCHARFUN has set point to ZV, we should
1769 stop reading, even if the form read sets point
1770 to a different value when evaluated. */
1771 if (BUFFERP (readcharfun
))
1773 struct buffer
*b
= XBUFFER (readcharfun
);
1774 if (BUF_PT (b
) == BUF_ZV (b
))
1775 continue_reading_p
= 0;
1778 else if (! NILP (Vload_read_function
))
1779 val
= call1 (Vload_read_function
, readcharfun
);
1781 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1784 if (!NILP (start
) && continue_reading_p
)
1785 start
= Fpoint_marker ();
1787 /* Restore saved point and BEGV. */
1788 unbind_to (count1
, Qnil
);
1790 /* Now eval what we just read. */
1791 val
= (*evalfun
) (val
);
1795 Vvalues
= Fcons (val
, Vvalues
);
1796 if (EQ (Vstandard_output
, Qt
))
1805 build_load_history (sourcename
,
1806 stream
|| whole_buffer
);
1810 unbind_to (count
, Qnil
);
1813 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1814 doc
: /* Execute the current buffer as Lisp code.
1815 Programs can pass two arguments, BUFFER and PRINTFLAG.
1816 BUFFER is the buffer to evaluate (nil means use current buffer).
1817 PRINTFLAG controls printing of output:
1818 A value of nil means discard it; anything else is stream for print.
1820 If the optional third argument FILENAME is non-nil,
1821 it specifies the file name to use for `load-history'.
1822 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1823 for this invocation.
1825 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1826 `print' and related functions should work normally even if PRINTFLAG is nil.
1828 This function preserves the position of point. */)
1829 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1830 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1832 int count
= SPECPDL_INDEX ();
1833 Lisp_Object tem
, buf
;
1836 buf
= Fcurrent_buffer ();
1838 buf
= Fget_buffer (buffer
);
1840 error ("No such buffer");
1842 if (NILP (printflag
) && NILP (do_allow_print
))
1847 if (NILP (filename
))
1848 filename
= XBUFFER (buf
)->filename
;
1850 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1851 specbind (Qstandard_output
, tem
);
1852 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1853 BUF_TEMP_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1854 readevalloop (buf
, 0, filename
, Feval
,
1855 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1856 unbind_to (count
, Qnil
);
1861 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1862 doc
: /* Execute the region as Lisp code.
1863 When called from programs, expects two arguments,
1864 giving starting and ending indices in the current buffer
1865 of the text to be executed.
1866 Programs can pass third argument PRINTFLAG which controls output:
1867 A value of nil means discard it; anything else is stream for printing it.
1868 Also the fourth argument READ-FUNCTION, if non-nil, is used
1869 instead of `read' to read each expression. It gets one argument
1870 which is the input stream for reading characters.
1872 This function does not move point. */)
1873 (start
, end
, printflag
, read_function
)
1874 Lisp_Object start
, end
, printflag
, read_function
;
1876 int count
= SPECPDL_INDEX ();
1877 Lisp_Object tem
, cbuf
;
1879 cbuf
= Fcurrent_buffer ();
1881 if (NILP (printflag
))
1885 specbind (Qstandard_output
, tem
);
1886 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1888 /* readevalloop calls functions which check the type of start and end. */
1889 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1890 !NILP (printflag
), Qnil
, read_function
,
1893 return unbind_to (count
, Qnil
);
1897 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1898 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1899 If STREAM is nil, use the value of `standard-input' (which see).
1900 STREAM or the value of `standard-input' may be:
1901 a buffer (read from point and advance it)
1902 a marker (read from where it points and advance it)
1903 a function (call it with no arguments for each character,
1904 call it with a char as argument to push a char back)
1905 a string (takes text from string, starting at the beginning)
1906 t (read text line using minibuffer and use it, or read from
1907 standard input in batch mode). */)
1912 stream
= Vstandard_input
;
1913 if (EQ (stream
, Qt
))
1914 stream
= Qread_char
;
1915 if (EQ (stream
, Qread_char
))
1916 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1918 return read_internal_start (stream
, Qnil
, Qnil
);
1921 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1922 doc
: /* Read one Lisp expression which is represented as text by STRING.
1923 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1924 START and END optionally delimit a substring of STRING from which to read;
1925 they default to 0 and (length STRING) respectively. */)
1926 (string
, start
, end
)
1927 Lisp_Object string
, start
, end
;
1930 CHECK_STRING (string
);
1931 /* read_internal_start sets read_from_string_index. */
1932 ret
= read_internal_start (string
, start
, end
);
1933 return Fcons (ret
, make_number (read_from_string_index
));
1936 /* Function to set up the global context we need in toplevel read
1939 read_internal_start (stream
, start
, end
)
1941 Lisp_Object start
; /* Only used when stream is a string. */
1942 Lisp_Object end
; /* Only used when stream is a string. */
1947 new_backquote_flag
= 0;
1948 read_objects
= Qnil
;
1949 if (EQ (Vread_with_symbol_positions
, Qt
)
1950 || EQ (Vread_with_symbol_positions
, stream
))
1951 Vread_symbol_positions_list
= Qnil
;
1953 if (STRINGP (stream
)
1954 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1956 int startval
, endval
;
1959 if (STRINGP (stream
))
1962 string
= XCAR (stream
);
1965 endval
= SCHARS (string
);
1969 endval
= XINT (end
);
1970 if (endval
< 0 || endval
> SCHARS (string
))
1971 args_out_of_range (string
, end
);
1978 CHECK_NUMBER (start
);
1979 startval
= XINT (start
);
1980 if (startval
< 0 || startval
> endval
)
1981 args_out_of_range (string
, start
);
1983 read_from_string_index
= startval
;
1984 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1985 read_from_string_limit
= endval
;
1988 retval
= read0 (stream
);
1989 if (EQ (Vread_with_symbol_positions
, Qt
)
1990 || EQ (Vread_with_symbol_positions
, stream
))
1991 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1996 /* Signal Qinvalid_read_syntax error.
1997 S is error string of length N (if > 0) */
2000 invalid_syntax (s
, n
)
2006 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
2010 /* Use this for recursive reads, in contexts where internal tokens
2015 Lisp_Object readcharfun
;
2017 register Lisp_Object val
;
2020 val
= read1 (readcharfun
, &c
, 0);
2024 xsignal1 (Qinvalid_read_syntax
,
2025 Fmake_string (make_number (1), make_number (c
)));
2028 static int read_buffer_size
;
2029 static char *read_buffer
;
2031 /* Read a \-escape sequence, assuming we already read the `\'.
2032 If the escape sequence forces unibyte, return eight-bit char. */
2035 read_escape (readcharfun
, stringp
)
2036 Lisp_Object readcharfun
;
2039 register int c
= READCHAR
;
2040 /* \u allows up to four hex digits, \U up to eight. Default to the
2041 behaviour for \u, and change this value in the case that \U is seen. */
2042 int unicode_hex_count
= 4;
2047 end_of_file_error ();
2077 error ("Invalid escape character syntax");
2080 c
= read_escape (readcharfun
, 0);
2081 return c
| meta_modifier
;
2086 error ("Invalid escape character syntax");
2089 c
= read_escape (readcharfun
, 0);
2090 return c
| shift_modifier
;
2095 error ("Invalid escape character syntax");
2098 c
= read_escape (readcharfun
, 0);
2099 return c
| hyper_modifier
;
2104 error ("Invalid escape character syntax");
2107 c
= read_escape (readcharfun
, 0);
2108 return c
| alt_modifier
;
2112 if (stringp
|| c
!= '-')
2119 c
= read_escape (readcharfun
, 0);
2120 return c
| super_modifier
;
2125 error ("Invalid escape character syntax");
2129 c
= read_escape (readcharfun
, 0);
2130 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2131 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2132 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2133 return c
| ctrl_modifier
;
2134 /* ASCII control chars are made from letters (both cases),
2135 as well as the non-letters within 0100...0137. */
2136 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2137 return (c
& (037 | ~0177));
2138 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2139 return (c
& (037 | ~0177));
2141 return c
| ctrl_modifier
;
2151 /* An octal escape, as in ANSI C. */
2153 register int i
= c
- '0';
2154 register int count
= 0;
2157 if ((c
= READCHAR
) >= '0' && c
<= '7')
2169 if (i
>= 0x80 && i
< 0x100)
2170 i
= BYTE8_TO_CHAR (i
);
2175 /* A hex escape, as in ANSI C. */
2182 if (c
>= '0' && c
<= '9')
2187 else if ((c
>= 'a' && c
<= 'f')
2188 || (c
>= 'A' && c
<= 'F'))
2191 if (c
>= 'a' && c
<= 'f')
2204 if (count
< 3 && i
>= 0x80)
2205 return BYTE8_TO_CHAR (i
);
2210 /* Post-Unicode-2.0: Up to eight hex chars. */
2211 unicode_hex_count
= 8;
2214 /* A Unicode escape. We only permit them in strings and characters,
2215 not arbitrarily in the source code, as in some other languages. */
2220 while (++count
<= unicode_hex_count
)
2223 /* isdigit and isalpha may be locale-specific, which we don't
2225 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2226 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2227 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2230 error ("Non-hex digit used for Unicode escape");
2243 /* Read an integer in radix RADIX using READCHARFUN to read
2244 characters. RADIX must be in the interval [2..36]; if it isn't, a
2245 read error is signaled . Value is the integer read. Signals an
2246 error if encountering invalid read syntax or if RADIX is out of
2250 read_integer (readcharfun
, radix
)
2251 Lisp_Object readcharfun
;
2254 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2255 EMACS_INT number
= 0;
2257 if (radix
< 2 || radix
> 36)
2261 number
= ndigits
= invalid_p
= 0;
2277 if (c
>= '0' && c
<= '9')
2279 else if (c
>= 'a' && c
<= 'z')
2280 digit
= c
- 'a' + 10;
2281 else if (c
>= 'A' && c
<= 'Z')
2282 digit
= c
- 'A' + 10;
2289 if (digit
< 0 || digit
>= radix
)
2292 number
= radix
* number
+ digit
;
2298 if (ndigits
== 0 || invalid_p
)
2301 sprintf (buf
, "integer, radix %d", radix
);
2302 invalid_syntax (buf
, 0);
2305 return make_number (sign
* number
);
2309 /* If the next token is ')' or ']' or '.', we store that character
2310 in *PCH and the return value is not interesting. Else, we store
2311 zero in *PCH and we read and return one lisp object.
2313 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2316 read1 (readcharfun
, pch
, first_in_list
)
2317 register Lisp_Object readcharfun
;
2322 int uninterned_symbol
= 0;
2330 c
= READCHAR_REPORT_MULTIBYTE (&multibyte
);
2332 end_of_file_error ();
2337 return read_list (0, readcharfun
);
2340 return read_vector (readcharfun
, 0);
2357 tmp
= read_vector (readcharfun
, 0);
2358 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2359 error ("Invalid size char-table");
2360 XSETPVECTYPE (XVECTOR (tmp
), PVEC_CHAR_TABLE
);
2371 tmp
= read_vector (readcharfun
, 0);
2372 if (!INTEGERP (AREF (tmp
, 0)))
2373 error ("Invalid depth in char-table");
2374 depth
= XINT (AREF (tmp
, 0));
2375 if (depth
< 1 || depth
> 3)
2376 error ("Invalid depth in char-table");
2377 size
= XVECTOR (tmp
)->size
- 2;
2378 if (chartab_size
[depth
] != size
)
2379 error ("Invalid size char-table");
2380 XSETPVECTYPE (XVECTOR (tmp
), PVEC_SUB_CHAR_TABLE
);
2383 invalid_syntax ("#^^", 3);
2385 invalid_syntax ("#^", 2);
2390 length
= read1 (readcharfun
, pch
, first_in_list
);
2394 Lisp_Object tmp
, val
;
2396 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2397 / BOOL_VECTOR_BITS_PER_CHAR
);
2400 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2401 if (STRING_MULTIBYTE (tmp
)
2402 || (size_in_chars
!= SCHARS (tmp
)
2403 /* We used to print 1 char too many
2404 when the number of bits was a multiple of 8.
2405 Accept such input in case it came from an old
2407 && ! (XFASTINT (length
)
2408 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2409 invalid_syntax ("#&...", 5);
2411 val
= Fmake_bool_vector (length
, Qnil
);
2412 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2414 /* Clear the extraneous bits in the last byte. */
2415 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2416 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2417 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2420 invalid_syntax ("#&...", 5);
2424 /* Accept compiled functions at read-time so that we don't have to
2425 build them using function calls. */
2427 tmp
= read_vector (readcharfun
, 1);
2428 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2429 XVECTOR (tmp
)->contents
);
2434 struct gcpro gcpro1
;
2437 /* Read the string itself. */
2438 tmp
= read1 (readcharfun
, &ch
, 0);
2439 if (ch
!= 0 || !STRINGP (tmp
))
2440 invalid_syntax ("#", 1);
2442 /* Read the intervals and their properties. */
2445 Lisp_Object beg
, end
, plist
;
2447 beg
= read1 (readcharfun
, &ch
, 0);
2452 end
= read1 (readcharfun
, &ch
, 0);
2454 plist
= read1 (readcharfun
, &ch
, 0);
2456 invalid_syntax ("Invalid string property list", 0);
2457 Fset_text_properties (beg
, end
, plist
, tmp
);
2463 /* #@NUMBER is used to skip NUMBER following characters.
2464 That's used in .elc files to skip over doc strings
2465 and function definitions. */
2471 /* Read a decimal integer. */
2472 while ((c
= READCHAR
) >= 0
2473 && c
>= '0' && c
<= '9')
2481 if (load_force_doc_strings
2482 && (EQ (readcharfun
, Qget_file_char
)
2483 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2485 /* If we are supposed to force doc strings into core right now,
2486 record the last string that we skipped,
2487 and record where in the file it comes from. */
2489 /* But first exchange saved_doc_string
2490 with prev_saved_doc_string, so we save two strings. */
2492 char *temp
= saved_doc_string
;
2493 int temp_size
= saved_doc_string_size
;
2494 file_offset temp_pos
= saved_doc_string_position
;
2495 int temp_len
= saved_doc_string_length
;
2497 saved_doc_string
= prev_saved_doc_string
;
2498 saved_doc_string_size
= prev_saved_doc_string_size
;
2499 saved_doc_string_position
= prev_saved_doc_string_position
;
2500 saved_doc_string_length
= prev_saved_doc_string_length
;
2502 prev_saved_doc_string
= temp
;
2503 prev_saved_doc_string_size
= temp_size
;
2504 prev_saved_doc_string_position
= temp_pos
;
2505 prev_saved_doc_string_length
= temp_len
;
2508 if (saved_doc_string_size
== 0)
2510 saved_doc_string_size
= nskip
+ 100;
2511 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2513 if (nskip
> saved_doc_string_size
)
2515 saved_doc_string_size
= nskip
+ 100;
2516 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2517 saved_doc_string_size
);
2520 saved_doc_string_position
= file_tell (instream
);
2522 /* Copy that many characters into saved_doc_string. */
2523 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2524 saved_doc_string
[i
] = c
= READCHAR
;
2526 saved_doc_string_length
= i
;
2530 /* Skip that many characters. */
2531 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2540 /* #! appears at the beginning of an executable file.
2541 Skip the first line. */
2542 while (c
!= '\n' && c
>= 0)
2547 return Vload_file_name
;
2549 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2550 /* #:foo is the uninterned symbol named foo. */
2553 uninterned_symbol
= 1;
2557 /* Reader forms that can reuse previously read objects. */
2558 if (c
>= '0' && c
<= '9')
2563 /* Read a non-negative integer. */
2564 while (c
>= '0' && c
<= '9')
2570 /* #n=object returns object, but associates it with n for #n#. */
2573 /* Make a placeholder for #n# to use temporarily */
2574 Lisp_Object placeholder
;
2577 placeholder
= Fcons(Qnil
, Qnil
);
2578 cell
= Fcons (make_number (n
), placeholder
);
2579 read_objects
= Fcons (cell
, read_objects
);
2581 /* Read the object itself. */
2582 tem
= read0 (readcharfun
);
2584 /* Now put it everywhere the placeholder was... */
2585 substitute_object_in_subtree (tem
, placeholder
);
2587 /* ...and #n# will use the real value from now on. */
2588 Fsetcdr (cell
, tem
);
2592 /* #n# returns a previously read object. */
2595 tem
= Fassq (make_number (n
), read_objects
);
2598 /* Fall through to error message. */
2600 else if (c
== 'r' || c
== 'R')
2601 return read_integer (readcharfun
, n
);
2603 /* Fall through to error message. */
2605 else if (c
== 'x' || c
== 'X')
2606 return read_integer (readcharfun
, 16);
2607 else if (c
== 'o' || c
== 'O')
2608 return read_integer (readcharfun
, 8);
2609 else if (c
== 'b' || c
== 'B')
2610 return read_integer (readcharfun
, 2);
2613 invalid_syntax ("#", 1);
2616 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2621 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2627 Vold_style_backquotes
= Qt
;
2634 new_backquote_flag
++;
2635 value
= read0 (readcharfun
);
2636 new_backquote_flag
--;
2638 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2642 if (new_backquote_flag
)
2644 Lisp_Object comma_type
= Qnil
;
2649 comma_type
= Qcomma_at
;
2651 comma_type
= Qcomma_dot
;
2654 if (ch
>= 0) UNREAD (ch
);
2655 comma_type
= Qcomma
;
2658 new_backquote_flag
--;
2659 value
= read0 (readcharfun
);
2660 new_backquote_flag
++;
2661 return Fcons (comma_type
, Fcons (value
, Qnil
));
2665 Vold_style_backquotes
= Qt
;
2677 end_of_file_error ();
2679 /* Accept `single space' syntax like (list ? x) where the
2680 whitespace character is SPC or TAB.
2681 Other literal whitespace like NL, CR, and FF are not accepted,
2682 as there are well-established escape sequences for these. */
2683 if (c
== ' ' || c
== '\t')
2684 return make_number (c
);
2687 c
= read_escape (readcharfun
, 0);
2688 modifiers
= c
& CHAR_MODIFIER_MASK
;
2689 c
&= ~CHAR_MODIFIER_MASK
;
2690 if (CHAR_BYTE8_P (c
))
2691 c
= CHAR_TO_BYTE8 (c
);
2694 next_char
= READCHAR
;
2695 if (next_char
== '.')
2697 /* Only a dotted-pair dot is valid after a char constant. */
2698 int next_next_char
= READCHAR
;
2699 UNREAD (next_next_char
);
2701 ok
= (next_next_char
<= 040
2702 || (next_next_char
< 0200
2703 && (index ("\"';([#?", next_next_char
)
2704 || (!first_in_list
&& next_next_char
== '`')
2705 || (new_backquote_flag
&& next_next_char
== ','))));
2709 ok
= (next_char
<= 040
2710 || (next_char
< 0200
2711 && (index ("\"';()[]#?", next_char
)
2712 || (!first_in_list
&& next_char
== '`')
2713 || (new_backquote_flag
&& next_char
== ','))));
2717 return make_number (c
);
2719 invalid_syntax ("?", 1);
2724 char *p
= read_buffer
;
2725 char *end
= read_buffer
+ read_buffer_size
;
2727 /* Nonzero if we saw an escape sequence specifying
2728 a multibyte character. */
2729 int force_multibyte
= 0;
2730 /* Nonzero if we saw an escape sequence specifying
2731 a single-byte character. */
2732 int force_singlebyte
= 0;
2736 while ((c
= READCHAR
) >= 0
2739 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2741 int offset
= p
- read_buffer
;
2742 read_buffer
= (char *) xrealloc (read_buffer
,
2743 read_buffer_size
*= 2);
2744 p
= read_buffer
+ offset
;
2745 end
= read_buffer
+ read_buffer_size
;
2752 c
= read_escape (readcharfun
, 1);
2754 /* C is -1 if \ newline has just been seen */
2757 if (p
== read_buffer
)
2762 modifiers
= c
& CHAR_MODIFIER_MASK
;
2763 c
= c
& ~CHAR_MODIFIER_MASK
;
2765 if (CHAR_BYTE8_P (c
))
2766 force_singlebyte
= 1;
2767 else if (! ASCII_CHAR_P (c
))
2768 force_multibyte
= 1;
2769 else /* i.e. ASCII_CHAR_P (c) */
2771 /* Allow `\C- ' and `\C-?'. */
2772 if (modifiers
== CHAR_CTL
)
2775 c
= 0, modifiers
= 0;
2777 c
= 127, modifiers
= 0;
2779 if (modifiers
& CHAR_SHIFT
)
2781 /* Shift modifier is valid only with [A-Za-z]. */
2782 if (c
>= 'A' && c
<= 'Z')
2783 modifiers
&= ~CHAR_SHIFT
;
2784 else if (c
>= 'a' && c
<= 'z')
2785 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2788 if (modifiers
& CHAR_META
)
2790 /* Move the meta bit to the right place for a
2792 modifiers
&= ~CHAR_META
;
2793 c
= BYTE8_TO_CHAR (c
| 0x80);
2794 force_singlebyte
= 1;
2798 /* Any modifiers remaining are invalid. */
2800 error ("Invalid modifier in string");
2801 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2805 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2806 if (CHAR_BYTE8_P (c
))
2807 force_singlebyte
= 1;
2808 else if (! ASCII_CHAR_P (c
))
2809 force_multibyte
= 1;
2815 end_of_file_error ();
2817 /* If purifying, and string starts with \ newline,
2818 return zero instead. This is for doc strings
2819 that we are really going to find in etc/DOC.nn.nn */
2820 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2821 return make_number (0);
2823 if (force_multibyte
)
2824 /* READ_BUFFER already contains valid multibyte forms. */
2826 else if (force_singlebyte
)
2828 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2829 p
= read_buffer
+ nchars
;
2832 /* Otherwise, READ_BUFFER contains only ASCII. */
2835 /* We want readchar_count to be the number of characters, not
2836 bytes. Hence we adjust for multibyte characters in the
2837 string. ... But it doesn't seem to be necessary, because
2838 READCHAR *does* read multibyte characters from buffers. */
2839 /* readchar_count -= (p - read_buffer) - nchars; */
2841 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2843 || (p
- read_buffer
!= nchars
)));
2844 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2846 || (p
- read_buffer
!= nchars
)));
2851 int next_char
= READCHAR
;
2854 if (next_char
<= 040
2855 || (next_char
< 0200
2856 && (index ("\"';([#?", next_char
)
2857 || (!first_in_list
&& next_char
== '`')
2858 || (new_backquote_flag
&& next_char
== ','))))
2864 /* Otherwise, we fall through! Note that the atom-reading loop
2865 below will now loop at least once, assuring that we will not
2866 try to UNREAD two characters in a row. */
2870 if (c
<= 040) goto retry
;
2871 if (c
== 0x8a0) /* NBSP */
2874 char *p
= read_buffer
;
2878 char *end
= read_buffer
+ read_buffer_size
;
2881 && c
!= 0x8a0 /* NBSP */
2883 || (!index ("\"';()[]#", c
)
2884 && !(!first_in_list
&& c
== '`')
2885 && !(new_backquote_flag
&& c
== ','))))
2887 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2889 int offset
= p
- read_buffer
;
2890 read_buffer
= (char *) xrealloc (read_buffer
,
2891 read_buffer_size
*= 2);
2892 p
= read_buffer
+ offset
;
2893 end
= read_buffer
+ read_buffer_size
;
2900 end_of_file_error ();
2905 p
+= CHAR_STRING (c
, p
);
2913 int offset
= p
- read_buffer
;
2914 read_buffer
= (char *) xrealloc (read_buffer
,
2915 read_buffer_size
*= 2);
2916 p
= read_buffer
+ offset
;
2917 end
= read_buffer
+ read_buffer_size
;
2924 if (!quoted
&& !uninterned_symbol
)
2927 register Lisp_Object val
;
2929 if (*p1
== '+' || *p1
== '-') p1
++;
2930 /* Is it an integer? */
2933 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2934 /* Integers can have trailing decimal points. */
2935 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2937 /* It is an integer. */
2941 /* Fixme: if we have strtol, use that, and check
2943 if (sizeof (int) == sizeof (EMACS_INT
))
2944 XSETINT (val
, atoi (read_buffer
));
2945 else if (sizeof (long) == sizeof (EMACS_INT
))
2946 XSETINT (val
, atol (read_buffer
));
2952 if (isfloat_string (read_buffer
))
2954 /* Compute NaN and infinities using 0.0 in a variable,
2955 to cope with compilers that think they are smarter
2961 /* Negate the value ourselves. This treats 0, NaNs,
2962 and infinity properly on IEEE floating point hosts,
2963 and works around a common bug where atof ("-0.0")
2965 int negative
= read_buffer
[0] == '-';
2967 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2968 returns 1, is if the input ends in e+INF or e+NaN. */
2975 value
= zero
/ zero
;
2977 /* If that made a "negative" NaN, negate it. */
2981 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2984 u_minus_zero
.d
= - 0.0;
2985 for (i
= 0; i
< sizeof (double); i
++)
2986 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2992 /* Now VALUE is a positive NaN. */
2995 value
= atof (read_buffer
+ negative
);
2999 return make_float (negative
? - value
: value
);
3003 Lisp_Object name
, result
;
3004 EMACS_INT nbytes
= p
- read_buffer
;
3006 = (multibyte
? multibyte_chars_in_text (read_buffer
, nbytes
)
3009 if (uninterned_symbol
&& ! NILP (Vpurify_flag
))
3010 name
= make_pure_string (read_buffer
, nchars
, nbytes
, multibyte
);
3012 name
= make_specified_string (read_buffer
, nchars
, nbytes
,multibyte
);
3013 result
= (uninterned_symbol
? Fmake_symbol (name
)
3014 : Fintern (name
, Qnil
));
3016 if (EQ (Vread_with_symbol_positions
, Qt
)
3017 || EQ (Vread_with_symbol_positions
, readcharfun
))
3018 Vread_symbol_positions_list
=
3019 /* Kind of a hack; this will probably fail if characters
3020 in the symbol name were escaped. Not really a big
3022 Fcons (Fcons (result
,
3023 make_number (readchar_count
3024 - XFASTINT (Flength (Fsymbol_name (result
))))),
3025 Vread_symbol_positions_list
);
3033 /* List of nodes we've seen during substitute_object_in_subtree. */
3034 static Lisp_Object seen_list
;
3037 substitute_object_in_subtree (object
, placeholder
)
3039 Lisp_Object placeholder
;
3041 Lisp_Object check_object
;
3043 /* We haven't seen any objects when we start. */
3046 /* Make all the substitutions. */
3048 = substitute_object_recurse (object
, placeholder
, object
);
3050 /* Clear seen_list because we're done with it. */
3053 /* The returned object here is expected to always eq the
3055 if (!EQ (check_object
, object
))
3056 error ("Unexpected mutation error in reader");
3059 /* Feval doesn't get called from here, so no gc protection is needed. */
3060 #define SUBSTITUTE(get_val, set_val) \
3062 Lisp_Object old_value = get_val; \
3063 Lisp_Object true_value \
3064 = substitute_object_recurse (object, placeholder, \
3067 if (!EQ (old_value, true_value)) \
3074 substitute_object_recurse (object
, placeholder
, subtree
)
3076 Lisp_Object placeholder
;
3077 Lisp_Object subtree
;
3079 /* If we find the placeholder, return the target object. */
3080 if (EQ (placeholder
, subtree
))
3083 /* If we've been to this node before, don't explore it again. */
3084 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3087 /* If this node can be the entry point to a cycle, remember that
3088 we've seen it. It can only be such an entry point if it was made
3089 by #n=, which means that we can find it as a value in
3091 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3092 seen_list
= Fcons (subtree
, seen_list
);
3094 /* Recurse according to subtree's type.
3095 Every branch must return a Lisp_Object. */
3096 switch (XTYPE (subtree
))
3098 case Lisp_Vectorlike
:
3101 if (BOOL_VECTOR_P (subtree
))
3102 return subtree
; /* No sub-objects anyway. */
3103 else if (CHAR_TABLE_P (subtree
) || SUB_CHAR_TABLE_P (subtree
)
3104 || COMPILEDP (subtree
))
3105 length
= ASIZE (subtree
) & PSEUDOVECTOR_SIZE_MASK
;
3106 else if (VECTORP (subtree
))
3107 length
= ASIZE (subtree
);
3109 /* An unknown pseudovector may contain non-Lisp fields, so we
3110 can't just blindly traverse all its fields. We used to call
3111 `Flength' which signalled `sequencep', so I just preserved this
3113 wrong_type_argument (Qsequencep
, subtree
);
3115 for (i
= 0; i
< length
; i
++)
3116 SUBSTITUTE (AREF (subtree
, i
),
3117 ASET (subtree
, i
, true_value
));
3123 SUBSTITUTE (XCAR (subtree
),
3124 XSETCAR (subtree
, true_value
));
3125 SUBSTITUTE (XCDR (subtree
),
3126 XSETCDR (subtree
, true_value
));
3132 /* Check for text properties in each interval.
3133 substitute_in_interval contains part of the logic. */
3135 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3136 Lisp_Object arg
= Fcons (object
, placeholder
);
3138 traverse_intervals_noorder (root_interval
,
3139 &substitute_in_interval
, arg
);
3144 /* Other types don't recurse any further. */
3150 /* Helper function for substitute_object_recurse. */
3152 substitute_in_interval (interval
, arg
)
3156 Lisp_Object object
= Fcar (arg
);
3157 Lisp_Object placeholder
= Fcdr (arg
);
3159 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3178 if (*cp
== '+' || *cp
== '-')
3181 if (*cp
>= '0' && *cp
<= '9')
3184 while (*cp
>= '0' && *cp
<= '9')
3192 if (*cp
>= '0' && *cp
<= '9')
3195 while (*cp
>= '0' && *cp
<= '9')
3198 if (*cp
== 'e' || *cp
== 'E')
3202 if (*cp
== '+' || *cp
== '-')
3206 if (*cp
>= '0' && *cp
<= '9')
3209 while (*cp
>= '0' && *cp
<= '9')
3212 else if (cp
== start
)
3214 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3219 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3225 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3226 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3227 || state
== (DOT_CHAR
|TRAIL_INT
)
3228 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3229 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3230 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3235 read_vector (readcharfun
, bytecodeflag
)
3236 Lisp_Object readcharfun
;
3241 register Lisp_Object
*ptr
;
3242 register Lisp_Object tem
, item
, vector
;
3243 register struct Lisp_Cons
*otem
;
3246 tem
= read_list (1, readcharfun
);
3247 len
= Flength (tem
);
3248 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3250 size
= XVECTOR (vector
)->size
;
3251 ptr
= XVECTOR (vector
)->contents
;
3252 for (i
= 0; i
< size
; i
++)
3255 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3256 bytecode object, the docstring containing the bytecode and
3257 constants values must be treated as unibyte and passed to
3258 Fread, to get the actual bytecode string and constants vector. */
3259 if (bytecodeflag
&& load_force_doc_strings
)
3261 if (i
== COMPILED_BYTECODE
)
3263 if (!STRINGP (item
))
3264 error ("Invalid byte code");
3266 /* Delay handling the bytecode slot until we know whether
3267 it is lazily-loaded (we can tell by whether the
3268 constants slot is nil). */
3269 ptr
[COMPILED_CONSTANTS
] = item
;
3272 else if (i
== COMPILED_CONSTANTS
)
3274 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3278 /* Coerce string to unibyte (like string-as-unibyte,
3279 but without generating extra garbage and
3280 guaranteeing no change in the contents). */
3281 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3282 STRING_SET_UNIBYTE (bytestr
);
3284 item
= Fread (Fcons (bytestr
, readcharfun
));
3286 error ("Invalid byte code");
3288 otem
= XCONS (item
);
3289 bytestr
= XCAR (item
);
3294 /* Now handle the bytecode slot. */
3295 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3297 else if (i
== COMPILED_DOC_STRING
3299 && ! STRING_MULTIBYTE (item
))
3301 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3302 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3304 item
= Fstring_as_multibyte (item
);
3307 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3315 /* FLAG = 1 means check for ] to terminate rather than ) and .
3316 FLAG = -1 means check for starting with defun
3317 and make structure pure. */
3320 read_list (flag
, readcharfun
)
3322 register Lisp_Object readcharfun
;
3324 /* -1 means check next element for defun,
3325 0 means don't check,
3326 1 means already checked and found defun. */
3327 int defunflag
= flag
< 0 ? -1 : 0;
3328 Lisp_Object val
, tail
;
3329 register Lisp_Object elt
, tem
;
3330 struct gcpro gcpro1
, gcpro2
;
3331 /* 0 is the normal case.
3332 1 means this list is a doc reference; replace it with the number 0.
3333 2 means this list is a doc reference; replace it with the doc string. */
3334 int doc_reference
= 0;
3336 /* Initialize this to 1 if we are reading a list. */
3337 int first_in_list
= flag
<= 0;
3346 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3351 /* While building, if the list starts with #$, treat it specially. */
3352 if (EQ (elt
, Vload_file_name
)
3354 && !NILP (Vpurify_flag
))
3356 if (NILP (Vdoc_file_name
))
3357 /* We have not yet called Snarf-documentation, so assume
3358 this file is described in the DOC-MM.NN file
3359 and Snarf-documentation will fill in the right value later.
3360 For now, replace the whole list with 0. */
3363 /* We have already called Snarf-documentation, so make a relative
3364 file name for this file, so it can be found properly
3365 in the installed Lisp directory.
3366 We don't use Fexpand_file_name because that would make
3367 the directory absolute now. */
3368 elt
= concat2 (build_string ("../lisp/"),
3369 Ffile_name_nondirectory (elt
));
3371 else if (EQ (elt
, Vload_file_name
)
3373 && load_force_doc_strings
)
3382 invalid_syntax (") or . in a vector", 18);
3390 XSETCDR (tail
, read0 (readcharfun
));
3392 val
= read0 (readcharfun
);
3393 read1 (readcharfun
, &ch
, 0);
3397 if (doc_reference
== 1)
3398 return make_number (0);
3399 if (doc_reference
== 2)
3401 /* Get a doc string from the file we are loading.
3402 If it's in saved_doc_string, get it from there.
3404 Here, we don't know if the string is a
3405 bytecode string or a doc string. As a
3406 bytecode string must be unibyte, we always
3407 return a unibyte string. If it is actually a
3408 doc string, caller must make it
3411 int pos
= XINT (XCDR (val
));
3412 /* Position is negative for user variables. */
3413 if (pos
< 0) pos
= -pos
;
3414 if (pos
>= saved_doc_string_position
3415 && pos
< (saved_doc_string_position
3416 + saved_doc_string_length
))
3418 int start
= pos
- saved_doc_string_position
;
3421 /* Process quoting with ^A,
3422 and find the end of the string,
3423 which is marked with ^_ (037). */
3424 for (from
= start
, to
= start
;
3425 saved_doc_string
[from
] != 037;)
3427 int c
= saved_doc_string
[from
++];
3430 c
= saved_doc_string
[from
++];
3432 saved_doc_string
[to
++] = c
;
3434 saved_doc_string
[to
++] = 0;
3436 saved_doc_string
[to
++] = 037;
3439 saved_doc_string
[to
++] = c
;
3442 return make_unibyte_string (saved_doc_string
+ start
,
3445 /* Look in prev_saved_doc_string the same way. */
3446 else if (pos
>= prev_saved_doc_string_position
3447 && pos
< (prev_saved_doc_string_position
3448 + prev_saved_doc_string_length
))
3450 int start
= pos
- prev_saved_doc_string_position
;
3453 /* Process quoting with ^A,
3454 and find the end of the string,
3455 which is marked with ^_ (037). */
3456 for (from
= start
, to
= start
;
3457 prev_saved_doc_string
[from
] != 037;)
3459 int c
= prev_saved_doc_string
[from
++];
3462 c
= prev_saved_doc_string
[from
++];
3464 prev_saved_doc_string
[to
++] = c
;
3466 prev_saved_doc_string
[to
++] = 0;
3468 prev_saved_doc_string
[to
++] = 037;
3471 prev_saved_doc_string
[to
++] = c
;
3474 return make_unibyte_string (prev_saved_doc_string
3479 return get_doc_string (val
, 1, 0);
3484 invalid_syntax (". in wrong context", 18);
3486 invalid_syntax ("] in a list", 11);
3488 tem
= (read_pure
&& flag
<= 0
3489 ? pure_cons (elt
, Qnil
)
3490 : Fcons (elt
, Qnil
));
3492 XSETCDR (tail
, tem
);
3497 defunflag
= EQ (elt
, Qdefun
);
3498 else if (defunflag
> 0)
3503 Lisp_Object Vobarray
;
3504 Lisp_Object initial_obarray
;
3506 /* oblookup stores the bucket number here, for the sake of Funintern. */
3508 int oblookup_last_bucket_number
;
3510 static int hash_string ();
3512 /* Get an error if OBARRAY is not an obarray.
3513 If it is one, return it. */
3516 check_obarray (obarray
)
3517 Lisp_Object obarray
;
3519 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3521 /* If Vobarray is now invalid, force it to be valid. */
3522 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3523 wrong_type_argument (Qvectorp
, obarray
);
3528 /* Intern the C string STR: return a symbol with that name,
3529 interned in the current obarray. */
3536 int len
= strlen (str
);
3537 Lisp_Object obarray
;
3540 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3541 obarray
= check_obarray (obarray
);
3542 tem
= oblookup (obarray
, str
, len
, len
);
3545 return Fintern (make_string (str
, len
), obarray
);
3548 /* Create an uninterned symbol with name STR. */
3554 int len
= strlen (str
);
3556 return Fmake_symbol ((!NILP (Vpurify_flag
)
3557 ? make_pure_string (str
, len
, len
, 0)
3558 : make_string (str
, len
)));
3561 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3562 doc
: /* Return the canonical symbol whose name is STRING.
3563 If there is none, one is created by this function and returned.
3564 A second optional argument specifies the obarray to use;
3565 it defaults to the value of `obarray'. */)
3567 Lisp_Object string
, obarray
;
3569 register Lisp_Object tem
, sym
, *ptr
;
3571 if (NILP (obarray
)) obarray
= Vobarray
;
3572 obarray
= check_obarray (obarray
);
3574 CHECK_STRING (string
);
3576 tem
= oblookup (obarray
, SDATA (string
),
3579 if (!INTEGERP (tem
))
3582 if (!NILP (Vpurify_flag
))
3583 string
= Fpurecopy (string
);
3584 sym
= Fmake_symbol (string
);
3586 if (EQ (obarray
, initial_obarray
))
3587 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3589 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3591 if ((SREF (string
, 0) == ':')
3592 && EQ (obarray
, initial_obarray
))
3594 XSYMBOL (sym
)->constant
= 1;
3595 XSYMBOL (sym
)->value
= sym
;
3598 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3600 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3602 XSYMBOL (sym
)->next
= 0;
3607 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3608 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3609 NAME may be a string or a symbol. If it is a symbol, that exact
3610 symbol is searched for.
3611 A second optional argument specifies the obarray to use;
3612 it defaults to the value of `obarray'. */)
3614 Lisp_Object name
, obarray
;
3616 register Lisp_Object tem
, string
;
3618 if (NILP (obarray
)) obarray
= Vobarray
;
3619 obarray
= check_obarray (obarray
);
3621 if (!SYMBOLP (name
))
3623 CHECK_STRING (name
);
3627 string
= SYMBOL_NAME (name
);
3629 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3630 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3636 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3637 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3638 The value is t if a symbol was found and deleted, nil otherwise.
3639 NAME may be a string or a symbol. If it is a symbol, that symbol
3640 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3641 OBARRAY defaults to the value of the variable `obarray'. */)
3643 Lisp_Object name
, obarray
;
3645 register Lisp_Object string
, tem
;
3648 if (NILP (obarray
)) obarray
= Vobarray
;
3649 obarray
= check_obarray (obarray
);
3652 string
= SYMBOL_NAME (name
);
3655 CHECK_STRING (name
);
3659 tem
= oblookup (obarray
, SDATA (string
),
3664 /* If arg was a symbol, don't delete anything but that symbol itself. */
3665 if (SYMBOLP (name
) && !EQ (name
, tem
))
3668 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3669 XSYMBOL (tem
)->constant
= 0;
3670 XSYMBOL (tem
)->indirect_variable
= 0;
3672 hash
= oblookup_last_bucket_number
;
3674 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3676 if (XSYMBOL (tem
)->next
)
3677 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3679 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3683 Lisp_Object tail
, following
;
3685 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3686 XSYMBOL (tail
)->next
;
3689 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3690 if (EQ (following
, tem
))
3692 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3701 /* Return the symbol in OBARRAY whose names matches the string
3702 of SIZE characters (SIZE_BYTE bytes) at PTR.
3703 If there is no such symbol in OBARRAY, return nil.
3705 Also store the bucket number in oblookup_last_bucket_number. */
3708 oblookup (obarray
, ptr
, size
, size_byte
)
3709 Lisp_Object obarray
;
3710 register const char *ptr
;
3711 int size
, size_byte
;
3715 register Lisp_Object tail
;
3716 Lisp_Object bucket
, tem
;
3718 if (!VECTORP (obarray
)
3719 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3721 obarray
= check_obarray (obarray
);
3722 obsize
= XVECTOR (obarray
)->size
;
3724 /* This is sometimes needed in the middle of GC. */
3725 obsize
&= ~ARRAY_MARK_FLAG
;
3726 /* Combining next two lines breaks VMS C 2.3. */
3727 hash
= hash_string (ptr
, size_byte
);
3729 bucket
= XVECTOR (obarray
)->contents
[hash
];
3730 oblookup_last_bucket_number
= hash
;
3731 if (EQ (bucket
, make_number (0)))
3733 else if (!SYMBOLP (bucket
))
3734 error ("Bad data in guts of obarray"); /* Like CADR error message */
3736 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3738 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3739 && SCHARS (SYMBOL_NAME (tail
)) == size
3740 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3742 else if (XSYMBOL (tail
)->next
== 0)
3745 XSETINT (tem
, hash
);
3750 hash_string (ptr
, len
)
3751 const unsigned char *ptr
;
3754 register const unsigned char *p
= ptr
;
3755 register const unsigned char *end
= p
+ len
;
3756 register unsigned char c
;
3757 register int hash
= 0;
3762 if (c
>= 0140) c
-= 40;
3763 hash
= ((hash
<<3) + (hash
>>28) + c
);
3765 return hash
& 07777777777;
3769 map_obarray (obarray
, fn
, arg
)
3770 Lisp_Object obarray
;
3771 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3775 register Lisp_Object tail
;
3776 CHECK_VECTOR (obarray
);
3777 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3779 tail
= XVECTOR (obarray
)->contents
[i
];
3784 if (XSYMBOL (tail
)->next
== 0)
3786 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3792 mapatoms_1 (sym
, function
)
3793 Lisp_Object sym
, function
;
3795 call1 (function
, sym
);
3798 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3799 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3800 OBARRAY defaults to the value of `obarray'. */)
3802 Lisp_Object function
, obarray
;
3804 if (NILP (obarray
)) obarray
= Vobarray
;
3805 obarray
= check_obarray (obarray
);
3807 map_obarray (obarray
, mapatoms_1
, function
);
3811 #define OBARRAY_SIZE 1511
3816 Lisp_Object oblength
;
3820 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3822 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3823 Vobarray
= Fmake_vector (oblength
, make_number (0));
3824 initial_obarray
= Vobarray
;
3825 staticpro (&initial_obarray
);
3826 /* Intern nil in the obarray */
3827 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3828 XSYMBOL (Qnil
)->constant
= 1;
3830 /* These locals are to kludge around a pyramid compiler bug. */
3831 hash
= hash_string ("nil", 3);
3832 /* Separate statement here to avoid VAXC bug. */
3833 hash
%= OBARRAY_SIZE
;
3834 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3837 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3838 XSYMBOL (Qnil
)->function
= Qunbound
;
3839 XSYMBOL (Qunbound
)->value
= Qunbound
;
3840 XSYMBOL (Qunbound
)->function
= Qunbound
;
3843 XSYMBOL (Qnil
)->value
= Qnil
;
3844 XSYMBOL (Qnil
)->plist
= Qnil
;
3845 XSYMBOL (Qt
)->value
= Qt
;
3846 XSYMBOL (Qt
)->constant
= 1;
3848 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3851 Qvariable_documentation
= intern ("variable-documentation");
3852 staticpro (&Qvariable_documentation
);
3854 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3855 read_buffer
= (char *) xmalloc (read_buffer_size
);
3860 struct Lisp_Subr
*sname
;
3863 sym
= intern (sname
->symbol_name
);
3864 XSETPVECTYPE (sname
, PVEC_SUBR
);
3865 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3868 #ifdef NOTDEF /* use fset in subr.el now */
3870 defalias (sname
, string
)
3871 struct Lisp_Subr
*sname
;
3875 sym
= intern (string
);
3876 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3880 /* Define an "integer variable"; a symbol whose value is forwarded
3881 to a C variable of type int. Sample call:
3882 DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
3884 defvar_int (namestring
, address
)
3888 Lisp_Object sym
, val
;
3889 sym
= intern (namestring
);
3890 val
= allocate_misc ();
3891 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3892 XINTFWD (val
)->intvar
= address
;
3893 SET_SYMBOL_VALUE (sym
, val
);
3896 /* Similar but define a variable whose value is t if address contains 1,
3897 nil if address contains 0. */
3899 defvar_bool (namestring
, address
)
3903 Lisp_Object sym
, val
;
3904 sym
= intern (namestring
);
3905 val
= allocate_misc ();
3906 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3907 XBOOLFWD (val
)->boolvar
= address
;
3908 SET_SYMBOL_VALUE (sym
, val
);
3909 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3912 /* Similar but define a variable whose value is the Lisp Object stored
3913 at address. Two versions: with and without gc-marking of the C
3914 variable. The nopro version is used when that variable will be
3915 gc-marked for some other reason, since marking the same slot twice
3916 can cause trouble with strings. */
3918 defvar_lisp_nopro (namestring
, address
)
3920 Lisp_Object
*address
;
3922 Lisp_Object sym
, val
;
3923 sym
= intern (namestring
);
3924 val
= allocate_misc ();
3925 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3926 XOBJFWD (val
)->objvar
= address
;
3927 SET_SYMBOL_VALUE (sym
, val
);
3931 defvar_lisp (namestring
, address
)
3933 Lisp_Object
*address
;
3935 defvar_lisp_nopro (namestring
, address
);
3936 staticpro (address
);
3939 /* Similar but define a variable whose value is the Lisp Object stored
3940 at a particular offset in the current kboard object. */
3943 defvar_kboard (namestring
, offset
)
3947 Lisp_Object sym
, val
;
3948 sym
= intern (namestring
);
3949 val
= allocate_misc ();
3950 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3951 XKBOARD_OBJFWD (val
)->offset
= offset
;
3952 SET_SYMBOL_VALUE (sym
, val
);
3955 /* Record the value of load-path used at the start of dumping
3956 so we can see if the site changed it later during dumping. */
3957 static Lisp_Object dump_path
;
3963 int turn_off_warning
= 0;
3965 /* Compute the default load-path. */
3967 normal
= PATH_LOADSEARCH
;
3968 Vload_path
= decode_env_path (0, normal
);
3970 if (NILP (Vpurify_flag
))
3971 normal
= PATH_LOADSEARCH
;
3973 normal
= PATH_DUMPLOADSEARCH
;
3975 /* In a dumped Emacs, we normally have to reset the value of
3976 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3977 uses ../lisp, instead of the path of the installed elisp
3978 libraries. However, if it appears that Vload_path was changed
3979 from the default before dumping, don't override that value. */
3982 if (! NILP (Fequal (dump_path
, Vload_path
)))
3984 Vload_path
= decode_env_path (0, normal
);
3985 if (!NILP (Vinstallation_directory
))
3987 Lisp_Object tem
, tem1
, sitelisp
;
3989 /* Remove site-lisp dirs from path temporarily and store
3990 them in sitelisp, then conc them on at the end so
3991 they're always first in path. */
3995 tem
= Fcar (Vload_path
);
3996 tem1
= Fstring_match (build_string ("site-lisp"),
4000 Vload_path
= Fcdr (Vload_path
);
4001 sitelisp
= Fcons (tem
, sitelisp
);
4007 /* Add to the path the lisp subdir of the
4008 installation dir, if it exists. */
4009 tem
= Fexpand_file_name (build_string ("lisp"),
4010 Vinstallation_directory
);
4011 tem1
= Ffile_exists_p (tem
);
4014 if (NILP (Fmember (tem
, Vload_path
)))
4016 turn_off_warning
= 1;
4017 Vload_path
= Fcons (tem
, Vload_path
);
4021 /* That dir doesn't exist, so add the build-time
4022 Lisp dirs instead. */
4023 Vload_path
= nconc2 (Vload_path
, dump_path
);
4025 /* Add leim under the installation dir, if it exists. */
4026 tem
= Fexpand_file_name (build_string ("leim"),
4027 Vinstallation_directory
);
4028 tem1
= Ffile_exists_p (tem
);
4031 if (NILP (Fmember (tem
, Vload_path
)))
4032 Vload_path
= Fcons (tem
, Vload_path
);
4035 /* Add site-lisp under the installation dir, if it exists. */
4036 tem
= Fexpand_file_name (build_string ("site-lisp"),
4037 Vinstallation_directory
);
4038 tem1
= Ffile_exists_p (tem
);
4041 if (NILP (Fmember (tem
, Vload_path
)))
4042 Vload_path
= Fcons (tem
, Vload_path
);
4045 /* If Emacs was not built in the source directory,
4046 and it is run from where it was built, add to load-path
4047 the lisp, leim and site-lisp dirs under that directory. */
4049 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
4053 tem
= Fexpand_file_name (build_string ("src/Makefile"),
4054 Vinstallation_directory
);
4055 tem1
= Ffile_exists_p (tem
);
4057 /* Don't be fooled if they moved the entire source tree
4058 AFTER dumping Emacs. If the build directory is indeed
4059 different from the source dir, src/Makefile.in and
4060 src/Makefile will not be found together. */
4061 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4062 Vinstallation_directory
);
4063 tem2
= Ffile_exists_p (tem
);
4064 if (!NILP (tem1
) && NILP (tem2
))
4066 tem
= Fexpand_file_name (build_string ("lisp"),
4069 if (NILP (Fmember (tem
, Vload_path
)))
4070 Vload_path
= Fcons (tem
, Vload_path
);
4072 tem
= Fexpand_file_name (build_string ("leim"),
4075 if (NILP (Fmember (tem
, Vload_path
)))
4076 Vload_path
= Fcons (tem
, Vload_path
);
4078 tem
= Fexpand_file_name (build_string ("site-lisp"),
4081 if (NILP (Fmember (tem
, Vload_path
)))
4082 Vload_path
= Fcons (tem
, Vload_path
);
4085 if (!NILP (sitelisp
))
4086 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4092 /* NORMAL refers to the lisp dir in the source directory. */
4093 /* We used to add ../lisp at the front here, but
4094 that caused trouble because it was copied from dump_path
4095 into Vload_path, above, when Vinstallation_directory was non-nil.
4096 It should be unnecessary. */
4097 Vload_path
= decode_env_path (0, normal
);
4098 dump_path
= Vload_path
;
4102 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
4103 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4104 almost never correct, thereby causing a warning to be printed out that
4105 confuses users. Since PATH_LOADSEARCH is always overridden by the
4106 EMACSLOADPATH environment variable below, disable the warning on NT.
4107 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
4108 the "standard" paths may not exist and would be overridden by
4109 EMACSLOADPATH as on NT. Since this depends on how the executable
4110 was build and packaged, turn off the warnings in general */
4112 /* Warn if dirs in the *standard* path don't exist. */
4113 if (!turn_off_warning
)
4115 Lisp_Object path_tail
;
4117 for (path_tail
= Vload_path
;
4119 path_tail
= XCDR (path_tail
))
4121 Lisp_Object dirfile
;
4122 dirfile
= Fcar (path_tail
);
4123 if (STRINGP (dirfile
))
4125 dirfile
= Fdirectory_file_name (dirfile
);
4126 if (access (SDATA (dirfile
), 0) < 0)
4127 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4132 #endif /* !(WINDOWSNT || HAVE_CARBON) */
4134 /* If the EMACSLOADPATH environment variable is set, use its value.
4135 This doesn't apply if we're dumping. */
4137 if (NILP (Vpurify_flag
)
4138 && egetenv ("EMACSLOADPATH"))
4140 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4144 load_in_progress
= 0;
4145 Vload_file_name
= Qnil
;
4147 load_descriptor_list
= Qnil
;
4149 Vstandard_input
= Qt
;
4150 Vloads_in_progress
= Qnil
;
4153 /* Print a warning, using format string FORMAT, that directory DIRNAME
4154 does not exist. Print it on stderr and put it in *Messages*. */
4157 dir_warning (format
, dirname
)
4159 Lisp_Object dirname
;
4162 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4164 fprintf (stderr
, format
, SDATA (dirname
));
4165 sprintf (buffer
, format
, SDATA (dirname
));
4166 /* Don't log the warning before we've initialized!! */
4168 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4175 defsubr (&Sread_from_string
);
4177 defsubr (&Sintern_soft
);
4178 defsubr (&Sunintern
);
4179 defsubr (&Sget_load_suffixes
);
4181 defsubr (&Seval_buffer
);
4182 defsubr (&Seval_region
);
4183 defsubr (&Sread_char
);
4184 defsubr (&Sread_char_exclusive
);
4185 defsubr (&Sread_event
);
4186 defsubr (&Sget_file_char
);
4187 defsubr (&Smapatoms
);
4188 defsubr (&Slocate_file_internal
);
4190 DEFVAR_LISP ("obarray", &Vobarray
,
4191 doc
: /* Symbol table for use by `intern' and `read'.
4192 It is a vector whose length ought to be prime for best results.
4193 The vector's contents don't make sense if examined from Lisp programs;
4194 to find all the symbols in an obarray, use `mapatoms'. */);
4196 DEFVAR_LISP ("values", &Vvalues
,
4197 doc
: /* List of values of all expressions which were read, evaluated and printed.
4198 Order is reverse chronological. */);
4200 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4201 doc
: /* Stream for read to get input from.
4202 See documentation of `read' for possible values. */);
4203 Vstandard_input
= Qt
;
4205 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4206 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4208 If this variable is a buffer, then only forms read from that buffer
4209 will be added to `read-symbol-positions-list'.
4210 If this variable is t, then all read forms will be added.
4211 The effect of all other values other than nil are not currently
4212 defined, although they may be in the future.
4214 The positions are relative to the last call to `read' or
4215 `read-from-string'. It is probably a bad idea to set this variable at
4216 the toplevel; bind it instead. */);
4217 Vread_with_symbol_positions
= Qnil
;
4219 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4220 doc
: /* A list mapping read symbols to their positions.
4221 This variable is modified during calls to `read' or
4222 `read-from-string', but only when `read-with-symbol-positions' is
4225 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4226 CHAR-POSITION is an integer giving the offset of that occurrence of the
4227 symbol from the position where `read' or `read-from-string' started.
4229 Note that a symbol will appear multiple times in this list, if it was
4230 read multiple times. The list is in the same order as the symbols
4232 Vread_symbol_positions_list
= Qnil
;
4234 DEFVAR_LISP ("load-path", &Vload_path
,
4235 doc
: /* *List of directories to search for files to load.
4236 Each element is a string (directory name) or nil (try default directory).
4237 Initialized based on EMACSLOADPATH environment variable, if any,
4238 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4240 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4241 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4242 This list should not include the empty string.
4243 `load' and related functions try to append these suffixes, in order,
4244 to the specified file name if a Lisp suffix is allowed or required. */);
4245 Vload_suffixes
= Fcons (build_string (".elc"),
4246 Fcons (build_string (".el"), Qnil
));
4247 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4248 doc
: /* List of suffixes that indicate representations of \
4250 This list should normally start with the empty string.
4252 Enabling Auto Compression mode appends the suffixes in
4253 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4254 mode removes them again. `load' and related functions use this list to
4255 determine whether they should look for compressed versions of a file
4256 and, if so, which suffixes they should try to append to the file name
4257 in order to do so. However, if you want to customize which suffixes
4258 the loading functions recognize as compression suffixes, you should
4259 customize `jka-compr-load-suffixes' rather than the present variable. */);
4260 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4262 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4263 doc
: /* Non-nil if inside of `load'. */);
4265 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4266 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4267 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4269 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4270 a symbol \(a feature name).
4272 When `load' is run and the file-name argument matches an element's
4273 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4274 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4276 An error in FORMS does not undo the load, but does prevent execution of
4277 the rest of the FORMS. */);
4278 Vafter_load_alist
= Qnil
;
4280 DEFVAR_LISP ("load-history", &Vload_history
,
4281 doc
: /* Alist mapping file names to symbols and features.
4282 Each alist element is a list that starts with a file name,
4283 except for one element (optional) that starts with nil and describes
4284 definitions evaluated from buffers not visiting files.
4286 The file name is absolute and is the true file name (i.e. it doesn't
4287 contain symbolic links) of the loaded file.
4289 The remaining elements of each list are symbols defined as variables
4290 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4291 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4292 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4293 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
4294 this file redefined it as a function.
4296 During preloading, the file name recorded is relative to the main Lisp
4297 directory. These file names are converted to absolute at startup. */);
4298 Vload_history
= Qnil
;
4300 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4301 doc
: /* Full name of file being loaded by `load'. */);
4302 Vload_file_name
= Qnil
;
4304 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4305 doc
: /* File name, including directory, of user's initialization file.
4306 If the file loaded had extension `.elc', and the corresponding source file
4307 exists, this variable contains the name of source file, suitable for use
4308 by functions like `custom-save-all' which edit the init file.
4309 While Emacs loads and evaluates the init file, value is the real name
4310 of the file, regardless of whether or not it has the `.elc' extension. */);
4311 Vuser_init_file
= Qnil
;
4313 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4314 doc
: /* Used for internal purposes by `load'. */);
4315 Vcurrent_load_list
= Qnil
;
4317 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4318 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4319 The default is nil, which means use the function `read'. */);
4320 Vload_read_function
= Qnil
;
4322 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4323 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4324 This function is for doing code conversion before reading the source file.
4325 If nil, loading is done without any code conversion.
4326 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4327 FULLNAME is the full name of FILE.
4328 See `load' for the meaning of the remaining arguments. */);
4329 Vload_source_file_function
= Qnil
;
4331 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4332 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4333 This is useful when the file being loaded is a temporary copy. */);
4334 load_force_doc_strings
= 0;
4336 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4337 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4338 This is normally bound by `load' and `eval-buffer' to control `read',
4339 and is not meant for users to change. */);
4340 load_convert_to_unibyte
= 0;
4342 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4343 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4344 You cannot count on them to still be there! */);
4346 = Fexpand_file_name (build_string ("../"),
4347 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4349 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4350 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4351 Vpreloaded_file_list
= Qnil
;
4353 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4354 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4355 Vbyte_boolean_vars
= Qnil
;
4357 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4358 doc
: /* Non-nil means load dangerous compiled Lisp files.
4359 Some versions of XEmacs use different byte codes than Emacs. These
4360 incompatible byte codes can make Emacs crash when it tries to execute
4362 load_dangerous_libraries
= 0;
4364 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4365 doc
: /* Regular expression matching safe to load compiled Lisp files.
4366 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4367 from the file, and matches them against this regular expression.
4368 When the regular expression matches, the file is considered to be safe
4369 to load. See also `load-dangerous-libraries'. */);
4370 Vbytecomp_version_regexp
4371 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4373 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4374 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4375 Veval_buffer_list
= Qnil
;
4377 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes
,
4378 doc
: /* Set to non-nil when `read' encounters an old-style backquote. */);
4379 Vold_style_backquotes
= Qnil
;
4380 Qold_style_backquotes
= intern ("old-style-backquotes");
4381 staticpro (&Qold_style_backquotes
);
4383 /* Vsource_directory was initialized in init_lread. */
4385 load_descriptor_list
= Qnil
;
4386 staticpro (&load_descriptor_list
);
4388 Qcurrent_load_list
= intern ("current-load-list");
4389 staticpro (&Qcurrent_load_list
);
4391 Qstandard_input
= intern ("standard-input");
4392 staticpro (&Qstandard_input
);
4394 Qread_char
= intern ("read-char");
4395 staticpro (&Qread_char
);
4397 Qget_file_char
= intern ("get-file-char");
4398 staticpro (&Qget_file_char
);
4400 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4401 staticpro (&Qget_emacs_mule_file_char
);
4403 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4404 staticpro (&Qload_force_doc_strings
);
4406 Qbackquote
= intern ("`");
4407 staticpro (&Qbackquote
);
4408 Qcomma
= intern (",");
4409 staticpro (&Qcomma
);
4410 Qcomma_at
= intern (",@");
4411 staticpro (&Qcomma_at
);
4412 Qcomma_dot
= intern (",.");
4413 staticpro (&Qcomma_dot
);
4415 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4416 staticpro (&Qinhibit_file_name_operation
);
4418 Qascii_character
= intern ("ascii-character");
4419 staticpro (&Qascii_character
);
4421 Qfunction
= intern ("function");
4422 staticpro (&Qfunction
);
4424 Qload
= intern ("load");
4427 Qload_file_name
= intern ("load-file-name");
4428 staticpro (&Qload_file_name
);
4430 Qeval_buffer_list
= intern ("eval-buffer-list");
4431 staticpro (&Qeval_buffer_list
);
4433 Qfile_truename
= intern ("file-truename");
4434 staticpro (&Qfile_truename
) ;
4436 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4437 staticpro (&Qdo_after_load_evaluation
) ;
4439 staticpro (&dump_path
);
4441 staticpro (&read_objects
);
4442 read_objects
= Qnil
;
4443 staticpro (&seen_list
);
4446 Vloads_in_progress
= Qnil
;
4447 staticpro (&Vloads_in_progress
);
4450 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4451 (do not change this comment) */