1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 01, 02
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
30 #include "intervals.h"
32 #include "character.h"
38 #include "termhooks.h"
41 #include <sys/inode.h>
46 #include <unistd.h> /* to get X_OK */
63 #endif /* HAVE_SETLOCALE */
70 #define file_offset off_t
71 #define file_tell ftello
73 #define file_offset long
74 #define file_tell ftell
81 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
82 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
83 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
84 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
85 Lisp_Object Qinhibit_file_name_operation
;
87 /* Used instead of Qget_file_char while loading *.elc files compiled
88 by Emacs 21 or older. */
89 static Lisp_Object Qget_emacs_mule_file_char
;
91 static Lisp_Object Qload_force_doc_strings
;
93 extern Lisp_Object Qevent_symbol_element_mask
;
94 extern Lisp_Object Qfile_exists_p
;
96 /* non-zero if inside `load' */
99 /* Directory in which the sources were found. */
100 Lisp_Object Vsource_directory
;
102 /* Search path and suffixes for files to be loaded. */
103 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
105 /* File name of user's init file. */
106 Lisp_Object Vuser_init_file
;
108 /* This is the user-visible association list that maps features to
109 lists of defs in their load files. */
110 Lisp_Object Vload_history
;
112 /* This is used to build the load history. */
113 Lisp_Object Vcurrent_load_list
;
115 /* List of files that were preloaded. */
116 Lisp_Object Vpreloaded_file_list
;
118 /* Name of file actually being read by `load'. */
119 Lisp_Object Vload_file_name
;
121 /* Function to use for reading, in `load' and friends. */
122 Lisp_Object Vload_read_function
;
124 /* The association list of objects read with the #n=object form.
125 Each member of the list has the form (n . object), and is used to
126 look up the object for the corresponding #n# construct.
127 It must be set to nil before all top-level calls to read0. */
128 Lisp_Object read_objects
;
130 /* Nonzero means load should forcibly load all dynamic doc strings. */
131 static int load_force_doc_strings
;
133 /* Nonzero means read should convert strings to unibyte. */
134 static int load_convert_to_unibyte
;
136 /* Nonzero means READCHAR should read bytes one by one (not character)
137 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
138 This is set to 1 by read1 temporarily while handling #@NUMBER. */
139 static int load_each_byte
;
141 /* Function to use for loading an Emacs lisp source file (not
142 compiled) instead of readevalloop. */
143 Lisp_Object Vload_source_file_function
;
145 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
146 Lisp_Object Vbyte_boolean_vars
;
148 /* List of descriptors now open for Fload. */
149 static Lisp_Object load_descriptor_list
;
151 /* File for get_file_char to read from. Use by load. */
152 static FILE *instream
;
154 /* When nonzero, read conses in pure space */
155 static int read_pure
;
157 /* For use within read-from-string (this reader is non-reentrant!!) */
158 static int read_from_string_index
;
159 static int read_from_string_index_byte
;
160 static int read_from_string_limit
;
162 /* This contains the last string skipped with #@. */
163 static char *saved_doc_string
;
164 /* Length of buffer allocated in saved_doc_string. */
165 static int saved_doc_string_size
;
166 /* Length of actual data in saved_doc_string. */
167 static int saved_doc_string_length
;
168 /* This is the file position that string came from. */
169 static file_offset saved_doc_string_position
;
171 /* This contains the previous string skipped with #@.
172 We copy it from saved_doc_string when a new string
173 is put in saved_doc_string. */
174 static char *prev_saved_doc_string
;
175 /* Length of buffer allocated in prev_saved_doc_string. */
176 static int prev_saved_doc_string_size
;
177 /* Length of actual data in prev_saved_doc_string. */
178 static int prev_saved_doc_string_length
;
179 /* This is the file position that string came from. */
180 static file_offset prev_saved_doc_string_position
;
182 /* Nonzero means inside a new-style backquote
183 with no surrounding parentheses.
184 Fread initializes this to zero, so we need not specbind it
185 or worry about what happens to it when there is an error. */
186 static int new_backquote_flag
;
188 /* A list of file names for files being loaded in Fload. Used to
189 check for recursive loads. */
191 static Lisp_Object Vloads_in_progress
;
193 /* Non-zero means load dangerous compiled Lisp files. */
195 int load_dangerous_libraries
;
197 /* A regular expression used to detect files compiled with Emacs. */
199 static Lisp_Object Vbytecomp_version_regexp
;
201 static int read_emacs_mule_char
P_ ((int, int (*) (int, Lisp_Object
),
204 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
205 Lisp_Object (*) (), int,
206 Lisp_Object
, Lisp_Object
));
207 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
208 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
211 /* Functions that read one byte from the current source READCHARFUN
212 or unreads one byte. If the integer argument C is -1, it returns
213 one read byte, or -1 when there's no more byte in the source. If C
214 is 0 or positive, it unreads C, and the return value is not
217 static int readbyte_for_lambda
P_ ((int, Lisp_Object
));
218 static int readbyte_from_file
P_ ((int, Lisp_Object
));
219 static int readbyte_from_string
P_ ((int, Lisp_Object
));
221 /* Handle unreading and rereading of characters.
222 Write READCHAR to read a character,
223 UNREAD(c) to unread c to be read again.
225 These macros correctly read/unread multibyte characters. */
227 #define READCHAR readchar (readcharfun)
228 #define UNREAD(c) unreadchar (readcharfun, c)
230 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
231 Qlambda, or a cons, we use this to keep unread character because a
232 file stream can't handle multibyte-char unreading. The value -1
233 means that there's no unread character. */
234 static int unread_char
;
238 readchar (readcharfun
)
239 Lisp_Object readcharfun
;
243 int (*readbyte
) P_ ((int, Lisp_Object
));
244 unsigned char buf
[MAX_MULTIBYTE_LENGTH
];
246 int emacs_mule_encoding
= 0;
248 if (BUFFERP (readcharfun
))
250 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
252 int pt_byte
= BUF_PT_BYTE (inbuffer
);
254 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
257 if (! NILP (inbuffer
->enable_multibyte_characters
))
259 /* Fetch the character code from the buffer. */
260 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
261 BUF_INC_POS (inbuffer
, pt_byte
);
262 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
266 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
267 if (! ASCII_BYTE_P (c
))
268 c
= BYTE8_TO_CHAR (c
);
271 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
275 if (MARKERP (readcharfun
))
277 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
279 int bytepos
= marker_byte_position (readcharfun
);
281 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
284 if (! NILP (inbuffer
->enable_multibyte_characters
))
286 /* Fetch the character code from the buffer. */
287 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
288 BUF_INC_POS (inbuffer
, bytepos
);
289 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
293 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
294 if (! ASCII_BYTE_P (c
))
295 c
= BYTE8_TO_CHAR (c
);
299 XMARKER (readcharfun
)->bytepos
= bytepos
;
300 XMARKER (readcharfun
)->charpos
++;
305 if (EQ (readcharfun
, Qlambda
))
307 readbyte
= readbyte_for_lambda
;
310 if (EQ (readcharfun
, Qget_file_char
))
312 readbyte
= readbyte_from_file
;
315 if (STRINGP (readcharfun
))
317 if (read_from_string_index
>= read_from_string_limit
)
320 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
321 read_from_string_index
,
322 read_from_string_index_byte
);
326 if (CONSP (readcharfun
))
328 /* This is the case that read_vector is reading from a unibyte
329 string that contains a byte sequence previously skipped
330 because of #@NUMBER. The car part of readcharfun is that
331 string, and the cdr part is a value of readcharfun given to
333 readbyte
= readbyte_from_string
;
334 if (EQ (XCDR (readcharfun
), Qget_emacs_mule_file_char
))
335 emacs_mule_encoding
= 1;
338 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
340 readbyte
= readbyte_from_file
;
341 emacs_mule_encoding
= 1;
345 tem
= call0 (readcharfun
);
352 if (unread_char
>= 0)
358 c
= (*readbyte
) (-1, readcharfun
);
359 if (c
< 0 || ASCII_BYTE_P (c
) || load_each_byte
)
361 if (emacs_mule_encoding
)
362 return read_emacs_mule_char (c
, readbyte
, readcharfun
);
365 len
= BYTES_BY_CHAR_HEAD (c
);
368 c
= (*readbyte
) (-1, readcharfun
);
369 if (c
< 0 || ! TRAILING_CODE_P (c
))
372 (*readbyte
) (buf
[i
], readcharfun
);
373 return BYTE8_TO_CHAR (buf
[0]);
377 return STRING_CHAR (buf
, i
);
381 /* Unread the character C in the way appropriate for the stream READCHARFUN.
382 If the stream is a user function, call it with the char as argument. */
385 unreadchar (readcharfun
, c
)
386 Lisp_Object readcharfun
;
390 /* Don't back up the pointer if we're unreading the end-of-input mark,
391 since readchar didn't advance it when we read it. */
393 else if (BUFFERP (readcharfun
))
395 struct buffer
*b
= XBUFFER (readcharfun
);
396 int bytepos
= BUF_PT_BYTE (b
);
399 if (! NILP (b
->enable_multibyte_characters
))
400 BUF_DEC_POS (b
, bytepos
);
404 BUF_PT_BYTE (b
) = bytepos
;
406 else if (MARKERP (readcharfun
))
408 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
409 int bytepos
= XMARKER (readcharfun
)->bytepos
;
411 XMARKER (readcharfun
)->charpos
--;
412 if (! NILP (b
->enable_multibyte_characters
))
413 BUF_DEC_POS (b
, bytepos
);
417 XMARKER (readcharfun
)->bytepos
= bytepos
;
419 else if (STRINGP (readcharfun
))
421 read_from_string_index
--;
422 read_from_string_index_byte
423 = string_char_to_byte (readcharfun
, read_from_string_index
);
425 else if (CONSP (readcharfun
))
429 else if (EQ (readcharfun
, Qlambda
))
433 else if (EQ (readcharfun
, Qget_file_char
)
434 || EQ (readcharfun
, Qget_emacs_mule_file_char
))
437 ungetc (c
, instream
);
442 call1 (readcharfun
, make_number (c
));
446 readbyte_for_lambda (c
, readcharfun
)
448 Lisp_Object readcharfun
;
450 return read_bytecode_char (c
>= 0);
455 readbyte_from_file (c
, readcharfun
)
457 Lisp_Object readcharfun
;
461 ungetc (c
, instream
);
467 /* Interrupted reads have been observed while reading over the network */
468 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
474 return (c
== EOF
? -1 : c
);
478 readbyte_from_string (c
, readcharfun
)
480 Lisp_Object readcharfun
;
482 Lisp_Object string
= XCAR (readcharfun
);
486 read_from_string_index
--;
487 read_from_string_index_byte
488 = string_char_to_byte (string
, read_from_string_index
);
491 if (read_from_string_index
>= read_from_string_limit
)
494 FETCH_STRING_CHAR_ADVANCE (c
, string
,
495 read_from_string_index
,
496 read_from_string_index_byte
);
501 /* Read one non-ASCII character from INSTREAM. The character is
502 encoded in `emacs-mule' and the first byte is already read in
505 extern char emacs_mule_bytes
[256];
508 read_emacs_mule_char (c
, readbyte
, readcharfun
)
510 int (*readbyte
) P_ ((int, Lisp_Object
));
511 Lisp_Object readcharfun
;
513 /* Emacs-mule coding uses at most 4-byte for one character. */
514 unsigned char buf
[4];
515 int len
= emacs_mule_bytes
[c
];
516 struct charset
*charset
;
521 /* C is not a valid leading-code of `emacs-mule'. */
522 return BYTE8_TO_CHAR (c
);
528 c
= (*readbyte
) (-1, readcharfun
);
532 (*readbyte
) (buf
[i
], readcharfun
);
533 return BYTE8_TO_CHAR (buf
[0]);
540 charset
= emacs_mule_charset
[buf
[0]];
541 code
= buf
[1] & 0x7F;
545 if (buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
546 || buf
[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12
)
548 charset
= emacs_mule_charset
[buf
[1]];
549 code
= buf
[2] & 0x7F;
553 charset
= emacs_mule_charset
[buf
[0]];
554 code
= ((buf
[1] << 8) | buf
[2]) & 0x7F7F;
559 charset
= emacs_mule_charset
[buf
[1]];
560 code
= ((buf
[2] << 8) | buf
[3]) & 0x7F7F;
562 c
= DECODE_CHAR (charset
, code
);
564 Fsignal (Qinvalid_read_syntax
,
565 Fcons (build_string ("invalid multibyte form"), Qnil
));
570 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
571 static Lisp_Object
substitute_object_recurse ();
572 static void substitute_object_in_subtree (), substitute_in_interval ();
575 /* Get a character from the tty. */
577 extern Lisp_Object
read_char ();
579 /* Read input events until we get one that's acceptable for our purposes.
581 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
582 until we get a character we like, and then stuffed into
585 If ASCII_REQUIRED is non-zero, we check function key events to see
586 if the unmodified version of the symbol has a Qascii_character
587 property, and use that character, if present.
589 If ERROR_NONASCII is non-zero, we signal an error if the input we
590 get isn't an ASCII character with modifiers. If it's zero but
591 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
594 If INPUT_METHOD is nonzero, we invoke the current input method
595 if the character warrants that. */
598 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
600 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
602 register Lisp_Object val
, delayed_switch_frame
;
604 #ifdef HAVE_WINDOW_SYSTEM
605 if (display_hourglass_p
)
609 delayed_switch_frame
= Qnil
;
611 /* Read until we get an acceptable event. */
613 val
= read_char (0, 0, 0,
614 (input_method
? Qnil
: Qt
),
620 /* switch-frame events are put off until after the next ASCII
621 character. This is better than signaling an error just because
622 the last characters were typed to a separate minibuffer frame,
623 for example. Eventually, some code which can deal with
624 switch-frame events will read it and process it. */
626 && EVENT_HAS_PARAMETERS (val
)
627 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
629 delayed_switch_frame
= val
;
635 /* Convert certain symbols to their ASCII equivalents. */
638 Lisp_Object tem
, tem1
;
639 tem
= Fget (val
, Qevent_symbol_element_mask
);
642 tem1
= Fget (Fcar (tem
), Qascii_character
);
643 /* Merge this symbol's modifier bits
644 with the ASCII equivalent of its basic code. */
646 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
650 /* If we don't have a character now, deal with it appropriately. */
655 Vunread_command_events
= Fcons (val
, Qnil
);
656 error ("Non-character input-event");
663 if (! NILP (delayed_switch_frame
))
664 unread_switch_frame
= delayed_switch_frame
;
666 #ifdef HAVE_WINDOW_SYSTEM
667 if (display_hourglass_p
)
673 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
674 doc
: /* Read a character from the command input (keyboard or macro).
675 It is returned as a number.
676 If the user generates an event which is not a character (i.e. a mouse
677 click or function key event), `read-char' signals an error. As an
678 exception, switch-frame events are put off until non-ASCII events can
680 If you want to read non-character events, or ignore them, call
681 `read-event' or `read-char-exclusive' instead.
683 If the optional argument PROMPT is non-nil, display that as a prompt.
684 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
685 input method is turned on in the current buffer, that input method
686 is used for reading a character. */)
687 (prompt
, inherit_input_method
)
688 Lisp_Object prompt
, inherit_input_method
;
691 message_with_string ("%s", prompt
, 0);
692 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
695 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
696 doc
: /* Read an event object from the input stream.
697 If the optional argument PROMPT is non-nil, display that as a prompt.
698 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
699 input method is turned on in the current buffer, that input method
700 is used for reading a character. */)
701 (prompt
, inherit_input_method
)
702 Lisp_Object prompt
, inherit_input_method
;
705 message_with_string ("%s", prompt
, 0);
706 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
709 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
710 doc
: /* Read a character from the command input (keyboard or macro).
711 It is returned as a number. Non-character events are ignored.
713 If the optional argument PROMPT is non-nil, display that as a prompt.
714 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
715 input method is turned on in the current buffer, that input method
716 is used for reading a character. */)
717 (prompt
, inherit_input_method
)
718 Lisp_Object prompt
, inherit_input_method
;
721 message_with_string ("%s", prompt
, 0);
722 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
725 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
726 doc
: /* Don't use this yourself. */)
729 register Lisp_Object val
;
730 XSETINT (val
, getc (instream
));
736 /* Value is a version number of byte compiled code if the file
737 associated with file descriptor FD is a compiled Lisp file that's
738 safe to load. Only files compiled with Emacs are safe to load.
739 Files compiled with XEmacs can lead to a crash in Fbyte_code
740 because of an incompatible change in the byte compiler. */
748 int safe_p
= 1, version
= 0;
750 /* Read the first few bytes from the file, and look for a line
751 specifying the byte compiler version used. */
752 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
757 /* Skip to the next newline, skipping over the initial `ELC'
758 with NUL bytes following it, but note the version. */
759 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
764 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
771 lseek (fd
, 0, SEEK_SET
);
776 /* Callback for record_unwind_protect. Restore the old load list OLD,
777 after loading a file successfully. */
780 record_load_unwind (old
)
783 return Vloads_in_progress
= old
;
787 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
788 doc
: /* Execute a file of Lisp code named FILE.
789 First try FILE with `.elc' appended, then try with `.el',
790 then try FILE unmodified. Environment variable references in FILE
791 are replaced with their values by calling `substitute-in-file-name'.
792 This function searches the directories in `load-path'.
793 If optional second arg NOERROR is non-nil,
794 report no error if FILE doesn't exist.
795 Print messages at start and end of loading unless
796 optional third arg NOMESSAGE is non-nil.
797 If optional fourth arg NOSUFFIX is non-nil, don't try adding
798 suffixes `.elc' or `.el' to the specified name FILE.
799 If optional fifth arg MUST-SUFFIX is non-nil, insist on
800 the suffix `.elc' or `.el'; don't accept just FILE unless
801 it ends in one of those suffixes or includes a directory name.
802 Return t if file exists. */)
803 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
804 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
806 register FILE *stream
;
807 register int fd
= -1;
808 register Lisp_Object lispstream
;
809 int count
= specpdl_ptr
- specpdl
;
813 /* 1 means we printed the ".el is newer" message. */
815 /* 1 means we are loading a compiled file. */
828 /* If file name is magic, call the handler. */
829 /* This shouldn't be necessary any more now that `openp' handles it right.
830 handler = Ffind_file_name_handler (file, Qload);
832 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
834 /* Do this after the handler to avoid
835 the need to gcpro noerror, nomessage and nosuffix.
836 (Below here, we care only whether they are nil or not.)
837 The presence of this call is the result of a historical accident:
838 it used to be in every file-operations and when it got removed
839 everywhere, it accidentally stayed here. Since then, enough people
840 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
841 that it seemed risky to remove. */
842 file
= Fsubstitute_in_file_name (file
);
844 /* Avoid weird lossage with null string as arg,
845 since it would try to load a directory as a Lisp file */
846 if (XSTRING (file
)->size
> 0)
848 int size
= STRING_BYTES (XSTRING (file
));
853 if (! NILP (must_suffix
))
855 /* Don't insist on adding a suffix if FILE already ends with one. */
857 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
860 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
862 /* Don't insist on adding a suffix
863 if the argument includes a directory name. */
864 else if (! NILP (Ffile_name_directory (file
)))
868 fd
= openp (Vload_path
, file
,
869 (!NILP (nosuffix
) ? Qnil
870 : !NILP (must_suffix
) ? Vload_suffixes
871 : Fappend (2, (tmp
[0] = Vload_suffixes
,
872 tmp
[1] = default_suffixes
,
882 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
883 Fcons (file
, Qnil
)));
888 /* Tell startup.el whether or not we found the user's init file. */
889 if (EQ (Qt
, Vuser_init_file
))
890 Vuser_init_file
= found
;
892 /* If FD is -2, that means openp found a magic file. */
895 if (NILP (Fequal (found
, file
)))
896 /* If FOUND is a different file name from FILE,
897 find its handler even if we have already inhibited
898 the `load' operation on FILE. */
899 handler
= Ffind_file_name_handler (found
, Qt
);
901 handler
= Ffind_file_name_handler (found
, Qload
);
902 if (! NILP (handler
))
903 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
906 /* Check if we're stuck in a recursive load cycle.
908 2000-09-21: It's not possible to just check for the file loaded
909 being a member of Vloads_in_progress. This fails because of the
910 way the byte compiler currently works; `provide's are not
911 evaluted, see font-lock.el/jit-lock.el as an example. This
912 leads to a certain amount of ``normal'' recursion.
914 Also, just loading a file recursively is not always an error in
915 the general case; the second load may do something different. */
919 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
920 if (!NILP (Fequal (found
, XCAR (tem
))))
923 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
924 Fcons (found
, Vloads_in_progress
)));
925 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
926 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
930 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
932 || (version
= safe_to_load_p (fd
)) > 0)
933 /* Load .elc files directly, but not when they are
934 remote and have no handler! */
942 && ! (version
= safe_to_load_p (fd
)))
945 if (!load_dangerous_libraries
)
948 error ("File `%s' was not compiled in Emacs",
949 XSTRING (found
)->data
);
951 else if (!NILP (nomessage
))
952 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
960 stat ((char *)XSTRING (found
)->data
, &s1
);
961 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
962 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
963 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
965 /* Make the progress messages mention that source is newer. */
968 /* If we won't print another message, mention this anyway. */
969 if (! NILP (nomessage
))
970 message_with_string ("Source file `%s' newer than byte-compiled file",
973 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
978 /* We are loading a source file (*.el). */
979 if (!NILP (Vload_source_file_function
))
985 val
= call4 (Vload_source_file_function
, found
, file
,
986 NILP (noerror
) ? Qnil
: Qt
,
987 NILP (nomessage
) ? Qnil
: Qt
);
988 return unbind_to (count
, val
);
994 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
995 #else /* not WINDOWSNT */
996 stream
= fdopen (fd
, fmode
);
997 #endif /* not WINDOWSNT */
1001 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
1004 if (! NILP (Vpurify_flag
))
1005 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
1007 if (NILP (nomessage
))
1010 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1013 message_with_string ("Loading %s (source)...", file
, 1);
1015 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1017 else /* The typical case; compiled file newer than source file. */
1018 message_with_string ("Loading %s...", file
, 1);
1022 lispstream
= Fcons (Qnil
, Qnil
);
1023 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
1024 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
1025 record_unwind_protect (load_unwind
, lispstream
);
1026 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
1027 specbind (Qload_file_name
, found
);
1028 specbind (Qinhibit_file_name_operation
, Qnil
);
1029 load_descriptor_list
1030 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
1032 if (! version
|| version
>= 22)
1033 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
1036 /* We can't handle a file which was compiled with
1037 byte-compile-dynamic by older version of Emacs. */
1038 specbind (Qload_force_doc_strings
, Qt
);
1039 readevalloop (Qget_emacs_mule_file_char
, stream
, file
, Feval
, 0,
1042 unbind_to (count
, Qnil
);
1044 /* Run any load-hooks for this file. */
1045 temp
= Fassoc (file
, Vafter_load_alist
);
1047 Fprogn (Fcdr (temp
));
1050 if (saved_doc_string
)
1051 free (saved_doc_string
);
1052 saved_doc_string
= 0;
1053 saved_doc_string_size
= 0;
1055 if (prev_saved_doc_string
)
1056 xfree (prev_saved_doc_string
);
1057 prev_saved_doc_string
= 0;
1058 prev_saved_doc_string_size
= 0;
1060 if (!noninteractive
&& NILP (nomessage
))
1063 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1066 message_with_string ("Loading %s (source)...done", file
, 1);
1068 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1070 else /* The typical case; compiled file newer than source file. */
1071 message_with_string ("Loading %s...done", file
, 1);
1078 load_unwind (stream
) /* used as unwind-protect function in load */
1081 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
1082 | XFASTINT (XCDR (stream
))));
1083 if (--load_in_progress
< 0) load_in_progress
= 0;
1088 load_descriptor_unwind (oldlist
)
1089 Lisp_Object oldlist
;
1091 load_descriptor_list
= oldlist
;
1095 /* Close all descriptors in use for Floads.
1096 This is used when starting a subprocess. */
1103 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1104 emacs_close (XFASTINT (XCAR (tail
)));
1109 complete_filename_p (pathname
)
1110 Lisp_Object pathname
;
1112 register unsigned char *s
= XSTRING (pathname
)->data
;
1113 return (IS_DIRECTORY_SEP (s
[0])
1114 || (XSTRING (pathname
)->size
> 2
1115 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1125 /* Search for a file whose name is STR, looking in directories
1126 in the Lisp list PATH, and trying suffixes from SUFFIX.
1127 On success, returns a file descriptor. On failure, returns -1.
1129 SUFFIXES is a list of strings containing possible suffixes.
1130 The empty suffix is automatically added iff the list is empty.
1132 EXEC_ONLY nonzero means don't open the files,
1133 just look for one that is executable. In this case,
1134 returns 1 on success.
1136 If STOREPTR is nonzero, it points to a slot where the name of
1137 the file actually found should be stored as a Lisp string.
1138 nil is stored there on failure.
1140 If the file we find is remote, return -2
1141 but store the found remote file name in *STOREPTR.
1142 We do not check for remote files if EXEC_ONLY is nonzero. */
1145 openp (path
, str
, suffixes
, storeptr
, exec_only
)
1146 Lisp_Object path
, str
;
1147 Lisp_Object suffixes
;
1148 Lisp_Object
*storeptr
;
1154 register char *fn
= buf
;
1157 Lisp_Object filename
;
1159 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
1160 Lisp_Object string
, tail
;
1161 int max_suffix_len
= 0;
1163 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1165 CHECK_STRING_CAR (tail
);
1166 max_suffix_len
= max (max_suffix_len
,
1167 STRING_BYTES (XSTRING (XCAR (tail
))));
1170 string
= filename
= Qnil
;
1171 GCPRO5 (str
, string
, filename
, path
, suffixes
);
1176 if (complete_filename_p (str
))
1179 for (; CONSP (path
); path
= XCDR (path
))
1181 filename
= Fexpand_file_name (str
, XCAR (path
));
1182 if (!complete_filename_p (filename
))
1183 /* If there are non-absolute elts in PATH (eg ".") */
1184 /* Of course, this could conceivably lose if luser sets
1185 default-directory to be something non-absolute... */
1187 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1188 if (!complete_filename_p (filename
))
1189 /* Give up on this path element! */
1193 /* Calculate maximum size of any filename made from
1194 this path element/specified file name and any possible suffix. */
1195 want_size
= max_suffix_len
+ STRING_BYTES (XSTRING (filename
)) + 1;
1196 if (fn_size
< want_size
)
1197 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1199 /* Loop over suffixes. */
1200 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1201 CONSP (tail
); tail
= XCDR (tail
))
1203 int lsuffix
= STRING_BYTES (XSTRING (XCAR (tail
)));
1204 Lisp_Object handler
;
1206 /* Concatenate path element/specified name with the suffix.
1207 If the directory starts with /:, remove that. */
1208 if (XSTRING (filename
)->size
> 2
1209 && XSTRING (filename
)->data
[0] == '/'
1210 && XSTRING (filename
)->data
[1] == ':')
1212 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1213 STRING_BYTES (XSTRING (filename
)) - 2);
1214 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1218 strncpy (fn
, XSTRING (filename
)->data
,
1219 STRING_BYTES (XSTRING (filename
)));
1220 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1223 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1224 strncat (fn
, XSTRING (XCAR (tail
))->data
, lsuffix
);
1226 /* Check that the file exists and is not a directory. */
1227 /* We used to only check for handlers on non-absolute file names:
1231 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1232 It's not clear why that was the case and it breaks things like
1233 (load "/bar.el") where the file is actually "/bar.el.gz". */
1234 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1235 if (!NILP (handler
) && !exec_only
)
1239 string
= build_string (fn
);
1240 exists
= !NILP (Ffile_readable_p (string
));
1241 if (exists
&& !NILP (Ffile_directory_p (build_string (fn
))))
1246 /* We succeeded; return this descriptor and filename. */
1248 *storeptr
= build_string (fn
);
1255 int exists
= (stat (fn
, &st
) >= 0
1256 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1259 /* Check that we can access or open it. */
1261 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1263 fd
= emacs_open (fn
, O_RDONLY
, 0);
1267 /* We succeeded; return this descriptor and filename. */
1269 *storeptr
= build_string (fn
);
1285 /* Merge the list we've accumulated of globals from the current input source
1286 into the load_history variable. The details depend on whether
1287 the source has an associated file name or not. */
1290 build_load_history (stream
, source
)
1294 register Lisp_Object tail
, prev
, newelt
;
1295 register Lisp_Object tem
, tem2
;
1296 register int foundit
, loading
;
1298 loading
= stream
|| !NARROWED
;
1300 tail
= Vload_history
;
1303 while (!NILP (tail
))
1307 /* Find the feature's previous assoc list... */
1308 if (!NILP (Fequal (source
, Fcar (tem
))))
1312 /* If we're loading, remove it. */
1316 Vload_history
= Fcdr (tail
);
1318 Fsetcdr (prev
, Fcdr (tail
));
1321 /* Otherwise, cons on new symbols that are not already members. */
1324 tem2
= Vcurrent_load_list
;
1326 while (CONSP (tem2
))
1328 newelt
= Fcar (tem2
);
1330 if (NILP (Fmemq (newelt
, tem
)))
1331 Fsetcar (tail
, Fcons (Fcar (tem
),
1332 Fcons (newelt
, Fcdr (tem
))));
1345 /* If we're loading, cons the new assoc onto the front of load-history,
1346 the most-recently-loaded position. Also do this if we didn't find
1347 an existing member for the current source. */
1348 if (loading
|| !foundit
)
1349 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1354 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1362 readevalloop_1 (old
)
1365 load_convert_to_unibyte
= ! NILP (old
);
1369 /* Signal an `end-of-file' error, if possible with file name
1373 end_of_file_error ()
1377 if (STRINGP (Vload_file_name
))
1378 data
= Fcons (Vload_file_name
, Qnil
);
1382 Fsignal (Qend_of_file
, data
);
1385 /* UNIBYTE specifies how to set load_convert_to_unibyte
1386 for this invocation.
1387 READFUN, if non-nil, is used instead of `read'. */
1390 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1391 Lisp_Object readcharfun
;
1393 Lisp_Object sourcename
;
1394 Lisp_Object (*evalfun
) ();
1396 Lisp_Object unibyte
, readfun
;
1399 register Lisp_Object val
;
1400 int count
= specpdl_ptr
- specpdl
;
1401 struct gcpro gcpro1
;
1402 struct buffer
*b
= 0;
1403 int continue_reading_p
;
1405 if (BUFFERP (readcharfun
))
1406 b
= XBUFFER (readcharfun
);
1407 else if (MARKERP (readcharfun
))
1408 b
= XMARKER (readcharfun
)->buffer
;
1410 specbind (Qstandard_input
, readcharfun
);
1411 specbind (Qcurrent_load_list
, Qnil
);
1412 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1413 load_convert_to_unibyte
= !NILP (unibyte
);
1415 GCPRO1 (sourcename
);
1417 LOADHIST_ATTACH (sourcename
);
1419 continue_reading_p
= 1;
1420 while (continue_reading_p
)
1422 if (b
!= 0 && NILP (b
->name
))
1423 error ("Reading from killed buffer");
1429 while ((c
= READCHAR
) != '\n' && c
!= -1);
1434 /* Ignore whitespace here, so we can detect eof. */
1435 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1438 if (!NILP (Vpurify_flag
) && c
== '(')
1440 int count1
= specpdl_ptr
- specpdl
;
1441 record_unwind_protect (unreadpure
, Qnil
);
1442 val
= read_list (-1, readcharfun
);
1443 unbind_to (count1
, Qnil
);
1448 read_objects
= Qnil
;
1449 if (!NILP (readfun
))
1451 val
= call1 (readfun
, readcharfun
);
1453 /* If READCHARFUN has set point to ZV, we should
1454 stop reading, even if the form read sets point
1455 to a different value when evaluated. */
1456 if (BUFFERP (readcharfun
))
1458 struct buffer
*b
= XBUFFER (readcharfun
);
1459 if (BUF_PT (b
) == BUF_ZV (b
))
1460 continue_reading_p
= 0;
1463 else if (! NILP (Vload_read_function
))
1464 val
= call1 (Vload_read_function
, readcharfun
);
1466 val
= read0 (readcharfun
);
1469 val
= (*evalfun
) (val
);
1473 Vvalues
= Fcons (val
, Vvalues
);
1474 if (EQ (Vstandard_output
, Qt
))
1481 build_load_history (stream
, sourcename
);
1484 unbind_to (count
, Qnil
);
1487 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1488 doc
: /* Execute the current buffer as Lisp code.
1489 Programs can pass two arguments, BUFFER and PRINTFLAG.
1490 BUFFER is the buffer to evaluate (nil means use current buffer).
1491 PRINTFLAG controls printing of output:
1492 nil means discard it; anything else is stream for print.
1494 If the optional third argument FILENAME is non-nil,
1495 it specifies the file name to use for `load-history'.
1496 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1497 for this invocation.
1499 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1500 `print' and related functions should work normally even if PRINTFLAG is nil.
1502 This function preserves the position of point. */)
1503 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1504 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1506 int count
= specpdl_ptr
- specpdl
;
1507 Lisp_Object tem
, buf
;
1510 buf
= Fcurrent_buffer ();
1512 buf
= Fget_buffer (buffer
);
1514 error ("No such buffer");
1516 if (NILP (printflag
) && NILP (do_allow_print
))
1521 if (NILP (filename
))
1522 filename
= XBUFFER (buf
)->filename
;
1524 specbind (Qstandard_output
, tem
);
1525 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1526 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1527 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1528 unbind_to (count
, Qnil
);
1533 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1534 doc
: /* Execute the region as Lisp code.
1535 When called from programs, expects two arguments,
1536 giving starting and ending indices in the current buffer
1537 of the text to be executed.
1538 Programs can pass third argument PRINTFLAG which controls output:
1539 nil means discard it; anything else is stream for printing it.
1540 Also the fourth argument READ-FUNCTION, if non-nil, is used
1541 instead of `read' to read each expression. It gets one argument
1542 which is the input stream for reading characters.
1544 This function does not move point. */)
1545 (start
, end
, printflag
, read_function
)
1546 Lisp_Object start
, end
, printflag
, read_function
;
1548 int count
= specpdl_ptr
- specpdl
;
1549 Lisp_Object tem
, cbuf
;
1551 cbuf
= Fcurrent_buffer ();
1553 if (NILP (printflag
))
1557 specbind (Qstandard_output
, tem
);
1559 if (NILP (printflag
))
1560 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1561 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1563 /* This both uses start and checks its type. */
1565 Fnarrow_to_region (make_number (BEGV
), end
);
1566 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1567 !NILP (printflag
), Qnil
, read_function
);
1569 return unbind_to (count
, Qnil
);
1573 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1574 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1575 If STREAM is nil, use the value of `standard-input' (which see).
1576 STREAM or the value of `standard-input' may be:
1577 a buffer (read from point and advance it)
1578 a marker (read from where it points and advance it)
1579 a function (call it with no arguments for each character,
1580 call it with a char as argument to push a char back)
1581 a string (takes text from string, starting at the beginning)
1582 t (read text line using minibuffer and use it, or read from
1583 standard input in batch mode). */)
1587 extern Lisp_Object
Fread_minibuffer ();
1590 stream
= Vstandard_input
;
1591 if (EQ (stream
, Qt
))
1592 stream
= Qread_char
;
1594 new_backquote_flag
= 0;
1595 read_objects
= Qnil
;
1597 if (EQ (stream
, Qread_char
))
1598 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1600 if (STRINGP (stream
) || ((CONSP (stream
) && STRINGP (XCAR (stream
)))))
1601 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1603 return read0 (stream
);
1606 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1607 doc
: /* Read one Lisp expression which is represented as text by STRING.
1608 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1609 START and END optionally delimit a substring of STRING from which to read;
1610 they default to 0 and (length STRING) respectively. */)
1611 (string
, start
, end
)
1612 Lisp_Object string
, start
, end
;
1614 int startval
, endval
;
1619 str
= XCAR (string
);
1625 endval
= XSTRING (str
)->size
;
1629 endval
= XINT (end
);
1630 if (endval
< 0 || endval
> XSTRING (str
)->size
)
1631 args_out_of_range (str
, end
);
1638 CHECK_NUMBER (start
);
1639 startval
= XINT (start
);
1640 if (startval
< 0 || startval
> endval
)
1641 args_out_of_range (str
, start
);
1644 read_from_string_index
= startval
;
1645 read_from_string_index_byte
= string_char_to_byte (str
, startval
);
1646 read_from_string_limit
= endval
;
1648 new_backquote_flag
= 0;
1649 read_objects
= Qnil
;
1651 tem
= read0 (string
);
1652 return Fcons (tem
, make_number (read_from_string_index
));
1655 /* Use this for recursive reads, in contexts where internal tokens
1660 Lisp_Object readcharfun
;
1662 register Lisp_Object val
;
1665 val
= read1 (readcharfun
, &c
, 0);
1667 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1674 static int read_buffer_size
;
1675 static char *read_buffer
;
1677 /* Read a \-escape sequence, assuming we already read the `\'.
1678 If the escape sequence forces unibyte, return eight-bit-char. */
1681 read_escape (readcharfun
, stringp
)
1682 Lisp_Object readcharfun
;
1685 register int c
= READCHAR
;
1690 end_of_file_error ();
1720 error ("Invalid escape character syntax");
1723 c
= read_escape (readcharfun
, 0);
1724 return c
| meta_modifier
;
1729 error ("Invalid escape character syntax");
1732 c
= read_escape (readcharfun
, 0);
1733 return c
| shift_modifier
;
1738 error ("Invalid escape character syntax");
1741 c
= read_escape (readcharfun
, 0);
1742 return c
| hyper_modifier
;
1747 error ("Invalid escape character syntax");
1750 c
= read_escape (readcharfun
, 0);
1751 return c
| alt_modifier
;
1756 error ("Invalid escape character syntax");
1759 c
= read_escape (readcharfun
, 0);
1760 return c
| super_modifier
;
1765 error ("Invalid escape character syntax");
1769 c
= read_escape (readcharfun
, 0);
1770 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1771 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1772 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1773 return c
| ctrl_modifier
;
1774 /* ASCII control chars are made from letters (both cases),
1775 as well as the non-letters within 0100...0137. */
1776 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1777 return (c
& (037 | ~0177));
1778 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1779 return (c
& (037 | ~0177));
1781 return c
| ctrl_modifier
;
1791 /* An octal escape, as in ANSI C. */
1793 register int i
= c
- '0';
1794 register int count
= 0;
1797 if ((c
= READCHAR
) >= '0' && c
<= '7')
1809 if (! ASCII_BYTE_P (i
))
1810 i
= BYTE8_TO_CHAR (i
);
1815 /* A hex escape, as in ANSI C. */
1822 if (c
>= '0' && c
<= '9')
1827 else if ((c
>= 'a' && c
<= 'f')
1828 || (c
>= 'A' && c
<= 'F'))
1831 if (c
>= 'a' && c
<= 'f')
1844 if (count
< 3 && i
>= 0x80)
1845 return BYTE8_TO_CHAR (i
);
1855 /* Read an integer in radix RADIX using READCHARFUN to read
1856 characters. RADIX must be in the interval [2..36]; if it isn't, a
1857 read error is signaled . Value is the integer read. Signals an
1858 error if encountering invalid read syntax or if RADIX is out of
1862 read_integer (readcharfun
, radix
)
1863 Lisp_Object readcharfun
;
1866 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1867 EMACS_INT number
= 0;
1869 if (radix
< 2 || radix
> 36)
1873 number
= ndigits
= invalid_p
= 0;
1889 if (c
>= '0' && c
<= '9')
1891 else if (c
>= 'a' && c
<= 'z')
1892 digit
= c
- 'a' + 10;
1893 else if (c
>= 'A' && c
<= 'Z')
1894 digit
= c
- 'A' + 10;
1901 if (digit
< 0 || digit
>= radix
)
1904 number
= radix
* number
+ digit
;
1910 if (ndigits
== 0 || invalid_p
)
1913 sprintf (buf
, "integer, radix %d", radix
);
1914 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1917 return make_number (sign
* number
);
1921 /* If the next token is ')' or ']' or '.', we store that character
1922 in *PCH and the return value is not interesting. Else, we store
1923 zero in *PCH and we read and return one lisp object.
1925 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1928 read1 (readcharfun
, pch
, first_in_list
)
1929 register Lisp_Object readcharfun
;
1934 int uninterned_symbol
= 0;
1943 end_of_file_error ();
1948 return read_list (0, readcharfun
);
1951 return read_vector (readcharfun
, 0);
1968 tmp
= read_vector (readcharfun
, 0);
1969 if (XVECTOR (tmp
)->size
!= VECSIZE (struct Lisp_Char_Table
))
1970 error ("Invalid size char-table");
1971 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1982 tmp
= read_vector (readcharfun
, 0);
1983 if (!INTEGERP (AREF (tmp
, 0)))
1984 error ("Invalid depth in char-table");
1985 depth
= XINT (AREF (tmp
, 0));
1986 if (depth
< 1 || depth
> 3)
1987 error ("Invalid depth in char-table");
1988 size
= XVECTOR (tmp
)->size
+ 2;
1989 if (chartab_size
[depth
] != size
)
1990 error ("Invalid size char-table");
1991 XSETSUB_CHAR_TABLE (tmp
, XSUB_CHAR_TABLE (tmp
));
1994 Fsignal (Qinvalid_read_syntax
,
1995 Fcons (make_string ("#^^", 3), Qnil
));
1997 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2002 length
= read1 (readcharfun
, pch
, first_in_list
);
2006 Lisp_Object tmp
, val
;
2007 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
2011 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2012 if (STRING_MULTIBYTE (tmp
)
2013 || (size_in_chars
!= XSTRING (tmp
)->size
2014 /* We used to print 1 char too many
2015 when the number of bits was a multiple of 8.
2016 Accept such input in case it came from an old
2018 && ! (XFASTINT (length
)
2019 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
)))
2020 Fsignal (Qinvalid_read_syntax
,
2021 Fcons (make_string ("#&...", 5), Qnil
));
2023 val
= Fmake_bool_vector (length
, Qnil
);
2024 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
2026 /* Clear the extraneous bits in the last byte. */
2027 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
2028 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2029 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
2032 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2037 /* Accept compiled functions at read-time so that we don't have to
2038 build them using function calls. */
2040 tmp
= read_vector (readcharfun
, 1);
2041 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2042 XVECTOR (tmp
)->contents
);
2047 struct gcpro gcpro1
;
2050 /* Read the string itself. */
2051 tmp
= read1 (readcharfun
, &ch
, 0);
2052 if (ch
!= 0 || !STRINGP (tmp
))
2053 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2055 /* Read the intervals and their properties. */
2058 Lisp_Object beg
, end
, plist
;
2060 beg
= read1 (readcharfun
, &ch
, 0);
2065 end
= read1 (readcharfun
, &ch
, 0);
2067 plist
= read1 (readcharfun
, &ch
, 0);
2069 Fsignal (Qinvalid_read_syntax
,
2070 Fcons (build_string ("invalid string property list"),
2072 Fset_text_properties (beg
, end
, plist
, tmp
);
2078 /* #@NUMBER is used to skip NUMBER following characters.
2079 That's used in .elc files to skip over doc strings
2080 and function definitions. */
2086 /* Read a decimal integer. */
2087 while ((c
= READCHAR
) >= 0
2088 && c
>= '0' && c
<= '9')
2096 if (load_force_doc_strings
2097 && (EQ (readcharfun
, Qget_file_char
)
2098 || EQ (readcharfun
, Qget_emacs_mule_file_char
)))
2100 /* If we are supposed to force doc strings into core right now,
2101 record the last string that we skipped,
2102 and record where in the file it comes from. */
2104 /* But first exchange saved_doc_string
2105 with prev_saved_doc_string, so we save two strings. */
2107 char *temp
= saved_doc_string
;
2108 int temp_size
= saved_doc_string_size
;
2109 file_offset temp_pos
= saved_doc_string_position
;
2110 int temp_len
= saved_doc_string_length
;
2112 saved_doc_string
= prev_saved_doc_string
;
2113 saved_doc_string_size
= prev_saved_doc_string_size
;
2114 saved_doc_string_position
= prev_saved_doc_string_position
;
2115 saved_doc_string_length
= prev_saved_doc_string_length
;
2117 prev_saved_doc_string
= temp
;
2118 prev_saved_doc_string_size
= temp_size
;
2119 prev_saved_doc_string_position
= temp_pos
;
2120 prev_saved_doc_string_length
= temp_len
;
2123 if (saved_doc_string_size
== 0)
2125 saved_doc_string_size
= nskip
+ 100;
2126 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2128 if (nskip
> saved_doc_string_size
)
2130 saved_doc_string_size
= nskip
+ 100;
2131 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2132 saved_doc_string_size
);
2135 saved_doc_string_position
= file_tell (instream
);
2137 /* Copy that many characters into saved_doc_string. */
2138 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2139 saved_doc_string
[i
] = c
= READCHAR
;
2141 saved_doc_string_length
= i
;
2145 /* Skip that many characters. */
2146 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2154 return Vload_file_name
;
2156 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2157 /* #:foo is the uninterned symbol named foo. */
2160 uninterned_symbol
= 1;
2164 /* Reader forms that can reuse previously read objects. */
2165 if (c
>= '0' && c
<= '9')
2170 /* Read a non-negative integer. */
2171 while (c
>= '0' && c
<= '9')
2177 /* #n=object returns object, but associates it with n for #n#. */
2180 /* Make a placeholder for #n# to use temporarily */
2181 Lisp_Object placeholder
;
2184 placeholder
= Fcons(Qnil
, Qnil
);
2185 cell
= Fcons (make_number (n
), placeholder
);
2186 read_objects
= Fcons (cell
, read_objects
);
2188 /* Read the object itself. */
2189 tem
= read0 (readcharfun
);
2191 /* Now put it everywhere the placeholder was... */
2192 substitute_object_in_subtree (tem
, placeholder
);
2194 /* ...and #n# will use the real value from now on. */
2195 Fsetcdr (cell
, tem
);
2199 /* #n# returns a previously read object. */
2202 tem
= Fassq (make_number (n
), read_objects
);
2205 /* Fall through to error message. */
2207 else if (c
== 'r' || c
== 'R')
2208 return read_integer (readcharfun
, n
);
2210 /* Fall through to error message. */
2212 else if (c
== 'x' || c
== 'X')
2213 return read_integer (readcharfun
, 16);
2214 else if (c
== 'o' || c
== 'O')
2215 return read_integer (readcharfun
, 8);
2216 else if (c
== 'b' || c
== 'B')
2217 return read_integer (readcharfun
, 2);
2220 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2223 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2228 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2238 new_backquote_flag
++;
2239 value
= read0 (readcharfun
);
2240 new_backquote_flag
--;
2242 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2246 if (new_backquote_flag
)
2248 Lisp_Object comma_type
= Qnil
;
2253 comma_type
= Qcomma_at
;
2255 comma_type
= Qcomma_dot
;
2258 if (ch
>= 0) UNREAD (ch
);
2259 comma_type
= Qcomma
;
2262 new_backquote_flag
--;
2263 value
= read0 (readcharfun
);
2264 new_backquote_flag
++;
2265 return Fcons (comma_type
, Fcons (value
, Qnil
));
2276 end_of_file_error ();
2278 c
= read_escape (readcharfun
, 0);
2279 modifiers
= c
& CHAR_MODIFIER_MASK
;
2280 c
&= ~CHAR_MODIFIER_MASK
;
2281 if (CHAR_BYTE8_P (c
))
2282 c
= CHAR_TO_BYTE8 (c
);
2285 return make_number (c
);
2290 char *p
= read_buffer
;
2291 char *end
= read_buffer
+ read_buffer_size
;
2293 /* Nonzero if we saw an escape sequence specifying
2294 a multibyte character. */
2295 int force_multibyte
= 0;
2296 /* Nonzero if we saw an escape sequence specifying
2297 a single-byte character. */
2298 int force_singlebyte
= 0;
2302 while ((c
= READCHAR
) >= 0
2305 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2307 int offset
= p
- read_buffer
;
2308 read_buffer
= (char *) xrealloc (read_buffer
,
2309 read_buffer_size
*= 2);
2310 p
= read_buffer
+ offset
;
2311 end
= read_buffer
+ read_buffer_size
;
2318 c
= read_escape (readcharfun
, 1);
2320 /* C is -1 if \ newline has just been seen */
2323 if (p
== read_buffer
)
2328 modifiers
= c
& CHAR_MODIFIER_MASK
;
2329 c
= c
& ~CHAR_MODIFIER_MASK
;
2331 if (CHAR_BYTE8_P (c
))
2332 force_singlebyte
= 1;
2333 else if (! ASCII_CHAR_P (c
))
2334 force_multibyte
= 1;
2335 else /* i.e. ASCII_CHAR_P (c) */
2337 /* Allow `\C- ' and `\C-?'. */
2338 if (modifiers
== CHAR_CTL
)
2341 c
= 0, modifiers
= 0;
2343 c
= 127, modifiers
= 0;
2345 if (modifiers
& CHAR_SHIFT
)
2347 /* Shift modifier is valid only with [A-Za-z]. */
2348 if (c
>= 'A' && c
<= 'Z')
2349 modifiers
&= ~CHAR_SHIFT
;
2350 else if (c
>= 'a' && c
<= 'z')
2351 c
-= ('a' - 'A'), modifiers
&= ~CHAR_SHIFT
;
2354 if (modifiers
& CHAR_META
)
2356 /* Move the meta bit to the right place for a
2358 modifiers
&= ~CHAR_META
;
2359 c
= BYTE8_TO_CHAR (c
| 0x80);
2360 force_singlebyte
= 1;
2364 /* Any modifiers remaining are invalid. */
2366 error ("Invalid modifier in string");
2367 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2371 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2372 if (CHAR_BYTE8_P (c
))
2373 force_singlebyte
= 1;
2374 else if (! ASCII_CHAR_P (c
))
2375 force_multibyte
= 1;
2380 end_of_file_error ();
2382 /* If purifying, and string starts with \ newline,
2383 return zero instead. This is for doc strings
2384 that we are really going to find in etc/DOC.nn.nn */
2385 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2386 return make_number (0);
2388 if (force_multibyte
)
2389 /* READ_BUFFER already contains valid multibyte forms. */
2391 else if (force_singlebyte
)
2393 nchars
= str_as_unibyte (read_buffer
, p
- read_buffer
);
2394 p
= read_buffer
+ nchars
;
2397 /* Otherwise, READ_BUFFER contains only ASCII. */
2400 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2402 || (p
- read_buffer
!= nchars
)));
2403 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2405 || (p
- read_buffer
!= nchars
)));
2410 int next_char
= READCHAR
;
2413 if (next_char
<= 040
2414 || index ("\"'`,(", next_char
))
2420 /* Otherwise, we fall through! Note that the atom-reading loop
2421 below will now loop at least once, assuring that we will not
2422 try to UNREAD two characters in a row. */
2426 if (c
<= 040) goto retry
;
2428 char *p
= read_buffer
;
2432 char *end
= read_buffer
+ read_buffer_size
;
2435 && !(c
== '\"' || c
== '\'' || c
== ';'
2436 || c
== '(' || c
== ')'
2437 || c
== '[' || c
== ']' || c
== '#'))
2439 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2441 int offset
= p
- read_buffer
;
2442 read_buffer
= (char *) xrealloc (read_buffer
,
2443 read_buffer_size
*= 2);
2444 p
= read_buffer
+ offset
;
2445 end
= read_buffer
+ read_buffer_size
;
2452 end_of_file_error ();
2456 p
+= CHAR_STRING (c
, p
);
2462 int offset
= p
- read_buffer
;
2463 read_buffer
= (char *) xrealloc (read_buffer
,
2464 read_buffer_size
*= 2);
2465 p
= read_buffer
+ offset
;
2466 end
= read_buffer
+ read_buffer_size
;
2473 if (!quoted
&& !uninterned_symbol
)
2476 register Lisp_Object val
;
2478 if (*p1
== '+' || *p1
== '-') p1
++;
2479 /* Is it an integer? */
2482 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2483 /* Integers can have trailing decimal points. */
2484 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2486 /* It is an integer. */
2490 /* Fixme: if we have strtol, use that, and check
2492 if (sizeof (int) == sizeof (EMACS_INT
))
2493 XSETINT (val
, atoi (read_buffer
));
2494 else if (sizeof (long) == sizeof (EMACS_INT
))
2495 XSETINT (val
, atol (read_buffer
));
2501 if (isfloat_string (read_buffer
))
2503 /* Compute NaN and infinities using 0.0 in a variable,
2504 to cope with compilers that think they are smarter
2510 /* Negate the value ourselves. This treats 0, NaNs,
2511 and infinity properly on IEEE floating point hosts,
2512 and works around a common bug where atof ("-0.0")
2514 int negative
= read_buffer
[0] == '-';
2516 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2517 returns 1, is if the input ends in e+INF or e+NaN. */
2524 value
= zero
/ zero
;
2527 value
= atof (read_buffer
+ negative
);
2531 return make_float (negative
? - value
: value
);
2535 if (uninterned_symbol
)
2536 return make_symbol (read_buffer
);
2538 return intern (read_buffer
);
2544 /* List of nodes we've seen during substitute_object_in_subtree. */
2545 static Lisp_Object seen_list
;
2548 substitute_object_in_subtree (object
, placeholder
)
2550 Lisp_Object placeholder
;
2552 Lisp_Object check_object
;
2554 /* We haven't seen any objects when we start. */
2557 /* Make all the substitutions. */
2559 = substitute_object_recurse (object
, placeholder
, object
);
2561 /* Clear seen_list because we're done with it. */
2564 /* The returned object here is expected to always eq the
2566 if (!EQ (check_object
, object
))
2567 error ("Unexpected mutation error in reader");
2570 /* Feval doesn't get called from here, so no gc protection is needed. */
2571 #define SUBSTITUTE(get_val, set_val) \
2573 Lisp_Object old_value = get_val; \
2574 Lisp_Object true_value \
2575 = substitute_object_recurse (object, placeholder,\
2578 if (!EQ (old_value, true_value)) \
2585 substitute_object_recurse (object
, placeholder
, subtree
)
2587 Lisp_Object placeholder
;
2588 Lisp_Object subtree
;
2590 /* If we find the placeholder, return the target object. */
2591 if (EQ (placeholder
, subtree
))
2594 /* If we've been to this node before, don't explore it again. */
2595 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2598 /* If this node can be the entry point to a cycle, remember that
2599 we've seen it. It can only be such an entry point if it was made
2600 by #n=, which means that we can find it as a value in
2602 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2603 seen_list
= Fcons (subtree
, seen_list
);
2605 /* Recurse according to subtree's type.
2606 Every branch must return a Lisp_Object. */
2607 switch (XTYPE (subtree
))
2609 case Lisp_Vectorlike
:
2612 int length
= XINT (Flength(subtree
));
2613 for (i
= 0; i
< length
; i
++)
2615 Lisp_Object idx
= make_number (i
);
2616 SUBSTITUTE (Faref (subtree
, idx
),
2617 Faset (subtree
, idx
, true_value
));
2624 SUBSTITUTE (Fcar_safe (subtree
),
2625 Fsetcar (subtree
, true_value
));
2626 SUBSTITUTE (Fcdr_safe (subtree
),
2627 Fsetcdr (subtree
, true_value
));
2633 /* Check for text properties in each interval.
2634 substitute_in_interval contains part of the logic. */
2636 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2637 Lisp_Object arg
= Fcons (object
, placeholder
);
2639 traverse_intervals_noorder (root_interval
,
2640 &substitute_in_interval
, arg
);
2645 /* Other types don't recurse any further. */
2651 /* Helper function for substitute_object_recurse. */
2653 substitute_in_interval (interval
, arg
)
2657 Lisp_Object object
= Fcar (arg
);
2658 Lisp_Object placeholder
= Fcdr (arg
);
2660 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2679 if (*cp
== '+' || *cp
== '-')
2682 if (*cp
>= '0' && *cp
<= '9')
2685 while (*cp
>= '0' && *cp
<= '9')
2693 if (*cp
>= '0' && *cp
<= '9')
2696 while (*cp
>= '0' && *cp
<= '9')
2699 if (*cp
== 'e' || *cp
== 'E')
2703 if (*cp
== '+' || *cp
== '-')
2707 if (*cp
>= '0' && *cp
<= '9')
2710 while (*cp
>= '0' && *cp
<= '9')
2713 else if (cp
== start
)
2715 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2720 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2726 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2727 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2728 || state
== (DOT_CHAR
|TRAIL_INT
)
2729 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2730 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2731 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2736 read_vector (readcharfun
, bytecodeflag
)
2737 Lisp_Object readcharfun
;
2742 register Lisp_Object
*ptr
;
2743 register Lisp_Object tem
, item
, vector
;
2744 register struct Lisp_Cons
*otem
;
2747 tem
= read_list (1, readcharfun
);
2748 len
= Flength (tem
);
2749 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2751 size
= XVECTOR (vector
)->size
;
2752 ptr
= XVECTOR (vector
)->contents
;
2753 for (i
= 0; i
< size
; i
++)
2756 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2757 bytecode object, the docstring containing the bytecode and
2758 constants values must be treated as unibyte and passed to
2759 Fread, to get the actual bytecode string and constants vector. */
2760 if (bytecodeflag
&& load_force_doc_strings
)
2762 if (i
== COMPILED_BYTECODE
)
2764 if (!STRINGP (item
))
2765 error ("invalid byte code");
2767 /* Delay handling the bytecode slot until we know whether
2768 it is lazily-loaded (we can tell by whether the
2769 constants slot is nil). */
2770 ptr
[COMPILED_CONSTANTS
] = item
;
2773 else if (i
== COMPILED_CONSTANTS
)
2775 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2779 /* Coerce string to unibyte (like string-as-unibyte,
2780 but without generating extra garbage and
2781 guaranteeing no change in the contents). */
2782 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2783 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2785 item
= Fread (Fcons (bytestr
, readcharfun
));
2787 error ("invalid byte code");
2789 otem
= XCONS (item
);
2790 bytestr
= XCAR (item
);
2795 /* Now handle the bytecode slot. */
2796 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2798 else if (i
== COMPILED_DOC_STRING
2800 && ! STRING_MULTIBYTE (item
))
2802 if (EQ (readcharfun
, Qget_emacs_mule_file_char
))
2803 item
= Fdecode_coding_string (item
, Qemacs_mule
, Qnil
, Qnil
);
2805 item
= Fstring_as_multibyte (item
);
2808 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2816 /* FLAG = 1 means check for ] to terminate rather than ) and .
2817 FLAG = -1 means check for starting with defun
2818 and make structure pure. */
2821 read_list (flag
, readcharfun
)
2823 register Lisp_Object readcharfun
;
2825 /* -1 means check next element for defun,
2826 0 means don't check,
2827 1 means already checked and found defun. */
2828 int defunflag
= flag
< 0 ? -1 : 0;
2829 Lisp_Object val
, tail
;
2830 register Lisp_Object elt
, tem
;
2831 struct gcpro gcpro1
, gcpro2
;
2832 /* 0 is the normal case.
2833 1 means this list is a doc reference; replace it with the number 0.
2834 2 means this list is a doc reference; replace it with the doc string. */
2835 int doc_reference
= 0;
2837 /* Initialize this to 1 if we are reading a list. */
2838 int first_in_list
= flag
<= 0;
2847 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2852 /* While building, if the list starts with #$, treat it specially. */
2853 if (EQ (elt
, Vload_file_name
)
2855 && !NILP (Vpurify_flag
))
2857 if (NILP (Vdoc_file_name
))
2858 /* We have not yet called Snarf-documentation, so assume
2859 this file is described in the DOC-MM.NN file
2860 and Snarf-documentation will fill in the right value later.
2861 For now, replace the whole list with 0. */
2864 /* We have already called Snarf-documentation, so make a relative
2865 file name for this file, so it can be found properly
2866 in the installed Lisp directory.
2867 We don't use Fexpand_file_name because that would make
2868 the directory absolute now. */
2869 elt
= concat2 (build_string ("../lisp/"),
2870 Ffile_name_nondirectory (elt
));
2872 else if (EQ (elt
, Vload_file_name
)
2874 && load_force_doc_strings
)
2883 Fsignal (Qinvalid_read_syntax
,
2884 Fcons (make_string (") or . in a vector", 18), Qnil
));
2892 XSETCDR (tail
, read0 (readcharfun
));
2894 val
= read0 (readcharfun
);
2895 read1 (readcharfun
, &ch
, 0);
2899 if (doc_reference
== 1)
2900 return make_number (0);
2901 if (doc_reference
== 2)
2903 /* Get a doc string from the file we are loading.
2904 If it's in saved_doc_string, get it from there.
2906 Here, we don't know if the string is a
2907 bytecode string or a doc string. As a
2908 bytecode string must be unibyte, we always
2909 return a unibyte string. If it is actually a
2910 doc string, caller must make it
2912 int pos
= XINT (XCDR (val
));
2913 /* Position is negative for user variables. */
2914 if (pos
< 0) pos
= -pos
;
2915 if (pos
>= saved_doc_string_position
2916 && pos
< (saved_doc_string_position
2917 + saved_doc_string_length
))
2919 int start
= pos
- saved_doc_string_position
;
2922 /* Process quoting with ^A,
2923 and find the end of the string,
2924 which is marked with ^_ (037). */
2925 for (from
= start
, to
= start
;
2926 saved_doc_string
[from
] != 037;)
2928 int c
= saved_doc_string
[from
++];
2931 c
= saved_doc_string
[from
++];
2933 saved_doc_string
[to
++] = c
;
2935 saved_doc_string
[to
++] = 0;
2937 saved_doc_string
[to
++] = 037;
2940 saved_doc_string
[to
++] = c
;
2943 return make_unibyte_string (saved_doc_string
+ start
,
2946 /* Look in prev_saved_doc_string the same way. */
2947 else if (pos
>= prev_saved_doc_string_position
2948 && pos
< (prev_saved_doc_string_position
2949 + prev_saved_doc_string_length
))
2951 int start
= pos
- prev_saved_doc_string_position
;
2954 /* Process quoting with ^A,
2955 and find the end of the string,
2956 which is marked with ^_ (037). */
2957 for (from
= start
, to
= start
;
2958 prev_saved_doc_string
[from
] != 037;)
2960 int c
= prev_saved_doc_string
[from
++];
2963 c
= prev_saved_doc_string
[from
++];
2965 prev_saved_doc_string
[to
++] = c
;
2967 prev_saved_doc_string
[to
++] = 0;
2969 prev_saved_doc_string
[to
++] = 037;
2972 prev_saved_doc_string
[to
++] = c
;
2975 return make_unibyte_string (prev_saved_doc_string
2980 return get_doc_string (val
, 1, 0);
2985 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2987 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2989 tem
= (read_pure
&& flag
<= 0
2990 ? pure_cons (elt
, Qnil
)
2991 : Fcons (elt
, Qnil
));
2993 XSETCDR (tail
, tem
);
2998 defunflag
= EQ (elt
, Qdefun
);
2999 else if (defunflag
> 0)
3004 Lisp_Object Vobarray
;
3005 Lisp_Object initial_obarray
;
3007 /* oblookup stores the bucket number here, for the sake of Funintern. */
3009 int oblookup_last_bucket_number
;
3011 static int hash_string ();
3012 Lisp_Object
oblookup ();
3014 /* Get an error if OBARRAY is not an obarray.
3015 If it is one, return it. */
3018 check_obarray (obarray
)
3019 Lisp_Object obarray
;
3021 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3023 /* If Vobarray is now invalid, force it to be valid. */
3024 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3026 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3031 /* Intern the C string STR: return a symbol with that name,
3032 interned in the current obarray. */
3039 int len
= strlen (str
);
3040 Lisp_Object obarray
;
3043 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3044 obarray
= check_obarray (obarray
);
3045 tem
= oblookup (obarray
, str
, len
, len
);
3048 return Fintern (make_string (str
, len
), obarray
);
3051 /* Create an uninterned symbol with name STR. */
3057 int len
= strlen (str
);
3059 return Fmake_symbol ((!NILP (Vpurify_flag
)
3060 ? make_pure_string (str
, len
, len
, 0)
3061 : make_string (str
, len
)));
3064 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3065 doc
: /* Return the canonical symbol whose name is STRING.
3066 If there is none, one is created by this function and returned.
3067 A second optional argument specifies the obarray to use;
3068 it defaults to the value of `obarray'. */)
3070 Lisp_Object string
, obarray
;
3072 register Lisp_Object tem
, sym
, *ptr
;
3074 if (NILP (obarray
)) obarray
= Vobarray
;
3075 obarray
= check_obarray (obarray
);
3077 CHECK_STRING (string
);
3079 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3080 XSTRING (string
)->size
,
3081 STRING_BYTES (XSTRING (string
)));
3082 if (!INTEGERP (tem
))
3085 if (!NILP (Vpurify_flag
))
3086 string
= Fpurecopy (string
);
3087 sym
= Fmake_symbol (string
);
3089 if (EQ (obarray
, initial_obarray
))
3090 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3092 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3094 if ((XSTRING (string
)->data
[0] == ':')
3095 && EQ (obarray
, initial_obarray
))
3097 XSYMBOL (sym
)->constant
= 1;
3098 XSYMBOL (sym
)->value
= sym
;
3101 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3103 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3105 XSYMBOL (sym
)->next
= 0;
3110 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3111 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3112 NAME may be a string or a symbol. If it is a symbol, that exact
3113 symbol is searched for.
3114 A second optional argument specifies the obarray to use;
3115 it defaults to the value of `obarray'. */)
3117 Lisp_Object name
, obarray
;
3119 register Lisp_Object tem
;
3120 struct Lisp_String
*string
;
3122 if (NILP (obarray
)) obarray
= Vobarray
;
3123 obarray
= check_obarray (obarray
);
3125 if (!SYMBOLP (name
))
3127 CHECK_STRING (name
);
3128 string
= XSTRING (name
);
3131 string
= XSYMBOL (name
)->name
;
3133 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
3134 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3140 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3141 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3142 The value is t if a symbol was found and deleted, nil otherwise.
3143 NAME may be a string or a symbol. If it is a symbol, that symbol
3144 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3145 OBARRAY defaults to the value of the variable `obarray'. */)
3147 Lisp_Object name
, obarray
;
3149 register Lisp_Object string
, tem
;
3152 if (NILP (obarray
)) obarray
= Vobarray
;
3153 obarray
= check_obarray (obarray
);
3156 XSETSTRING (string
, XSYMBOL (name
)->name
);
3159 CHECK_STRING (name
);
3163 tem
= oblookup (obarray
, XSTRING (string
)->data
,
3164 XSTRING (string
)->size
,
3165 STRING_BYTES (XSTRING (string
)));
3168 /* If arg was a symbol, don't delete anything but that symbol itself. */
3169 if (SYMBOLP (name
) && !EQ (name
, tem
))
3172 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3173 XSYMBOL (tem
)->constant
= 0;
3174 XSYMBOL (tem
)->indirect_variable
= 0;
3176 hash
= oblookup_last_bucket_number
;
3178 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3180 if (XSYMBOL (tem
)->next
)
3181 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3183 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3187 Lisp_Object tail
, following
;
3189 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3190 XSYMBOL (tail
)->next
;
3193 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3194 if (EQ (following
, tem
))
3196 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3205 /* Return the symbol in OBARRAY whose names matches the string
3206 of SIZE characters (SIZE_BYTE bytes) at PTR.
3207 If there is no such symbol in OBARRAY, return nil.
3209 Also store the bucket number in oblookup_last_bucket_number. */
3212 oblookup (obarray
, ptr
, size
, size_byte
)
3213 Lisp_Object obarray
;
3215 int size
, size_byte
;
3219 register Lisp_Object tail
;
3220 Lisp_Object bucket
, tem
;
3222 if (!VECTORP (obarray
)
3223 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3225 obarray
= check_obarray (obarray
);
3226 obsize
= XVECTOR (obarray
)->size
;
3228 /* This is sometimes needed in the middle of GC. */
3229 obsize
&= ~ARRAY_MARK_FLAG
;
3230 /* Combining next two lines breaks VMS C 2.3. */
3231 hash
= hash_string (ptr
, size_byte
);
3233 bucket
= XVECTOR (obarray
)->contents
[hash
];
3234 oblookup_last_bucket_number
= hash
;
3235 if (XFASTINT (bucket
) == 0)
3237 else if (!SYMBOLP (bucket
))
3238 error ("Bad data in guts of obarray"); /* Like CADR error message */
3240 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3242 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3243 && XSYMBOL (tail
)->name
->size
== size
3244 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3246 else if (XSYMBOL (tail
)->next
== 0)
3249 XSETINT (tem
, hash
);
3254 hash_string (ptr
, len
)
3258 register unsigned char *p
= ptr
;
3259 register unsigned char *end
= p
+ len
;
3260 register unsigned char c
;
3261 register int hash
= 0;
3266 if (c
>= 0140) c
-= 40;
3267 hash
= ((hash
<<3) + (hash
>>28) + c
);
3269 return hash
& 07777777777;
3273 map_obarray (obarray
, fn
, arg
)
3274 Lisp_Object obarray
;
3275 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3279 register Lisp_Object tail
;
3280 CHECK_VECTOR (obarray
);
3281 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3283 tail
= XVECTOR (obarray
)->contents
[i
];
3288 if (XSYMBOL (tail
)->next
== 0)
3290 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3296 mapatoms_1 (sym
, function
)
3297 Lisp_Object sym
, function
;
3299 call1 (function
, sym
);
3302 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3303 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3304 OBARRAY defaults to the value of `obarray'. */)
3306 Lisp_Object function
, obarray
;
3308 if (NILP (obarray
)) obarray
= Vobarray
;
3309 obarray
= check_obarray (obarray
);
3311 map_obarray (obarray
, mapatoms_1
, function
);
3315 #define OBARRAY_SIZE 1511
3320 Lisp_Object oblength
;
3324 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3326 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3327 Vobarray
= Fmake_vector (oblength
, make_number (0));
3328 initial_obarray
= Vobarray
;
3329 staticpro (&initial_obarray
);
3330 /* Intern nil in the obarray */
3331 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3332 XSYMBOL (Qnil
)->constant
= 1;
3334 /* These locals are to kludge around a pyramid compiler bug. */
3335 hash
= hash_string ("nil", 3);
3336 /* Separate statement here to avoid VAXC bug. */
3337 hash
%= OBARRAY_SIZE
;
3338 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3341 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3342 XSYMBOL (Qnil
)->function
= Qunbound
;
3343 XSYMBOL (Qunbound
)->value
= Qunbound
;
3344 XSYMBOL (Qunbound
)->function
= Qunbound
;
3347 XSYMBOL (Qnil
)->value
= Qnil
;
3348 XSYMBOL (Qnil
)->plist
= Qnil
;
3349 XSYMBOL (Qt
)->value
= Qt
;
3350 XSYMBOL (Qt
)->constant
= 1;
3352 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3355 Qvariable_documentation
= intern ("variable-documentation");
3356 staticpro (&Qvariable_documentation
);
3358 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3359 read_buffer
= (char *) xmalloc (read_buffer_size
);
3364 struct Lisp_Subr
*sname
;
3367 sym
= intern (sname
->symbol_name
);
3368 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3371 #ifdef NOTDEF /* use fset in subr.el now */
3373 defalias (sname
, string
)
3374 struct Lisp_Subr
*sname
;
3378 sym
= intern (string
);
3379 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3383 /* Define an "integer variable"; a symbol whose value is forwarded
3384 to a C variable of type int. Sample call: */
3385 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3387 defvar_int (namestring
, address
)
3391 Lisp_Object sym
, val
;
3392 sym
= intern (namestring
);
3393 val
= allocate_misc ();
3394 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3395 XINTFWD (val
)->intvar
= address
;
3396 SET_SYMBOL_VALUE (sym
, val
);
3399 /* Similar but define a variable whose value is t if address contains 1,
3400 nil if address contains 0 */
3402 defvar_bool (namestring
, address
)
3406 Lisp_Object sym
, val
;
3407 sym
= intern (namestring
);
3408 val
= allocate_misc ();
3409 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3410 XBOOLFWD (val
)->boolvar
= address
;
3411 SET_SYMBOL_VALUE (sym
, val
);
3412 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3415 /* Similar but define a variable whose value is the Lisp Object stored
3416 at address. Two versions: with and without gc-marking of the C
3417 variable. The nopro version is used when that variable will be
3418 gc-marked for some other reason, since marking the same slot twice
3419 can cause trouble with strings. */
3421 defvar_lisp_nopro (namestring
, address
)
3423 Lisp_Object
*address
;
3425 Lisp_Object sym
, val
;
3426 sym
= intern (namestring
);
3427 val
= allocate_misc ();
3428 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3429 XOBJFWD (val
)->objvar
= address
;
3430 SET_SYMBOL_VALUE (sym
, val
);
3434 defvar_lisp (namestring
, address
)
3436 Lisp_Object
*address
;
3438 defvar_lisp_nopro (namestring
, address
);
3439 staticpro (address
);
3442 /* Similar but define a variable whose value is the Lisp Object stored in
3443 the current buffer. address is the address of the slot in the buffer
3444 that is current now. */
3447 defvar_per_buffer (namestring
, address
, type
, doc
)
3449 Lisp_Object
*address
;
3453 Lisp_Object sym
, val
;
3455 extern struct buffer buffer_local_symbols
;
3457 sym
= intern (namestring
);
3458 val
= allocate_misc ();
3459 offset
= (char *)address
- (char *)current_buffer
;
3461 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3462 XBUFFER_OBJFWD (val
)->offset
= offset
;
3463 SET_SYMBOL_VALUE (sym
, val
);
3464 PER_BUFFER_SYMBOL (offset
) = sym
;
3465 PER_BUFFER_TYPE (offset
) = type
;
3467 if (PER_BUFFER_IDX (offset
) == 0)
3468 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3469 slot of buffer_local_flags */
3474 /* Similar but define a variable whose value is the Lisp Object stored
3475 at a particular offset in the current kboard object. */
3478 defvar_kboard (namestring
, offset
)
3482 Lisp_Object sym
, val
;
3483 sym
= intern (namestring
);
3484 val
= allocate_misc ();
3485 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3486 XKBOARD_OBJFWD (val
)->offset
= offset
;
3487 SET_SYMBOL_VALUE (sym
, val
);
3490 /* Record the value of load-path used at the start of dumping
3491 so we can see if the site changed it later during dumping. */
3492 static Lisp_Object dump_path
;
3498 int turn_off_warning
= 0;
3500 /* Compute the default load-path. */
3502 normal
= PATH_LOADSEARCH
;
3503 Vload_path
= decode_env_path (0, normal
);
3505 if (NILP (Vpurify_flag
))
3506 normal
= PATH_LOADSEARCH
;
3508 normal
= PATH_DUMPLOADSEARCH
;
3510 /* In a dumped Emacs, we normally have to reset the value of
3511 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3512 uses ../lisp, instead of the path of the installed elisp
3513 libraries. However, if it appears that Vload_path was changed
3514 from the default before dumping, don't override that value. */
3517 if (! NILP (Fequal (dump_path
, Vload_path
)))
3519 Vload_path
= decode_env_path (0, normal
);
3520 if (!NILP (Vinstallation_directory
))
3522 Lisp_Object tem
, tem1
, sitelisp
;
3524 /* Remove site-lisp dirs from path temporarily and store
3525 them in sitelisp, then conc them on at the end so
3526 they're always first in path. */
3530 tem
= Fcar (Vload_path
);
3531 tem1
= Fstring_match (build_string ("site-lisp"),
3535 Vload_path
= Fcdr (Vload_path
);
3536 sitelisp
= Fcons (tem
, sitelisp
);
3542 /* Add to the path the lisp subdir of the
3543 installation dir, if it exists. */
3544 tem
= Fexpand_file_name (build_string ("lisp"),
3545 Vinstallation_directory
);
3546 tem1
= Ffile_exists_p (tem
);
3549 if (NILP (Fmember (tem
, Vload_path
)))
3551 turn_off_warning
= 1;
3552 Vload_path
= Fcons (tem
, Vload_path
);
3556 /* That dir doesn't exist, so add the build-time
3557 Lisp dirs instead. */
3558 Vload_path
= nconc2 (Vload_path
, dump_path
);
3560 /* Add leim under the installation dir, if it exists. */
3561 tem
= Fexpand_file_name (build_string ("leim"),
3562 Vinstallation_directory
);
3563 tem1
= Ffile_exists_p (tem
);
3566 if (NILP (Fmember (tem
, Vload_path
)))
3567 Vload_path
= Fcons (tem
, Vload_path
);
3570 /* Add site-list under the installation dir, if it exists. */
3571 tem
= Fexpand_file_name (build_string ("site-lisp"),
3572 Vinstallation_directory
);
3573 tem1
= Ffile_exists_p (tem
);
3576 if (NILP (Fmember (tem
, Vload_path
)))
3577 Vload_path
= Fcons (tem
, Vload_path
);
3580 /* If Emacs was not built in the source directory,
3581 and it is run from where it was built, add to load-path
3582 the lisp, leim and site-lisp dirs under that directory. */
3584 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3588 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3589 Vinstallation_directory
);
3590 tem1
= Ffile_exists_p (tem
);
3592 /* Don't be fooled if they moved the entire source tree
3593 AFTER dumping Emacs. If the build directory is indeed
3594 different from the source dir, src/Makefile.in and
3595 src/Makefile will not be found together. */
3596 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3597 Vinstallation_directory
);
3598 tem2
= Ffile_exists_p (tem
);
3599 if (!NILP (tem1
) && NILP (tem2
))
3601 tem
= Fexpand_file_name (build_string ("lisp"),
3604 if (NILP (Fmember (tem
, Vload_path
)))
3605 Vload_path
= Fcons (tem
, Vload_path
);
3607 tem
= Fexpand_file_name (build_string ("leim"),
3610 if (NILP (Fmember (tem
, Vload_path
)))
3611 Vload_path
= Fcons (tem
, Vload_path
);
3613 tem
= Fexpand_file_name (build_string ("site-lisp"),
3616 if (NILP (Fmember (tem
, Vload_path
)))
3617 Vload_path
= Fcons (tem
, Vload_path
);
3620 if (!NILP (sitelisp
))
3621 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3627 /* NORMAL refers to the lisp dir in the source directory. */
3628 /* We used to add ../lisp at the front here, but
3629 that caused trouble because it was copied from dump_path
3630 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3631 It should be unnecessary. */
3632 Vload_path
= decode_env_path (0, normal
);
3633 dump_path
= Vload_path
;
3638 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3639 almost never correct, thereby causing a warning to be printed out that
3640 confuses users. Since PATH_LOADSEARCH is always overridden by the
3641 EMACSLOADPATH environment variable below, disable the warning on NT. */
3643 /* Warn if dirs in the *standard* path don't exist. */
3644 if (!turn_off_warning
)
3646 Lisp_Object path_tail
;
3648 for (path_tail
= Vload_path
;
3650 path_tail
= XCDR (path_tail
))
3652 Lisp_Object dirfile
;
3653 dirfile
= Fcar (path_tail
);
3654 if (STRINGP (dirfile
))
3656 dirfile
= Fdirectory_file_name (dirfile
);
3657 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3658 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3663 #endif /* WINDOWSNT */
3665 /* If the EMACSLOADPATH environment variable is set, use its value.
3666 This doesn't apply if we're dumping. */
3668 if (NILP (Vpurify_flag
)
3669 && egetenv ("EMACSLOADPATH"))
3671 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3675 load_in_progress
= 0;
3676 Vload_file_name
= Qnil
;
3678 load_descriptor_list
= Qnil
;
3680 Vstandard_input
= Qt
;
3681 Vloads_in_progress
= Qnil
;
3684 /* Print a warning, using format string FORMAT, that directory DIRNAME
3685 does not exist. Print it on stderr and put it in *Message*. */
3688 dir_warning (format
, dirname
)
3690 Lisp_Object dirname
;
3693 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3695 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3696 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3697 /* Don't log the warning before we've initialized!! */
3699 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3706 defsubr (&Sread_from_string
);
3708 defsubr (&Sintern_soft
);
3709 defsubr (&Sunintern
);
3711 defsubr (&Seval_buffer
);
3712 defsubr (&Seval_region
);
3713 defsubr (&Sread_char
);
3714 defsubr (&Sread_char_exclusive
);
3715 defsubr (&Sread_event
);
3716 defsubr (&Sget_file_char
);
3717 defsubr (&Smapatoms
);
3719 DEFVAR_LISP ("obarray", &Vobarray
,
3720 doc
: /* Symbol table for use by `intern' and `read'.
3721 It is a vector whose length ought to be prime for best results.
3722 The vector's contents don't make sense if examined from Lisp programs;
3723 to find all the symbols in an obarray, use `mapatoms'. */);
3725 DEFVAR_LISP ("values", &Vvalues
,
3726 doc
: /* List of values of all expressions which were read, evaluated and printed.
3727 Order is reverse chronological. */);
3729 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3730 doc
: /* Stream for read to get input from.
3731 See documentation of `read' for possible values. */);
3732 Vstandard_input
= Qt
;
3734 DEFVAR_LISP ("load-path", &Vload_path
,
3735 doc
: /* *List of directories to search for files to load.
3736 Each element is a string (directory name) or nil (try default directory).
3737 Initialized based on EMACSLOADPATH environment variable, if any,
3738 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3740 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3741 doc
: /* *List of suffixes to try for files to load.
3742 This list should not include the empty string. */);
3743 Vload_suffixes
= Fcons (build_string (".elc"),
3744 Fcons (build_string (".el"), Qnil
));
3745 /* We don't use empty_string because it's not initialized yet. */
3746 default_suffixes
= Fcons (build_string (""), Qnil
);
3747 staticpro (&default_suffixes
);
3749 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3750 doc
: /* Non-nil iff inside of `load'. */);
3752 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3753 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3754 Each element looks like (FILENAME FORMS...).
3755 When `load' is run and the file-name argument is FILENAME,
3756 the FORMS in the corresponding element are executed at the end of loading.
3758 FILENAME must match exactly! Normally FILENAME is the name of a library,
3759 with no directory specified, since that is how `load' is normally called.
3760 An error in FORMS does not undo the load,
3761 but does prevent execution of the rest of the FORMS.
3762 FILENAME can also be a symbol (a feature) and FORMS are then executed
3763 when the corresponding call to `provide' is made. */);
3764 Vafter_load_alist
= Qnil
;
3766 DEFVAR_LISP ("load-history", &Vload_history
,
3767 doc
: /* Alist mapping source file names to symbols and features.
3768 Each alist element is a list that starts with a file name,
3769 except for one element (optional) that starts with nil and describes
3770 definitions evaluated from buffers not visiting files.
3771 The remaining elements of each list are symbols defined as functions
3772 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3773 and `(autoload . SYMBOL)'. */);
3774 Vload_history
= Qnil
;
3776 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3777 doc
: /* Full name of file being loaded by `load'. */);
3778 Vload_file_name
= Qnil
;
3780 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3781 doc
: /* File name, including directory, of user's initialization file.
3782 If the file loaded had extension `.elc' and there was a corresponding `.el'
3783 file, this variable contains the name of the .el file, suitable for use
3784 by functions like `custom-save-all' which edit the init file. */);
3785 Vuser_init_file
= Qnil
;
3787 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3788 doc
: /* Used for internal purposes by `load'. */);
3789 Vcurrent_load_list
= Qnil
;
3791 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3792 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3793 The default is nil, which means use the function `read'. */);
3794 Vload_read_function
= Qnil
;
3796 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3797 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3798 This function is for doing code conversion before reading the source file.
3799 If nil, loading is done without any code conversion.
3800 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3801 FULLNAME is the full name of FILE.
3802 See `load' for the meaning of the remaining arguments. */);
3803 Vload_source_file_function
= Qnil
;
3805 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3806 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3807 This is useful when the file being loaded is a temporary copy. */);
3808 load_force_doc_strings
= 0;
3810 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3811 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3812 This is normally bound by `load' and `eval-buffer' to control `read',
3813 and is not meant for users to change. */);
3814 load_convert_to_unibyte
= 0;
3816 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3817 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3818 You cannot count on them to still be there! */);
3820 = Fexpand_file_name (build_string ("../"),
3821 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3823 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3824 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3825 Vpreloaded_file_list
= Qnil
;
3827 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3828 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3829 Vbyte_boolean_vars
= Qnil
;
3831 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3832 doc
: /* Non-nil means load dangerous compiled Lisp files.
3833 Some versions of XEmacs use different byte codes than Emacs. These
3834 incompatible byte codes can make Emacs crash when it tries to execute
3836 load_dangerous_libraries
= 0;
3838 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3839 doc
: /* Regular expression matching safe to load compiled Lisp files.
3840 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3841 from the file, and matches them against this regular expression.
3842 When the regular expression matches, the file is considered to be safe
3843 to load. See also `load-dangerous-libraries'. */);
3844 Vbytecomp_version_regexp
3845 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3847 /* Vsource_directory was initialized in init_lread. */
3849 load_descriptor_list
= Qnil
;
3850 staticpro (&load_descriptor_list
);
3852 Qcurrent_load_list
= intern ("current-load-list");
3853 staticpro (&Qcurrent_load_list
);
3855 Qstandard_input
= intern ("standard-input");
3856 staticpro (&Qstandard_input
);
3858 Qread_char
= intern ("read-char");
3859 staticpro (&Qread_char
);
3861 Qget_file_char
= intern ("get-file-char");
3862 staticpro (&Qget_file_char
);
3864 Qget_emacs_mule_file_char
= intern ("get-emacs-mule-file-char");
3865 staticpro (&Qget_emacs_mule_file_char
);
3867 Qload_force_doc_strings
= intern ("load-force-doc-strings");
3868 staticpro (&Qload_force_doc_strings
);
3870 Qbackquote
= intern ("`");
3871 staticpro (&Qbackquote
);
3872 Qcomma
= intern (",");
3873 staticpro (&Qcomma
);
3874 Qcomma_at
= intern (",@");
3875 staticpro (&Qcomma_at
);
3876 Qcomma_dot
= intern (",.");
3877 staticpro (&Qcomma_dot
);
3879 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3880 staticpro (&Qinhibit_file_name_operation
);
3882 Qascii_character
= intern ("ascii-character");
3883 staticpro (&Qascii_character
);
3885 Qfunction
= intern ("function");
3886 staticpro (&Qfunction
);
3888 Qload
= intern ("load");
3891 Qload_file_name
= intern ("load-file-name");
3892 staticpro (&Qload_file_name
);
3894 staticpro (&dump_path
);
3896 staticpro (&read_objects
);
3897 read_objects
= Qnil
;
3898 staticpro (&seen_list
);
3900 Vloads_in_progress
= Qnil
;
3901 staticpro (&Vloads_in_progress
);