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
)
300 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
301 read_from_string_index
,
302 read_from_string_index_byte
);
307 tem
= call0 (readcharfun
);
314 /* Unread the character C in the way appropriate for the stream READCHARFUN.
315 If the stream is a user function, call it with the char as argument. */
318 unreadchar (readcharfun
, c
)
319 Lisp_Object readcharfun
;
323 /* Don't back up the pointer if we're unreading the end-of-input mark,
324 since readchar didn't advance it when we read it. */
326 else if (BUFFERP (readcharfun
))
328 struct buffer
*b
= XBUFFER (readcharfun
);
329 int bytepos
= BUF_PT_BYTE (b
);
331 if (readchar_backlog
>= 0)
336 if (! NILP (b
->enable_multibyte_characters
))
337 BUF_DEC_POS (b
, bytepos
);
341 BUF_PT_BYTE (b
) = bytepos
;
344 else if (MARKERP (readcharfun
))
346 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
347 int bytepos
= XMARKER (readcharfun
)->bytepos
;
349 if (readchar_backlog
>= 0)
353 XMARKER (readcharfun
)->charpos
--;
354 if (! NILP (b
->enable_multibyte_characters
))
355 BUF_DEC_POS (b
, bytepos
);
359 XMARKER (readcharfun
)->bytepos
= bytepos
;
362 else if (STRINGP (readcharfun
))
364 read_from_string_index
--;
365 read_from_string_index_byte
366 = string_char_to_byte (readcharfun
, read_from_string_index
);
368 else if (EQ (readcharfun
, Qlambda
))
369 read_bytecode_char (1);
370 else if (EQ (readcharfun
, Qget_file_char
))
371 ungetc (c
, instream
);
373 call1 (readcharfun
, make_number (c
));
376 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
377 static int read_multibyte ();
378 static Lisp_Object
substitute_object_recurse ();
379 static void substitute_object_in_subtree (), substitute_in_interval ();
382 /* Get a character from the tty. */
384 extern Lisp_Object
read_char ();
386 /* Read input events until we get one that's acceptable for our purposes.
388 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
389 until we get a character we like, and then stuffed into
392 If ASCII_REQUIRED is non-zero, we check function key events to see
393 if the unmodified version of the symbol has a Qascii_character
394 property, and use that character, if present.
396 If ERROR_NONASCII is non-zero, we signal an error if the input we
397 get isn't an ASCII character with modifiers. If it's zero but
398 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
401 If INPUT_METHOD is nonzero, we invoke the current input method
402 if the character warrants that. */
405 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
407 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
409 register Lisp_Object val
, delayed_switch_frame
;
411 #ifdef HAVE_WINDOW_SYSTEM
412 if (display_busy_cursor_p
)
413 cancel_busy_cursor ();
416 delayed_switch_frame
= Qnil
;
418 /* Read until we get an acceptable event. */
420 val
= read_char (0, 0, 0,
421 (input_method
? Qnil
: Qt
),
427 /* switch-frame events are put off until after the next ASCII
428 character. This is better than signaling an error just because
429 the last characters were typed to a separate minibuffer frame,
430 for example. Eventually, some code which can deal with
431 switch-frame events will read it and process it. */
433 && EVENT_HAS_PARAMETERS (val
)
434 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
436 delayed_switch_frame
= val
;
442 /* Convert certain symbols to their ASCII equivalents. */
445 Lisp_Object tem
, tem1
;
446 tem
= Fget (val
, Qevent_symbol_element_mask
);
449 tem1
= Fget (Fcar (tem
), Qascii_character
);
450 /* Merge this symbol's modifier bits
451 with the ASCII equivalent of its basic code. */
453 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
457 /* If we don't have a character now, deal with it appropriately. */
462 Vunread_command_events
= Fcons (val
, Qnil
);
463 error ("Non-character input-event");
470 if (! NILP (delayed_switch_frame
))
471 unread_switch_frame
= delayed_switch_frame
;
473 #ifdef HAVE_WINDOW_SYSTEM
474 if (display_busy_cursor_p
)
475 start_busy_cursor ();
480 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
481 "Read a character from the command input (keyboard or macro).\n\
482 It is returned as a number.\n\
483 If the user generates an event which is not a character (i.e. a mouse\n\
484 click or function key event), `read-char' signals an error. As an\n\
485 exception, switch-frame events are put off until non-ASCII events can\n\
487 If you want to read non-character events, or ignore them, call\n\
488 `read-event' or `read-char-exclusive' instead.\n\
490 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
491 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
492 input method is turned on in the current buffer, that input method\n\
493 is used for reading a character.")
494 (prompt
, inherit_input_method
)
495 Lisp_Object prompt
, inherit_input_method
;
498 message_with_string ("%s", prompt
, 0);
499 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
502 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
503 "Read an event object from the input stream.\n\
504 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
505 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
506 input method is turned on in the current buffer, that input method\n\
507 is used for reading a character.")
508 (prompt
, inherit_input_method
)
509 Lisp_Object prompt
, inherit_input_method
;
512 message_with_string ("%s", prompt
, 0);
513 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
516 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
517 "Read a character from the command input (keyboard or macro).\n\
518 It is returned as a number. Non-character events are ignored.\n\
520 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
521 If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\
522 input method is turned on in the current buffer, that input method\n\
523 is used for reading a character.")
524 (prompt
, inherit_input_method
)
525 Lisp_Object prompt
, inherit_input_method
;
528 message_with_string ("%s", prompt
, 0);
529 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
532 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
533 "Don't use this yourself.")
536 register Lisp_Object val
;
537 XSETINT (val
, getc (instream
));
541 static void readevalloop ();
542 static Lisp_Object
load_unwind ();
543 static Lisp_Object
load_descriptor_unwind ();
545 /* Non-zero means load dangerous compiled Lisp files. */
547 int load_dangerous_libraries
;
549 /* A regular expression used to detect files compiled with Emacs. */
551 static Lisp_Object Vbytecomp_version_regexp
;
554 /* Value is non-zero if the file asswociated with file descriptor FD
555 is a compiled Lisp file that's safe to load. Only files compiled
556 with Emacs are safe to load. Files compiled with XEmacs can lead
557 to a crash in Fbyte_code because of an incompatible change in the
568 /* Read the first few bytes from the file, and look for a line
569 specifying the byte compiler version used. */
570 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
575 /* Skip to the next newline, skipping over the initial `ELC'
576 with NUL bytes following it. */
577 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
581 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
586 lseek (fd
, 0, SEEK_SET
);
591 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
592 "Execute a file of Lisp code named FILE.\n\
593 First try FILE with `.elc' appended, then try with `.el',\n\
594 then try FILE unmodified.\n\
595 This function searches the directories in `load-path'.\n\
596 If optional second arg NOERROR is non-nil,\n\
597 report no error if FILE doesn't exist.\n\
598 Print messages at start and end of loading unless\n\
599 optional third arg NOMESSAGE is non-nil.\n\
600 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
601 suffixes `.elc' or `.el' to the specified name FILE.\n\
602 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
603 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
604 it ends in one of those suffixes or includes a directory name.\n\
605 Return t if file exists.")
606 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
607 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
609 register FILE *stream
;
610 register int fd
= -1;
611 register Lisp_Object lispstream
;
612 int count
= specpdl_ptr
- specpdl
;
616 /* 1 means we printed the ".el is newer" message. */
618 /* 1 means we are loading a compiled file. */
627 CHECK_STRING (file
, 0);
629 /* If file name is magic, call the handler. */
630 handler
= Ffind_file_name_handler (file
, Qload
);
632 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
634 /* Do this after the handler to avoid
635 the need to gcpro noerror, nomessage and nosuffix.
636 (Below here, we care only whether they are nil or not.) */
637 file
= Fsubstitute_in_file_name (file
);
639 /* Avoid weird lossage with null string as arg,
640 since it would try to load a directory as a Lisp file */
641 if (XSTRING (file
)->size
> 0)
643 int size
= STRING_BYTES (XSTRING (file
));
647 if (! NILP (must_suffix
))
649 /* Don't insist on adding a suffix if FILE already ends with one. */
651 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
654 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
656 /* Don't insist on adding a suffix
657 if the argument includes a directory name. */
658 else if (! NILP (Ffile_name_directory (file
)))
662 fd
= openp (Vload_path
, file
,
663 (!NILP (nosuffix
) ? ""
664 : ! NILP (must_suffix
) ? ".elc.gz:.elc:.el.gz:.el"
665 : ".elc:.elc.gz:.el.gz:.el:"),
674 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
675 Fcons (file
, Qnil
)));
680 if (EQ (Qt
, Vuser_init_file
))
681 Vuser_init_file
= found
;
683 /* If FD is 0, that means openp found a magic file. */
686 if (NILP (Fequal (found
, file
)))
687 /* If FOUND is a different file name from FILE,
688 find its handler even if we have already inhibited
689 the `load' operation on FILE. */
690 handler
= Ffind_file_name_handler (found
, Qt
);
692 handler
= Ffind_file_name_handler (found
, Qload
);
693 if (! NILP (handler
))
694 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
697 /* Load .elc files directly, but not when they are
698 remote and have no handler! */
699 if (!bcmp (&(XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 4]),
706 if (!safe_to_load_p (fd
))
709 if (!load_dangerous_libraries
)
710 error ("File `%s' was not compiled in Emacs",
711 XSTRING (found
)->data
);
712 else if (!NILP (nomessage
))
713 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
721 stat ((char *)XSTRING (found
)->data
, &s1
);
722 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 0;
723 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
724 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
726 /* Make the progress messages mention that source is newer. */
729 /* If we won't print another message, mention this anyway. */
730 if (! NILP (nomessage
))
731 message_with_string ("Source file `%s' newer than byte-compiled file",
734 XSTRING (found
)->data
[STRING_BYTES (XSTRING (found
)) - 1] = 'c';
740 /* We are loading a source file (*.el). */
741 if (!NILP (Vload_source_file_function
))
745 return call4 (Vload_source_file_function
, found
, file
,
746 NILP (noerror
) ? Qnil
: Qt
,
747 NILP (nomessage
) ? Qnil
: Qt
);
753 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
754 #else /* not WINDOWSNT */
755 stream
= fdopen (fd
, fmode
);
756 #endif /* not WINDOWSNT */
760 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
763 if (! NILP (Vpurify_flag
))
764 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
766 if (NILP (nomessage
))
769 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
772 message_with_string ("Loading %s (source)...", file
, 1);
774 message_with_string ("Loading %s (compiled; note, source file is newer)...",
776 else /* The typical case; compiled file newer than source file. */
777 message_with_string ("Loading %s...", file
, 1);
781 lispstream
= Fcons (Qnil
, Qnil
);
782 XSETFASTINT (XCAR (lispstream
), (EMACS_UINT
)stream
>> 16);
783 XSETFASTINT (XCDR (lispstream
), (EMACS_UINT
)stream
& 0xffff);
784 record_unwind_protect (load_unwind
, lispstream
);
785 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
786 specbind (Qload_file_name
, found
);
787 specbind (Qinhibit_file_name_operation
, Qnil
);
789 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
791 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
792 unbind_to (count
, Qnil
);
794 /* Run any load-hooks for this file. */
795 temp
= Fassoc (file
, Vafter_load_alist
);
797 Fprogn (Fcdr (temp
));
800 if (saved_doc_string
)
801 free (saved_doc_string
);
802 saved_doc_string
= 0;
803 saved_doc_string_size
= 0;
805 if (prev_saved_doc_string
)
806 xfree (prev_saved_doc_string
);
807 prev_saved_doc_string
= 0;
808 prev_saved_doc_string_size
= 0;
810 if (!noninteractive
&& NILP (nomessage
))
813 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
816 message_with_string ("Loading %s (source)...done", file
, 1);
818 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
820 else /* The typical case; compiled file newer than source file. */
821 message_with_string ("Loading %s...done", file
, 1);
827 load_unwind (stream
) /* used as unwind-protect function in load */
830 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
831 | XFASTINT (XCDR (stream
))));
832 if (--load_in_progress
< 0) load_in_progress
= 0;
837 load_descriptor_unwind (oldlist
)
840 load_descriptor_list
= oldlist
;
844 /* Close all descriptors in use for Floads.
845 This is used when starting a subprocess. */
852 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
853 emacs_close (XFASTINT (XCAR (tail
)));
858 complete_filename_p (pathname
)
859 Lisp_Object pathname
;
861 register unsigned char *s
= XSTRING (pathname
)->data
;
862 return (IS_DIRECTORY_SEP (s
[0])
863 || (XSTRING (pathname
)->size
> 2
864 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
874 /* Search for a file whose name is STR, looking in directories
875 in the Lisp list PATH, and trying suffixes from SUFFIX.
876 SUFFIX is a string containing possible suffixes separated by colons.
877 On success, returns a file descriptor. On failure, returns -1.
879 EXEC_ONLY nonzero means don't open the files,
880 just look for one that is executable. In this case,
881 returns 1 on success.
883 If STOREPTR is nonzero, it points to a slot where the name of
884 the file actually found should be stored as a Lisp string.
885 nil is stored there on failure.
887 If the file we find is remote, return 0
888 but store the found remote file name in *STOREPTR.
889 We do not check for remote files if EXEC_ONLY is nonzero. */
892 openp (path
, str
, suffix
, storeptr
, exec_only
)
893 Lisp_Object path
, str
;
895 Lisp_Object
*storeptr
;
901 register char *fn
= buf
;
904 Lisp_Object filename
;
912 if (complete_filename_p (str
))
915 for (; !NILP (path
); path
= Fcdr (path
))
919 filename
= Fexpand_file_name (str
, Fcar (path
));
920 if (!complete_filename_p (filename
))
921 /* If there are non-absolute elts in PATH (eg ".") */
922 /* Of course, this could conceivably lose if luser sets
923 default-directory to be something non-absolute... */
925 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
926 if (!complete_filename_p (filename
))
927 /* Give up on this path element! */
931 /* Calculate maximum size of any filename made from
932 this path element/specified file name and any possible suffix. */
933 want_size
= strlen (suffix
) + STRING_BYTES (XSTRING (filename
)) + 1;
934 if (fn_size
< want_size
)
935 fn
= (char *) alloca (fn_size
= 100 + want_size
);
939 /* Loop over suffixes. */
942 char *esuffix
= (char *) index (nsuffix
, ':');
943 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
946 /* Concatenate path element/specified name with the suffix.
947 If the directory starts with /:, remove that. */
948 if (XSTRING (filename
)->size
> 2
949 && XSTRING (filename
)->data
[0] == '/'
950 && XSTRING (filename
)->data
[1] == ':')
952 strncpy (fn
, XSTRING (filename
)->data
+ 2,
953 STRING_BYTES (XSTRING (filename
)) - 2);
954 fn
[STRING_BYTES (XSTRING (filename
)) - 2] = 0;
958 strncpy (fn
, XSTRING (filename
)->data
,
959 STRING_BYTES (XSTRING (filename
)));
960 fn
[STRING_BYTES (XSTRING (filename
))] = 0;
963 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
964 strncat (fn
, nsuffix
, lsuffix
);
966 /* Check that the file exists and is not a directory. */
970 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
971 if (! NILP (handler
) && ! exec_only
)
976 string
= build_string (fn
);
977 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
978 : Ffile_readable_p (string
));
980 && ! NILP (Ffile_directory_p (build_string (fn
))))
985 /* We succeeded; return this descriptor and filename. */
987 *storeptr
= build_string (fn
);
994 int exists
= (stat (fn
, &st
) >= 0
995 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
998 /* Check that we can access or open it. */
1000 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
1002 fd
= emacs_open (fn
, O_RDONLY
, 0);
1006 /* We succeeded; return this descriptor and filename. */
1008 *storeptr
= build_string (fn
);
1015 /* Advance to next suffix. */
1018 nsuffix
+= lsuffix
+ 1;
1029 /* Merge the list we've accumulated of globals from the current input source
1030 into the load_history variable. The details depend on whether
1031 the source has an associated file name or not. */
1034 build_load_history (stream
, source
)
1038 register Lisp_Object tail
, prev
, newelt
;
1039 register Lisp_Object tem
, tem2
;
1040 register int foundit
, loading
;
1042 loading
= stream
|| !NARROWED
;
1044 tail
= Vload_history
;
1047 while (!NILP (tail
))
1051 /* Find the feature's previous assoc list... */
1052 if (!NILP (Fequal (source
, Fcar (tem
))))
1056 /* If we're loading, remove it. */
1060 Vload_history
= Fcdr (tail
);
1062 Fsetcdr (prev
, Fcdr (tail
));
1065 /* Otherwise, cons on new symbols that are not already members. */
1068 tem2
= Vcurrent_load_list
;
1070 while (CONSP (tem2
))
1072 newelt
= Fcar (tem2
);
1074 if (NILP (Fmemq (newelt
, tem
)))
1075 Fsetcar (tail
, Fcons (Fcar (tem
),
1076 Fcons (newelt
, Fcdr (tem
))));
1089 /* If we're loading, cons the new assoc onto the front of load-history,
1090 the most-recently-loaded position. Also do this if we didn't find
1091 an existing member for the current source. */
1092 if (loading
|| !foundit
)
1093 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1098 unreadpure () /* Used as unwind-protect function in readevalloop */
1105 readevalloop_1 (old
)
1108 load_convert_to_unibyte
= ! NILP (old
);
1112 /* Signal an `end-of-file' error, if possible with file name
1116 end_of_file_error ()
1120 if (STRINGP (Vload_file_name
))
1121 data
= Fcons (Vload_file_name
, Qnil
);
1125 Fsignal (Qend_of_file
, data
);
1128 /* UNIBYTE specifies how to set load_convert_to_unibyte
1129 for this invocation.
1130 READFUN, if non-nil, is used instead of `read'. */
1133 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1134 Lisp_Object readcharfun
;
1136 Lisp_Object sourcename
;
1137 Lisp_Object (*evalfun
) ();
1139 Lisp_Object unibyte
, readfun
;
1142 register Lisp_Object val
;
1143 int count
= specpdl_ptr
- specpdl
;
1144 struct gcpro gcpro1
;
1145 struct buffer
*b
= 0;
1147 if (BUFFERP (readcharfun
))
1148 b
= XBUFFER (readcharfun
);
1149 else if (MARKERP (readcharfun
))
1150 b
= XMARKER (readcharfun
)->buffer
;
1152 specbind (Qstandard_input
, readcharfun
);
1153 specbind (Qcurrent_load_list
, Qnil
);
1154 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1155 load_convert_to_unibyte
= !NILP (unibyte
);
1157 readchar_backlog
= -1;
1159 GCPRO1 (sourcename
);
1161 LOADHIST_ATTACH (sourcename
);
1165 if (b
!= 0 && NILP (b
->name
))
1166 error ("Reading from killed buffer");
1172 while ((c
= READCHAR
) != '\n' && c
!= -1);
1177 /* Ignore whitespace here, so we can detect eof. */
1178 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1181 if (!NILP (Vpurify_flag
) && c
== '(')
1183 int count1
= specpdl_ptr
- specpdl
;
1184 record_unwind_protect (unreadpure
, Qnil
);
1185 val
= read_list (-1, readcharfun
);
1186 unbind_to (count1
, Qnil
);
1191 read_objects
= Qnil
;
1192 if (! NILP (readfun
))
1193 val
= call1 (readfun
, readcharfun
);
1194 else if (! NILP (Vload_read_function
))
1195 val
= call1 (Vload_read_function
, readcharfun
);
1197 val
= read0 (readcharfun
);
1200 val
= (*evalfun
) (val
);
1203 Vvalues
= Fcons (val
, Vvalues
);
1204 if (EQ (Vstandard_output
, Qt
))
1211 build_load_history (stream
, sourcename
);
1214 unbind_to (count
, Qnil
);
1217 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1218 "Execute the current buffer as Lisp code.\n\
1219 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1220 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1221 PRINTFLAG controls printing of output:\n\
1222 nil means discard it; anything else is stream for print.\n\
1224 If the optional third argument FILENAME is non-nil,\n\
1225 it specifies the file name to use for `load-history'.\n\
1226 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\
1227 for this invocation.\n\
1229 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\
1230 `print' and related functions should work normally even if PRINTFLAG is nil.\n\
1232 This function preserves the position of point.")
1233 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1234 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1236 int count
= specpdl_ptr
- specpdl
;
1237 Lisp_Object tem
, buf
;
1240 buf
= Fcurrent_buffer ();
1242 buf
= Fget_buffer (buffer
);
1244 error ("No such buffer");
1246 if (NILP (printflag
) && NILP (do_allow_print
))
1251 if (NILP (filename
))
1252 filename
= XBUFFER (buf
)->filename
;
1254 specbind (Qstandard_output
, tem
);
1255 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1256 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1257 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1258 unbind_to (count
, Qnil
);
1264 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1265 "Execute the current buffer as Lisp code.\n\
1266 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1267 nil means discard it; anything else is stream for print.\n\
1269 If there is no error, point does not move. If there is an error,\n\
1270 point remains at the end of the last character read from the buffer.")
1272 Lisp_Object printflag
;
1274 int count
= specpdl_ptr
- specpdl
;
1275 Lisp_Object tem
, cbuf
;
1277 cbuf
= Fcurrent_buffer ()
1279 if (NILP (printflag
))
1283 specbind (Qstandard_output
, tem
);
1284 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1286 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1287 !NILP (printflag
), Qnil
, Qnil
);
1288 return unbind_to (count
, Qnil
);
1292 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1293 "Execute the region as Lisp code.\n\
1294 When called from programs, expects two arguments,\n\
1295 giving starting and ending indices in the current buffer\n\
1296 of the text to be executed.\n\
1297 Programs can pass third argument PRINTFLAG which controls output:\n\
1298 nil means discard it; anything else is stream for printing it.\n\
1299 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1300 instead of `read' to read each expression. It gets one argument\n\
1301 which is the input stream for reading characters.\n\
1303 This function does not move point.")
1304 (start
, end
, printflag
, read_function
)
1305 Lisp_Object start
, end
, printflag
, read_function
;
1307 int count
= specpdl_ptr
- specpdl
;
1308 Lisp_Object tem
, cbuf
;
1310 cbuf
= Fcurrent_buffer ();
1312 if (NILP (printflag
))
1316 specbind (Qstandard_output
, tem
);
1318 if (NILP (printflag
))
1319 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1320 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1322 /* This both uses start and checks its type. */
1324 Fnarrow_to_region (make_number (BEGV
), end
);
1325 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1326 !NILP (printflag
), Qnil
, read_function
);
1328 return unbind_to (count
, Qnil
);
1332 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1333 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1334 If STREAM is nil, use the value of `standard-input' (which see).\n\
1335 STREAM or the value of `standard-input' may be:\n\
1336 a buffer (read from point and advance it)\n\
1337 a marker (read from where it points and advance it)\n\
1338 a function (call it with no arguments for each character,\n\
1339 call it with a char as argument to push a char back)\n\
1340 a string (takes text from string, starting at the beginning)\n\
1341 t (read text line using minibuffer and use it).")
1345 extern Lisp_Object
Fread_minibuffer ();
1348 stream
= Vstandard_input
;
1349 if (EQ (stream
, Qt
))
1350 stream
= Qread_char
;
1352 readchar_backlog
= -1;
1353 new_backquote_flag
= 0;
1354 read_objects
= Qnil
;
1356 if (EQ (stream
, Qread_char
))
1357 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1359 if (STRINGP (stream
))
1360 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1362 return read0 (stream
);
1365 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1366 "Read one Lisp expression which is represented as text by STRING.\n\
1367 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1368 START and END optionally delimit a substring of STRING from which to read;\n\
1369 they default to 0 and (length STRING) respectively.")
1370 (string
, start
, end
)
1371 Lisp_Object string
, start
, end
;
1373 int startval
, endval
;
1376 CHECK_STRING (string
,0);
1379 endval
= XSTRING (string
)->size
;
1382 CHECK_NUMBER (end
, 2);
1383 endval
= XINT (end
);
1384 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1385 args_out_of_range (string
, end
);
1392 CHECK_NUMBER (start
, 1);
1393 startval
= XINT (start
);
1394 if (startval
< 0 || startval
> endval
)
1395 args_out_of_range (string
, start
);
1398 read_from_string_index
= startval
;
1399 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1400 read_from_string_limit
= endval
;
1402 new_backquote_flag
= 0;
1403 read_objects
= Qnil
;
1405 tem
= read0 (string
);
1406 return Fcons (tem
, make_number (read_from_string_index
));
1409 /* Use this for recursive reads, in contexts where internal tokens
1414 Lisp_Object readcharfun
;
1416 register Lisp_Object val
;
1419 val
= read1 (readcharfun
, &c
, 0);
1421 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1428 static int read_buffer_size
;
1429 static char *read_buffer
;
1431 /* Read multibyte form and return it as a character. C is a first
1432 byte of multibyte form, and rest of them are read from
1436 read_multibyte (c
, readcharfun
)
1438 Lisp_Object readcharfun
;
1440 /* We need the actual character code of this multibyte
1442 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1446 while ((c
= READCHAR
) >= 0xA0
1447 && len
< MAX_MULTIBYTE_LENGTH
)
1450 return STRING_CHAR (str
, len
);
1453 /* Read a \-escape sequence, assuming we already read the `\'. */
1456 read_escape (readcharfun
, stringp
)
1457 Lisp_Object readcharfun
;
1460 register int c
= READCHAR
;
1464 error ("End of file");
1494 error ("Invalid escape character syntax");
1497 c
= read_escape (readcharfun
, 0);
1498 return c
| meta_modifier
;
1503 error ("Invalid escape character syntax");
1506 c
= read_escape (readcharfun
, 0);
1507 return c
| shift_modifier
;
1512 error ("Invalid escape character syntax");
1515 c
= read_escape (readcharfun
, 0);
1516 return c
| hyper_modifier
;
1521 error ("Invalid escape character syntax");
1524 c
= read_escape (readcharfun
, 0);
1525 return c
| alt_modifier
;
1530 error ("Invalid escape character syntax");
1533 c
= read_escape (readcharfun
, 0);
1534 return c
| super_modifier
;
1539 error ("Invalid escape character syntax");
1543 c
= read_escape (readcharfun
, 0);
1544 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1545 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1546 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1547 return c
| ctrl_modifier
;
1548 /* ASCII control chars are made from letters (both cases),
1549 as well as the non-letters within 0100...0137. */
1550 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1551 return (c
& (037 | ~0177));
1552 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1553 return (c
& (037 | ~0177));
1555 return c
| ctrl_modifier
;
1565 /* An octal escape, as in ANSI C. */
1567 register int i
= c
- '0';
1568 register int count
= 0;
1571 if ((c
= READCHAR
) >= '0' && c
<= '7')
1586 /* A hex escape, as in ANSI C. */
1592 if (c
>= '0' && c
<= '9')
1597 else if ((c
>= 'a' && c
<= 'f')
1598 || (c
>= 'A' && c
<= 'F'))
1601 if (c
>= 'a' && c
<= 'f')
1616 if (BASE_LEADING_CODE_P (c
))
1617 c
= read_multibyte (c
, readcharfun
);
1623 /* Read an integer in radix RADIX using READCHARFUN to read
1624 characters. RADIX must be in the interval [2..36]; if it isn't, a
1625 read error is signaled . Value is the integer read. Signals an
1626 error if encountering invalid read syntax or if RADIX is out of
1630 read_integer (readcharfun
, radix
)
1631 Lisp_Object readcharfun
;
1634 int number
, ndigits
, invalid_p
, c
, sign
;
1636 if (radix
< 2 || radix
> 36)
1640 number
= ndigits
= invalid_p
= 0;
1656 if (c
>= '0' && c
<= '9')
1658 else if (c
>= 'a' && c
<= 'z')
1659 digit
= c
- 'a' + 10;
1660 else if (c
>= 'A' && c
<= 'Z')
1661 digit
= c
- 'A' + 10;
1668 if (digit
< 0 || digit
>= radix
)
1671 number
= radix
* number
+ digit
;
1677 if (ndigits
== 0 || invalid_p
)
1680 sprintf (buf
, "integer, radix %d", radix
);
1681 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1684 return make_number (sign
* number
);
1688 /* If the next token is ')' or ']' or '.', we store that character
1689 in *PCH and the return value is not interesting. Else, we store
1690 zero in *PCH and we read and return one lisp object.
1692 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1695 read1 (readcharfun
, pch
, first_in_list
)
1696 register Lisp_Object readcharfun
;
1701 int uninterned_symbol
= 0;
1709 end_of_file_error ();
1714 return read_list (0, readcharfun
);
1717 return read_vector (readcharfun
, 0);
1734 tmp
= read_vector (readcharfun
, 0);
1735 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1736 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1737 error ("Invalid size char-table");
1738 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1739 XCHAR_TABLE (tmp
)->top
= Qt
;
1748 tmp
= read_vector (readcharfun
, 0);
1749 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1750 error ("Invalid size char-table");
1751 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1752 XCHAR_TABLE (tmp
)->top
= Qnil
;
1755 Fsignal (Qinvalid_read_syntax
,
1756 Fcons (make_string ("#^^", 3), Qnil
));
1758 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1763 length
= read1 (readcharfun
, pch
, first_in_list
);
1767 Lisp_Object tmp
, val
;
1768 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1772 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1773 if (size_in_chars
!= XSTRING (tmp
)->size
1774 /* We used to print 1 char too many
1775 when the number of bits was a multiple of 8.
1776 Accept such input in case it came from an old version. */
1777 && ! (XFASTINT (length
)
1778 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1779 Fsignal (Qinvalid_read_syntax
,
1780 Fcons (make_string ("#&...", 5), Qnil
));
1782 val
= Fmake_bool_vector (length
, Qnil
);
1783 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1785 /* Clear the extraneous bits in the last byte. */
1786 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1787 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1788 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1791 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1796 /* Accept compiled functions at read-time so that we don't have to
1797 build them using function calls. */
1799 tmp
= read_vector (readcharfun
, 1);
1800 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1801 XVECTOR (tmp
)->contents
);
1806 struct gcpro gcpro1
;
1809 /* Read the string itself. */
1810 tmp
= read1 (readcharfun
, &ch
, 0);
1811 if (ch
!= 0 || !STRINGP (tmp
))
1812 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1814 /* Read the intervals and their properties. */
1817 Lisp_Object beg
, end
, plist
;
1819 beg
= read1 (readcharfun
, &ch
, 0);
1823 end
= read1 (readcharfun
, &ch
, 0);
1825 plist
= read1 (readcharfun
, &ch
, 0);
1827 Fsignal (Qinvalid_read_syntax
,
1828 Fcons (build_string ("invalid string property list"),
1830 Fset_text_properties (beg
, end
, plist
, tmp
);
1836 /* #@NUMBER is used to skip NUMBER following characters.
1837 That's used in .elc files to skip over doc strings
1838 and function definitions. */
1843 /* Read a decimal integer. */
1844 while ((c
= READCHAR
) >= 0
1845 && c
>= '0' && c
<= '9')
1853 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1855 /* If we are supposed to force doc strings into core right now,
1856 record the last string that we skipped,
1857 and record where in the file it comes from. */
1859 /* But first exchange saved_doc_string
1860 with prev_saved_doc_string, so we save two strings. */
1862 char *temp
= saved_doc_string
;
1863 int temp_size
= saved_doc_string_size
;
1864 file_offset temp_pos
= saved_doc_string_position
;
1865 int temp_len
= saved_doc_string_length
;
1867 saved_doc_string
= prev_saved_doc_string
;
1868 saved_doc_string_size
= prev_saved_doc_string_size
;
1869 saved_doc_string_position
= prev_saved_doc_string_position
;
1870 saved_doc_string_length
= prev_saved_doc_string_length
;
1872 prev_saved_doc_string
= temp
;
1873 prev_saved_doc_string_size
= temp_size
;
1874 prev_saved_doc_string_position
= temp_pos
;
1875 prev_saved_doc_string_length
= temp_len
;
1878 if (saved_doc_string_size
== 0)
1880 saved_doc_string_size
= nskip
+ 100;
1881 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1883 if (nskip
> saved_doc_string_size
)
1885 saved_doc_string_size
= nskip
+ 100;
1886 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1887 saved_doc_string_size
);
1890 saved_doc_string_position
= file_tell (instream
);
1892 /* Copy that many characters into saved_doc_string. */
1893 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1894 saved_doc_string
[i
] = c
= READCHAR
;
1896 saved_doc_string_length
= i
;
1900 /* Skip that many characters. */
1901 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1908 return Vload_file_name
;
1910 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1911 /* #:foo is the uninterned symbol named foo. */
1914 uninterned_symbol
= 1;
1918 /* Reader forms that can reuse previously read objects. */
1919 if (c
>= '0' && c
<= '9')
1924 /* Read a non-negative integer. */
1925 while (c
>= '0' && c
<= '9')
1931 /* #n=object returns object, but associates it with n for #n#. */
1934 /* Make a placeholder for #n# to use temporarily */
1935 Lisp_Object placeholder
;
1938 placeholder
= Fcons(Qnil
, Qnil
);
1939 cell
= Fcons (make_number (n
), placeholder
);
1940 read_objects
= Fcons (cell
, read_objects
);
1942 /* Read the object itself. */
1943 tem
= read0 (readcharfun
);
1945 /* Now put it everywhere the placeholder was... */
1946 substitute_object_in_subtree (tem
, placeholder
);
1948 /* ...and #n# will use the real value from now on. */
1949 Fsetcdr (cell
, tem
);
1953 /* #n# returns a previously read object. */
1956 tem
= Fassq (make_number (n
), read_objects
);
1959 /* Fall through to error message. */
1961 else if (c
== 'r' || c
== 'R')
1962 return read_integer (readcharfun
, n
);
1964 /* Fall through to error message. */
1966 else if (c
== 'x' || c
== 'X')
1967 return read_integer (readcharfun
, 16);
1968 else if (c
== 'o' || c
== 'O')
1969 return read_integer (readcharfun
, 8);
1970 else if (c
== 'b' || c
== 'B')
1971 return read_integer (readcharfun
, 2);
1974 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1977 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1982 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1992 new_backquote_flag
= 1;
1993 value
= read0 (readcharfun
);
1994 new_backquote_flag
= 0;
1996 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2000 if (new_backquote_flag
)
2002 Lisp_Object comma_type
= Qnil
;
2007 comma_type
= Qcomma_at
;
2009 comma_type
= Qcomma_dot
;
2012 if (ch
>= 0) UNREAD (ch
);
2013 comma_type
= Qcomma
;
2016 new_backquote_flag
= 0;
2017 value
= read0 (readcharfun
);
2018 new_backquote_flag
= 1;
2019 return Fcons (comma_type
, Fcons (value
, Qnil
));
2028 end_of_file_error ();
2031 c
= read_escape (readcharfun
, 0);
2032 else if (BASE_LEADING_CODE_P (c
))
2033 c
= read_multibyte (c
, readcharfun
);
2035 return make_number (c
);
2040 register char *p
= read_buffer
;
2041 register char *end
= read_buffer
+ read_buffer_size
;
2043 /* Nonzero if we saw an escape sequence specifying
2044 a multibyte character. */
2045 int force_multibyte
= 0;
2046 /* Nonzero if we saw an escape sequence specifying
2047 a single-byte character. */
2048 int force_singlebyte
= 0;
2052 while ((c
= READCHAR
) >= 0
2055 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2057 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2058 p
+= new - read_buffer
;
2059 read_buffer
+= new - read_buffer
;
2060 end
= read_buffer
+ read_buffer_size
;
2065 c
= read_escape (readcharfun
, 1);
2067 /* C is -1 if \ newline has just been seen */
2070 if (p
== read_buffer
)
2075 /* If an escape specifies a non-ASCII single-byte character,
2076 this must be a unibyte string. */
2077 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
))
2078 && ! ASCII_BYTE_P ((c
& ~CHAR_MODIFIER_MASK
)))
2079 force_singlebyte
= 1;
2082 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
2084 /* Any modifiers for a multibyte character are invalid. */
2085 if (c
& CHAR_MODIFIER_MASK
)
2086 error ("Invalid modifier in string");
2087 p
+= CHAR_STRING (c
, p
);
2088 force_multibyte
= 1;
2092 /* Allow `\C- ' and `\C-?'. */
2093 if (c
== (CHAR_CTL
| ' '))
2095 else if (c
== (CHAR_CTL
| '?'))
2100 /* Shift modifier is valid only with [A-Za-z]. */
2101 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2103 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2104 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2108 /* Move the meta bit to the right place for a string. */
2109 c
= (c
& ~CHAR_META
) | 0x80;
2111 error ("Invalid modifier in string");
2116 end_of_file_error ();
2118 /* If purifying, and string starts with \ newline,
2119 return zero instead. This is for doc strings
2120 that we are really going to find in etc/DOC.nn.nn */
2121 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2122 return make_number (0);
2124 if (force_multibyte
)
2125 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2126 p
- read_buffer
, &nchars
);
2127 else if (force_singlebyte
)
2128 nchars
= p
- read_buffer
;
2129 else if (load_convert_to_unibyte
)
2132 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2133 p
- read_buffer
, &nchars
);
2134 if (p
- read_buffer
!= nchars
)
2136 string
= make_multibyte_string (read_buffer
, nchars
,
2138 return Fstring_make_unibyte (string
);
2141 else if (EQ (readcharfun
, Qget_file_char
)
2142 || EQ (readcharfun
, Qlambda
))
2143 /* Nowadays, reading directly from a file is used only for
2144 compiled Emacs Lisp files, and those always use the
2145 Emacs internal encoding. Meanwhile, Qlambda is used
2146 for reading dynamic byte code (compiled with
2147 byte-compile-dynamic = t). */
2148 p
= read_buffer
+ str_as_multibyte (read_buffer
, end
- read_buffer
,
2149 p
- read_buffer
, &nchars
);
2151 /* In all other cases, if we read these bytes as
2152 separate characters, treat them as separate characters now. */
2153 nchars
= p
- read_buffer
;
2156 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2158 || (p
- read_buffer
!= nchars
)));
2159 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2161 || (p
- read_buffer
!= nchars
)));
2166 int next_char
= READCHAR
;
2169 if (next_char
<= 040
2170 || index ("\"'`,(", next_char
))
2176 /* Otherwise, we fall through! Note that the atom-reading loop
2177 below will now loop at least once, assuring that we will not
2178 try to UNREAD two characters in a row. */
2182 if (c
<= 040) goto retry
;
2184 register char *p
= read_buffer
;
2188 register char *end
= read_buffer
+ read_buffer_size
;
2191 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
2192 || c
== '(' || c
== ')'
2193 || c
== '[' || c
== ']' || c
== '#'
2196 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2198 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2199 p
+= new - read_buffer
;
2200 read_buffer
+= new - read_buffer
;
2201 end
= read_buffer
+ read_buffer_size
;
2209 if (! SINGLE_BYTE_CHAR_P (c
))
2210 p
+= CHAR_STRING (c
, p
);
2219 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2220 p
+= new - read_buffer
;
2221 read_buffer
+= new - read_buffer
;
2222 /* end = read_buffer + read_buffer_size; */
2229 if (!quoted
&& !uninterned_symbol
)
2232 register Lisp_Object val
;
2234 if (*p1
== '+' || *p1
== '-') p1
++;
2235 /* Is it an integer? */
2238 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2239 /* Integers can have trailing decimal points. */
2240 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2242 /* It is an integer. */
2246 if (sizeof (int) == sizeof (EMACS_INT
))
2247 XSETINT (val
, atoi (read_buffer
));
2248 else if (sizeof (long) == sizeof (EMACS_INT
))
2249 XSETINT (val
, atol (read_buffer
));
2255 if (isfloat_string (read_buffer
))
2257 /* Compute NaN and infinities using 0.0 in a variable,
2258 to cope with compilers that think they are smarter
2264 /* Negate the value ourselves. This treats 0, NaNs,
2265 and infinity properly on IEEE floating point hosts,
2266 and works around a common bug where atof ("-0.0")
2268 int negative
= read_buffer
[0] == '-';
2270 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2271 returns 1, is if the input ends in e+INF or e+NaN. */
2278 value
= zero
/ zero
;
2281 value
= atof (read_buffer
+ negative
);
2285 return make_float (negative
? - value
: value
);
2289 if (uninterned_symbol
)
2290 return make_symbol (read_buffer
);
2292 return intern (read_buffer
);
2298 /* List of nodes we've seen during substitute_object_in_subtree. */
2299 static Lisp_Object seen_list
;
2302 substitute_object_in_subtree (object
, placeholder
)
2304 Lisp_Object placeholder
;
2306 Lisp_Object check_object
;
2308 /* We haven't seen any objects when we start. */
2311 /* Make all the substitutions. */
2313 = substitute_object_recurse (object
, placeholder
, object
);
2315 /* Clear seen_list because we're done with it. */
2318 /* The returned object here is expected to always eq the
2320 if (!EQ (check_object
, object
))
2321 error ("Unexpected mutation error in reader");
2324 /* Feval doesn't get called from here, so no gc protection is needed. */
2325 #define SUBSTITUTE(get_val, set_val) \
2327 Lisp_Object old_value = get_val; \
2328 Lisp_Object true_value \
2329 = substitute_object_recurse (object, placeholder,\
2332 if (!EQ (old_value, true_value)) \
2339 substitute_object_recurse (object
, placeholder
, subtree
)
2341 Lisp_Object placeholder
;
2342 Lisp_Object subtree
;
2344 /* If we find the placeholder, return the target object. */
2345 if (EQ (placeholder
, subtree
))
2348 /* If we've been to this node before, don't explore it again. */
2349 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2352 /* If this node can be the entry point to a cycle, remember that
2353 we've seen it. It can only be such an entry point if it was made
2354 by #n=, which means that we can find it as a value in
2356 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2357 seen_list
= Fcons (subtree
, seen_list
);
2359 /* Recurse according to subtree's type.
2360 Every branch must return a Lisp_Object. */
2361 switch (XTYPE (subtree
))
2363 case Lisp_Vectorlike
:
2366 int length
= XINT (Flength(subtree
));
2367 for (i
= 0; i
< length
; i
++)
2369 Lisp_Object idx
= make_number (i
);
2370 SUBSTITUTE (Faref (subtree
, idx
),
2371 Faset (subtree
, idx
, true_value
));
2378 SUBSTITUTE (Fcar_safe (subtree
),
2379 Fsetcar (subtree
, true_value
));
2380 SUBSTITUTE (Fcdr_safe (subtree
),
2381 Fsetcdr (subtree
, true_value
));
2387 /* Check for text properties in each interval.
2388 substitute_in_interval contains part of the logic. */
2390 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2391 Lisp_Object arg
= Fcons (object
, placeholder
);
2393 traverse_intervals (root_interval
, 1, 0,
2394 &substitute_in_interval
, arg
);
2399 /* Other types don't recurse any further. */
2405 /* Helper function for substitute_object_recurse. */
2407 substitute_in_interval (interval
, arg
)
2411 Lisp_Object object
= Fcar (arg
);
2412 Lisp_Object placeholder
= Fcdr (arg
);
2414 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2433 if (*cp
== '+' || *cp
== '-')
2436 if (*cp
>= '0' && *cp
<= '9')
2439 while (*cp
>= '0' && *cp
<= '9')
2447 if (*cp
>= '0' && *cp
<= '9')
2450 while (*cp
>= '0' && *cp
<= '9')
2453 if (*cp
== 'e' || *cp
== 'E')
2457 if (*cp
== '+' || *cp
== '-')
2461 if (*cp
>= '0' && *cp
<= '9')
2464 while (*cp
>= '0' && *cp
<= '9')
2467 else if (cp
== start
)
2469 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2474 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2480 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2481 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2482 || state
== (DOT_CHAR
|TRAIL_INT
)
2483 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2484 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2485 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2490 read_vector (readcharfun
, bytecodeflag
)
2491 Lisp_Object readcharfun
;
2496 register Lisp_Object
*ptr
;
2497 register Lisp_Object tem
, item
, vector
;
2498 register struct Lisp_Cons
*otem
;
2501 tem
= read_list (1, readcharfun
);
2502 len
= Flength (tem
);
2503 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2505 size
= XVECTOR (vector
)->size
;
2506 ptr
= XVECTOR (vector
)->contents
;
2507 for (i
= 0; i
< size
; i
++)
2510 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2511 bytecode object, the docstring containing the bytecode and
2512 constants values must be treated as unibyte and passed to
2513 Fread, to get the actual bytecode string and constants vector. */
2514 if (bytecodeflag
&& load_force_doc_strings
)
2516 if (i
== COMPILED_BYTECODE
)
2518 if (!STRINGP (item
))
2519 error ("invalid byte code");
2521 /* Delay handling the bytecode slot until we know whether
2522 it is lazily-loaded (we can tell by whether the
2523 constants slot is nil). */
2524 ptr
[COMPILED_CONSTANTS
] = item
;
2527 else if (i
== COMPILED_CONSTANTS
)
2529 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2533 /* Coerce string to unibyte (like string-as-unibyte,
2534 but without generating extra garbage and
2535 guaranteeing no change in the contents). */
2536 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2537 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2539 item
= Fread (bytestr
);
2541 error ("invalid byte code");
2543 otem
= XCONS (item
);
2544 bytestr
= XCAR (item
);
2549 /* Now handle the bytecode slot. */
2550 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2553 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2561 /* FLAG = 1 means check for ] to terminate rather than ) and .
2562 FLAG = -1 means check for starting with defun
2563 and make structure pure. */
2566 read_list (flag
, readcharfun
)
2568 register Lisp_Object readcharfun
;
2570 /* -1 means check next element for defun,
2571 0 means don't check,
2572 1 means already checked and found defun. */
2573 int defunflag
= flag
< 0 ? -1 : 0;
2574 Lisp_Object val
, tail
;
2575 register Lisp_Object elt
, tem
;
2576 struct gcpro gcpro1
, gcpro2
;
2577 /* 0 is the normal case.
2578 1 means this list is a doc reference; replace it with the number 0.
2579 2 means this list is a doc reference; replace it with the doc string. */
2580 int doc_reference
= 0;
2582 /* Initialize this to 1 if we are reading a list. */
2583 int first_in_list
= flag
<= 0;
2592 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2597 /* While building, if the list starts with #$, treat it specially. */
2598 if (EQ (elt
, Vload_file_name
)
2600 && !NILP (Vpurify_flag
))
2602 if (NILP (Vdoc_file_name
))
2603 /* We have not yet called Snarf-documentation, so assume
2604 this file is described in the DOC-MM.NN file
2605 and Snarf-documentation will fill in the right value later.
2606 For now, replace the whole list with 0. */
2609 /* We have already called Snarf-documentation, so make a relative
2610 file name for this file, so it can be found properly
2611 in the installed Lisp directory.
2612 We don't use Fexpand_file_name because that would make
2613 the directory absolute now. */
2614 elt
= concat2 (build_string ("../lisp/"),
2615 Ffile_name_nondirectory (elt
));
2617 else if (EQ (elt
, Vload_file_name
)
2619 && load_force_doc_strings
)
2628 Fsignal (Qinvalid_read_syntax
,
2629 Fcons (make_string (") or . in a vector", 18), Qnil
));
2637 XCDR (tail
) = read0 (readcharfun
);
2639 val
= read0 (readcharfun
);
2640 read1 (readcharfun
, &ch
, 0);
2644 if (doc_reference
== 1)
2645 return make_number (0);
2646 if (doc_reference
== 2)
2648 /* Get a doc string from the file we are loading.
2649 If it's in saved_doc_string, get it from there. */
2650 int pos
= XINT (XCDR (val
));
2651 /* Position is negative for user variables. */
2652 if (pos
< 0) pos
= -pos
;
2653 if (pos
>= saved_doc_string_position
2654 && pos
< (saved_doc_string_position
2655 + saved_doc_string_length
))
2657 int start
= pos
- saved_doc_string_position
;
2660 /* Process quoting with ^A,
2661 and find the end of the string,
2662 which is marked with ^_ (037). */
2663 for (from
= start
, to
= start
;
2664 saved_doc_string
[from
] != 037;)
2666 int c
= saved_doc_string
[from
++];
2669 c
= saved_doc_string
[from
++];
2671 saved_doc_string
[to
++] = c
;
2673 saved_doc_string
[to
++] = 0;
2675 saved_doc_string
[to
++] = 037;
2678 saved_doc_string
[to
++] = c
;
2681 return make_string (saved_doc_string
+ start
,
2684 /* Look in prev_saved_doc_string the same way. */
2685 else if (pos
>= prev_saved_doc_string_position
2686 && pos
< (prev_saved_doc_string_position
2687 + prev_saved_doc_string_length
))
2689 int start
= pos
- prev_saved_doc_string_position
;
2692 /* Process quoting with ^A,
2693 and find the end of the string,
2694 which is marked with ^_ (037). */
2695 for (from
= start
, to
= start
;
2696 prev_saved_doc_string
[from
] != 037;)
2698 int c
= prev_saved_doc_string
[from
++];
2701 c
= prev_saved_doc_string
[from
++];
2703 prev_saved_doc_string
[to
++] = c
;
2705 prev_saved_doc_string
[to
++] = 0;
2707 prev_saved_doc_string
[to
++] = 037;
2710 prev_saved_doc_string
[to
++] = c
;
2713 return make_string (prev_saved_doc_string
+ start
,
2717 return get_doc_string (val
, 0, 0);
2722 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2724 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2726 tem
= (read_pure
&& flag
<= 0
2727 ? pure_cons (elt
, Qnil
)
2728 : Fcons (elt
, Qnil
));
2735 defunflag
= EQ (elt
, Qdefun
);
2736 else if (defunflag
> 0)
2741 Lisp_Object Vobarray
;
2742 Lisp_Object initial_obarray
;
2744 /* oblookup stores the bucket number here, for the sake of Funintern. */
2746 int oblookup_last_bucket_number
;
2748 static int hash_string ();
2749 Lisp_Object
oblookup ();
2751 /* Get an error if OBARRAY is not an obarray.
2752 If it is one, return it. */
2755 check_obarray (obarray
)
2756 Lisp_Object obarray
;
2758 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2760 /* If Vobarray is now invalid, force it to be valid. */
2761 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2763 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2768 /* Intern the C string STR: return a symbol with that name,
2769 interned in the current obarray. */
2776 int len
= strlen (str
);
2777 Lisp_Object obarray
;
2780 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2781 obarray
= check_obarray (obarray
);
2782 tem
= oblookup (obarray
, str
, len
, len
);
2785 return Fintern (make_string (str
, len
), obarray
);
2788 /* Create an uninterned symbol with name STR. */
2794 int len
= strlen (str
);
2796 return Fmake_symbol ((!NILP (Vpurify_flag
)
2797 ? make_pure_string (str
, len
, len
, 0)
2798 : make_string (str
, len
)));
2801 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2802 "Return the canonical symbol whose name is STRING.\n\
2803 If there is none, one is created by this function and returned.\n\
2804 A second optional argument specifies the obarray to use;\n\
2805 it defaults to the value of `obarray'.")
2807 Lisp_Object string
, obarray
;
2809 register Lisp_Object tem
, sym
, *ptr
;
2811 if (NILP (obarray
)) obarray
= Vobarray
;
2812 obarray
= check_obarray (obarray
);
2814 CHECK_STRING (string
, 0);
2816 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2817 XSTRING (string
)->size
,
2818 STRING_BYTES (XSTRING (string
)));
2819 if (!INTEGERP (tem
))
2822 if (!NILP (Vpurify_flag
))
2823 string
= Fpurecopy (string
);
2824 sym
= Fmake_symbol (string
);
2825 XSYMBOL (sym
)->obarray
= obarray
;
2827 if ((XSTRING (string
)->data
[0] == ':')
2828 && EQ (obarray
, initial_obarray
))
2829 XSYMBOL (sym
)->value
= sym
;
2831 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2833 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2835 XSYMBOL (sym
)->next
= 0;
2840 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2841 "Return the canonical symbol named NAME, or nil if none exists.\n\
2842 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2843 symbol is searched for.\n\
2844 A second optional argument specifies the obarray to use;\n\
2845 it defaults to the value of `obarray'.")
2847 Lisp_Object name
, obarray
;
2849 register Lisp_Object tem
;
2850 struct Lisp_String
*string
;
2852 if (NILP (obarray
)) obarray
= Vobarray
;
2853 obarray
= check_obarray (obarray
);
2855 if (!SYMBOLP (name
))
2857 CHECK_STRING (name
, 0);
2858 string
= XSTRING (name
);
2861 string
= XSYMBOL (name
)->name
;
2863 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2864 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2870 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2871 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2872 The value is t if a symbol was found and deleted, nil otherwise.\n\
2873 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2874 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2875 OBARRAY defaults to the value of the variable `obarray'.")
2877 Lisp_Object name
, obarray
;
2879 register Lisp_Object string
, tem
;
2882 if (NILP (obarray
)) obarray
= Vobarray
;
2883 obarray
= check_obarray (obarray
);
2886 XSETSTRING (string
, XSYMBOL (name
)->name
);
2889 CHECK_STRING (name
, 0);
2893 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2894 XSTRING (string
)->size
,
2895 STRING_BYTES (XSTRING (string
)));
2898 /* If arg was a symbol, don't delete anything but that symbol itself. */
2899 if (SYMBOLP (name
) && !EQ (name
, tem
))
2902 XSYMBOL (tem
)->obarray
= Qnil
;
2904 hash
= oblookup_last_bucket_number
;
2906 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2908 if (XSYMBOL (tem
)->next
)
2909 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2911 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2915 Lisp_Object tail
, following
;
2917 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2918 XSYMBOL (tail
)->next
;
2921 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2922 if (EQ (following
, tem
))
2924 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2933 /* Return the symbol in OBARRAY whose names matches the string
2934 of SIZE characters (SIZE_BYTE bytes) at PTR.
2935 If there is no such symbol in OBARRAY, return nil.
2937 Also store the bucket number in oblookup_last_bucket_number. */
2940 oblookup (obarray
, ptr
, size
, size_byte
)
2941 Lisp_Object obarray
;
2943 int size
, size_byte
;
2947 register Lisp_Object tail
;
2948 Lisp_Object bucket
, tem
;
2950 if (!VECTORP (obarray
)
2951 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2953 obarray
= check_obarray (obarray
);
2954 obsize
= XVECTOR (obarray
)->size
;
2956 /* This is sometimes needed in the middle of GC. */
2957 obsize
&= ~ARRAY_MARK_FLAG
;
2958 /* Combining next two lines breaks VMS C 2.3. */
2959 hash
= hash_string (ptr
, size_byte
);
2961 bucket
= XVECTOR (obarray
)->contents
[hash
];
2962 oblookup_last_bucket_number
= hash
;
2963 if (XFASTINT (bucket
) == 0)
2965 else if (!SYMBOLP (bucket
))
2966 error ("Bad data in guts of obarray"); /* Like CADR error message */
2968 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2970 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2971 && XSYMBOL (tail
)->name
->size
== size
2972 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2974 else if (XSYMBOL (tail
)->next
== 0)
2977 XSETINT (tem
, hash
);
2982 hash_string (ptr
, len
)
2986 register unsigned char *p
= ptr
;
2987 register unsigned char *end
= p
+ len
;
2988 register unsigned char c
;
2989 register int hash
= 0;
2994 if (c
>= 0140) c
-= 40;
2995 hash
= ((hash
<<3) + (hash
>>28) + c
);
2997 return hash
& 07777777777;
3001 map_obarray (obarray
, fn
, arg
)
3002 Lisp_Object obarray
;
3003 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3007 register Lisp_Object tail
;
3008 CHECK_VECTOR (obarray
, 1);
3009 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3011 tail
= XVECTOR (obarray
)->contents
[i
];
3016 if (XSYMBOL (tail
)->next
== 0)
3018 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3024 mapatoms_1 (sym
, function
)
3025 Lisp_Object sym
, function
;
3027 call1 (function
, sym
);
3030 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3031 "Call FUNCTION on every symbol in OBARRAY.\n\
3032 OBARRAY defaults to the value of `obarray'.")
3034 Lisp_Object function
, obarray
;
3036 if (NILP (obarray
)) obarray
= Vobarray
;
3037 obarray
= check_obarray (obarray
);
3039 map_obarray (obarray
, mapatoms_1
, function
);
3043 #define OBARRAY_SIZE 1511
3048 Lisp_Object oblength
;
3052 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3054 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3055 Vobarray
= Fmake_vector (oblength
, make_number (0));
3056 initial_obarray
= Vobarray
;
3057 staticpro (&initial_obarray
);
3058 /* Intern nil in the obarray */
3059 XSYMBOL (Qnil
)->obarray
= Vobarray
;
3060 /* These locals are to kludge around a pyramid compiler bug. */
3061 hash
= hash_string ("nil", 3);
3062 /* Separate statement here to avoid VAXC bug. */
3063 hash
%= OBARRAY_SIZE
;
3064 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3067 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3068 XSYMBOL (Qnil
)->function
= Qunbound
;
3069 XSYMBOL (Qunbound
)->value
= Qunbound
;
3070 XSYMBOL (Qunbound
)->function
= Qunbound
;
3073 XSYMBOL (Qnil
)->value
= Qnil
;
3074 XSYMBOL (Qnil
)->plist
= Qnil
;
3075 XSYMBOL (Qt
)->value
= Qt
;
3077 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3080 Qvariable_documentation
= intern ("variable-documentation");
3081 staticpro (&Qvariable_documentation
);
3083 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3084 read_buffer
= (char *) xmalloc (read_buffer_size
);
3089 struct Lisp_Subr
*sname
;
3092 sym
= intern (sname
->symbol_name
);
3093 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3096 #ifdef NOTDEF /* use fset in subr.el now */
3098 defalias (sname
, string
)
3099 struct Lisp_Subr
*sname
;
3103 sym
= intern (string
);
3104 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3108 /* Define an "integer variable"; a symbol whose value is forwarded
3109 to a C variable of type int. Sample call: */
3110 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3112 defvar_int (namestring
, address
)
3116 Lisp_Object sym
, val
;
3117 sym
= intern (namestring
);
3118 val
= allocate_misc ();
3119 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3120 XINTFWD (val
)->intvar
= address
;
3121 XSYMBOL (sym
)->value
= val
;
3124 /* Similar but define a variable whose value is T if address contains 1,
3125 NIL if address contains 0 */
3127 defvar_bool (namestring
, address
)
3131 Lisp_Object sym
, val
;
3132 sym
= intern (namestring
);
3133 val
= allocate_misc ();
3134 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3135 XBOOLFWD (val
)->boolvar
= address
;
3136 XSYMBOL (sym
)->value
= val
;
3137 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3140 /* Similar but define a variable whose value is the Lisp Object stored
3141 at address. Two versions: with and without gc-marking of the C
3142 variable. The nopro version is used when that variable will be
3143 gc-marked for some other reason, since marking the same slot twice
3144 can cause trouble with strings. */
3146 defvar_lisp_nopro (namestring
, address
)
3148 Lisp_Object
*address
;
3150 Lisp_Object sym
, val
;
3151 sym
= intern (namestring
);
3152 val
= allocate_misc ();
3153 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3154 XOBJFWD (val
)->objvar
= address
;
3155 XSYMBOL (sym
)->value
= val
;
3159 defvar_lisp (namestring
, address
)
3161 Lisp_Object
*address
;
3163 defvar_lisp_nopro (namestring
, address
);
3164 staticpro (address
);
3167 /* Similar but define a variable whose value is the Lisp Object stored in
3168 the current buffer. address is the address of the slot in the buffer
3169 that is current now. */
3172 defvar_per_buffer (namestring
, address
, type
, doc
)
3174 Lisp_Object
*address
;
3178 Lisp_Object sym
, val
;
3180 extern struct buffer buffer_local_symbols
;
3182 sym
= intern (namestring
);
3183 val
= allocate_misc ();
3184 offset
= (char *)address
- (char *)current_buffer
;
3186 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3187 XBUFFER_OBJFWD (val
)->offset
= offset
;
3188 XSYMBOL (sym
)->value
= val
;
3189 PER_BUFFER_SYMBOL (offset
) = sym
;
3190 PER_BUFFER_TYPE (offset
) = type
;
3192 if (PER_BUFFER_IDX (offset
) == 0)
3193 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3194 slot of buffer_local_flags */
3199 /* Similar but define a variable whose value is the Lisp Object stored
3200 at a particular offset in the current kboard object. */
3203 defvar_kboard (namestring
, offset
)
3207 Lisp_Object sym
, val
;
3208 sym
= intern (namestring
);
3209 val
= allocate_misc ();
3210 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3211 XKBOARD_OBJFWD (val
)->offset
= offset
;
3212 XSYMBOL (sym
)->value
= val
;
3215 /* Record the value of load-path used at the start of dumping
3216 so we can see if the site changed it later during dumping. */
3217 static Lisp_Object dump_path
;
3223 int turn_off_warning
= 0;
3225 /* Compute the default load-path. */
3227 normal
= PATH_LOADSEARCH
;
3228 Vload_path
= decode_env_path (0, normal
);
3230 if (NILP (Vpurify_flag
))
3231 normal
= PATH_LOADSEARCH
;
3233 normal
= PATH_DUMPLOADSEARCH
;
3235 /* In a dumped Emacs, we normally have to reset the value of
3236 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3237 uses ../lisp, instead of the path of the installed elisp
3238 libraries. However, if it appears that Vload_path was changed
3239 from the default before dumping, don't override that value. */
3242 if (! NILP (Fequal (dump_path
, Vload_path
)))
3244 Vload_path
= decode_env_path (0, normal
);
3245 if (!NILP (Vinstallation_directory
))
3247 /* Add to the path the lisp subdir of the
3248 installation dir, if it exists. */
3249 Lisp_Object tem
, tem1
;
3250 tem
= Fexpand_file_name (build_string ("lisp"),
3251 Vinstallation_directory
);
3252 tem1
= Ffile_exists_p (tem
);
3255 if (NILP (Fmember (tem
, Vload_path
)))
3257 turn_off_warning
= 1;
3258 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3262 /* That dir doesn't exist, so add the build-time
3263 Lisp dirs instead. */
3264 Vload_path
= nconc2 (Vload_path
, dump_path
);
3266 /* Add leim under the installation dir, if it exists. */
3267 tem
= Fexpand_file_name (build_string ("leim"),
3268 Vinstallation_directory
);
3269 tem1
= Ffile_exists_p (tem
);
3272 if (NILP (Fmember (tem
, Vload_path
)))
3273 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3276 /* Add site-list under the installation dir, if it exists. */
3277 tem
= Fexpand_file_name (build_string ("site-lisp"),
3278 Vinstallation_directory
);
3279 tem1
= Ffile_exists_p (tem
);
3282 if (NILP (Fmember (tem
, Vload_path
)))
3283 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3286 /* If Emacs was not built in the source directory,
3287 and it is run from where it was built, add to load-path
3288 the lisp, leim and site-lisp dirs under that directory. */
3290 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3294 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3295 Vinstallation_directory
);
3296 tem1
= Ffile_exists_p (tem
);
3298 /* Don't be fooled if they moved the entire source tree
3299 AFTER dumping Emacs. If the build directory is indeed
3300 different from the source dir, src/Makefile.in and
3301 src/Makefile will not be found together. */
3302 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3303 Vinstallation_directory
);
3304 tem2
= Ffile_exists_p (tem
);
3305 if (!NILP (tem1
) && NILP (tem2
))
3307 tem
= Fexpand_file_name (build_string ("lisp"),
3310 if (NILP (Fmember (tem
, Vload_path
)))
3311 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3313 tem
= Fexpand_file_name (build_string ("leim"),
3316 if (NILP (Fmember (tem
, Vload_path
)))
3317 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3319 tem
= Fexpand_file_name (build_string ("site-lisp"),
3322 if (NILP (Fmember (tem
, Vload_path
)))
3323 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3331 /* NORMAL refers to the lisp dir in the source directory. */
3332 /* We used to add ../lisp at the front here, but
3333 that caused trouble because it was copied from dump_path
3334 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3335 It should be unnecessary. */
3336 Vload_path
= decode_env_path (0, normal
);
3337 dump_path
= Vload_path
;
3342 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3343 almost never correct, thereby causing a warning to be printed out that
3344 confuses users. Since PATH_LOADSEARCH is always overridden by the
3345 EMACSLOADPATH environment variable below, disable the warning on NT. */
3347 /* Warn if dirs in the *standard* path don't exist. */
3348 if (!turn_off_warning
)
3350 Lisp_Object path_tail
;
3352 for (path_tail
= Vload_path
;
3354 path_tail
= XCDR (path_tail
))
3356 Lisp_Object dirfile
;
3357 dirfile
= Fcar (path_tail
);
3358 if (STRINGP (dirfile
))
3360 dirfile
= Fdirectory_file_name (dirfile
);
3361 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3362 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3367 #endif /* WINDOWSNT */
3369 /* If the EMACSLOADPATH environment variable is set, use its value.
3370 This doesn't apply if we're dumping. */
3372 if (NILP (Vpurify_flag
)
3373 && egetenv ("EMACSLOADPATH"))
3375 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3379 load_in_progress
= 0;
3380 Vload_file_name
= Qnil
;
3382 load_descriptor_list
= Qnil
;
3384 Vstandard_input
= Qt
;
3387 /* Print a warning, using format string FORMAT, that directory DIRNAME
3388 does not exist. Print it on stderr and put it in *Message*. */
3391 dir_warning (format
, dirname
)
3393 Lisp_Object dirname
;
3396 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3398 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3399 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3400 /* Don't log the warning before we've initialized!! */
3402 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3409 defsubr (&Sread_from_string
);
3411 defsubr (&Sintern_soft
);
3412 defsubr (&Sunintern
);
3414 defsubr (&Seval_buffer
);
3415 defsubr (&Seval_region
);
3416 defsubr (&Sread_char
);
3417 defsubr (&Sread_char_exclusive
);
3418 defsubr (&Sread_event
);
3419 defsubr (&Sget_file_char
);
3420 defsubr (&Smapatoms
);
3422 DEFVAR_LISP ("obarray", &Vobarray
,
3423 "Symbol table for use by `intern' and `read'.\n\
3424 It is a vector whose length ought to be prime for best results.\n\
3425 The vector's contents don't make sense if examined from Lisp programs;\n\
3426 to find all the symbols in an obarray, use `mapatoms'.");
3428 DEFVAR_LISP ("values", &Vvalues
,
3429 "List of values of all expressions which were read, evaluated and printed.\n\
3430 Order is reverse chronological.");
3432 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3433 "Stream for read to get input from.\n\
3434 See documentation of `read' for possible values.");
3435 Vstandard_input
= Qt
;
3437 DEFVAR_LISP ("load-path", &Vload_path
,
3438 "*List of directories to search for files to load.\n\
3439 Each element is a string (directory name) or nil (try default directory).\n\
3440 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3441 otherwise to default specified by file `epaths.h' when Emacs was built.");
3443 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3444 "Non-nil iff inside of `load'.");
3446 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3447 "An alist of expressions to be evalled when particular files are loaded.\n\
3448 Each element looks like (FILENAME FORMS...).\n\
3449 When `load' is run and the file-name argument is FILENAME,\n\
3450 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3451 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3452 with no directory specified, since that is how `load' is normally called.\n\
3453 An error in FORMS does not undo the load,\n\
3454 but does prevent execution of the rest of the FORMS.");
3455 Vafter_load_alist
= Qnil
;
3457 DEFVAR_LISP ("load-history", &Vload_history
,
3458 "Alist mapping source file names to symbols and features.\n\
3459 Each alist element is a list that starts with a file name,\n\
3460 except for one element (optional) that starts with nil and describes\n\
3461 definitions evaluated from buffers not visiting files.\n\
3462 The remaining elements of each list are symbols defined as functions\n\
3463 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
3464 and `(autoload . SYMBOL)'.");
3465 Vload_history
= Qnil
;
3467 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3468 "Full name of file being loaded by `load'.");
3469 Vload_file_name
= Qnil
;
3471 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3472 "File name, including directory, of user's initialization file.\n\
3473 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3474 file, this variable contains the name of the .el file, suitable for use\n\
3475 by functions like `custom-save-all' which edit the init file.");
3476 Vuser_init_file
= Qnil
;
3478 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3479 "Used for internal purposes by `load'.");
3480 Vcurrent_load_list
= Qnil
;
3482 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3483 "Function used by `load' and `eval-region' for reading expressions.\n\
3484 The default is nil, which means use the function `read'.");
3485 Vload_read_function
= Qnil
;
3487 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3488 "Function called in `load' for loading an Emacs lisp source file.\n\
3489 This function is for doing code conversion before reading the source file.\n\
3490 If nil, loading is done without any code conversion.\n\
3491 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3492 FULLNAME is the full name of FILE.\n\
3493 See `load' for the meaning of the remaining arguments.");
3494 Vload_source_file_function
= Qnil
;
3496 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3497 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3498 This is useful when the file being loaded is a temporary copy.");
3499 load_force_doc_strings
= 0;
3501 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3502 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3503 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3504 and is not meant for users to change.");
3505 load_convert_to_unibyte
= 0;
3507 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3508 "Directory in which Emacs sources were found when Emacs was built.\n\
3509 You cannot count on them to still be there!");
3511 = Fexpand_file_name (build_string ("../"),
3512 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3514 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3515 "List of files that were preloaded (when dumping Emacs).");
3516 Vpreloaded_file_list
= Qnil
;
3518 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3519 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3520 Vbyte_boolean_vars
= Qnil
;
3522 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3523 "Non-nil means load dangerous compiled Lisp files.\n\
3524 Some versions of XEmacs use different byte codes than Emacs. These\n\
3525 incompatible byte codes can make Emacs crash when it tries to execute\n\
3527 load_dangerous_libraries
= 0;
3529 Vbytecomp_version_regexp
= build_string ("^;;;.in Emacs version");
3530 staticpro (&Vbytecomp_version_regexp
);
3532 /* Vsource_directory was initialized in init_lread. */
3534 load_descriptor_list
= Qnil
;
3535 staticpro (&load_descriptor_list
);
3537 Qcurrent_load_list
= intern ("current-load-list");
3538 staticpro (&Qcurrent_load_list
);
3540 Qstandard_input
= intern ("standard-input");
3541 staticpro (&Qstandard_input
);
3543 Qread_char
= intern ("read-char");
3544 staticpro (&Qread_char
);
3546 Qget_file_char
= intern ("get-file-char");
3547 staticpro (&Qget_file_char
);
3549 Qbackquote
= intern ("`");
3550 staticpro (&Qbackquote
);
3551 Qcomma
= intern (",");
3552 staticpro (&Qcomma
);
3553 Qcomma_at
= intern (",@");
3554 staticpro (&Qcomma_at
);
3555 Qcomma_dot
= intern (",.");
3556 staticpro (&Qcomma_dot
);
3558 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3559 staticpro (&Qinhibit_file_name_operation
);
3561 Qascii_character
= intern ("ascii-character");
3562 staticpro (&Qascii_character
);
3564 Qfunction
= intern ("function");
3565 staticpro (&Qfunction
);
3567 Qload
= intern ("load");
3570 Qload_file_name
= intern ("load-file-name");
3571 staticpro (&Qload_file_name
);
3573 staticpro (&dump_path
);
3575 staticpro (&read_objects
);
3576 read_objects
= Qnil
;
3577 staticpro (&seen_list
);