1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 1999
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"
36 #include "termhooks.h"
39 #include <sys/inode.h>
44 #include <unistd.h> /* to get X_OK */
61 #endif /* HAVE_SETLOCALE */
68 #define file_offset off_t
69 #define file_tell ftello
71 #define file_offset long
72 #define file_tell ftell
79 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
80 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
81 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
82 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
83 Lisp_Object Qinhibit_file_name_operation
;
85 extern Lisp_Object Qevent_symbol_element_mask
;
86 extern Lisp_Object Qfile_exists_p
;
88 /* non-zero if inside `load' */
91 /* Directory in which the sources were found. */
92 Lisp_Object Vsource_directory
;
94 /* Search path for files to be loaded. */
95 Lisp_Object Vload_path
;
97 /* File name of user's init file. */
98 Lisp_Object Vuser_init_file
;
100 /* This is the user-visible association list that maps features to
101 lists of defs in their load files. */
102 Lisp_Object Vload_history
;
104 /* This is used to build the load history. */
105 Lisp_Object Vcurrent_load_list
;
107 /* List of files that were preloaded. */
108 Lisp_Object Vpreloaded_file_list
;
110 /* Name of file actually being read by `load'. */
111 Lisp_Object Vload_file_name
;
113 /* Function to use for reading, in `load' and friends. */
114 Lisp_Object Vload_read_function
;
116 /* The association list of objects read with the #n=object form.
117 Each member of the list has the form (n . object), and is used to
118 look up the object for the corresponding #n# construct.
119 It must be set to nil before all top-level calls to read0. */
120 Lisp_Object read_objects
;
122 /* Nonzero means load should forcibly load all dynamic doc strings. */
123 static int load_force_doc_strings
;
125 /* Nonzero means read should convert strings to unibyte. */
126 static int load_convert_to_unibyte
;
128 /* Function to use for loading an Emacs lisp source file (not
129 compiled) instead of readevalloop. */
130 Lisp_Object Vload_source_file_function
;
132 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
133 Lisp_Object Vbyte_boolean_vars
;
135 /* List of descriptors now open for Fload. */
136 static Lisp_Object load_descriptor_list
;
138 /* File for get_file_char to read from. Use by load. */
139 static FILE *instream
;
141 /* When nonzero, read conses in pure space */
142 static int read_pure
;
144 /* For use within read-from-string (this reader is non-reentrant!!) */
145 static int read_from_string_index
;
146 static int read_from_string_index_byte
;
147 static int read_from_string_limit
;
149 /* Number of bytes left to read in the buffer character
150 that `readchar' has already advanced over. */
151 static int readchar_backlog
;
153 /* This contains the last string skipped with #@. */
154 static char *saved_doc_string
;
155 /* Length of buffer allocated in saved_doc_string. */
156 static int saved_doc_string_size
;
157 /* Length of actual data in saved_doc_string. */
158 static int saved_doc_string_length
;
159 /* This is the file position that string came from. */
160 static file_offset saved_doc_string_position
;
162 /* This contains the previous string skipped with #@.
163 We copy it from saved_doc_string when a new string
164 is put in saved_doc_string. */
165 static char *prev_saved_doc_string
;
166 /* Length of buffer allocated in prev_saved_doc_string. */
167 static int prev_saved_doc_string_size
;
168 /* Length of actual data in prev_saved_doc_string. */
169 static int prev_saved_doc_string_length
;
170 /* This is the file position that string came from. */
171 static file_offset prev_saved_doc_string_position
;
173 /* Nonzero means inside a new-style backquote
174 with no surrounding parentheses.
175 Fread initializes this to zero, so we need not specbind it
176 or worry about what happens to it when there is an error. */
177 static int new_backquote_flag
;
179 /* A list of file names for files being loaded in Fload. Used to
180 check for recursive loads. */
182 static Lisp_Object Vloads_in_progress
;
185 /* Handle unreading and rereading of characters.
186 Write READCHAR to read a character,
187 UNREAD(c) to unread c to be read again.
189 These macros actually read/unread a byte code, multibyte characters
190 are not handled here. The caller should manage them if necessary.
193 #define READCHAR readchar (readcharfun)
194 #define UNREAD(c) unreadchar (readcharfun, c)
197 readchar (readcharfun
)
198 Lisp_Object readcharfun
;
203 if (BUFFERP (readcharfun
))
205 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
207 int pt_byte
= BUF_PT_BYTE (inbuffer
);
208 int orig_pt_byte
= pt_byte
;
210 if (readchar_backlog
> 0)
211 /* We get the address of the byte just passed,
212 which is the last byte of the character.
213 The other bytes in this character are consecutive with it,
214 because the gap can't be in the middle of a character. */
215 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
216 - --readchar_backlog
);
218 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
221 readchar_backlog
= -1;
223 if (! NILP (inbuffer
->enable_multibyte_characters
))
225 /* Fetch the character code from the buffer. */
226 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
227 BUF_INC_POS (inbuffer
, pt_byte
);
228 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
232 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
235 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
239 if (MARKERP (readcharfun
))
241 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
243 int bytepos
= marker_byte_position (readcharfun
);
244 int orig_bytepos
= bytepos
;
246 if (readchar_backlog
> 0)
247 /* We get the address of the byte just passed,
248 which is the last byte of the character.
249 The other bytes in this character are consecutive with it,
250 because the gap can't be in the middle of a character. */
251 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
252 - --readchar_backlog
);
254 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
257 readchar_backlog
= -1;
259 if (! NILP (inbuffer
->enable_multibyte_characters
))
261 /* Fetch the character code from the buffer. */
262 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
263 BUF_INC_POS (inbuffer
, bytepos
);
264 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
268 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
272 XMARKER (readcharfun
)->bytepos
= bytepos
;
273 XMARKER (readcharfun
)->charpos
++;
278 if (EQ (readcharfun
, Qlambda
))
279 return read_bytecode_char (0);
281 if (EQ (readcharfun
, Qget_file_char
))
285 /* Interrupted reads have been observed while reading over the network */
286 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
295 if (STRINGP (readcharfun
))
297 if (read_from_string_index
>= read_from_string_limit
)
300 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
301 read_from_string_index
,
302 read_from_string_index_byte
);
307 tem
= call0 (readcharfun
);
314 /* Unread the character C in the way appropriate for the stream READCHARFUN.
315 If the stream is a user function, call it with the char as argument. */
318 unreadchar (readcharfun
, c
)
319 Lisp_Object readcharfun
;
323 /* Don't back up the pointer if we're unreading the end-of-input mark,
324 since readchar didn't advance it when we read it. */
326 else if (BUFFERP (readcharfun
))
328 struct buffer
*b
= XBUFFER (readcharfun
);
329 int bytepos
= BUF_PT_BYTE (b
);
331 if (readchar_backlog
>= 0)
336 if (! NILP (b
->enable_multibyte_characters
))
337 BUF_DEC_POS (b
, bytepos
);
341 BUF_PT_BYTE (b
) = bytepos
;
344 else if (MARKERP (readcharfun
))
346 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
347 int bytepos
= XMARKER (readcharfun
)->bytepos
;
349 if (readchar_backlog
>= 0)
353 XMARKER (readcharfun
)->charpos
--;
354 if (! NILP (b
->enable_multibyte_characters
))
355 BUF_DEC_POS (b
, bytepos
);
359 XMARKER (readcharfun
)->bytepos
= bytepos
;
362 else if (STRINGP (readcharfun
))
364 read_from_string_index
--;
365 read_from_string_index_byte
366 = string_char_to_byte (readcharfun
, read_from_string_index
);
368 else if (EQ (readcharfun
, Qlambda
))
369 read_bytecode_char (1);
370 else if (EQ (readcharfun
, Qget_file_char
))
371 ungetc (c
, instream
);
373 call1 (readcharfun
, make_number (c
));
376 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
377 static int read_multibyte ();
378 static Lisp_Object
substitute_object_recurse ();
379 static void substitute_object_in_subtree (), substitute_in_interval ();
382 /* Get a character from the tty. */
384 extern Lisp_Object
read_char ();
386 /* Read input events until we get one that's acceptable for our purposes.
388 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
389 until we get a character we like, and then stuffed into
392 If ASCII_REQUIRED is non-zero, we check function key events to see
393 if the unmodified version of the symbol has a Qascii_character
394 property, and use that character, if present.
396 If ERROR_NONASCII is non-zero, we signal an error if the input we
397 get isn't an ASCII character with modifiers. If it's zero but
398 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
401 If INPUT_METHOD is nonzero, we invoke the current input method
402 if the character warrants that. */
405 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
407 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
409 register Lisp_Object val
, delayed_switch_frame
;
411 #ifdef HAVE_WINDOW_SYSTEM
412 if (display_busy_cursor_p
)
413 cancel_busy_cursor ();
416 delayed_switch_frame
= Qnil
;
418 /* Read until we get an acceptable event. */
420 val
= read_char (0, 0, 0,
421 (input_method
? Qnil
: Qt
),
427 /* switch-frame events are put off until after the next ASCII
428 character. This is better than signaling an error just because
429 the last characters were typed to a separate minibuffer frame,
430 for example. Eventually, some code which can deal with
431 switch-frame events will read it and process it. */
433 && EVENT_HAS_PARAMETERS (val
)
434 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
436 delayed_switch_frame
= val
;
442 /* Convert certain symbols to their ASCII equivalents. */
445 Lisp_Object tem
, tem1
;
446 tem
= Fget (val
, Qevent_symbol_element_mask
);
449 tem1
= Fget (Fcar (tem
), Qascii_character
);
450 /* Merge this symbol's modifier bits
451 with the ASCII equivalent of its basic code. */
453 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
457 /* If we don't have a character now, deal with it appropriately. */
462 Vunread_command_events
= Fcons (val
, Qnil
);
463 error ("Non-character input-event");
470 if (! NILP (delayed_switch_frame
))
471 unread_switch_frame
= delayed_switch_frame
;
473 #ifdef HAVE_WINDOW_SYSTEM
474 if (display_busy_cursor_p
)
475 start_busy_cursor ();
480 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
481 "Read a character from the command input (keyboard or macro).\n\
482 It is returned as a number.\n\
483 If the user generates an event which is not a character (i.e. a mouse\n\
484 click or function key event), `read-char' signals an error. As an\n\
485 exception, switch-frame events are put off until non-ASCII events can\n\
487 If you want to read non-character events, or ignore them, call\n\
488 `read-event' or `read-char-exclusive' instead.\n\
490 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
491 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
492 input method is turned on in the current buffer, that input method\n\
493 is used for reading a character.")
494 (prompt
, inherit_input_method
)
495 Lisp_Object prompt
, inherit_input_method
;
498 message_with_string ("%s", prompt
, 0);
499 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
502 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
503 "Read an event object from the input stream.\n\
504 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
505 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
506 input method is turned on in the current buffer, that input method\n\
507 is used for reading a character.")
508 (prompt
, inherit_input_method
)
509 Lisp_Object prompt
, inherit_input_method
;
512 message_with_string ("%s", prompt
, 0);
513 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
516 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
517 "Read a character from the command input (keyboard or macro).\n\
518 It is returned as a number. Non-character events are ignored.\n\
520 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
521 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
522 input method is turned on in the current buffer, that input method\n\
523 is used for reading a character.")
524 (prompt
, inherit_input_method
)
525 Lisp_Object prompt
, inherit_input_method
;
528 message_with_string ("%s", prompt
, 0);
529 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
532 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
533 "Don't use this yourself.")
536 register Lisp_Object val
;
537 XSETINT (val
, getc (instream
));
541 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
542 Lisp_Object (*) (), int,
543 Lisp_Object
, Lisp_Object
));
544 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
545 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
547 /* Non-zero means load dangerous compiled Lisp files. */
549 int load_dangerous_libraries
;
551 /* A regular expression used to detect files compiled with Emacs. */
553 static Lisp_Object Vbytecomp_version_regexp
;
556 /* Value is non-zero if the file asswociated with file descriptor FD
557 is a compiled Lisp file that's safe to load. Only files compiled
558 with Emacs are safe to load. Files compiled with XEmacs can lead
559 to a crash in Fbyte_code because of an incompatible change in the
570 /* Read the first few bytes from the file, and look for a line
571 specifying the byte compiler version used. */
572 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
577 /* Skip to the next newline, skipping over the initial `ELC'
578 with NUL bytes following it. */
579 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
583 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
588 lseek (fd
, 0, SEEK_SET
);
593 /* Callback for record_unwind_protect. Restore the old load list OLD,
594 after loading a file successfully. */
597 record_load_unwind (old
)
600 return Vloads_in_progress
= old
;
604 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
605 "Execute a file of Lisp code named FILE.\n\
606 First try FILE with `.elc' appended, then try with `.el',\n\
607 then try FILE unmodified.\n\
608 This function searches the directories in `load-path'.\n\
609 If optional second arg NOERROR is non-nil,\n\
610 report no error if FILE doesn't exist.\n\
611 Print messages at start and end of loading unless\n\
612 optional third arg NOMESSAGE is non-nil.\n\
613 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
614 suffixes `.elc' or `.el' to the specified name FILE.\n\
615 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
616 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
617 it ends in one of those suffixes or includes a directory name.\n\
618 Return t if file exists.")
619 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
620 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
622 register FILE *stream
;
623 register int fd
= -1;
624 register Lisp_Object lispstream
;
625 int count
= specpdl_ptr
- specpdl
;
629 /* 1 means we printed the ".el is newer" message. */
631 /* 1 means we are loading a compiled file. */
640 CHECK_STRING (file
, 0);
642 /* If file name is magic, call the handler. */
643 handler
= Ffind_file_name_handler (file
, Qload
);
645 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
647 /* Do this after the handler to avoid
648 the need to gcpro noerror, nomessage and nosuffix.
649 (Below here, we care only whether they are nil or not.) */
650 file
= Fsubstitute_in_file_name (file
);
652 /* Avoid weird lossage with null string as arg,
653 since it would try to load a directory as a Lisp file */
654 if (XSTRING (file
)->size
> 0)
656 int size
= STRING_BYTES (XSTRING (file
));
660 if (! NILP (must_suffix
))
662 /* Don't insist on adding a suffix if FILE already ends with one. */
664 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
667 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
669 /* Don't insist on adding a suffix
670 if the argument includes a directory name. */
671 else if (! NILP (Ffile_name_directory (file
)))
675 fd
= openp (Vload_path
, file
,
676 (!NILP (nosuffix
) ? ""
677 : ! NILP (must_suffix
) ? ".elc.gz:.elc:.el.gz:.el"
678 : ".elc:.elc.gz:.el.gz:.el:"),
687 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
688 Fcons (file
, Qnil
)));
693 /* Tell startup.el whether or not we found the user's init file. */
694 if (EQ (Qt
, Vuser_init_file
))
695 Vuser_init_file
= found
;
697 /* If FD is 0, that means openp found a magic file. */
700 if (NILP (Fequal (found
, file
)))
701 /* If FOUND is a different file name from FILE,
702 find its handler even if we have already inhibited
703 the `load' operation on FILE. */
704 handler
= Ffind_file_name_handler (found
, Qt
);
706 handler
= Ffind_file_name_handler (found
, Qload
);
707 if (! NILP (handler
))
708 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
711 /* Check if we're loading this file again while another load
712 of the same file is already in progress. */
713 if (!NILP (Fmember (found
, Vloads_in_progress
)))
714 error ("Recursive load of file `%s'", XSTRING (file
)->data
);
715 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
716 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
718 /* Load .elc files directly, but not when they are
719 remote and have no handler! */
720 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
727 if (!safe_to_load_p (fd
))
730 if (!load_dangerous_libraries
)
731 error ("File `%s' was not compiled in Emacs",
732 XSTRING (found
)->data
);
733 else if (!NILP (nomessage
))
734 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
742 stat ((char *)XSTRING (found
)->data
, &s1
);
743 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
744 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
745 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
747 /* Make the progress messages mention that source is newer. */
750 /* If we won't print another message, mention this anyway. */
751 if (! NILP (nomessage
))
752 message_with_string ("Source file `%s' newer than byte-compiled file",
755 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
761 /* We are loading a source file (*.el). */
762 if (!NILP (Vload_source_file_function
))
768 val
= call4 (Vload_source_file_function
, found
, file
,
769 NILP (noerror
) ? Qnil
: Qt
,
770 NILP (nomessage
) ? Qnil
: Qt
);
771 return unbind_to (count
, val
);
777 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
778 #else /* not WINDOWSNT */
779 stream
= fdopen (fd
, fmode
);
780 #endif /* not WINDOWSNT */
784 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
787 if (! NILP (Vpurify_flag
))
788 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
790 if (NILP (nomessage
))
793 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
796 message_with_string ("Loading %s (source)...", file
, 1);
798 message_with_string ("Loading %s (compiled; note, source file is newer)...",
800 else /* The typical case; compiled file newer than source file. */
801 message_with_string ("Loading %s...", file
, 1);
805 lispstream
= Fcons (Qnil
, Qnil
);
806 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
807 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
808 record_unwind_protect (load_unwind
, lispstream
);
809 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
810 specbind (Qload_file_name
, found
);
811 specbind (Qinhibit_file_name_operation
, Qnil
);
813 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
815 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
816 unbind_to (count
, Qnil
);
818 /* Run any load-hooks for this file. */
819 temp
= Fassoc (file
, Vafter_load_alist
);
821 Fprogn (Fcdr (temp
));
824 if (saved_doc_string
)
825 free (saved_doc_string
);
826 saved_doc_string
= 0;
827 saved_doc_string_size
= 0;
829 if (prev_saved_doc_string
)
830 xfree (prev_saved_doc_string
);
831 prev_saved_doc_string
= 0;
832 prev_saved_doc_string_size
= 0;
834 if (!noninteractive
&& NILP (nomessage
))
837 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
840 message_with_string ("Loading %s (source)...done", file
, 1);
842 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
844 else /* The typical case; compiled file newer than source file. */
845 message_with_string ("Loading %s...done", file
, 1);
852 load_unwind (stream
) /* used as unwind-protect function in load */
855 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
856 | XFASTINT (XCDR (stream
))));
857 if (--load_in_progress
< 0) load_in_progress
= 0;
862 load_descriptor_unwind (oldlist
)
865 load_descriptor_list
= oldlist
;
869 /* Close all descriptors in use for Floads.
870 This is used when starting a subprocess. */
877 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
878 emacs_close (XFASTINT (XCAR (tail
)));
883 complete_filename_p (pathname
)
884 Lisp_Object pathname
;
886 register unsigned char *s
= XSTRING (pathname
)->data
;
887 return (IS_DIRECTORY_SEP (s
[0])
888 || (XSTRING (pathname
)->size
> 2
889 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
899 /* Search for a file whose name is STR, looking in directories
900 in the Lisp list PATH, and trying suffixes from SUFFIX.
901 SUFFIX is a string containing possible suffixes separated by colons.
902 On success, returns a file descriptor. On failure, returns -1.
904 EXEC_ONLY nonzero means don't open the files,
905 just look for one that is executable. In this case,
906 returns 1 on success.
908 If STOREPTR is nonzero, it points to a slot where the name of
909 the file actually found should be stored as a Lisp string.
910 nil is stored there on failure.
912 If the file we find is remote, return 0
913 but store the found remote file name in *STOREPTR.
914 We do not check for remote files if EXEC_ONLY is nonzero. */
917 openp (path
, str
, suffix
, storeptr
, exec_only
)
918 Lisp_Object path
, str
;
920 Lisp_Object
*storeptr
;
926 register char *fn
= buf
;
929 Lisp_Object filename
;
931 struct gcpro gcpro1
, gcpro2
, gcpro3
;
934 string
= filename
= Qnil
;
935 GCPRO3 (str
, string
, filename
);
940 if (complete_filename_p (str
))
943 for (; !NILP (path
); path
= Fcdr (path
))
947 filename
= Fexpand_file_name (str
, Fcar (path
));
948 if (!complete_filename_p (filename
))
949 /* If there are non-absolute elts in PATH (eg ".") */
950 /* Of course, this could conceivably lose if luser sets
951 default-directory to be something non-absolute... */
953 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
954 if (!complete_filename_p (filename
))
955 /* Give up on this path element! */
959 /* Calculate maximum size of any filename made from
960 this path element/specified file name and any possible suffix. */
961 want_size
= strlen (suffix
) + STRING_BYTES (XSTRING (filename
)) + 1;
962 if (fn_size
< want_size
)
963 fn
= (char *) alloca (fn_size
= 100 + want_size
);
967 /* Loop over suffixes. */
970 char *esuffix
= (char *) index (nsuffix
, ':');
971 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
974 /* Concatenate path element/specified name with the suffix.
975 If the directory starts with /:, remove that. */
976 if (XSTRING (filename
)->size
> 2
977 && XSTRING (filename
)->data
[0] == '/'
978 && XSTRING (filename
)->data
[1] == ':')
980 strncpy (fn
, XSTRING (filename
)->data
+ 2,
981 STRING_BYTES (XSTRING (filename
)) - 2);
982 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
986 strncpy (fn
, XSTRING (filename
)->data
,
987 STRING_BYTES (XSTRING (filename
)));
988 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
991 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
992 strncat (fn
, nsuffix
, lsuffix
);
994 /* Check that the file exists and is not a directory. */
998 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
999 if (! NILP (handler
) && ! exec_only
)
1003 string
= build_string (fn
);
1004 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
1005 : Ffile_readable_p (string
));
1007 && ! NILP (Ffile_directory_p (build_string (fn
))))
1012 /* We succeeded; return this descriptor and filename. */
1014 *storeptr
= build_string (fn
);
1021 int exists
= (stat (fn
, &st
) >= 0
1022 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1025 /* Check that we can access or open it. */
1027 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1029 fd
= emacs_open (fn
, O_RDONLY
, 0);
1033 /* We succeeded; return this descriptor and filename. */
1035 *storeptr
= build_string (fn
);
1042 /* Advance to next suffix. */
1045 nsuffix
+= lsuffix
+ 1;
1056 /* Merge the list we've accumulated of globals from the current input source
1057 into the load_history variable. The details depend on whether
1058 the source has an associated file name or not. */
1061 build_load_history (stream
, source
)
1065 register Lisp_Object tail
, prev
, newelt
;
1066 register Lisp_Object tem
, tem2
;
1067 register int foundit
, loading
;
1069 loading
= stream
|| !NARROWED
;
1071 tail
= Vload_history
;
1074 while (!NILP (tail
))
1078 /* Find the feature's previous assoc list... */
1079 if (!NILP (Fequal (source
, Fcar (tem
))))
1083 /* If we're loading, remove it. */
1087 Vload_history
= Fcdr (tail
);
1089 Fsetcdr (prev
, Fcdr (tail
));
1092 /* Otherwise, cons on new symbols that are not already members. */
1095 tem2
= Vcurrent_load_list
;
1097 while (CONSP (tem2
))
1099 newelt
= Fcar (tem2
);
1101 if (NILP (Fmemq (newelt
, tem
)))
1102 Fsetcar (tail
, Fcons (Fcar (tem
),
1103 Fcons (newelt
, Fcdr (tem
))));
1116 /* If we're loading, cons the new assoc onto the front of load-history,
1117 the most-recently-loaded position. Also do this if we didn't find
1118 an existing member for the current source. */
1119 if (loading
|| !foundit
)
1120 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1125 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1133 readevalloop_1 (old
)
1136 load_convert_to_unibyte
= ! NILP (old
);
1140 /* Signal an `end-of-file' error, if possible with file name
1144 end_of_file_error ()
1148 if (STRINGP (Vload_file_name
))
1149 data
= Fcons (Vload_file_name
, Qnil
);
1153 Fsignal (Qend_of_file
, data
);
1156 /* UNIBYTE specifies how to set load_convert_to_unibyte
1157 for this invocation.
1158 READFUN, if non-nil, is used instead of `read'. */
1161 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1162 Lisp_Object readcharfun
;
1164 Lisp_Object sourcename
;
1165 Lisp_Object (*evalfun
) ();
1167 Lisp_Object unibyte
, readfun
;
1170 register Lisp_Object val
;
1171 int count
= specpdl_ptr
- specpdl
;
1172 struct gcpro gcpro1
;
1173 struct buffer
*b
= 0;
1174 int continue_reading_p
;
1176 if (BUFFERP (readcharfun
))
1177 b
= XBUFFER (readcharfun
);
1178 else if (MARKERP (readcharfun
))
1179 b
= XMARKER (readcharfun
)->buffer
;
1181 specbind (Qstandard_input
, readcharfun
);
1182 specbind (Qcurrent_load_list
, Qnil
);
1183 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1184 load_convert_to_unibyte
= !NILP (unibyte
);
1186 readchar_backlog
= -1;
1188 GCPRO1 (sourcename
);
1190 LOADHIST_ATTACH (sourcename
);
1192 continue_reading_p
= 1;
1193 while (continue_reading_p
)
1195 if (b
!= 0 && NILP (b
->name
))
1196 error ("Reading from killed buffer");
1202 while ((c
= READCHAR
) != '\n' && c
!= -1);
1207 /* Ignore whitespace here, so we can detect eof. */
1208 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1211 if (!NILP (Vpurify_flag
) && c
== '(')
1213 int count1
= specpdl_ptr
- specpdl
;
1214 record_unwind_protect (unreadpure
, Qnil
);
1215 val
= read_list (-1, readcharfun
);
1216 unbind_to (count1
, Qnil
);
1221 read_objects
= Qnil
;
1222 if (!NILP (readfun
))
1224 val
= call1 (readfun
, readcharfun
);
1226 /* If READCHARFUN has set point to ZV, we should
1227 stop reading, even if the form read sets point
1228 to a different value when evaluated. */
1229 if (BUFFERP (readcharfun
))
1231 struct buffer
*b
= XBUFFER (readcharfun
);
1232 if (BUF_PT (b
) == BUF_ZV (b
))
1233 continue_reading_p
= 0;
1236 else if (! NILP (Vload_read_function
))
1237 val
= call1 (Vload_read_function
, readcharfun
);
1239 val
= read0 (readcharfun
);
1242 val
= (*evalfun
) (val
);
1246 Vvalues
= Fcons (val
, Vvalues
);
1247 if (EQ (Vstandard_output
, Qt
))
1254 build_load_history (stream
, sourcename
);
1257 unbind_to (count
, Qnil
);
1260 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1261 "Execute the current buffer as Lisp code.\n\
1262 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1263 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1264 PRINTFLAG controls printing of output:\n\
1265 nil means discard it; anything else is stream for print.\n\
1267 If the optional third argument FILENAME is non-nil,\n\
1268 it specifies the file name to use for `load-history'.\n\
1269 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\
1270 for this invocation.\n\
1272 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\
1273 `print' and related functions should work normally even if PRINTFLAG is nil.\n\
1275 This function preserves the position of point.")
1276 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1277 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1279 int count
= specpdl_ptr
- specpdl
;
1280 Lisp_Object tem
, buf
;
1283 buf
= Fcurrent_buffer ();
1285 buf
= Fget_buffer (buffer
);
1287 error ("No such buffer");
1289 if (NILP (printflag
) && NILP (do_allow_print
))
1294 if (NILP (filename
))
1295 filename
= XBUFFER (buf
)->filename
;
1297 specbind (Qstandard_output
, tem
);
1298 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1299 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1300 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1301 unbind_to (count
, Qnil
);
1307 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1308 "Execute the current buffer as Lisp code.\n\
1309 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1310 nil means discard it; anything else is stream for print.\n\
1312 If there is no error, point does not move. If there is an error,\n\
1313 point remains at the end of the last character read from the buffer.")
1315 Lisp_Object printflag
;
1317 int count
= specpdl_ptr
- specpdl
;
1318 Lisp_Object tem
, cbuf
;
1320 cbuf
= Fcurrent_buffer ()
1322 if (NILP (printflag
))
1326 specbind (Qstandard_output
, tem
);
1327 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1329 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1330 !NILP (printflag
), Qnil
, Qnil
);
1331 return unbind_to (count
, Qnil
);
1335 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1336 "Execute the region as Lisp code.\n\
1337 When called from programs, expects two arguments,\n\
1338 giving starting and ending indices in the current buffer\n\
1339 of the text to be executed.\n\
1340 Programs can pass third argument PRINTFLAG which controls output:\n\
1341 nil means discard it; anything else is stream for printing it.\n\
1342 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1343 instead of `read' to read each expression. It gets one argument\n\
1344 which is the input stream for reading characters.\n\
1346 This function does not move point.")
1347 (start
, end
, printflag
, read_function
)
1348 Lisp_Object start
, end
, printflag
, read_function
;
1350 int count
= specpdl_ptr
- specpdl
;
1351 Lisp_Object tem
, cbuf
;
1353 cbuf
= Fcurrent_buffer ();
1355 if (NILP (printflag
))
1359 specbind (Qstandard_output
, tem
);
1361 if (NILP (printflag
))
1362 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1363 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1365 /* This both uses start and checks its type. */
1367 Fnarrow_to_region (make_number (BEGV
), end
);
1368 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1369 !NILP (printflag
), Qnil
, read_function
);
1371 return unbind_to (count
, Qnil
);
1375 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1376 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1377 If STREAM is nil, use the value of `standard-input' (which see).\n\
1378 STREAM or the value of `standard-input' may be:\n\
1379 a buffer (read from point and advance it)\n\
1380 a marker (read from where it points and advance it)\n\
1381 a function (call it with no arguments for each character,\n\
1382 call it with a char as argument to push a char back)\n\
1383 a string (takes text from string, starting at the beginning)\n\
1384 t (read text line using minibuffer and use it, or read from\n\
1385 standard input in batch mode).")
1389 extern Lisp_Object
Fread_minibuffer ();
1392 stream
= Vstandard_input
;
1393 if (EQ (stream
, Qt
))
1394 stream
= Qread_char
;
1396 readchar_backlog
= -1;
1397 new_backquote_flag
= 0;
1398 read_objects
= Qnil
;
1400 if (EQ (stream
, Qread_char
))
1401 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1403 if (STRINGP (stream
))
1404 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1406 return read0 (stream
);
1409 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1410 "Read one Lisp expression which is represented as text by STRING.\n\
1411 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1412 START and END optionally delimit a substring of STRING from which to read;\n\
1413 they default to 0 and (length STRING) respectively.")
1414 (string
, start
, end
)
1415 Lisp_Object string
, start
, end
;
1417 int startval
, endval
;
1420 CHECK_STRING (string
,0);
1423 endval
= XSTRING (string
)->size
;
1426 CHECK_NUMBER (end
, 2);
1427 endval
= XINT (end
);
1428 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1429 args_out_of_range (string
, end
);
1436 CHECK_NUMBER (start
, 1);
1437 startval
= XINT (start
);
1438 if (startval
< 0 || startval
> endval
)
1439 args_out_of_range (string
, start
);
1442 read_from_string_index
= startval
;
1443 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1444 read_from_string_limit
= endval
;
1446 new_backquote_flag
= 0;
1447 read_objects
= Qnil
;
1449 tem
= read0 (string
);
1450 return Fcons (tem
, make_number (read_from_string_index
));
1453 /* Use this for recursive reads, in contexts where internal tokens
1458 Lisp_Object readcharfun
;
1460 register Lisp_Object val
;
1463 val
= read1 (readcharfun
, &c
, 0);
1465 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1472 static int read_buffer_size
;
1473 static char *read_buffer
;
1475 /* Read multibyte form and return it as a character. C is a first
1476 byte of multibyte form, and rest of them are read from
1480 read_multibyte (c
, readcharfun
)
1482 Lisp_Object readcharfun
;
1484 /* We need the actual character code of this multibyte
1486 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1490 while ((c
= READCHAR
) >= 0xA0
1491 && len
< MAX_MULTIBYTE_LENGTH
)
1494 return STRING_CHAR (str
, len
);
1497 /* Read a \-escape sequence, assuming we already read the `\'. */
1500 read_escape (readcharfun
, stringp
)
1501 Lisp_Object readcharfun
;
1504 register int c
= READCHAR
;
1508 error ("End of file");
1538 error ("Invalid escape character syntax");
1541 c
= read_escape (readcharfun
, 0);
1542 return c
| meta_modifier
;
1547 error ("Invalid escape character syntax");
1550 c
= read_escape (readcharfun
, 0);
1551 return c
| shift_modifier
;
1556 error ("Invalid escape character syntax");
1559 c
= read_escape (readcharfun
, 0);
1560 return c
| hyper_modifier
;
1565 error ("Invalid escape character syntax");
1568 c
= read_escape (readcharfun
, 0);
1569 return c
| alt_modifier
;
1574 error ("Invalid escape character syntax");
1577 c
= read_escape (readcharfun
, 0);
1578 return c
| super_modifier
;
1583 error ("Invalid escape character syntax");
1587 c
= read_escape (readcharfun
, 0);
1588 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1589 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1590 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1591 return c
| ctrl_modifier
;
1592 /* ASCII control chars are made from letters (both cases),
1593 as well as the non-letters within 0100...0137. */
1594 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1595 return (c
& (037 | ~0177));
1596 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1597 return (c
& (037 | ~0177));
1599 return c
| ctrl_modifier
;
1609 /* An octal escape, as in ANSI C. */
1611 register int i
= c
- '0';
1612 register int count
= 0;
1615 if ((c
= READCHAR
) >= '0' && c
<= '7')
1630 /* A hex escape, as in ANSI C. */
1636 if (c
>= '0' && c
<= '9')
1641 else if ((c
>= 'a' && c
<= 'f')
1642 || (c
>= 'A' && c
<= 'F'))
1645 if (c
>= 'a' && c
<= 'f')
1660 if (BASE_LEADING_CODE_P (c
))
1661 c
= read_multibyte (c
, readcharfun
);
1667 /* Read an integer in radix RADIX using READCHARFUN to read
1668 characters. RADIX must be in the interval [2..36]; if it isn't, a
1669 read error is signaled . Value is the integer read. Signals an
1670 error if encountering invalid read syntax or if RADIX is out of
1674 read_integer (readcharfun
, radix
)
1675 Lisp_Object readcharfun
;
1678 int number
= 0, ndigits
= 0, invalid_p
, c
, sign
= 0;
1680 if (radix
< 2 || radix
> 36)
1684 number
= ndigits
= invalid_p
= 0;
1700 if (c
>= '0' && c
<= '9')
1702 else if (c
>= 'a' && c
<= 'z')
1703 digit
= c
- 'a' + 10;
1704 else if (c
>= 'A' && c
<= 'Z')
1705 digit
= c
- 'A' + 10;
1712 if (digit
< 0 || digit
>= radix
)
1715 number
= radix
* number
+ digit
;
1721 if (ndigits
== 0 || invalid_p
)
1724 sprintf (buf
, "integer, radix %d", radix
);
1725 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1728 return make_number (sign
* number
);
1732 /* If the next token is ')' or ']' or '.', we store that character
1733 in *PCH and the return value is not interesting. Else, we store
1734 zero in *PCH and we read and return one lisp object.
1736 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1739 read1 (readcharfun
, pch
, first_in_list
)
1740 register Lisp_Object readcharfun
;
1745 int uninterned_symbol
= 0;
1753 end_of_file_error ();
1758 return read_list (0, readcharfun
);
1761 return read_vector (readcharfun
, 0);
1778 tmp
= read_vector (readcharfun
, 0);
1779 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1780 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1781 error ("Invalid size char-table");
1782 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1783 XCHAR_TABLE (tmp
)->top
= Qt
;
1792 tmp
= read_vector (readcharfun
, 0);
1793 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1794 error ("Invalid size char-table");
1795 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1796 XCHAR_TABLE (tmp
)->top
= Qnil
;
1799 Fsignal (Qinvalid_read_syntax
,
1800 Fcons (make_string ("#^^", 3), Qnil
));
1802 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1807 length
= read1 (readcharfun
, pch
, first_in_list
);
1811 Lisp_Object tmp
, val
;
1812 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1816 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1817 if (size_in_chars
!= XSTRING (tmp
)->size
1818 /* We used to print 1 char too many
1819 when the number of bits was a multiple of 8.
1820 Accept such input in case it came from an old version. */
1821 && ! (XFASTINT (length
)
1822 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1823 Fsignal (Qinvalid_read_syntax
,
1824 Fcons (make_string ("#&...", 5), Qnil
));
1826 val
= Fmake_bool_vector (length
, Qnil
);
1827 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1829 /* Clear the extraneous bits in the last byte. */
1830 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1831 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1832 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1835 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1840 /* Accept compiled functions at read-time so that we don't have to
1841 build them using function calls. */
1843 tmp
= read_vector (readcharfun
, 1);
1844 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1845 XVECTOR (tmp
)->contents
);
1850 struct gcpro gcpro1
;
1853 /* Read the string itself. */
1854 tmp
= read1 (readcharfun
, &ch
, 0);
1855 if (ch
!= 0 || !STRINGP (tmp
))
1856 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1858 /* Read the intervals and their properties. */
1861 Lisp_Object beg
, end
, plist
;
1863 beg
= read1 (readcharfun
, &ch
, 0);
1868 end
= read1 (readcharfun
, &ch
, 0);
1870 plist
= read1 (readcharfun
, &ch
, 0);
1872 Fsignal (Qinvalid_read_syntax
,
1873 Fcons (build_string ("invalid string property list"),
1875 Fset_text_properties (beg
, end
, plist
, tmp
);
1881 /* #@NUMBER is used to skip NUMBER following characters.
1882 That's used in .elc files to skip over doc strings
1883 and function definitions. */
1888 /* Read a decimal integer. */
1889 while ((c
= READCHAR
) >= 0
1890 && c
>= '0' && c
<= '9')
1898 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1900 /* If we are supposed to force doc strings into core right now,
1901 record the last string that we skipped,
1902 and record where in the file it comes from. */
1904 /* But first exchange saved_doc_string
1905 with prev_saved_doc_string, so we save two strings. */
1907 char *temp
= saved_doc_string
;
1908 int temp_size
= saved_doc_string_size
;
1909 file_offset temp_pos
= saved_doc_string_position
;
1910 int temp_len
= saved_doc_string_length
;
1912 saved_doc_string
= prev_saved_doc_string
;
1913 saved_doc_string_size
= prev_saved_doc_string_size
;
1914 saved_doc_string_position
= prev_saved_doc_string_position
;
1915 saved_doc_string_length
= prev_saved_doc_string_length
;
1917 prev_saved_doc_string
= temp
;
1918 prev_saved_doc_string_size
= temp_size
;
1919 prev_saved_doc_string_position
= temp_pos
;
1920 prev_saved_doc_string_length
= temp_len
;
1923 if (saved_doc_string_size
== 0)
1925 saved_doc_string_size
= nskip
+ 100;
1926 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1928 if (nskip
> saved_doc_string_size
)
1930 saved_doc_string_size
= nskip
+ 100;
1931 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1932 saved_doc_string_size
);
1935 saved_doc_string_position
= file_tell (instream
);
1937 /* Copy that many characters into saved_doc_string. */
1938 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1939 saved_doc_string
[i
] = c
= READCHAR
;
1941 saved_doc_string_length
= i
;
1945 /* Skip that many characters. */
1946 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1953 return Vload_file_name
;
1955 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1956 /* #:foo is the uninterned symbol named foo. */
1959 uninterned_symbol
= 1;
1963 /* Reader forms that can reuse previously read objects. */
1964 if (c
>= '0' && c
<= '9')
1969 /* Read a non-negative integer. */
1970 while (c
>= '0' && c
<= '9')
1976 /* #n=object returns object, but associates it with n for #n#. */
1979 /* Make a placeholder for #n# to use temporarily */
1980 Lisp_Object placeholder
;
1983 placeholder
= Fcons(Qnil
, Qnil
);
1984 cell
= Fcons (make_number (n
), placeholder
);
1985 read_objects
= Fcons (cell
, read_objects
);
1987 /* Read the object itself. */
1988 tem
= read0 (readcharfun
);
1990 /* Now put it everywhere the placeholder was... */
1991 substitute_object_in_subtree (tem
, placeholder
);
1993 /* ...and #n# will use the real value from now on. */
1994 Fsetcdr (cell
, tem
);
1998 /* #n# returns a previously read object. */
2001 tem
= Fassq (make_number (n
), read_objects
);
2004 /* Fall through to error message. */
2006 else if (c
== 'r' || c
== 'R')
2007 return read_integer (readcharfun
, n
);
2009 /* Fall through to error message. */
2011 else if (c
== 'x' || c
== 'X')
2012 return read_integer (readcharfun
, 16);
2013 else if (c
== 'o' || c
== 'O')
2014 return read_integer (readcharfun
, 8);
2015 else if (c
== 'b' || c
== 'B')
2016 return read_integer (readcharfun
, 2);
2019 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2022 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2027 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2037 new_backquote_flag
= 1;
2038 value
= read0 (readcharfun
);
2039 new_backquote_flag
= 0;
2041 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2045 if (new_backquote_flag
)
2047 Lisp_Object comma_type
= Qnil
;
2052 comma_type
= Qcomma_at
;
2054 comma_type
= Qcomma_dot
;
2057 if (ch
>= 0) UNREAD (ch
);
2058 comma_type
= Qcomma
;
2061 new_backquote_flag
= 0;
2062 value
= read0 (readcharfun
);
2063 new_backquote_flag
= 1;
2064 return Fcons (comma_type
, Fcons (value
, Qnil
));
2073 end_of_file_error ();
2076 c
= read_escape (readcharfun
, 0);
2077 else if (BASE_LEADING_CODE_P (c
))
2078 c
= read_multibyte (c
, readcharfun
);
2080 return make_number (c
);
2085 register char *p
= read_buffer
;
2086 register char *end
= read_buffer
+ read_buffer_size
;
2088 /* Nonzero if we saw an escape sequence specifying
2089 a multibyte character. */
2090 int force_multibyte
= 0;
2091 /* Nonzero if we saw an escape sequence specifying
2092 a single-byte character. */
2093 int force_singlebyte
= 0;
2097 while ((c
= READCHAR
) >= 0
2100 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2102 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2103 p
+= new - read_buffer
;
2104 read_buffer
+= new - read_buffer
;
2105 end
= read_buffer
+ read_buffer_size
;
2110 c
= read_escape (readcharfun
, 1);
2112 /* C is -1 if \ newline has just been seen */
2115 if (p
== read_buffer
)
2120 /* If an escape specifies a non-ASCII single-byte character,
2121 this must be a unibyte string. */
2122 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2123 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2124 force_singlebyte
= 1;
2127 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2129 /* Any modifiers for a multibyte character are invalid. */
2130 if (c
& CHAR_MODIFIER_MASK
)
2131 error ("Invalid modifier in string");
2132 p
+= CHAR_STRING (c
, p
);
2133 force_multibyte
= 1;
2137 /* Allow `\C- ' and `\C-?'. */
2138 if (c
== (CHAR_CTL
| ' '))
2140 else if (c
== (CHAR_CTL
| '?'))
2145 /* Shift modifier is valid only with [A-Za-z]. */
2146 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2148 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2149 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2153 /* Move the meta bit to the right place for a string. */
2154 c
= (c
& ~CHAR_META
) | 0x80;
2156 error ("Invalid modifier in string");
2161 end_of_file_error ();
2163 /* If purifying, and string starts with \ newline,
2164 return zero instead. This is for doc strings
2165 that we are really going to find in etc/DOC.nn.nn */
2166 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2167 return make_number (0);
2169 if (force_multibyte
)
2170 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2171 p
- read_buffer
, &nchars
);
2172 else if (force_singlebyte
)
2173 nchars
= p
- read_buffer
;
2174 else if (load_convert_to_unibyte
)
2177 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2178 p
- read_buffer
, &nchars
);
2179 if (p
- read_buffer
!= nchars
)
2181 string
= make_multibyte_string (read_buffer
, nchars
,
2183 return Fstring_make_unibyte (string
);
2186 else if (EQ (readcharfun
, Qget_file_char
)
2187 || EQ (readcharfun
, Qlambda
))
2188 /* Nowadays, reading directly from a file is used only for
2189 compiled Emacs Lisp files, and those always use the
2190 Emacs internal encoding. Meanwhile, Qlambda is used
2191 for reading dynamic byte code (compiled with
2192 byte-compile-dynamic = t). */
2193 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2194 p
- read_buffer
, &nchars
);
2196 /* In all other cases, if we read these bytes as
2197 separate characters, treat them as separate characters now. */
2198 nchars
= p
- read_buffer
;
2201 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2203 || (p
- read_buffer
!= nchars
)));
2204 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2206 || (p
- read_buffer
!= nchars
)));
2211 int next_char
= READCHAR
;
2214 if (next_char
<= 040
2215 || index ("\"'`,(", next_char
))
2221 /* Otherwise, we fall through! Note that the atom-reading loop
2222 below will now loop at least once, assuring that we will not
2223 try to UNREAD two characters in a row. */
2227 if (c
<= 040) goto retry
;
2229 char *p
= read_buffer
;
2233 char *end
= read_buffer
+ read_buffer_size
;
2236 && !(c
== '\"' || c
== '\'' || c
== ';'
2237 || c
== '(' || c
== ')'
2238 || c
== '[' || c
== ']' || c
== '#'))
2240 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2242 char *new = (char *) xrealloc (read_buffer
,
2243 read_buffer_size
*= 2);
2244 p
+= new - read_buffer
;
2245 read_buffer
+= new - read_buffer
;
2246 end
= read_buffer
+ read_buffer_size
;
2255 if (! SINGLE_BYTE_CHAR_P (c
))
2256 p
+= CHAR_STRING (c
, p
);
2265 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2266 p
+= new - read_buffer
;
2267 read_buffer
+= new - read_buffer
;
2268 /* end = read_buffer + read_buffer_size; */
2275 if (!quoted
&& !uninterned_symbol
)
2278 register Lisp_Object val
;
2280 if (*p1
== '+' || *p1
== '-') p1
++;
2281 /* Is it an integer? */
2284 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2285 /* Integers can have trailing decimal points. */
2286 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2288 /* It is an integer. */
2292 if (sizeof (int) == sizeof (EMACS_INT
))
2293 XSETINT (val
, atoi (read_buffer
));
2294 else if (sizeof (long) == sizeof (EMACS_INT
))
2295 XSETINT (val
, atol (read_buffer
));
2301 if (isfloat_string (read_buffer
))
2303 /* Compute NaN and infinities using 0.0 in a variable,
2304 to cope with compilers that think they are smarter
2310 /* Negate the value ourselves. This treats 0, NaNs,
2311 and infinity properly on IEEE floating point hosts,
2312 and works around a common bug where atof ("-0.0")
2314 int negative
= read_buffer
[0] == '-';
2316 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2317 returns 1, is if the input ends in e+INF or e+NaN. */
2324 value
= zero
/ zero
;
2327 value
= atof (read_buffer
+ negative
);
2331 return make_float (negative
? - value
: value
);
2335 if (uninterned_symbol
)
2336 return make_symbol (read_buffer
);
2338 return intern (read_buffer
);
2344 /* List of nodes we've seen during substitute_object_in_subtree. */
2345 static Lisp_Object seen_list
;
2348 substitute_object_in_subtree (object
, placeholder
)
2350 Lisp_Object placeholder
;
2352 Lisp_Object check_object
;
2354 /* We haven't seen any objects when we start. */
2357 /* Make all the substitutions. */
2359 = substitute_object_recurse (object
, placeholder
, object
);
2361 /* Clear seen_list because we're done with it. */
2364 /* The returned object here is expected to always eq the
2366 if (!EQ (check_object
, object
))
2367 error ("Unexpected mutation error in reader");
2370 /* Feval doesn't get called from here, so no gc protection is needed. */
2371 #define SUBSTITUTE(get_val, set_val) \
2373 Lisp_Object old_value = get_val; \
2374 Lisp_Object true_value \
2375 = substitute_object_recurse (object, placeholder,\
2378 if (!EQ (old_value, true_value)) \
2385 substitute_object_recurse (object
, placeholder
, subtree
)
2387 Lisp_Object placeholder
;
2388 Lisp_Object subtree
;
2390 /* If we find the placeholder, return the target object. */
2391 if (EQ (placeholder
, subtree
))
2394 /* If we've been to this node before, don't explore it again. */
2395 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2398 /* If this node can be the entry point to a cycle, remember that
2399 we've seen it. It can only be such an entry point if it was made
2400 by #n=, which means that we can find it as a value in
2402 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2403 seen_list
= Fcons (subtree
, seen_list
);
2405 /* Recurse according to subtree's type.
2406 Every branch must return a Lisp_Object. */
2407 switch (XTYPE (subtree
))
2409 case Lisp_Vectorlike
:
2412 int length
= XINT (Flength(subtree
));
2413 for (i
= 0; i
< length
; i
++)
2415 Lisp_Object idx
= make_number (i
);
2416 SUBSTITUTE (Faref (subtree
, idx
),
2417 Faset (subtree
, idx
, true_value
));
2424 SUBSTITUTE (Fcar_safe (subtree
),
2425 Fsetcar (subtree
, true_value
));
2426 SUBSTITUTE (Fcdr_safe (subtree
),
2427 Fsetcdr (subtree
, true_value
));
2433 /* Check for text properties in each interval.
2434 substitute_in_interval contains part of the logic. */
2436 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2437 Lisp_Object arg
= Fcons (object
, placeholder
);
2439 traverse_intervals (root_interval
, 1, 0,
2440 &substitute_in_interval
, arg
);
2445 /* Other types don't recurse any further. */
2451 /* Helper function for substitute_object_recurse. */
2453 substitute_in_interval (interval
, arg
)
2457 Lisp_Object object
= Fcar (arg
);
2458 Lisp_Object placeholder
= Fcdr (arg
);
2460 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2479 if (*cp
== '+' || *cp
== '-')
2482 if (*cp
>= '0' && *cp
<= '9')
2485 while (*cp
>= '0' && *cp
<= '9')
2493 if (*cp
>= '0' && *cp
<= '9')
2496 while (*cp
>= '0' && *cp
<= '9')
2499 if (*cp
== 'e' || *cp
== 'E')
2503 if (*cp
== '+' || *cp
== '-')
2507 if (*cp
>= '0' && *cp
<= '9')
2510 while (*cp
>= '0' && *cp
<= '9')
2513 else if (cp
== start
)
2515 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2520 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2526 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2527 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2528 || state
== (DOT_CHAR
|TRAIL_INT
)
2529 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2530 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2531 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2536 read_vector (readcharfun
, bytecodeflag
)
2537 Lisp_Object readcharfun
;
2542 register Lisp_Object
*ptr
;
2543 register Lisp_Object tem
, item
, vector
;
2544 register struct Lisp_Cons
*otem
;
2547 tem
= read_list (1, readcharfun
);
2548 len
= Flength (tem
);
2549 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2551 size
= XVECTOR (vector
)->size
;
2552 ptr
= XVECTOR (vector
)->contents
;
2553 for (i
= 0; i
< size
; i
++)
2556 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2557 bytecode object, the docstring containing the bytecode and
2558 constants values must be treated as unibyte and passed to
2559 Fread, to get the actual bytecode string and constants vector. */
2560 if (bytecodeflag
&& load_force_doc_strings
)
2562 if (i
== COMPILED_BYTECODE
)
2564 if (!STRINGP (item
))
2565 error ("invalid byte code");
2567 /* Delay handling the bytecode slot until we know whether
2568 it is lazily-loaded (we can tell by whether the
2569 constants slot is nil). */
2570 ptr
[COMPILED_CONSTANTS
] = item
;
2573 else if (i
== COMPILED_CONSTANTS
)
2575 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2579 /* Coerce string to unibyte (like string-as-unibyte,
2580 but without generating extra garbage and
2581 guaranteeing no change in the contents). */
2582 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2583 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2585 item
= Fread (bytestr
);
2587 error ("invalid byte code");
2589 otem
= XCONS (item
);
2590 bytestr
= XCAR (item
);
2595 /* Now handle the bytecode slot. */
2596 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2599 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2607 /* FLAG = 1 means check for ] to terminate rather than ) and .
2608 FLAG = -1 means check for starting with defun
2609 and make structure pure. */
2612 read_list (flag
, readcharfun
)
2614 register Lisp_Object readcharfun
;
2616 /* -1 means check next element for defun,
2617 0 means don't check,
2618 1 means already checked and found defun. */
2619 int defunflag
= flag
< 0 ? -1 : 0;
2620 Lisp_Object val
, tail
;
2621 register Lisp_Object elt
, tem
;
2622 struct gcpro gcpro1
, gcpro2
;
2623 /* 0 is the normal case.
2624 1 means this list is a doc reference; replace it with the number 0.
2625 2 means this list is a doc reference; replace it with the doc string. */
2626 int doc_reference
= 0;
2628 /* Initialize this to 1 if we are reading a list. */
2629 int first_in_list
= flag
<= 0;
2638 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2643 /* While building, if the list starts with #$, treat it specially. */
2644 if (EQ (elt
, Vload_file_name
)
2646 && !NILP (Vpurify_flag
))
2648 if (NILP (Vdoc_file_name
))
2649 /* We have not yet called Snarf-documentation, so assume
2650 this file is described in the DOC-MM.NN file
2651 and Snarf-documentation will fill in the right value later.
2652 For now, replace the whole list with 0. */
2655 /* We have already called Snarf-documentation, so make a relative
2656 file name for this file, so it can be found properly
2657 in the installed Lisp directory.
2658 We don't use Fexpand_file_name because that would make
2659 the directory absolute now. */
2660 elt
= concat2 (build_string ("../lisp/"),
2661 Ffile_name_nondirectory (elt
));
2663 else if (EQ (elt
, Vload_file_name
)
2665 && load_force_doc_strings
)
2674 Fsignal (Qinvalid_read_syntax
,
2675 Fcons (make_string (") or . in a vector", 18), Qnil
));
2683 XCDR (tail
) = read0 (readcharfun
);
2685 val
= read0 (readcharfun
);
2686 read1 (readcharfun
, &ch
, 0);
2690 if (doc_reference
== 1)
2691 return make_number (0);
2692 if (doc_reference
== 2)
2694 /* Get a doc string from the file we are loading.
2695 If it's in saved_doc_string, get it from there. */
2696 int pos
= XINT (XCDR (val
));
2697 /* Position is negative for user variables. */
2698 if (pos
< 0) pos
= -pos
;
2699 if (pos
>= saved_doc_string_position
2700 && pos
< (saved_doc_string_position
2701 + saved_doc_string_length
))
2703 int start
= pos
- saved_doc_string_position
;
2706 /* Process quoting with ^A,
2707 and find the end of the string,
2708 which is marked with ^_ (037). */
2709 for (from
= start
, to
= start
;
2710 saved_doc_string
[from
] != 037;)
2712 int c
= saved_doc_string
[from
++];
2715 c
= saved_doc_string
[from
++];
2717 saved_doc_string
[to
++] = c
;
2719 saved_doc_string
[to
++] = 0;
2721 saved_doc_string
[to
++] = 037;
2724 saved_doc_string
[to
++] = c
;
2727 return make_string (saved_doc_string
+ start
,
2730 /* Look in prev_saved_doc_string the same way. */
2731 else if (pos
>= prev_saved_doc_string_position
2732 && pos
< (prev_saved_doc_string_position
2733 + prev_saved_doc_string_length
))
2735 int start
= pos
- prev_saved_doc_string_position
;
2738 /* Process quoting with ^A,
2739 and find the end of the string,
2740 which is marked with ^_ (037). */
2741 for (from
= start
, to
= start
;
2742 prev_saved_doc_string
[from
] != 037;)
2744 int c
= prev_saved_doc_string
[from
++];
2747 c
= prev_saved_doc_string
[from
++];
2749 prev_saved_doc_string
[to
++] = c
;
2751 prev_saved_doc_string
[to
++] = 0;
2753 prev_saved_doc_string
[to
++] = 037;
2756 prev_saved_doc_string
[to
++] = c
;
2759 return make_string (prev_saved_doc_string
+ start
,
2763 return get_doc_string (val
, 0, 0);
2768 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2770 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2772 tem
= (read_pure
&& flag
<= 0
2773 ? pure_cons (elt
, Qnil
)
2774 : Fcons (elt
, Qnil
));
2781 defunflag
= EQ (elt
, Qdefun
);
2782 else if (defunflag
> 0)
2787 Lisp_Object Vobarray
;
2788 Lisp_Object initial_obarray
;
2790 /* oblookup stores the bucket number here, for the sake of Funintern. */
2792 int oblookup_last_bucket_number
;
2794 static int hash_string ();
2795 Lisp_Object
oblookup ();
2797 /* Get an error if OBARRAY is not an obarray.
2798 If it is one, return it. */
2801 check_obarray (obarray
)
2802 Lisp_Object obarray
;
2804 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2806 /* If Vobarray is now invalid, force it to be valid. */
2807 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2809 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2814 /* Intern the C string STR: return a symbol with that name,
2815 interned in the current obarray. */
2822 int len
= strlen (str
);
2823 Lisp_Object obarray
;
2826 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2827 obarray
= check_obarray (obarray
);
2828 tem
= oblookup (obarray
, str
, len
, len
);
2831 return Fintern (make_string (str
, len
), obarray
);
2834 /* Create an uninterned symbol with name STR. */
2840 int len
= strlen (str
);
2842 return Fmake_symbol ((!NILP (Vpurify_flag
)
2843 ? make_pure_string (str
, len
, len
, 0)
2844 : make_string (str
, len
)));
2847 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2848 "Return the canonical symbol whose name is STRING.\n\
2849 If there is none, one is created by this function and returned.\n\
2850 A second optional argument specifies the obarray to use;\n\
2851 it defaults to the value of `obarray'.")
2853 Lisp_Object string
, obarray
;
2855 register Lisp_Object tem
, sym
, *ptr
;
2857 if (NILP (obarray
)) obarray
= Vobarray
;
2858 obarray
= check_obarray (obarray
);
2860 CHECK_STRING (string
, 0);
2862 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2863 XSTRING (string
)->size
,
2864 STRING_BYTES (XSTRING (string
)));
2865 if (!INTEGERP (tem
))
2868 if (!NILP (Vpurify_flag
))
2869 string
= Fpurecopy (string
);
2870 sym
= Fmake_symbol (string
);
2871 XSYMBOL (sym
)->obarray
= obarray
;
2873 if ((XSTRING (string
)->data
[0] == ':')
2874 && EQ (obarray
, initial_obarray
))
2875 XSYMBOL (sym
)->value
= sym
;
2877 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2879 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2881 XSYMBOL (sym
)->next
= 0;
2886 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2887 "Return the canonical symbol named NAME, or nil if none exists.\n\
2888 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2889 symbol is searched for.\n\
2890 A second optional argument specifies the obarray to use;\n\
2891 it defaults to the value of `obarray'.")
2893 Lisp_Object name
, obarray
;
2895 register Lisp_Object tem
;
2896 struct Lisp_String
*string
;
2898 if (NILP (obarray
)) obarray
= Vobarray
;
2899 obarray
= check_obarray (obarray
);
2901 if (!SYMBOLP (name
))
2903 CHECK_STRING (name
, 0);
2904 string
= XSTRING (name
);
2907 string
= XSYMBOL (name
)->name
;
2909 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2910 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2916 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2917 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2918 The value is t if a symbol was found and deleted, nil otherwise.\n\
2919 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2920 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2921 OBARRAY defaults to the value of the variable `obarray'.")
2923 Lisp_Object name
, obarray
;
2925 register Lisp_Object string
, tem
;
2928 if (NILP (obarray
)) obarray
= Vobarray
;
2929 obarray
= check_obarray (obarray
);
2932 XSETSTRING (string
, XSYMBOL (name
)->name
);
2935 CHECK_STRING (name
, 0);
2939 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2940 XSTRING (string
)->size
,
2941 STRING_BYTES (XSTRING (string
)));
2944 /* If arg was a symbol, don't delete anything but that symbol itself. */
2945 if (SYMBOLP (name
) && !EQ (name
, tem
))
2948 XSYMBOL (tem
)->obarray
= Qnil
;
2950 hash
= oblookup_last_bucket_number
;
2952 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2954 if (XSYMBOL (tem
)->next
)
2955 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2957 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2961 Lisp_Object tail
, following
;
2963 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2964 XSYMBOL (tail
)->next
;
2967 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2968 if (EQ (following
, tem
))
2970 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2979 /* Return the symbol in OBARRAY whose names matches the string
2980 of SIZE characters (SIZE_BYTE bytes) at PTR.
2981 If there is no such symbol in OBARRAY, return nil.
2983 Also store the bucket number in oblookup_last_bucket_number. */
2986 oblookup (obarray
, ptr
, size
, size_byte
)
2987 Lisp_Object obarray
;
2989 int size
, size_byte
;
2993 register Lisp_Object tail
;
2994 Lisp_Object bucket
, tem
;
2996 if (!VECTORP (obarray
)
2997 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2999 obarray
= check_obarray (obarray
);
3000 obsize
= XVECTOR (obarray
)->size
;
3002 /* This is sometimes needed in the middle of GC. */
3003 obsize
&= ~ARRAY_MARK_FLAG
;
3004 /* Combining next two lines breaks VMS C 2.3. */
3005 hash
= hash_string (ptr
, size_byte
);
3007 bucket
= XVECTOR (obarray
)->contents
[hash
];
3008 oblookup_last_bucket_number
= hash
;
3009 if (XFASTINT (bucket
) == 0)
3011 else if (!SYMBOLP (bucket
))
3012 error ("Bad data in guts of obarray"); /* Like CADR error message */
3014 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3016 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3017 && XSYMBOL (tail
)->name
->size
== size
3018 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3020 else if (XSYMBOL (tail
)->next
== 0)
3023 XSETINT (tem
, hash
);
3028 hash_string (ptr
, len
)
3032 register unsigned char *p
= ptr
;
3033 register unsigned char *end
= p
+ len
;
3034 register unsigned char c
;
3035 register int hash
= 0;
3040 if (c
>= 0140) c
-= 40;
3041 hash
= ((hash
<<3) + (hash
>>28) + c
);
3043 return hash
& 07777777777;
3047 map_obarray (obarray
, fn
, arg
)
3048 Lisp_Object obarray
;
3049 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3053 register Lisp_Object tail
;
3054 CHECK_VECTOR (obarray
, 1);
3055 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3057 tail
= XVECTOR (obarray
)->contents
[i
];
3062 if (XSYMBOL (tail
)->next
== 0)
3064 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3070 mapatoms_1 (sym
, function
)
3071 Lisp_Object sym
, function
;
3073 call1 (function
, sym
);
3076 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3077 "Call FUNCTION on every symbol in OBARRAY.\n\
3078 OBARRAY defaults to the value of `obarray'.")
3080 Lisp_Object function
, obarray
;
3082 if (NILP (obarray
)) obarray
= Vobarray
;
3083 obarray
= check_obarray (obarray
);
3085 map_obarray (obarray
, mapatoms_1
, function
);
3089 #define OBARRAY_SIZE 1511
3094 Lisp_Object oblength
;
3098 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3100 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3101 Vobarray
= Fmake_vector (oblength
, make_number (0));
3102 initial_obarray
= Vobarray
;
3103 staticpro (&initial_obarray
);
3104 /* Intern nil in the obarray */
3105 XSYMBOL (Qnil
)->obarray
= Vobarray
;
3106 /* These locals are to kludge around a pyramid compiler bug. */
3107 hash
= hash_string ("nil", 3);
3108 /* Separate statement here to avoid VAXC bug. */
3109 hash
%= OBARRAY_SIZE
;
3110 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3113 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3114 XSYMBOL (Qnil
)->function
= Qunbound
;
3115 XSYMBOL (Qunbound
)->value
= Qunbound
;
3116 XSYMBOL (Qunbound
)->function
= Qunbound
;
3119 XSYMBOL (Qnil
)->value
= Qnil
;
3120 XSYMBOL (Qnil
)->plist
= Qnil
;
3121 XSYMBOL (Qt
)->value
= Qt
;
3123 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3126 Qvariable_documentation
= intern ("variable-documentation");
3127 staticpro (&Qvariable_documentation
);
3129 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3130 read_buffer
= (char *) xmalloc (read_buffer_size
);
3135 struct Lisp_Subr
*sname
;
3138 sym
= intern (sname
->symbol_name
);
3139 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3142 #ifdef NOTDEF /* use fset in subr.el now */
3144 defalias (sname
, string
)
3145 struct Lisp_Subr
*sname
;
3149 sym
= intern (string
);
3150 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3154 /* Define an "integer variable"; a symbol whose value is forwarded
3155 to a C variable of type int. Sample call: */
3156 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3158 defvar_int (namestring
, address
)
3162 Lisp_Object sym
, val
;
3163 sym
= intern (namestring
);
3164 val
= allocate_misc ();
3165 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3166 XINTFWD (val
)->intvar
= address
;
3167 XSYMBOL (sym
)->value
= val
;
3170 /* Similar but define a variable whose value is T if address contains 1,
3171 NIL if address contains 0 */
3173 defvar_bool (namestring
, address
)
3177 Lisp_Object sym
, val
;
3178 sym
= intern (namestring
);
3179 val
= allocate_misc ();
3180 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3181 XBOOLFWD (val
)->boolvar
= address
;
3182 XSYMBOL (sym
)->value
= val
;
3183 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3186 /* Similar but define a variable whose value is the Lisp Object stored
3187 at address. Two versions: with and without gc-marking of the C
3188 variable. The nopro version is used when that variable will be
3189 gc-marked for some other reason, since marking the same slot twice
3190 can cause trouble with strings. */
3192 defvar_lisp_nopro (namestring
, address
)
3194 Lisp_Object
*address
;
3196 Lisp_Object sym
, val
;
3197 sym
= intern (namestring
);
3198 val
= allocate_misc ();
3199 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3200 XOBJFWD (val
)->objvar
= address
;
3201 XSYMBOL (sym
)->value
= val
;
3205 defvar_lisp (namestring
, address
)
3207 Lisp_Object
*address
;
3209 defvar_lisp_nopro (namestring
, address
);
3210 staticpro (address
);
3213 /* Similar but define a variable whose value is the Lisp Object stored in
3214 the current buffer. address is the address of the slot in the buffer
3215 that is current now. */
3218 defvar_per_buffer (namestring
, address
, type
, doc
)
3220 Lisp_Object
*address
;
3224 Lisp_Object sym
, val
;
3226 extern struct buffer buffer_local_symbols
;
3228 sym
= intern (namestring
);
3229 val
= allocate_misc ();
3230 offset
= (char *)address
- (char *)current_buffer
;
3232 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3233 XBUFFER_OBJFWD (val
)->offset
= offset
;
3234 XSYMBOL (sym
)->value
= val
;
3235 PER_BUFFER_SYMBOL (offset
) = sym
;
3236 PER_BUFFER_TYPE (offset
) = type
;
3238 if (PER_BUFFER_IDX (offset
) == 0)
3239 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3240 slot of buffer_local_flags */
3245 /* Similar but define a variable whose value is the Lisp Object stored
3246 at a particular offset in the current kboard object. */
3249 defvar_kboard (namestring
, offset
)
3253 Lisp_Object sym
, val
;
3254 sym
= intern (namestring
);
3255 val
= allocate_misc ();
3256 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3257 XKBOARD_OBJFWD (val
)->offset
= offset
;
3258 XSYMBOL (sym
)->value
= val
;
3261 /* Record the value of load-path used at the start of dumping
3262 so we can see if the site changed it later during dumping. */
3263 static Lisp_Object dump_path
;
3269 int turn_off_warning
= 0;
3271 /* Compute the default load-path. */
3273 normal
= PATH_LOADSEARCH
;
3274 Vload_path
= decode_env_path (0, normal
);
3276 if (NILP (Vpurify_flag
))
3277 normal
= PATH_LOADSEARCH
;
3279 normal
= PATH_DUMPLOADSEARCH
;
3281 /* In a dumped Emacs, we normally have to reset the value of
3282 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3283 uses ../lisp, instead of the path of the installed elisp
3284 libraries. However, if it appears that Vload_path was changed
3285 from the default before dumping, don't override that value. */
3288 if (! NILP (Fequal (dump_path
, Vload_path
)))
3290 Vload_path
= decode_env_path (0, normal
);
3291 if (!NILP (Vinstallation_directory
))
3293 /* Add to the path the lisp subdir of the
3294 installation dir, if it exists. */
3295 Lisp_Object tem
, tem1
;
3296 tem
= Fexpand_file_name (build_string ("lisp"),
3297 Vinstallation_directory
);
3298 tem1
= Ffile_exists_p (tem
);
3301 if (NILP (Fmember (tem
, Vload_path
)))
3303 turn_off_warning
= 1;
3304 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3308 /* That dir doesn't exist, so add the build-time
3309 Lisp dirs instead. */
3310 Vload_path
= nconc2 (Vload_path
, dump_path
);
3312 /* Add leim under the installation dir, if it exists. */
3313 tem
= Fexpand_file_name (build_string ("leim"),
3314 Vinstallation_directory
);
3315 tem1
= Ffile_exists_p (tem
);
3318 if (NILP (Fmember (tem
, Vload_path
)))
3319 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3322 /* Add site-list under the installation dir, if it exists. */
3323 tem
= Fexpand_file_name (build_string ("site-lisp"),
3324 Vinstallation_directory
);
3325 tem1
= Ffile_exists_p (tem
);
3328 if (NILP (Fmember (tem
, Vload_path
)))
3329 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3332 /* If Emacs was not built in the source directory,
3333 and it is run from where it was built, add to load-path
3334 the lisp, leim and site-lisp dirs under that directory. */
3336 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3340 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3341 Vinstallation_directory
);
3342 tem1
= Ffile_exists_p (tem
);
3344 /* Don't be fooled if they moved the entire source tree
3345 AFTER dumping Emacs. If the build directory is indeed
3346 different from the source dir, src/Makefile.in and
3347 src/Makefile will not be found together. */
3348 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3349 Vinstallation_directory
);
3350 tem2
= Ffile_exists_p (tem
);
3351 if (!NILP (tem1
) && NILP (tem2
))
3353 tem
= Fexpand_file_name (build_string ("lisp"),
3356 if (NILP (Fmember (tem
, Vload_path
)))
3357 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3359 tem
= Fexpand_file_name (build_string ("leim"),
3362 if (NILP (Fmember (tem
, Vload_path
)))
3363 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3365 tem
= Fexpand_file_name (build_string ("site-lisp"),
3368 if (NILP (Fmember (tem
, Vload_path
)))
3369 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3377 /* NORMAL refers to the lisp dir in the source directory. */
3378 /* We used to add ../lisp at the front here, but
3379 that caused trouble because it was copied from dump_path
3380 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3381 It should be unnecessary. */
3382 Vload_path
= decode_env_path (0, normal
);
3383 dump_path
= Vload_path
;
3388 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3389 almost never correct, thereby causing a warning to be printed out that
3390 confuses users. Since PATH_LOADSEARCH is always overridden by the
3391 EMACSLOADPATH environment variable below, disable the warning on NT. */
3393 /* Warn if dirs in the *standard* path don't exist. */
3394 if (!turn_off_warning
)
3396 Lisp_Object path_tail
;
3398 for (path_tail
= Vload_path
;
3400 path_tail
= XCDR (path_tail
))
3402 Lisp_Object dirfile
;
3403 dirfile
= Fcar (path_tail
);
3404 if (STRINGP (dirfile
))
3406 dirfile
= Fdirectory_file_name (dirfile
);
3407 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3408 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3413 #endif /* WINDOWSNT */
3415 /* If the EMACSLOADPATH environment variable is set, use its value.
3416 This doesn't apply if we're dumping. */
3418 if (NILP (Vpurify_flag
)
3419 && egetenv ("EMACSLOADPATH"))
3421 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3425 load_in_progress
= 0;
3426 Vload_file_name
= Qnil
;
3428 load_descriptor_list
= Qnil
;
3430 Vstandard_input
= Qt
;
3433 /* Print a warning, using format string FORMAT, that directory DIRNAME
3434 does not exist. Print it on stderr and put it in *Message*. */
3437 dir_warning (format
, dirname
)
3439 Lisp_Object dirname
;
3442 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3444 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3445 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3446 /* Don't log the warning before we've initialized!! */
3448 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3455 defsubr (&Sread_from_string
);
3457 defsubr (&Sintern_soft
);
3458 defsubr (&Sunintern
);
3460 defsubr (&Seval_buffer
);
3461 defsubr (&Seval_region
);
3462 defsubr (&Sread_char
);
3463 defsubr (&Sread_char_exclusive
);
3464 defsubr (&Sread_event
);
3465 defsubr (&Sget_file_char
);
3466 defsubr (&Smapatoms
);
3468 DEFVAR_LISP ("obarray", &Vobarray
,
3469 "Symbol table for use by `intern' and `read'.\n\
3470 It is a vector whose length ought to be prime for best results.\n\
3471 The vector's contents don't make sense if examined from Lisp programs;\n\
3472 to find all the symbols in an obarray, use `mapatoms'.");
3474 DEFVAR_LISP ("values", &Vvalues
,
3475 "List of values of all expressions which were read, evaluated and printed.\n\
3476 Order is reverse chronological.");
3478 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3479 "Stream for read to get input from.\n\
3480 See documentation of `read' for possible values.");
3481 Vstandard_input
= Qt
;
3483 DEFVAR_LISP ("load-path", &Vload_path
,
3484 "*List of directories to search for files to load.\n\
3485 Each element is a string (directory name) or nil (try default directory).\n\
3486 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3487 otherwise to default specified by file `epaths.h' when Emacs was built.");
3489 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3490 "Non-nil iff inside of `load'.");
3492 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3493 "An alist of expressions to be evalled when particular files are loaded.\n\
3494 Each element looks like (FILENAME FORMS...).\n\
3495 When `load' is run and the file-name argument is FILENAME,\n\
3496 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3497 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3498 with no directory specified, since that is how `load' is normally called.\n\
3499 An error in FORMS does not undo the load,\n\
3500 but does prevent execution of the rest of the FORMS.");
3501 Vafter_load_alist
= Qnil
;
3503 DEFVAR_LISP ("load-history", &Vload_history
,
3504 "Alist mapping source file names to symbols and features.\n\
3505 Each alist element is a list that starts with a file name,\n\
3506 except for one element (optional) that starts with nil and describes\n\
3507 definitions evaluated from buffers not visiting files.\n\
3508 The remaining elements of each list are symbols defined as functions\n\
3509 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
3510 and `(autoload . SYMBOL)'.");
3511 Vload_history
= Qnil
;
3513 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3514 "Full name of file being loaded by `load'.");
3515 Vload_file_name
= Qnil
;
3517 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3518 "File name, including directory, of user's initialization file.\n\
3519 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3520 file, this variable contains the name of the .el file, suitable for use\n\
3521 by functions like `custom-save-all' which edit the init file.");
3522 Vuser_init_file
= Qnil
;
3524 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3525 "Used for internal purposes by `load'.");
3526 Vcurrent_load_list
= Qnil
;
3528 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3529 "Function used by `load' and `eval-region' for reading expressions.\n\
3530 The default is nil, which means use the function `read'.");
3531 Vload_read_function
= Qnil
;
3533 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3534 "Function called in `load' for loading an Emacs lisp source file.\n\
3535 This function is for doing code conversion before reading the source file.\n\
3536 If nil, loading is done without any code conversion.\n\
3537 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3538 FULLNAME is the full name of FILE.\n\
3539 See `load' for the meaning of the remaining arguments.");
3540 Vload_source_file_function
= Qnil
;
3542 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3543 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3544 This is useful when the file being loaded is a temporary copy.");
3545 load_force_doc_strings
= 0;
3547 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3548 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3549 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3550 and is not meant for users to change.");
3551 load_convert_to_unibyte
= 0;
3553 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3554 "Directory in which Emacs sources were found when Emacs was built.\n\
3555 You cannot count on them to still be there!");
3557 = Fexpand_file_name (build_string ("../"),
3558 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3560 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3561 "List of files that were preloaded (when dumping Emacs).");
3562 Vpreloaded_file_list
= Qnil
;
3564 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3565 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3566 Vbyte_boolean_vars
= Qnil
;
3568 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3569 "Non-nil means load dangerous compiled Lisp files.\n\
3570 Some versions of XEmacs use different byte codes than Emacs. These\n\
3571 incompatible byte codes can make Emacs crash when it tries to execute\n\
3573 load_dangerous_libraries
= 0;
3575 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3576 "Regular expression matching safe to load compiled Lisp files.\n\
3577 When Emacs loads a compiled Lisp file, it reads the first 512 bytes\n\
3578 from the file, and matches them against this regular expression.\n\
3579 When the regular expression matches, the file is considered to be safe\n\
3580 to load. See also `load-dangerous-libraries'.");
3581 Vbytecomp_version_regexp
3582 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3584 /* Vsource_directory was initialized in init_lread. */
3586 load_descriptor_list
= Qnil
;
3587 staticpro (&load_descriptor_list
);
3589 Qcurrent_load_list
= intern ("current-load-list");
3590 staticpro (&Qcurrent_load_list
);
3592 Qstandard_input
= intern ("standard-input");
3593 staticpro (&Qstandard_input
);
3595 Qread_char
= intern ("read-char");
3596 staticpro (&Qread_char
);
3598 Qget_file_char
= intern ("get-file-char");
3599 staticpro (&Qget_file_char
);
3601 Qbackquote
= intern ("`");
3602 staticpro (&Qbackquote
);
3603 Qcomma
= intern (",");
3604 staticpro (&Qcomma
);
3605 Qcomma_at
= intern (",@");
3606 staticpro (&Qcomma_at
);
3607 Qcomma_dot
= intern (",.");
3608 staticpro (&Qcomma_dot
);
3610 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3611 staticpro (&Qinhibit_file_name_operation
);
3613 Qascii_character
= intern ("ascii-character");
3614 staticpro (&Qascii_character
);
3616 Qfunction
= intern ("function");
3617 staticpro (&Qfunction
);
3619 Qload
= intern ("load");
3622 Qload_file_name
= intern ("load-file-name");
3623 staticpro (&Qload_file_name
);
3625 staticpro (&dump_path
);
3627 staticpro (&read_objects
);
3628 read_objects
= Qnil
;
3629 staticpro (&seen_list
);
3631 Vloads_in_progress
= Qnil
;
3632 staticpro (&Vloads_in_progress
);