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 #if 0 /* This is a good idea, but it doesn't quite work.
712 While compiling files, `provide's seem to not be evaluated.
713 Let's come back to this when there's more time. */
715 /* Check if we're loading this file again while another load
716 of the same file is already in progress. */
717 if (!NILP (Fmember (found
, Vloads_in_progress
)))
718 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
719 Fcons (found
, Vloads_in_progress
)));
720 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
721 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
724 /* Load .elc files directly, but not when they are
725 remote and have no handler! */
726 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
733 if (!safe_to_load_p (fd
))
736 if (!load_dangerous_libraries
)
737 error ("File `%s' was not compiled in Emacs",
738 XSTRING (found
)->data
);
739 else if (!NILP (nomessage
))
740 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
748 stat ((char *)XSTRING (found
)->data
, &s1
);
749 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
750 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
751 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
753 /* Make the progress messages mention that source is newer. */
756 /* If we won't print another message, mention this anyway. */
757 if (! NILP (nomessage
))
758 message_with_string ("Source file `%s' newer than byte-compiled file",
761 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
767 /* We are loading a source file (*.el). */
768 if (!NILP (Vload_source_file_function
))
774 val
= call4 (Vload_source_file_function
, found
, file
,
775 NILP (noerror
) ? Qnil
: Qt
,
776 NILP (nomessage
) ? Qnil
: Qt
);
777 return unbind_to (count
, val
);
783 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
784 #else /* not WINDOWSNT */
785 stream
= fdopen (fd
, fmode
);
786 #endif /* not WINDOWSNT */
790 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
793 if (! NILP (Vpurify_flag
))
794 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
796 if (NILP (nomessage
))
799 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
802 message_with_string ("Loading %s (source)...", file
, 1);
804 message_with_string ("Loading %s (compiled; note, source file is newer)...",
806 else /* The typical case; compiled file newer than source file. */
807 message_with_string ("Loading %s...", file
, 1);
811 lispstream
= Fcons (Qnil
, Qnil
);
812 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
813 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
814 record_unwind_protect (load_unwind
, lispstream
);
815 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
816 specbind (Qload_file_name
, found
);
817 specbind (Qinhibit_file_name_operation
, Qnil
);
819 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
821 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
822 unbind_to (count
, Qnil
);
824 /* Run any load-hooks for this file. */
825 temp
= Fassoc (file
, Vafter_load_alist
);
827 Fprogn (Fcdr (temp
));
830 if (saved_doc_string
)
831 free (saved_doc_string
);
832 saved_doc_string
= 0;
833 saved_doc_string_size
= 0;
835 if (prev_saved_doc_string
)
836 xfree (prev_saved_doc_string
);
837 prev_saved_doc_string
= 0;
838 prev_saved_doc_string_size
= 0;
840 if (!noninteractive
&& NILP (nomessage
))
843 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
846 message_with_string ("Loading %s (source)...done", file
, 1);
848 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
850 else /* The typical case; compiled file newer than source file. */
851 message_with_string ("Loading %s...done", file
, 1);
858 load_unwind (stream
) /* used as unwind-protect function in load */
861 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
862 | XFASTINT (XCDR (stream
))));
863 if (--load_in_progress
< 0) load_in_progress
= 0;
868 load_descriptor_unwind (oldlist
)
871 load_descriptor_list
= oldlist
;
875 /* Close all descriptors in use for Floads.
876 This is used when starting a subprocess. */
883 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
884 emacs_close (XFASTINT (XCAR (tail
)));
889 complete_filename_p (pathname
)
890 Lisp_Object pathname
;
892 register unsigned char *s
= XSTRING (pathname
)->data
;
893 return (IS_DIRECTORY_SEP (s
[0])
894 || (XSTRING (pathname
)->size
> 2
895 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
905 /* Search for a file whose name is STR, looking in directories
906 in the Lisp list PATH, and trying suffixes from SUFFIX.
907 SUFFIX is a string containing possible suffixes separated by colons.
908 On success, returns a file descriptor. On failure, returns -1.
910 EXEC_ONLY nonzero means don't open the files,
911 just look for one that is executable. In this case,
912 returns 1 on success.
914 If STOREPTR is nonzero, it points to a slot where the name of
915 the file actually found should be stored as a Lisp string.
916 nil is stored there on failure.
918 If the file we find is remote, return 0
919 but store the found remote file name in *STOREPTR.
920 We do not check for remote files if EXEC_ONLY is nonzero. */
923 openp (path
, str
, suffix
, storeptr
, exec_only
)
924 Lisp_Object path
, str
;
926 Lisp_Object
*storeptr
;
932 register char *fn
= buf
;
935 Lisp_Object filename
;
937 struct gcpro gcpro1
, gcpro2
, gcpro3
;
940 string
= filename
= Qnil
;
941 GCPRO3 (str
, string
, filename
);
946 if (complete_filename_p (str
))
949 for (; !NILP (path
); path
= Fcdr (path
))
953 filename
= Fexpand_file_name (str
, Fcar (path
));
954 if (!complete_filename_p (filename
))
955 /* If there are non-absolute elts in PATH (eg ".") */
956 /* Of course, this could conceivably lose if luser sets
957 default-directory to be something non-absolute... */
959 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
960 if (!complete_filename_p (filename
))
961 /* Give up on this path element! */
965 /* Calculate maximum size of any filename made from
966 this path element/specified file name and any possible suffix. */
967 want_size
= strlen (suffix
) + STRING_BYTES (XSTRING (filename
)) + 1;
968 if (fn_size
< want_size
)
969 fn
= (char *) alloca (fn_size
= 100 + want_size
);
973 /* Loop over suffixes. */
976 char *esuffix
= (char *) index (nsuffix
, ':');
977 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
980 /* Concatenate path element/specified name with the suffix.
981 If the directory starts with /:, remove that. */
982 if (XSTRING (filename
)->size
> 2
983 && XSTRING (filename
)->data
[0] == '/'
984 && XSTRING (filename
)->data
[1] == ':')
986 strncpy (fn
, XSTRING (filename
)->data
+ 2,
987 STRING_BYTES (XSTRING (filename
)) - 2);
988 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
992 strncpy (fn
, XSTRING (filename
)->data
,
993 STRING_BYTES (XSTRING (filename
)));
994 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
997 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
998 strncat (fn
, nsuffix
, lsuffix
);
1000 /* Check that the file exists and is not a directory. */
1004 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1005 if (! NILP (handler
) && ! exec_only
)
1009 string
= build_string (fn
);
1010 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
1011 : Ffile_readable_p (string
));
1013 && ! NILP (Ffile_directory_p (build_string (fn
))))
1018 /* We succeeded; return this descriptor and filename. */
1020 *storeptr
= build_string (fn
);
1027 int exists
= (stat (fn
, &st
) >= 0
1028 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1031 /* Check that we can access or open it. */
1033 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1035 fd
= emacs_open (fn
, O_RDONLY
, 0);
1039 /* We succeeded; return this descriptor and filename. */
1041 *storeptr
= build_string (fn
);
1048 /* Advance to next suffix. */
1051 nsuffix
+= lsuffix
+ 1;
1062 /* Merge the list we've accumulated of globals from the current input source
1063 into the load_history variable. The details depend on whether
1064 the source has an associated file name or not. */
1067 build_load_history (stream
, source
)
1071 register Lisp_Object tail
, prev
, newelt
;
1072 register Lisp_Object tem
, tem2
;
1073 register int foundit
, loading
;
1075 loading
= stream
|| !NARROWED
;
1077 tail
= Vload_history
;
1080 while (!NILP (tail
))
1084 /* Find the feature's previous assoc list... */
1085 if (!NILP (Fequal (source
, Fcar (tem
))))
1089 /* If we're loading, remove it. */
1093 Vload_history
= Fcdr (tail
);
1095 Fsetcdr (prev
, Fcdr (tail
));
1098 /* Otherwise, cons on new symbols that are not already members. */
1101 tem2
= Vcurrent_load_list
;
1103 while (CONSP (tem2
))
1105 newelt
= Fcar (tem2
);
1107 if (NILP (Fmemq (newelt
, tem
)))
1108 Fsetcar (tail
, Fcons (Fcar (tem
),
1109 Fcons (newelt
, Fcdr (tem
))));
1122 /* If we're loading, cons the new assoc onto the front of load-history,
1123 the most-recently-loaded position. Also do this if we didn't find
1124 an existing member for the current source. */
1125 if (loading
|| !foundit
)
1126 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1131 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1139 readevalloop_1 (old
)
1142 load_convert_to_unibyte
= ! NILP (old
);
1146 /* Signal an `end-of-file' error, if possible with file name
1150 end_of_file_error ()
1154 if (STRINGP (Vload_file_name
))
1155 data
= Fcons (Vload_file_name
, Qnil
);
1159 Fsignal (Qend_of_file
, data
);
1162 /* UNIBYTE specifies how to set load_convert_to_unibyte
1163 for this invocation.
1164 READFUN, if non-nil, is used instead of `read'. */
1167 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1168 Lisp_Object readcharfun
;
1170 Lisp_Object sourcename
;
1171 Lisp_Object (*evalfun
) ();
1173 Lisp_Object unibyte
, readfun
;
1176 register Lisp_Object val
;
1177 int count
= specpdl_ptr
- specpdl
;
1178 struct gcpro gcpro1
;
1179 struct buffer
*b
= 0;
1180 int continue_reading_p
;
1182 if (BUFFERP (readcharfun
))
1183 b
= XBUFFER (readcharfun
);
1184 else if (MARKERP (readcharfun
))
1185 b
= XMARKER (readcharfun
)->buffer
;
1187 specbind (Qstandard_input
, readcharfun
);
1188 specbind (Qcurrent_load_list
, Qnil
);
1189 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1190 load_convert_to_unibyte
= !NILP (unibyte
);
1192 readchar_backlog
= -1;
1194 GCPRO1 (sourcename
);
1196 LOADHIST_ATTACH (sourcename
);
1198 continue_reading_p
= 1;
1199 while (continue_reading_p
)
1201 if (b
!= 0 && NILP (b
->name
))
1202 error ("Reading from killed buffer");
1208 while ((c
= READCHAR
) != '\n' && c
!= -1);
1213 /* Ignore whitespace here, so we can detect eof. */
1214 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1217 if (!NILP (Vpurify_flag
) && c
== '(')
1219 int count1
= specpdl_ptr
- specpdl
;
1220 record_unwind_protect (unreadpure
, Qnil
);
1221 val
= read_list (-1, readcharfun
);
1222 unbind_to (count1
, Qnil
);
1227 read_objects
= Qnil
;
1228 if (!NILP (readfun
))
1230 val
= call1 (readfun
, readcharfun
);
1232 /* If READCHARFUN has set point to ZV, we should
1233 stop reading, even if the form read sets point
1234 to a different value when evaluated. */
1235 if (BUFFERP (readcharfun
))
1237 struct buffer
*b
= XBUFFER (readcharfun
);
1238 if (BUF_PT (b
) == BUF_ZV (b
))
1239 continue_reading_p
= 0;
1242 else if (! NILP (Vload_read_function
))
1243 val
= call1 (Vload_read_function
, readcharfun
);
1245 val
= read0 (readcharfun
);
1248 val
= (*evalfun
) (val
);
1252 Vvalues
= Fcons (val
, Vvalues
);
1253 if (EQ (Vstandard_output
, Qt
))
1260 build_load_history (stream
, sourcename
);
1263 unbind_to (count
, Qnil
);
1266 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1267 "Execute the current buffer as Lisp code.\n\
1268 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1269 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1270 PRINTFLAG controls printing of output:\n\
1271 nil means discard it; anything else is stream for print.\n\
1273 If the optional third argument FILENAME is non-nil,\n\
1274 it specifies the file name to use for `load-history'.\n\
1275 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\
1276 for this invocation.\n\
1278 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\
1279 `print' and related functions should work normally even if PRINTFLAG is nil.\n\
1281 This function preserves the position of point.")
1282 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1283 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1285 int count
= specpdl_ptr
- specpdl
;
1286 Lisp_Object tem
, buf
;
1289 buf
= Fcurrent_buffer ();
1291 buf
= Fget_buffer (buffer
);
1293 error ("No such buffer");
1295 if (NILP (printflag
) && NILP (do_allow_print
))
1300 if (NILP (filename
))
1301 filename
= XBUFFER (buf
)->filename
;
1303 specbind (Qstandard_output
, tem
);
1304 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1305 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1306 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1307 unbind_to (count
, Qnil
);
1313 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1314 "Execute the current buffer as Lisp code.\n\
1315 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1316 nil means discard it; anything else is stream for print.\n\
1318 If there is no error, point does not move. If there is an error,\n\
1319 point remains at the end of the last character read from the buffer.")
1321 Lisp_Object printflag
;
1323 int count
= specpdl_ptr
- specpdl
;
1324 Lisp_Object tem
, cbuf
;
1326 cbuf
= Fcurrent_buffer ()
1328 if (NILP (printflag
))
1332 specbind (Qstandard_output
, tem
);
1333 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1335 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1336 !NILP (printflag
), Qnil
, Qnil
);
1337 return unbind_to (count
, Qnil
);
1341 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1342 "Execute the region as Lisp code.\n\
1343 When called from programs, expects two arguments,\n\
1344 giving starting and ending indices in the current buffer\n\
1345 of the text to be executed.\n\
1346 Programs can pass third argument PRINTFLAG which controls output:\n\
1347 nil means discard it; anything else is stream for printing it.\n\
1348 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1349 instead of `read' to read each expression. It gets one argument\n\
1350 which is the input stream for reading characters.\n\
1352 This function does not move point.")
1353 (start
, end
, printflag
, read_function
)
1354 Lisp_Object start
, end
, printflag
, read_function
;
1356 int count
= specpdl_ptr
- specpdl
;
1357 Lisp_Object tem
, cbuf
;
1359 cbuf
= Fcurrent_buffer ();
1361 if (NILP (printflag
))
1365 specbind (Qstandard_output
, tem
);
1367 if (NILP (printflag
))
1368 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1369 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1371 /* This both uses start and checks its type. */
1373 Fnarrow_to_region (make_number (BEGV
), end
);
1374 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1375 !NILP (printflag
), Qnil
, read_function
);
1377 return unbind_to (count
, Qnil
);
1381 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1382 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1383 If STREAM is nil, use the value of `standard-input' (which see).\n\
1384 STREAM or the value of `standard-input' may be:\n\
1385 a buffer (read from point and advance it)\n\
1386 a marker (read from where it points and advance it)\n\
1387 a function (call it with no arguments for each character,\n\
1388 call it with a char as argument to push a char back)\n\
1389 a string (takes text from string, starting at the beginning)\n\
1390 t (read text line using minibuffer and use it, or read from\n\
1391 standard input in batch mode).")
1395 extern Lisp_Object
Fread_minibuffer ();
1398 stream
= Vstandard_input
;
1399 if (EQ (stream
, Qt
))
1400 stream
= Qread_char
;
1402 readchar_backlog
= -1;
1403 new_backquote_flag
= 0;
1404 read_objects
= Qnil
;
1406 if (EQ (stream
, Qread_char
))
1407 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1409 if (STRINGP (stream
))
1410 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1412 return read0 (stream
);
1415 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1416 "Read one Lisp expression which is represented as text by STRING.\n\
1417 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1418 START and END optionally delimit a substring of STRING from which to read;\n\
1419 they default to 0 and (length STRING) respectively.")
1420 (string
, start
, end
)
1421 Lisp_Object string
, start
, end
;
1423 int startval
, endval
;
1426 CHECK_STRING (string
,0);
1429 endval
= XSTRING (string
)->size
;
1432 CHECK_NUMBER (end
, 2);
1433 endval
= XINT (end
);
1434 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1435 args_out_of_range (string
, end
);
1442 CHECK_NUMBER (start
, 1);
1443 startval
= XINT (start
);
1444 if (startval
< 0 || startval
> endval
)
1445 args_out_of_range (string
, start
);
1448 read_from_string_index
= startval
;
1449 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1450 read_from_string_limit
= endval
;
1452 new_backquote_flag
= 0;
1453 read_objects
= Qnil
;
1455 tem
= read0 (string
);
1456 return Fcons (tem
, make_number (read_from_string_index
));
1459 /* Use this for recursive reads, in contexts where internal tokens
1464 Lisp_Object readcharfun
;
1466 register Lisp_Object val
;
1469 val
= read1 (readcharfun
, &c
, 0);
1471 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1478 static int read_buffer_size
;
1479 static char *read_buffer
;
1481 /* Read multibyte form and return it as a character. C is a first
1482 byte of multibyte form, and rest of them are read from
1486 read_multibyte (c
, readcharfun
)
1488 Lisp_Object readcharfun
;
1490 /* We need the actual character code of this multibyte
1492 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1496 while ((c
= READCHAR
) >= 0xA0
1497 && len
< MAX_MULTIBYTE_LENGTH
)
1500 return STRING_CHAR (str
, len
);
1503 /* Read a \-escape sequence, assuming we already read the `\'. */
1506 read_escape (readcharfun
, stringp
)
1507 Lisp_Object readcharfun
;
1510 register int c
= READCHAR
;
1514 error ("End of file");
1544 error ("Invalid escape character syntax");
1547 c
= read_escape (readcharfun
, 0);
1548 return c
| meta_modifier
;
1553 error ("Invalid escape character syntax");
1556 c
= read_escape (readcharfun
, 0);
1557 return c
| shift_modifier
;
1562 error ("Invalid escape character syntax");
1565 c
= read_escape (readcharfun
, 0);
1566 return c
| hyper_modifier
;
1571 error ("Invalid escape character syntax");
1574 c
= read_escape (readcharfun
, 0);
1575 return c
| alt_modifier
;
1580 error ("Invalid escape character syntax");
1583 c
= read_escape (readcharfun
, 0);
1584 return c
| super_modifier
;
1589 error ("Invalid escape character syntax");
1593 c
= read_escape (readcharfun
, 0);
1594 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1595 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1596 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1597 return c
| ctrl_modifier
;
1598 /* ASCII control chars are made from letters (both cases),
1599 as well as the non-letters within 0100...0137. */
1600 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1601 return (c
& (037 | ~0177));
1602 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1603 return (c
& (037 | ~0177));
1605 return c
| ctrl_modifier
;
1615 /* An octal escape, as in ANSI C. */
1617 register int i
= c
- '0';
1618 register int count
= 0;
1621 if ((c
= READCHAR
) >= '0' && c
<= '7')
1636 /* A hex escape, as in ANSI C. */
1642 if (c
>= '0' && c
<= '9')
1647 else if ((c
>= 'a' && c
<= 'f')
1648 || (c
>= 'A' && c
<= 'F'))
1651 if (c
>= 'a' && c
<= 'f')
1666 if (BASE_LEADING_CODE_P (c
))
1667 c
= read_multibyte (c
, readcharfun
);
1673 /* Read an integer in radix RADIX using READCHARFUN to read
1674 characters. RADIX must be in the interval [2..36]; if it isn't, a
1675 read error is signaled . Value is the integer read. Signals an
1676 error if encountering invalid read syntax or if RADIX is out of
1680 read_integer (readcharfun
, radix
)
1681 Lisp_Object readcharfun
;
1684 int number
= 0, ndigits
= 0, invalid_p
, c
, sign
= 0;
1686 if (radix
< 2 || radix
> 36)
1690 number
= ndigits
= invalid_p
= 0;
1706 if (c
>= '0' && c
<= '9')
1708 else if (c
>= 'a' && c
<= 'z')
1709 digit
= c
- 'a' + 10;
1710 else if (c
>= 'A' && c
<= 'Z')
1711 digit
= c
- 'A' + 10;
1718 if (digit
< 0 || digit
>= radix
)
1721 number
= radix
* number
+ digit
;
1727 if (ndigits
== 0 || invalid_p
)
1730 sprintf (buf
, "integer, radix %d", radix
);
1731 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1734 return make_number (sign
* number
);
1738 /* If the next token is ')' or ']' or '.', we store that character
1739 in *PCH and the return value is not interesting. Else, we store
1740 zero in *PCH and we read and return one lisp object.
1742 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1745 read1 (readcharfun
, pch
, first_in_list
)
1746 register Lisp_Object readcharfun
;
1751 int uninterned_symbol
= 0;
1759 end_of_file_error ();
1764 return read_list (0, readcharfun
);
1767 return read_vector (readcharfun
, 0);
1784 tmp
= read_vector (readcharfun
, 0);
1785 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1786 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1787 error ("Invalid size char-table");
1788 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1789 XCHAR_TABLE (tmp
)->top
= Qt
;
1798 tmp
= read_vector (readcharfun
, 0);
1799 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1800 error ("Invalid size char-table");
1801 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1802 XCHAR_TABLE (tmp
)->top
= Qnil
;
1805 Fsignal (Qinvalid_read_syntax
,
1806 Fcons (make_string ("#^^", 3), Qnil
));
1808 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1813 length
= read1 (readcharfun
, pch
, first_in_list
);
1817 Lisp_Object tmp
, val
;
1818 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1822 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1823 if (size_in_chars
!= XSTRING (tmp
)->size
1824 /* We used to print 1 char too many
1825 when the number of bits was a multiple of 8.
1826 Accept such input in case it came from an old version. */
1827 && ! (XFASTINT (length
)
1828 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1829 Fsignal (Qinvalid_read_syntax
,
1830 Fcons (make_string ("#&...", 5), Qnil
));
1832 val
= Fmake_bool_vector (length
, Qnil
);
1833 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1835 /* Clear the extraneous bits in the last byte. */
1836 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1837 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1838 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1841 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1846 /* Accept compiled functions at read-time so that we don't have to
1847 build them using function calls. */
1849 tmp
= read_vector (readcharfun
, 1);
1850 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1851 XVECTOR (tmp
)->contents
);
1856 struct gcpro gcpro1
;
1859 /* Read the string itself. */
1860 tmp
= read1 (readcharfun
, &ch
, 0);
1861 if (ch
!= 0 || !STRINGP (tmp
))
1862 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1864 /* Read the intervals and their properties. */
1867 Lisp_Object beg
, end
, plist
;
1869 beg
= read1 (readcharfun
, &ch
, 0);
1874 end
= read1 (readcharfun
, &ch
, 0);
1876 plist
= read1 (readcharfun
, &ch
, 0);
1878 Fsignal (Qinvalid_read_syntax
,
1879 Fcons (build_string ("invalid string property list"),
1881 Fset_text_properties (beg
, end
, plist
, tmp
);
1887 /* #@NUMBER is used to skip NUMBER following characters.
1888 That's used in .elc files to skip over doc strings
1889 and function definitions. */
1894 /* Read a decimal integer. */
1895 while ((c
= READCHAR
) >= 0
1896 && c
>= '0' && c
<= '9')
1904 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1906 /* If we are supposed to force doc strings into core right now,
1907 record the last string that we skipped,
1908 and record where in the file it comes from. */
1910 /* But first exchange saved_doc_string
1911 with prev_saved_doc_string, so we save two strings. */
1913 char *temp
= saved_doc_string
;
1914 int temp_size
= saved_doc_string_size
;
1915 file_offset temp_pos
= saved_doc_string_position
;
1916 int temp_len
= saved_doc_string_length
;
1918 saved_doc_string
= prev_saved_doc_string
;
1919 saved_doc_string_size
= prev_saved_doc_string_size
;
1920 saved_doc_string_position
= prev_saved_doc_string_position
;
1921 saved_doc_string_length
= prev_saved_doc_string_length
;
1923 prev_saved_doc_string
= temp
;
1924 prev_saved_doc_string_size
= temp_size
;
1925 prev_saved_doc_string_position
= temp_pos
;
1926 prev_saved_doc_string_length
= temp_len
;
1929 if (saved_doc_string_size
== 0)
1931 saved_doc_string_size
= nskip
+ 100;
1932 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1934 if (nskip
> saved_doc_string_size
)
1936 saved_doc_string_size
= nskip
+ 100;
1937 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1938 saved_doc_string_size
);
1941 saved_doc_string_position
= file_tell (instream
);
1943 /* Copy that many characters into saved_doc_string. */
1944 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1945 saved_doc_string
[i
] = c
= READCHAR
;
1947 saved_doc_string_length
= i
;
1951 /* Skip that many characters. */
1952 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1959 return Vload_file_name
;
1961 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1962 /* #:foo is the uninterned symbol named foo. */
1965 uninterned_symbol
= 1;
1969 /* Reader forms that can reuse previously read objects. */
1970 if (c
>= '0' && c
<= '9')
1975 /* Read a non-negative integer. */
1976 while (c
>= '0' && c
<= '9')
1982 /* #n=object returns object, but associates it with n for #n#. */
1985 /* Make a placeholder for #n# to use temporarily */
1986 Lisp_Object placeholder
;
1989 placeholder
= Fcons(Qnil
, Qnil
);
1990 cell
= Fcons (make_number (n
), placeholder
);
1991 read_objects
= Fcons (cell
, read_objects
);
1993 /* Read the object itself. */
1994 tem
= read0 (readcharfun
);
1996 /* Now put it everywhere the placeholder was... */
1997 substitute_object_in_subtree (tem
, placeholder
);
1999 /* ...and #n# will use the real value from now on. */
2000 Fsetcdr (cell
, tem
);
2004 /* #n# returns a previously read object. */
2007 tem
= Fassq (make_number (n
), read_objects
);
2010 /* Fall through to error message. */
2012 else if (c
== 'r' || c
== 'R')
2013 return read_integer (readcharfun
, n
);
2015 /* Fall through to error message. */
2017 else if (c
== 'x' || c
== 'X')
2018 return read_integer (readcharfun
, 16);
2019 else if (c
== 'o' || c
== 'O')
2020 return read_integer (readcharfun
, 8);
2021 else if (c
== 'b' || c
== 'B')
2022 return read_integer (readcharfun
, 2);
2025 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2028 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2033 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2043 new_backquote_flag
= 1;
2044 value
= read0 (readcharfun
);
2045 new_backquote_flag
= 0;
2047 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2051 if (new_backquote_flag
)
2053 Lisp_Object comma_type
= Qnil
;
2058 comma_type
= Qcomma_at
;
2060 comma_type
= Qcomma_dot
;
2063 if (ch
>= 0) UNREAD (ch
);
2064 comma_type
= Qcomma
;
2067 new_backquote_flag
= 0;
2068 value
= read0 (readcharfun
);
2069 new_backquote_flag
= 1;
2070 return Fcons (comma_type
, Fcons (value
, Qnil
));
2079 end_of_file_error ();
2082 c
= read_escape (readcharfun
, 0);
2083 else if (BASE_LEADING_CODE_P (c
))
2084 c
= read_multibyte (c
, readcharfun
);
2086 return make_number (c
);
2091 register char *p
= read_buffer
;
2092 register char *end
= read_buffer
+ read_buffer_size
;
2094 /* Nonzero if we saw an escape sequence specifying
2095 a multibyte character. */
2096 int force_multibyte
= 0;
2097 /* Nonzero if we saw an escape sequence specifying
2098 a single-byte character. */
2099 int force_singlebyte
= 0;
2103 while ((c
= READCHAR
) >= 0
2106 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2108 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2109 p
+= new - read_buffer
;
2110 read_buffer
+= new - read_buffer
;
2111 end
= read_buffer
+ read_buffer_size
;
2116 c
= read_escape (readcharfun
, 1);
2118 /* C is -1 if \ newline has just been seen */
2121 if (p
== read_buffer
)
2126 /* If an escape specifies a non-ASCII single-byte character,
2127 this must be a unibyte string. */
2128 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2129 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2130 force_singlebyte
= 1;
2133 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2135 /* Any modifiers for a multibyte character are invalid. */
2136 if (c
& CHAR_MODIFIER_MASK
)
2137 error ("Invalid modifier in string");
2138 p
+= CHAR_STRING (c
, p
);
2139 force_multibyte
= 1;
2143 /* Allow `\C- ' and `\C-?'. */
2144 if (c
== (CHAR_CTL
| ' '))
2146 else if (c
== (CHAR_CTL
| '?'))
2151 /* Shift modifier is valid only with [A-Za-z]. */
2152 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2154 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2155 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2159 /* Move the meta bit to the right place for a string. */
2160 c
= (c
& ~CHAR_META
) | 0x80;
2162 error ("Invalid modifier in string");
2167 end_of_file_error ();
2169 /* If purifying, and string starts with \ newline,
2170 return zero instead. This is for doc strings
2171 that we are really going to find in etc/DOC.nn.nn */
2172 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2173 return make_number (0);
2175 if (force_multibyte
)
2176 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2177 p
- read_buffer
, &nchars
);
2178 else if (force_singlebyte
)
2179 nchars
= p
- read_buffer
;
2180 else if (load_convert_to_unibyte
)
2183 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2184 p
- read_buffer
, &nchars
);
2185 if (p
- read_buffer
!= nchars
)
2187 string
= make_multibyte_string (read_buffer
, nchars
,
2189 return Fstring_make_unibyte (string
);
2192 else if (EQ (readcharfun
, Qget_file_char
)
2193 || EQ (readcharfun
, Qlambda
))
2194 /* Nowadays, reading directly from a file is used only for
2195 compiled Emacs Lisp files, and those always use the
2196 Emacs internal encoding. Meanwhile, Qlambda is used
2197 for reading dynamic byte code (compiled with
2198 byte-compile-dynamic = t). */
2199 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2200 p
- read_buffer
, &nchars
);
2202 /* In all other cases, if we read these bytes as
2203 separate characters, treat them as separate characters now. */
2204 nchars
= p
- read_buffer
;
2207 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2209 || (p
- read_buffer
!= nchars
)));
2210 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2212 || (p
- read_buffer
!= nchars
)));
2217 int next_char
= READCHAR
;
2220 if (next_char
<= 040
2221 || index ("\"'`,(", next_char
))
2227 /* Otherwise, we fall through! Note that the atom-reading loop
2228 below will now loop at least once, assuring that we will not
2229 try to UNREAD two characters in a row. */
2233 if (c
<= 040) goto retry
;
2235 char *p
= read_buffer
;
2239 char *end
= read_buffer
+ read_buffer_size
;
2242 && !(c
== '\"' || c
== '\'' || c
== ';'
2243 || c
== '(' || c
== ')'
2244 || c
== '[' || c
== ']' || c
== '#'))
2246 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2248 char *new = (char *) xrealloc (read_buffer
,
2249 read_buffer_size
*= 2);
2250 p
+= new - read_buffer
;
2251 read_buffer
+= new - read_buffer
;
2252 end
= read_buffer
+ read_buffer_size
;
2261 if (! SINGLE_BYTE_CHAR_P (c
))
2262 p
+= CHAR_STRING (c
, p
);
2271 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2272 p
+= new - read_buffer
;
2273 read_buffer
+= new - read_buffer
;
2274 /* end = read_buffer + read_buffer_size; */
2281 if (!quoted
&& !uninterned_symbol
)
2284 register Lisp_Object val
;
2286 if (*p1
== '+' || *p1
== '-') p1
++;
2287 /* Is it an integer? */
2290 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2291 /* Integers can have trailing decimal points. */
2292 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2294 /* It is an integer. */
2298 if (sizeof (int) == sizeof (EMACS_INT
))
2299 XSETINT (val
, atoi (read_buffer
));
2300 else if (sizeof (long) == sizeof (EMACS_INT
))
2301 XSETINT (val
, atol (read_buffer
));
2307 if (isfloat_string (read_buffer
))
2309 /* Compute NaN and infinities using 0.0 in a variable,
2310 to cope with compilers that think they are smarter
2316 /* Negate the value ourselves. This treats 0, NaNs,
2317 and infinity properly on IEEE floating point hosts,
2318 and works around a common bug where atof ("-0.0")
2320 int negative
= read_buffer
[0] == '-';
2322 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2323 returns 1, is if the input ends in e+INF or e+NaN. */
2330 value
= zero
/ zero
;
2333 value
= atof (read_buffer
+ negative
);
2337 return make_float (negative
? - value
: value
);
2341 if (uninterned_symbol
)
2342 return make_symbol (read_buffer
);
2344 return intern (read_buffer
);
2350 /* List of nodes we've seen during substitute_object_in_subtree. */
2351 static Lisp_Object seen_list
;
2354 substitute_object_in_subtree (object
, placeholder
)
2356 Lisp_Object placeholder
;
2358 Lisp_Object check_object
;
2360 /* We haven't seen any objects when we start. */
2363 /* Make all the substitutions. */
2365 = substitute_object_recurse (object
, placeholder
, object
);
2367 /* Clear seen_list because we're done with it. */
2370 /* The returned object here is expected to always eq the
2372 if (!EQ (check_object
, object
))
2373 error ("Unexpected mutation error in reader");
2376 /* Feval doesn't get called from here, so no gc protection is needed. */
2377 #define SUBSTITUTE(get_val, set_val) \
2379 Lisp_Object old_value = get_val; \
2380 Lisp_Object true_value \
2381 = substitute_object_recurse (object, placeholder,\
2384 if (!EQ (old_value, true_value)) \
2391 substitute_object_recurse (object
, placeholder
, subtree
)
2393 Lisp_Object placeholder
;
2394 Lisp_Object subtree
;
2396 /* If we find the placeholder, return the target object. */
2397 if (EQ (placeholder
, subtree
))
2400 /* If we've been to this node before, don't explore it again. */
2401 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2404 /* If this node can be the entry point to a cycle, remember that
2405 we've seen it. It can only be such an entry point if it was made
2406 by #n=, which means that we can find it as a value in
2408 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2409 seen_list
= Fcons (subtree
, seen_list
);
2411 /* Recurse according to subtree's type.
2412 Every branch must return a Lisp_Object. */
2413 switch (XTYPE (subtree
))
2415 case Lisp_Vectorlike
:
2418 int length
= XINT (Flength(subtree
));
2419 for (i
= 0; i
< length
; i
++)
2421 Lisp_Object idx
= make_number (i
);
2422 SUBSTITUTE (Faref (subtree
, idx
),
2423 Faset (subtree
, idx
, true_value
));
2430 SUBSTITUTE (Fcar_safe (subtree
),
2431 Fsetcar (subtree
, true_value
));
2432 SUBSTITUTE (Fcdr_safe (subtree
),
2433 Fsetcdr (subtree
, true_value
));
2439 /* Check for text properties in each interval.
2440 substitute_in_interval contains part of the logic. */
2442 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2443 Lisp_Object arg
= Fcons (object
, placeholder
);
2445 traverse_intervals (root_interval
, 1, 0,
2446 &substitute_in_interval
, arg
);
2451 /* Other types don't recurse any further. */
2457 /* Helper function for substitute_object_recurse. */
2459 substitute_in_interval (interval
, arg
)
2463 Lisp_Object object
= Fcar (arg
);
2464 Lisp_Object placeholder
= Fcdr (arg
);
2466 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2485 if (*cp
== '+' || *cp
== '-')
2488 if (*cp
>= '0' && *cp
<= '9')
2491 while (*cp
>= '0' && *cp
<= '9')
2499 if (*cp
>= '0' && *cp
<= '9')
2502 while (*cp
>= '0' && *cp
<= '9')
2505 if (*cp
== 'e' || *cp
== 'E')
2509 if (*cp
== '+' || *cp
== '-')
2513 if (*cp
>= '0' && *cp
<= '9')
2516 while (*cp
>= '0' && *cp
<= '9')
2519 else if (cp
== start
)
2521 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2526 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2532 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2533 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2534 || state
== (DOT_CHAR
|TRAIL_INT
)
2535 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2536 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2537 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2542 read_vector (readcharfun
, bytecodeflag
)
2543 Lisp_Object readcharfun
;
2548 register Lisp_Object
*ptr
;
2549 register Lisp_Object tem
, item
, vector
;
2550 register struct Lisp_Cons
*otem
;
2553 tem
= read_list (1, readcharfun
);
2554 len
= Flength (tem
);
2555 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2557 size
= XVECTOR (vector
)->size
;
2558 ptr
= XVECTOR (vector
)->contents
;
2559 for (i
= 0; i
< size
; i
++)
2562 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2563 bytecode object, the docstring containing the bytecode and
2564 constants values must be treated as unibyte and passed to
2565 Fread, to get the actual bytecode string and constants vector. */
2566 if (bytecodeflag
&& load_force_doc_strings
)
2568 if (i
== COMPILED_BYTECODE
)
2570 if (!STRINGP (item
))
2571 error ("invalid byte code");
2573 /* Delay handling the bytecode slot until we know whether
2574 it is lazily-loaded (we can tell by whether the
2575 constants slot is nil). */
2576 ptr
[COMPILED_CONSTANTS
] = item
;
2579 else if (i
== COMPILED_CONSTANTS
)
2581 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2585 /* Coerce string to unibyte (like string-as-unibyte,
2586 but without generating extra garbage and
2587 guaranteeing no change in the contents). */
2588 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2589 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2591 item
= Fread (bytestr
);
2593 error ("invalid byte code");
2595 otem
= XCONS (item
);
2596 bytestr
= XCAR (item
);
2601 /* Now handle the bytecode slot. */
2602 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2605 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2613 /* FLAG = 1 means check for ] to terminate rather than ) and .
2614 FLAG = -1 means check for starting with defun
2615 and make structure pure. */
2618 read_list (flag
, readcharfun
)
2620 register Lisp_Object readcharfun
;
2622 /* -1 means check next element for defun,
2623 0 means don't check,
2624 1 means already checked and found defun. */
2625 int defunflag
= flag
< 0 ? -1 : 0;
2626 Lisp_Object val
, tail
;
2627 register Lisp_Object elt
, tem
;
2628 struct gcpro gcpro1
, gcpro2
;
2629 /* 0 is the normal case.
2630 1 means this list is a doc reference; replace it with the number 0.
2631 2 means this list is a doc reference; replace it with the doc string. */
2632 int doc_reference
= 0;
2634 /* Initialize this to 1 if we are reading a list. */
2635 int first_in_list
= flag
<= 0;
2644 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2649 /* While building, if the list starts with #$, treat it specially. */
2650 if (EQ (elt
, Vload_file_name
)
2652 && !NILP (Vpurify_flag
))
2654 if (NILP (Vdoc_file_name
))
2655 /* We have not yet called Snarf-documentation, so assume
2656 this file is described in the DOC-MM.NN file
2657 and Snarf-documentation will fill in the right value later.
2658 For now, replace the whole list with 0. */
2661 /* We have already called Snarf-documentation, so make a relative
2662 file name for this file, so it can be found properly
2663 in the installed Lisp directory.
2664 We don't use Fexpand_file_name because that would make
2665 the directory absolute now. */
2666 elt
= concat2 (build_string ("../lisp/"),
2667 Ffile_name_nondirectory (elt
));
2669 else if (EQ (elt
, Vload_file_name
)
2671 && load_force_doc_strings
)
2680 Fsignal (Qinvalid_read_syntax
,
2681 Fcons (make_string (") or . in a vector", 18), Qnil
));
2689 XCDR (tail
) = read0 (readcharfun
);
2691 val
= read0 (readcharfun
);
2692 read1 (readcharfun
, &ch
, 0);
2696 if (doc_reference
== 1)
2697 return make_number (0);
2698 if (doc_reference
== 2)
2700 /* Get a doc string from the file we are loading.
2701 If it's in saved_doc_string, get it from there. */
2702 int pos
= XINT (XCDR (val
));
2703 /* Position is negative for user variables. */
2704 if (pos
< 0) pos
= -pos
;
2705 if (pos
>= saved_doc_string_position
2706 && pos
< (saved_doc_string_position
2707 + saved_doc_string_length
))
2709 int start
= pos
- saved_doc_string_position
;
2712 /* Process quoting with ^A,
2713 and find the end of the string,
2714 which is marked with ^_ (037). */
2715 for (from
= start
, to
= start
;
2716 saved_doc_string
[from
] != 037;)
2718 int c
= saved_doc_string
[from
++];
2721 c
= saved_doc_string
[from
++];
2723 saved_doc_string
[to
++] = c
;
2725 saved_doc_string
[to
++] = 0;
2727 saved_doc_string
[to
++] = 037;
2730 saved_doc_string
[to
++] = c
;
2733 return make_string (saved_doc_string
+ start
,
2736 /* Look in prev_saved_doc_string the same way. */
2737 else if (pos
>= prev_saved_doc_string_position
2738 && pos
< (prev_saved_doc_string_position
2739 + prev_saved_doc_string_length
))
2741 int start
= pos
- prev_saved_doc_string_position
;
2744 /* Process quoting with ^A,
2745 and find the end of the string,
2746 which is marked with ^_ (037). */
2747 for (from
= start
, to
= start
;
2748 prev_saved_doc_string
[from
] != 037;)
2750 int c
= prev_saved_doc_string
[from
++];
2753 c
= prev_saved_doc_string
[from
++];
2755 prev_saved_doc_string
[to
++] = c
;
2757 prev_saved_doc_string
[to
++] = 0;
2759 prev_saved_doc_string
[to
++] = 037;
2762 prev_saved_doc_string
[to
++] = c
;
2765 return make_string (prev_saved_doc_string
+ start
,
2769 return get_doc_string (val
, 0, 0);
2774 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2776 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2778 tem
= (read_pure
&& flag
<= 0
2779 ? pure_cons (elt
, Qnil
)
2780 : Fcons (elt
, Qnil
));
2787 defunflag
= EQ (elt
, Qdefun
);
2788 else if (defunflag
> 0)
2793 Lisp_Object Vobarray
;
2794 Lisp_Object initial_obarray
;
2796 /* oblookup stores the bucket number here, for the sake of Funintern. */
2798 int oblookup_last_bucket_number
;
2800 static int hash_string ();
2801 Lisp_Object
oblookup ();
2803 /* Get an error if OBARRAY is not an obarray.
2804 If it is one, return it. */
2807 check_obarray (obarray
)
2808 Lisp_Object obarray
;
2810 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2812 /* If Vobarray is now invalid, force it to be valid. */
2813 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2815 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2820 /* Intern the C string STR: return a symbol with that name,
2821 interned in the current obarray. */
2828 int len
= strlen (str
);
2829 Lisp_Object obarray
;
2832 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2833 obarray
= check_obarray (obarray
);
2834 tem
= oblookup (obarray
, str
, len
, len
);
2837 return Fintern (make_string (str
, len
), obarray
);
2840 /* Create an uninterned symbol with name STR. */
2846 int len
= strlen (str
);
2848 return Fmake_symbol ((!NILP (Vpurify_flag
)
2849 ? make_pure_string (str
, len
, len
, 0)
2850 : make_string (str
, len
)));
2853 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2854 "Return the canonical symbol whose name is STRING.\n\
2855 If there is none, one is created by this function and returned.\n\
2856 A second optional argument specifies the obarray to use;\n\
2857 it defaults to the value of `obarray'.")
2859 Lisp_Object string
, obarray
;
2861 register Lisp_Object tem
, sym
, *ptr
;
2863 if (NILP (obarray
)) obarray
= Vobarray
;
2864 obarray
= check_obarray (obarray
);
2866 CHECK_STRING (string
, 0);
2868 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2869 XSTRING (string
)->size
,
2870 STRING_BYTES (XSTRING (string
)));
2871 if (!INTEGERP (tem
))
2874 if (!NILP (Vpurify_flag
))
2875 string
= Fpurecopy (string
);
2876 sym
= Fmake_symbol (string
);
2877 XSYMBOL (sym
)->obarray
= obarray
;
2879 if ((XSTRING (string
)->data
[0] == ':')
2880 && EQ (obarray
, initial_obarray
))
2881 XSYMBOL (sym
)->value
= sym
;
2883 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2885 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2887 XSYMBOL (sym
)->next
= 0;
2892 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2893 "Return the canonical symbol named NAME, or nil if none exists.\n\
2894 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2895 symbol is searched for.\n\
2896 A second optional argument specifies the obarray to use;\n\
2897 it defaults to the value of `obarray'.")
2899 Lisp_Object name
, obarray
;
2901 register Lisp_Object tem
;
2902 struct Lisp_String
*string
;
2904 if (NILP (obarray
)) obarray
= Vobarray
;
2905 obarray
= check_obarray (obarray
);
2907 if (!SYMBOLP (name
))
2909 CHECK_STRING (name
, 0);
2910 string
= XSTRING (name
);
2913 string
= XSYMBOL (name
)->name
;
2915 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2916 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2922 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2923 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2924 The value is t if a symbol was found and deleted, nil otherwise.\n\
2925 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2926 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2927 OBARRAY defaults to the value of the variable `obarray'.")
2929 Lisp_Object name
, obarray
;
2931 register Lisp_Object string
, tem
;
2934 if (NILP (obarray
)) obarray
= Vobarray
;
2935 obarray
= check_obarray (obarray
);
2938 XSETSTRING (string
, XSYMBOL (name
)->name
);
2941 CHECK_STRING (name
, 0);
2945 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2946 XSTRING (string
)->size
,
2947 STRING_BYTES (XSTRING (string
)));
2950 /* If arg was a symbol, don't delete anything but that symbol itself. */
2951 if (SYMBOLP (name
) && !EQ (name
, tem
))
2954 XSYMBOL (tem
)->obarray
= Qnil
;
2956 hash
= oblookup_last_bucket_number
;
2958 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2960 if (XSYMBOL (tem
)->next
)
2961 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2963 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2967 Lisp_Object tail
, following
;
2969 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2970 XSYMBOL (tail
)->next
;
2973 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2974 if (EQ (following
, tem
))
2976 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2985 /* Return the symbol in OBARRAY whose names matches the string
2986 of SIZE characters (SIZE_BYTE bytes) at PTR.
2987 If there is no such symbol in OBARRAY, return nil.
2989 Also store the bucket number in oblookup_last_bucket_number. */
2992 oblookup (obarray
, ptr
, size
, size_byte
)
2993 Lisp_Object obarray
;
2995 int size
, size_byte
;
2999 register Lisp_Object tail
;
3000 Lisp_Object bucket
, tem
;
3002 if (!VECTORP (obarray
)
3003 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3005 obarray
= check_obarray (obarray
);
3006 obsize
= XVECTOR (obarray
)->size
;
3008 /* This is sometimes needed in the middle of GC. */
3009 obsize
&= ~ARRAY_MARK_FLAG
;
3010 /* Combining next two lines breaks VMS C 2.3. */
3011 hash
= hash_string (ptr
, size_byte
);
3013 bucket
= XVECTOR (obarray
)->contents
[hash
];
3014 oblookup_last_bucket_number
= hash
;
3015 if (XFASTINT (bucket
) == 0)
3017 else if (!SYMBOLP (bucket
))
3018 error ("Bad data in guts of obarray"); /* Like CADR error message */
3020 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3022 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3023 && XSYMBOL (tail
)->name
->size
== size
3024 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3026 else if (XSYMBOL (tail
)->next
== 0)
3029 XSETINT (tem
, hash
);
3034 hash_string (ptr
, len
)
3038 register unsigned char *p
= ptr
;
3039 register unsigned char *end
= p
+ len
;
3040 register unsigned char c
;
3041 register int hash
= 0;
3046 if (c
>= 0140) c
-= 40;
3047 hash
= ((hash
<<3) + (hash
>>28) + c
);
3049 return hash
& 07777777777;
3053 map_obarray (obarray
, fn
, arg
)
3054 Lisp_Object obarray
;
3055 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3059 register Lisp_Object tail
;
3060 CHECK_VECTOR (obarray
, 1);
3061 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3063 tail
= XVECTOR (obarray
)->contents
[i
];
3068 if (XSYMBOL (tail
)->next
== 0)
3070 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3076 mapatoms_1 (sym
, function
)
3077 Lisp_Object sym
, function
;
3079 call1 (function
, sym
);
3082 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3083 "Call FUNCTION on every symbol in OBARRAY.\n\
3084 OBARRAY defaults to the value of `obarray'.")
3086 Lisp_Object function
, obarray
;
3088 if (NILP (obarray
)) obarray
= Vobarray
;
3089 obarray
= check_obarray (obarray
);
3091 map_obarray (obarray
, mapatoms_1
, function
);
3095 #define OBARRAY_SIZE 1511
3100 Lisp_Object oblength
;
3104 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3106 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3107 Vobarray
= Fmake_vector (oblength
, make_number (0));
3108 initial_obarray
= Vobarray
;
3109 staticpro (&initial_obarray
);
3110 /* Intern nil in the obarray */
3111 XSYMBOL (Qnil
)->obarray
= Vobarray
;
3112 /* These locals are to kludge around a pyramid compiler bug. */
3113 hash
= hash_string ("nil", 3);
3114 /* Separate statement here to avoid VAXC bug. */
3115 hash
%= OBARRAY_SIZE
;
3116 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3119 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3120 XSYMBOL (Qnil
)->function
= Qunbound
;
3121 XSYMBOL (Qunbound
)->value
= Qunbound
;
3122 XSYMBOL (Qunbound
)->function
= Qunbound
;
3125 XSYMBOL (Qnil
)->value
= Qnil
;
3126 XSYMBOL (Qnil
)->plist
= Qnil
;
3127 XSYMBOL (Qt
)->value
= Qt
;
3129 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3132 Qvariable_documentation
= intern ("variable-documentation");
3133 staticpro (&Qvariable_documentation
);
3135 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3136 read_buffer
= (char *) xmalloc (read_buffer_size
);
3141 struct Lisp_Subr
*sname
;
3144 sym
= intern (sname
->symbol_name
);
3145 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3148 #ifdef NOTDEF /* use fset in subr.el now */
3150 defalias (sname
, string
)
3151 struct Lisp_Subr
*sname
;
3155 sym
= intern (string
);
3156 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3160 /* Define an "integer variable"; a symbol whose value is forwarded
3161 to a C variable of type int. Sample call: */
3162 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3164 defvar_int (namestring
, address
)
3168 Lisp_Object sym
, val
;
3169 sym
= intern (namestring
);
3170 val
= allocate_misc ();
3171 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3172 XINTFWD (val
)->intvar
= address
;
3173 XSYMBOL (sym
)->value
= val
;
3176 /* Similar but define a variable whose value is T if address contains 1,
3177 NIL if address contains 0 */
3179 defvar_bool (namestring
, address
)
3183 Lisp_Object sym
, val
;
3184 sym
= intern (namestring
);
3185 val
= allocate_misc ();
3186 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3187 XBOOLFWD (val
)->boolvar
= address
;
3188 XSYMBOL (sym
)->value
= val
;
3189 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3192 /* Similar but define a variable whose value is the Lisp Object stored
3193 at address. Two versions: with and without gc-marking of the C
3194 variable. The nopro version is used when that variable will be
3195 gc-marked for some other reason, since marking the same slot twice
3196 can cause trouble with strings. */
3198 defvar_lisp_nopro (namestring
, address
)
3200 Lisp_Object
*address
;
3202 Lisp_Object sym
, val
;
3203 sym
= intern (namestring
);
3204 val
= allocate_misc ();
3205 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3206 XOBJFWD (val
)->objvar
= address
;
3207 XSYMBOL (sym
)->value
= val
;
3211 defvar_lisp (namestring
, address
)
3213 Lisp_Object
*address
;
3215 defvar_lisp_nopro (namestring
, address
);
3216 staticpro (address
);
3219 /* Similar but define a variable whose value is the Lisp Object stored in
3220 the current buffer. address is the address of the slot in the buffer
3221 that is current now. */
3224 defvar_per_buffer (namestring
, address
, type
, doc
)
3226 Lisp_Object
*address
;
3230 Lisp_Object sym
, val
;
3232 extern struct buffer buffer_local_symbols
;
3234 sym
= intern (namestring
);
3235 val
= allocate_misc ();
3236 offset
= (char *)address
- (char *)current_buffer
;
3238 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3239 XBUFFER_OBJFWD (val
)->offset
= offset
;
3240 XSYMBOL (sym
)->value
= val
;
3241 PER_BUFFER_SYMBOL (offset
) = sym
;
3242 PER_BUFFER_TYPE (offset
) = type
;
3244 if (PER_BUFFER_IDX (offset
) == 0)
3245 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3246 slot of buffer_local_flags */
3251 /* Similar but define a variable whose value is the Lisp Object stored
3252 at a particular offset in the current kboard object. */
3255 defvar_kboard (namestring
, offset
)
3259 Lisp_Object sym
, val
;
3260 sym
= intern (namestring
);
3261 val
= allocate_misc ();
3262 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3263 XKBOARD_OBJFWD (val
)->offset
= offset
;
3264 XSYMBOL (sym
)->value
= val
;
3267 /* Record the value of load-path used at the start of dumping
3268 so we can see if the site changed it later during dumping. */
3269 static Lisp_Object dump_path
;
3275 int turn_off_warning
= 0;
3277 /* Compute the default load-path. */
3279 normal
= PATH_LOADSEARCH
;
3280 Vload_path
= decode_env_path (0, normal
);
3282 if (NILP (Vpurify_flag
))
3283 normal
= PATH_LOADSEARCH
;
3285 normal
= PATH_DUMPLOADSEARCH
;
3287 /* In a dumped Emacs, we normally have to reset the value of
3288 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3289 uses ../lisp, instead of the path of the installed elisp
3290 libraries. However, if it appears that Vload_path was changed
3291 from the default before dumping, don't override that value. */
3294 if (! NILP (Fequal (dump_path
, Vload_path
)))
3296 Vload_path
= decode_env_path (0, normal
);
3297 if (!NILP (Vinstallation_directory
))
3299 /* Add to the path the lisp subdir of the
3300 installation dir, if it exists. */
3301 Lisp_Object tem
, tem1
;
3302 tem
= Fexpand_file_name (build_string ("lisp"),
3303 Vinstallation_directory
);
3304 tem1
= Ffile_exists_p (tem
);
3307 if (NILP (Fmember (tem
, Vload_path
)))
3309 turn_off_warning
= 1;
3310 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3314 /* That dir doesn't exist, so add the build-time
3315 Lisp dirs instead. */
3316 Vload_path
= nconc2 (Vload_path
, dump_path
);
3318 /* Add leim under the installation dir, if it exists. */
3319 tem
= Fexpand_file_name (build_string ("leim"),
3320 Vinstallation_directory
);
3321 tem1
= Ffile_exists_p (tem
);
3324 if (NILP (Fmember (tem
, Vload_path
)))
3325 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3328 /* Add site-list under the installation dir, if it exists. */
3329 tem
= Fexpand_file_name (build_string ("site-lisp"),
3330 Vinstallation_directory
);
3331 tem1
= Ffile_exists_p (tem
);
3334 if (NILP (Fmember (tem
, Vload_path
)))
3335 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3338 /* If Emacs was not built in the source directory,
3339 and it is run from where it was built, add to load-path
3340 the lisp, leim and site-lisp dirs under that directory. */
3342 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3346 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3347 Vinstallation_directory
);
3348 tem1
= Ffile_exists_p (tem
);
3350 /* Don't be fooled if they moved the entire source tree
3351 AFTER dumping Emacs. If the build directory is indeed
3352 different from the source dir, src/Makefile.in and
3353 src/Makefile will not be found together. */
3354 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3355 Vinstallation_directory
);
3356 tem2
= Ffile_exists_p (tem
);
3357 if (!NILP (tem1
) && NILP (tem2
))
3359 tem
= Fexpand_file_name (build_string ("lisp"),
3362 if (NILP (Fmember (tem
, Vload_path
)))
3363 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3365 tem
= Fexpand_file_name (build_string ("leim"),
3368 if (NILP (Fmember (tem
, Vload_path
)))
3369 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3371 tem
= Fexpand_file_name (build_string ("site-lisp"),
3374 if (NILP (Fmember (tem
, Vload_path
)))
3375 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3383 /* NORMAL refers to the lisp dir in the source directory. */
3384 /* We used to add ../lisp at the front here, but
3385 that caused trouble because it was copied from dump_path
3386 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3387 It should be unnecessary. */
3388 Vload_path
= decode_env_path (0, normal
);
3389 dump_path
= Vload_path
;
3394 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3395 almost never correct, thereby causing a warning to be printed out that
3396 confuses users. Since PATH_LOADSEARCH is always overridden by the
3397 EMACSLOADPATH environment variable below, disable the warning on NT. */
3399 /* Warn if dirs in the *standard* path don't exist. */
3400 if (!turn_off_warning
)
3402 Lisp_Object path_tail
;
3404 for (path_tail
= Vload_path
;
3406 path_tail
= XCDR (path_tail
))
3408 Lisp_Object dirfile
;
3409 dirfile
= Fcar (path_tail
);
3410 if (STRINGP (dirfile
))
3412 dirfile
= Fdirectory_file_name (dirfile
);
3413 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3414 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3419 #endif /* WINDOWSNT */
3421 /* If the EMACSLOADPATH environment variable is set, use its value.
3422 This doesn't apply if we're dumping. */
3424 if (NILP (Vpurify_flag
)
3425 && egetenv ("EMACSLOADPATH"))
3427 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3431 load_in_progress
= 0;
3432 Vload_file_name
= Qnil
;
3434 load_descriptor_list
= Qnil
;
3436 Vstandard_input
= Qt
;
3437 Vloads_in_progress
= Qnil
;
3440 /* Print a warning, using format string FORMAT, that directory DIRNAME
3441 does not exist. Print it on stderr and put it in *Message*. */
3444 dir_warning (format
, dirname
)
3446 Lisp_Object dirname
;
3449 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3451 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3452 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3453 /* Don't log the warning before we've initialized!! */
3455 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3462 defsubr (&Sread_from_string
);
3464 defsubr (&Sintern_soft
);
3465 defsubr (&Sunintern
);
3467 defsubr (&Seval_buffer
);
3468 defsubr (&Seval_region
);
3469 defsubr (&Sread_char
);
3470 defsubr (&Sread_char_exclusive
);
3471 defsubr (&Sread_event
);
3472 defsubr (&Sget_file_char
);
3473 defsubr (&Smapatoms
);
3475 DEFVAR_LISP ("obarray", &Vobarray
,
3476 "Symbol table for use by `intern' and `read'.\n\
3477 It is a vector whose length ought to be prime for best results.\n\
3478 The vector's contents don't make sense if examined from Lisp programs;\n\
3479 to find all the symbols in an obarray, use `mapatoms'.");
3481 DEFVAR_LISP ("values", &Vvalues
,
3482 "List of values of all expressions which were read, evaluated and printed.\n\
3483 Order is reverse chronological.");
3485 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3486 "Stream for read to get input from.\n\
3487 See documentation of `read' for possible values.");
3488 Vstandard_input
= Qt
;
3490 DEFVAR_LISP ("load-path", &Vload_path
,
3491 "*List of directories to search for files to load.\n\
3492 Each element is a string (directory name) or nil (try default directory).\n\
3493 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3494 otherwise to default specified by file `epaths.h' when Emacs was built.");
3496 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3497 "Non-nil iff inside of `load'.");
3499 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3500 "An alist of expressions to be evalled when particular files are loaded.\n\
3501 Each element looks like (FILENAME FORMS...).\n\
3502 When `load' is run and the file-name argument is FILENAME,\n\
3503 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3504 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3505 with no directory specified, since that is how `load' is normally called.\n\
3506 An error in FORMS does not undo the load,\n\
3507 but does prevent execution of the rest of the FORMS.");
3508 Vafter_load_alist
= Qnil
;
3510 DEFVAR_LISP ("load-history", &Vload_history
,
3511 "Alist mapping source file names to symbols and features.\n\
3512 Each alist element is a list that starts with a file name,\n\
3513 except for one element (optional) that starts with nil and describes\n\
3514 definitions evaluated from buffers not visiting files.\n\
3515 The remaining elements of each list are symbols defined as functions\n\
3516 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
3517 and `(autoload . SYMBOL)'.");
3518 Vload_history
= Qnil
;
3520 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3521 "Full name of file being loaded by `load'.");
3522 Vload_file_name
= Qnil
;
3524 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3525 "File name, including directory, of user's initialization file.\n\
3526 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3527 file, this variable contains the name of the .el file, suitable for use\n\
3528 by functions like `custom-save-all' which edit the init file.");
3529 Vuser_init_file
= Qnil
;
3531 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3532 "Used for internal purposes by `load'.");
3533 Vcurrent_load_list
= Qnil
;
3535 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3536 "Function used by `load' and `eval-region' for reading expressions.\n\
3537 The default is nil, which means use the function `read'.");
3538 Vload_read_function
= Qnil
;
3540 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3541 "Function called in `load' for loading an Emacs lisp source file.\n\
3542 This function is for doing code conversion before reading the source file.\n\
3543 If nil, loading is done without any code conversion.\n\
3544 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3545 FULLNAME is the full name of FILE.\n\
3546 See `load' for the meaning of the remaining arguments.");
3547 Vload_source_file_function
= Qnil
;
3549 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3550 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3551 This is useful when the file being loaded is a temporary copy.");
3552 load_force_doc_strings
= 0;
3554 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3555 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3556 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3557 and is not meant for users to change.");
3558 load_convert_to_unibyte
= 0;
3560 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3561 "Directory in which Emacs sources were found when Emacs was built.\n\
3562 You cannot count on them to still be there!");
3564 = Fexpand_file_name (build_string ("../"),
3565 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3567 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3568 "List of files that were preloaded (when dumping Emacs).");
3569 Vpreloaded_file_list
= Qnil
;
3571 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3572 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3573 Vbyte_boolean_vars
= Qnil
;
3575 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3576 "Non-nil means load dangerous compiled Lisp files.\n\
3577 Some versions of XEmacs use different byte codes than Emacs. These\n\
3578 incompatible byte codes can make Emacs crash when it tries to execute\n\
3580 load_dangerous_libraries
= 0;
3582 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3583 "Regular expression matching safe to load compiled Lisp files.\n\
3584 When Emacs loads a compiled Lisp file, it reads the first 512 bytes\n\
3585 from the file, and matches them against this regular expression.\n\
3586 When the regular expression matches, the file is considered to be safe\n\
3587 to load. See also `load-dangerous-libraries'.");
3588 Vbytecomp_version_regexp
3589 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3591 /* Vsource_directory was initialized in init_lread. */
3593 load_descriptor_list
= Qnil
;
3594 staticpro (&load_descriptor_list
);
3596 Qcurrent_load_list
= intern ("current-load-list");
3597 staticpro (&Qcurrent_load_list
);
3599 Qstandard_input
= intern ("standard-input");
3600 staticpro (&Qstandard_input
);
3602 Qread_char
= intern ("read-char");
3603 staticpro (&Qread_char
);
3605 Qget_file_char
= intern ("get-file-char");
3606 staticpro (&Qget_file_char
);
3608 Qbackquote
= intern ("`");
3609 staticpro (&Qbackquote
);
3610 Qcomma
= intern (",");
3611 staticpro (&Qcomma
);
3612 Qcomma_at
= intern (",@");
3613 staticpro (&Qcomma_at
);
3614 Qcomma_dot
= intern (",.");
3615 staticpro (&Qcomma_dot
);
3617 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3618 staticpro (&Qinhibit_file_name_operation
);
3620 Qascii_character
= intern ("ascii-character");
3621 staticpro (&Qascii_character
);
3623 Qfunction
= intern ("function");
3624 staticpro (&Qfunction
);
3626 Qload
= intern ("load");
3629 Qload_file_name
= intern ("load-file-name");
3630 staticpro (&Qload_file_name
);
3632 staticpro (&dump_path
);
3634 staticpro (&read_objects
);
3635 read_objects
= Qnil
;
3636 staticpro (&seen_list
);
3638 Vloads_in_progress
= Qnil
;
3639 staticpro (&Vloads_in_progress
);