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 /* If a period is followed by a number, then we should read it
2139 as a floating point number. Otherwise, it denotes a dotted
2141 int next_char
= READCHAR
;
2144 if (! (next_char
>= '0' && next_char
<= '9'))
2150 /* Otherwise, we fall through! Note that the atom-reading loop
2151 below will now loop at least once, assuring that we will not
2152 try to UNREAD two characters in a row. */
2156 if (c
<= 040) goto retry
;
2158 register char *p
= read_buffer
;
2162 register char *end
= read_buffer
+ read_buffer_size
;
2165 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
2166 || c
== '(' || c
== ')'
2167 || c
== '[' || c
== ']' || c
== '#'
2170 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2172 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2173 p
+= new - read_buffer
;
2174 read_buffer
+= new - read_buffer
;
2175 end
= read_buffer
+ read_buffer_size
;
2183 if (! SINGLE_BYTE_CHAR_P (c
))
2184 p
+= CHAR_STRING (c
, p
);
2193 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2194 p
+= new - read_buffer
;
2195 read_buffer
+= new - read_buffer
;
2196 /* end = read_buffer + read_buffer_size; */
2203 if (!quoted
&& !uninterned_symbol
)
2206 register Lisp_Object val
;
2208 if (*p1
== '+' || *p1
== '-') p1
++;
2209 /* Is it an integer? */
2212 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2213 /* Integers can have trailing decimal points. */
2214 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2216 /* It is an integer. */
2220 if (sizeof (int) == sizeof (EMACS_INT
))
2221 XSETINT (val
, atoi (read_buffer
));
2222 else if (sizeof (long) == sizeof (EMACS_INT
))
2223 XSETINT (val
, atol (read_buffer
));
2229 if (isfloat_string (read_buffer
))
2231 /* Compute NaN and infinities using 0.0 in a variable,
2232 to cope with compilers that think they are smarter
2238 /* Negate the value ourselves. This treats 0, NaNs,
2239 and infinity properly on IEEE floating point hosts,
2240 and works around a common bug where atof ("-0.0")
2242 int negative
= read_buffer
[0] == '-';
2244 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2245 returns 1, is if the input ends in e+INF or e+NaN. */
2252 value
= zero
/ zero
;
2255 value
= atof (read_buffer
+ negative
);
2259 return make_float (negative
? - value
: value
);
2263 if (uninterned_symbol
)
2264 return make_symbol (read_buffer
);
2266 return intern (read_buffer
);
2272 /* List of nodes we've seen during substitute_object_in_subtree. */
2273 static Lisp_Object seen_list
;
2276 substitute_object_in_subtree (object
, placeholder
)
2278 Lisp_Object placeholder
;
2280 Lisp_Object check_object
;
2282 /* We haven't seen any objects when we start. */
2285 /* Make all the substitutions. */
2287 = substitute_object_recurse (object
, placeholder
, object
);
2289 /* Clear seen_list because we're done with it. */
2292 /* The returned object here is expected to always eq the
2294 if (!EQ (check_object
, object
))
2295 error ("Unexpected mutation error in reader");
2298 /* Feval doesn't get called from here, so no gc protection is needed. */
2299 #define SUBSTITUTE(get_val, set_val) \
2301 Lisp_Object old_value = get_val; \
2302 Lisp_Object true_value \
2303 = substitute_object_recurse (object, placeholder,\
2306 if (!EQ (old_value, true_value)) \
2313 substitute_object_recurse (object
, placeholder
, subtree
)
2315 Lisp_Object placeholder
;
2316 Lisp_Object subtree
;
2318 /* If we find the placeholder, return the target object. */
2319 if (EQ (placeholder
, subtree
))
2322 /* If we've been to this node before, don't explore it again. */
2323 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2326 /* If this node can be the entry point to a cycle, remember that
2327 we've seen it. It can only be such an entry point if it was made
2328 by #n=, which means that we can find it as a value in
2330 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2331 seen_list
= Fcons (subtree
, seen_list
);
2333 /* Recurse according to subtree's type.
2334 Every branch must return a Lisp_Object. */
2335 switch (XTYPE (subtree
))
2337 case Lisp_Vectorlike
:
2340 int length
= Flength(subtree
);
2341 for (i
= 0; i
< length
; i
++)
2343 Lisp_Object idx
= make_number (i
);
2344 SUBSTITUTE (Faref (subtree
, idx
),
2345 Faset (subtree
, idx
, true_value
));
2352 SUBSTITUTE (Fcar_safe (subtree
),
2353 Fsetcar (subtree
, true_value
));
2354 SUBSTITUTE (Fcdr_safe (subtree
),
2355 Fsetcdr (subtree
, true_value
));
2361 /* Check for text properties in each interval.
2362 substitute_in_interval contains part of the logic. */
2364 INTERVAL root_interval
= XSTRING (subtree
)->intervals
;
2365 Lisp_Object arg
= Fcons (object
, placeholder
);
2367 traverse_intervals (root_interval
, 1, 0,
2368 &substitute_in_interval
, arg
);
2373 /* Other types don't recurse any further. */
2379 /* Helper function for substitute_object_recurse. */
2381 substitute_in_interval (interval
, arg
)
2385 Lisp_Object object
= Fcar (arg
);
2386 Lisp_Object placeholder
= Fcdr (arg
);
2388 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2407 if (*cp
== '+' || *cp
== '-')
2410 if (*cp
>= '0' && *cp
<= '9')
2413 while (*cp
>= '0' && *cp
<= '9')
2421 if (*cp
>= '0' && *cp
<= '9')
2424 while (*cp
>= '0' && *cp
<= '9')
2427 if (*cp
== 'e' || *cp
== 'E')
2431 if (*cp
== '+' || *cp
== '-')
2435 if (*cp
>= '0' && *cp
<= '9')
2438 while (*cp
>= '0' && *cp
<= '9')
2441 else if (cp
== start
)
2443 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2448 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2454 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2455 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2456 || state
== (DOT_CHAR
|TRAIL_INT
)
2457 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2458 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2459 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2464 read_vector (readcharfun
, bytecodeflag
)
2465 Lisp_Object readcharfun
;
2470 register Lisp_Object
*ptr
;
2471 register Lisp_Object tem
, item
, vector
;
2472 register struct Lisp_Cons
*otem
;
2475 tem
= read_list (1, readcharfun
);
2476 len
= Flength (tem
);
2477 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2479 size
= XVECTOR (vector
)->size
;
2480 ptr
= XVECTOR (vector
)->contents
;
2481 for (i
= 0; i
< size
; i
++)
2484 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2485 bytecode object, the docstring containing the bytecode and
2486 constants values must be treated as unibyte and passed to
2487 Fread, to get the actual bytecode string and constants vector. */
2488 if (bytecodeflag
&& load_force_doc_strings
)
2490 if (i
== COMPILED_BYTECODE
)
2492 if (!STRINGP (item
))
2493 error ("invalid byte code");
2495 /* Delay handling the bytecode slot until we know whether
2496 it is lazily-loaded (we can tell by whether the
2497 constants slot is nil). */
2498 ptr
[COMPILED_CONSTANTS
] = item
;
2501 else if (i
== COMPILED_CONSTANTS
)
2503 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2507 /* Coerce string to unibyte (like string-as-unibyte,
2508 but without generating extra garbage and
2509 guaranteeing no change in the contents). */
2510 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2511 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2513 item
= Fread (bytestr
);
2515 error ("invalid byte code");
2517 otem
= XCONS (item
);
2518 bytestr
= XCAR (item
);
2523 /* Now handle the bytecode slot. */
2524 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2527 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2535 /* FLAG = 1 means check for ] to terminate rather than ) and .
2536 FLAG = -1 means check for starting with defun
2537 and make structure pure. */
2540 read_list (flag
, readcharfun
)
2542 register Lisp_Object readcharfun
;
2544 /* -1 means check next element for defun,
2545 0 means don't check,
2546 1 means already checked and found defun. */
2547 int defunflag
= flag
< 0 ? -1 : 0;
2548 Lisp_Object val
, tail
;
2549 register Lisp_Object elt
, tem
;
2550 struct gcpro gcpro1
, gcpro2
;
2551 /* 0 is the normal case.
2552 1 means this list is a doc reference; replace it with the number 0.
2553 2 means this list is a doc reference; replace it with the doc string. */
2554 int doc_reference
= 0;
2556 /* Initialize this to 1 if we are reading a list. */
2557 int first_in_list
= flag
<= 0;
2566 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2571 /* While building, if the list starts with #$, treat it specially. */
2572 if (EQ (elt
, Vload_file_name
)
2574 && !NILP (Vpurify_flag
))
2576 if (NILP (Vdoc_file_name
))
2577 /* We have not yet called Snarf-documentation, so assume
2578 this file is described in the DOC-MM.NN file
2579 and Snarf-documentation will fill in the right value later.
2580 For now, replace the whole list with 0. */
2583 /* We have already called Snarf-documentation, so make a relative
2584 file name for this file, so it can be found properly
2585 in the installed Lisp directory.
2586 We don't use Fexpand_file_name because that would make
2587 the directory absolute now. */
2588 elt
= concat2 (build_string ("../lisp/"),
2589 Ffile_name_nondirectory (elt
));
2591 else if (EQ (elt
, Vload_file_name
)
2593 && load_force_doc_strings
)
2602 Fsignal (Qinvalid_read_syntax
,
2603 Fcons (make_string (") or . in a vector", 18), Qnil
));
2611 XCDR (tail
) = read0 (readcharfun
);
2613 val
= read0 (readcharfun
);
2614 read1 (readcharfun
, &ch
, 0);
2618 if (doc_reference
== 1)
2619 return make_number (0);
2620 if (doc_reference
== 2)
2622 /* Get a doc string from the file we are loading.
2623 If it's in saved_doc_string, get it from there. */
2624 int pos
= XINT (XCDR (val
));
2625 /* Position is negative for user variables. */
2626 if (pos
< 0) pos
= -pos
;
2627 if (pos
>= saved_doc_string_position
2628 && pos
< (saved_doc_string_position
2629 + saved_doc_string_length
))
2631 int start
= pos
- saved_doc_string_position
;
2634 /* Process quoting with ^A,
2635 and find the end of the string,
2636 which is marked with ^_ (037). */
2637 for (from
= start
, to
= start
;
2638 saved_doc_string
[from
] != 037;)
2640 int c
= saved_doc_string
[from
++];
2643 c
= saved_doc_string
[from
++];
2645 saved_doc_string
[to
++] = c
;
2647 saved_doc_string
[to
++] = 0;
2649 saved_doc_string
[to
++] = 037;
2652 saved_doc_string
[to
++] = c
;
2655 return make_string (saved_doc_string
+ start
,
2658 /* Look in prev_saved_doc_string the same way. */
2659 else if (pos
>= prev_saved_doc_string_position
2660 && pos
< (prev_saved_doc_string_position
2661 + prev_saved_doc_string_length
))
2663 int start
= pos
- prev_saved_doc_string_position
;
2666 /* Process quoting with ^A,
2667 and find the end of the string,
2668 which is marked with ^_ (037). */
2669 for (from
= start
, to
= start
;
2670 prev_saved_doc_string
[from
] != 037;)
2672 int c
= prev_saved_doc_string
[from
++];
2675 c
= prev_saved_doc_string
[from
++];
2677 prev_saved_doc_string
[to
++] = c
;
2679 prev_saved_doc_string
[to
++] = 0;
2681 prev_saved_doc_string
[to
++] = 037;
2684 prev_saved_doc_string
[to
++] = c
;
2687 return make_string (prev_saved_doc_string
+ start
,
2691 return get_doc_string (val
, 0, 0);
2696 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2698 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2700 tem
= (read_pure
&& flag
<= 0
2701 ? pure_cons (elt
, Qnil
)
2702 : Fcons (elt
, Qnil
));
2709 defunflag
= EQ (elt
, Qdefun
);
2710 else if (defunflag
> 0)
2715 Lisp_Object Vobarray
;
2716 Lisp_Object initial_obarray
;
2718 /* oblookup stores the bucket number here, for the sake of Funintern. */
2720 int oblookup_last_bucket_number
;
2722 static int hash_string ();
2723 Lisp_Object
oblookup ();
2725 /* Get an error if OBARRAY is not an obarray.
2726 If it is one, return it. */
2729 check_obarray (obarray
)
2730 Lisp_Object obarray
;
2732 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2734 /* If Vobarray is now invalid, force it to be valid. */
2735 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2737 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2742 /* Intern the C string STR: return a symbol with that name,
2743 interned in the current obarray. */
2750 int len
= strlen (str
);
2751 Lisp_Object obarray
;
2754 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2755 obarray
= check_obarray (obarray
);
2756 tem
= oblookup (obarray
, str
, len
, len
);
2759 return Fintern (make_string (str
, len
), obarray
);
2762 /* Create an uninterned symbol with name STR. */
2768 int len
= strlen (str
);
2770 return Fmake_symbol ((!NILP (Vpurify_flag
)
2771 ? make_pure_string (str
, len
, len
, 0)
2772 : make_string (str
, len
)));
2775 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2776 "Return the canonical symbol whose name is STRING.\n\
2777 If there is none, one is created by this function and returned.\n\
2778 A second optional argument specifies the obarray to use;\n\
2779 it defaults to the value of `obarray'.")
2781 Lisp_Object string
, obarray
;
2783 register Lisp_Object tem
, sym
, *ptr
;
2785 if (NILP (obarray
)) obarray
= Vobarray
;
2786 obarray
= check_obarray (obarray
);
2788 CHECK_STRING (string
, 0);
2790 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2791 XSTRING (string
)->size
,
2792 STRING_BYTES (XSTRING (string
)));
2793 if (!INTEGERP (tem
))
2796 if (!NILP (Vpurify_flag
))
2797 string
= Fpurecopy (string
);
2798 sym
= Fmake_symbol (string
);
2799 XSYMBOL (sym
)->obarray
= obarray
;
2801 if ((XSTRING (string
)->data
[0] == ':')
2802 && EQ (obarray
, initial_obarray
))
2803 XSYMBOL (sym
)->value
= sym
;
2805 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2807 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2809 XSYMBOL (sym
)->next
= 0;
2814 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2815 "Return the canonical symbol named NAME, or nil if none exists.\n\
2816 NAME may be a string or a symbol. If it is a symbol, that exact\n\
2817 symbol is searched for.\n\
2818 A second optional argument specifies the obarray to use;\n\
2819 it defaults to the value of `obarray'.")
2821 Lisp_Object name
, obarray
;
2823 register Lisp_Object tem
;
2824 struct Lisp_String
*string
;
2826 if (NILP (obarray
)) obarray
= Vobarray
;
2827 obarray
= check_obarray (obarray
);
2829 if (!SYMBOLP (name
))
2831 CHECK_STRING (name
, 0);
2832 string
= XSTRING (name
);
2835 string
= XSYMBOL (name
)->name
;
2837 tem
= oblookup (obarray
, string
->data
, string
->size
, STRING_BYTES (string
));
2838 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
2844 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2845 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2846 The value is t if a symbol was found and deleted, nil otherwise.\n\
2847 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2848 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2849 OBARRAY defaults to the value of the variable `obarray'.")
2851 Lisp_Object name
, obarray
;
2853 register Lisp_Object string
, tem
;
2856 if (NILP (obarray
)) obarray
= Vobarray
;
2857 obarray
= check_obarray (obarray
);
2860 XSETSTRING (string
, XSYMBOL (name
)->name
);
2863 CHECK_STRING (name
, 0);
2867 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2868 XSTRING (string
)->size
,
2869 STRING_BYTES (XSTRING (string
)));
2872 /* If arg was a symbol, don't delete anything but that symbol itself. */
2873 if (SYMBOLP (name
) && !EQ (name
, tem
))
2876 XSYMBOL (tem
)->obarray
= Qnil
;
2878 hash
= oblookup_last_bucket_number
;
2880 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2882 if (XSYMBOL (tem
)->next
)
2883 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2885 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2889 Lisp_Object tail
, following
;
2891 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2892 XSYMBOL (tail
)->next
;
2895 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2896 if (EQ (following
, tem
))
2898 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2907 /* Return the symbol in OBARRAY whose names matches the string
2908 of SIZE characters (SIZE_BYTE bytes) at PTR.
2909 If there is no such symbol in OBARRAY, return nil.
2911 Also store the bucket number in oblookup_last_bucket_number. */
2914 oblookup (obarray
, ptr
, size
, size_byte
)
2915 Lisp_Object obarray
;
2917 int size
, size_byte
;
2921 register Lisp_Object tail
;
2922 Lisp_Object bucket
, tem
;
2924 if (!VECTORP (obarray
)
2925 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2927 obarray
= check_obarray (obarray
);
2928 obsize
= XVECTOR (obarray
)->size
;
2930 /* This is sometimes needed in the middle of GC. */
2931 obsize
&= ~ARRAY_MARK_FLAG
;
2932 /* Combining next two lines breaks VMS C 2.3. */
2933 hash
= hash_string (ptr
, size_byte
);
2935 bucket
= XVECTOR (obarray
)->contents
[hash
];
2936 oblookup_last_bucket_number
= hash
;
2937 if (XFASTINT (bucket
) == 0)
2939 else if (!SYMBOLP (bucket
))
2940 error ("Bad data in guts of obarray"); /* Like CADR error message */
2942 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2944 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2945 && XSYMBOL (tail
)->name
->size
== size
2946 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2948 else if (XSYMBOL (tail
)->next
== 0)
2951 XSETINT (tem
, hash
);
2956 hash_string (ptr
, len
)
2960 register unsigned char *p
= ptr
;
2961 register unsigned char *end
= p
+ len
;
2962 register unsigned char c
;
2963 register int hash
= 0;
2968 if (c
>= 0140) c
-= 40;
2969 hash
= ((hash
<<3) + (hash
>>28) + c
);
2971 return hash
& 07777777777;
2975 map_obarray (obarray
, fn
, arg
)
2976 Lisp_Object obarray
;
2977 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2981 register Lisp_Object tail
;
2982 CHECK_VECTOR (obarray
, 1);
2983 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2985 tail
= XVECTOR (obarray
)->contents
[i
];
2990 if (XSYMBOL (tail
)->next
== 0)
2992 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2998 mapatoms_1 (sym
, function
)
2999 Lisp_Object sym
, function
;
3001 call1 (function
, sym
);
3004 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3005 "Call FUNCTION on every symbol in OBARRAY.\n\
3006 OBARRAY defaults to the value of `obarray'.")
3008 Lisp_Object function
, obarray
;
3010 if (NILP (obarray
)) obarray
= Vobarray
;
3011 obarray
= check_obarray (obarray
);
3013 map_obarray (obarray
, mapatoms_1
, function
);
3017 #define OBARRAY_SIZE 1511
3022 Lisp_Object oblength
;
3026 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3028 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3029 Vobarray
= Fmake_vector (oblength
, make_number (0));
3030 initial_obarray
= Vobarray
;
3031 staticpro (&initial_obarray
);
3032 /* Intern nil in the obarray */
3033 XSYMBOL (Qnil
)->obarray
= Vobarray
;
3034 /* These locals are to kludge around a pyramid compiler bug. */
3035 hash
= hash_string ("nil", 3);
3036 /* Separate statement here to avoid VAXC bug. */
3037 hash
%= OBARRAY_SIZE
;
3038 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3041 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3042 XSYMBOL (Qnil
)->function
= Qunbound
;
3043 XSYMBOL (Qunbound
)->value
= Qunbound
;
3044 XSYMBOL (Qunbound
)->function
= Qunbound
;
3047 XSYMBOL (Qnil
)->value
= Qnil
;
3048 XSYMBOL (Qnil
)->plist
= Qnil
;
3049 XSYMBOL (Qt
)->value
= Qt
;
3051 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3054 Qvariable_documentation
= intern ("variable-documentation");
3055 staticpro (&Qvariable_documentation
);
3057 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3058 read_buffer
= (char *) xmalloc (read_buffer_size
);
3063 struct Lisp_Subr
*sname
;
3066 sym
= intern (sname
->symbol_name
);
3067 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3070 #ifdef NOTDEF /* use fset in subr.el now */
3072 defalias (sname
, string
)
3073 struct Lisp_Subr
*sname
;
3077 sym
= intern (string
);
3078 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3082 /* Define an "integer variable"; a symbol whose value is forwarded
3083 to a C variable of type int. Sample call: */
3084 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3086 defvar_int (namestring
, address
)
3090 Lisp_Object sym
, val
;
3091 sym
= intern (namestring
);
3092 val
= allocate_misc ();
3093 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3094 XINTFWD (val
)->intvar
= address
;
3095 XSYMBOL (sym
)->value
= val
;
3098 /* Similar but define a variable whose value is T if address contains 1,
3099 NIL if address contains 0 */
3101 defvar_bool (namestring
, address
)
3105 Lisp_Object sym
, val
;
3106 sym
= intern (namestring
);
3107 val
= allocate_misc ();
3108 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3109 XBOOLFWD (val
)->boolvar
= address
;
3110 XSYMBOL (sym
)->value
= val
;
3111 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3114 /* Similar but define a variable whose value is the Lisp Object stored
3115 at address. Two versions: with and without gc-marking of the C
3116 variable. The nopro version is used when that variable will be
3117 gc-marked for some other reason, since marking the same slot twice
3118 can cause trouble with strings. */
3120 defvar_lisp_nopro (namestring
, address
)
3122 Lisp_Object
*address
;
3124 Lisp_Object sym
, val
;
3125 sym
= intern (namestring
);
3126 val
= allocate_misc ();
3127 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3128 XOBJFWD (val
)->objvar
= address
;
3129 XSYMBOL (sym
)->value
= val
;
3133 defvar_lisp (namestring
, address
)
3135 Lisp_Object
*address
;
3137 defvar_lisp_nopro (namestring
, address
);
3138 staticpro (address
);
3141 /* Similar but define a variable whose value is the Lisp Object stored in
3142 the current buffer. address is the address of the slot in the buffer
3143 that is current now. */
3146 defvar_per_buffer (namestring
, address
, type
, doc
)
3148 Lisp_Object
*address
;
3152 Lisp_Object sym
, val
;
3154 extern struct buffer buffer_local_symbols
;
3156 sym
= intern (namestring
);
3157 val
= allocate_misc ();
3158 offset
= (char *)address
- (char *)current_buffer
;
3160 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3161 XBUFFER_OBJFWD (val
)->offset
= offset
;
3162 XSYMBOL (sym
)->value
= val
;
3163 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
3164 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
3165 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
3166 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3167 slot of buffer_local_flags */
3172 /* Similar but define a variable whose value is the Lisp Object stored
3173 at a particular offset in the current kboard object. */
3176 defvar_kboard (namestring
, offset
)
3180 Lisp_Object sym
, val
;
3181 sym
= intern (namestring
);
3182 val
= allocate_misc ();
3183 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3184 XKBOARD_OBJFWD (val
)->offset
= offset
;
3185 XSYMBOL (sym
)->value
= val
;
3188 /* Record the value of load-path used at the start of dumping
3189 so we can see if the site changed it later during dumping. */
3190 static Lisp_Object dump_path
;
3196 int turn_off_warning
= 0;
3198 /* Compute the default load-path. */
3200 normal
= PATH_LOADSEARCH
;
3201 Vload_path
= decode_env_path (0, normal
);
3203 if (NILP (Vpurify_flag
))
3204 normal
= PATH_LOADSEARCH
;
3206 normal
= PATH_DUMPLOADSEARCH
;
3208 /* In a dumped Emacs, we normally have to reset the value of
3209 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3210 uses ../lisp, instead of the path of the installed elisp
3211 libraries. However, if it appears that Vload_path was changed
3212 from the default before dumping, don't override that value. */
3215 if (! NILP (Fequal (dump_path
, Vload_path
)))
3217 Vload_path
= decode_env_path (0, normal
);
3218 if (!NILP (Vinstallation_directory
))
3220 /* Add to the path the lisp subdir of the
3221 installation dir, if it exists. */
3222 Lisp_Object tem
, tem1
;
3223 tem
= Fexpand_file_name (build_string ("lisp"),
3224 Vinstallation_directory
);
3225 tem1
= Ffile_exists_p (tem
);
3228 if (NILP (Fmember (tem
, Vload_path
)))
3230 turn_off_warning
= 1;
3231 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3235 /* That dir doesn't exist, so add the build-time
3236 Lisp dirs instead. */
3237 Vload_path
= nconc2 (Vload_path
, dump_path
);
3239 /* Add leim under the installation dir, if it exists. */
3240 tem
= Fexpand_file_name (build_string ("leim"),
3241 Vinstallation_directory
);
3242 tem1
= Ffile_exists_p (tem
);
3245 if (NILP (Fmember (tem
, Vload_path
)))
3246 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3249 /* Add site-list under the installation dir, if it exists. */
3250 tem
= Fexpand_file_name (build_string ("site-lisp"),
3251 Vinstallation_directory
);
3252 tem1
= Ffile_exists_p (tem
);
3255 if (NILP (Fmember (tem
, Vload_path
)))
3256 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3259 /* If Emacs was not built in the source directory,
3260 and it is run from where it was built, add to load-path
3261 the lisp, leim and site-lisp dirs under that directory. */
3263 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3267 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3268 Vinstallation_directory
);
3269 tem1
= Ffile_exists_p (tem
);
3271 /* Don't be fooled if they moved the entire source tree
3272 AFTER dumping Emacs. If the build directory is indeed
3273 different from the source dir, src/Makefile.in and
3274 src/Makefile will not be found together. */
3275 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3276 Vinstallation_directory
);
3277 tem2
= Ffile_exists_p (tem
);
3278 if (!NILP (tem1
) && NILP (tem2
))
3280 tem
= Fexpand_file_name (build_string ("lisp"),
3283 if (NILP (Fmember (tem
, Vload_path
)))
3284 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3286 tem
= Fexpand_file_name (build_string ("leim"),
3289 if (NILP (Fmember (tem
, Vload_path
)))
3290 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3292 tem
= Fexpand_file_name (build_string ("site-lisp"),
3295 if (NILP (Fmember (tem
, Vload_path
)))
3296 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3304 /* NORMAL refers to the lisp dir in the source directory. */
3305 /* We used to add ../lisp at the front here, but
3306 that caused trouble because it was copied from dump_path
3307 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3308 It should be unnecessary. */
3309 Vload_path
= decode_env_path (0, normal
);
3310 dump_path
= Vload_path
;
3315 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3316 almost never correct, thereby causing a warning to be printed out that
3317 confuses users. Since PATH_LOADSEARCH is always overridden by the
3318 EMACSLOADPATH environment variable below, disable the warning on NT. */
3320 /* Warn if dirs in the *standard* path don't exist. */
3321 if (!turn_off_warning
)
3323 Lisp_Object path_tail
;
3325 for (path_tail
= Vload_path
;
3327 path_tail
= XCDR (path_tail
))
3329 Lisp_Object dirfile
;
3330 dirfile
= Fcar (path_tail
);
3331 if (STRINGP (dirfile
))
3333 dirfile
= Fdirectory_file_name (dirfile
);
3334 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3335 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3340 #endif /* WINDOWSNT */
3342 /* If the EMACSLOADPATH environment variable is set, use its value.
3343 This doesn't apply if we're dumping. */
3345 if (NILP (Vpurify_flag
)
3346 && egetenv ("EMACSLOADPATH"))
3348 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3352 load_in_progress
= 0;
3353 Vload_file_name
= Qnil
;
3355 load_descriptor_list
= Qnil
;
3357 Vstandard_input
= Qt
;
3360 /* Print a warning, using format string FORMAT, that directory DIRNAME
3361 does not exist. Print it on stderr and put it in *Message*. */
3364 dir_warning (format
, dirname
)
3366 Lisp_Object dirname
;
3369 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3371 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3372 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3373 /* Don't log the warning before we've initialized!! */
3375 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3382 defsubr (&Sread_from_string
);
3384 defsubr (&Sintern_soft
);
3385 defsubr (&Sunintern
);
3387 defsubr (&Seval_buffer
);
3388 defsubr (&Seval_region
);
3389 defsubr (&Sread_char
);
3390 defsubr (&Sread_char_exclusive
);
3391 defsubr (&Sread_event
);
3392 defsubr (&Sget_file_char
);
3393 defsubr (&Smapatoms
);
3395 DEFVAR_LISP ("obarray", &Vobarray
,
3396 "Symbol table for use by `intern' and `read'.\n\
3397 It is a vector whose length ought to be prime for best results.\n\
3398 The vector's contents don't make sense if examined from Lisp programs;\n\
3399 to find all the symbols in an obarray, use `mapatoms'.");
3401 DEFVAR_LISP ("values", &Vvalues
,
3402 "List of values of all expressions which were read, evaluated and printed.\n\
3403 Order is reverse chronological.");
3405 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3406 "Stream for read to get input from.\n\
3407 See documentation of `read' for possible values.");
3408 Vstandard_input
= Qt
;
3410 DEFVAR_LISP ("load-path", &Vload_path
,
3411 "*List of directories to search for files to load.\n\
3412 Each element is a string (directory name) or nil (try default directory).\n\
3413 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3414 otherwise to default specified by file `epaths.h' when Emacs was built.");
3416 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3417 "Non-nil iff inside of `load'.");
3419 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3420 "An alist of expressions to be evalled when particular files are loaded.\n\
3421 Each element looks like (FILENAME FORMS...).\n\
3422 When `load' is run and the file-name argument is FILENAME,\n\
3423 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3424 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3425 with no directory specified, since that is how `load' is normally called.\n\
3426 An error in FORMS does not undo the load,\n\
3427 but does prevent execution of the rest of the FORMS.");
3428 Vafter_load_alist
= Qnil
;
3430 DEFVAR_LISP ("load-history", &Vload_history
,
3431 "Alist mapping source file names to symbols and features.\n\
3432 Each alist element is a list that starts with a file name,\n\
3433 except for one element (optional) that starts with nil and describes\n\
3434 definitions evaluated from buffers not visiting files.\n\
3435 The remaining elements of each list are symbols defined as functions\n\
3436 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
3437 Vload_history
= Qnil
;
3439 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3440 "Full name of file being loaded by `load'.");
3441 Vload_file_name
= Qnil
;
3443 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3444 "File name, including directory, of user's initialization file.\n\
3445 If the file loaded had extension `.elc' and there was a corresponding `.el'\n\
3446 file, this variable contains the name of the .el file, suitable for use\n\
3447 by functions like `custom-save-all' which edit the init file.");
3448 Vuser_init_file
= Qnil
;
3450 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3451 "Used for internal purposes by `load'.");
3452 Vcurrent_load_list
= Qnil
;
3454 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3455 "Function used by `load' and `eval-region' for reading expressions.\n\
3456 The default is nil, which means use the function `read'.");
3457 Vload_read_function
= Qnil
;
3459 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3460 "Function called in `load' for loading an Emacs lisp source file.\n\
3461 This function is for doing code conversion before reading the source file.\n\
3462 If nil, loading is done without any code conversion.\n\
3463 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3464 FULLNAME is the full name of FILE.\n\
3465 See `load' for the meaning of the remaining arguments.");
3466 Vload_source_file_function
= Qnil
;
3468 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3469 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3470 This is useful when the file being loaded is a temporary copy.");
3471 load_force_doc_strings
= 0;
3473 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3474 "Non-nil means `read' converts strings to unibyte whenever possible.\n\
3475 This is normally bound by `load' and `eval-buffer' to control `read',\n\
3476 and is not meant for users to change.");
3477 load_convert_to_unibyte
= 0;
3479 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3480 "Directory in which Emacs sources were found when Emacs was built.\n\
3481 You cannot count on them to still be there!");
3483 = Fexpand_file_name (build_string ("../"),
3484 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3486 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3487 "List of files that were preloaded (when dumping Emacs).");
3488 Vpreloaded_file_list
= Qnil
;
3490 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3491 "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
3492 Vbyte_boolean_vars
= Qnil
;
3494 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3495 "Non-nil means load dangerous compiled Lisp files.\n\
3496 Some versions of XEmacs use different byte codes than Emacs. These\n\
3497 incompatible byte codes can make Emacs crash when it tries to execute\n\
3499 load_dangerous_libraries
= 0;
3501 Vbytecomp_version_regexp
= build_string ("^;;;.in Emacs version");
3502 staticpro (&Vbytecomp_version_regexp
);
3504 /* Vsource_directory was initialized in init_lread. */
3506 load_descriptor_list
= Qnil
;
3507 staticpro (&load_descriptor_list
);
3509 Qcurrent_load_list
= intern ("current-load-list");
3510 staticpro (&Qcurrent_load_list
);
3512 Qstandard_input
= intern ("standard-input");
3513 staticpro (&Qstandard_input
);
3515 Qread_char
= intern ("read-char");
3516 staticpro (&Qread_char
);
3518 Qget_file_char
= intern ("get-file-char");
3519 staticpro (&Qget_file_char
);
3521 Qbackquote
= intern ("`");
3522 staticpro (&Qbackquote
);
3523 Qcomma
= intern (",");
3524 staticpro (&Qcomma
);
3525 Qcomma_at
= intern (",@");
3526 staticpro (&Qcomma_at
);
3527 Qcomma_dot
= intern (",.");
3528 staticpro (&Qcomma_dot
);
3530 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3531 staticpro (&Qinhibit_file_name_operation
);
3533 Qascii_character
= intern ("ascii-character");
3534 staticpro (&Qascii_character
);
3536 Qfunction
= intern ("function");
3537 staticpro (&Qfunction
);
3539 Qload
= intern ("load");
3542 Qload_file_name
= intern ("load-file-name");
3543 staticpro (&Qload_file_name
);
3545 staticpro (&dump_path
);
3547 staticpro (&read_objects
);
3548 read_objects
= Qnil
;
3549 staticpro (&seen_list
);