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 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
31 #include "intervals.h"
33 #include "character.h"
39 #include "termhooks.h"
41 #include "blockinput.h"
44 #include <sys/inode.h>
49 #include <unistd.h> /* to get X_OK */
66 #endif /* HAVE_SETLOCALE */
76 #define file_offset off_t
77 #define file_tell ftello
79 #define file_offset long
80 #define file_tell ftell
87 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
88 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
89 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
90 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
91 Lisp_Object Qinhibit_file_name_operation
;
92 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
93 Lisp_Object Qfile_truename
, Qdo_after_load_evaluation
; /* ACM 2006/5/16 */
95 /* Used instead of Qget_file_char while loading *.elc files compiled
96 by Emacs 21 or older. */
97 static Lisp_Object Qget_emacs_mule_file_char
;
99 static Lisp_Object Qload_force_doc_strings
;
101 extern Lisp_Object Qevent_symbol_element_mask
;
102 extern Lisp_Object Qfile_exists_p
;
104 /* non-zero iff inside `load' */
105 int load_in_progress
;
107 /* Directory in which the sources were found. */
108 Lisp_Object Vsource_directory
;
110 /* Search path and suffixes for files to be loaded. */
111 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
113 /* File name of user's init file. */
114 Lisp_Object Vuser_init_file
;
116 /* This is the user-visible association list that maps features to
117 lists of defs in their load files. */
118 Lisp_Object Vload_history
;
120 /* This is used to build the load history. */
121 Lisp_Object Vcurrent_load_list
;
123 /* List of files that were preloaded. */
124 Lisp_Object Vpreloaded_file_list
;
126 /* Name of file actually being read by `load'. */
127 Lisp_Object Vload_file_name
;
129 /* Function to use for reading, in `load' and friends. */
130 Lisp_Object Vload_read_function
;
132 /* The association list of objects read with the #n=object form.
133 Each member of the list has the form (n . object), and is used to
134 look up the object for the corresponding #n# construct.
135 It must be set to nil before all top-level calls to read0. */
136 Lisp_Object read_objects
;
138 /* Nonzero means load should forcibly load all dynamic doc strings. */
139 static int load_force_doc_strings
;
141 /* Nonzero means read should convert strings to unibyte. */
142 static int load_convert_to_unibyte
;
144 /* Nonzero means READCHAR should read bytes one by one (not character)
145 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
146 This is set to 1 by read1 temporarily while handling #@NUMBER. */
147 static int load_each_byte
;
149 /* Function to use for loading an Emacs Lisp source file (not
150 compiled) instead of readevalloop. */
151 Lisp_Object Vload_source_file_function
;
153 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
154 Lisp_Object Vbyte_boolean_vars
;
156 /* Whether or not to add a `read-positions' property to symbols
158 Lisp_Object Vread_with_symbol_positions
;
160 /* List of (SYMBOL . POSITION) accumulated so far. */
161 Lisp_Object Vread_symbol_positions_list
;
163 /* List of descriptors now open for Fload. */
164 static Lisp_Object load_descriptor_list
;
166 /* File for get_file_char to read from. Use by load. */
167 static FILE *instream
;
169 /* When nonzero, read conses in pure space */
170 static int read_pure
;
172 /* For use within read-from-string (this reader is non-reentrant!!) */
173 static int read_from_string_index
;
174 static int read_from_string_index_byte
;
175 static int read_from_string_limit
;
177 /* Number of characters read in the current call to Fread or
178 Fread_from_string. */
179 static int readchar_count
;
181 /* This contains the last string skipped with #@. */
182 static char *saved_doc_string
;
183 /* Length of buffer allocated in saved_doc_string. */
184 static int saved_doc_string_size
;
185 /* Length of actual data in saved_doc_string. */
186 static int saved_doc_string_length
;
187 /* This is the file position that string came from. */
188 static file_offset saved_doc_string_position
;
190 /* This contains the previous string skipped with #@.
191 We copy it from saved_doc_string when a new string
192 is put in saved_doc_string. */
193 static char *prev_saved_doc_string
;
194 /* Length of buffer allocated in prev_saved_doc_string. */
195 static int prev_saved_doc_string_size
;
196 /* Length of actual data in prev_saved_doc_string. */
197 static int prev_saved_doc_string_length
;
198 /* This is the file position that string came from. */
199 static file_offset prev_saved_doc_string_position
;
201 /* Nonzero means inside a new-style backquote
202 with no surrounding parentheses.
203 Fread initializes this to zero, so we need not specbind it
204 or worry about what happens to it when there is an error. */
205 static int new_backquote_flag
;
207 /* A list of file names for files being loaded in Fload. Used to
208 check for recursive loads. */
210 static Lisp_Object Vloads_in_progress
;
212 /* Non-zero means load dangerous compiled Lisp files. */
214 int load_dangerous_libraries
;
216 /* A regular expression used to detect files compiled with Emacs. */
218 static Lisp_Object Vbytecomp_version_regexp
;
220 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
223 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
224 Lisp_Object (*) (), int,
225 Lisp_Object
, Lisp_Object
,
226 Lisp_Object
, Lisp_Object
));
227 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
228 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
230 static void invalid_syntax
P_ ((const char *, int)) NO_RETURN
;
231 static void end_of_file_error
P_ (()) NO_RETURN
;
234 /* Functions that read one byte from the current source READCHARFUN
235 or unreads one byte. If the integer argument C is -1, it returns
236 one read byte, or -1 when there's no more byte in the source. If C
237 is 0 or positive, it unreads C, and the return value is not
240 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
241 static int readbyte_from_file
P_ ((int, Lisp_Object
));
242 static int readbyte_from_string
P_ ((int, Lisp_Object
));
244 /* Handle unreading and rereading of characters.
245 Write READCHAR to read a character,
246 UNREAD(c) to unread c to be read again.
248 These macros correctly read/unread multibyte characters. */
250 #define READCHAR readchar (readcharfun)
251 #define UNREAD(c) unreadchar (readcharfun, c)
253 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
254 Qlambda, or a cons, we use this to keep an unread character because
255 a file stream can't handle multibyte-char unreading. The value -1
256 means that there's no unread character. */
257 static int unread_char
;
260 readchar (readcharfun
)
261 Lisp_Object readcharfun
;
265 int (*readbyte
) P_ ((int, Lisp_Object
));
266 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
268 int emacs_mule_encoding
= 0;
272 if (BUFFERP (readcharfun
))
274 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
276 int pt_byte
= BUF_PT_BYTE (inbuffer
);
278 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
281 if (! NILP (inbuffer
->enable_multibyte_characters
))
283 /* Fetch the character code from the buffer. */
284 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
285 BUF_INC_POS (inbuffer
, pt_byte
);
286 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
290 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
291 if (! ASCII_BYTE_P (c
))
292 c
= BYTE8_TO_CHAR (c
);
295 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
299 if (MARKERP (readcharfun
))
301 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
303 int bytepos
= marker_byte_position (readcharfun
);
305 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
308 if (! NILP (inbuffer
->enable_multibyte_characters
))
310 /* Fetch the character code from the buffer. */
311 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
312 BUF_INC_POS (inbuffer
, bytepos
);
313 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
317 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
318 if (! ASCII_BYTE_P (c
))
319 c
= BYTE8_TO_CHAR (c
);
323 XMARKER (readcharfun
)->bytepos
= bytepos
;
324 XMARKER (readcharfun
)->charpos
++;
329 if (EQ (readcharfun
, Qlambda
))
331 readbyte
= readbyte_for_lambda
;
335 if (EQ (readcharfun
, Qget_file_char
))
337 readbyte
= readbyte_from_file
;
341 if (STRINGP (readcharfun
))
343 if (read_from_string_index
>= read_from_string_limit
)
346 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
347 read_from_string_index
,
348 read_from_string_index_byte
);
353 if (CONSP (readcharfun
))
355 /* This is the case that read_vector is reading from a unibyte
356 string that contains a byte sequence previously skipped
357 because of #@NUMBER. The car part of readcharfun is that
358 string, and the cdr part is a value of readcharfun given to
360 readbyte
= readbyte_from_string
;
361 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
362 emacs_mule_encoding
= 1;
366 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
368 readbyte
= readbyte_from_file
;
369 emacs_mule_encoding
= 1;
373 tem
= call0 (readcharfun
);
380 if (unread_char
>= 0)
386 c
= (*readbyte
) (-1, readcharfun
);
387 if (c
< 0 || ASCII_BYTE_P (c
) || load_each_byte
)
389 if (emacs_mule_encoding
)
390 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
393 len
= BYTES_BY_CHAR_HEAD (c
);
396 c
= (*readbyte
) (-1, readcharfun
);
397 if (c
< 0 || ! TRAILING_CODE_P (c
))
400 (*readbyte
) (buf
[i
], readcharfun
);
401 return BYTE8_TO_CHAR (buf
[0]);
405 return STRING_CHAR (buf
, i
);
408 /* Unread the character C in the way appropriate for the stream READCHARFUN.
409 If the stream is a user function, call it with the char as argument. */
412 unreadchar (readcharfun
, c
)
413 Lisp_Object readcharfun
;
418 /* Don't back up the pointer if we're unreading the end-of-input mark,
419 since readchar didn't advance it when we read it. */
421 else if (BUFFERP (readcharfun
))
423 struct buffer
*b
= XBUFFER (readcharfun
);
424 int bytepos
= BUF_PT_BYTE (b
);
427 if (! NILP (b
->enable_multibyte_characters
))
428 BUF_DEC_POS (b
, bytepos
);
432 BUF_PT_BYTE (b
) = bytepos
;
434 else if (MARKERP (readcharfun
))
436 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
437 int bytepos
= XMARKER (readcharfun
)->bytepos
;
439 XMARKER (readcharfun
)->charpos
--;
440 if (! NILP (b
->enable_multibyte_characters
))
441 BUF_DEC_POS (b
, bytepos
);
445 XMARKER (readcharfun
)->bytepos
= bytepos
;
447 else if (STRINGP (readcharfun
))
449 read_from_string_index
--;
450 read_from_string_index_byte
451 = string_char_to_byte (readcharfun
, read_from_string_index
);
453 else if (CONSP (readcharfun
))
457 else if (EQ (readcharfun
, Qlambda
))
461 else if (EQ (readcharfun
, Qget_file_char
)
462 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
467 ungetc (c
, instream
);
474 call1 (readcharfun
, make_number (c
));
478 readbyte_for_lambda (c
, readcharfun
)
480 Lisp_Object readcharfun
;
482 return read_bytecode_char (c
>= 0);
487 readbyte_from_file (c
, readcharfun
)
489 Lisp_Object readcharfun
;
494 ungetc (c
, instream
);
503 /* Interrupted reads have been observed while reading over the network */
504 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
516 return (c
== EOF
? -1 : c
);
520 readbyte_from_string (c
, readcharfun
)
522 Lisp_Object readcharfun
;
524 Lisp_Object string
= XCAR (readcharfun
);
528 read_from_string_index
--;
529 read_from_string_index_byte
530 = string_char_to_byte (string
, read_from_string_index
);
533 if (read_from_string_index
>= read_from_string_limit
)
536 FETCH_STRING_CHAR_ADVANCE (c
, string
,
537 read_from_string_index
,
538 read_from_string_index_byte
);
543 /* Read one non-ASCII character from INSTREAM. The character is
544 encoded in `emacs-mule' and the first byte is already read in
547 extern char emacs_mule_bytes
[256];
550 read_emacs_mule_char (c
, readbyte
, readcharfun
)
552 int (*readbyte
) P_ ((int, Lisp_Object
));
553 Lisp_Object readcharfun
;
555 /* Emacs-mule coding uses at most 4-byte for one character. */
556 unsigned char buf
[4];
557 int len
= emacs_mule_bytes
[c
];
558 struct charset
*charset
;
563 /* C is not a valid leading-code of `emacs-mule'. */
564 return BYTE8_TO_CHAR (c
);
570 c
= (*readbyte
) (-1, readcharfun
);
574 (*readbyte
) (buf
[i
], readcharfun
);
575 return BYTE8_TO_CHAR (buf
[0]);
582 charset
= emacs_mule_charset
[buf
[0]];
583 code
= buf
[1] & 0x7F;
587 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
588 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
590 charset
= emacs_mule_charset
[buf
[1]];
591 code
= buf
[2] & 0x7F;
595 charset
= emacs_mule_charset
[buf
[0]];
596 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
601 charset
= emacs_mule_charset
[buf
[1]];
602 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
604 c
= DECODE_CHAR (charset
, code
);
606 Fsignal (Qinvalid_read_syntax
,
607 Fcons (build_string ("invalid multibyte form"), Qnil
));
612 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
614 static Lisp_Object read0
P_ ((Lisp_Object
));
615 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
617 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
618 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
620 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
622 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
624 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
627 /* Get a character from the tty. */
629 extern Lisp_Object
read_char ();
631 /* Read input events until we get one that's acceptable for our purposes.
633 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
634 until we get a character we like, and then stuffed into
637 If ASCII_REQUIRED is non-zero, we check function key events to see
638 if the unmodified version of the symbol has a Qascii_character
639 property, and use that character, if present.
641 If ERROR_NONASCII is non-zero, we signal an error if the input we
642 get isn't an ASCII character with modifiers. If it's zero but
643 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
646 If INPUT_METHOD is nonzero, we invoke the current input method
647 if the character warrants that.
649 If SECONDS is a number, we wait that many seconds for input, and
650 return Qnil if no input arrives within that time. */
653 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
654 input_method
, seconds
)
655 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
658 Lisp_Object val
, delayed_switch_frame
;
661 #ifdef HAVE_WINDOW_SYSTEM
662 if (display_hourglass_p
)
666 delayed_switch_frame
= Qnil
;
668 /* Compute timeout. */
669 if (NUMBERP (seconds
))
671 EMACS_TIME wait_time
;
673 double duration
= extract_float (seconds
);
675 sec
= (int) duration
;
676 usec
= (duration
- sec
) * 1000000;
677 EMACS_GET_TIME (end_time
);
678 EMACS_SET_SECS_USECS (wait_time
, sec
, usec
);
679 EMACS_ADD_TIME (end_time
, end_time
, wait_time
);
682 /* Read until we get an acceptable event. */
684 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0,
685 NUMBERP (seconds
) ? &end_time
: NULL
);
690 /* switch-frame events are put off until after the next ASCII
691 character. This is better than signaling an error just because
692 the last characters were typed to a separate minibuffer frame,
693 for example. Eventually, some code which can deal with
694 switch-frame events will read it and process it. */
696 && EVENT_HAS_PARAMETERS (val
)
697 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val
)), Qswitch_frame
))
699 delayed_switch_frame
= val
;
703 if (ascii_required
&& !(NUMBERP (seconds
) && NILP (val
)))
705 /* Convert certain symbols to their ASCII equivalents. */
708 Lisp_Object tem
, tem1
;
709 tem
= Fget (val
, Qevent_symbol_element_mask
);
712 tem1
= Fget (Fcar (tem
), Qascii_character
);
713 /* Merge this symbol's modifier bits
714 with the ASCII equivalent of its basic code. */
716 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
720 /* If we don't have a character now, deal with it appropriately. */
725 Vunread_command_events
= Fcons (val
, Qnil
);
726 error ("Non-character input-event");
733 if (! NILP (delayed_switch_frame
))
734 unread_switch_frame
= delayed_switch_frame
;
738 #ifdef HAVE_WINDOW_SYSTEM
739 if (display_hourglass_p
)
748 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 3, 0,
749 doc
: /* Read a character from the command input (keyboard or macro).
750 It is returned as a number.
751 If the user generates an event which is not a character (i.e. a mouse
752 click or function key event), `read-char' signals an error. As an
753 exception, switch-frame events are put off until non-ASCII events can
755 If you want to read non-character events, or ignore them, call
756 `read-event' or `read-char-exclusive' instead.
758 If the optional argument PROMPT is non-nil, display that as a prompt.
759 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
760 input method is turned on in the current buffer, that input method
761 is used for reading a character.
762 If the optional argument SECONDS is non-nil, it should be a number
763 specifying the maximum number of seconds to wait for input. If no
764 input arrives in that time, return nil. SECONDS may be a
765 floating-point value. */)
766 (prompt
, inherit_input_method
, seconds
)
767 Lisp_Object prompt
, inherit_input_method
, seconds
;
770 message_with_string ("%s", prompt
, 0);
771 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
), seconds
);
774 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 3, 0,
775 doc
: /* Read an event object from the input stream.
776 If the optional argument PROMPT is non-nil, display that as a prompt.
777 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
778 input method is turned on in the current buffer, that input method
779 is used for reading a character.
780 If the optional argument SECONDS is non-nil, it should be a number
781 specifying the maximum number of seconds to wait for input. If no
782 input arrives in that time, return nil. SECONDS may be a
783 floating-point value. */)
784 (prompt
, inherit_input_method
, seconds
)
785 Lisp_Object prompt
, inherit_input_method
, seconds
;
788 message_with_string ("%s", prompt
, 0);
789 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
), seconds
);
792 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 3, 0,
793 doc
: /* Read a character from the command input (keyboard or macro).
794 It is returned as a number. Non-character events are ignored.
796 If the optional argument PROMPT is non-nil, display that as a prompt.
797 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
798 input method is turned on in the current buffer, that input method
799 is used for reading a character.
800 If the optional argument SECONDS is non-nil, it should be a number
801 specifying the maximum number of seconds to wait for input. If no
802 input arrives in that time, return nil. SECONDS may be a
803 floating-point value. */)
804 (prompt
, inherit_input_method
, seconds
)
805 Lisp_Object prompt
, inherit_input_method
, seconds
;
808 message_with_string ("%s", prompt
, 0);
809 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
), seconds
);
812 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
813 doc
: /* Don't use this yourself. */)
816 register Lisp_Object val
;
818 XSETINT (val
, getc (instream
));
825 /* Value is a version number of byte compiled code if the file
826 asswociated with file descriptor FD is a compiled Lisp file that's
827 safe to load. Only files compiled with Emacs are safe to load.
828 Files compiled with XEmacs can lead to a crash in Fbyte_code
829 because of an incompatible change in the byte compiler. */
840 /* Read the first few bytes from the file, and look for a line
841 specifying the byte compiler version used. */
842 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
847 /* Skip to the next newline, skipping over the initial `ELC'
848 with NUL bytes following it, but note the version. */
849 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
854 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
861 lseek (fd
, 0, SEEK_SET
);
866 /* Callback for record_unwind_protect. Restore the old load list OLD,
867 after loading a file successfully. */
870 record_load_unwind (old
)
873 return Vloads_in_progress
= old
;
876 /* This handler function is used via internal_condition_case_1. */
879 load_error_handler (data
)
885 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
886 doc
: /* Return the suffixes that `load' should try if a suffix is \
888 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
891 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
892 while (CONSP (suffixes
))
894 Lisp_Object exts
= Vload_file_rep_suffixes
;
895 suffix
= XCAR (suffixes
);
896 suffixes
= XCDR (suffixes
);
901 lst
= Fcons (concat2 (suffix
, ext
), lst
);
904 return Fnreverse (lst
);
907 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
908 doc
: /* Execute a file of Lisp code named FILE.
909 First try FILE with `.elc' appended, then try with `.el',
910 then try FILE unmodified (the exact suffixes in the exact order are
911 determined by `load-suffixes'). Environment variable references in
912 FILE are replaced with their values by calling `substitute-in-file-name'.
913 This function searches the directories in `load-path'.
915 If optional second arg NOERROR is non-nil,
916 report no error if FILE doesn't exist.
917 Print messages at start and end of loading unless
918 optional third arg NOMESSAGE is non-nil.
919 If optional fourth arg NOSUFFIX is non-nil, don't try adding
920 suffixes `.elc' or `.el' to the specified name FILE.
921 If optional fifth arg MUST-SUFFIX is non-nil, insist on
922 the suffix `.elc' or `.el'; don't accept just FILE unless
923 it ends in one of those suffixes or includes a directory name.
925 If this function fails to find a file, it may look for different
926 representations of that file before trying another file.
927 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
928 to the file name. Emacs uses this feature mainly to find compressed
929 versions of files when Auto Compression mode is enabled.
931 The exact suffixes that this function tries out, in the exact order,
932 are given by the value of the variable `load-file-rep-suffixes' if
933 NOSUFFIX is non-nil and by the return value of the function
934 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
935 MUST-SUFFIX are nil, this function first tries out the latter suffixes
938 Loading a file records its definitions, and its `provide' and
939 `require' calls, in an element of `load-history' whose
940 car is the file name loaded. See `load-history'.
942 Return t if the file exists and loads successfully. */)
943 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
944 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
946 register FILE *stream
;
947 register int fd
= -1;
948 int count
= SPECPDL_INDEX ();
950 struct gcpro gcpro1
, gcpro2
, gcpro3
;
951 Lisp_Object found
, efound
, hist_file_name
;
952 /* 1 means we printed the ".el is newer" message. */
954 /* 1 means we are loading a compiled file. */
968 /* If file name is magic, call the handler. */
969 /* This shouldn't be necessary any more now that `openp' handles it right.
970 handler = Ffind_file_name_handler (file, Qload);
972 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
974 /* Do this after the handler to avoid
975 the need to gcpro noerror, nomessage and nosuffix.
976 (Below here, we care only whether they are nil or not.)
977 The presence of this call is the result of a historical accident:
978 it used to be in every file-operation and when it got removed
979 everywhere, it accidentally stayed here. Since then, enough people
980 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
981 that it seemed risky to remove. */
982 if (! NILP (noerror
))
984 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
985 Qt
, load_error_handler
);
990 file
= Fsubstitute_in_file_name (file
);
993 /* Avoid weird lossage with null string as arg,
994 since it would try to load a directory as a Lisp file */
995 if (SCHARS (file
) > 0)
997 int size
= SBYTES (file
);
1000 GCPRO2 (file
, found
);
1002 if (! NILP (must_suffix
))
1004 /* Don't insist on adding a suffix if FILE already ends with one. */
1006 && !strcmp (SDATA (file
) + size
- 3, ".el"))
1009 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
1011 /* Don't insist on adding a suffix
1012 if the argument includes a directory name. */
1013 else if (! NILP (Ffile_name_directory (file
)))
1017 fd
= openp (Vload_path
, file
,
1018 (!NILP (nosuffix
) ? Qnil
1019 : !NILP (must_suffix
) ? Fget_load_suffixes ()
1020 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
1021 tmp
[1] = Vload_file_rep_suffixes
,
1030 xsignal2 (Qfile_error
, build_string ("Cannot open load file"), file
);
1034 /* Tell startup.el whether or not we found the user's init file. */
1035 if (EQ (Qt
, Vuser_init_file
))
1036 Vuser_init_file
= found
;
1038 /* If FD is -2, that means openp found a magic file. */
1041 if (NILP (Fequal (found
, file
)))
1042 /* If FOUND is a different file name from FILE,
1043 find its handler even if we have already inhibited
1044 the `load' operation on FILE. */
1045 handler
= Ffind_file_name_handler (found
, Qt
);
1047 handler
= Ffind_file_name_handler (found
, Qload
);
1048 if (! NILP (handler
))
1049 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
1052 /* Check if we're stuck in a recursive load cycle.
1054 2000-09-21: It's not possible to just check for the file loaded
1055 being a member of Vloads_in_progress. This fails because of the
1056 way the byte compiler currently works; `provide's are not
1057 evaluted, see font-lock.el/jit-lock.el as an example. This
1058 leads to a certain amount of ``normal'' recursion.
1060 Also, just loading a file recursively is not always an error in
1061 the general case; the second load may do something different. */
1065 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
1066 if (!NILP (Fequal (found
, XCAR (tem
))))
1072 signal_error ("Recursive load", Fcons (found
, Vloads_in_progress
));
1074 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
1075 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
1078 /* Get the name for load-history. */
1079 hist_file_name
= (! NILP (Vpurify_flag
)
1080 ? Fconcat (2, (tmp
[0] = Ffile_name_directory (file
),
1081 tmp
[1] = Ffile_name_nondirectory (found
),
1086 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
1088 || (version
= safe_to_load_p (fd
)) > 0)
1089 /* Load .elc files directly, but not when they are
1090 remote and have no handler! */
1097 GCPRO3 (file
, found
, hist_file_name
);
1100 && ! (version
= safe_to_load_p (fd
)))
1103 if (!load_dangerous_libraries
)
1107 error ("File `%s' was not compiled in Emacs",
1110 else if (!NILP (nomessage
))
1111 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
1116 efound
= ENCODE_FILE (found
);
1121 stat ((char *)SDATA (efound
), &s1
);
1122 SSET (efound
, SBYTES (efound
) - 1, 0);
1123 result
= stat ((char *)SDATA (efound
), &s2
);
1124 SSET (efound
, SBYTES (efound
) - 1, 'c');
1126 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
1128 /* Make the progress messages mention that source is newer. */
1131 /* If we won't print another message, mention this anyway. */
1132 if (!NILP (nomessage
))
1134 Lisp_Object msg_file
;
1135 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
1136 message_with_string ("Source file `%s' newer than byte-compiled file",
1145 /* We are loading a source file (*.el). */
1146 if (!NILP (Vload_source_file_function
))
1152 val
= call4 (Vload_source_file_function
, found
, hist_file_name
,
1153 NILP (noerror
) ? Qnil
: Qt
,
1154 NILP (nomessage
) ? Qnil
: Qt
);
1155 return unbind_to (count
, val
);
1159 GCPRO3 (file
, found
, hist_file_name
);
1163 efound
= ENCODE_FILE (found
);
1164 stream
= fopen ((char *) SDATA (efound
), fmode
);
1165 #else /* not WINDOWSNT */
1166 stream
= fdopen (fd
, fmode
);
1167 #endif /* not WINDOWSNT */
1171 error ("Failure to create stdio stream for %s", SDATA (file
));
1174 if (! NILP (Vpurify_flag
))
1175 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1177 if (NILP (nomessage
))
1180 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1183 message_with_string ("Loading %s (source)...", file
, 1);
1185 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1187 else /* The typical case; compiled file newer than source file. */
1188 message_with_string ("Loading %s...", file
, 1);
1191 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
1192 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1193 specbind (Qload_file_name
, found
);
1194 specbind (Qinhibit_file_name_operation
, Qnil
);
1195 load_descriptor_list
1196 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1198 if (! version
|| version
>= 22)
1199 readevalloop (Qget_file_char
, stream
, hist_file_name
,
1200 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
1203 /* We can't handle a file which was compiled with
1204 byte-compile-dynamic by older version of Emacs. */
1205 specbind (Qload_force_doc_strings
, Qt
);
1206 readevalloop (Qget_emacs_mule_file_char
, stream
, hist_file_name
, Feval
,
1207 0, Qnil
, Qnil
, Qnil
, Qnil
);
1209 unbind_to (count
, Qnil
);
1211 /* Run any eval-after-load forms for this file */
1212 if (NILP (Vpurify_flag
)
1213 && (!NILP (Ffboundp (Qdo_after_load_evaluation
))))
1214 call1 (Qdo_after_load_evaluation
, hist_file_name
) ;
1218 if (saved_doc_string
)
1219 free (saved_doc_string
);
1220 saved_doc_string
= 0;
1221 saved_doc_string_size
= 0;
1223 if (prev_saved_doc_string
)
1224 xfree (prev_saved_doc_string
);
1225 prev_saved_doc_string
= 0;
1226 prev_saved_doc_string_size
= 0;
1228 if (!noninteractive
&& NILP (nomessage
))
1231 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1234 message_with_string ("Loading %s (source)...done", file
, 1);
1236 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1238 else /* The typical case; compiled file newer than source file. */
1239 message_with_string ("Loading %s...done", file
, 1);
1242 if (!NILP (Fequal (build_string ("obsolete"),
1243 Ffile_name_nondirectory
1244 (Fdirectory_file_name (Ffile_name_directory (found
))))))
1245 message_with_string ("Package %s is obsolete", file
, 1);
1251 load_unwind (arg
) /* used as unwind-protect function in load */
1254 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1261 if (--load_in_progress
< 0) load_in_progress
= 0;
1266 load_descriptor_unwind (oldlist
)
1267 Lisp_Object oldlist
;
1269 load_descriptor_list
= oldlist
;
1273 /* Close all descriptors in use for Floads.
1274 This is used when starting a subprocess. */
1281 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1282 emacs_close (XFASTINT (XCAR (tail
)));
1287 complete_filename_p (pathname
)
1288 Lisp_Object pathname
;
1290 register const unsigned char *s
= SDATA (pathname
);
1291 return (IS_DIRECTORY_SEP (s
[0])
1292 || (SCHARS (pathname
) > 2
1293 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1303 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1304 doc
: /* Search for FILENAME through PATH.
1305 Returns the file's name in absolute form, or nil if not found.
1306 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1307 file name when searching.
1308 If non-nil, PREDICATE is used instead of `file-readable-p'.
1309 PREDICATE can also be an integer to pass to the access(2) function,
1310 in which case file-name-handlers are ignored. */)
1311 (filename
, path
, suffixes
, predicate
)
1312 Lisp_Object filename
, path
, suffixes
, predicate
;
1315 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1316 if (NILP (predicate
) && fd
> 0)
1322 /* Search for a file whose name is STR, looking in directories
1323 in the Lisp list PATH, and trying suffixes from SUFFIX.
1324 On success, returns a file descriptor. On failure, returns -1.
1326 SUFFIXES is a list of strings containing possible suffixes.
1327 The empty suffix is automatically added iff the list is empty.
1329 PREDICATE non-nil means don't open the files,
1330 just look for one that satisfies the predicate. In this case,
1331 returns 1 on success. The predicate can be a lisp function or
1332 an integer to pass to `access' (in which case file-name-handlers
1335 If STOREPTR is nonzero, it points to a slot where the name of
1336 the file actually found should be stored as a Lisp string.
1337 nil is stored there on failure.
1339 If the file we find is remote, return -2
1340 but store the found remote file name in *STOREPTR. */
1343 openp (path
, str
, suffixes
, storeptr
, predicate
)
1344 Lisp_Object path
, str
;
1345 Lisp_Object suffixes
;
1346 Lisp_Object
*storeptr
;
1347 Lisp_Object predicate
;
1352 register char *fn
= buf
;
1355 Lisp_Object filename
;
1357 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1358 Lisp_Object string
, tail
, encoded_fn
;
1359 int max_suffix_len
= 0;
1363 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1365 CHECK_STRING_CAR (tail
);
1366 max_suffix_len
= max (max_suffix_len
,
1367 SBYTES (XCAR (tail
)));
1370 string
= filename
= encoded_fn
= Qnil
;
1371 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1376 if (complete_filename_p (str
))
1379 for (; CONSP (path
); path
= XCDR (path
))
1381 filename
= Fexpand_file_name (str
, XCAR (path
));
1382 if (!complete_filename_p (filename
))
1383 /* If there are non-absolute elts in PATH (eg ".") */
1384 /* Of course, this could conceivably lose if luser sets
1385 default-directory to be something non-absolute... */
1387 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1388 if (!complete_filename_p (filename
))
1389 /* Give up on this path element! */
1393 /* Calculate maximum size of any filename made from
1394 this path element/specified file name and any possible suffix. */
1395 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1396 if (fn_size
< want_size
)
1397 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1399 /* Loop over suffixes. */
1400 for (tail
= NILP (suffixes
) ? Fcons (empty_unibyte_string
, Qnil
) : suffixes
;
1401 CONSP (tail
); tail
= XCDR (tail
))
1403 int lsuffix
= SBYTES (XCAR (tail
));
1404 Lisp_Object handler
;
1407 /* Concatenate path element/specified name with the suffix.
1408 If the directory starts with /:, remove that. */
1409 if (SCHARS (filename
) > 2
1410 && SREF (filename
, 0) == '/'
1411 && SREF (filename
, 1) == ':')
1413 strncpy (fn
, SDATA (filename
) + 2,
1414 SBYTES (filename
) - 2);
1415 fn
[SBYTES (filename
) - 2] = 0;
1419 strncpy (fn
, SDATA (filename
),
1421 fn
[SBYTES (filename
)] = 0;
1424 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1425 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1427 /* Check that the file exists and is not a directory. */
1428 /* We used to only check for handlers on non-absolute file names:
1432 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1433 It's not clear why that was the case and it breaks things like
1434 (load "/bar.el") where the file is actually "/bar.el.gz". */
1435 string
= build_string (fn
);
1436 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1437 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1439 if (NILP (predicate
))
1440 exists
= !NILP (Ffile_readable_p (string
));
1442 exists
= !NILP (call1 (predicate
, string
));
1443 if (exists
&& !NILP (Ffile_directory_p (string
)))
1448 /* We succeeded; return this descriptor and filename. */
1459 encoded_fn
= ENCODE_FILE (string
);
1460 pfn
= SDATA (encoded_fn
);
1461 exists
= (stat (pfn
, &st
) >= 0
1462 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1465 /* Check that we can access or open it. */
1466 if (NATNUMP (predicate
))
1467 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1469 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1473 /* We succeeded; return this descriptor and filename. */
1491 /* Merge the list we've accumulated of globals from the current input source
1492 into the load_history variable. The details depend on whether
1493 the source has an associated file name or not.
1495 FILENAME is the file name that we are loading from.
1496 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1499 build_load_history (filename
, entire
)
1500 Lisp_Object filename
;
1503 register Lisp_Object tail
, prev
, newelt
;
1504 register Lisp_Object tem
, tem2
;
1505 register int foundit
= 0;
1507 tail
= Vload_history
;
1510 while (CONSP (tail
))
1514 /* Find the feature's previous assoc list... */
1515 if (!NILP (Fequal (filename
, Fcar (tem
))))
1519 /* If we're loading the entire file, remove old data. */
1523 Vload_history
= XCDR (tail
);
1525 Fsetcdr (prev
, XCDR (tail
));
1528 /* Otherwise, cons on new symbols that are not already members. */
1531 tem2
= Vcurrent_load_list
;
1533 while (CONSP (tem2
))
1535 newelt
= XCAR (tem2
);
1537 if (NILP (Fmember (newelt
, tem
)))
1538 Fsetcar (tail
, Fcons (XCAR (tem
),
1539 Fcons (newelt
, XCDR (tem
))));
1552 /* If we're loading an entire file, cons the new assoc onto the
1553 front of load-history, the most-recently-loaded position. Also
1554 do this if we didn't find an existing member for the file. */
1555 if (entire
|| !foundit
)
1556 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1561 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1569 readevalloop_1 (old
)
1572 load_convert_to_unibyte
= ! NILP (old
);
1576 /* Signal an `end-of-file' error, if possible with file name
1580 end_of_file_error ()
1584 if (STRINGP (Vload_file_name
))
1585 xsignal1 (Qend_of_file
, Vload_file_name
);
1587 xsignal0 (Qend_of_file
);
1590 /* UNIBYTE specifies how to set load_convert_to_unibyte
1591 for this invocation.
1592 READFUN, if non-nil, is used instead of `read'.
1594 START, END specify region to read in current buffer (from eval-region).
1595 If the input is not from a buffer, they must be nil. */
1598 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1599 printflag
, unibyte
, readfun
, start
, end
)
1600 Lisp_Object readcharfun
;
1602 Lisp_Object sourcename
;
1603 Lisp_Object (*evalfun
) ();
1605 Lisp_Object unibyte
, readfun
;
1606 Lisp_Object start
, end
;
1609 register Lisp_Object val
;
1610 int count
= SPECPDL_INDEX ();
1611 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1612 struct buffer
*b
= 0;
1613 int continue_reading_p
;
1614 /* Nonzero if reading an entire buffer. */
1615 int whole_buffer
= 0;
1616 /* 1 on the first time around. */
1619 if (MARKERP (readcharfun
))
1622 start
= readcharfun
;
1625 if (BUFFERP (readcharfun
))
1626 b
= XBUFFER (readcharfun
);
1627 else if (MARKERP (readcharfun
))
1628 b
= XMARKER (readcharfun
)->buffer
;
1630 /* We assume START is nil when input is not from a buffer. */
1631 if (! NILP (start
) && !b
)
1634 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1635 specbind (Qcurrent_load_list
, Qnil
);
1636 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1637 load_convert_to_unibyte
= !NILP (unibyte
);
1639 GCPRO4 (sourcename
, readfun
, start
, end
);
1641 /* Try to ensure sourcename is a truename, except whilst preloading. */
1642 if (NILP (Vpurify_flag
)
1643 && !NILP (sourcename
) && !NILP (Ffile_name_absolute_p (sourcename
))
1644 && !NILP (Ffboundp (Qfile_truename
)))
1645 sourcename
= call1 (Qfile_truename
, sourcename
) ;
1647 LOADHIST_ATTACH (sourcename
);
1649 continue_reading_p
= 1;
1650 while (continue_reading_p
)
1652 int count1
= SPECPDL_INDEX ();
1654 if (b
!= 0 && NILP (b
->name
))
1655 error ("Reading from killed buffer");
1659 /* Switch to the buffer we are reading from. */
1660 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1661 set_buffer_internal (b
);
1663 /* Save point in it. */
1664 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1665 /* Save ZV in it. */
1666 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1667 /* Those get unbound after we read one expression. */
1669 /* Set point and ZV around stuff to be read. */
1672 Fnarrow_to_region (make_number (BEGV
), end
);
1674 /* Just for cleanliness, convert END to a marker
1675 if it is an integer. */
1677 end
= Fpoint_max_marker ();
1680 /* On the first cycle, we can easily test here
1681 whether we are reading the whole buffer. */
1682 if (b
&& first_sexp
)
1683 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1690 while ((c
= READCHAR
) != '\n' && c
!= -1);
1695 unbind_to (count1
, Qnil
);
1699 /* Ignore whitespace here, so we can detect eof. */
1700 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1703 if (!NILP (Vpurify_flag
) && c
== '(')
1705 record_unwind_protect (unreadpure
, Qnil
);
1706 val
= read_list (-1, readcharfun
);
1711 read_objects
= Qnil
;
1712 if (!NILP (readfun
))
1714 val
= call1 (readfun
, readcharfun
);
1716 /* If READCHARFUN has set point to ZV, we should
1717 stop reading, even if the form read sets point
1718 to a different value when evaluated. */
1719 if (BUFFERP (readcharfun
))
1721 struct buffer
*b
= XBUFFER (readcharfun
);
1722 if (BUF_PT (b
) == BUF_ZV (b
))
1723 continue_reading_p
= 0;
1726 else if (! NILP (Vload_read_function
))
1727 val
= call1 (Vload_read_function
, readcharfun
);
1729 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1732 if (!NILP (start
) && continue_reading_p
)
1733 start
= Fpoint_marker ();
1735 /* Restore saved point and BEGV. */
1736 unbind_to (count1
, Qnil
);
1738 /* Now eval what we just read. */
1739 val
= (*evalfun
) (val
);
1743 Vvalues
= Fcons (val
, Vvalues
);
1744 if (EQ (Vstandard_output
, Qt
))
1753 build_load_history (sourcename
,
1754 stream
|| whole_buffer
);
1758 unbind_to (count
, Qnil
);
1761 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1762 doc
: /* Execute the current buffer as Lisp code.
1763 Programs can pass two arguments, BUFFER and PRINTFLAG.
1764 BUFFER is the buffer to evaluate (nil means use current buffer).
1765 PRINTFLAG controls printing of output:
1766 A value of nil means discard it; anything else is stream for print.
1768 If the optional third argument FILENAME is non-nil,
1769 it specifies the file name to use for `load-history'.
1770 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1771 for this invocation.
1773 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1774 `print' and related functions should work normally even if PRINTFLAG is nil.
1776 This function preserves the position of point. */)
1777 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1778 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1780 int count
= SPECPDL_INDEX ();
1781 Lisp_Object tem
, buf
;
1784 buf
= Fcurrent_buffer ();
1786 buf
= Fget_buffer (buffer
);
1788 error ("No such buffer");
1790 if (NILP (printflag
) && NILP (do_allow_print
))
1795 if (NILP (filename
))
1796 filename
= XBUFFER (buf
)->filename
;
1798 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1799 specbind (Qstandard_output
, tem
);
1800 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1801 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1802 readevalloop (buf
, 0, filename
, Feval
,
1803 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1804 unbind_to (count
, Qnil
);
1809 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1810 doc
: /* Execute the region as Lisp code.
1811 When called from programs, expects two arguments,
1812 giving starting and ending indices in the current buffer
1813 of the text to be executed.
1814 Programs can pass third argument PRINTFLAG which controls output:
1815 A value of nil means discard it; anything else is stream for printing it.
1816 Also the fourth argument READ-FUNCTION, if non-nil, is used
1817 instead of `read' to read each expression. It gets one argument
1818 which is the input stream for reading characters.
1820 This function does not move point. */)
1821 (start
, end
, printflag
, read_function
)
1822 Lisp_Object start
, end
, printflag
, read_function
;
1824 int count
= SPECPDL_INDEX ();
1825 Lisp_Object tem
, cbuf
;
1827 cbuf
= Fcurrent_buffer ();
1829 if (NILP (printflag
))
1833 specbind (Qstandard_output
, tem
);
1834 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1836 /* readevalloop calls functions which check the type of start and end. */
1837 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1838 !NILP (printflag
), Qnil
, read_function
,
1841 return unbind_to (count
, Qnil
);
1845 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1846 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1847 If STREAM is nil, use the value of `standard-input' (which see).
1848 STREAM or the value of `standard-input' may be:
1849 a buffer (read from point and advance it)
1850 a marker (read from where it points and advance it)
1851 a function (call it with no arguments for each character,
1852 call it with a char as argument to push a char back)
1853 a string (takes text from string, starting at the beginning)
1854 t (read text line using minibuffer and use it, or read from
1855 standard input in batch mode). */)
1860 stream
= Vstandard_input
;
1861 if (EQ (stream
, Qt
))
1862 stream
= Qread_char
;
1863 if (EQ (stream
, Qread_char
))
1864 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1866 return read_internal_start (stream
, Qnil
, Qnil
);
1869 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1870 doc
: /* Read one Lisp expression which is represented as text by STRING.
1871 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1872 START and END optionally delimit a substring of STRING from which to read;
1873 they default to 0 and (length STRING) respectively. */)
1874 (string
, start
, end
)
1875 Lisp_Object string
, start
, end
;
1878 CHECK_STRING (string
);
1879 /* read_internal_start sets read_from_string_index. */
1880 ret
= read_internal_start (string
, start
, end
);
1881 return Fcons (ret
, make_number (read_from_string_index
));
1884 /* Function to set up the global context we need in toplevel read
1887 read_internal_start (stream
, start
, end
)
1889 Lisp_Object start
; /* Only used when stream is a string. */
1890 Lisp_Object end
; /* Only used when stream is a string. */
1895 new_backquote_flag
= 0;
1896 read_objects
= Qnil
;
1897 if (EQ (Vread_with_symbol_positions
, Qt
)
1898 || EQ (Vread_with_symbol_positions
, stream
))
1899 Vread_symbol_positions_list
= Qnil
;
1901 if (STRINGP (stream
)
1902 || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1904 int startval
, endval
;
1907 if (STRINGP (stream
))
1910 string
= XCAR (stream
);
1913 endval
= SCHARS (string
);
1917 endval
= XINT (end
);
1918 if (endval
< 0 || endval
> SCHARS (string
))
1919 args_out_of_range (string
, end
);
1926 CHECK_NUMBER (start
);
1927 startval
= XINT (start
);
1928 if (startval
< 0 || startval
> endval
)
1929 args_out_of_range (string
, start
);
1931 read_from_string_index
= startval
;
1932 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1933 read_from_string_limit
= endval
;
1936 retval
= read0 (stream
);
1937 if (EQ (Vread_with_symbol_positions
, Qt
)
1938 || EQ (Vread_with_symbol_positions
, stream
))
1939 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1944 /* Signal Qinvalid_read_syntax error.
1945 S is error string of length N (if > 0) */
1948 invalid_syntax (s
, n
)
1954 xsignal1 (Qinvalid_read_syntax
, make_string (s
, n
));
1958 /* Use this for recursive reads, in contexts where internal tokens
1963 Lisp_Object readcharfun
;
1965 register Lisp_Object val
;
1968 val
= read1 (readcharfun
, &c
, 0);
1972 xsignal1 (Qinvalid_read_syntax
,
1973 Fmake_string (make_number (1), make_number (c
)));
1976 static int read_buffer_size
;
1977 static char *read_buffer
;
1979 /* Read a \-escape sequence, assuming we already read the `\'.
1980 If the escape sequence forces unibyte, return eight-bit char. */
1983 read_escape (readcharfun
, stringp
)
1984 Lisp_Object readcharfun
;
1987 register int c
= READCHAR
;
1988 /* \u allows up to four hex digits, \U up to eight. Default to the
1989 behaviour for \u, and change this value in the case that \U is seen. */
1990 int unicode_hex_count
= 4;
1995 end_of_file_error ();
2025 error ("Invalid escape character syntax");
2028 c
= read_escape (readcharfun
, 0);
2029 return c
| meta_modifier
;
2034 error ("Invalid escape character syntax");
2037 c
= read_escape (readcharfun
, 0);
2038 return c
| shift_modifier
;
2043 error ("Invalid escape character syntax");
2046 c
= read_escape (readcharfun
, 0);
2047 return c
| hyper_modifier
;
2052 error ("Invalid escape character syntax");
2055 c
= read_escape (readcharfun
, 0);
2056 return c
| alt_modifier
;
2060 if (stringp
|| c
!= '-')
2067 c
= read_escape (readcharfun
, 0);
2068 return c
| super_modifier
;
2073 error ("Invalid escape character syntax");
2077 c
= read_escape (readcharfun
, 0);
2078 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
2079 return 0177 | (c
& CHAR_MODIFIER_MASK
);
2080 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2081 return c
| ctrl_modifier
;
2082 /* ASCII control chars are made from letters (both cases),
2083 as well as the non-letters within 0100...0137. */
2084 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
2085 return (c
& (037 | ~0177));
2086 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
2087 return (c
& (037 | ~0177));
2089 return c
| ctrl_modifier
;
2099 /* An octal escape, as in ANSI C. */
2101 register int i
= c
- '0';
2102 register int count
= 0;
2105 if ((c
= READCHAR
) >= '0' && c
<= '7')
2117 if (i
>= 0x80 && i
< 0x100)
2118 i
= BYTE8_TO_CHAR (i
);
2123 /* A hex escape, as in ANSI C. */
2130 if (c
>= '0' && c
<= '9')
2135 else if ((c
>= 'a' && c
<= 'f')
2136 || (c
>= 'A' && c
<= 'F'))
2139 if (c
>= 'a' && c
<= 'f')
2152 if (count
< 3 && i
>= 0x80)
2153 return BYTE8_TO_CHAR (i
);
2158 /* Post-Unicode-2.0: Up to eight hex chars. */
2159 unicode_hex_count
= 8;
2162 /* A Unicode escape. We only permit them in strings and characters,
2163 not arbitrarily in the source code, as in some other languages. */
2168 while (++count
<= unicode_hex_count
)
2171 /* isdigit and isalpha may be locale-specific, which we don't
2173 if (c
>= '0' && c
<= '9') i
= (i
<< 4) + (c
- '0');
2174 else if (c
>= 'a' && c
<= 'f') i
= (i
<< 4) + (c
- 'a') + 10;
2175 else if (c
>= 'A' && c
<= 'F') i
= (i
<< 4) + (c
- 'A') + 10;
2178 error ("Non-hex digit used for Unicode escape");
2191 /* Read an integer in radix RADIX using READCHARFUN to read
2192 characters. RADIX must be in the interval [2..36]; if it isn't, a
2193 read error is signaled . Value is the integer read. Signals an
2194 error if encountering invalid read syntax or if RADIX is out of
2198 read_integer (readcharfun
, radix
)
2199 Lisp_Object readcharfun
;
2202 int ndigits
= 0, invalid_p
, c
, sign
= 0;
2203 EMACS_INT number
= 0;
2205 if (radix
< 2 || radix
> 36)
2209 number
= ndigits
= invalid_p
= 0;
2225 if (c
>= '0' && c
<= '9')
2227 else if (c
>= 'a' && c
<= 'z')
2228 digit
= c
- 'a' + 10;
2229 else if (c
>= 'A' && c
<= 'Z')
2230 digit
= c
- 'A' + 10;
2237 if (digit
< 0 || digit
>= radix
)
2240 number
= radix
* number
+ digit
;
2246 if (ndigits
== 0 || invalid_p
)
2249 sprintf (buf
, "integer, radix %d", radix
);
2250 invalid_syntax (buf
, 0);
2253 return make_number (sign
* number
);
2257 /* If the next token is ')' or ']' or '.', we store that character
2258 in *PCH and the return value is not interesting. Else, we store
2259 zero in *PCH and we read and return one lisp object.
2261 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2264 read1 (readcharfun
, pch
, first_in_list
)
2265 register Lisp_Object readcharfun
;
2270 int uninterned_symbol
= 0;
2279 end_of_file_error ();
2284 return read_list (0, readcharfun
);
2287 return read_vector (readcharfun
, 0);
2304 tmp
= read_vector (readcharfun
, 0);
2305 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
)
2306 error ("Invalid size char-table");
2307 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2318 tmp
= read_vector (readcharfun
, 0);
2319 if (!INTEGERP (AREF (tmp
, 0)))
2320 error ("Invalid depth in char-table");
2321 depth
= XINT (AREF (tmp
, 0));
2322 if (depth
< 1 || depth
> 3)
2323 error ("Invalid depth in char-table");
2324 size
= XVECTOR (tmp
)->size
- 2;
2325 if (chartab_size
[depth
] != size
)
2326 error ("Invalid size char-table");
2327 XSETSUB_CHAR_TABLE (tmp
, XSUB_CHAR_TABLE (tmp
));
2330 invalid_syntax ("#^^", 3);
2332 invalid_syntax ("#^", 2);
2337 length
= read1 (readcharfun
, pch
, first_in_list
);
2341 Lisp_Object tmp
, val
;
2343 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2344 / BOOL_VECTOR_BITS_PER_CHAR
);
2347 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2348 if (STRING_MULTIBYTE (tmp
)
2349 || (size_in_chars
!= SCHARS (tmp
)
2350 /* We used to print 1 char too many
2351 when the number of bits was a multiple of 8.
2352 Accept such input in case it came from an old
2354 && ! (XFASTINT (length
)
2355 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
)))
2356 invalid_syntax ("#&...", 5);
2358 val
= Fmake_bool_vector (length
, Qnil
);
2359 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2361 /* Clear the extraneous bits in the last byte. */
2362 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2363 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2364 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2367 invalid_syntax ("#&...", 5);
2371 /* Accept compiled functions at read-time so that we don't have to
2372 build them using function calls. */
2374 tmp
= read_vector (readcharfun
, 1);
2375 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2376 XVECTOR (tmp
)->contents
);
2381 struct gcpro gcpro1
;
2384 /* Read the string itself. */
2385 tmp
= read1 (readcharfun
, &ch
, 0);
2386 if (ch
!= 0 || !STRINGP (tmp
))
2387 invalid_syntax ("#", 1);
2389 /* Read the intervals and their properties. */
2392 Lisp_Object beg
, end
, plist
;
2394 beg
= read1 (readcharfun
, &ch
, 0);
2399 end
= read1 (readcharfun
, &ch
, 0);
2401 plist
= read1 (readcharfun
, &ch
, 0);
2403 invalid_syntax ("Invalid string property list", 0);
2404 Fset_text_properties (beg
, end
, plist
, tmp
);
2410 /* #@NUMBER is used to skip NUMBER following characters.
2411 That's used in .elc files to skip over doc strings
2412 and function definitions. */
2418 /* Read a decimal integer. */
2419 while ((c
= READCHAR
) >= 0
2420 && c
>= '0' && c
<= '9')
2428 if (load_force_doc_strings
2429 && (EQ (readcharfun
, Qget_file_char
)
2430 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2432 /* If we are supposed to force doc strings into core right now,
2433 record the last string that we skipped,
2434 and record where in the file it comes from. */
2436 /* But first exchange saved_doc_string
2437 with prev_saved_doc_string, so we save two strings. */
2439 char *temp
= saved_doc_string
;
2440 int temp_size
= saved_doc_string_size
;
2441 file_offset temp_pos
= saved_doc_string_position
;
2442 int temp_len
= saved_doc_string_length
;
2444 saved_doc_string
= prev_saved_doc_string
;
2445 saved_doc_string_size
= prev_saved_doc_string_size
;
2446 saved_doc_string_position
= prev_saved_doc_string_position
;
2447 saved_doc_string_length
= prev_saved_doc_string_length
;
2449 prev_saved_doc_string
= temp
;
2450 prev_saved_doc_string_size
= temp_size
;
2451 prev_saved_doc_string_position
= temp_pos
;
2452 prev_saved_doc_string_length
= temp_len
;
2455 if (saved_doc_string_size
== 0)
2457 saved_doc_string_size
= nskip
+ 100;
2458 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2460 if (nskip
> saved_doc_string_size
)
2462 saved_doc_string_size
= nskip
+ 100;
2463 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2464 saved_doc_string_size
);
2467 saved_doc_string_position
= file_tell (instream
);
2469 /* Copy that many characters into saved_doc_string. */
2470 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2471 saved_doc_string
[i
] = c
= READCHAR
;
2473 saved_doc_string_length
= i
;
2477 /* Skip that many characters. */
2478 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2487 /* #! appears at the beginning of an executable file.
2488 Skip the first line. */
2489 while (c
!= '\n' && c
>= 0)
2494 return Vload_file_name
;
2496 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2497 /* #:foo is the uninterned symbol named foo. */
2500 uninterned_symbol
= 1;
2504 /* Reader forms that can reuse previously read objects. */
2505 if (c
>= '0' && c
<= '9')
2510 /* Read a non-negative integer. */
2511 while (c
>= '0' && c
<= '9')
2517 /* #n=object returns object, but associates it with n for #n#. */
2520 /* Make a placeholder for #n# to use temporarily */
2521 Lisp_Object placeholder
;
2524 placeholder
= Fcons(Qnil
, Qnil
);
2525 cell
= Fcons (make_number (n
), placeholder
);
2526 read_objects
= Fcons (cell
, read_objects
);
2528 /* Read the object itself. */
2529 tem
= read0 (readcharfun
);
2531 /* Now put it everywhere the placeholder was... */
2532 substitute_object_in_subtree (tem
, placeholder
);
2534 /* ...and #n# will use the real value from now on. */
2535 Fsetcdr (cell
, tem
);
2539 /* #n# returns a previously read object. */
2542 tem
= Fassq (make_number (n
), read_objects
);
2545 /* Fall through to error message. */
2547 else if (c
== 'r' || c
== 'R')
2548 return read_integer (readcharfun
, n
);
2550 /* Fall through to error message. */
2552 else if (c
== 'x' || c
== 'X')
2553 return read_integer (readcharfun
, 16);
2554 else if (c
== 'o' || c
== 'O')
2555 return read_integer (readcharfun
, 8);
2556 else if (c
== 'b' || c
== 'B')
2557 return read_integer (readcharfun
, 2);
2560 invalid_syntax ("#", 1);
2563 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2568 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2578 new_backquote_flag
++;
2579 value
= read0 (readcharfun
);
2580 new_backquote_flag
--;
2582 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2586 if (new_backquote_flag
)
2588 Lisp_Object comma_type
= Qnil
;
2593 comma_type
= Qcomma_at
;
2595 comma_type
= Qcomma_dot
;
2598 if (ch
>= 0) UNREAD (ch
);
2599 comma_type
= Qcomma
;
2602 new_backquote_flag
--;
2603 value
= read0 (readcharfun
);
2604 new_backquote_flag
++;
2605 return Fcons (comma_type
, Fcons (value
, Qnil
));
2618 end_of_file_error ();
2620 /* Accept `single space' syntax like (list ? x) where the
2621 whitespace character is SPC or TAB.
2622 Other literal whitespace like NL, CR, and FF are not accepted,
2623 as there are well-established escape sequences for these. */
2624 if (c
== ' ' || c
== '\t')
2625 return make_number (c
);
2628 c
= read_escape (readcharfun
, 0);
2629 modifiers
= c
& CHAR_MODIFIER_MASK
;
2630 c
&= ~CHAR_MODIFIER_MASK
;
2631 if (CHAR_BYTE8_P (c
))
2632 c
= CHAR_TO_BYTE8 (c
);
2635 next_char
= READCHAR
;
2636 if (next_char
== '.')
2638 /* Only a dotted-pair dot is valid after a char constant. */
2639 int next_next_char
= READCHAR
;
2640 UNREAD (next_next_char
);
2642 ok
= (next_next_char
<= 040
2643 || (next_next_char
< 0200
2644 && (index ("\"';([#?", next_next_char
)
2645 || (!first_in_list
&& next_next_char
== '`')
2646 || (new_backquote_flag
&& next_next_char
== ','))));
2650 ok
= (next_char
<= 040
2651 || (next_char
< 0200
2652 && (index ("\"';()[]#?", next_char
)
2653 || (!first_in_list
&& next_char
== '`')
2654 || (new_backquote_flag
&& next_char
== ','))));
2658 return make_number (c
);
2660 invalid_syntax ("?", 1);
2665 char *p
= read_buffer
;
2666 char *end
= read_buffer
+ read_buffer_size
;
2668 /* Nonzero if we saw an escape sequence specifying
2669 a multibyte character. */
2670 int force_multibyte
= 0;
2671 /* Nonzero if we saw an escape sequence specifying
2672 a single-byte character. */
2673 int force_singlebyte
= 0;
2677 while ((c
= READCHAR
) >= 0
2680 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2682 int offset
= p
- read_buffer
;
2683 read_buffer
= (char *) xrealloc (read_buffer
,
2684 read_buffer_size
*= 2);
2685 p
= read_buffer
+ offset
;
2686 end
= read_buffer
+ read_buffer_size
;
2693 c
= read_escape (readcharfun
, 1);
2695 /* C is -1 if \ newline has just been seen */
2698 if (p
== read_buffer
)
2703 modifiers
= c
& CHAR_MODIFIER_MASK
;
2704 c
= c
& ~CHAR_MODIFIER_MASK
;
2706 if (CHAR_BYTE8_P (c
))
2707 force_singlebyte
= 1;
2708 else if (! ASCII_CHAR_P (c
))
2709 force_multibyte
= 1;
2710 else /* i.e. ASCII_CHAR_P (c) */
2712 /* Allow `\C- ' and `\C-?'. */
2713 if (modifiers
== CHAR_CTL
)
2716 c
= 0, modifiers
= 0;
2718 c
= 127, modifiers
= 0;
2720 if (modifiers
& CHAR_SHIFT
)
2722 /* Shift modifier is valid only with [A-Za-z]. */
2723 if (c
>= 'A' && c
<= 'Z')
2724 modifiers
&= ~CHAR_SHIFT
;
2725 else if (c
>= 'a' && c
<= 'z')
2726 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2729 if (modifiers
& CHAR_META
)
2731 /* Move the meta bit to the right place for a
2733 modifiers
&= ~CHAR_META
;
2734 c
= BYTE8_TO_CHAR (c
| 0x80);
2735 force_singlebyte
= 1;
2739 /* Any modifiers remaining are invalid. */
2741 error ("Invalid modifier in string");
2742 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2746 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2747 if (CHAR_BYTE8_P (c
))
2748 force_singlebyte
= 1;
2749 else if (! ASCII_CHAR_P (c
))
2750 force_multibyte
= 1;
2756 end_of_file_error ();
2758 /* If purifying, and string starts with \ newline,
2759 return zero instead. This is for doc strings
2760 that we are really going to find in etc/DOC.nn.nn */
2761 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2762 return make_number (0);
2764 if (force_multibyte
)
2765 /* READ_BUFFER already contains valid multibyte forms. */
2767 else if (force_singlebyte
)
2769 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2770 p
= read_buffer
+ nchars
;
2773 /* Otherwise, READ_BUFFER contains only ASCII. */
2776 /* We want readchar_count to be the number of characters, not
2777 bytes. Hence we adjust for multibyte characters in the
2778 string. ... But it doesn't seem to be necessary, because
2779 READCHAR *does* read multibyte characters from buffers. */
2780 /* readchar_count -= (p - read_buffer) - nchars; */
2782 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2784 || (p
- read_buffer
!= nchars
)));
2785 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2787 || (p
- read_buffer
!= nchars
)));
2792 int next_char
= READCHAR
;
2795 if (next_char
<= 040
2796 || (next_char
< 0200
2797 && (index ("\"';([#?", next_char
)
2798 || (!first_in_list
&& next_char
== '`')
2799 || (new_backquote_flag
&& next_char
== ','))))
2805 /* Otherwise, we fall through! Note that the atom-reading loop
2806 below will now loop at least once, assuring that we will not
2807 try to UNREAD two characters in a row. */
2811 if (c
<= 040) goto retry
;
2813 char *p
= read_buffer
;
2817 char *end
= read_buffer
+ read_buffer_size
;
2821 || (!index ("\"';()[]#", c
)
2822 && !(!first_in_list
&& c
== '`')
2823 && !(new_backquote_flag
&& c
== ','))))
2825 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2827 int offset
= p
- read_buffer
;
2828 read_buffer
= (char *) xrealloc (read_buffer
,
2829 read_buffer_size
*= 2);
2830 p
= read_buffer
+ offset
;
2831 end
= read_buffer
+ read_buffer_size
;
2838 end_of_file_error ();
2842 p
+= CHAR_STRING (c
, p
);
2848 int offset
= p
- read_buffer
;
2849 read_buffer
= (char *) xrealloc (read_buffer
,
2850 read_buffer_size
*= 2);
2851 p
= read_buffer
+ offset
;
2852 end
= read_buffer
+ read_buffer_size
;
2859 if (!quoted
&& !uninterned_symbol
)
2862 register Lisp_Object val
;
2864 if (*p1
== '+' || *p1
== '-') p1
++;
2865 /* Is it an integer? */
2868 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2869 /* Integers can have trailing decimal points. */
2870 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2872 /* It is an integer. */
2876 /* Fixme: if we have strtol, use that, and check
2878 if (sizeof (int) == sizeof (EMACS_INT
))
2879 XSETINT (val
, atoi (read_buffer
));
2880 else if (sizeof (long) == sizeof (EMACS_INT
))
2881 XSETINT (val
, atol (read_buffer
));
2887 if (isfloat_string (read_buffer
))
2889 /* Compute NaN and infinities using 0.0 in a variable,
2890 to cope with compilers that think they are smarter
2896 /* Negate the value ourselves. This treats 0, NaNs,
2897 and infinity properly on IEEE floating point hosts,
2898 and works around a common bug where atof ("-0.0")
2900 int negative
= read_buffer
[0] == '-';
2902 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2903 returns 1, is if the input ends in e+INF or e+NaN. */
2910 value
= zero
/ zero
;
2912 /* If that made a "negative" NaN, negate it. */
2916 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2919 u_minus_zero
.d
= - 0.0;
2920 for (i
= 0; i
< sizeof (double); i
++)
2921 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2927 /* Now VALUE is a positive NaN. */
2930 value
= atof (read_buffer
+ negative
);
2934 return make_float (negative
? - value
: value
);
2938 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2939 : intern (read_buffer
);
2940 if (EQ (Vread_with_symbol_positions
, Qt
)
2941 || EQ (Vread_with_symbol_positions
, readcharfun
))
2942 Vread_symbol_positions_list
=
2943 /* Kind of a hack; this will probably fail if characters
2944 in the symbol name were escaped. Not really a big
2946 Fcons (Fcons (result
,
2947 make_number (readchar_count
2948 - XFASTINT (Flength (Fsymbol_name (result
))))),
2949 Vread_symbol_positions_list
);
2957 /* List of nodes we've seen during substitute_object_in_subtree. */
2958 static Lisp_Object seen_list
;
2961 substitute_object_in_subtree (object
, placeholder
)
2963 Lisp_Object placeholder
;
2965 Lisp_Object check_object
;
2967 /* We haven't seen any objects when we start. */
2970 /* Make all the substitutions. */
2972 = substitute_object_recurse (object
, placeholder
, object
);
2974 /* Clear seen_list because we're done with it. */
2977 /* The returned object here is expected to always eq the
2979 if (!EQ (check_object
, object
))
2980 error ("Unexpected mutation error in reader");
2983 /* Feval doesn't get called from here, so no gc protection is needed. */
2984 #define SUBSTITUTE(get_val, set_val) \
2986 Lisp_Object old_value = get_val; \
2987 Lisp_Object true_value \
2988 = substitute_object_recurse (object, placeholder,\
2991 if (!EQ (old_value, true_value)) \
2998 substitute_object_recurse (object
, placeholder
, subtree
)
3000 Lisp_Object placeholder
;
3001 Lisp_Object subtree
;
3003 /* If we find the placeholder, return the target object. */
3004 if (EQ (placeholder
, subtree
))
3007 /* If we've been to this node before, don't explore it again. */
3008 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
3011 /* If this node can be the entry point to a cycle, remember that
3012 we've seen it. It can only be such an entry point if it was made
3013 by #n=, which means that we can find it as a value in
3015 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
3016 seen_list
= Fcons (subtree
, seen_list
);
3018 /* Recurse according to subtree's type.
3019 Every branch must return a Lisp_Object. */
3020 switch (XTYPE (subtree
))
3022 case Lisp_Vectorlike
:
3025 int length
= XINT (Flength(subtree
));
3026 for (i
= 0; i
< length
; i
++)
3028 Lisp_Object idx
= make_number (i
);
3029 SUBSTITUTE (Faref (subtree
, idx
),
3030 Faset (subtree
, idx
, true_value
));
3037 SUBSTITUTE (Fcar_safe (subtree
),
3038 Fsetcar (subtree
, true_value
));
3039 SUBSTITUTE (Fcdr_safe (subtree
),
3040 Fsetcdr (subtree
, true_value
));
3046 /* Check for text properties in each interval.
3047 substitute_in_interval contains part of the logic. */
3049 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
3050 Lisp_Object arg
= Fcons (object
, placeholder
);
3052 traverse_intervals_noorder (root_interval
,
3053 &substitute_in_interval
, arg
);
3058 /* Other types don't recurse any further. */
3064 /* Helper function for substitute_object_recurse. */
3066 substitute_in_interval (interval
, arg
)
3070 Lisp_Object object
= Fcar (arg
);
3071 Lisp_Object placeholder
= Fcdr (arg
);
3073 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
3092 if (*cp
== '+' || *cp
== '-')
3095 if (*cp
>= '0' && *cp
<= '9')
3098 while (*cp
>= '0' && *cp
<= '9')
3106 if (*cp
>= '0' && *cp
<= '9')
3109 while (*cp
>= '0' && *cp
<= '9')
3112 if (*cp
== 'e' || *cp
== 'E')
3116 if (*cp
== '+' || *cp
== '-')
3120 if (*cp
>= '0' && *cp
<= '9')
3123 while (*cp
>= '0' && *cp
<= '9')
3126 else if (cp
== start
)
3128 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
3133 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
3139 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
3140 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
3141 || state
== (DOT_CHAR
|TRAIL_INT
)
3142 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
3143 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
3144 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
3149 read_vector (readcharfun
, bytecodeflag
)
3150 Lisp_Object readcharfun
;
3155 register Lisp_Object
*ptr
;
3156 register Lisp_Object tem
, item
, vector
;
3157 register struct Lisp_Cons
*otem
;
3160 tem
= read_list (1, readcharfun
);
3161 len
= Flength (tem
);
3162 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
3164 size
= XVECTOR (vector
)->size
;
3165 ptr
= XVECTOR (vector
)->contents
;
3166 for (i
= 0; i
< size
; i
++)
3169 /* If `load-force-doc-strings' is t when reading a lazily-loaded
3170 bytecode object, the docstring containing the bytecode and
3171 constants values must be treated as unibyte and passed to
3172 Fread, to get the actual bytecode string and constants vector. */
3173 if (bytecodeflag
&& load_force_doc_strings
)
3175 if (i
== COMPILED_BYTECODE
)
3177 if (!STRINGP (item
))
3178 error ("Invalid byte code");
3180 /* Delay handling the bytecode slot until we know whether
3181 it is lazily-loaded (we can tell by whether the
3182 constants slot is nil). */
3183 ptr
[COMPILED_CONSTANTS
] = item
;
3186 else if (i
== COMPILED_CONSTANTS
)
3188 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
3192 /* Coerce string to unibyte (like string-as-unibyte,
3193 but without generating extra garbage and
3194 guaranteeing no change in the contents). */
3195 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
3196 STRING_SET_UNIBYTE (bytestr
);
3198 item
= Fread (Fcons (bytestr
, readcharfun
));
3200 error ("Invalid byte code");
3202 otem
= XCONS (item
);
3203 bytestr
= XCAR (item
);
3208 /* Now handle the bytecode slot. */
3209 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
3211 else if (i
== COMPILED_DOC_STRING
3213 && ! STRING_MULTIBYTE (item
))
3215 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
3216 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
3218 item
= Fstring_as_multibyte (item
);
3221 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
3229 /* FLAG = 1 means check for ] to terminate rather than ) and .
3230 FLAG = -1 means check for starting with defun
3231 and make structure pure. */
3234 read_list (flag
, readcharfun
)
3236 register Lisp_Object readcharfun
;
3238 /* -1 means check next element for defun,
3239 0 means don't check,
3240 1 means already checked and found defun. */
3241 int defunflag
= flag
< 0 ? -1 : 0;
3242 Lisp_Object val
, tail
;
3243 register Lisp_Object elt
, tem
;
3244 struct gcpro gcpro1
, gcpro2
;
3245 /* 0 is the normal case.
3246 1 means this list is a doc reference; replace it with the number 0.
3247 2 means this list is a doc reference; replace it with the doc string. */
3248 int doc_reference
= 0;
3250 /* Initialize this to 1 if we are reading a list. */
3251 int first_in_list
= flag
<= 0;
3260 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3265 /* While building, if the list starts with #$, treat it specially. */
3266 if (EQ (elt
, Vload_file_name
)
3268 && !NILP (Vpurify_flag
))
3270 if (NILP (Vdoc_file_name
))
3271 /* We have not yet called Snarf-documentation, so assume
3272 this file is described in the DOC-MM.NN file
3273 and Snarf-documentation will fill in the right value later.
3274 For now, replace the whole list with 0. */
3277 /* We have already called Snarf-documentation, so make a relative
3278 file name for this file, so it can be found properly
3279 in the installed Lisp directory.
3280 We don't use Fexpand_file_name because that would make
3281 the directory absolute now. */
3282 elt
= concat2 (build_string ("../lisp/"),
3283 Ffile_name_nondirectory (elt
));
3285 else if (EQ (elt
, Vload_file_name
)
3287 && load_force_doc_strings
)
3296 invalid_syntax (") or . in a vector", 18);
3304 XSETCDR (tail
, read0 (readcharfun
));
3306 val
= read0 (readcharfun
);
3307 read1 (readcharfun
, &ch
, 0);
3311 if (doc_reference
== 1)
3312 return make_number (0);
3313 if (doc_reference
== 2)
3315 /* Get a doc string from the file we are loading.
3316 If it's in saved_doc_string, get it from there.
3318 Here, we don't know if the string is a
3319 bytecode string or a doc string. As a
3320 bytecode string must be unibyte, we always
3321 return a unibyte string. If it is actually a
3322 doc string, caller must make it
3325 int pos
= XINT (XCDR (val
));
3326 /* Position is negative for user variables. */
3327 if (pos
< 0) pos
= -pos
;
3328 if (pos
>= saved_doc_string_position
3329 && pos
< (saved_doc_string_position
3330 + saved_doc_string_length
))
3332 int start
= pos
- saved_doc_string_position
;
3335 /* Process quoting with ^A,
3336 and find the end of the string,
3337 which is marked with ^_ (037). */
3338 for (from
= start
, to
= start
;
3339 saved_doc_string
[from
] != 037;)
3341 int c
= saved_doc_string
[from
++];
3344 c
= saved_doc_string
[from
++];
3346 saved_doc_string
[to
++] = c
;
3348 saved_doc_string
[to
++] = 0;
3350 saved_doc_string
[to
++] = 037;
3353 saved_doc_string
[to
++] = c
;
3356 return make_unibyte_string (saved_doc_string
+ start
,
3359 /* Look in prev_saved_doc_string the same way. */
3360 else if (pos
>= prev_saved_doc_string_position
3361 && pos
< (prev_saved_doc_string_position
3362 + prev_saved_doc_string_length
))
3364 int start
= pos
- prev_saved_doc_string_position
;
3367 /* Process quoting with ^A,
3368 and find the end of the string,
3369 which is marked with ^_ (037). */
3370 for (from
= start
, to
= start
;
3371 prev_saved_doc_string
[from
] != 037;)
3373 int c
= prev_saved_doc_string
[from
++];
3376 c
= prev_saved_doc_string
[from
++];
3378 prev_saved_doc_string
[to
++] = c
;
3380 prev_saved_doc_string
[to
++] = 0;
3382 prev_saved_doc_string
[to
++] = 037;
3385 prev_saved_doc_string
[to
++] = c
;
3388 return make_unibyte_string (prev_saved_doc_string
3393 return get_doc_string (val
, 1, 0);
3398 invalid_syntax (". in wrong context", 18);
3400 invalid_syntax ("] in a list", 11);
3402 tem
= (read_pure
&& flag
<= 0
3403 ? pure_cons (elt
, Qnil
)
3404 : Fcons (elt
, Qnil
));
3406 XSETCDR (tail
, tem
);
3411 defunflag
= EQ (elt
, Qdefun
);
3412 else if (defunflag
> 0)
3417 Lisp_Object Vobarray
;
3418 Lisp_Object initial_obarray
;
3420 /* oblookup stores the bucket number here, for the sake of Funintern. */
3422 int oblookup_last_bucket_number
;
3424 static int hash_string ();
3426 /* Get an error if OBARRAY is not an obarray.
3427 If it is one, return it. */
3430 check_obarray (obarray
)
3431 Lisp_Object obarray
;
3433 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3435 /* If Vobarray is now invalid, force it to be valid. */
3436 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3437 wrong_type_argument (Qvectorp
, obarray
);
3442 /* Intern the C string STR: return a symbol with that name,
3443 interned in the current obarray. */
3450 int len
= strlen (str
);
3451 Lisp_Object obarray
;
3454 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3455 obarray
= check_obarray (obarray
);
3456 tem
= oblookup (obarray
, str
, len
, len
);
3459 return Fintern (make_string (str
, len
), obarray
);
3462 /* Create an uninterned symbol with name STR. */
3468 int len
= strlen (str
);
3470 return Fmake_symbol ((!NILP (Vpurify_flag
)
3471 ? make_pure_string (str
, len
, len
, 0)
3472 : make_string (str
, len
)));
3475 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3476 doc
: /* Return the canonical symbol whose name is STRING.
3477 If there is none, one is created by this function and returned.
3478 A second optional argument specifies the obarray to use;
3479 it defaults to the value of `obarray'. */)
3481 Lisp_Object string
, obarray
;
3483 register Lisp_Object tem
, sym
, *ptr
;
3485 if (NILP (obarray
)) obarray
= Vobarray
;
3486 obarray
= check_obarray (obarray
);
3488 CHECK_STRING (string
);
3490 tem
= oblookup (obarray
, SDATA (string
),
3493 if (!INTEGERP (tem
))
3496 if (!NILP (Vpurify_flag
))
3497 string
= Fpurecopy (string
);
3498 sym
= Fmake_symbol (string
);
3500 if (EQ (obarray
, initial_obarray
))
3501 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3503 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3505 if ((SREF (string
, 0) == ':')
3506 && EQ (obarray
, initial_obarray
))
3508 XSYMBOL (sym
)->constant
= 1;
3509 XSYMBOL (sym
)->value
= sym
;
3512 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3514 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3516 XSYMBOL (sym
)->next
= 0;
3521 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3522 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3523 NAME may be a string or a symbol. If it is a symbol, that exact
3524 symbol is searched for.
3525 A second optional argument specifies the obarray to use;
3526 it defaults to the value of `obarray'. */)
3528 Lisp_Object name
, obarray
;
3530 register Lisp_Object tem
, string
;
3532 if (NILP (obarray
)) obarray
= Vobarray
;
3533 obarray
= check_obarray (obarray
);
3535 if (!SYMBOLP (name
))
3537 CHECK_STRING (name
);
3541 string
= SYMBOL_NAME (name
);
3543 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3544 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3550 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3551 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3552 The value is t if a symbol was found and deleted, nil otherwise.
3553 NAME may be a string or a symbol. If it is a symbol, that symbol
3554 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3555 OBARRAY defaults to the value of the variable `obarray'. */)
3557 Lisp_Object name
, obarray
;
3559 register Lisp_Object string
, tem
;
3562 if (NILP (obarray
)) obarray
= Vobarray
;
3563 obarray
= check_obarray (obarray
);
3566 string
= SYMBOL_NAME (name
);
3569 CHECK_STRING (name
);
3573 tem
= oblookup (obarray
, SDATA (string
),
3578 /* If arg was a symbol, don't delete anything but that symbol itself. */
3579 if (SYMBOLP (name
) && !EQ (name
, tem
))
3582 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3583 XSYMBOL (tem
)->constant
= 0;
3584 XSYMBOL (tem
)->indirect_variable
= 0;
3586 hash
= oblookup_last_bucket_number
;
3588 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3590 if (XSYMBOL (tem
)->next
)
3591 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3593 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3597 Lisp_Object tail
, following
;
3599 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3600 XSYMBOL (tail
)->next
;
3603 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3604 if (EQ (following
, tem
))
3606 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3615 /* Return the symbol in OBARRAY whose names matches the string
3616 of SIZE characters (SIZE_BYTE bytes) at PTR.
3617 If there is no such symbol in OBARRAY, return nil.
3619 Also store the bucket number in oblookup_last_bucket_number. */
3622 oblookup (obarray
, ptr
, size
, size_byte
)
3623 Lisp_Object obarray
;
3624 register const char *ptr
;
3625 int size
, size_byte
;
3629 register Lisp_Object tail
;
3630 Lisp_Object bucket
, tem
;
3632 if (!VECTORP (obarray
)
3633 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3635 obarray
= check_obarray (obarray
);
3636 obsize
= XVECTOR (obarray
)->size
;
3638 /* This is sometimes needed in the middle of GC. */
3639 obsize
&= ~ARRAY_MARK_FLAG
;
3640 /* Combining next two lines breaks VMS C 2.3. */
3641 hash
= hash_string (ptr
, size_byte
);
3643 bucket
= XVECTOR (obarray
)->contents
[hash
];
3644 oblookup_last_bucket_number
= hash
;
3645 if (EQ (bucket
, make_number (0)))
3647 else if (!SYMBOLP (bucket
))
3648 error ("Bad data in guts of obarray"); /* Like CADR error message */
3650 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3652 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3653 && SCHARS (SYMBOL_NAME (tail
)) == size
3654 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3656 else if (XSYMBOL (tail
)->next
== 0)
3659 XSETINT (tem
, hash
);
3664 hash_string (ptr
, len
)
3665 const unsigned char *ptr
;
3668 register const unsigned char *p
= ptr
;
3669 register const unsigned char *end
= p
+ len
;
3670 register unsigned char c
;
3671 register int hash
= 0;
3676 if (c
>= 0140) c
-= 40;
3677 hash
= ((hash
<<3) + (hash
>>28) + c
);
3679 return hash
& 07777777777;
3683 map_obarray (obarray
, fn
, arg
)
3684 Lisp_Object obarray
;
3685 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3689 register Lisp_Object tail
;
3690 CHECK_VECTOR (obarray
);
3691 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3693 tail
= XVECTOR (obarray
)->contents
[i
];
3698 if (XSYMBOL (tail
)->next
== 0)
3700 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3706 mapatoms_1 (sym
, function
)
3707 Lisp_Object sym
, function
;
3709 call1 (function
, sym
);
3712 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3713 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3714 OBARRAY defaults to the value of `obarray'. */)
3716 Lisp_Object function
, obarray
;
3718 if (NILP (obarray
)) obarray
= Vobarray
;
3719 obarray
= check_obarray (obarray
);
3721 map_obarray (obarray
, mapatoms_1
, function
);
3725 #define OBARRAY_SIZE 1511
3730 Lisp_Object oblength
;
3734 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3736 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3737 Vobarray
= Fmake_vector (oblength
, make_number (0));
3738 initial_obarray
= Vobarray
;
3739 staticpro (&initial_obarray
);
3740 /* Intern nil in the obarray */
3741 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3742 XSYMBOL (Qnil
)->constant
= 1;
3744 /* These locals are to kludge around a pyramid compiler bug. */
3745 hash
= hash_string ("nil", 3);
3746 /* Separate statement here to avoid VAXC bug. */
3747 hash
%= OBARRAY_SIZE
;
3748 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3751 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3752 XSYMBOL (Qnil
)->function
= Qunbound
;
3753 XSYMBOL (Qunbound
)->value
= Qunbound
;
3754 XSYMBOL (Qunbound
)->function
= Qunbound
;
3757 XSYMBOL (Qnil
)->value
= Qnil
;
3758 XSYMBOL (Qnil
)->plist
= Qnil
;
3759 XSYMBOL (Qt
)->value
= Qt
;
3760 XSYMBOL (Qt
)->constant
= 1;
3762 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3765 Qvariable_documentation
= intern ("variable-documentation");
3766 staticpro (&Qvariable_documentation
);
3768 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3769 read_buffer
= (char *) xmalloc (read_buffer_size
);
3774 struct Lisp_Subr
*sname
;
3777 sym
= intern (sname
->symbol_name
);
3778 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3781 #ifdef NOTDEF /* use fset in subr.el now */
3783 defalias (sname
, string
)
3784 struct Lisp_Subr
*sname
;
3788 sym
= intern (string
);
3789 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3793 /* Define an "integer variable"; a symbol whose value is forwarded
3794 to a C variable of type int. Sample call: */
3795 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3797 defvar_int (namestring
, address
)
3801 Lisp_Object sym
, val
;
3802 sym
= intern (namestring
);
3803 val
= allocate_misc ();
3804 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3805 XINTFWD (val
)->intvar
= address
;
3806 SET_SYMBOL_VALUE (sym
, val
);
3809 /* Similar but define a variable whose value is t if address contains 1,
3810 nil if address contains 0 */
3812 defvar_bool (namestring
, address
)
3816 Lisp_Object sym
, val
;
3817 sym
= intern (namestring
);
3818 val
= allocate_misc ();
3819 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3820 XBOOLFWD (val
)->boolvar
= address
;
3821 SET_SYMBOL_VALUE (sym
, val
);
3822 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3825 /* Similar but define a variable whose value is the Lisp Object stored
3826 at address. Two versions: with and without gc-marking of the C
3827 variable. The nopro version is used when that variable will be
3828 gc-marked for some other reason, since marking the same slot twice
3829 can cause trouble with strings. */
3831 defvar_lisp_nopro (namestring
, address
)
3833 Lisp_Object
*address
;
3835 Lisp_Object sym
, val
;
3836 sym
= intern (namestring
);
3837 val
= allocate_misc ();
3838 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3839 XOBJFWD (val
)->objvar
= address
;
3840 SET_SYMBOL_VALUE (sym
, val
);
3844 defvar_lisp (namestring
, address
)
3846 Lisp_Object
*address
;
3848 defvar_lisp_nopro (namestring
, address
);
3849 staticpro (address
);
3852 /* Similar but define a variable whose value is the Lisp Object stored in
3853 the current buffer. address is the address of the slot in the buffer
3854 that is current now. */
3857 defvar_per_buffer (namestring
, address
, type
, doc
)
3859 Lisp_Object
*address
;
3863 Lisp_Object sym
, val
;
3866 sym
= intern (namestring
);
3867 val
= allocate_misc ();
3868 offset
= (char *)address
- (char *)current_buffer
;
3870 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3871 XBUFFER_OBJFWD (val
)->offset
= offset
;
3872 SET_SYMBOL_VALUE (sym
, val
);
3873 PER_BUFFER_SYMBOL (offset
) = sym
;
3874 PER_BUFFER_TYPE (offset
) = type
;
3876 if (PER_BUFFER_IDX (offset
) == 0)
3877 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3878 slot of buffer_local_flags */
3883 /* Similar but define a variable whose value is the Lisp Object stored
3884 at a particular offset in the current kboard object. */
3887 defvar_kboard (namestring
, offset
)
3891 Lisp_Object sym
, val
;
3892 sym
= intern (namestring
);
3893 val
= allocate_misc ();
3894 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3895 XKBOARD_OBJFWD (val
)->offset
= offset
;
3896 SET_SYMBOL_VALUE (sym
, val
);
3899 /* Record the value of load-path used at the start of dumping
3900 so we can see if the site changed it later during dumping. */
3901 static Lisp_Object dump_path
;
3907 int turn_off_warning
= 0;
3909 /* Compute the default load-path. */
3911 normal
= PATH_LOADSEARCH
;
3912 Vload_path
= decode_env_path (0, normal
);
3914 if (NILP (Vpurify_flag
))
3915 normal
= PATH_LOADSEARCH
;
3917 normal
= PATH_DUMPLOADSEARCH
;
3919 /* In a dumped Emacs, we normally have to reset the value of
3920 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3921 uses ../lisp, instead of the path of the installed elisp
3922 libraries. However, if it appears that Vload_path was changed
3923 from the default before dumping, don't override that value. */
3926 if (! NILP (Fequal (dump_path
, Vload_path
)))
3928 Vload_path
= decode_env_path (0, normal
);
3929 if (!NILP (Vinstallation_directory
))
3931 Lisp_Object tem
, tem1
, sitelisp
;
3933 /* Remove site-lisp dirs from path temporarily and store
3934 them in sitelisp, then conc them on at the end so
3935 they're always first in path. */
3939 tem
= Fcar (Vload_path
);
3940 tem1
= Fstring_match (build_string ("site-lisp"),
3944 Vload_path
= Fcdr (Vload_path
);
3945 sitelisp
= Fcons (tem
, sitelisp
);
3951 /* Add to the path the lisp subdir of the
3952 installation dir, if it exists. */
3953 tem
= Fexpand_file_name (build_string ("lisp"),
3954 Vinstallation_directory
);
3955 tem1
= Ffile_exists_p (tem
);
3958 if (NILP (Fmember (tem
, Vload_path
)))
3960 turn_off_warning
= 1;
3961 Vload_path
= Fcons (tem
, Vload_path
);
3965 /* That dir doesn't exist, so add the build-time
3966 Lisp dirs instead. */
3967 Vload_path
= nconc2 (Vload_path
, dump_path
);
3969 /* Add leim under the installation dir, if it exists. */
3970 tem
= Fexpand_file_name (build_string ("leim"),
3971 Vinstallation_directory
);
3972 tem1
= Ffile_exists_p (tem
);
3975 if (NILP (Fmember (tem
, Vload_path
)))
3976 Vload_path
= Fcons (tem
, Vload_path
);
3979 /* Add site-list under the installation dir, if it exists. */
3980 tem
= Fexpand_file_name (build_string ("site-lisp"),
3981 Vinstallation_directory
);
3982 tem1
= Ffile_exists_p (tem
);
3985 if (NILP (Fmember (tem
, Vload_path
)))
3986 Vload_path
= Fcons (tem
, Vload_path
);
3989 /* If Emacs was not built in the source directory,
3990 and it is run from where it was built, add to load-path
3991 the lisp, leim and site-lisp dirs under that directory. */
3993 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3997 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3998 Vinstallation_directory
);
3999 tem1
= Ffile_exists_p (tem
);
4001 /* Don't be fooled if they moved the entire source tree
4002 AFTER dumping Emacs. If the build directory is indeed
4003 different from the source dir, src/Makefile.in and
4004 src/Makefile will not be found together. */
4005 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
4006 Vinstallation_directory
);
4007 tem2
= Ffile_exists_p (tem
);
4008 if (!NILP (tem1
) && NILP (tem2
))
4010 tem
= Fexpand_file_name (build_string ("lisp"),
4013 if (NILP (Fmember (tem
, Vload_path
)))
4014 Vload_path
= Fcons (tem
, Vload_path
);
4016 tem
= Fexpand_file_name (build_string ("leim"),
4019 if (NILP (Fmember (tem
, Vload_path
)))
4020 Vload_path
= Fcons (tem
, Vload_path
);
4022 tem
= Fexpand_file_name (build_string ("site-lisp"),
4025 if (NILP (Fmember (tem
, Vload_path
)))
4026 Vload_path
= Fcons (tem
, Vload_path
);
4029 if (!NILP (sitelisp
))
4030 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
4036 /* NORMAL refers to the lisp dir in the source directory. */
4037 /* We used to add ../lisp at the front here, but
4038 that caused trouble because it was copied from dump_path
4039 into Vload_path, aboe, when Vinstallation_directory was non-nil.
4040 It should be unnecessary. */
4041 Vload_path
= decode_env_path (0, normal
);
4042 dump_path
= Vload_path
;
4046 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
4047 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4048 almost never correct, thereby causing a warning to be printed out that
4049 confuses users. Since PATH_LOADSEARCH is always overridden by the
4050 EMACSLOADPATH environment variable below, disable the warning on NT.
4051 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
4052 the "standard" paths may not exist and would be overridden by
4053 EMACSLOADPATH as on NT. Since this depends on how the executable
4054 was build and packaged, turn off the warnings in general */
4056 /* Warn if dirs in the *standard* path don't exist. */
4057 if (!turn_off_warning
)
4059 Lisp_Object path_tail
;
4061 for (path_tail
= Vload_path
;
4063 path_tail
= XCDR (path_tail
))
4065 Lisp_Object dirfile
;
4066 dirfile
= Fcar (path_tail
);
4067 if (STRINGP (dirfile
))
4069 dirfile
= Fdirectory_file_name (dirfile
);
4070 if (access (SDATA (dirfile
), 0) < 0)
4071 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4076 #endif /* !(WINDOWSNT || HAVE_CARBON) */
4078 /* If the EMACSLOADPATH environment variable is set, use its value.
4079 This doesn't apply if we're dumping. */
4081 if (NILP (Vpurify_flag
)
4082 && egetenv ("EMACSLOADPATH"))
4084 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
4088 load_in_progress
= 0;
4089 Vload_file_name
= Qnil
;
4091 load_descriptor_list
= Qnil
;
4093 Vstandard_input
= Qt
;
4094 Vloads_in_progress
= Qnil
;
4097 /* Print a warning, using format string FORMAT, that directory DIRNAME
4098 does not exist. Print it on stderr and put it in *Message*. */
4101 dir_warning (format
, dirname
)
4103 Lisp_Object dirname
;
4106 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
4108 fprintf (stderr
, format
, SDATA (dirname
));
4109 sprintf (buffer
, format
, SDATA (dirname
));
4110 /* Don't log the warning before we've initialized!! */
4112 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
4119 defsubr (&Sread_from_string
);
4121 defsubr (&Sintern_soft
);
4122 defsubr (&Sunintern
);
4123 defsubr (&Sget_load_suffixes
);
4125 defsubr (&Seval_buffer
);
4126 defsubr (&Seval_region
);
4127 defsubr (&Sread_char
);
4128 defsubr (&Sread_char_exclusive
);
4129 defsubr (&Sread_event
);
4130 defsubr (&Sget_file_char
);
4131 defsubr (&Smapatoms
);
4132 defsubr (&Slocate_file_internal
);
4134 DEFVAR_LISP ("obarray", &Vobarray
,
4135 doc
: /* Symbol table for use by `intern' and `read'.
4136 It is a vector whose length ought to be prime for best results.
4137 The vector's contents don't make sense if examined from Lisp programs;
4138 to find all the symbols in an obarray, use `mapatoms'. */);
4140 DEFVAR_LISP ("values", &Vvalues
,
4141 doc
: /* List of values of all expressions which were read, evaluated and printed.
4142 Order is reverse chronological. */);
4144 DEFVAR_LISP ("standard-input", &Vstandard_input
,
4145 doc
: /* Stream for read to get input from.
4146 See documentation of `read' for possible values. */);
4147 Vstandard_input
= Qt
;
4149 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
4150 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4152 If this variable is a buffer, then only forms read from that buffer
4153 will be added to `read-symbol-positions-list'.
4154 If this variable is t, then all read forms will be added.
4155 The effect of all other values other than nil are not currently
4156 defined, although they may be in the future.
4158 The positions are relative to the last call to `read' or
4159 `read-from-string'. It is probably a bad idea to set this variable at
4160 the toplevel; bind it instead. */);
4161 Vread_with_symbol_positions
= Qnil
;
4163 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
4164 doc
: /* A list mapping read symbols to their positions.
4165 This variable is modified during calls to `read' or
4166 `read-from-string', but only when `read-with-symbol-positions' is
4169 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4170 CHAR-POSITION is an integer giving the offset of that occurrence of the
4171 symbol from the position where `read' or `read-from-string' started.
4173 Note that a symbol will appear multiple times in this list, if it was
4174 read multiple times. The list is in the same order as the symbols
4176 Vread_symbol_positions_list
= Qnil
;
4178 DEFVAR_LISP ("load-path", &Vload_path
,
4179 doc
: /* *List of directories to search for files to load.
4180 Each element is a string (directory name) or nil (try default directory).
4181 Initialized based on EMACSLOADPATH environment variable, if any,
4182 otherwise to default specified by file `epaths.h' when Emacs was built. */);
4184 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
4185 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
4186 This list should not include the empty string.
4187 `load' and related functions try to append these suffixes, in order,
4188 to the specified file name if a Lisp suffix is allowed or required. */);
4189 Vload_suffixes
= Fcons (build_string (".elc"),
4190 Fcons (build_string (".el"), Qnil
));
4191 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
4192 doc
: /* List of suffixes that indicate representations of \
4194 This list should normally start with the empty string.
4196 Enabling Auto Compression mode appends the suffixes in
4197 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4198 mode removes them again. `load' and related functions use this list to
4199 determine whether they should look for compressed versions of a file
4200 and, if so, which suffixes they should try to append to the file name
4201 in order to do so. However, if you want to customize which suffixes
4202 the loading functions recognize as compression suffixes, you should
4203 customize `jka-compr-load-suffixes' rather than the present variable. */);
4204 Vload_file_rep_suffixes
= Fcons (empty_unibyte_string
, Qnil
);
4206 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
4207 doc
: /* Non-nil iff inside of `load'. */);
4209 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
4210 doc
: /* An alist of expressions to be evalled when particular files are loaded.
4211 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4213 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4214 a symbol \(a feature name).
4216 When `load' is run and the file-name argument matches an element's
4217 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4218 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4220 An error in FORMS does not undo the load, but does prevent execution of
4221 the rest of the FORMS. */);
4222 Vafter_load_alist
= Qnil
;
4224 DEFVAR_LISP ("load-history", &Vload_history
,
4225 doc
: /* Alist mapping file names to symbols and features.
4226 Each alist element is a list that starts with a file name,
4227 except for one element (optional) that starts with nil and describes
4228 definitions evaluated from buffers not visiting files.
4230 The file name is absolute and is the true file name (i.e. it doesn't
4231 contain symbolic links) of the loaded file.
4233 The remaining elements of each list are symbols defined as variables
4234 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
4235 `(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)'
4236 and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry
4237 `(defun . FUNCTION)', and means that SYMBOL was an autoload before
4238 this file redefined it as a function.
4240 During preloading, the file name recorded is relative to the main Lisp
4241 directory. These file names are converted to absolute at startup. */);
4242 Vload_history
= Qnil
;
4244 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
4245 doc
: /* Full name of file being loaded by `load'. */);
4246 Vload_file_name
= Qnil
;
4248 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4249 doc
: /* File name, including directory, of user's initialization file.
4250 If the file loaded had extension `.elc', and the corresponding source file
4251 exists, this variable contains the name of source file, suitable for use
4252 by functions like `custom-save-all' which edit the init file.
4253 While Emacs loads and evaluates the init file, value is the real name
4254 of the file, regardless of whether or not it has the `.elc' extension. */);
4255 Vuser_init_file
= Qnil
;
4257 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4258 doc
: /* Used for internal purposes by `load'. */);
4259 Vcurrent_load_list
= Qnil
;
4261 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4262 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4263 The default is nil, which means use the function `read'. */);
4264 Vload_read_function
= Qnil
;
4266 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4267 doc
: /* Function called in `load' for loading an Emacs Lisp source file.
4268 This function is for doing code conversion before reading the source file.
4269 If nil, loading is done without any code conversion.
4270 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4271 FULLNAME is the full name of FILE.
4272 See `load' for the meaning of the remaining arguments. */);
4273 Vload_source_file_function
= Qnil
;
4275 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4276 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4277 This is useful when the file being loaded is a temporary copy. */);
4278 load_force_doc_strings
= 0;
4280 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4281 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4282 This is normally bound by `load' and `eval-buffer' to control `read',
4283 and is not meant for users to change. */);
4284 load_convert_to_unibyte
= 0;
4286 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4287 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4288 You cannot count on them to still be there! */);
4290 = Fexpand_file_name (build_string ("../"),
4291 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4293 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4294 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4295 Vpreloaded_file_list
= Qnil
;
4297 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4298 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4299 Vbyte_boolean_vars
= Qnil
;
4301 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4302 doc
: /* Non-nil means load dangerous compiled Lisp files.
4303 Some versions of XEmacs use different byte codes than Emacs. These
4304 incompatible byte codes can make Emacs crash when it tries to execute
4306 load_dangerous_libraries
= 0;
4308 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4309 doc
: /* Regular expression matching safe to load compiled Lisp files.
4310 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4311 from the file, and matches them against this regular expression.
4312 When the regular expression matches, the file is considered to be safe
4313 to load. See also `load-dangerous-libraries'. */);
4314 Vbytecomp_version_regexp
4315 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4317 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4318 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4319 Veval_buffer_list
= Qnil
;
4321 /* Vsource_directory was initialized in init_lread. */
4323 load_descriptor_list
= Qnil
;
4324 staticpro (&load_descriptor_list
);
4326 Qcurrent_load_list
= intern ("current-load-list");
4327 staticpro (&Qcurrent_load_list
);
4329 Qstandard_input
= intern ("standard-input");
4330 staticpro (&Qstandard_input
);
4332 Qread_char
= intern ("read-char");
4333 staticpro (&Qread_char
);
4335 Qget_file_char
= intern ("get-file-char");
4336 staticpro (&Qget_file_char
);
4338 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
4339 staticpro (&Qget_emacs_mule_file_char
);
4341 Qload_force_doc_strings
= intern ("load-force-doc-strings");
4342 staticpro (&Qload_force_doc_strings
);
4344 Qbackquote
= intern ("`");
4345 staticpro (&Qbackquote
);
4346 Qcomma
= intern (",");
4347 staticpro (&Qcomma
);
4348 Qcomma_at
= intern (",@");
4349 staticpro (&Qcomma_at
);
4350 Qcomma_dot
= intern (",.");
4351 staticpro (&Qcomma_dot
);
4353 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4354 staticpro (&Qinhibit_file_name_operation
);
4356 Qascii_character
= intern ("ascii-character");
4357 staticpro (&Qascii_character
);
4359 Qfunction
= intern ("function");
4360 staticpro (&Qfunction
);
4362 Qload
= intern ("load");
4365 Qload_file_name
= intern ("load-file-name");
4366 staticpro (&Qload_file_name
);
4368 Qeval_buffer_list
= intern ("eval-buffer-list");
4369 staticpro (&Qeval_buffer_list
);
4371 Qfile_truename
= intern ("file-truename");
4372 staticpro (&Qfile_truename
) ;
4374 Qdo_after_load_evaluation
= intern ("do-after-load-evaluation");
4375 staticpro (&Qdo_after_load_evaluation
) ;
4377 staticpro (&dump_path
);
4379 staticpro (&read_objects
);
4380 read_objects
= Qnil
;
4381 staticpro (&seen_list
);
4384 Vloads_in_progress
= Qnil
;
4385 staticpro (&Vloads_in_progress
);
4388 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4389 (do not change this comment) */