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. */
24 /* The following feature selections should be in config.h, but that
25 causes at best a host of warnings on some systems. */
26 #undef _XOPEN_SOURCE /* Avoid warnings about redefinition
28 #define _XOPEN_SOURCE 500 /* for Unix 98 ftello on GNU */
30 #define __EXTENSIONS__ /* Keep Solaris 2.6 happy with the
31 above, else things we need are hidden. */
33 #include <sys/types.h>
38 #include "intervals.h"
44 #include "termhooks.h"
47 #include <sys/inode.h>
52 #include <unistd.h> /* to get X_OK */
69 #endif /* HAVE_SETLOCALE */
76 #define file_offset off_t
77 #define file_tell ftello
79 #define file_offset long
80 #define file_tell ftell
85 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
86 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
87 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
88 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
89 Lisp_Object Qinhibit_file_name_operation
;
91 extern Lisp_Object Qevent_symbol_element_mask
;
92 extern Lisp_Object Qfile_exists_p
;
94 /* non-zero if inside `load' */
97 /* Directory in which the sources were found. */
98 Lisp_Object Vsource_directory
;
100 /* Search path for files to be loaded. */
101 Lisp_Object Vload_path
;
103 /* File name of user's init file. */
104 Lisp_Object Vuser_init_file
;
106 /* This is the user-visible association list that maps features to
107 lists of defs in their load files. */
108 Lisp_Object Vload_history
;
110 /* This is used to build the load history. */
111 Lisp_Object Vcurrent_load_list
;
113 /* List of files that were preloaded. */
114 Lisp_Object Vpreloaded_file_list
;
116 /* Name of file actually being read by `load'. */
117 Lisp_Object Vload_file_name
;
119 /* Function to use for reading, in `load' and friends. */
120 Lisp_Object Vload_read_function
;
122 /* The association list of objects read with the #n=object form.
123 Each member of the list has the form (n . object), and is used to
124 look up the object for the corresponding #n# construct.
125 It must be set to nil before all top-level calls to read0. */
126 Lisp_Object read_objects
;
128 /* Nonzero means load should forcibly load all dynamic doc strings. */
129 static int load_force_doc_strings
;
131 /* Nonzero means read should convert strings to unibyte. */
132 static int load_convert_to_unibyte
;
134 /* Function to use for loading an Emacs lisp source file (not
135 compiled) instead of readevalloop. */
136 Lisp_Object Vload_source_file_function
;
138 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
139 Lisp_Object Vbyte_boolean_vars
;
141 /* List of descriptors now open for Fload. */
142 static Lisp_Object load_descriptor_list
;
144 /* File for get_file_char to read from. Use by load. */
145 static FILE *instream
;
147 /* When nonzero, read conses in pure space */
148 static int read_pure
;
150 /* For use within read-from-string (this reader is non-reentrant!!) */
151 static int read_from_string_index
;
152 static int read_from_string_index_byte
;
153 static int read_from_string_limit
;
155 /* Number of bytes left to read in the buffer character
156 that `readchar' has already advanced over. */
157 static int readchar_backlog
;
159 /* This contains the last string skipped with #@. */
160 static char *saved_doc_string
;
161 /* Length of buffer allocated in saved_doc_string. */
162 static int saved_doc_string_size
;
163 /* Length of actual data in saved_doc_string. */
164 static int saved_doc_string_length
;
165 /* This is the file position that string came from. */
166 static file_offset saved_doc_string_position
;
168 /* This contains the previous string skipped with #@.
169 We copy it from saved_doc_string when a new string
170 is put in saved_doc_string. */
171 static char *prev_saved_doc_string
;
172 /* Length of buffer allocated in prev_saved_doc_string. */
173 static int prev_saved_doc_string_size
;
174 /* Length of actual data in prev_saved_doc_string. */
175 static int prev_saved_doc_string_length
;
176 /* This is the file position that string came from. */
177 static file_offset prev_saved_doc_string_position
;
179 /* Nonzero means inside a new-style backquote
180 with no surrounding parentheses.
181 Fread initializes this to zero, so we need not specbind it
182 or worry about what happens to it when there is an error. */
183 static int new_backquote_flag
;
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
)
299 else if (STRING_MULTIBYTE (readcharfun
))
300 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
301 read_from_string_index
,
302 read_from_string_index_byte
);
304 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
309 tem
= call0 (readcharfun
);
316 /* Unread the character C in the way appropriate for the stream READCHARFUN.
317 If the stream is a user function, call it with the char as argument. */
320 unreadchar (readcharfun
, c
)
321 Lisp_Object readcharfun
;
325 /* Don't back up the pointer if we're unreading the end-of-input mark,
326 since readchar didn't advance it when we read it. */
328 else if (BUFFERP (readcharfun
))
330 struct buffer
*b
= XBUFFER (readcharfun
);
331 int bytepos
= BUF_PT_BYTE (b
);
333 if (readchar_backlog
>= 0)
338 if (! NILP (b
->enable_multibyte_characters
))
339 BUF_DEC_POS (b
, bytepos
);
343 BUF_PT_BYTE (b
) = bytepos
;
346 else if (MARKERP (readcharfun
))
348 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
349 int bytepos
= XMARKER (readcharfun
)->bytepos
;
351 if (readchar_backlog
>= 0)
355 XMARKER (readcharfun
)->charpos
--;
356 if (! NILP (b
->enable_multibyte_characters
))
357 BUF_DEC_POS (b
, bytepos
);
361 XMARKER (readcharfun
)->bytepos
= bytepos
;
364 else if (STRINGP (readcharfun
))
366 read_from_string_index
--;
367 read_from_string_index_byte
368 = string_char_to_byte (readcharfun
, read_from_string_index
);
370 else if (EQ (readcharfun
, Qlambda
))
371 read_bytecode_char (1);
372 else if (EQ (readcharfun
, Qget_file_char
))
373 ungetc (c
, instream
);
375 call1 (readcharfun
, make_number (c
));
378 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
379 static int read_multibyte ();
380 static Lisp_Object
substitute_object_recurse ();
381 static void substitute_object_in_subtree (), substitute_in_interval ();
384 /* Get a character from the tty. */
386 extern Lisp_Object
read_char ();
388 /* Read input events until we get one that's acceptable for our purposes.
390 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
391 until we get a character we like, and then stuffed into
394 If ASCII_REQUIRED is non-zero, we check function key events to see
395 if the unmodified version of the symbol has a Qascii_character
396 property, and use that character, if present.
398 If ERROR_NONASCII is non-zero, we signal an error if the input we
399 get isn't an ASCII character with modifiers. If it's zero but
400 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
403 If INPUT_METHOD is nonzero, we invoke the current input method
404 if the character warrants that. */
407 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
409 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
411 register Lisp_Object val
, delayed_switch_frame
;
413 delayed_switch_frame
= Qnil
;
415 /* Read until we get an acceptable event. */
417 val
= read_char (0, 0, 0,
418 (input_method
? Qnil
: Qt
),
424 /* switch-frame events are put off until after the next ASCII
425 character. This is better than signaling an error just because
426 the last characters were typed to a separate minibuffer frame,
427 for example. Eventually, some code which can deal with
428 switch-frame events will read it and process it. */
430 && EVENT_HAS_PARAMETERS (val
)
431 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
433 delayed_switch_frame
= val
;
439 /* Convert certain symbols to their ASCII equivalents. */
442 Lisp_Object tem
, tem1
;
443 tem
= Fget (val
, Qevent_symbol_element_mask
);
446 tem1
= Fget (Fcar (tem
), Qascii_character
);
447 /* Merge this symbol's modifier bits
448 with the ASCII equivalent of its basic code. */
450 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
454 /* If we don't have a character now, deal with it appropriately. */
459 Vunread_command_events
= Fcons (val
, Qnil
);
460 error ("Non-character input-event");
467 if (! NILP (delayed_switch_frame
))
468 unread_switch_frame
= delayed_switch_frame
;
473 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
474 "Read a character from the command input (keyboard or macro).\n\
475 It is returned as a number.\n\
476 If the user generates an event which is not a character (i.e. a mouse\n\
477 click or function key event), `read-char' signals an error. As an\n\
478 exception, switch-frame events are put off until non-ASCII events can\n\
480 If you want to read non-character events, or ignore them, call\n\
481 `read-event' or `read-char-exclusive' instead.\n\
483 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
484 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
485 input method is turned on in the current buffer, that input method\n\
486 is used for reading a character.")
487 (prompt
, inherit_input_method
)
488 Lisp_Object prompt
, inherit_input_method
;
491 message_with_string ("%s", prompt
, 0);
492 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
495 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
496 "Read an event object from the input stream.\n\
497 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
498 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
499 input method is turned on in the current buffer, that input method\n\
500 is used for reading a character.")
501 (prompt
, inherit_input_method
)
502 Lisp_Object prompt
, inherit_input_method
;
505 message_with_string ("%s", prompt
, 0);
506 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
509 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
510 "Read a character from the command input (keyboard or macro).\n\
511 It is returned as a number. Non-character events are ignored.\n\
513 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
514 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
515 input method is turned on in the current buffer, that input method\n\
516 is used for reading a character.")
517 (prompt
, inherit_input_method
)
518 Lisp_Object prompt
, inherit_input_method
;
521 message_with_string ("%s", prompt
, 0);
522 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
525 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
526 "Don't use this yourself.")
529 register Lisp_Object val
;
530 XSETINT (val
, getc (instream
));
534 static void readevalloop ();
535 static Lisp_Object
load_unwind ();
536 static Lisp_Object
load_descriptor_unwind ();
538 /* Non-zero means load dangerous compiled Lisp files. */
540 int load_dangerous_libraries
;
542 /* A regular expression used to detect files compiled with Emacs. */
544 static Lisp_Object Vbytecomp_version_regexp
;
547 /* Value is non-zero if the file asswociated with file descriptor FD
548 is a compiled Lisp file that's safe to load. Only files compiled
549 with Emacs are safe to load. Files compiled with XEmacs can lead
550 to a crash in Fbyte_code because of an incompatible change in the
561 /* Read the first few bytes from the file, and look for a line
562 specifying the byte compiler version used. */
563 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
568 /* Skip to the next newline, skipping over the initial `ELC'
569 with NUL bytes following it. */
570 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
574 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
579 lseek (fd
, 0, SEEK_SET
);
584 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
585 "Execute a file of Lisp code named FILE.\n\
586 First try FILE with `.elc' appended, then try with `.el',\n\
587 then try FILE unmodified.\n\
588 This function searches the directories in `load-path'.\n\
589 If optional second arg NOERROR is non-nil,\n\
590 report no error if FILE doesn't exist.\n\
591 Print messages at start and end of loading unless\n\
592 optional third arg NOMESSAGE is non-nil.\n\
593 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
594 suffixes `.elc' or `.el' to the specified name FILE.\n\
595 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
596 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
597 it ends in one of those suffixes or includes a directory name.\n\
598 Return t if file exists.")
599 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
600 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
602 register FILE *stream
;
603 register int fd
= -1;
604 register Lisp_Object lispstream
;
605 int count
= specpdl_ptr
- specpdl
;
609 /* 1 means we printed the ".el is newer" message. */
611 /* 1 means we are loading a compiled file. */
620 CHECK_STRING (file
, 0);
622 /* If file name is magic, call the handler. */
623 handler
= Ffind_file_name_handler (file
, Qload
);
625 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
627 /* Do this after the handler to avoid
628 the need to gcpro noerror, nomessage and nosuffix.
629 (Below here, we care only whether they are nil or not.) */
630 file
= Fsubstitute_in_file_name (file
);
632 /* Avoid weird lossage with null string as arg,
633 since it would try to load a directory as a Lisp file */
634 if (XSTRING (file
)->size
> 0)
636 int size
= STRING_BYTES (XSTRING (file
));
640 if (! NILP (must_suffix
))
642 /* Don't insist on adding a suffix if FILE already ends with one. */
644 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
647 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
649 /* Don't insist on adding a suffix
650 if the argument includes a directory name. */
651 else if (! NILP (Ffile_name_directory (file
)))
655 fd
= openp (Vload_path
, file
,
656 (!NILP (nosuffix
) ? ""
657 : ! NILP (must_suffix
) ? ".elc.gz:.elc:.el.gz:.el"
658 : ".elc:.elc.gz:.el.gz:.el:"),
667 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
668 Fcons (file
, Qnil
)));
673 if (EQ (Qt
, Vuser_init_file
))
674 Vuser_init_file
= found
;
676 /* If FD is 0, that means openp found a magic file. */
679 if (NILP (Fequal (found
, file
)))
680 /* If FOUND is a different file name from FILE,
681 find its handler even if we have already inhibited
682 the `load' operation on FILE. */
683 handler
= Ffind_file_name_handler (found
, Qt
);
685 handler
= Ffind_file_name_handler (found
, Qload
);
686 if (! NILP (handler
))
687 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
690 /* Load .elc files directly, but not when they are
691 remote and have no handler! */
692 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
699 if (!safe_to_load_p (fd
))
702 if (!load_dangerous_libraries
)
703 error ("File `%s' was not compiled in Emacs",
704 XSTRING (found
)->data
);
705 else if (!NILP (nomessage
))
706 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
714 stat ((char *)XSTRING (found
)->data
, &s1
);
715 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
716 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
717 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
719 /* Make the progress messages mention that source is newer. */
722 /* If we won't print another message, mention this anyway. */
723 if (! NILP (nomessage
))
724 message_with_string ("Source file `%s' newer than byte-compiled file",
727 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
733 /* We are loading a source file (*.el). */
734 if (!NILP (Vload_source_file_function
))
738 return call4 (Vload_source_file_function
, found
, file
,
739 NILP (noerror
) ? Qnil
: Qt
,
740 NILP (nomessage
) ? Qnil
: Qt
);
746 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
747 #else /* not WINDOWSNT */
748 stream
= fdopen (fd
, fmode
);
749 #endif /* not WINDOWSNT */
753 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
756 if (! NILP (Vpurify_flag
))
757 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
759 if (NILP (nomessage
))
762 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
765 message_with_string ("Loading %s (source)...", file
, 1);
767 message_with_string ("Loading %s (compiled; note, source file is newer)...",
769 else /* The typical case; compiled file newer than source file. */
770 message_with_string ("Loading %s...", file
, 1);
774 lispstream
= Fcons (Qnil
, Qnil
);
775 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
776 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
777 record_unwind_protect (load_unwind
, lispstream
);
778 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
779 specbind (Qload_file_name
, found
);
780 specbind (Qinhibit_file_name_operation
, Qnil
);
782 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
784 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
785 unbind_to (count
, Qnil
);
787 /* Run any load-hooks for this file. */
788 temp
= Fassoc (file
, Vafter_load_alist
);
790 Fprogn (Fcdr (temp
));
793 if (saved_doc_string
)
794 free (saved_doc_string
);
795 saved_doc_string
= 0;
796 saved_doc_string_size
= 0;
798 if (prev_saved_doc_string
)
799 xfree (prev_saved_doc_string
);
800 prev_saved_doc_string
= 0;
801 prev_saved_doc_string_size
= 0;
803 if (!noninteractive
&& NILP (nomessage
))
806 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
809 message_with_string ("Loading %s (source)...done", file
, 1);
811 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
813 else /* The typical case; compiled file newer than source file. */
814 message_with_string ("Loading %s...done", file
, 1);
820 load_unwind (stream
) /* used as unwind-protect function in load */
823 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
824 | XFASTINT (XCDR (stream
))));
825 if (--load_in_progress
< 0) load_in_progress
= 0;
830 load_descriptor_unwind (oldlist
)
833 load_descriptor_list
= oldlist
;
837 /* Close all descriptors in use for Floads.
838 This is used when starting a subprocess. */
845 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
846 emacs_close (XFASTINT (XCAR (tail
)));
851 complete_filename_p (pathname
)
852 Lisp_Object pathname
;
854 register unsigned char *s
= XSTRING (pathname
)->data
;
855 return (IS_DIRECTORY_SEP (s
[0])
856 || (XSTRING (pathname
)->size
> 2
857 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
867 /* Search for a file whose name is STR, looking in directories
868 in the Lisp list PATH, and trying suffixes from SUFFIX.
869 SUFFIX is a string containing possible suffixes separated by colons.
870 On success, returns a file descriptor. On failure, returns -1.
872 EXEC_ONLY nonzero means don't open the files,
873 just look for one that is executable. In this case,
874 returns 1 on success.
876 If STOREPTR is nonzero, it points to a slot where the name of
877 the file actually found should be stored as a Lisp string.
878 nil is stored there on failure.
880 If the file we find is remote, return 0
881 but store the found remote file name in *STOREPTR.
882 We do not check for remote files if EXEC_ONLY is nonzero. */
885 openp (path
, str
, suffix
, storeptr
, exec_only
)
886 Lisp_Object path
, str
;
888 Lisp_Object
*storeptr
;
894 register char *fn
= buf
;
897 Lisp_Object filename
;
905 if (complete_filename_p (str
))
908 for (; !NILP (path
); path
= Fcdr (path
))
912 filename
= Fexpand_file_name (str
, Fcar (path
));
913 if (!complete_filename_p (filename
))
914 /* If there are non-absolute elts in PATH (eg ".") */
915 /* Of course, this could conceivably lose if luser sets
916 default-directory to be something non-absolute... */
918 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
919 if (!complete_filename_p (filename
))
920 /* Give up on this path element! */
924 /* Calculate maximum size of any filename made from
925 this path element/specified file name and any possible suffix. */
926 want_size
= strlen (suffix
) + STRING_BYTES (XSTRING (filename
)) + 1;
927 if (fn_size
< want_size
)
928 fn
= (char *) alloca (fn_size
= 100 + want_size
);
932 /* Loop over suffixes. */
935 char *esuffix
= (char *) index (nsuffix
, ':');
936 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
939 /* Concatenate path element/specified name with the suffix.
940 If the directory starts with /:, remove that. */
941 if (XSTRING (filename
)->size
> 2
942 && XSTRING (filename
)->data
[0] == '/'
943 && XSTRING (filename
)->data
[1] == ':')
945 strncpy (fn
, XSTRING (filename
)->data
+ 2,
946 STRING_BYTES (XSTRING (filename
)) - 2);
947 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
951 strncpy (fn
, XSTRING (filename
)->data
,
952 STRING_BYTES (XSTRING (filename
)));
953 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
956 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
957 strncat (fn
, nsuffix
, lsuffix
);
959 /* Check that the file exists and is not a directory. */
963 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
964 if (! NILP (handler
) && ! exec_only
)
969 string
= build_string (fn
);
970 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
971 : Ffile_readable_p (string
));
973 && ! NILP (Ffile_directory_p (build_string (fn
))))
978 /* We succeeded; return this descriptor and filename. */
980 *storeptr
= build_string (fn
);
987 int exists
= (stat (fn
, &st
) >= 0
988 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
991 /* Check that we can access or open it. */
993 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
995 fd
= emacs_open (fn
, O_RDONLY
, 0);
999 /* We succeeded; return this descriptor and filename. */
1001 *storeptr
= build_string (fn
);
1008 /* Advance to next suffix. */
1011 nsuffix
+= lsuffix
+ 1;
1022 /* Merge the list we've accumulated of globals from the current input source
1023 into the load_history variable. The details depend on whether
1024 the source has an associated file name or not. */
1027 build_load_history (stream
, source
)
1031 register Lisp_Object tail
, prev
, newelt
;
1032 register Lisp_Object tem
, tem2
;
1033 register int foundit
, loading
;
1035 loading
= stream
|| !NARROWED
;
1037 tail
= Vload_history
;
1040 while (!NILP (tail
))
1044 /* Find the feature's previous assoc list... */
1045 if (!NILP (Fequal (source
, Fcar (tem
))))
1049 /* If we're loading, remove it. */
1053 Vload_history
= Fcdr (tail
);
1055 Fsetcdr (prev
, Fcdr (tail
));
1058 /* Otherwise, cons on new symbols that are not already members. */
1061 tem2
= Vcurrent_load_list
;
1063 while (CONSP (tem2
))
1065 newelt
= Fcar (tem2
);
1067 if (NILP (Fmemq (newelt
, tem
)))
1068 Fsetcar (tail
, Fcons (Fcar (tem
),
1069 Fcons (newelt
, Fcdr (tem
))));
1082 /* If we're loading, cons the new assoc onto the front of load-history,
1083 the most-recently-loaded position. Also do this if we didn't find
1084 an existing member for the current source. */
1085 if (loading
|| !foundit
)
1086 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1091 unreadpure () /* Used as unwind-protect function in readevalloop */
1098 readevalloop_1 (old
)
1101 load_convert_to_unibyte
= ! NILP (old
);
1105 /* UNIBYTE specifies how to set load_convert_to_unibyte
1106 for this invocation.
1107 READFUN, if non-nil, is used instead of `read'. */
1110 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1111 Lisp_Object readcharfun
;
1113 Lisp_Object sourcename
;
1114 Lisp_Object (*evalfun
) ();
1116 Lisp_Object unibyte
, readfun
;
1119 register Lisp_Object val
;
1120 int count
= specpdl_ptr
- specpdl
;
1121 struct gcpro gcpro1
;
1122 struct buffer
*b
= 0;
1124 if (BUFFERP (readcharfun
))
1125 b
= XBUFFER (readcharfun
);
1126 else if (MARKERP (readcharfun
))
1127 b
= XMARKER (readcharfun
)->buffer
;
1129 specbind (Qstandard_input
, readcharfun
);
1130 specbind (Qcurrent_load_list
, Qnil
);
1131 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1132 load_convert_to_unibyte
= !NILP (unibyte
);
1134 readchar_backlog
= -1;
1136 GCPRO1 (sourcename
);
1138 LOADHIST_ATTACH (sourcename
);
1142 if (b
!= 0 && NILP (b
->name
))
1143 error ("Reading from killed buffer");
1149 while ((c
= READCHAR
) != '\n' && c
!= -1);
1154 /* Ignore whitespace here, so we can detect eof. */
1155 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1158 if (!NILP (Vpurify_flag
) && c
== '(')
1160 int count1
= specpdl_ptr
- specpdl
;
1161 record_unwind_protect (unreadpure
, Qnil
);
1162 val
= read_list (-1, readcharfun
);
1163 unbind_to (count1
, Qnil
);
1168 read_objects
= Qnil
;
1169 if (! NILP (readfun
))
1170 val
= call1 (readfun
, readcharfun
);
1171 else if (! NILP (Vload_read_function
))
1172 val
= call1 (Vload_read_function
, readcharfun
);
1174 val
= read0 (readcharfun
);
1177 val
= (*evalfun
) (val
);
1180 Vvalues
= Fcons (val
, Vvalues
);
1181 if (EQ (Vstandard_output
, Qt
))
1188 build_load_history (stream
, sourcename
);
1191 unbind_to (count
, Qnil
);
1194 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1195 "Execute the current buffer as Lisp code.\n\
1196 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1197 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1198 PRINTFLAG controls printing of output:\n\
1199 nil means discard it; anything else is stream for print.\n\
1201 If the optional third argument FILENAME is non-nil,\n\
1202 it specifies the file name to use for `load-history'.\n\
1203 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\
1204 for this invocation.\n\
1206 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\
1207 `print' and related functions should work normally even if PRINTFLAG is nil.\n\
1209 This function preserves the position of point.")
1210 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1211 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1213 int count
= specpdl_ptr
- specpdl
;
1214 Lisp_Object tem
, buf
;
1217 buf
= Fcurrent_buffer ();
1219 buf
= Fget_buffer (buffer
);
1221 error ("No such buffer");
1223 if (NILP (printflag
) && NILP (do_allow_print
))
1228 if (NILP (filename
))
1229 filename
= XBUFFER (buf
)->filename
;
1231 specbind (Qstandard_output
, tem
);
1232 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1233 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1234 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1235 unbind_to (count
, Qnil
);
1241 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1242 "Execute the current buffer as Lisp code.\n\
1243 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1244 nil means discard it; anything else is stream for print.\n\
1246 If there is no error, point does not move. If there is an error,\n\
1247 point remains at the end of the last character read from the buffer.")
1249 Lisp_Object printflag
;
1251 int count
= specpdl_ptr
- specpdl
;
1252 Lisp_Object tem
, cbuf
;
1254 cbuf
= Fcurrent_buffer ()
1256 if (NILP (printflag
))
1260 specbind (Qstandard_output
, tem
);
1261 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1263 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1264 !NILP (printflag
), Qnil
, Qnil
);
1265 return unbind_to (count
, Qnil
);
1269 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1270 "Execute the region as Lisp code.\n\
1271 When called from programs, expects two arguments,\n\
1272 giving starting and ending indices in the current buffer\n\
1273 of the text to be executed.\n\
1274 Programs can pass third argument PRINTFLAG which controls output:\n\
1275 nil means discard it; anything else is stream for printing it.\n\
1276 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1277 instead of `read' to read each expression. It gets one argument\n\
1278 which is the input stream for reading characters.\n\
1280 This function does not move point.")
1281 (start
, end
, printflag
, read_function
)
1282 Lisp_Object start
, end
, printflag
, read_function
;
1284 int count
= specpdl_ptr
- specpdl
;
1285 Lisp_Object tem
, cbuf
;
1287 cbuf
= Fcurrent_buffer ();
1289 if (NILP (printflag
))
1293 specbind (Qstandard_output
, tem
);
1295 if (NILP (printflag
))
1296 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1297 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1299 /* This both uses start and checks its type. */
1301 Fnarrow_to_region (make_number (BEGV
), end
);
1302 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1303 !NILP (printflag
), Qnil
, read_function
);
1305 return unbind_to (count
, Qnil
);
1309 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1310 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1311 If STREAM is nil, use the value of `standard-input' (which see).\n\
1312 STREAM or the value of `standard-input' may be:\n\
1313 a buffer (read from point and advance it)\n\
1314 a marker (read from where it points and advance it)\n\
1315 a function (call it with no arguments for each character,\n\
1316 call it with a char as argument to push a char back)\n\
1317 a string (takes text from string, starting at the beginning)\n\
1318 t (read text line using minibuffer and use it).")
1322 extern Lisp_Object
Fread_minibuffer ();
1325 stream
= Vstandard_input
;
1326 if (EQ (stream
, Qt
))
1327 stream
= Qread_char
;
1329 readchar_backlog
= -1;
1330 new_backquote_flag
= 0;
1331 read_objects
= Qnil
;
1333 if (EQ (stream
, Qread_char
))
1334 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1336 if (STRINGP (stream
))
1337 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1339 return read0 (stream
);
1342 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1343 "Read one Lisp expression which is represented as text by STRING.\n\
1344 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1345 START and END optionally delimit a substring of STRING from which to read;\n\
1346 they default to 0 and (length STRING) respectively.")
1347 (string
, start
, end
)
1348 Lisp_Object string
, start
, end
;
1350 int startval
, endval
;
1353 CHECK_STRING (string
,0);
1356 endval
= XSTRING (string
)->size
;
1359 CHECK_NUMBER (end
, 2);
1360 endval
= XINT (end
);
1361 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1362 args_out_of_range (string
, end
);
1369 CHECK_NUMBER (start
, 1);
1370 startval
= XINT (start
);
1371 if (startval
< 0 || startval
> endval
)
1372 args_out_of_range (string
, start
);
1375 read_from_string_index
= startval
;
1376 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1377 read_from_string_limit
= endval
;
1379 new_backquote_flag
= 0;
1380 read_objects
= Qnil
;
1382 tem
= read0 (string
);
1383 return Fcons (tem
, make_number (read_from_string_index
));
1386 /* Use this for recursive reads, in contexts where internal tokens
1391 Lisp_Object readcharfun
;
1393 register Lisp_Object val
;
1396 val
= read1 (readcharfun
, &c
, 0);
1398 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1405 static int read_buffer_size
;
1406 static char *read_buffer
;
1408 /* Read multibyte form and return it as a character. C is a first
1409 byte of multibyte form, and rest of them are read from
1413 read_multibyte (c
, readcharfun
)
1415 Lisp_Object readcharfun
;
1417 /* We need the actual character code of this multibyte
1419 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1423 while ((c
= READCHAR
) >= 0xA0
1424 && len
< MAX_MULTIBYTE_LENGTH
)
1427 return STRING_CHAR (str
, len
);
1430 /* Read a \-escape sequence, assuming we already read the `\'. */
1433 read_escape (readcharfun
, stringp
)
1434 Lisp_Object readcharfun
;
1437 register int c
= READCHAR
;
1441 error ("End of file");
1471 error ("Invalid escape character syntax");
1474 c
= read_escape (readcharfun
, 0);
1475 return c
| meta_modifier
;
1480 error ("Invalid escape character syntax");
1483 c
= read_escape (readcharfun
, 0);
1484 return c
| shift_modifier
;
1489 error ("Invalid escape character syntax");
1492 c
= read_escape (readcharfun
, 0);
1493 return c
| hyper_modifier
;
1498 error ("Invalid escape character syntax");
1501 c
= read_escape (readcharfun
, 0);
1502 return c
| alt_modifier
;
1507 error ("Invalid escape character syntax");
1510 c
= read_escape (readcharfun
, 0);
1511 return c
| super_modifier
;
1516 error ("Invalid escape character syntax");
1520 c
= read_escape (readcharfun
, 0);
1521 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1522 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1523 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1524 return c
| ctrl_modifier
;
1525 /* ASCII control chars are made from letters (both cases),
1526 as well as the non-letters within 0100...0137. */
1527 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1528 return (c
& (037 | ~0177));
1529 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1530 return (c
& (037 | ~0177));
1532 return c
| ctrl_modifier
;
1542 /* An octal escape, as in ANSI C. */
1544 register int i
= c
- '0';
1545 register int count
= 0;
1548 if ((c
= READCHAR
) >= '0' && c
<= '7')
1563 /* A hex escape, as in ANSI C. */
1569 if (c
>= '0' && c
<= '9')
1574 else if ((c
>= 'a' && c
<= 'f')
1575 || (c
>= 'A' && c
<= 'F'))
1578 if (c
>= 'a' && c
<= 'f')
1593 if (BASE_LEADING_CODE_P (c
))
1594 c
= read_multibyte (c
, readcharfun
);
1600 /* Read an integer in radix RADIX using READCHARFUN to read
1601 characters. RADIX must be in the interval [2..36]; if it isn't, a
1602 read error is signaled . Value is the integer read. Signals an
1603 error if encountering invalid read syntax or if RADIX is out of
1607 read_integer (readcharfun
, radix
)
1608 Lisp_Object readcharfun
;
1611 int number
, ndigits
, invalid_p
, c
, sign
;
1613 if (radix
< 2 || radix
> 36)
1617 number
= ndigits
= invalid_p
= 0;
1633 if (c
>= '0' && c
<= '9')
1635 else if (c
>= 'a' && c
<= 'z')
1636 digit
= c
- 'a' + 10;
1637 else if (c
>= 'A' && c
<= 'Z')
1638 digit
= c
- 'A' + 10;
1645 if (digit
< 0 || digit
>= radix
)
1648 number
= radix
* number
+ digit
;
1654 if (ndigits
== 0 || invalid_p
)
1657 sprintf (buf
, "integer, radix %d", radix
);
1658 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1661 return make_number (sign
* number
);
1665 /* If the next token is ')' or ']' or '.', we store that character
1666 in *PCH and the return value is not interesting. Else, we store
1667 zero in *PCH and we read and return one lisp object.
1669 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1672 read1 (readcharfun
, pch
, first_in_list
)
1673 register Lisp_Object readcharfun
;
1678 int uninterned_symbol
= 0;
1685 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1690 return read_list (0, readcharfun
);
1693 return read_vector (readcharfun
, 0);
1710 tmp
= read_vector (readcharfun
, 0);
1711 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1712 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1713 error ("Invalid size char-table");
1714 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1715 XCHAR_TABLE (tmp
)->top
= Qt
;
1724 tmp
= read_vector (readcharfun
, 0);
1725 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1726 error ("Invalid size char-table");
1727 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1728 XCHAR_TABLE (tmp
)->top
= Qnil
;
1731 Fsignal (Qinvalid_read_syntax
,
1732 Fcons (make_string ("#^^", 3), Qnil
));
1734 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1739 length
= read1 (readcharfun
, pch
, first_in_list
);
1743 Lisp_Object tmp
, val
;
1744 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1748 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1749 if (size_in_chars
!= XSTRING (tmp
)->size
1750 /* We used to print 1 char too many
1751 when the number of bits was a multiple of 8.
1752 Accept such input in case it came from an old version. */
1753 && ! (XFASTINT (length
)
1754 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1755 Fsignal (Qinvalid_read_syntax
,
1756 Fcons (make_string ("#&...", 5), Qnil
));
1758 val
= Fmake_bool_vector (length
, Qnil
);
1759 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1761 /* Clear the extraneous bits in the last byte. */
1762 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1763 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1764 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1767 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1772 /* Accept compiled functions at read-time so that we don't have to
1773 build them using function calls. */
1775 tmp
= read_vector (readcharfun
, 1);
1776 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1777 XVECTOR (tmp
)->contents
);
1782 struct gcpro gcpro1
;
1785 /* Read the string itself. */
1786 tmp
= read1 (readcharfun
, &ch
, 0);
1787 if (ch
!= 0 || !STRINGP (tmp
))
1788 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1790 /* Read the intervals and their properties. */
1793 Lisp_Object beg
, end
, plist
;
1795 beg
= read1 (readcharfun
, &ch
, 0);
1799 end
= read1 (readcharfun
, &ch
, 0);
1801 plist
= read1 (readcharfun
, &ch
, 0);
1803 Fsignal (Qinvalid_read_syntax
,
1804 Fcons (build_string ("invalid string property list"),
1806 Fset_text_properties (beg
, end
, plist
, tmp
);
1812 /* #@NUMBER is used to skip NUMBER following characters.
1813 That's used in .elc files to skip over doc strings
1814 and function definitions. */
1819 /* Read a decimal integer. */
1820 while ((c
= READCHAR
) >= 0
1821 && c
>= '0' && c
<= '9')
1829 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1831 /* If we are supposed to force doc strings into core right now,
1832 record the last string that we skipped,
1833 and record where in the file it comes from. */
1835 /* But first exchange saved_doc_string
1836 with prev_saved_doc_string, so we save two strings. */
1838 char *temp
= saved_doc_string
;
1839 int temp_size
= saved_doc_string_size
;
1840 file_offset temp_pos
= saved_doc_string_position
;
1841 int temp_len
= saved_doc_string_length
;
1843 saved_doc_string
= prev_saved_doc_string
;
1844 saved_doc_string_size
= prev_saved_doc_string_size
;
1845 saved_doc_string_position
= prev_saved_doc_string_position
;
1846 saved_doc_string_length
= prev_saved_doc_string_length
;
1848 prev_saved_doc_string
= temp
;
1849 prev_saved_doc_string_size
= temp_size
;
1850 prev_saved_doc_string_position
= temp_pos
;
1851 prev_saved_doc_string_length
= temp_len
;
1854 if (saved_doc_string_size
== 0)
1856 saved_doc_string_size
= nskip
+ 100;
1857 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1859 if (nskip
> saved_doc_string_size
)
1861 saved_doc_string_size
= nskip
+ 100;
1862 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1863 saved_doc_string_size
);
1866 saved_doc_string_position
= file_tell (instream
);
1868 /* Copy that many characters into saved_doc_string. */
1869 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1870 saved_doc_string
[i
] = c
= READCHAR
;
1872 saved_doc_string_length
= i
;
1876 /* Skip that many characters. */
1877 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1884 return Vload_file_name
;
1886 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1887 /* #:foo is the uninterned symbol named foo. */
1890 uninterned_symbol
= 1;
1894 /* Reader forms that can reuse previously read objects. */
1895 if (c
>= '0' && c
<= '9')
1900 /* Read a non-negative integer. */
1901 while (c
>= '0' && c
<= '9')
1907 /* #n=object returns object, but associates it with n for #n#. */
1910 /* Make a placeholder for #n# to use temporarily */
1911 Lisp_Object placeholder
;
1914 placeholder
= Fcons(Qnil
, Qnil
);
1915 cell
= Fcons (make_number (n
), placeholder
);
1916 read_objects
= Fcons (cell
, read_objects
);
1918 /* Read the object itself. */
1919 tem
= read0 (readcharfun
);
1921 /* Now put it everywhere the placeholder was... */
1922 substitute_object_in_subtree (tem
, placeholder
);
1924 /* ...and #n# will use the real value from now on. */
1925 Fsetcdr (cell
, tem
);
1929 /* #n# returns a previously read object. */
1932 tem
= Fassq (make_number (n
), read_objects
);
1935 /* Fall through to error message. */
1937 else if (c
== 'r' || c
== 'R')
1938 return read_integer (readcharfun
, n
);
1940 /* Fall through to error message. */
1942 else if (c
== 'x' || c
== 'X')
1943 return read_integer (readcharfun
, 16);
1944 else if (c
== 'o' || c
== 'O')
1945 return read_integer (readcharfun
, 8);
1946 else if (c
== 'b' || c
== 'B')
1947 return read_integer (readcharfun
, 2);
1950 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1953 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1958 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1968 new_backquote_flag
= 1;
1969 value
= read0 (readcharfun
);
1970 new_backquote_flag
= 0;
1972 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1976 if (new_backquote_flag
)
1978 Lisp_Object comma_type
= Qnil
;
1983 comma_type
= Qcomma_at
;
1985 comma_type
= Qcomma_dot
;
1988 if (ch
>= 0) UNREAD (ch
);
1989 comma_type
= Qcomma
;
1992 new_backquote_flag
= 0;
1993 value
= read0 (readcharfun
);
1994 new_backquote_flag
= 1;
1995 return Fcons (comma_type
, Fcons (value
, Qnil
));
2003 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
2006 c
= read_escape (readcharfun
, 0);
2007 else if (BASE_LEADING_CODE_P (c
))
2008 c
= read_multibyte (c
, readcharfun
);
2010 return make_number (c
);
2015 register char *p
= read_buffer
;
2016 register char *end
= read_buffer
+ read_buffer_size
;
2018 /* Nonzero if we saw an escape sequence specifying
2019 a multibyte character. */
2020 int force_multibyte
= 0;
2021 /* Nonzero if we saw an escape sequence specifying
2022 a single-byte character. */
2023 int force_singlebyte
= 0;
2027 while ((c
= READCHAR
) >= 0
2030 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2032 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2033 p
+= new - read_buffer
;
2034 read_buffer
+= new - read_buffer
;
2035 end
= read_buffer
+ read_buffer_size
;
2040 c
= read_escape (readcharfun
, 1);
2042 /* C is -1 if \ newline has just been seen */
2045 if (p
== read_buffer
)
2050 /* If an escape specifies a non-ASCII single-byte character,
2051 this must be a unibyte string. */
2052 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2053 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2054 force_singlebyte
= 1;
2057 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2059 /* Any modifiers for a multibyte character are invalid. */
2060 if (c
& CHAR_MODIFIER_MASK
)
2061 error ("Invalid modifier in string");
2062 p
+= CHAR_STRING (c
, p
);
2063 force_multibyte
= 1;
2067 /* Allow `\C- ' and `\C-?'. */
2068 if (c
== (CHAR_CTL
| ' '))
2070 else if (c
== (CHAR_CTL
| '?'))
2075 /* Shift modifier is valid only with [A-Za-z]. */
2076 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2078 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2079 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2083 /* Move the meta bit to the right place for a string. */
2084 c
= (c
& ~CHAR_META
) | 0x80;
2086 error ("Invalid modifier in string");
2091 return Fsignal (Qend_of_file
, Qnil
);
2093 /* If purifying, and string starts with \ newline,
2094 return zero instead. This is for doc strings
2095 that we are really going to find in etc/DOC.nn.nn */
2096 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2097 return make_number (0);
2099 if (force_multibyte
)
2100 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
2101 else if (force_singlebyte
)
2102 nchars
= p
- read_buffer
;
2103 else if (load_convert_to_unibyte
)
2106 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
2107 if (p
- read_buffer
!= nchars
)
2109 string
= make_multibyte_string (read_buffer
, nchars
,
2111 return Fstring_make_unibyte (string
);
2114 else if (EQ (readcharfun
, Qget_file_char
)
2115 || EQ (readcharfun
, Qlambda
))
2116 /* Nowadays, reading directly from a file
2117 is used only for compiled Emacs Lisp files,
2118 and those always use the Emacs internal encoding.
2119 Meanwhile, Qlambda is used for reading dynamic byte code
2120 (compiled with byte-compile-dynamic = t). */
2121 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
2123 /* In all other cases, if we read these bytes as
2124 separate characters, treat them as separate characters now. */
2125 nchars
= p
- read_buffer
;
2128 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2130 || (p
- read_buffer
!= nchars
)));
2131 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2133 || (p
- read_buffer
!= nchars
)));
2138 int next_char
= READCHAR
;
2141 if (next_char
<= 040)
2147 /* Otherwise, we fall through! Note that the atom-reading loop
2148 below will now loop at least once, assuring that we will not
2149 try to UNREAD two characters in a row. */
2153 if (c
<= 040) goto retry
;
2155 register char *p
= read_buffer
;
2159 register char *end
= read_buffer
+ read_buffer_size
;
2162 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
2163 || c
== '(' || c
== ')'
2164 || c
== '[' || c
== ']' || c
== '#'
2167 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2169 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2170 p
+= new - read_buffer
;
2171 read_buffer
+= new - read_buffer
;
2172 end
= read_buffer
+ read_buffer_size
;
2180 if (! SINGLE_BYTE_CHAR_P (c
))
2181 p
+= CHAR_STRING (c
, p
);
2190 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2191 p
+= new - read_buffer
;
2192 read_buffer
+= new - read_buffer
;
2193 /* end = read_buffer + read_buffer_size; */
2200 if (!quoted
&& !uninterned_symbol
)
2203 register Lisp_Object val
;
2205 if (*p1
== '+' || *p1
== '-') p1
++;
2206 /* Is it an integer? */
2209 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2210 /* Integers can have trailing decimal points. */
2211 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2213 /* It is an integer. */
2217 if (sizeof (int) == sizeof (EMACS_INT
))
2218 XSETINT (val
, atoi (read_buffer
));
2219 else if (sizeof (long) == sizeof (EMACS_INT
))
2220 XSETINT (val
, atol (read_buffer
));
2226 if (isfloat_string (read_buffer
))
2228 /* Compute NaN and infinities using 0.0 in a variable,
2229 to cope with compilers that think they are smarter
2235 /* Negate the value ourselves. This treats 0, NaNs,
2236 and infinity properly on IEEE floating point hosts,
2237 and works around a common bug where atof ("-0.0")
2239 int negative
= read_buffer
[0] == '-';
2241 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2242 returns 1, is if the input ends in e+INF or e+NaN. */
2249 value
= zero
/ zero
;
2252 value
= atof (read_buffer
+ negative
);
2256 return make_float (negative
? - value
: value
);
2260 if (uninterned_symbol
)
2261 return make_symbol (read_buffer
);
2263 return intern (read_buffer
);
2269 /* List of nodes we've seen during substitute_object_in_subtree. */
2270 static Lisp_Object seen_list
;
2273 substitute_object_in_subtree (object
, placeholder
)
2275 Lisp_Object placeholder
;
2277 Lisp_Object check_object
;
2279 /* We haven't seen any objects when we start. */
2282 /* Make all the substitutions. */
2284 = substitute_object_recurse (object
, placeholder
, object
);
2286 /* Clear seen_list because we're done with it. */
2289 /* The returned object here is expected to always eq the
2291 if (!EQ (check_object
, object
))
2292 error ("Unexpected mutation error in reader");
2295 /* Feval doesn't get called from here, so no gc protection is needed. */
2296 #define SUBSTITUTE(get_val, set_val) \
2298 Lisp_Object old_value = get_val; \
2299 Lisp_Object true_value \
2300 = substitute_object_recurse (object, placeholder,\
2303 if (!EQ (old_value, true_value)) \
2310 substitute_object_recurse (object
, placeholder
, subtree
)
2312 Lisp_Object placeholder
;
2313 Lisp_Object subtree
;
2315 /* If we find the placeholder, return the target object. */
2316 if (EQ (placeholder
, subtree
))
2319 /* If we've been to this node before, don't explore it again. */
2320 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2323 /* If this node can be the entry point to a cycle, remember that
2324 we've seen it. It can only be such an entry point if it was made
2325 by #n=, which means that we can find it as a value in
2327 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2328 seen_list
= Fcons (subtree
, seen_list
);
2330 /* Recurse according to subtree's type.
2331 Every branch must return a Lisp_Object. */
2332 switch (XTYPE (subtree
))
2334 case Lisp_Vectorlike
:
2337 int length
= XINT (Flength(subtree
));
2338 for (i
= 0; i
< length
; i
++)
2340 Lisp_Object idx
= make_number (i
);
2341 SUBSTITUTE (Faref (subtree
, idx
),
2342 Faset (subtree
, idx
, true_value
));
2349 SUBSTITUTE (Fcar_safe (subtree
),
2350 Fsetcar (subtree
, true_value
));
2351 SUBSTITUTE (Fcdr_safe (subtree
),
2352 Fsetcdr (subtree
, true_value
));
2358 /* Check for text properties in each interval.
2359 substitute_in_interval contains part of the logic. */
2361 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2362 Lisp_Object arg
= Fcons (object
, placeholder
);
2364 traverse_intervals (root_interval
, 1, 0,
2365 &substitute_in_interval
, arg
);
2370 /* Other types don't recurse any further. */
2376 /* Helper function for substitute_object_recurse. */
2378 substitute_in_interval (interval
, arg
)
2382 Lisp_Object object
= Fcar (arg
);
2383 Lisp_Object placeholder
= Fcdr (arg
);
2385 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2404 if (*cp
== '+' || *cp
== '-')
2407 if (*cp
>= '0' && *cp
<= '9')
2410 while (*cp
>= '0' && *cp
<= '9')
2418 if (*cp
>= '0' && *cp
<= '9')
2421 while (*cp
>= '0' && *cp
<= '9')
2424 if (*cp
== 'e' || *cp
== 'E')
2428 if (*cp
== '+' || *cp
== '-')
2432 if (*cp
>= '0' && *cp
<= '9')
2435 while (*cp
>= '0' && *cp
<= '9')
2438 else if (cp
== start
)
2440 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2445 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2451 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2452 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2453 || state
== (DOT_CHAR
|TRAIL_INT
)
2454 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2455 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2456 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2461 read_vector (readcharfun
, bytecodeflag
)
2462 Lisp_Object readcharfun
;
2467 register Lisp_Object
*ptr
;
2468 register Lisp_Object tem
, item
, vector
;
2469 register struct Lisp_Cons
*otem
;
2472 tem
= read_list (1, readcharfun
);
2473 len
= Flength (tem
);
2474 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2476 size
= XVECTOR (vector
)->size
;
2477 ptr
= XVECTOR (vector
)->contents
;
2478 for (i
= 0; i
< size
; i
++)
2481 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2482 bytecode object, the docstring containing the bytecode and
2483 constants values must be treated as unibyte and passed to
2484 Fread, to get the actual bytecode string and constants vector. */
2485 if (bytecodeflag
&& load_force_doc_strings
)
2487 if (i
== COMPILED_BYTECODE
)
2489 if (!STRINGP (item
))
2490 error ("invalid byte code");
2492 /* Delay handling the bytecode slot until we know whether
2493 it is lazily-loaded (we can tell by whether the
2494 constants slot is nil). */
2495 ptr
[COMPILED_CONSTANTS
] = item
;
2498 else if (i
== COMPILED_CONSTANTS
)
2500 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2504 /* Coerce string to unibyte (like string-as-unibyte,
2505 but without generating extra garbage and
2506 guaranteeing no change in the contents). */
2507 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2508 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2510 item
= Fread (bytestr
);
2512 error ("invalid byte code");
2514 otem
= XCONS (item
);
2515 bytestr
= XCAR (item
);
2520 /* Now handle the bytecode slot. */
2521 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2524 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2532 /* FLAG = 1 means check for ] to terminate rather than ) and .
2533 FLAG = -1 means check for starting with defun
2534 and make structure pure. */
2537 read_list (flag
, readcharfun
)
2539 register Lisp_Object readcharfun
;
2541 /* -1 means check next element for defun,
2542 0 means don't check,
2543 1 means already checked and found defun. */
2544 int defunflag
= flag
< 0 ? -1 : 0;
2545 Lisp_Object val
, tail
;
2546 register Lisp_Object elt
, tem
;
2547 struct gcpro gcpro1
, gcpro2
;
2548 /* 0 is the normal case.
2549 1 means this list is a doc reference; replace it with the number 0.
2550 2 means this list is a doc reference; replace it with the doc string. */
2551 int doc_reference
= 0;
2553 /* Initialize this to 1 if we are reading a list. */
2554 int first_in_list
= flag
<= 0;
2563 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2568 /* While building, if the list starts with #$, treat it specially. */
2569 if (EQ (elt
, Vload_file_name
)
2571 && !NILP (Vpurify_flag
))
2573 if (NILP (Vdoc_file_name
))
2574 /* We have not yet called Snarf-documentation, so assume
2575 this file is described in the DOC-MM.NN file
2576 and Snarf-documentation will fill in the right value later.
2577 For now, replace the whole list with 0. */
2580 /* We have already called Snarf-documentation, so make a relative
2581 file name for this file, so it can be found properly
2582 in the installed Lisp directory.
2583 We don't use Fexpand_file_name because that would make
2584 the directory absolute now. */
2585 elt
= concat2 (build_string ("../lisp/"),
2586 Ffile_name_nondirectory (elt
));
2588 else if (EQ (elt
, Vload_file_name
)
2590 && load_force_doc_strings
)
2599 Fsignal (Qinvalid_read_syntax
,
2600 Fcons (make_string (") or . in a vector", 18), Qnil
));
2608 XCDR (tail
) = read0 (readcharfun
);
2610 val
= read0 (readcharfun
);
2611 read1 (readcharfun
, &ch
, 0);
2615 if (doc_reference
== 1)
2616 return make_number (0);
2617 if (doc_reference
== 2)
2619 /* Get a doc string from the file we are loading.
2620 If it's in saved_doc_string, get it from there. */
2621 int pos
= XINT (XCDR (val
));
2622 /* Position is negative for user variables. */
2623 if (pos
< 0) pos
= -pos
;
2624 if (pos
>= saved_doc_string_position
2625 && pos
< (saved_doc_string_position
2626 + saved_doc_string_length
))
2628 int start
= pos
- saved_doc_string_position
;
2631 /* Process quoting with ^A,
2632 and find the end of the string,
2633 which is marked with ^_ (037). */
2634 for (from
= start
, to
= start
;
2635 saved_doc_string
[from
] != 037;)
2637 int c
= saved_doc_string
[from
++];
2640 c
= saved_doc_string
[from
++];
2642 saved_doc_string
[to
++] = c
;
2644 saved_doc_string
[to
++] = 0;
2646 saved_doc_string
[to
++] = 037;
2649 saved_doc_string
[to
++] = c
;
2652 return make_string (saved_doc_string
+ start
,
2655 /* Look in prev_saved_doc_string the same way. */
2656 else if (pos
>= prev_saved_doc_string_position
2657 && pos
< (prev_saved_doc_string_position
2658 + prev_saved_doc_string_length
))
2660 int start
= pos
- prev_saved_doc_string_position
;
2663 /* Process quoting with ^A,
2664 and find the end of the string,
2665 which is marked with ^_ (037). */
2666 for (from
= start
, to
= start
;
2667 prev_saved_doc_string
[from
] != 037;)
2669 int c
= prev_saved_doc_string
[from
++];
2672 c
= prev_saved_doc_string
[from
++];
2674 prev_saved_doc_string
[to
++] = c
;
2676 prev_saved_doc_string
[to
++] = 0;
2678 prev_saved_doc_string
[to
++] = 037;
2681 prev_saved_doc_string
[to
++] = c
;
2684 return make_string (prev_saved_doc_string
+ start
,
2688 return get_doc_string (val
, 0, 0);
2693 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2695 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2697 tem
= (read_pure
&& flag
<= 0
2698 ? pure_cons (elt
, Qnil
)
2699 : Fcons (elt
, Qnil
));
2706 defunflag
= EQ (elt
, Qdefun
);
2707 else if (defunflag
> 0)
2712 Lisp_Object Vobarray
;
2713 Lisp_Object initial_obarray
;
2715 /* oblookup stores the bucket number here, for the sake of Funintern. */
2717 int oblookup_last_bucket_number
;
2719 static int hash_string ();
2720 Lisp_Object
oblookup ();
2722 /* Get an error if OBARRAY is not an obarray.
2723 If it is one, return it. */
2726 check_obarray (obarray
)
2727 Lisp_Object obarray
;
2729 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2731 /* If Vobarray is now invalid, force it to be valid. */
2732 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2734 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2739 /* Intern the C string STR: return a symbol with that name,
2740 interned in the current obarray. */
2747 int len
= strlen (str
);
2748 Lisp_Object obarray
;
2751 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2752 obarray
= check_obarray (obarray
);
2753 tem
= oblookup (obarray
, str
, len
, len
);
2756 return Fintern (make_string (str
, len
), obarray
);
2759 /* Create an uninterned symbol with name STR. */
2765 int len
= strlen (str
);
2767 return Fmake_symbol ((!NILP (Vpurify_flag
)
2768 ? make_pure_string (str
, len
, len
, 0)
2769 : make_string (str
, len
)));
2772 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2773 "Return the canonical symbol whose name is STRING.\n\
2774 If there is none, one is created by this function and returned.\n\
2775 A second optional argument specifies the obarray to use;\n\
2776 it defaults to the value of `obarray'.")
2778 Lisp_Object string
, obarray
;
2780 register Lisp_Object tem
, sym
, *ptr
;
2782 if (NILP (obarray
)) obarray
= Vobarray
;
2783 obarray
= check_obarray (obarray
);
2785 CHECK_STRING (string
, 0);
2787 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2788 XSTRING (string
)->size
,
2789 STRING_BYTES (XSTRING (string
)));
2790 if (!INTEGERP (tem
))
2793 if (!NILP (Vpurify_flag
))
2794 string
= Fpurecopy (string
);
2795 sym
= Fmake_symbol (string
);
2796 XSYMBOL (sym
)->obarray
= obarray
;
2798 if ((XSTRING (string
)->data
[0] == ':')
2799 && EQ (obarray
, initial_obarray
))
2800 XSYMBOL (sym
)->value
= sym
;
2802 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2804 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2806 XSYMBOL (sym
)->next
= 0;
2811 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2812 "Return the canonical symbol named NAME, or nil if none exists.\n\
2813 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2814 symbol is searched for.\n\
2815 A second optional argument specifies the obarray to use;\n\
2816 it defaults to the value of `obarray'.")
2818 Lisp_Object name
, obarray
;
2820 register Lisp_Object tem
;
2821 struct Lisp_String
*string
;
2823 if (NILP (obarray
)) obarray
= Vobarray
;
2824 obarray
= check_obarray (obarray
);
2826 if (!SYMBOLP (name
))
2828 CHECK_STRING (name
, 0);
2829 string
= XSTRING (name
);
2832 string
= XSYMBOL (name
)->name
;
2834 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2835 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2841 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2842 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2843 The value is t if a symbol was found and deleted, nil otherwise.\n\
2844 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2845 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2846 OBARRAY defaults to the value of the variable `obarray'.")
2848 Lisp_Object name
, obarray
;
2850 register Lisp_Object string
, tem
;
2853 if (NILP (obarray
)) obarray
= Vobarray
;
2854 obarray
= check_obarray (obarray
);
2857 XSETSTRING (string
, XSYMBOL (name
)->name
);
2860 CHECK_STRING (name
, 0);
2864 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2865 XSTRING (string
)->size
,
2866 STRING_BYTES (XSTRING (string
)));
2869 /* If arg was a symbol, don't delete anything but that symbol itself. */
2870 if (SYMBOLP (name
) && !EQ (name
, tem
))
2873 XSYMBOL (tem
)->obarray
= Qnil
;
2875 hash
= oblookup_last_bucket_number
;
2877 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2879 if (XSYMBOL (tem
)->next
)
2880 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2882 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2886 Lisp_Object tail
, following
;
2888 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2889 XSYMBOL (tail
)->next
;
2892 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2893 if (EQ (following
, tem
))
2895 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2904 /* Return the symbol in OBARRAY whose names matches the string
2905 of SIZE characters (SIZE_BYTE bytes) at PTR.
2906 If there is no such symbol in OBARRAY, return nil.
2908 Also store the bucket number in oblookup_last_bucket_number. */
2911 oblookup (obarray
, ptr
, size
, size_byte
)
2912 Lisp_Object obarray
;
2914 int size
, size_byte
;
2918 register Lisp_Object tail
;
2919 Lisp_Object bucket
, tem
;
2921 if (!VECTORP (obarray
)
2922 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2924 obarray
= check_obarray (obarray
);
2925 obsize
= XVECTOR (obarray
)->size
;
2927 /* This is sometimes needed in the middle of GC. */
2928 obsize
&= ~ARRAY_MARK_FLAG
;
2929 /* Combining next two lines breaks VMS C 2.3. */
2930 hash
= hash_string (ptr
, size_byte
);
2932 bucket
= XVECTOR (obarray
)->contents
[hash
];
2933 oblookup_last_bucket_number
= hash
;
2934 if (XFASTINT (bucket
) == 0)
2936 else if (!SYMBOLP (bucket
))
2937 error ("Bad data in guts of obarray"); /* Like CADR error message */
2939 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2941 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2942 && XSYMBOL (tail
)->name
->size
== size
2943 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2945 else if (XSYMBOL (tail
)->next
== 0)
2948 XSETINT (tem
, hash
);
2953 hash_string (ptr
, len
)
2957 register unsigned char *p
= ptr
;
2958 register unsigned char *end
= p
+ len
;
2959 register unsigned char c
;
2960 register int hash
= 0;
2965 if (c
>= 0140) c
-= 40;
2966 hash
= ((hash
<<3) + (hash
>>28) + c
);
2968 return hash
& 07777777777;
2972 map_obarray (obarray
, fn
, arg
)
2973 Lisp_Object obarray
;
2974 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2978 register Lisp_Object tail
;
2979 CHECK_VECTOR (obarray
, 1);
2980 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2982 tail
= XVECTOR (obarray
)->contents
[i
];
2987 if (XSYMBOL (tail
)->next
== 0)
2989 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2995 mapatoms_1 (sym
, function
)
2996 Lisp_Object sym
, function
;
2998 call1 (function
, sym
);
3001 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3002 "Call FUNCTION on every symbol in OBARRAY.\n\
3003 OBARRAY defaults to the value of `obarray'.")
3005 Lisp_Object function
, obarray
;
3007 if (NILP (obarray
)) obarray
= Vobarray
;
3008 obarray
= check_obarray (obarray
);
3010 map_obarray (obarray
, mapatoms_1
, function
);
3014 #define OBARRAY_SIZE 1511
3019 Lisp_Object oblength
;
3023 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3025 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3026 Vobarray
= Fmake_vector (oblength
, make_number (0));
3027 initial_obarray
= Vobarray
;
3028 staticpro (&initial_obarray
);
3029 /* Intern nil in the obarray */
3030 XSYMBOL (Qnil
)->obarray
= Vobarray
;
3031 /* These locals are to kludge around a pyramid compiler bug. */
3032 hash
= hash_string ("nil", 3);
3033 /* Separate statement here to avoid VAXC bug. */
3034 hash
%= OBARRAY_SIZE
;
3035 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3038 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3039 XSYMBOL (Qnil
)->function
= Qunbound
;
3040 XSYMBOL (Qunbound
)->value
= Qunbound
;
3041 XSYMBOL (Qunbound
)->function
= Qunbound
;
3044 XSYMBOL (Qnil
)->value
= Qnil
;
3045 XSYMBOL (Qnil
)->plist
= Qnil
;
3046 XSYMBOL (Qt
)->value
= Qt
;
3048 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3051 Qvariable_documentation
= intern ("variable-documentation");
3052 staticpro (&Qvariable_documentation
);
3054 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3055 read_buffer
= (char *) xmalloc (read_buffer_size
);
3060 struct Lisp_Subr
*sname
;
3063 sym
= intern (sname
->symbol_name
);
3064 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3067 #ifdef NOTDEF /* use fset in subr.el now */
3069 defalias (sname
, string
)
3070 struct Lisp_Subr
*sname
;
3074 sym
= intern (string
);
3075 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3079 /* Define an "integer variable"; a symbol whose value is forwarded
3080 to a C variable of type int. Sample call: */
3081 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3083 defvar_int (namestring
, address
)
3087 Lisp_Object sym
, val
;
3088 sym
= intern (namestring
);
3089 val
= allocate_misc ();
3090 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3091 XINTFWD (val
)->intvar
= address
;
3092 XSYMBOL (sym
)->value
= val
;
3095 /* Similar but define a variable whose value is T if address contains 1,
3096 NIL if address contains 0 */
3098 defvar_bool (namestring
, address
)
3102 Lisp_Object sym
, val
;
3103 sym
= intern (namestring
);
3104 val
= allocate_misc ();
3105 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3106 XBOOLFWD (val
)->boolvar
= address
;
3107 XSYMBOL (sym
)->value
= val
;
3108 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3111 /* Similar but define a variable whose value is the Lisp Object stored
3112 at address. Two versions: with and without gc-marking of the C
3113 variable. The nopro version is used when that variable will be
3114 gc-marked for some other reason, since marking the same slot twice
3115 can cause trouble with strings. */
3117 defvar_lisp_nopro (namestring
, address
)
3119 Lisp_Object
*address
;
3121 Lisp_Object sym
, val
;
3122 sym
= intern (namestring
);
3123 val
= allocate_misc ();
3124 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3125 XOBJFWD (val
)->objvar
= address
;
3126 XSYMBOL (sym
)->value
= val
;
3130 defvar_lisp (namestring
, address
)
3132 Lisp_Object
*address
;
3134 defvar_lisp_nopro (namestring
, address
);
3135 staticpro (address
);
3138 /* Similar but define a variable whose value is the Lisp Object stored in
3139 the current buffer. address is the address of the slot in the buffer
3140 that is current now. */
3143 defvar_per_buffer (namestring
, address
, type
, doc
)
3145 Lisp_Object
*address
;
3149 Lisp_Object sym
, val
;
3151 extern struct buffer buffer_local_symbols
;
3153 sym
= intern (namestring
);
3154 val
= allocate_misc ();
3155 offset
= (char *)address
- (char *)current_buffer
;
3157 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3158 XBUFFER_OBJFWD (val
)->offset
= offset
;
3159 XSYMBOL (sym
)->value
= val
;
3160 PER_BUFFER_SYMBOL (offset
) = sym
;
3161 PER_BUFFER_TYPE (offset
) = type
;
3163 if (PER_BUFFER_IDX (offset
) == 0)
3164 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3165 slot of buffer_local_flags */
3170 /* Similar but define a variable whose value is the Lisp Object stored
3171 at a particular offset in the current kboard object. */
3174 defvar_kboard (namestring
, offset
)
3178 Lisp_Object sym
, val
;
3179 sym
= intern (namestring
);
3180 val
= allocate_misc ();
3181 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3182 XKBOARD_OBJFWD (val
)->offset
= offset
;
3183 XSYMBOL (sym
)->value
= val
;
3186 /* Record the value of load-path used at the start of dumping
3187 so we can see if the site changed it later during dumping. */
3188 static Lisp_Object dump_path
;
3194 int turn_off_warning
= 0;
3196 /* Compute the default load-path. */
3198 normal
= PATH_LOADSEARCH
;
3199 Vload_path
= decode_env_path (0, normal
);
3201 if (NILP (Vpurify_flag
))
3202 normal
= PATH_LOADSEARCH
;
3204 normal
= PATH_DUMPLOADSEARCH
;
3206 /* In a dumped Emacs, we normally have to reset the value of
3207 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3208 uses ../lisp, instead of the path of the installed elisp
3209 libraries. However, if it appears that Vload_path was changed
3210 from the default before dumping, don't override that value. */
3213 if (! NILP (Fequal (dump_path
, Vload_path
)))
3215 Vload_path
= decode_env_path (0, normal
);
3216 if (!NILP (Vinstallation_directory
))
3218 /* Add to the path the lisp subdir of the
3219 installation dir, if it exists. */
3220 Lisp_Object tem
, tem1
;
3221 tem
= Fexpand_file_name (build_string ("lisp"),
3222 Vinstallation_directory
);
3223 tem1
= Ffile_exists_p (tem
);
3226 if (NILP (Fmember (tem
, Vload_path
)))
3228 turn_off_warning
= 1;
3229 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3233 /* That dir doesn't exist, so add the build-time
3234 Lisp dirs instead. */
3235 Vload_path
= nconc2 (Vload_path
, dump_path
);
3237 /* Add leim under the installation dir, if it exists. */
3238 tem
= Fexpand_file_name (build_string ("leim"),
3239 Vinstallation_directory
);
3240 tem1
= Ffile_exists_p (tem
);
3243 if (NILP (Fmember (tem
, Vload_path
)))
3244 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3247 /* Add site-list under the installation dir, if it exists. */
3248 tem
= Fexpand_file_name (build_string ("site-lisp"),
3249 Vinstallation_directory
);
3250 tem1
= Ffile_exists_p (tem
);
3253 if (NILP (Fmember (tem
, Vload_path
)))
3254 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3257 /* If Emacs was not built in the source directory,
3258 and it is run from where it was built, add to load-path
3259 the lisp, leim and site-lisp dirs under that directory. */
3261 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3265 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3266 Vinstallation_directory
);
3267 tem1
= Ffile_exists_p (tem
);
3269 /* Don't be fooled if they moved the entire source tree
3270 AFTER dumping Emacs. If the build directory is indeed
3271 different from the source dir, src/Makefile.in and
3272 src/Makefile will not be found together. */
3273 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3274 Vinstallation_directory
);
3275 tem2
= Ffile_exists_p (tem
);
3276 if (!NILP (tem1
) && NILP (tem2
))
3278 tem
= Fexpand_file_name (build_string ("lisp"),
3281 if (NILP (Fmember (tem
, Vload_path
)))
3282 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3284 tem
= Fexpand_file_name (build_string ("leim"),
3287 if (NILP (Fmember (tem
, Vload_path
)))
3288 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3290 tem
= Fexpand_file_name (build_string ("site-lisp"),
3293 if (NILP (Fmember (tem
, Vload_path
)))
3294 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3302 /* NORMAL refers to the lisp dir in the source directory. */
3303 /* We used to add ../lisp at the front here, but
3304 that caused trouble because it was copied from dump_path
3305 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3306 It should be unnecessary. */
3307 Vload_path
= decode_env_path (0, normal
);
3308 dump_path
= Vload_path
;
3313 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3314 almost never correct, thereby causing a warning to be printed out that
3315 confuses users. Since PATH_LOADSEARCH is always overridden by the
3316 EMACSLOADPATH environment variable below, disable the warning on NT. */
3318 /* Warn if dirs in the *standard* path don't exist. */
3319 if (!turn_off_warning
)
3321 Lisp_Object path_tail
;
3323 for (path_tail
= Vload_path
;
3325 path_tail
= XCDR (path_tail
))
3327 Lisp_Object dirfile
;
3328 dirfile
= Fcar (path_tail
);
3329 if (STRINGP (dirfile
))
3331 dirfile
= Fdirectory_file_name (dirfile
);
3332 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3333 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3338 #endif /* WINDOWSNT */
3340 /* If the EMACSLOADPATH environment variable is set, use its value.
3341 This doesn't apply if we're dumping. */
3343 if (NILP (Vpurify_flag
)
3344 && egetenv ("EMACSLOADPATH"))
3346 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3350 load_in_progress
= 0;
3351 Vload_file_name
= Qnil
;
3353 load_descriptor_list
= Qnil
;
3355 Vstandard_input
= Qt
;
3358 /* Print a warning, using format string FORMAT, that directory DIRNAME
3359 does not exist. Print it on stderr and put it in *Message*. */
3362 dir_warning (format
, dirname
)
3364 Lisp_Object dirname
;
3367 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3369 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3370 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3371 /* Don't log the warning before we've initialized!! */
3373 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3380 defsubr (&Sread_from_string
);
3382 defsubr (&Sintern_soft
);
3383 defsubr (&Sunintern
);
3385 defsubr (&Seval_buffer
);
3386 defsubr (&Seval_region
);
3387 defsubr (&Sread_char
);
3388 defsubr (&Sread_char_exclusive
);
3389 defsubr (&Sread_event
);
3390 defsubr (&Sget_file_char
);
3391 defsubr (&Smapatoms
);
3393 DEFVAR_LISP ("obarray", &Vobarray
,
3394 "Symbol table for use by `intern' and `read'.\n\
3395 It is a vector whose length ought to be prime for best results.\n\
3396 The vector's contents don't make sense if examined from Lisp programs;\n\
3397 to find all the symbols in an obarray, use `mapatoms'.");
3399 DEFVAR_LISP ("values", &Vvalues
,
3400 "List of values of all expressions which were read, evaluated and printed.\n\
3401 Order is reverse chronological.");
3403 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3404 "Stream for read to get input from.\n\
3405 See documentation of `read' for possible values.");
3406 Vstandard_input
= Qt
;
3408 DEFVAR_LISP ("load-path", &Vload_path
,
3409 "*List of directories to search for files to load.\n\
3410 Each element is a string (directory name) or nil (try default directory).\n\
3411 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3412 otherwise to default specified by file `epaths.h' when Emacs was built.");
3414 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3415 "Non-nil iff inside of `load'.");
3417 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3418 "An alist of expressions to be evalled when particular files are loaded.\n\
3419 Each element looks like (FILENAME FORMS...).\n\
3420 When `load' is run and the file-name argument is FILENAME,\n\
3421 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3422 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3423 with no directory specified, since that is how `load' is normally called.\n\
3424 An error in FORMS does not undo the load,\n\
3425 but does prevent execution of the rest of the FORMS.");
3426 Vafter_load_alist
= Qnil
;
3428 DEFVAR_LISP ("load-history", &Vload_history
,
3429 "Alist mapping source file names to symbols and features.\n\
3430 Each alist element is a list that starts with a file name,\n\
3431 except for one element (optional) that starts with nil and describes\n\
3432 definitions evaluated from buffers not visiting files.\n\
3433 The remaining elements of each list are symbols defined as functions\n\
3434 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
3435 and `(autoload . SYMBOL)'.");
3436 Vload_history
= Qnil
;
3438 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3439 "Full name of file being loaded by `load'.");
3440 Vload_file_name
= Qnil
;
3442 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3443 "File name, including directory, of user's initialization file.\n\
3444 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3445 file, this variable contains the name of the .el file, suitable for use\n\
3446 by functions like `custom-save-all' which edit the init file.");
3447 Vuser_init_file
= Qnil
;
3449 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3450 "Used for internal purposes by `load'.");
3451 Vcurrent_load_list
= Qnil
;
3453 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3454 "Function used by `load' and `eval-region' for reading expressions.\n\
3455 The default is nil, which means use the function `read'.");
3456 Vload_read_function
= Qnil
;
3458 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3459 "Function called in `load' for loading an Emacs lisp source file.\n\
3460 This function is for doing code conversion before reading the source file.\n\
3461 If nil, loading is done without any code conversion.\n\
3462 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3463 FULLNAME is the full name of FILE.\n\
3464 See `load' for the meaning of the remaining arguments.");
3465 Vload_source_file_function
= Qnil
;
3467 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3468 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3469 This is useful when the file being loaded is a temporary copy.");
3470 load_force_doc_strings
= 0;
3472 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3473 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3474 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3475 and is not meant for users to change.");
3476 load_convert_to_unibyte
= 0;
3478 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3479 "Directory in which Emacs sources were found when Emacs was built.\n\
3480 You cannot count on them to still be there!");
3482 = Fexpand_file_name (build_string ("../"),
3483 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3485 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3486 "List of files that were preloaded (when dumping Emacs).");
3487 Vpreloaded_file_list
= Qnil
;
3489 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3490 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3491 Vbyte_boolean_vars
= Qnil
;
3493 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3494 "Non-nil means load dangerous compiled Lisp files.\n\
3495 Some versions of XEmacs use different byte codes than Emacs. These\n\
3496 incompatible byte codes can make Emacs crash when it tries to execute\n\
3498 load_dangerous_libraries
= 0;
3500 Vbytecomp_version_regexp
= build_string ("^;;;.in Emacs version");
3501 staticpro (&Vbytecomp_version_regexp
);
3503 /* Vsource_directory was initialized in init_lread. */
3505 load_descriptor_list
= Qnil
;
3506 staticpro (&load_descriptor_list
);
3508 Qcurrent_load_list
= intern ("current-load-list");
3509 staticpro (&Qcurrent_load_list
);
3511 Qstandard_input
= intern ("standard-input");
3512 staticpro (&Qstandard_input
);
3514 Qread_char
= intern ("read-char");
3515 staticpro (&Qread_char
);
3517 Qget_file_char
= intern ("get-file-char");
3518 staticpro (&Qget_file_char
);
3520 Qbackquote
= intern ("`");
3521 staticpro (&Qbackquote
);
3522 Qcomma
= intern (",");
3523 staticpro (&Qcomma
);
3524 Qcomma_at
= intern (",@");
3525 staticpro (&Qcomma_at
);
3526 Qcomma_dot
= intern (",.");
3527 staticpro (&Qcomma_dot
);
3529 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3530 staticpro (&Qinhibit_file_name_operation
);
3532 Qascii_character
= intern ("ascii-character");
3533 staticpro (&Qascii_character
);
3535 Qfunction
= intern ("function");
3536 staticpro (&Qfunction
);
3538 Qload
= intern ("load");
3541 Qload_file_name
= intern ("load-file-name");
3542 staticpro (&Qload_file_name
);
3544 staticpro (&dump_path
);
3546 staticpro (&read_objects
);
3547 read_objects
= Qnil
;
3548 staticpro (&seen_list
);