1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
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
;
184 /* Limit of the depth of recursive loads. */
186 Lisp_Object Vrecursive_load_depth_limit
;
188 /* Non-zero means load dangerous compiled Lisp files. */
190 int load_dangerous_libraries
;
192 /* A regular expression used to detect files compiled with Emacs. */
194 static Lisp_Object Vbytecomp_version_regexp
;
196 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
197 Lisp_Object (*) (), int,
198 Lisp_Object
, Lisp_Object
));
199 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
200 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
203 /* Handle unreading and rereading of characters.
204 Write READCHAR to read a character,
205 UNREAD(c) to unread c to be read again.
207 These macros actually read/unread a byte code, multibyte characters
208 are not handled here. The caller should manage them if necessary.
211 #define READCHAR readchar (readcharfun)
212 #define UNREAD(c) unreadchar (readcharfun, c)
215 readchar (readcharfun
)
216 Lisp_Object readcharfun
;
221 if (BUFFERP (readcharfun
))
223 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
225 int pt_byte
= BUF_PT_BYTE (inbuffer
);
226 int orig_pt_byte
= pt_byte
;
228 if (readchar_backlog
> 0)
229 /* We get the address of the byte just passed,
230 which is the last byte of the character.
231 The other bytes in this character are consecutive with it,
232 because the gap can't be in the middle of a character. */
233 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
234 - --readchar_backlog
);
236 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
239 readchar_backlog
= -1;
241 if (! NILP (inbuffer
->enable_multibyte_characters
))
243 /* Fetch the character code from the buffer. */
244 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
245 BUF_INC_POS (inbuffer
, pt_byte
);
246 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
250 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
253 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
257 if (MARKERP (readcharfun
))
259 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
261 int bytepos
= marker_byte_position (readcharfun
);
262 int orig_bytepos
= bytepos
;
264 if (readchar_backlog
> 0)
265 /* We get the address of the byte just passed,
266 which is the last byte of the character.
267 The other bytes in this character are consecutive with it,
268 because the gap can't be in the middle of a character. */
269 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
270 - --readchar_backlog
);
272 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
275 readchar_backlog
= -1;
277 if (! NILP (inbuffer
->enable_multibyte_characters
))
279 /* Fetch the character code from the buffer. */
280 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
281 BUF_INC_POS (inbuffer
, bytepos
);
282 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
286 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
290 XMARKER (readcharfun
)->bytepos
= bytepos
;
291 XMARKER (readcharfun
)->charpos
++;
296 if (EQ (readcharfun
, Qlambda
))
297 return read_bytecode_char (0);
299 if (EQ (readcharfun
, Qget_file_char
))
303 /* Interrupted reads have been observed while reading over the network */
304 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
313 if (STRINGP (readcharfun
))
315 if (read_from_string_index
>= read_from_string_limit
)
318 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
319 read_from_string_index
,
320 read_from_string_index_byte
);
325 tem
= call0 (readcharfun
);
332 /* Unread the character C in the way appropriate for the stream READCHARFUN.
333 If the stream is a user function, call it with the char as argument. */
336 unreadchar (readcharfun
, c
)
337 Lisp_Object readcharfun
;
341 /* Don't back up the pointer if we're unreading the end-of-input mark,
342 since readchar didn't advance it when we read it. */
344 else if (BUFFERP (readcharfun
))
346 struct buffer
*b
= XBUFFER (readcharfun
);
347 int bytepos
= BUF_PT_BYTE (b
);
349 if (readchar_backlog
>= 0)
354 if (! NILP (b
->enable_multibyte_characters
))
355 BUF_DEC_POS (b
, bytepos
);
359 BUF_PT_BYTE (b
) = bytepos
;
362 else if (MARKERP (readcharfun
))
364 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
365 int bytepos
= XMARKER (readcharfun
)->bytepos
;
367 if (readchar_backlog
>= 0)
371 XMARKER (readcharfun
)->charpos
--;
372 if (! NILP (b
->enable_multibyte_characters
))
373 BUF_DEC_POS (b
, bytepos
);
377 XMARKER (readcharfun
)->bytepos
= bytepos
;
380 else if (STRINGP (readcharfun
))
382 read_from_string_index
--;
383 read_from_string_index_byte
384 = string_char_to_byte (readcharfun
, read_from_string_index
);
386 else if (EQ (readcharfun
, Qlambda
))
387 read_bytecode_char (1);
388 else if (EQ (readcharfun
, Qget_file_char
))
389 ungetc (c
, instream
);
391 call1 (readcharfun
, make_number (c
));
394 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
395 static int read_multibyte ();
396 static Lisp_Object
substitute_object_recurse ();
397 static void substitute_object_in_subtree (), substitute_in_interval ();
400 /* Get a character from the tty. */
402 extern Lisp_Object
read_char ();
404 /* Read input events until we get one that's acceptable for our purposes.
406 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
407 until we get a character we like, and then stuffed into
410 If ASCII_REQUIRED is non-zero, we check function key events to see
411 if the unmodified version of the symbol has a Qascii_character
412 property, and use that character, if present.
414 If ERROR_NONASCII is non-zero, we signal an error if the input we
415 get isn't an ASCII character with modifiers. If it's zero but
416 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
419 If INPUT_METHOD is nonzero, we invoke the current input method
420 if the character warrants that. */
423 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
425 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
427 register Lisp_Object val
, delayed_switch_frame
;
429 #ifdef HAVE_WINDOW_SYSTEM
430 if (display_hourglass_p
)
434 delayed_switch_frame
= Qnil
;
436 /* Read until we get an acceptable event. */
438 val
= read_char (0, 0, 0,
439 (input_method
? Qnil
: Qt
),
445 /* switch-frame events are put off until after the next ASCII
446 character. This is better than signaling an error just because
447 the last characters were typed to a separate minibuffer frame,
448 for example. Eventually, some code which can deal with
449 switch-frame events will read it and process it. */
451 && EVENT_HAS_PARAMETERS (val
)
452 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
454 delayed_switch_frame
= val
;
460 /* Convert certain symbols to their ASCII equivalents. */
463 Lisp_Object tem
, tem1
;
464 tem
= Fget (val
, Qevent_symbol_element_mask
);
467 tem1
= Fget (Fcar (tem
), Qascii_character
);
468 /* Merge this symbol's modifier bits
469 with the ASCII equivalent of its basic code. */
471 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
475 /* If we don't have a character now, deal with it appropriately. */
480 Vunread_command_events
= Fcons (val
, Qnil
);
481 error ("Non-character input-event");
488 if (! NILP (delayed_switch_frame
))
489 unread_switch_frame
= delayed_switch_frame
;
491 #ifdef HAVE_WINDOW_SYSTEM
492 if (display_hourglass_p
)
498 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
499 "Read a character from the command input (keyboard or macro).\n\
500 It is returned as a number.\n\
501 If the user generates an event which is not a character (i.e. a mouse\n\
502 click or function key event), `read-char' signals an error. As an\n\
503 exception, switch-frame events are put off until non-ASCII events can\n\
505 If you want to read non-character events, or ignore them, call\n\
506 `read-event' or `read-char-exclusive' instead.\n\
508 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
509 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
510 input method is turned on in the current buffer, that input method\n\
511 is used for reading a character.")
512 (prompt
, inherit_input_method
)
513 Lisp_Object prompt
, inherit_input_method
;
516 message_with_string ("%s", prompt
, 0);
517 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
520 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
521 "Read an event object from the input stream.\n\
522 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
523 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
524 input method is turned on in the current buffer, that input method\n\
525 is used for reading a character.")
526 (prompt
, inherit_input_method
)
527 Lisp_Object prompt
, inherit_input_method
;
530 message_with_string ("%s", prompt
, 0);
531 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
534 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
535 "Read a character from the command input (keyboard or macro).\n\
536 It is returned as a number. Non-character events are ignored.\n\
538 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
539 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
540 input method is turned on in the current buffer, that input method\n\
541 is used for reading a character.")
542 (prompt
, inherit_input_method
)
543 Lisp_Object prompt
, inherit_input_method
;
546 message_with_string ("%s", prompt
, 0);
547 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
550 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
551 "Don't use this yourself.")
554 register Lisp_Object val
;
555 XSETINT (val
, getc (instream
));
561 /* Value is non-zero if the file asswociated with file descriptor FD
562 is a compiled Lisp file that's safe to load. Only files compiled
563 with Emacs are safe to load. Files compiled with XEmacs can lead
564 to a crash in Fbyte_code because of an incompatible change in the
575 /* Read the first few bytes from the file, and look for a line
576 specifying the byte compiler version used. */
577 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
582 /* Skip to the next newline, skipping over the initial `ELC'
583 with NUL bytes following it. */
584 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
588 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
593 lseek (fd
, 0, SEEK_SET
);
598 /* Callback for record_unwind_protect. Restore the old load list OLD,
599 after loading a file successfully. */
602 record_load_unwind (old
)
605 return Vloads_in_progress
= old
;
609 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
610 "Execute a file of Lisp code named FILE.\n\
611 First try FILE with `.elc' appended, then try with `.el',\n\
612 then try FILE unmodified.\n\
613 This function searches the directories in `load-path'.\n\
614 If optional second arg NOERROR is non-nil,\n\
615 report no error if FILE doesn't exist.\n\
616 Print messages at start and end of loading unless\n\
617 optional third arg NOMESSAGE is non-nil.\n\
618 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
619 suffixes `.elc' or `.el' to the specified name FILE.\n\
620 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
621 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
622 it ends in one of those suffixes or includes a directory name.\n\
623 Return t if file exists.")
624 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
625 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
627 register FILE *stream
;
628 register int fd
= -1;
629 register Lisp_Object lispstream
;
630 int count
= specpdl_ptr
- specpdl
;
634 /* 1 means we printed the ".el is newer" message. */
636 /* 1 means we are loading a compiled file. */
645 CHECK_STRING (file
, 0);
647 /* If file name is magic, call the handler. */
648 handler
= Ffind_file_name_handler (file
, Qload
);
650 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
652 /* Do this after the handler to avoid
653 the need to gcpro noerror, nomessage and nosuffix.
654 (Below here, we care only whether they are nil or not.) */
655 file
= Fsubstitute_in_file_name (file
);
657 /* Avoid weird lossage with null string as arg,
658 since it would try to load a directory as a Lisp file */
659 if (XSTRING (file
)->size
> 0)
661 int size
= STRING_BYTES (XSTRING (file
));
665 if (! NILP (must_suffix
))
667 /* Don't insist on adding a suffix if FILE already ends with one. */
669 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
672 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
674 /* Don't insist on adding a suffix
675 if the argument includes a directory name. */
676 else if (! NILP (Ffile_name_directory (file
)))
680 fd
= openp (Vload_path
, file
,
681 (!NILP (nosuffix
) ? ""
682 : ! NILP (must_suffix
) ? ".elc.gz:.elc:.el.gz:.el"
683 : ".elc:.elc.gz:.el.gz:.el:"),
692 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
693 Fcons (file
, Qnil
)));
698 /* Tell startup.el whether or not we found the user's init file. */
699 if (EQ (Qt
, Vuser_init_file
))
700 Vuser_init_file
= found
;
702 /* If FD is -2, that means openp found a magic file. */
705 if (NILP (Fequal (found
, file
)))
706 /* If FOUND is a different file name from FILE,
707 find its handler even if we have already inhibited
708 the `load' operation on FILE. */
709 handler
= Ffind_file_name_handler (found
, Qt
);
711 handler
= Ffind_file_name_handler (found
, Qload
);
712 if (! NILP (handler
))
713 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
716 /* Check if we're stuck in a recursive load cycle.
718 2000-09-21: It's not possible to just check for the file loaded
719 being a member of Vloads_in_progress. This fails because of the
720 way the byte compiler currently works; `provide's are not
721 evaluted, see font-lock.el/jit-lock.el as an example. This
722 leads to a certain amount of ``normal'' recursion.
724 Also, just loading a file recursively is not always an error in
725 the general case; the second load may do something different. */
726 if (INTEGERP (Vrecursive_load_depth_limit
)
727 && XINT (Vrecursive_load_depth_limit
) > 0)
729 Lisp_Object len
= Flength (Vloads_in_progress
);
730 if (XFASTINT (len
) > XFASTINT (Vrecursive_load_depth_limit
))
731 Fsignal (Qerror
, Fcons (build_string ("Recursive load suspected"),
732 Fcons (found
, Vloads_in_progress
)));
733 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
734 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
737 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
739 /* Load .elc files directly, but not when they are
740 remote and have no handler! */
747 if (!safe_to_load_p (fd
))
750 if (!load_dangerous_libraries
)
751 error ("File `%s' was not compiled in Emacs",
752 XSTRING (found
)->data
);
753 else if (!NILP (nomessage
))
754 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
762 stat ((char *)XSTRING (found
)->data
, &s1
);
763 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
764 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
765 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
767 /* Make the progress messages mention that source is newer. */
770 /* If we won't print another message, mention this anyway. */
771 if (! NILP (nomessage
))
772 message_with_string ("Source file `%s' newer than byte-compiled file",
775 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
780 /* We are loading a source file (*.el). */
781 if (!NILP (Vload_source_file_function
))
787 val
= call4 (Vload_source_file_function
, found
, file
,
788 NILP (noerror
) ? Qnil
: Qt
,
789 NILP (nomessage
) ? Qnil
: Qt
);
790 return unbind_to (count
, val
);
796 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
797 #else /* not WINDOWSNT */
798 stream
= fdopen (fd
, fmode
);
799 #endif /* not WINDOWSNT */
803 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
806 if (! NILP (Vpurify_flag
))
807 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
809 if (NILP (nomessage
))
812 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
815 message_with_string ("Loading %s (source)...", file
, 1);
817 message_with_string ("Loading %s (compiled; note, source file is newer)...",
819 else /* The typical case; compiled file newer than source file. */
820 message_with_string ("Loading %s...", file
, 1);
824 lispstream
= Fcons (Qnil
, Qnil
);
825 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
826 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
827 record_unwind_protect (load_unwind
, lispstream
);
828 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
829 specbind (Qload_file_name
, found
);
830 specbind (Qinhibit_file_name_operation
, Qnil
);
832 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
834 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
835 unbind_to (count
, Qnil
);
837 /* Run any load-hooks for this file. */
838 temp
= Fassoc (file
, Vafter_load_alist
);
840 Fprogn (Fcdr (temp
));
843 if (saved_doc_string
)
844 free (saved_doc_string
);
845 saved_doc_string
= 0;
846 saved_doc_string_size
= 0;
848 if (prev_saved_doc_string
)
849 xfree (prev_saved_doc_string
);
850 prev_saved_doc_string
= 0;
851 prev_saved_doc_string_size
= 0;
853 if (!noninteractive
&& NILP (nomessage
))
856 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
859 message_with_string ("Loading %s (source)...done", file
, 1);
861 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
863 else /* The typical case; compiled file newer than source file. */
864 message_with_string ("Loading %s...done", file
, 1);
871 load_unwind (stream
) /* used as unwind-protect function in load */
874 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
875 | XFASTINT (XCDR (stream
))));
876 if (--load_in_progress
< 0) load_in_progress
= 0;
881 load_descriptor_unwind (oldlist
)
884 load_descriptor_list
= oldlist
;
888 /* Close all descriptors in use for Floads.
889 This is used when starting a subprocess. */
896 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
897 emacs_close (XFASTINT (XCAR (tail
)));
902 complete_filename_p (pathname
)
903 Lisp_Object pathname
;
905 register unsigned char *s
= XSTRING (pathname
)->data
;
906 return (IS_DIRECTORY_SEP (s
[0])
907 || (XSTRING (pathname
)->size
> 2
908 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
918 /* Search for a file whose name is STR, looking in directories
919 in the Lisp list PATH, and trying suffixes from SUFFIX.
920 SUFFIX is a string containing possible suffixes separated by colons.
921 On success, returns a file descriptor. On failure, returns -1.
923 EXEC_ONLY nonzero means don't open the files,
924 just look for one that is executable. In this case,
925 returns 1 on success.
927 If STOREPTR is nonzero, it points to a slot where the name of
928 the file actually found should be stored as a Lisp string.
929 nil is stored there on failure.
931 If the file we find is remote, return -2
932 but store the found remote file name in *STOREPTR.
933 We do not check for remote files if EXEC_ONLY is nonzero. */
936 openp (path
, str
, suffix
, storeptr
, exec_only
)
937 Lisp_Object path
, str
;
939 Lisp_Object
*storeptr
;
945 register char *fn
= buf
;
948 Lisp_Object filename
;
950 struct gcpro gcpro1
, gcpro2
, gcpro3
;
953 string
= filename
= Qnil
;
954 GCPRO3 (str
, string
, filename
);
959 if (complete_filename_p (str
))
962 for (; !NILP (path
); path
= Fcdr (path
))
966 filename
= Fexpand_file_name (str
, Fcar (path
));
967 if (!complete_filename_p (filename
))
968 /* If there are non-absolute elts in PATH (eg ".") */
969 /* Of course, this could conceivably lose if luser sets
970 default-directory to be something non-absolute... */
972 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
973 if (!complete_filename_p (filename
))
974 /* Give up on this path element! */
978 /* Calculate maximum size of any filename made from
979 this path element/specified file name and any possible suffix. */
980 want_size
= strlen (suffix
) + STRING_BYTES (XSTRING (filename
)) + 1;
981 if (fn_size
< want_size
)
982 fn
= (char *) alloca (fn_size
= 100 + want_size
);
986 /* Loop over suffixes. */
989 char *esuffix
= (char *) index (nsuffix
, ':');
990 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
993 /* Concatenate path element/specified name with the suffix.
994 If the directory starts with /:, remove that. */
995 if (XSTRING (filename
)->size
> 2
996 && XSTRING (filename
)->data
[0] == '/'
997 && XSTRING (filename
)->data
[1] == ':')
999 strncpy (fn
, XSTRING (filename
)->data
+ 2,
1000 STRING_BYTES (XSTRING (filename
)) - 2);
1001 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
1005 strncpy (fn
, XSTRING (filename
)->data
,
1006 STRING_BYTES (XSTRING (filename
)));
1007 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
1010 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1011 strncat (fn
, nsuffix
, lsuffix
);
1013 /* Check that the file exists and is not a directory. */
1017 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
1018 if (! NILP (handler
) && ! exec_only
)
1022 string
= build_string (fn
);
1023 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
1024 : Ffile_readable_p (string
));
1026 && ! NILP (Ffile_directory_p (build_string (fn
))))
1031 /* We succeeded; return this descriptor and filename. */
1033 *storeptr
= build_string (fn
);
1040 int exists
= (stat (fn
, &st
) >= 0
1041 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1044 /* Check that we can access or open it. */
1046 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1048 fd
= emacs_open (fn
, O_RDONLY
, 0);
1052 /* We succeeded; return this descriptor and filename. */
1054 *storeptr
= build_string (fn
);
1061 /* Advance to next suffix. */
1064 nsuffix
+= lsuffix
+ 1;
1075 /* Merge the list we've accumulated of globals from the current input source
1076 into the load_history variable. The details depend on whether
1077 the source has an associated file name or not. */
1080 build_load_history (stream
, source
)
1084 register Lisp_Object tail
, prev
, newelt
;
1085 register Lisp_Object tem
, tem2
;
1086 register int foundit
, loading
;
1088 loading
= stream
|| !NARROWED
;
1090 tail
= Vload_history
;
1093 while (!NILP (tail
))
1097 /* Find the feature's previous assoc list... */
1098 if (!NILP (Fequal (source
, Fcar (tem
))))
1102 /* If we're loading, remove it. */
1106 Vload_history
= Fcdr (tail
);
1108 Fsetcdr (prev
, Fcdr (tail
));
1111 /* Otherwise, cons on new symbols that are not already members. */
1114 tem2
= Vcurrent_load_list
;
1116 while (CONSP (tem2
))
1118 newelt
= Fcar (tem2
);
1120 if (NILP (Fmemq (newelt
, tem
)))
1121 Fsetcar (tail
, Fcons (Fcar (tem
),
1122 Fcons (newelt
, Fcdr (tem
))));
1135 /* If we're loading, cons the new assoc onto the front of load-history,
1136 the most-recently-loaded position. Also do this if we didn't find
1137 an existing member for the current source. */
1138 if (loading
|| !foundit
)
1139 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1144 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1152 readevalloop_1 (old
)
1155 load_convert_to_unibyte
= ! NILP (old
);
1159 /* Signal an `end-of-file' error, if possible with file name
1163 end_of_file_error ()
1167 if (STRINGP (Vload_file_name
))
1168 data
= Fcons (Vload_file_name
, Qnil
);
1172 Fsignal (Qend_of_file
, data
);
1175 /* UNIBYTE specifies how to set load_convert_to_unibyte
1176 for this invocation.
1177 READFUN, if non-nil, is used instead of `read'. */
1180 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1181 Lisp_Object readcharfun
;
1183 Lisp_Object sourcename
;
1184 Lisp_Object (*evalfun
) ();
1186 Lisp_Object unibyte
, readfun
;
1189 register Lisp_Object val
;
1190 int count
= specpdl_ptr
- specpdl
;
1191 struct gcpro gcpro1
;
1192 struct buffer
*b
= 0;
1193 int continue_reading_p
;
1195 if (BUFFERP (readcharfun
))
1196 b
= XBUFFER (readcharfun
);
1197 else if (MARKERP (readcharfun
))
1198 b
= XMARKER (readcharfun
)->buffer
;
1200 specbind (Qstandard_input
, readcharfun
);
1201 specbind (Qcurrent_load_list
, Qnil
);
1202 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1203 load_convert_to_unibyte
= !NILP (unibyte
);
1205 readchar_backlog
= -1;
1207 GCPRO1 (sourcename
);
1209 LOADHIST_ATTACH (sourcename
);
1211 continue_reading_p
= 1;
1212 while (continue_reading_p
)
1214 if (b
!= 0 && NILP (b
->name
))
1215 error ("Reading from killed buffer");
1221 while ((c
= READCHAR
) != '\n' && c
!= -1);
1226 /* Ignore whitespace here, so we can detect eof. */
1227 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1230 if (!NILP (Vpurify_flag
) && c
== '(')
1232 int count1
= specpdl_ptr
- specpdl
;
1233 record_unwind_protect (unreadpure
, Qnil
);
1234 val
= read_list (-1, readcharfun
);
1235 unbind_to (count1
, Qnil
);
1240 read_objects
= Qnil
;
1241 if (!NILP (readfun
))
1243 val
= call1 (readfun
, readcharfun
);
1245 /* If READCHARFUN has set point to ZV, we should
1246 stop reading, even if the form read sets point
1247 to a different value when evaluated. */
1248 if (BUFFERP (readcharfun
))
1250 struct buffer
*b
= XBUFFER (readcharfun
);
1251 if (BUF_PT (b
) == BUF_ZV (b
))
1252 continue_reading_p
= 0;
1255 else if (! NILP (Vload_read_function
))
1256 val
= call1 (Vload_read_function
, readcharfun
);
1258 val
= read0 (readcharfun
);
1261 val
= (*evalfun
) (val
);
1265 Vvalues
= Fcons (val
, Vvalues
);
1266 if (EQ (Vstandard_output
, Qt
))
1273 build_load_history (stream
, sourcename
);
1276 unbind_to (count
, Qnil
);
1279 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1280 "Execute the current buffer as Lisp code.\n\
1281 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1282 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1283 PRINTFLAG controls printing of output:\n\
1284 nil means discard it; anything else is stream for print.\n\
1286 If the optional third argument FILENAME is non-nil,\n\
1287 it specifies the file name to use for `load-history'.\n\
1288 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\
1289 for this invocation.\n\
1291 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\
1292 `print' and related functions should work normally even if PRINTFLAG is nil.\n\
1294 This function preserves the position of point.")
1295 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1296 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1298 int count
= specpdl_ptr
- specpdl
;
1299 Lisp_Object tem
, buf
;
1302 buf
= Fcurrent_buffer ();
1304 buf
= Fget_buffer (buffer
);
1306 error ("No such buffer");
1308 if (NILP (printflag
) && NILP (do_allow_print
))
1313 if (NILP (filename
))
1314 filename
= XBUFFER (buf
)->filename
;
1316 specbind (Qstandard_output
, tem
);
1317 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1318 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1319 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1320 unbind_to (count
, Qnil
);
1326 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1327 "Execute the current buffer as Lisp code.\n\
1328 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1329 nil means discard it; anything else is stream for print.\n\
1331 If there is no error, point does not move. If there is an error,\n\
1332 point remains at the end of the last character read from the buffer.")
1334 Lisp_Object printflag
;
1336 int count
= specpdl_ptr
- specpdl
;
1337 Lisp_Object tem
, cbuf
;
1339 cbuf
= Fcurrent_buffer ()
1341 if (NILP (printflag
))
1345 specbind (Qstandard_output
, tem
);
1346 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1348 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1349 !NILP (printflag
), Qnil
, Qnil
);
1350 return unbind_to (count
, Qnil
);
1354 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1355 "Execute the region as Lisp code.\n\
1356 When called from programs, expects two arguments,\n\
1357 giving starting and ending indices in the current buffer\n\
1358 of the text to be executed.\n\
1359 Programs can pass third argument PRINTFLAG which controls output:\n\
1360 nil means discard it; anything else is stream for printing it.\n\
1361 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1362 instead of `read' to read each expression. It gets one argument\n\
1363 which is the input stream for reading characters.\n\
1365 This function does not move point.")
1366 (start
, end
, printflag
, read_function
)
1367 Lisp_Object start
, end
, printflag
, read_function
;
1369 int count
= specpdl_ptr
- specpdl
;
1370 Lisp_Object tem
, cbuf
;
1372 cbuf
= Fcurrent_buffer ();
1374 if (NILP (printflag
))
1378 specbind (Qstandard_output
, tem
);
1380 if (NILP (printflag
))
1381 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1382 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1384 /* This both uses start and checks its type. */
1386 Fnarrow_to_region (make_number (BEGV
), end
);
1387 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1388 !NILP (printflag
), Qnil
, read_function
);
1390 return unbind_to (count
, Qnil
);
1394 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1395 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1396 If STREAM is nil, use the value of `standard-input' (which see).\n\
1397 STREAM or the value of `standard-input' may be:\n\
1398 a buffer (read from point and advance it)\n\
1399 a marker (read from where it points and advance it)\n\
1400 a function (call it with no arguments for each character,\n\
1401 call it with a char as argument to push a char back)\n\
1402 a string (takes text from string, starting at the beginning)\n\
1403 t (read text line using minibuffer and use it, or read from\n\
1404 standard input in batch mode).")
1408 extern Lisp_Object
Fread_minibuffer ();
1411 stream
= Vstandard_input
;
1412 if (EQ (stream
, Qt
))
1413 stream
= Qread_char
;
1415 readchar_backlog
= -1;
1416 new_backquote_flag
= 0;
1417 read_objects
= Qnil
;
1419 if (EQ (stream
, Qread_char
))
1420 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1422 if (STRINGP (stream
))
1423 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1425 return read0 (stream
);
1428 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1429 "Read one Lisp expression which is represented as text by STRING.\n\
1430 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1431 START and END optionally delimit a substring of STRING from which to read;\n\
1432 they default to 0 and (length STRING) respectively.")
1433 (string
, start
, end
)
1434 Lisp_Object string
, start
, end
;
1436 int startval
, endval
;
1439 CHECK_STRING (string
,0);
1442 endval
= XSTRING (string
)->size
;
1445 CHECK_NUMBER (end
, 2);
1446 endval
= XINT (end
);
1447 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1448 args_out_of_range (string
, end
);
1455 CHECK_NUMBER (start
, 1);
1456 startval
= XINT (start
);
1457 if (startval
< 0 || startval
> endval
)
1458 args_out_of_range (string
, start
);
1461 read_from_string_index
= startval
;
1462 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1463 read_from_string_limit
= endval
;
1465 new_backquote_flag
= 0;
1466 read_objects
= Qnil
;
1468 tem
= read0 (string
);
1469 return Fcons (tem
, make_number (read_from_string_index
));
1472 /* Use this for recursive reads, in contexts where internal tokens
1477 Lisp_Object readcharfun
;
1479 register Lisp_Object val
;
1482 val
= read1 (readcharfun
, &c
, 0);
1484 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1491 static int read_buffer_size
;
1492 static char *read_buffer
;
1494 /* Read multibyte form and return it as a character. C is a first
1495 byte of multibyte form, and rest of them are read from
1499 read_multibyte (c
, readcharfun
)
1501 Lisp_Object readcharfun
;
1503 /* We need the actual character code of this multibyte
1505 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1510 while ((c
= READCHAR
) >= 0xA0
1511 && len
< MAX_MULTIBYTE_LENGTH
)
1514 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1515 return STRING_CHAR (str
, len
);
1516 /* The byte sequence is not valid as multibyte. Unread all bytes
1517 but the first one, and return the first byte. */
1523 /* Read a \-escape sequence, assuming we already read the `\'. */
1526 read_escape (readcharfun
, stringp
)
1527 Lisp_Object readcharfun
;
1530 register int c
= READCHAR
;
1534 error ("End of file");
1564 error ("Invalid escape character syntax");
1567 c
= read_escape (readcharfun
, 0);
1568 return c
| meta_modifier
;
1573 error ("Invalid escape character syntax");
1576 c
= read_escape (readcharfun
, 0);
1577 return c
| shift_modifier
;
1582 error ("Invalid escape character syntax");
1585 c
= read_escape (readcharfun
, 0);
1586 return c
| hyper_modifier
;
1591 error ("Invalid escape character syntax");
1594 c
= read_escape (readcharfun
, 0);
1595 return c
| alt_modifier
;
1600 error ("Invalid escape character syntax");
1603 c
= read_escape (readcharfun
, 0);
1604 return c
| super_modifier
;
1609 error ("Invalid escape character syntax");
1613 c
= read_escape (readcharfun
, 0);
1614 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1615 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1616 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1617 return c
| ctrl_modifier
;
1618 /* ASCII control chars are made from letters (both cases),
1619 as well as the non-letters within 0100...0137. */
1620 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1621 return (c
& (037 | ~0177));
1622 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1623 return (c
& (037 | ~0177));
1625 return c
| ctrl_modifier
;
1635 /* An octal escape, as in ANSI C. */
1637 register int i
= c
- '0';
1638 register int count
= 0;
1641 if ((c
= READCHAR
) >= '0' && c
<= '7')
1656 /* A hex escape, as in ANSI C. */
1662 if (c
>= '0' && c
<= '9')
1667 else if ((c
>= 'a' && c
<= 'f')
1668 || (c
>= 'A' && c
<= 'F'))
1671 if (c
>= 'a' && c
<= 'f')
1686 if (BASE_LEADING_CODE_P (c
))
1687 c
= read_multibyte (c
, readcharfun
);
1693 /* Read an integer in radix RADIX using READCHARFUN to read
1694 characters. RADIX must be in the interval [2..36]; if it isn't, a
1695 read error is signaled . Value is the integer read. Signals an
1696 error if encountering invalid read syntax or if RADIX is out of
1700 read_integer (readcharfun
, radix
)
1701 Lisp_Object readcharfun
;
1704 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1705 EMACS_INT number
= 0;
1707 if (radix
< 2 || radix
> 36)
1711 number
= ndigits
= invalid_p
= 0;
1727 if (c
>= '0' && c
<= '9')
1729 else if (c
>= 'a' && c
<= 'z')
1730 digit
= c
- 'a' + 10;
1731 else if (c
>= 'A' && c
<= 'Z')
1732 digit
= c
- 'A' + 10;
1739 if (digit
< 0 || digit
>= radix
)
1742 number
= radix
* number
+ digit
;
1748 if (ndigits
== 0 || invalid_p
)
1751 sprintf (buf
, "integer, radix %d", radix
);
1752 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1755 return make_number (sign
* number
);
1759 /* If the next token is ')' or ']' or '.', we store that character
1760 in *PCH and the return value is not interesting. Else, we store
1761 zero in *PCH and we read and return one lisp object.
1763 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1766 read1 (readcharfun
, pch
, first_in_list
)
1767 register Lisp_Object readcharfun
;
1772 int uninterned_symbol
= 0;
1780 end_of_file_error ();
1785 return read_list (0, readcharfun
);
1788 return read_vector (readcharfun
, 0);
1805 tmp
= read_vector (readcharfun
, 0);
1806 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1807 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1808 error ("Invalid size char-table");
1809 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1810 XCHAR_TABLE (tmp
)->top
= Qt
;
1819 tmp
= read_vector (readcharfun
, 0);
1820 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1821 error ("Invalid size char-table");
1822 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1823 XCHAR_TABLE (tmp
)->top
= Qnil
;
1826 Fsignal (Qinvalid_read_syntax
,
1827 Fcons (make_string ("#^^", 3), Qnil
));
1829 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1834 length
= read1 (readcharfun
, pch
, first_in_list
);
1838 Lisp_Object tmp
, val
;
1839 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1843 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1844 if (size_in_chars
!= XSTRING (tmp
)->size
1845 /* We used to print 1 char too many
1846 when the number of bits was a multiple of 8.
1847 Accept such input in case it came from an old version. */
1848 && ! (XFASTINT (length
)
1849 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1850 Fsignal (Qinvalid_read_syntax
,
1851 Fcons (make_string ("#&...", 5), Qnil
));
1853 val
= Fmake_bool_vector (length
, Qnil
);
1854 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1856 /* Clear the extraneous bits in the last byte. */
1857 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1858 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1859 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1862 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1867 /* Accept compiled functions at read-time so that we don't have to
1868 build them using function calls. */
1870 tmp
= read_vector (readcharfun
, 1);
1871 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1872 XVECTOR (tmp
)->contents
);
1877 struct gcpro gcpro1
;
1880 /* Read the string itself. */
1881 tmp
= read1 (readcharfun
, &ch
, 0);
1882 if (ch
!= 0 || !STRINGP (tmp
))
1883 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1885 /* Read the intervals and their properties. */
1888 Lisp_Object beg
, end
, plist
;
1890 beg
= read1 (readcharfun
, &ch
, 0);
1895 end
= read1 (readcharfun
, &ch
, 0);
1897 plist
= read1 (readcharfun
, &ch
, 0);
1899 Fsignal (Qinvalid_read_syntax
,
1900 Fcons (build_string ("invalid string property list"),
1902 Fset_text_properties (beg
, end
, plist
, tmp
);
1908 /* #@NUMBER is used to skip NUMBER following characters.
1909 That's used in .elc files to skip over doc strings
1910 and function definitions. */
1915 /* Read a decimal integer. */
1916 while ((c
= READCHAR
) >= 0
1917 && c
>= '0' && c
<= '9')
1925 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1927 /* If we are supposed to force doc strings into core right now,
1928 record the last string that we skipped,
1929 and record where in the file it comes from. */
1931 /* But first exchange saved_doc_string
1932 with prev_saved_doc_string, so we save two strings. */
1934 char *temp
= saved_doc_string
;
1935 int temp_size
= saved_doc_string_size
;
1936 file_offset temp_pos
= saved_doc_string_position
;
1937 int temp_len
= saved_doc_string_length
;
1939 saved_doc_string
= prev_saved_doc_string
;
1940 saved_doc_string_size
= prev_saved_doc_string_size
;
1941 saved_doc_string_position
= prev_saved_doc_string_position
;
1942 saved_doc_string_length
= prev_saved_doc_string_length
;
1944 prev_saved_doc_string
= temp
;
1945 prev_saved_doc_string_size
= temp_size
;
1946 prev_saved_doc_string_position
= temp_pos
;
1947 prev_saved_doc_string_length
= temp_len
;
1950 if (saved_doc_string_size
== 0)
1952 saved_doc_string_size
= nskip
+ 100;
1953 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1955 if (nskip
> saved_doc_string_size
)
1957 saved_doc_string_size
= nskip
+ 100;
1958 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1959 saved_doc_string_size
);
1962 saved_doc_string_position
= file_tell (instream
);
1964 /* Copy that many characters into saved_doc_string. */
1965 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1966 saved_doc_string
[i
] = c
= READCHAR
;
1968 saved_doc_string_length
= i
;
1972 /* Skip that many characters. */
1973 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1980 return Vload_file_name
;
1982 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1983 /* #:foo is the uninterned symbol named foo. */
1986 uninterned_symbol
= 1;
1990 /* Reader forms that can reuse previously read objects. */
1991 if (c
>= '0' && c
<= '9')
1996 /* Read a non-negative integer. */
1997 while (c
>= '0' && c
<= '9')
2003 /* #n=object returns object, but associates it with n for #n#. */
2006 /* Make a placeholder for #n# to use temporarily */
2007 Lisp_Object placeholder
;
2010 placeholder
= Fcons(Qnil
, Qnil
);
2011 cell
= Fcons (make_number (n
), placeholder
);
2012 read_objects
= Fcons (cell
, read_objects
);
2014 /* Read the object itself. */
2015 tem
= read0 (readcharfun
);
2017 /* Now put it everywhere the placeholder was... */
2018 substitute_object_in_subtree (tem
, placeholder
);
2020 /* ...and #n# will use the real value from now on. */
2021 Fsetcdr (cell
, tem
);
2025 /* #n# returns a previously read object. */
2028 tem
= Fassq (make_number (n
), read_objects
);
2031 /* Fall through to error message. */
2033 else if (c
== 'r' || c
== 'R')
2034 return read_integer (readcharfun
, n
);
2036 /* Fall through to error message. */
2038 else if (c
== 'x' || c
== 'X')
2039 return read_integer (readcharfun
, 16);
2040 else if (c
== 'o' || c
== 'O')
2041 return read_integer (readcharfun
, 8);
2042 else if (c
== 'b' || c
== 'B')
2043 return read_integer (readcharfun
, 2);
2046 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2049 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2054 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2064 new_backquote_flag
= 1;
2065 value
= read0 (readcharfun
);
2066 new_backquote_flag
= 0;
2068 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2072 if (new_backquote_flag
)
2074 Lisp_Object comma_type
= Qnil
;
2079 comma_type
= Qcomma_at
;
2081 comma_type
= Qcomma_dot
;
2084 if (ch
>= 0) UNREAD (ch
);
2085 comma_type
= Qcomma
;
2088 new_backquote_flag
= 0;
2089 value
= read0 (readcharfun
);
2090 new_backquote_flag
= 1;
2091 return Fcons (comma_type
, Fcons (value
, Qnil
));
2100 end_of_file_error ();
2103 c
= read_escape (readcharfun
, 0);
2104 else if (BASE_LEADING_CODE_P (c
))
2105 c
= read_multibyte (c
, readcharfun
);
2107 return make_number (c
);
2112 register char *p
= read_buffer
;
2113 register char *end
= read_buffer
+ read_buffer_size
;
2115 /* Nonzero if we saw an escape sequence specifying
2116 a multibyte character. */
2117 int force_multibyte
= 0;
2118 /* Nonzero if we saw an escape sequence specifying
2119 a single-byte character. */
2120 int force_singlebyte
= 0;
2124 while ((c
= READCHAR
) >= 0
2127 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2129 int offset
= p
- read_buffer
;
2130 read_buffer
= (char *) xrealloc (read_buffer
,
2131 read_buffer_size
*= 2);
2132 p
= read_buffer
+ offset
;
2133 end
= read_buffer
+ read_buffer_size
;
2138 c
= read_escape (readcharfun
, 1);
2140 /* C is -1 if \ newline has just been seen */
2143 if (p
== read_buffer
)
2148 /* If an escape specifies a non-ASCII single-byte character,
2149 this must be a unibyte string. */
2150 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2151 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2152 force_singlebyte
= 1;
2155 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2157 /* Any modifiers for a multibyte character are invalid. */
2158 if (c
& CHAR_MODIFIER_MASK
)
2159 error ("Invalid modifier in string");
2160 p
+= CHAR_STRING (c
, p
);
2161 force_multibyte
= 1;
2165 /* Allow `\C- ' and `\C-?'. */
2166 if (c
== (CHAR_CTL
| ' '))
2168 else if (c
== (CHAR_CTL
| '?'))
2173 /* Shift modifier is valid only with [A-Za-z]. */
2174 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2176 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2177 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2181 /* Move the meta bit to the right place for a string. */
2182 c
= (c
& ~CHAR_META
) | 0x80;
2184 error ("Invalid modifier in string");
2189 end_of_file_error ();
2191 /* If purifying, and string starts with \ newline,
2192 return zero instead. This is for doc strings
2193 that we are really going to find in etc/DOC.nn.nn */
2194 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2195 return make_number (0);
2197 if (force_multibyte
)
2198 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2199 p
- read_buffer
, &nchars
);
2200 else if (force_singlebyte
)
2201 nchars
= p
- read_buffer
;
2202 else if (load_convert_to_unibyte
)
2205 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2206 p
- read_buffer
, &nchars
);
2207 if (p
- read_buffer
!= nchars
)
2209 string
= make_multibyte_string (read_buffer
, nchars
,
2211 return Fstring_make_unibyte (string
);
2214 else if (EQ (readcharfun
, Qget_file_char
)
2215 || EQ (readcharfun
, Qlambda
))
2216 /* Nowadays, reading directly from a file is used only for
2217 compiled Emacs Lisp files, and those always use the
2218 Emacs internal encoding. Meanwhile, Qlambda is used
2219 for reading dynamic byte code (compiled with
2220 byte-compile-dynamic = t). */
2221 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2222 p
- read_buffer
, &nchars
);
2224 /* In all other cases, if we read these bytes as
2225 separate characters, treat them as separate characters now. */
2226 nchars
= p
- read_buffer
;
2229 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2231 || (p
- read_buffer
!= nchars
)));
2232 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2234 || (p
- read_buffer
!= nchars
)));
2239 int next_char
= READCHAR
;
2242 if (next_char
<= 040
2243 || index ("\"'`,(", next_char
))
2249 /* Otherwise, we fall through! Note that the atom-reading loop
2250 below will now loop at least once, assuring that we will not
2251 try to UNREAD two characters in a row. */
2255 if (c
<= 040) goto retry
;
2257 char *p
= read_buffer
;
2261 char *end
= read_buffer
+ read_buffer_size
;
2264 && !(c
== '\"' || c
== '\'' || c
== ';'
2265 || c
== '(' || c
== ')'
2266 || c
== '[' || c
== ']' || c
== '#'))
2268 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2270 int offset
= p
- read_buffer
;
2271 read_buffer
= (char *) xrealloc (read_buffer
,
2272 read_buffer_size
*= 2);
2273 p
= read_buffer
+ offset
;
2274 end
= read_buffer
+ read_buffer_size
;
2281 end_of_file_error ();
2285 if (! SINGLE_BYTE_CHAR_P (c
))
2286 p
+= CHAR_STRING (c
, p
);
2295 int offset
= p
- read_buffer
;
2296 read_buffer
= (char *) xrealloc (read_buffer
,
2297 read_buffer_size
*= 2);
2298 p
= read_buffer
+ offset
;
2299 end
= read_buffer
+ read_buffer_size
;
2306 if (!quoted
&& !uninterned_symbol
)
2309 register Lisp_Object val
;
2311 if (*p1
== '+' || *p1
== '-') p1
++;
2312 /* Is it an integer? */
2315 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2316 /* Integers can have trailing decimal points. */
2317 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2319 /* It is an integer. */
2323 if (sizeof (int) == sizeof (EMACS_INT
))
2324 XSETINT (val
, atoi (read_buffer
));
2325 else if (sizeof (long) == sizeof (EMACS_INT
))
2326 XSETINT (val
, atol (read_buffer
));
2332 if (isfloat_string (read_buffer
))
2334 /* Compute NaN and infinities using 0.0 in a variable,
2335 to cope with compilers that think they are smarter
2341 /* Negate the value ourselves. This treats 0, NaNs,
2342 and infinity properly on IEEE floating point hosts,
2343 and works around a common bug where atof ("-0.0")
2345 int negative
= read_buffer
[0] == '-';
2347 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2348 returns 1, is if the input ends in e+INF or e+NaN. */
2355 value
= zero
/ zero
;
2358 value
= atof (read_buffer
+ negative
);
2362 return make_float (negative
? - value
: value
);
2366 if (uninterned_symbol
)
2367 return make_symbol (read_buffer
);
2369 return intern (read_buffer
);
2375 /* List of nodes we've seen during substitute_object_in_subtree. */
2376 static Lisp_Object seen_list
;
2379 substitute_object_in_subtree (object
, placeholder
)
2381 Lisp_Object placeholder
;
2383 Lisp_Object check_object
;
2385 /* We haven't seen any objects when we start. */
2388 /* Make all the substitutions. */
2390 = substitute_object_recurse (object
, placeholder
, object
);
2392 /* Clear seen_list because we're done with it. */
2395 /* The returned object here is expected to always eq the
2397 if (!EQ (check_object
, object
))
2398 error ("Unexpected mutation error in reader");
2401 /* Feval doesn't get called from here, so no gc protection is needed. */
2402 #define SUBSTITUTE(get_val, set_val) \
2404 Lisp_Object old_value = get_val; \
2405 Lisp_Object true_value \
2406 = substitute_object_recurse (object, placeholder,\
2409 if (!EQ (old_value, true_value)) \
2416 substitute_object_recurse (object
, placeholder
, subtree
)
2418 Lisp_Object placeholder
;
2419 Lisp_Object subtree
;
2421 /* If we find the placeholder, return the target object. */
2422 if (EQ (placeholder
, subtree
))
2425 /* If we've been to this node before, don't explore it again. */
2426 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2429 /* If this node can be the entry point to a cycle, remember that
2430 we've seen it. It can only be such an entry point if it was made
2431 by #n=, which means that we can find it as a value in
2433 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2434 seen_list
= Fcons (subtree
, seen_list
);
2436 /* Recurse according to subtree's type.
2437 Every branch must return a Lisp_Object. */
2438 switch (XTYPE (subtree
))
2440 case Lisp_Vectorlike
:
2443 int length
= XINT (Flength(subtree
));
2444 for (i
= 0; i
< length
; i
++)
2446 Lisp_Object idx
= make_number (i
);
2447 SUBSTITUTE (Faref (subtree
, idx
),
2448 Faset (subtree
, idx
, true_value
));
2455 SUBSTITUTE (Fcar_safe (subtree
),
2456 Fsetcar (subtree
, true_value
));
2457 SUBSTITUTE (Fcdr_safe (subtree
),
2458 Fsetcdr (subtree
, true_value
));
2464 /* Check for text properties in each interval.
2465 substitute_in_interval contains part of the logic. */
2467 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2468 Lisp_Object arg
= Fcons (object
, placeholder
);
2470 traverse_intervals (root_interval
, 1, 0,
2471 &substitute_in_interval
, arg
);
2476 /* Other types don't recurse any further. */
2482 /* Helper function for substitute_object_recurse. */
2484 substitute_in_interval (interval
, arg
)
2488 Lisp_Object object
= Fcar (arg
);
2489 Lisp_Object placeholder
= Fcdr (arg
);
2491 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2510 if (*cp
== '+' || *cp
== '-')
2513 if (*cp
>= '0' && *cp
<= '9')
2516 while (*cp
>= '0' && *cp
<= '9')
2524 if (*cp
>= '0' && *cp
<= '9')
2527 while (*cp
>= '0' && *cp
<= '9')
2530 if (*cp
== 'e' || *cp
== 'E')
2534 if (*cp
== '+' || *cp
== '-')
2538 if (*cp
>= '0' && *cp
<= '9')
2541 while (*cp
>= '0' && *cp
<= '9')
2544 else if (cp
== start
)
2546 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2551 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2557 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2558 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2559 || state
== (DOT_CHAR
|TRAIL_INT
)
2560 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2561 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2562 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2567 read_vector (readcharfun
, bytecodeflag
)
2568 Lisp_Object readcharfun
;
2573 register Lisp_Object
*ptr
;
2574 register Lisp_Object tem
, item
, vector
;
2575 register struct Lisp_Cons
*otem
;
2578 tem
= read_list (1, readcharfun
);
2579 len
= Flength (tem
);
2580 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2582 size
= XVECTOR (vector
)->size
;
2583 ptr
= XVECTOR (vector
)->contents
;
2584 for (i
= 0; i
< size
; i
++)
2587 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2588 bytecode object, the docstring containing the bytecode and
2589 constants values must be treated as unibyte and passed to
2590 Fread, to get the actual bytecode string and constants vector. */
2591 if (bytecodeflag
&& load_force_doc_strings
)
2593 if (i
== COMPILED_BYTECODE
)
2595 if (!STRINGP (item
))
2596 error ("invalid byte code");
2598 /* Delay handling the bytecode slot until we know whether
2599 it is lazily-loaded (we can tell by whether the
2600 constants slot is nil). */
2601 ptr
[COMPILED_CONSTANTS
] = item
;
2604 else if (i
== COMPILED_CONSTANTS
)
2606 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2610 /* Coerce string to unibyte (like string-as-unibyte,
2611 but without generating extra garbage and
2612 guaranteeing no change in the contents). */
2613 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2614 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2616 item
= Fread (bytestr
);
2618 error ("invalid byte code");
2620 otem
= XCONS (item
);
2621 bytestr
= XCAR (item
);
2626 /* Now handle the bytecode slot. */
2627 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2630 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2638 /* FLAG = 1 means check for ] to terminate rather than ) and .
2639 FLAG = -1 means check for starting with defun
2640 and make structure pure. */
2643 read_list (flag
, readcharfun
)
2645 register Lisp_Object readcharfun
;
2647 /* -1 means check next element for defun,
2648 0 means don't check,
2649 1 means already checked and found defun. */
2650 int defunflag
= flag
< 0 ? -1 : 0;
2651 Lisp_Object val
, tail
;
2652 register Lisp_Object elt
, tem
;
2653 struct gcpro gcpro1
, gcpro2
;
2654 /* 0 is the normal case.
2655 1 means this list is a doc reference; replace it with the number 0.
2656 2 means this list is a doc reference; replace it with the doc string. */
2657 int doc_reference
= 0;
2659 /* Initialize this to 1 if we are reading a list. */
2660 int first_in_list
= flag
<= 0;
2669 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2674 /* While building, if the list starts with #$, treat it specially. */
2675 if (EQ (elt
, Vload_file_name
)
2677 && !NILP (Vpurify_flag
))
2679 if (NILP (Vdoc_file_name
))
2680 /* We have not yet called Snarf-documentation, so assume
2681 this file is described in the DOC-MM.NN file
2682 and Snarf-documentation will fill in the right value later.
2683 For now, replace the whole list with 0. */
2686 /* We have already called Snarf-documentation, so make a relative
2687 file name for this file, so it can be found properly
2688 in the installed Lisp directory.
2689 We don't use Fexpand_file_name because that would make
2690 the directory absolute now. */
2691 elt
= concat2 (build_string ("../lisp/"),
2692 Ffile_name_nondirectory (elt
));
2694 else if (EQ (elt
, Vload_file_name
)
2696 && load_force_doc_strings
)
2705 Fsignal (Qinvalid_read_syntax
,
2706 Fcons (make_string (") or . in a vector", 18), Qnil
));
2714 XCDR (tail
) = read0 (readcharfun
);
2716 val
= read0 (readcharfun
);
2717 read1 (readcharfun
, &ch
, 0);
2721 if (doc_reference
== 1)
2722 return make_number (0);
2723 if (doc_reference
== 2)
2725 /* Get a doc string from the file we are loading.
2726 If it's in saved_doc_string, get it from there. */
2727 int pos
= XINT (XCDR (val
));
2728 /* Position is negative for user variables. */
2729 if (pos
< 0) pos
= -pos
;
2730 if (pos
>= saved_doc_string_position
2731 && pos
< (saved_doc_string_position
2732 + saved_doc_string_length
))
2734 int start
= pos
- saved_doc_string_position
;
2737 /* Process quoting with ^A,
2738 and find the end of the string,
2739 which is marked with ^_ (037). */
2740 for (from
= start
, to
= start
;
2741 saved_doc_string
[from
] != 037;)
2743 int c
= saved_doc_string
[from
++];
2746 c
= saved_doc_string
[from
++];
2748 saved_doc_string
[to
++] = c
;
2750 saved_doc_string
[to
++] = 0;
2752 saved_doc_string
[to
++] = 037;
2755 saved_doc_string
[to
++] = c
;
2758 return make_string (saved_doc_string
+ start
,
2761 /* Look in prev_saved_doc_string the same way. */
2762 else if (pos
>= prev_saved_doc_string_position
2763 && pos
< (prev_saved_doc_string_position
2764 + prev_saved_doc_string_length
))
2766 int start
= pos
- prev_saved_doc_string_position
;
2769 /* Process quoting with ^A,
2770 and find the end of the string,
2771 which is marked with ^_ (037). */
2772 for (from
= start
, to
= start
;
2773 prev_saved_doc_string
[from
] != 037;)
2775 int c
= prev_saved_doc_string
[from
++];
2778 c
= prev_saved_doc_string
[from
++];
2780 prev_saved_doc_string
[to
++] = c
;
2782 prev_saved_doc_string
[to
++] = 0;
2784 prev_saved_doc_string
[to
++] = 037;
2787 prev_saved_doc_string
[to
++] = c
;
2790 return make_string (prev_saved_doc_string
+ start
,
2794 return get_doc_string (val
, 0, 0);
2799 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2801 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2803 tem
= (read_pure
&& flag
<= 0
2804 ? pure_cons (elt
, Qnil
)
2805 : Fcons (elt
, Qnil
));
2812 defunflag
= EQ (elt
, Qdefun
);
2813 else if (defunflag
> 0)
2818 Lisp_Object Vobarray
;
2819 Lisp_Object initial_obarray
;
2821 /* oblookup stores the bucket number here, for the sake of Funintern. */
2823 int oblookup_last_bucket_number
;
2825 static int hash_string ();
2826 Lisp_Object
oblookup ();
2828 /* Get an error if OBARRAY is not an obarray.
2829 If it is one, return it. */
2832 check_obarray (obarray
)
2833 Lisp_Object obarray
;
2835 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2837 /* If Vobarray is now invalid, force it to be valid. */
2838 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2840 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2845 /* Intern the C string STR: return a symbol with that name,
2846 interned in the current obarray. */
2853 int len
= strlen (str
);
2854 Lisp_Object obarray
;
2857 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2858 obarray
= check_obarray (obarray
);
2859 tem
= oblookup (obarray
, str
, len
, len
);
2862 return Fintern (make_string (str
, len
), obarray
);
2865 /* Create an uninterned symbol with name STR. */
2871 int len
= strlen (str
);
2873 return Fmake_symbol ((!NILP (Vpurify_flag
)
2874 ? make_pure_string (str
, len
, len
, 0)
2875 : make_string (str
, len
)));
2878 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2879 "Return the canonical symbol whose name is STRING.\n\
2880 If there is none, one is created by this function and returned.\n\
2881 A second optional argument specifies the obarray to use;\n\
2882 it defaults to the value of `obarray'.")
2884 Lisp_Object string
, obarray
;
2886 register Lisp_Object tem
, sym
, *ptr
;
2888 if (NILP (obarray
)) obarray
= Vobarray
;
2889 obarray
= check_obarray (obarray
);
2891 CHECK_STRING (string
, 0);
2893 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2894 XSTRING (string
)->size
,
2895 STRING_BYTES (XSTRING (string
)));
2896 if (!INTEGERP (tem
))
2899 if (!NILP (Vpurify_flag
))
2900 string
= Fpurecopy (string
);
2901 sym
= Fmake_symbol (string
);
2902 XSYMBOL (sym
)->obarray
= obarray
;
2904 if ((XSTRING (string
)->data
[0] == ':')
2905 && EQ (obarray
, initial_obarray
))
2906 XSYMBOL (sym
)->value
= sym
;
2908 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2910 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2912 XSYMBOL (sym
)->next
= 0;
2917 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2918 "Return the canonical symbol named NAME, or nil if none exists.\n\
2919 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2920 symbol is searched for.\n\
2921 A second optional argument specifies the obarray to use;\n\
2922 it defaults to the value of `obarray'.")
2924 Lisp_Object name
, obarray
;
2926 register Lisp_Object tem
;
2927 struct Lisp_String
*string
;
2929 if (NILP (obarray
)) obarray
= Vobarray
;
2930 obarray
= check_obarray (obarray
);
2932 if (!SYMBOLP (name
))
2934 CHECK_STRING (name
, 0);
2935 string
= XSTRING (name
);
2938 string
= XSYMBOL (name
)->name
;
2940 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2941 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2947 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2948 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2949 The value is t if a symbol was found and deleted, nil otherwise.\n\
2950 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2951 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2952 OBARRAY defaults to the value of the variable `obarray'.")
2954 Lisp_Object name
, obarray
;
2956 register Lisp_Object string
, tem
;
2959 if (NILP (obarray
)) obarray
= Vobarray
;
2960 obarray
= check_obarray (obarray
);
2963 XSETSTRING (string
, XSYMBOL (name
)->name
);
2966 CHECK_STRING (name
, 0);
2970 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2971 XSTRING (string
)->size
,
2972 STRING_BYTES (XSTRING (string
)));
2975 /* If arg was a symbol, don't delete anything but that symbol itself. */
2976 if (SYMBOLP (name
) && !EQ (name
, tem
))
2979 XSYMBOL (tem
)->obarray
= Qnil
;
2981 hash
= oblookup_last_bucket_number
;
2983 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2985 if (XSYMBOL (tem
)->next
)
2986 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2988 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2992 Lisp_Object tail
, following
;
2994 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2995 XSYMBOL (tail
)->next
;
2998 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2999 if (EQ (following
, tem
))
3001 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3010 /* Return the symbol in OBARRAY whose names matches the string
3011 of SIZE characters (SIZE_BYTE bytes) at PTR.
3012 If there is no such symbol in OBARRAY, return nil.
3014 Also store the bucket number in oblookup_last_bucket_number. */
3017 oblookup (obarray
, ptr
, size
, size_byte
)
3018 Lisp_Object obarray
;
3020 int size
, size_byte
;
3024 register Lisp_Object tail
;
3025 Lisp_Object bucket
, tem
;
3027 if (!VECTORP (obarray
)
3028 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3030 obarray
= check_obarray (obarray
);
3031 obsize
= XVECTOR (obarray
)->size
;
3033 /* This is sometimes needed in the middle of GC. */
3034 obsize
&= ~ARRAY_MARK_FLAG
;
3035 /* Combining next two lines breaks VMS C 2.3. */
3036 hash
= hash_string (ptr
, size_byte
);
3038 bucket
= XVECTOR (obarray
)->contents
[hash
];
3039 oblookup_last_bucket_number
= hash
;
3040 if (XFASTINT (bucket
) == 0)
3042 else if (!SYMBOLP (bucket
))
3043 error ("Bad data in guts of obarray"); /* Like CADR error message */
3045 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3047 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
3048 && XSYMBOL (tail
)->name
->size
== size
3049 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
3051 else if (XSYMBOL (tail
)->next
== 0)
3054 XSETINT (tem
, hash
);
3059 hash_string (ptr
, len
)
3063 register unsigned char *p
= ptr
;
3064 register unsigned char *end
= p
+ len
;
3065 register unsigned char c
;
3066 register int hash
= 0;
3071 if (c
>= 0140) c
-= 40;
3072 hash
= ((hash
<<3) + (hash
>>28) + c
);
3074 return hash
& 07777777777;
3078 map_obarray (obarray
, fn
, arg
)
3079 Lisp_Object obarray
;
3080 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3084 register Lisp_Object tail
;
3085 CHECK_VECTOR (obarray
, 1);
3086 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3088 tail
= XVECTOR (obarray
)->contents
[i
];
3093 if (XSYMBOL (tail
)->next
== 0)
3095 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3101 mapatoms_1 (sym
, function
)
3102 Lisp_Object sym
, function
;
3104 call1 (function
, sym
);
3107 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3108 "Call FUNCTION on every symbol in OBARRAY.\n\
3109 OBARRAY defaults to the value of `obarray'.")
3111 Lisp_Object function
, obarray
;
3113 if (NILP (obarray
)) obarray
= Vobarray
;
3114 obarray
= check_obarray (obarray
);
3116 map_obarray (obarray
, mapatoms_1
, function
);
3120 #define OBARRAY_SIZE 1511
3125 Lisp_Object oblength
;
3129 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3131 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3132 Vobarray
= Fmake_vector (oblength
, make_number (0));
3133 initial_obarray
= Vobarray
;
3134 staticpro (&initial_obarray
);
3135 /* Intern nil in the obarray */
3136 XSYMBOL (Qnil
)->obarray
= Vobarray
;
3137 /* These locals are to kludge around a pyramid compiler bug. */
3138 hash
= hash_string ("nil", 3);
3139 /* Separate statement here to avoid VAXC bug. */
3140 hash
%= OBARRAY_SIZE
;
3141 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3144 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3145 XSYMBOL (Qnil
)->function
= Qunbound
;
3146 XSYMBOL (Qunbound
)->value
= Qunbound
;
3147 XSYMBOL (Qunbound
)->function
= Qunbound
;
3150 XSYMBOL (Qnil
)->value
= Qnil
;
3151 XSYMBOL (Qnil
)->plist
= Qnil
;
3152 XSYMBOL (Qt
)->value
= Qt
;
3154 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3157 Qvariable_documentation
= intern ("variable-documentation");
3158 staticpro (&Qvariable_documentation
);
3160 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3161 read_buffer
= (char *) xmalloc (read_buffer_size
);
3166 struct Lisp_Subr
*sname
;
3169 sym
= intern (sname
->symbol_name
);
3170 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3173 #ifdef NOTDEF /* use fset in subr.el now */
3175 defalias (sname
, string
)
3176 struct Lisp_Subr
*sname
;
3180 sym
= intern (string
);
3181 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3185 /* Define an "integer variable"; a symbol whose value is forwarded
3186 to a C variable of type int. Sample call: */
3187 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3189 defvar_int (namestring
, address
)
3193 Lisp_Object sym
, val
;
3194 sym
= intern (namestring
);
3195 val
= allocate_misc ();
3196 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3197 XINTFWD (val
)->intvar
= address
;
3198 XSYMBOL (sym
)->value
= val
;
3201 /* Similar but define a variable whose value is T if address contains 1,
3202 NIL if address contains 0 */
3204 defvar_bool (namestring
, address
)
3208 Lisp_Object sym
, val
;
3209 sym
= intern (namestring
);
3210 val
= allocate_misc ();
3211 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3212 XBOOLFWD (val
)->boolvar
= address
;
3213 XSYMBOL (sym
)->value
= val
;
3214 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3217 /* Similar but define a variable whose value is the Lisp Object stored
3218 at address. Two versions: with and without gc-marking of the C
3219 variable. The nopro version is used when that variable will be
3220 gc-marked for some other reason, since marking the same slot twice
3221 can cause trouble with strings. */
3223 defvar_lisp_nopro (namestring
, address
)
3225 Lisp_Object
*address
;
3227 Lisp_Object sym
, val
;
3228 sym
= intern (namestring
);
3229 val
= allocate_misc ();
3230 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3231 XOBJFWD (val
)->objvar
= address
;
3232 XSYMBOL (sym
)->value
= val
;
3236 defvar_lisp (namestring
, address
)
3238 Lisp_Object
*address
;
3240 defvar_lisp_nopro (namestring
, address
);
3241 staticpro (address
);
3244 /* Similar but define a variable whose value is the Lisp Object stored in
3245 the current buffer. address is the address of the slot in the buffer
3246 that is current now. */
3249 defvar_per_buffer (namestring
, address
, type
, doc
)
3251 Lisp_Object
*address
;
3255 Lisp_Object sym
, val
;
3257 extern struct buffer buffer_local_symbols
;
3259 sym
= intern (namestring
);
3260 val
= allocate_misc ();
3261 offset
= (char *)address
- (char *)current_buffer
;
3263 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3264 XBUFFER_OBJFWD (val
)->offset
= offset
;
3265 XSYMBOL (sym
)->value
= val
;
3266 PER_BUFFER_SYMBOL (offset
) = sym
;
3267 PER_BUFFER_TYPE (offset
) = type
;
3269 if (PER_BUFFER_IDX (offset
) == 0)
3270 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3271 slot of buffer_local_flags */
3276 /* Similar but define a variable whose value is the Lisp Object stored
3277 at a particular offset in the current kboard object. */
3280 defvar_kboard (namestring
, offset
)
3284 Lisp_Object sym
, val
;
3285 sym
= intern (namestring
);
3286 val
= allocate_misc ();
3287 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3288 XKBOARD_OBJFWD (val
)->offset
= offset
;
3289 XSYMBOL (sym
)->value
= val
;
3292 /* Record the value of load-path used at the start of dumping
3293 so we can see if the site changed it later during dumping. */
3294 static Lisp_Object dump_path
;
3300 int turn_off_warning
= 0;
3302 /* Compute the default load-path. */
3304 normal
= PATH_LOADSEARCH
;
3305 Vload_path
= decode_env_path (0, normal
);
3307 if (NILP (Vpurify_flag
))
3308 normal
= PATH_LOADSEARCH
;
3310 normal
= PATH_DUMPLOADSEARCH
;
3312 /* In a dumped Emacs, we normally have to reset the value of
3313 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3314 uses ../lisp, instead of the path of the installed elisp
3315 libraries. However, if it appears that Vload_path was changed
3316 from the default before dumping, don't override that value. */
3319 if (! NILP (Fequal (dump_path
, Vload_path
)))
3321 Vload_path
= decode_env_path (0, normal
);
3322 if (!NILP (Vinstallation_directory
))
3324 /* Add to the path the lisp subdir of the
3325 installation dir, if it exists. */
3326 Lisp_Object tem
, tem1
;
3327 tem
= Fexpand_file_name (build_string ("lisp"),
3328 Vinstallation_directory
);
3329 tem1
= Ffile_exists_p (tem
);
3332 if (NILP (Fmember (tem
, Vload_path
)))
3334 turn_off_warning
= 1;
3335 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3339 /* That dir doesn't exist, so add the build-time
3340 Lisp dirs instead. */
3341 Vload_path
= nconc2 (Vload_path
, dump_path
);
3343 /* Add leim under the installation dir, if it exists. */
3344 tem
= Fexpand_file_name (build_string ("leim"),
3345 Vinstallation_directory
);
3346 tem1
= Ffile_exists_p (tem
);
3349 if (NILP (Fmember (tem
, Vload_path
)))
3350 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3353 /* Add site-list under the installation dir, if it exists. */
3354 tem
= Fexpand_file_name (build_string ("site-lisp"),
3355 Vinstallation_directory
);
3356 tem1
= Ffile_exists_p (tem
);
3359 if (NILP (Fmember (tem
, Vload_path
)))
3360 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3363 /* If Emacs was not built in the source directory,
3364 and it is run from where it was built, add to load-path
3365 the lisp, leim and site-lisp dirs under that directory. */
3367 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3371 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3372 Vinstallation_directory
);
3373 tem1
= Ffile_exists_p (tem
);
3375 /* Don't be fooled if they moved the entire source tree
3376 AFTER dumping Emacs. If the build directory is indeed
3377 different from the source dir, src/Makefile.in and
3378 src/Makefile will not be found together. */
3379 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3380 Vinstallation_directory
);
3381 tem2
= Ffile_exists_p (tem
);
3382 if (!NILP (tem1
) && NILP (tem2
))
3384 tem
= Fexpand_file_name (build_string ("lisp"),
3387 if (NILP (Fmember (tem
, Vload_path
)))
3388 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3390 tem
= Fexpand_file_name (build_string ("leim"),
3393 if (NILP (Fmember (tem
, Vload_path
)))
3394 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3396 tem
= Fexpand_file_name (build_string ("site-lisp"),
3399 if (NILP (Fmember (tem
, Vload_path
)))
3400 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3408 /* NORMAL refers to the lisp dir in the source directory. */
3409 /* We used to add ../lisp at the front here, but
3410 that caused trouble because it was copied from dump_path
3411 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3412 It should be unnecessary. */
3413 Vload_path
= decode_env_path (0, normal
);
3414 dump_path
= Vload_path
;
3419 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3420 almost never correct, thereby causing a warning to be printed out that
3421 confuses users. Since PATH_LOADSEARCH is always overridden by the
3422 EMACSLOADPATH environment variable below, disable the warning on NT. */
3424 /* Warn if dirs in the *standard* path don't exist. */
3425 if (!turn_off_warning
)
3427 Lisp_Object path_tail
;
3429 for (path_tail
= Vload_path
;
3431 path_tail
= XCDR (path_tail
))
3433 Lisp_Object dirfile
;
3434 dirfile
= Fcar (path_tail
);
3435 if (STRINGP (dirfile
))
3437 dirfile
= Fdirectory_file_name (dirfile
);
3438 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3439 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3444 #endif /* WINDOWSNT */
3446 /* If the EMACSLOADPATH environment variable is set, use its value.
3447 This doesn't apply if we're dumping. */
3449 if (NILP (Vpurify_flag
)
3450 && egetenv ("EMACSLOADPATH"))
3452 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3456 load_in_progress
= 0;
3457 Vload_file_name
= Qnil
;
3459 load_descriptor_list
= Qnil
;
3461 Vstandard_input
= Qt
;
3462 Vloads_in_progress
= Qnil
;
3465 /* Print a warning, using format string FORMAT, that directory DIRNAME
3466 does not exist. Print it on stderr and put it in *Message*. */
3469 dir_warning (format
, dirname
)
3471 Lisp_Object dirname
;
3474 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3476 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3477 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3478 /* Don't log the warning before we've initialized!! */
3480 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3487 defsubr (&Sread_from_string
);
3489 defsubr (&Sintern_soft
);
3490 defsubr (&Sunintern
);
3492 defsubr (&Seval_buffer
);
3493 defsubr (&Seval_region
);
3494 defsubr (&Sread_char
);
3495 defsubr (&Sread_char_exclusive
);
3496 defsubr (&Sread_event
);
3497 defsubr (&Sget_file_char
);
3498 defsubr (&Smapatoms
);
3500 DEFVAR_LISP ("obarray", &Vobarray
,
3501 "Symbol table for use by `intern' and `read'.\n\
3502 It is a vector whose length ought to be prime for best results.\n\
3503 The vector's contents don't make sense if examined from Lisp programs;\n\
3504 to find all the symbols in an obarray, use `mapatoms'.");
3506 DEFVAR_LISP ("values", &Vvalues
,
3507 "List of values of all expressions which were read, evaluated and printed.\n\
3508 Order is reverse chronological.");
3510 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3511 "Stream for read to get input from.\n\
3512 See documentation of `read' for possible values.");
3513 Vstandard_input
= Qt
;
3515 DEFVAR_LISP ("load-path", &Vload_path
,
3516 "*List of directories to search for files to load.\n\
3517 Each element is a string (directory name) or nil (try default directory).\n\
3518 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3519 otherwise to default specified by file `epaths.h' when Emacs was built.");
3521 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3522 "Non-nil iff inside of `load'.");
3524 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3525 "An alist of expressions to be evalled when particular files are loaded.\n\
3526 Each element looks like (FILENAME FORMS...).\n\
3527 When `load' is run and the file-name argument is FILENAME,\n\
3528 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3529 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3530 with no directory specified, since that is how `load' is normally called.\n\
3531 An error in FORMS does not undo the load,\n\
3532 but does prevent execution of the rest of the FORMS.");
3533 Vafter_load_alist
= Qnil
;
3535 DEFVAR_LISP ("load-history", &Vload_history
,
3536 "Alist mapping source file names to symbols and features.\n\
3537 Each alist element is a list that starts with a file name,\n\
3538 except for one element (optional) that starts with nil and describes\n\
3539 definitions evaluated from buffers not visiting files.\n\
3540 The remaining elements of each list are symbols defined as functions\n\
3541 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
3542 and `(autoload . SYMBOL)'.");
3543 Vload_history
= Qnil
;
3545 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3546 "Full name of file being loaded by `load'.");
3547 Vload_file_name
= Qnil
;
3549 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3550 "File name, including directory, of user's initialization file.\n\
3551 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3552 file, this variable contains the name of the .el file, suitable for use\n\
3553 by functions like `custom-save-all' which edit the init file.");
3554 Vuser_init_file
= Qnil
;
3556 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3557 "Used for internal purposes by `load'.");
3558 Vcurrent_load_list
= Qnil
;
3560 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3561 "Function used by `load' and `eval-region' for reading expressions.\n\
3562 The default is nil, which means use the function `read'.");
3563 Vload_read_function
= Qnil
;
3565 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3566 "Function called in `load' for loading an Emacs lisp source file.\n\
3567 This function is for doing code conversion before reading the source file.\n\
3568 If nil, loading is done without any code conversion.\n\
3569 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3570 FULLNAME is the full name of FILE.\n\
3571 See `load' for the meaning of the remaining arguments.");
3572 Vload_source_file_function
= Qnil
;
3574 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3575 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3576 This is useful when the file being loaded is a temporary copy.");
3577 load_force_doc_strings
= 0;
3579 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3580 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3581 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3582 and is not meant for users to change.");
3583 load_convert_to_unibyte
= 0;
3585 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3586 "Directory in which Emacs sources were found when Emacs was built.\n\
3587 You cannot count on them to still be there!");
3589 = Fexpand_file_name (build_string ("../"),
3590 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3592 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3593 "List of files that were preloaded (when dumping Emacs).");
3594 Vpreloaded_file_list
= Qnil
;
3596 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3597 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3598 Vbyte_boolean_vars
= Qnil
;
3600 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3601 "Non-nil means load dangerous compiled Lisp files.\n\
3602 Some versions of XEmacs use different byte codes than Emacs. These\n\
3603 incompatible byte codes can make Emacs crash when it tries to execute\n\
3605 load_dangerous_libraries
= 0;
3607 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3608 "Regular expression matching safe to load compiled Lisp files.\n\
3609 When Emacs loads a compiled Lisp file, it reads the first 512 bytes\n\
3610 from the file, and matches them against this regular expression.\n\
3611 When the regular expression matches, the file is considered to be safe\n\
3612 to load. See also `load-dangerous-libraries'.");
3613 Vbytecomp_version_regexp
3614 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3616 DEFVAR_LISP ("recursive-load-depth-limit", &Vrecursive_load_depth_limit
,
3617 "Limit for depth of recursive loads.\n\
3618 Value should be either an integer > 0 specifying the limit, or nil for\n\
3620 Vrecursive_load_depth_limit
= make_number (10);
3622 /* Vsource_directory was initialized in init_lread. */
3624 load_descriptor_list
= Qnil
;
3625 staticpro (&load_descriptor_list
);
3627 Qcurrent_load_list
= intern ("current-load-list");
3628 staticpro (&Qcurrent_load_list
);
3630 Qstandard_input
= intern ("standard-input");
3631 staticpro (&Qstandard_input
);
3633 Qread_char
= intern ("read-char");
3634 staticpro (&Qread_char
);
3636 Qget_file_char
= intern ("get-file-char");
3637 staticpro (&Qget_file_char
);
3639 Qbackquote
= intern ("`");
3640 staticpro (&Qbackquote
);
3641 Qcomma
= intern (",");
3642 staticpro (&Qcomma
);
3643 Qcomma_at
= intern (",@");
3644 staticpro (&Qcomma_at
);
3645 Qcomma_dot
= intern (",.");
3646 staticpro (&Qcomma_dot
);
3648 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3649 staticpro (&Qinhibit_file_name_operation
);
3651 Qascii_character
= intern ("ascii-character");
3652 staticpro (&Qascii_character
);
3654 Qfunction
= intern ("function");
3655 staticpro (&Qfunction
);
3657 Qload
= intern ("load");
3660 Qload_file_name
= intern ("load-file-name");
3661 staticpro (&Qload_file_name
);
3663 staticpro (&dump_path
);
3665 staticpro (&read_objects
);
3666 read_objects
= Qnil
;
3667 staticpro (&seen_list
);
3669 Vloads_in_progress
= Qnil
;
3670 staticpro (&Vloads_in_progress
);