1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 1997
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
37 #include "termhooks.h"
41 #include <sys/inode.h>
46 #include <unistd.h> /* to get X_OK */
55 #ifdef LISP_FLOAT_TYPE
61 #endif /* LISP_FLOAT_TYPE */
65 #endif /* HAVE_SETLOCALE */
73 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
74 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
75 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
76 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
77 Lisp_Object Qinhibit_file_name_operation
;
79 extern Lisp_Object Qevent_symbol_element_mask
;
80 extern Lisp_Object Qfile_exists_p
;
82 /* non-zero if inside `load' */
85 /* Directory in which the sources were found. */
86 Lisp_Object Vsource_directory
;
88 /* Search path for files to be loaded. */
89 Lisp_Object Vload_path
;
91 /* This is the user-visible association list that maps features to
92 lists of defs in their load files. */
93 Lisp_Object Vload_history
;
95 /* This is used to build the load history. */
96 Lisp_Object Vcurrent_load_list
;
98 /* List of files that were preloaded. */
99 Lisp_Object Vpreloaded_file_list
;
101 /* Name of file actually being read by `load'. */
102 Lisp_Object Vload_file_name
;
104 /* Function to use for reading, in `load' and friends. */
105 Lisp_Object Vload_read_function
;
107 /* The association list of objects read with the #n=object form.
108 Each member of the list has the form (n . object), and is used to
109 look up the object for the corresponding #n# construct.
110 It must be set to nil before all top-level calls to read0. */
111 Lisp_Object read_objects
;
113 /* Nonzero means load should forcibly load all dynamic doc strings. */
114 static int load_force_doc_strings
;
116 /* Function to use for loading an Emacs lisp source file (not
117 compiled) instead of readevalloop. */
118 Lisp_Object Vload_source_file_function
;
120 /* List of descriptors now open for Fload. */
121 static Lisp_Object load_descriptor_list
;
123 /* File for get_file_char to read from. Use by load. */
124 static FILE *instream
;
126 /* When nonzero, read conses in pure space */
127 static int read_pure
;
129 /* For use within read-from-string (this reader is non-reentrant!!) */
130 static int read_from_string_index
;
131 static int read_from_string_limit
;
133 /* This contains the last string skipped with #@. */
134 static char *saved_doc_string
;
135 /* Length of buffer allocated in saved_doc_string. */
136 static int saved_doc_string_size
;
137 /* Length of actual data in saved_doc_string. */
138 static int saved_doc_string_length
;
139 /* This is the file position that string came from. */
140 static int saved_doc_string_position
;
142 /* Nonzero means inside a new-style backquote
143 with no surrounding parentheses.
144 Fread initializes this to zero, so we need not specbind it
145 or worry about what happens to it when there is an error. */
146 static int new_backquote_flag
;
148 /* Handle unreading and rereading of characters.
149 Write READCHAR to read a character,
150 UNREAD(c) to unread c to be read again.
152 These macros actually read/unread a byte code, multibyte characters
153 are not handled here. The caller should manage them if necessary.
156 #define READCHAR readchar (readcharfun)
157 #define UNREAD(c) unreadchar (readcharfun, c)
160 readchar (readcharfun
)
161 Lisp_Object readcharfun
;
164 register struct buffer
*inbuffer
;
165 register int c
, mpos
;
167 if (BUFFERP (readcharfun
))
169 inbuffer
= XBUFFER (readcharfun
);
171 if (BUF_PT (inbuffer
) >= BUF_ZV (inbuffer
))
173 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, BUF_PT (inbuffer
));
174 SET_BUF_PT (inbuffer
, BUF_PT (inbuffer
) + 1);
178 if (MARKERP (readcharfun
))
180 inbuffer
= XMARKER (readcharfun
)->buffer
;
182 mpos
= marker_position (readcharfun
);
184 if (mpos
> BUF_ZV (inbuffer
) - 1)
186 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, mpos
);
187 if (mpos
!= BUF_GPT (inbuffer
))
188 XMARKER (readcharfun
)->bufpos
++;
190 Fset_marker (readcharfun
, make_number (mpos
+ 1),
191 Fmarker_buffer (readcharfun
));
194 if (EQ (readcharfun
, Qget_file_char
))
198 /* Interrupted reads have been observed while reading over the network */
199 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
208 if (STRINGP (readcharfun
))
211 /* This used to be return of a conditional expression,
212 but that truncated -1 to a char on VMS. */
213 if (read_from_string_index
< read_from_string_limit
)
214 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
220 tem
= call0 (readcharfun
);
227 /* Unread the character C in the way appropriate for the stream READCHARFUN.
228 If the stream is a user function, call it with the char as argument. */
231 unreadchar (readcharfun
, c
)
232 Lisp_Object readcharfun
;
236 /* Don't back up the pointer if we're unreading the end-of-input mark,
237 since readchar didn't advance it when we read it. */
239 else if (BUFFERP (readcharfun
))
241 if (XBUFFER (readcharfun
) == current_buffer
)
244 SET_BUF_PT (XBUFFER (readcharfun
), BUF_PT (XBUFFER (readcharfun
)) - 1);
246 else if (MARKERP (readcharfun
))
247 XMARKER (readcharfun
)->bufpos
--;
248 else if (STRINGP (readcharfun
))
249 read_from_string_index
--;
250 else if (EQ (readcharfun
, Qget_file_char
))
251 ungetc (c
, instream
);
253 call1 (readcharfun
, make_number (c
));
256 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
258 /* get a character from the tty */
260 extern Lisp_Object
read_char ();
262 /* Read input events until we get one that's acceptable for our purposes.
264 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
265 until we get a character we like, and then stuffed into
268 If ASCII_REQUIRED is non-zero, we check function key events to see
269 if the unmodified version of the symbol has a Qascii_character
270 property, and use that character, if present.
272 If ERROR_NONASCII is non-zero, we signal an error if the input we
273 get isn't an ASCII character with modifiers. If it's zero but
274 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
278 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
279 int no_switch_frame
, ascii_required
, error_nonascii
;
282 return make_number (getchar ());
284 register Lisp_Object val
, delayed_switch_frame
;
286 delayed_switch_frame
= Qnil
;
288 /* Read until we get an acceptable event. */
290 val
= read_char (0, 0, 0, Qnil
, 0);
295 /* switch-frame events are put off until after the next ASCII
296 character. This is better than signaling an error just because
297 the last characters were typed to a separate minibuffer frame,
298 for example. Eventually, some code which can deal with
299 switch-frame events will read it and process it. */
301 && EVENT_HAS_PARAMETERS (val
)
302 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
304 delayed_switch_frame
= val
;
310 /* Convert certain symbols to their ASCII equivalents. */
313 Lisp_Object tem
, tem1
, tem2
;
314 tem
= Fget (val
, Qevent_symbol_element_mask
);
317 tem1
= Fget (Fcar (tem
), Qascii_character
);
318 /* Merge this symbol's modifier bits
319 with the ASCII equivalent of its basic code. */
321 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
325 /* If we don't have a character now, deal with it appropriately. */
330 Vunread_command_events
= Fcons (val
, Qnil
);
331 error ("Non-character input-event");
338 if (! NILP (delayed_switch_frame
))
339 unread_switch_frame
= delayed_switch_frame
;
345 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
346 "Read a character from the command input (keyboard or macro).\n\
347 It is returned as a number.\n\
348 If the user generates an event which is not a character (i.e. a mouse\n\
349 click or function key event), `read-char' signals an error. As an\n\
350 exception, switch-frame events are put off until non-ASCII events can\n\
352 If you want to read non-character events, or ignore them, call\n\
353 `read-event' or `read-char-exclusive' instead.")
356 return read_filtered_event (1, 1, 1);
359 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
360 "Read an event object from the input stream.")
363 return read_filtered_event (0, 0, 0);
366 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
367 "Read a character from the command input (keyboard or macro).\n\
368 It is returned as a number. Non-character events are ignored.")
371 return read_filtered_event (1, 1, 0);
374 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
375 "Don't use this yourself.")
378 register Lisp_Object val
;
379 XSETINT (val
, getc (instream
));
383 static void readevalloop ();
384 static Lisp_Object
load_unwind ();
385 static Lisp_Object
load_descriptor_unwind ();
387 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
388 "Execute a file of Lisp code named FILE.\n\
389 First try FILE with `.elc' appended, then try with `.el',\n\
390 then try FILE unmodified.\n\
391 This function searches the directories in `load-path'.\n\
392 If optional second arg NOERROR is non-nil,\n\
393 report no error if FILE doesn't exist.\n\
394 Print messages at start and end of loading unless\n\
395 optional third arg NOMESSAGE is non-nil.\n\
396 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
397 suffixes `.elc' or `.el' to the specified name FILE.\n\
398 Return t if file exists.")
399 (file
, noerror
, nomessage
, nosuffix
)
400 Lisp_Object file
, noerror
, nomessage
, nosuffix
;
402 register FILE *stream
;
403 register int fd
= -1;
404 register Lisp_Object lispstream
;
405 int count
= specpdl_ptr
- specpdl
;
409 /* 1 means we printed the ".el is newer" message. */
411 /* 1 means we are loading a compiled file. */
415 char *dosmode
= "rt";
418 CHECK_STRING (file
, 0);
420 /* If file name is magic, call the handler. */
421 handler
= Ffind_file_name_handler (file
, Qload
);
423 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
425 /* Do this after the handler to avoid
426 the need to gcpro noerror, nomessage and nosuffix.
427 (Below here, we care only whether they are nil or not.) */
428 file
= Fsubstitute_in_file_name (file
);
430 /* Avoid weird lossage with null string as arg,
431 since it would try to load a directory as a Lisp file */
432 if (XSTRING (file
)->size
> 0)
435 fd
= openp (Vload_path
, file
, !NILP (nosuffix
) ? "" : ".elc:.el:",
444 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
445 Fcons (file
, Qnil
)));
450 /* If FD is 0, that means openp found a remote file. */
453 handler
= Ffind_file_name_handler (found
, Qload
);
454 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
457 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
468 stat ((char *)XSTRING (found
)->data
, &s1
);
469 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
470 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
471 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
473 /* Make the progress messages mention that source is newer. */
476 /* If we won't print another message, mention this anyway. */
477 if (! NILP (nomessage
))
478 message ("Source file `%s' newer than byte-compiled file",
479 XSTRING (found
)->data
);
481 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
485 /* We are loading a source file (*.el). */
486 if (!NILP (Vload_source_file_function
))
489 return call4 (Vload_source_file_function
, found
, file
,
490 NILP (noerror
) ? Qnil
: Qt
,
491 NILP (nomessage
) ? Qnil
: Qt
);
497 stream
= fopen ((char *) XSTRING (found
)->data
, dosmode
);
498 #else /* not DOS_NT */
499 stream
= fdopen (fd
, "r");
500 #endif /* not DOS_NT */
504 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
507 if (! NILP (Vpurify_flag
))
508 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
510 if (NILP (nomessage
))
513 message ("Loading %s (compiled; note, source file is newer)...",
514 XSTRING (file
)->data
);
516 message ("Loading %s (compiled)...", XSTRING (file
)->data
);
518 message ("Loading %s...", XSTRING (file
)->data
);
522 lispstream
= Fcons (Qnil
, Qnil
);
523 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
524 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
525 record_unwind_protect (load_unwind
, lispstream
);
526 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
527 specbind (Qload_file_name
, found
);
528 specbind (Qinhibit_file_name_operation
, Qnil
);
530 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
532 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0);
533 unbind_to (count
, Qnil
);
535 /* Run any load-hooks for this file. */
536 temp
= Fassoc (file
, Vafter_load_alist
);
538 Fprogn (Fcdr (temp
));
541 if (saved_doc_string
)
542 free (saved_doc_string
);
543 saved_doc_string
= 0;
544 saved_doc_string_size
= 0;
546 if (!noninteractive
&& NILP (nomessage
))
549 message ("Loading %s (compiled; note, source file is newer)...done",
550 XSTRING (file
)->data
);
552 message ("Loading %s (compiled)...done", XSTRING (file
)->data
);
554 message ("Loading %s...done", XSTRING (file
)->data
);
560 load_unwind (stream
) /* used as unwind-protect function in load */
563 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
564 | XFASTINT (XCONS (stream
)->cdr
)));
565 if (--load_in_progress
< 0) load_in_progress
= 0;
570 load_descriptor_unwind (oldlist
)
573 load_descriptor_list
= oldlist
;
577 /* Close all descriptors in use for Floads.
578 This is used when starting a subprocess. */
585 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
586 close (XFASTINT (XCONS (tail
)->car
));
591 complete_filename_p (pathname
)
592 Lisp_Object pathname
;
594 register unsigned char *s
= XSTRING (pathname
)->data
;
595 return (IS_DIRECTORY_SEP (s
[0])
596 || (XSTRING (pathname
)->size
> 2
597 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
607 /* Search for a file whose name is STR, looking in directories
608 in the Lisp list PATH, and trying suffixes from SUFFIX.
609 SUFFIX is a string containing possible suffixes separated by colons.
610 On success, returns a file descriptor. On failure, returns -1.
612 EXEC_ONLY nonzero means don't open the files,
613 just look for one that is executable. In this case,
614 returns 1 on success.
616 If STOREPTR is nonzero, it points to a slot where the name of
617 the file actually found should be stored as a Lisp string.
618 nil is stored there on failure.
620 If the file we find is remote, return 0
621 but store the found remote file name in *STOREPTR.
622 We do not check for remote files if EXEC_ONLY is nonzero. */
625 openp (path
, str
, suffix
, storeptr
, exec_only
)
626 Lisp_Object path
, str
;
628 Lisp_Object
*storeptr
;
634 register char *fn
= buf
;
637 Lisp_Object filename
;
645 if (complete_filename_p (str
))
648 for (; !NILP (path
); path
= Fcdr (path
))
652 filename
= Fexpand_file_name (str
, Fcar (path
));
653 if (!complete_filename_p (filename
))
654 /* If there are non-absolute elts in PATH (eg ".") */
655 /* Of course, this could conceivably lose if luser sets
656 default-directory to be something non-absolute... */
658 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
659 if (!complete_filename_p (filename
))
660 /* Give up on this path element! */
664 /* Calculate maximum size of any filename made from
665 this path element/specified file name and any possible suffix. */
666 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
667 if (fn_size
< want_size
)
668 fn
= (char *) alloca (fn_size
= 100 + want_size
);
672 /* Loop over suffixes. */
675 char *esuffix
= (char *) index (nsuffix
, ':');
676 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
679 /* Concatenate path element/specified name with the suffix.
680 If the directory starts with /:, remove that. */
681 if (XSTRING (filename
)->size
> 2
682 && XSTRING (filename
)->data
[0] == '/'
683 && XSTRING (filename
)->data
[1] == ':')
685 strncpy (fn
, XSTRING (filename
)->data
+ 2,
686 XSTRING (filename
)->size
- 2);
687 fn
[XSTRING (filename
)->size
- 2] = 0;
691 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
692 fn
[XSTRING (filename
)->size
] = 0;
695 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
696 strncat (fn
, nsuffix
, lsuffix
);
698 /* Check that the file exists and is not a directory. */
702 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
703 if (! NILP (handler
) && ! exec_only
)
708 string
= build_string (fn
);
709 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
710 : Ffile_readable_p (string
));
712 && ! NILP (Ffile_directory_p (build_string (fn
))))
717 /* We succeeded; return this descriptor and filename. */
719 *storeptr
= build_string (fn
);
726 int exists
= (stat (fn
, &st
) >= 0
727 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
730 /* Check that we can access or open it. */
732 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
734 fd
= open (fn
, O_RDONLY
, 0);
738 /* We succeeded; return this descriptor and filename. */
740 *storeptr
= build_string (fn
);
747 /* Advance to next suffix. */
750 nsuffix
+= lsuffix
+ 1;
761 /* Merge the list we've accumulated of globals from the current input source
762 into the load_history variable. The details depend on whether
763 the source has an associated file name or not. */
766 build_load_history (stream
, source
)
770 register Lisp_Object tail
, prev
, newelt
;
771 register Lisp_Object tem
, tem2
;
772 register int foundit
, loading
;
774 /* Don't bother recording anything for preloaded files. */
775 if (!NILP (Vpurify_flag
))
778 loading
= stream
|| !NARROWED
;
780 tail
= Vload_history
;
787 /* Find the feature's previous assoc list... */
788 if (!NILP (Fequal (source
, Fcar (tem
))))
792 /* If we're loading, remove it. */
796 Vload_history
= Fcdr (tail
);
798 Fsetcdr (prev
, Fcdr (tail
));
801 /* Otherwise, cons on new symbols that are not already members. */
804 tem2
= Vcurrent_load_list
;
808 newelt
= Fcar (tem2
);
810 if (NILP (Fmemq (newelt
, tem
)))
811 Fsetcar (tail
, Fcons (Fcar (tem
),
812 Fcons (newelt
, Fcdr (tem
))));
825 /* If we're loading, cons the new assoc onto the front of load-history,
826 the most-recently-loaded position. Also do this if we didn't find
827 an existing member for the current source. */
828 if (loading
|| !foundit
)
829 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
834 unreadpure () /* Used as unwind-protect function in readevalloop */
841 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
)
842 Lisp_Object readcharfun
;
844 Lisp_Object sourcename
;
845 Lisp_Object (*evalfun
) ();
849 register Lisp_Object val
;
850 int count
= specpdl_ptr
- specpdl
;
852 struct buffer
*b
= 0;
854 if (BUFFERP (readcharfun
))
855 b
= XBUFFER (readcharfun
);
856 else if (MARKERP (readcharfun
))
857 b
= XMARKER (readcharfun
)->buffer
;
859 specbind (Qstandard_input
, readcharfun
);
860 specbind (Qcurrent_load_list
, Qnil
);
864 LOADHIST_ATTACH (sourcename
);
868 if (b
!= 0 && NILP (b
->name
))
869 error ("Reading from killed buffer");
875 while ((c
= READCHAR
) != '\n' && c
!= -1);
880 /* Ignore whitespace here, so we can detect eof. */
881 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
884 if (!NILP (Vpurify_flag
) && c
== '(')
886 int count1
= specpdl_ptr
- specpdl
;
887 record_unwind_protect (unreadpure
, Qnil
);
888 val
= read_list (-1, readcharfun
);
889 unbind_to (count1
, Qnil
);
895 if (NILP (Vload_read_function
))
896 val
= read0 (readcharfun
);
898 val
= call1 (Vload_read_function
, readcharfun
);
901 val
= (*evalfun
) (val
);
904 Vvalues
= Fcons (val
, Vvalues
);
905 if (EQ (Vstandard_output
, Qt
))
912 build_load_history (stream
, sourcename
);
915 unbind_to (count
, Qnil
);
920 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
921 "Execute the current buffer as Lisp code.\n\
922 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
923 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
924 PRINTFLAG controls printing of output:\n\
925 nil means discard it; anything else is stream for print.\n\
927 This function preserves the position of point.")
929 Lisp_Object buffer
, printflag
;
931 int count
= specpdl_ptr
- specpdl
;
932 Lisp_Object tem
, buf
;
935 buf
= Fcurrent_buffer ();
937 buf
= Fget_buffer (buffer
);
939 error ("No such buffer.");
941 if (NILP (printflag
))
945 specbind (Qstandard_output
, tem
);
946 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
947 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
948 readevalloop (buf
, 0, XBUFFER (buf
)->filename
, Feval
, !NILP (printflag
));
949 unbind_to (count
, Qnil
);
955 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
956 "Execute the current buffer as Lisp code.\n\
957 Programs can pass argument PRINTFLAG which controls printing of output:\n\
958 nil means discard it; anything else is stream for print.\n\
960 If there is no error, point does not move. If there is an error,\n\
961 point remains at the end of the last character read from the buffer.")
963 Lisp_Object printflag
;
965 int count
= specpdl_ptr
- specpdl
;
966 Lisp_Object tem
, cbuf
;
968 cbuf
= Fcurrent_buffer ()
970 if (NILP (printflag
))
974 specbind (Qstandard_output
, tem
);
975 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
977 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
978 return unbind_to (count
, Qnil
);
982 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
983 "Execute the region as Lisp code.\n\
984 When called from programs, expects two arguments,\n\
985 giving starting and ending indices in the current buffer\n\
986 of the text to be executed.\n\
987 Programs can pass third argument PRINTFLAG which controls output:\n\
988 nil means discard it; anything else is stream for printing it.\n\
990 If there is no error, point does not move. If there is an error,\n\
991 point remains at the end of the last character read from the buffer.")
992 (start
, end
, printflag
)
993 Lisp_Object start
, end
, printflag
;
995 int count
= specpdl_ptr
- specpdl
;
996 Lisp_Object tem
, cbuf
;
998 cbuf
= Fcurrent_buffer ();
1000 if (NILP (printflag
))
1004 specbind (Qstandard_output
, tem
);
1006 if (NILP (printflag
))
1007 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1008 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1010 /* This both uses start and checks its type. */
1012 Fnarrow_to_region (make_number (BEGV
), end
);
1013 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
1015 return unbind_to (count
, Qnil
);
1018 #endif /* standalone */
1020 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1021 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1022 If STREAM is nil, use the value of `standard-input' (which see).\n\
1023 STREAM or the value of `standard-input' may be:\n\
1024 a buffer (read from point and advance it)\n\
1025 a marker (read from where it points and advance it)\n\
1026 a function (call it with no arguments for each character,\n\
1027 call it with a char as argument to push a char back)\n\
1028 a string (takes text from string, starting at the beginning)\n\
1029 t (read text line using minibuffer and use it).")
1033 extern Lisp_Object
Fread_minibuffer ();
1036 stream
= Vstandard_input
;
1037 if (EQ (stream
, Qt
))
1038 stream
= Qread_char
;
1040 new_backquote_flag
= 0;
1041 read_objects
= Qnil
;
1044 if (EQ (stream
, Qread_char
))
1045 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1048 if (STRINGP (stream
))
1049 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1051 return read0 (stream
);
1054 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1055 "Read one Lisp expression which is represented as text by STRING.\n\
1056 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1057 START and END optionally delimit a substring of STRING from which to read;\n\
1058 they default to 0 and (length STRING) respectively.")
1059 (string
, start
, end
)
1060 Lisp_Object string
, start
, end
;
1062 int startval
, endval
;
1065 CHECK_STRING (string
,0);
1068 endval
= XSTRING (string
)->size
;
1070 { CHECK_NUMBER (end
,2);
1071 endval
= XINT (end
);
1072 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1073 args_out_of_range (string
, end
);
1079 { CHECK_NUMBER (start
,1);
1080 startval
= XINT (start
);
1081 if (startval
< 0 || startval
> endval
)
1082 args_out_of_range (string
, start
);
1085 read_from_string_index
= startval
;
1086 read_from_string_limit
= endval
;
1088 new_backquote_flag
= 0;
1089 read_objects
= Qnil
;
1091 tem
= read0 (string
);
1092 return Fcons (tem
, make_number (read_from_string_index
));
1095 /* Use this for recursive reads, in contexts where internal tokens
1099 Lisp_Object readcharfun
;
1101 register Lisp_Object val
;
1104 val
= read1 (readcharfun
, &c
, 0);
1106 Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
1111 static int read_buffer_size
;
1112 static char *read_buffer
;
1114 /* Read multibyte form and return it as a character. C is a first
1115 byte of multibyte form, and rest of them are read from
1118 read_multibyte (c
, readcharfun
)
1120 Lisp_Object readcharfun
;
1122 /* We need the actual character code of this multibyte
1124 unsigned char str
[MAX_LENGTH_OF_MULTI_BYTE_FORM
];
1128 while ((c
= READCHAR
) >= 0xA0
1129 && len
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1132 return STRING_CHAR (str
, len
);
1136 read_escape (readcharfun
)
1137 Lisp_Object readcharfun
;
1139 register int c
= READCHAR
;
1143 error ("End of file");
1169 error ("Invalid escape character syntax");
1172 c
= read_escape (readcharfun
);
1173 return c
| meta_modifier
;
1178 error ("Invalid escape character syntax");
1181 c
= read_escape (readcharfun
);
1182 return c
| shift_modifier
;
1187 error ("Invalid escape character syntax");
1190 c
= read_escape (readcharfun
);
1191 return c
| hyper_modifier
;
1196 error ("Invalid escape character syntax");
1199 c
= read_escape (readcharfun
);
1200 return c
| alt_modifier
;
1205 error ("Invalid escape character syntax");
1208 c
= read_escape (readcharfun
);
1209 return c
| super_modifier
;
1214 error ("Invalid escape character syntax");
1218 c
= read_escape (readcharfun
);
1219 if ((c
& 0177) == '?')
1221 /* ASCII control chars are made from letters (both cases),
1222 as well as the non-letters within 0100...0137. */
1223 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1224 return (c
& (037 | ~0177));
1225 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1226 return (c
& (037 | ~0177));
1228 return c
| ctrl_modifier
;
1238 /* An octal escape, as in ANSI C. */
1240 register int i
= c
- '0';
1241 register int count
= 0;
1244 if ((c
= READCHAR
) >= '0' && c
<= '7')
1259 /* A hex escape, as in ANSI C. */
1265 if (c
>= '0' && c
<= '9')
1270 else if ((c
>= 'a' && c
<= 'f')
1271 || (c
>= 'A' && c
<= 'F'))
1274 if (c
>= 'a' && c
<= 'f')
1289 if (BASE_LEADING_CODE_P (c
))
1290 c
= read_multibyte (c
, readcharfun
);
1295 /* If the next token is ')' or ']' or '.', we store that character
1296 in *PCH and the return value is not interesting. Else, we store
1297 zero in *PCH and we read and return one lisp object.
1299 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1302 read1 (readcharfun
, pch
, first_in_list
)
1303 register Lisp_Object readcharfun
;
1308 int uninterned_symbol
= 0;
1315 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1320 return read_list (0, readcharfun
);
1323 return read_vector (readcharfun
);
1340 tmp
= read_vector (readcharfun
);
1341 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1342 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1343 error ("Invalid size char-table");
1344 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1345 XCHAR_TABLE (tmp
)->top
= Qt
;
1354 tmp
= read_vector (readcharfun
);
1355 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1356 error ("Invalid size char-table");
1357 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1358 XCHAR_TABLE (tmp
)->top
= Qnil
;
1361 Fsignal (Qinvalid_read_syntax
,
1362 Fcons (make_string ("#^^", 3), Qnil
));
1364 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1369 length
= read1 (readcharfun
, pch
, first_in_list
);
1373 Lisp_Object tmp
, val
;
1374 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1378 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1379 if (size_in_chars
!= XSTRING (tmp
)->size
1380 /* We used to print 1 char too many
1381 when the number of bits was a multiple of 8.
1382 Accept such input in case it came from an old version. */
1383 && ! (XFASTINT (length
)
1384 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1385 Fsignal (Qinvalid_read_syntax
,
1386 Fcons (make_string ("#&...", 5), Qnil
));
1388 val
= Fmake_bool_vector (length
, Qnil
);
1389 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1393 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1398 /* Accept compiled functions at read-time so that we don't have to
1399 build them using function calls. */
1401 tmp
= read_vector (readcharfun
);
1402 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1403 XVECTOR (tmp
)->contents
);
1405 #ifdef USE_TEXT_PROPERTIES
1409 struct gcpro gcpro1
;
1412 /* Read the string itself. */
1413 tmp
= read1 (readcharfun
, &ch
, 0);
1414 if (ch
!= 0 || !STRINGP (tmp
))
1415 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1417 /* Read the intervals and their properties. */
1420 Lisp_Object beg
, end
, plist
;
1422 beg
= read1 (readcharfun
, &ch
, 0);
1426 end
= read1 (readcharfun
, &ch
, 0);
1428 plist
= read1 (readcharfun
, &ch
, 0);
1430 Fsignal (Qinvalid_read_syntax
,
1431 Fcons (build_string ("invalid string property list"),
1433 Fset_text_properties (beg
, end
, plist
, tmp
);
1439 /* #@NUMBER is used to skip NUMBER following characters.
1440 That's used in .elc files to skip over doc strings
1441 and function definitions. */
1446 /* Read a decimal integer. */
1447 while ((c
= READCHAR
) >= 0
1448 && c
>= '0' && c
<= '9')
1456 #ifndef DOS_NT /* I don't know if filepos works right on MSDOS and Windoze. */
1457 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1459 /* If we are supposed to force doc strings into core right now,
1460 record the last string that we skipped,
1461 and record where in the file it comes from. */
1462 if (saved_doc_string_size
== 0)
1464 saved_doc_string_size
= nskip
+ 100;
1465 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1467 if (nskip
> saved_doc_string_size
)
1469 saved_doc_string_size
= nskip
+ 100;
1470 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1471 saved_doc_string_size
);
1474 saved_doc_string_position
= ftell (instream
);
1476 /* Copy that many characters into saved_doc_string. */
1477 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1478 saved_doc_string
[i
] = c
= READCHAR
;
1480 saved_doc_string_length
= i
;
1483 #endif /* not DOS_NT */
1485 /* Skip that many characters. */
1486 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1492 return Vload_file_name
;
1494 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1495 /* #:foo is the uninterned symbol named foo. */
1498 uninterned_symbol
= 1;
1502 /* Reader forms that can reuse previously read objects. */
1503 if (c
>= '0' && c
<= '9')
1508 /* Read a non-negative integer. */
1509 while (c
>= '0' && c
<= '9')
1515 /* #n=object returns object, but associates it with n for #n#. */
1518 tem
= read0 (readcharfun
);
1519 read_objects
= Fcons (Fcons (make_number (n
), tem
), read_objects
);
1522 /* #n# returns a previously read object. */
1525 tem
= Fassq (make_number (n
), read_objects
);
1528 /* Fall through to error message. */
1530 /* Fall through to error message. */
1534 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1537 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1542 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1552 new_backquote_flag
= 1;
1553 value
= read0 (readcharfun
);
1554 new_backquote_flag
= 0;
1556 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1560 if (new_backquote_flag
)
1562 Lisp_Object comma_type
= Qnil
;
1567 comma_type
= Qcomma_at
;
1569 comma_type
= Qcomma_dot
;
1572 if (ch
>= 0) UNREAD (ch
);
1573 comma_type
= Qcomma
;
1576 new_backquote_flag
= 0;
1577 value
= read0 (readcharfun
);
1578 new_backquote_flag
= 1;
1579 return Fcons (comma_type
, Fcons (value
, Qnil
));
1586 register Lisp_Object val
;
1589 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1592 c
= read_escape (readcharfun
);
1593 else if (BASE_LEADING_CODE_P (c
))
1594 c
= read_multibyte (c
, readcharfun
);
1602 register char *p
= read_buffer
;
1603 register char *end
= read_buffer
+ read_buffer_size
;
1607 while ((c
= READCHAR
) >= 0
1612 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1613 p
+= new - read_buffer
;
1614 read_buffer
+= new - read_buffer
;
1615 end
= read_buffer
+ read_buffer_size
;
1618 c
= read_escape (readcharfun
);
1619 /* c is -1 if \ newline has just been seen */
1622 if (p
== read_buffer
)
1627 /* Allow `\C- ' and `\C-?'. */
1628 if (c
== (CHAR_CTL
| ' '))
1630 else if (c
== (CHAR_CTL
| '?'))
1634 /* Move the meta bit to the right place for a string. */
1635 c
= (c
& ~CHAR_META
) | 0x80;
1637 error ("Invalid modifier in string");
1641 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1643 /* If purifying, and string starts with \ newline,
1644 return zero instead. This is for doc strings
1645 that we are really going to find in etc/DOC.nn.nn */
1646 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1647 return make_number (0);
1650 return make_pure_string (read_buffer
, p
- read_buffer
);
1652 return make_string (read_buffer
, p
- read_buffer
);
1657 #ifdef LISP_FLOAT_TYPE
1658 /* If a period is followed by a number, then we should read it
1659 as a floating point number. Otherwise, it denotes a dotted
1661 int next_char
= READCHAR
;
1664 if (! (next_char
>= '0' && next_char
<= '9'))
1671 /* Otherwise, we fall through! Note that the atom-reading loop
1672 below will now loop at least once, assuring that we will not
1673 try to UNREAD two characters in a row. */
1677 if (c
<= 040) goto retry
;
1679 register char *p
= read_buffer
;
1683 register char *end
= read_buffer
+ read_buffer_size
;
1686 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1687 || c
== '(' || c
== ')'
1688 #ifndef LISP_FLOAT_TYPE
1689 /* If we have floating-point support, then we need
1690 to allow <digits><dot><digits>. */
1692 #endif /* not LISP_FLOAT_TYPE */
1693 || c
== '[' || c
== ']' || c
== '#'
1698 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1699 p
+= new - read_buffer
;
1700 read_buffer
+= new - read_buffer
;
1701 end
= read_buffer
+ read_buffer_size
;
1714 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1715 p
+= new - read_buffer
;
1716 read_buffer
+= new - read_buffer
;
1717 /* end = read_buffer + read_buffer_size; */
1724 if (!quoted
&& !uninterned_symbol
)
1727 register Lisp_Object val
;
1729 if (*p1
== '+' || *p1
== '-') p1
++;
1730 /* Is it an integer? */
1733 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1734 #ifdef LISP_FLOAT_TYPE
1735 /* Integers can have trailing decimal points. */
1736 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
1739 /* It is an integer. */
1741 #ifdef LISP_FLOAT_TYPE
1745 if (sizeof (int) == sizeof (EMACS_INT
))
1746 XSETINT (val
, atoi (read_buffer
));
1747 else if (sizeof (long) == sizeof (EMACS_INT
))
1748 XSETINT (val
, atol (read_buffer
));
1754 #ifdef LISP_FLOAT_TYPE
1755 if (isfloat_string (read_buffer
))
1756 return make_float (atof (read_buffer
));
1760 if (uninterned_symbol
)
1761 return make_symbol (read_buffer
);
1763 return intern (read_buffer
);
1768 #ifdef LISP_FLOAT_TYPE
1783 if (*cp
== '+' || *cp
== '-')
1786 if (*cp
>= '0' && *cp
<= '9')
1789 while (*cp
>= '0' && *cp
<= '9')
1797 if (*cp
>= '0' && *cp
<= '9')
1800 while (*cp
>= '0' && *cp
<= '9')
1803 if (*cp
== 'e' || *cp
== 'E')
1807 if (*cp
== '+' || *cp
== '-')
1811 if (*cp
>= '0' && *cp
<= '9')
1814 while (*cp
>= '0' && *cp
<= '9')
1817 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
1818 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1819 || state
== (DOT_CHAR
|TRAIL_INT
)
1820 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1821 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1822 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1824 #endif /* LISP_FLOAT_TYPE */
1827 read_vector (readcharfun
)
1828 Lisp_Object readcharfun
;
1832 register Lisp_Object
*ptr
;
1833 register Lisp_Object tem
, vector
;
1834 register struct Lisp_Cons
*otem
;
1837 tem
= read_list (1, readcharfun
);
1838 len
= Flength (tem
);
1839 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1842 size
= XVECTOR (vector
)->size
;
1843 ptr
= XVECTOR (vector
)->contents
;
1844 for (i
= 0; i
< size
; i
++)
1846 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1854 /* flag = 1 means check for ] to terminate rather than ) and .
1855 flag = -1 means check for starting with defun
1856 and make structure pure. */
1859 read_list (flag
, readcharfun
)
1861 register Lisp_Object readcharfun
;
1863 /* -1 means check next element for defun,
1864 0 means don't check,
1865 1 means already checked and found defun. */
1866 int defunflag
= flag
< 0 ? -1 : 0;
1867 Lisp_Object val
, tail
;
1868 register Lisp_Object elt
, tem
;
1869 struct gcpro gcpro1
, gcpro2
;
1870 /* 0 is the normal case.
1871 1 means this list is a doc reference; replace it with the number 0.
1872 2 means this list is a doc reference; replace it with the doc string. */
1873 int doc_reference
= 0;
1875 /* Initialize this to 1 if we are reading a list. */
1876 int first_in_list
= flag
<= 0;
1885 elt
= read1 (readcharfun
, &ch
, first_in_list
);
1890 /* While building, if the list starts with #$, treat it specially. */
1891 if (EQ (elt
, Vload_file_name
)
1892 && !NILP (Vpurify_flag
))
1894 if (NILP (Vdoc_file_name
))
1895 /* We have not yet called Snarf-documentation, so assume
1896 this file is described in the DOC-MM.NN file
1897 and Snarf-documentation will fill in the right value later.
1898 For now, replace the whole list with 0. */
1901 /* We have already called Snarf-documentation, so make a relative
1902 file name for this file, so it can be found properly
1903 in the installed Lisp directory.
1904 We don't use Fexpand_file_name because that would make
1905 the directory absolute now. */
1906 elt
= concat2 (build_string ("../lisp/"),
1907 Ffile_name_nondirectory (elt
));
1909 else if (EQ (elt
, Vload_file_name
)
1910 && load_force_doc_strings
)
1919 Fsignal (Qinvalid_read_syntax
,
1920 Fcons (make_string (") or . in a vector", 18), Qnil
));
1928 XCONS (tail
)->cdr
= read0 (readcharfun
);
1930 val
= read0 (readcharfun
);
1931 read1 (readcharfun
, &ch
, 0);
1935 if (doc_reference
== 1)
1936 return make_number (0);
1937 if (doc_reference
== 2)
1939 /* Get a doc string from the file we are loading.
1940 If it's in saved_doc_string, get it from there. */
1941 int pos
= XINT (XCONS (val
)->cdr
);
1942 if (pos
>= saved_doc_string_position
1943 && pos
< (saved_doc_string_position
1944 + saved_doc_string_length
))
1946 int start
= pos
- saved_doc_string_position
;
1949 /* Process quoting with ^A,
1950 and find the end of the string,
1951 which is marked with ^_ (037). */
1952 for (from
= start
, to
= start
;
1953 saved_doc_string
[from
] != 037;)
1955 int c
= saved_doc_string
[from
++];
1958 c
= saved_doc_string
[from
++];
1960 saved_doc_string
[to
++] = c
;
1962 saved_doc_string
[to
++] = 0;
1964 saved_doc_string
[to
++] = 037;
1967 saved_doc_string
[to
++] = c
;
1970 return make_string (saved_doc_string
+ start
,
1974 return read_doc_string (val
);
1979 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1981 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1983 tem
= (read_pure
&& flag
<= 0
1984 ? pure_cons (elt
, Qnil
)
1985 : Fcons (elt
, Qnil
));
1987 XCONS (tail
)->cdr
= tem
;
1992 defunflag
= EQ (elt
, Qdefun
);
1993 else if (defunflag
> 0)
1998 Lisp_Object Vobarray
;
1999 Lisp_Object initial_obarray
;
2001 /* oblookup stores the bucket number here, for the sake of Funintern. */
2003 int oblookup_last_bucket_number
;
2005 static int hash_string ();
2006 Lisp_Object
oblookup ();
2008 /* Get an error if OBARRAY is not an obarray.
2009 If it is one, return it. */
2012 check_obarray (obarray
)
2013 Lisp_Object obarray
;
2015 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2017 /* If Vobarray is now invalid, force it to be valid. */
2018 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2020 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2025 /* Intern the C string STR: return a symbol with that name,
2026 interned in the current obarray. */
2033 int len
= strlen (str
);
2034 Lisp_Object obarray
;
2037 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2038 obarray
= check_obarray (obarray
);
2039 tem
= oblookup (obarray
, str
, len
);
2042 return Fintern (make_string (str
, len
), obarray
);
2045 /* Create an uninterned symbol with name STR. */
2051 int len
= strlen (str
);
2053 return Fmake_symbol ((!NILP (Vpurify_flag
)
2054 ? make_pure_string (str
, len
)
2055 : make_string (str
, len
)));
2058 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2059 "Return the canonical symbol whose name is STRING.\n\
2060 If there is none, one is created by this function and returned.\n\
2061 A second optional argument specifies the obarray to use;\n\
2062 it defaults to the value of `obarray'.")
2064 Lisp_Object string
, obarray
;
2066 register Lisp_Object tem
, sym
, *ptr
;
2068 if (NILP (obarray
)) obarray
= Vobarray
;
2069 obarray
= check_obarray (obarray
);
2071 CHECK_STRING (string
, 0);
2073 tem
= oblookup (obarray
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2074 if (!INTEGERP (tem
))
2077 if (!NILP (Vpurify_flag
))
2078 string
= Fpurecopy (string
);
2079 sym
= Fmake_symbol (string
);
2080 XSYMBOL (sym
)->obarray
= obarray
;
2082 if (XSTRING (string
)->data
[0] == ':')
2083 XSYMBOL (sym
)->value
= sym
;
2085 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2087 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2089 XSYMBOL (sym
)->next
= 0;
2094 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2095 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2096 A second optional argument specifies the obarray to use;\n\
2097 it defaults to the value of `obarray'.")
2099 Lisp_Object string
, obarray
;
2101 register Lisp_Object tem
;
2103 if (NILP (obarray
)) obarray
= Vobarray
;
2104 obarray
= check_obarray (obarray
);
2106 CHECK_STRING (string
, 0);
2108 tem
= oblookup (obarray
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2109 if (!INTEGERP (tem
))
2114 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2115 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2116 The value is t if a symbol was found and deleted, nil otherwise.\n\
2117 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2118 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2119 OBARRAY defaults to the value of the variable `obarray'.")
2121 Lisp_Object name
, obarray
;
2123 register Lisp_Object string
, tem
;
2126 if (NILP (obarray
)) obarray
= Vobarray
;
2127 obarray
= check_obarray (obarray
);
2130 XSETSTRING (string
, XSYMBOL (name
)->name
);
2133 CHECK_STRING (name
, 0);
2137 tem
= oblookup (obarray
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2140 /* If arg was a symbol, don't delete anything but that symbol itself. */
2141 if (SYMBOLP (name
) && !EQ (name
, tem
))
2144 hash
= oblookup_last_bucket_number
;
2146 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2148 if (XSYMBOL (tem
)->next
)
2149 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2151 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2155 Lisp_Object tail
, following
;
2157 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2158 XSYMBOL (tail
)->next
;
2161 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2162 if (EQ (following
, tem
))
2164 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2173 /* Return the symbol in OBARRAY whose names matches the string
2174 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
2177 Also store the bucket number in oblookup_last_bucket_number. */
2180 oblookup (obarray
, ptr
, size
)
2181 Lisp_Object obarray
;
2187 register Lisp_Object tail
;
2188 Lisp_Object bucket
, tem
;
2190 if (!VECTORP (obarray
)
2191 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2193 obarray
= check_obarray (obarray
);
2194 obsize
= XVECTOR (obarray
)->size
;
2196 /* This is sometimes needed in the middle of GC. */
2197 obsize
&= ~ARRAY_MARK_FLAG
;
2198 /* Combining next two lines breaks VMS C 2.3. */
2199 hash
= hash_string (ptr
, size
);
2201 bucket
= XVECTOR (obarray
)->contents
[hash
];
2202 oblookup_last_bucket_number
= hash
;
2203 if (XFASTINT (bucket
) == 0)
2205 else if (!SYMBOLP (bucket
))
2206 error ("Bad data in guts of obarray"); /* Like CADR error message */
2208 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2210 if (XSYMBOL (tail
)->name
->size
== size
2211 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
2213 else if (XSYMBOL (tail
)->next
== 0)
2216 XSETINT (tem
, hash
);
2221 hash_string (ptr
, len
)
2225 register unsigned char *p
= ptr
;
2226 register unsigned char *end
= p
+ len
;
2227 register unsigned char c
;
2228 register int hash
= 0;
2233 if (c
>= 0140) c
-= 40;
2234 hash
= ((hash
<<3) + (hash
>>28) + c
);
2236 return hash
& 07777777777;
2240 map_obarray (obarray
, fn
, arg
)
2241 Lisp_Object obarray
;
2246 register Lisp_Object tail
;
2247 CHECK_VECTOR (obarray
, 1);
2248 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2250 tail
= XVECTOR (obarray
)->contents
[i
];
2255 if (XSYMBOL (tail
)->next
== 0)
2257 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2262 mapatoms_1 (sym
, function
)
2263 Lisp_Object sym
, function
;
2265 call1 (function
, sym
);
2268 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2269 "Call FUNCTION on every symbol in OBARRAY.\n\
2270 OBARRAY defaults to the value of `obarray'.")
2272 Lisp_Object function
, obarray
;
2276 if (NILP (obarray
)) obarray
= Vobarray
;
2277 obarray
= check_obarray (obarray
);
2279 map_obarray (obarray
, mapatoms_1
, function
);
2283 #define OBARRAY_SIZE 1511
2288 Lisp_Object oblength
;
2292 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2294 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
2295 Vobarray
= Fmake_vector (oblength
, make_number (0));
2296 initial_obarray
= Vobarray
;
2297 staticpro (&initial_obarray
);
2298 /* Intern nil in the obarray */
2299 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2300 /* These locals are to kludge around a pyramid compiler bug. */
2301 hash
= hash_string ("nil", 3);
2302 /* Separate statement here to avoid VAXC bug. */
2303 hash
%= OBARRAY_SIZE
;
2304 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2307 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
2308 XSYMBOL (Qnil
)->function
= Qunbound
;
2309 XSYMBOL (Qunbound
)->value
= Qunbound
;
2310 XSYMBOL (Qunbound
)->function
= Qunbound
;
2313 XSYMBOL (Qnil
)->value
= Qnil
;
2314 XSYMBOL (Qnil
)->plist
= Qnil
;
2315 XSYMBOL (Qt
)->value
= Qt
;
2317 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2320 Qvariable_documentation
= intern ("variable-documentation");
2321 staticpro (&Qvariable_documentation
);
2323 read_buffer_size
= 100;
2324 read_buffer
= (char *) malloc (read_buffer_size
);
2329 struct Lisp_Subr
*sname
;
2332 sym
= intern (sname
->symbol_name
);
2333 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2336 #ifdef NOTDEF /* use fset in subr.el now */
2338 defalias (sname
, string
)
2339 struct Lisp_Subr
*sname
;
2343 sym
= intern (string
);
2344 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2348 /* Define an "integer variable"; a symbol whose value is forwarded
2349 to a C variable of type int. Sample call: */
2350 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2352 defvar_int (namestring
, address
)
2356 Lisp_Object sym
, val
;
2357 sym
= intern (namestring
);
2358 val
= allocate_misc ();
2359 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2360 XINTFWD (val
)->intvar
= address
;
2361 XSYMBOL (sym
)->value
= val
;
2364 /* Similar but define a variable whose value is T if address contains 1,
2365 NIL if address contains 0 */
2367 defvar_bool (namestring
, address
)
2371 Lisp_Object sym
, val
;
2372 sym
= intern (namestring
);
2373 val
= allocate_misc ();
2374 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2375 XBOOLFWD (val
)->boolvar
= address
;
2376 XSYMBOL (sym
)->value
= val
;
2379 /* Similar but define a variable whose value is the Lisp Object stored
2380 at address. Two versions: with and without gc-marking of the C
2381 variable. The nopro version is used when that variable will be
2382 gc-marked for some other reason, since marking the same slot twice
2383 can cause trouble with strings. */
2385 defvar_lisp_nopro (namestring
, address
)
2387 Lisp_Object
*address
;
2389 Lisp_Object sym
, val
;
2390 sym
= intern (namestring
);
2391 val
= allocate_misc ();
2392 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2393 XOBJFWD (val
)->objvar
= address
;
2394 XSYMBOL (sym
)->value
= val
;
2398 defvar_lisp (namestring
, address
)
2400 Lisp_Object
*address
;
2402 defvar_lisp_nopro (namestring
, address
);
2403 staticpro (address
);
2408 /* Similar but define a variable whose value is the Lisp Object stored in
2409 the current buffer. address is the address of the slot in the buffer
2410 that is current now. */
2413 defvar_per_buffer (namestring
, address
, type
, doc
)
2415 Lisp_Object
*address
;
2419 Lisp_Object sym
, val
;
2421 extern struct buffer buffer_local_symbols
;
2423 sym
= intern (namestring
);
2424 val
= allocate_misc ();
2425 offset
= (char *)address
- (char *)current_buffer
;
2427 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2428 XBUFFER_OBJFWD (val
)->offset
= offset
;
2429 XSYMBOL (sym
)->value
= val
;
2430 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2431 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2432 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2433 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2434 slot of buffer_local_flags */
2438 #endif /* standalone */
2440 /* Similar but define a variable whose value is the Lisp Object stored
2441 at a particular offset in the current kboard object. */
2444 defvar_kboard (namestring
, offset
)
2448 Lisp_Object sym
, val
;
2449 sym
= intern (namestring
);
2450 val
= allocate_misc ();
2451 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2452 XKBOARD_OBJFWD (val
)->offset
= offset
;
2453 XSYMBOL (sym
)->value
= val
;
2456 /* Record the value of load-path used at the start of dumping
2457 so we can see if the site changed it later during dumping. */
2458 static Lisp_Object dump_path
;
2463 int turn_off_warning
= 0;
2465 #ifdef HAVE_SETLOCALE
2466 /* Make sure numbers are parsed as we expect. */
2467 setlocale (LC_NUMERIC
, "C");
2468 #endif /* HAVE_SETLOCALE */
2470 /* Compute the default load-path. */
2472 normal
= PATH_LOADSEARCH
;
2473 Vload_path
= decode_env_path (0, normal
);
2475 if (NILP (Vpurify_flag
))
2476 normal
= PATH_LOADSEARCH
;
2478 normal
= PATH_DUMPLOADSEARCH
;
2480 /* In a dumped Emacs, we normally have to reset the value of
2481 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2482 uses ../lisp, instead of the path of the installed elisp
2483 libraries. However, if it appears that Vload_path was changed
2484 from the default before dumping, don't override that value. */
2487 if (! NILP (Fequal (dump_path
, Vload_path
)))
2489 Vload_path
= decode_env_path (0, normal
);
2490 if (!NILP (Vinstallation_directory
))
2492 /* Add to the path the lisp subdir of the
2493 installation dir, if it exists. */
2494 Lisp_Object tem
, tem1
;
2495 tem
= Fexpand_file_name (build_string ("lisp"),
2496 Vinstallation_directory
);
2497 tem1
= Ffile_exists_p (tem
);
2500 if (NILP (Fmember (tem
, Vload_path
)))
2502 turn_off_warning
= 1;
2503 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2507 /* That dir doesn't exist, so add the build-time
2508 Lisp dirs instead. */
2509 Vload_path
= nconc2 (Vload_path
, dump_path
);
2511 /* Add leim under the installation dir, if it exists. */
2512 tem
= Fexpand_file_name (build_string ("leim"),
2513 Vinstallation_directory
);
2514 tem1
= Ffile_exists_p (tem
);
2517 if (NILP (Fmember (tem
, Vload_path
)))
2518 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2521 /* Add site-list under the installation dir, if it exists. */
2522 tem
= Fexpand_file_name (build_string ("site-lisp"),
2523 Vinstallation_directory
);
2524 tem1
= Ffile_exists_p (tem
);
2527 if (NILP (Fmember (tem
, Vload_path
)))
2528 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2531 /* If Emacs was not built in the source directory,
2532 and it is run from where it was built, add to load-path
2533 the lisp, leim and site-lisp dirs under that directory. */
2535 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
2539 tem
= Fexpand_file_name (build_string ("src/Makefile"),
2540 Vinstallation_directory
);
2541 tem1
= Ffile_exists_p (tem
);
2543 /* Don't be fooled if they moved the entire source tree
2544 AFTER dumping Emacs. If the build directory is indeed
2545 different from the source dir, src/Makefile.in and
2546 src/Makefile will not be found together. */
2547 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
2548 Vinstallation_directory
);
2549 tem2
= Ffile_exists_p (tem
);
2550 if (!NILP (tem1
) && NILP (tem2
))
2552 tem
= Fexpand_file_name (build_string ("lisp"),
2555 if (NILP (Fmember (tem
, Vload_path
)))
2556 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2558 tem
= Fexpand_file_name (build_string ("leim"),
2561 if (NILP (Fmember (tem
, Vload_path
)))
2562 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2564 tem
= Fexpand_file_name (build_string ("site-lisp"),
2567 if (NILP (Fmember (tem
, Vload_path
)))
2568 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2576 /* NORMAL refers to the lisp dir in the source directory. */
2577 /* We used to add ../lisp at the front here, but
2578 that caused trouble because it was copied from dump_path
2579 into Vload_path, aboe, when Vinstallation_directory was non-nil.
2580 It should be unnecessary. */
2581 Vload_path
= decode_env_path (0, normal
);
2582 dump_path
= Vload_path
;
2587 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
2588 almost never correct, thereby causing a warning to be printed out that
2589 confuses users. Since PATH_LOADSEARCH is always overridden by the
2590 EMACSLOADPATH environment variable below, disable the warning on NT. */
2592 /* Warn if dirs in the *standard* path don't exist. */
2593 if (!turn_off_warning
)
2595 Lisp_Object path_tail
;
2597 for (path_tail
= Vload_path
;
2599 path_tail
= XCONS (path_tail
)->cdr
)
2601 Lisp_Object dirfile
;
2602 dirfile
= Fcar (path_tail
);
2603 if (STRINGP (dirfile
))
2605 dirfile
= Fdirectory_file_name (dirfile
);
2606 if (access (XSTRING (dirfile
)->data
, 0) < 0)
2607 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
2608 XCONS (path_tail
)->car
);
2612 #endif /* WINDOWSNT */
2614 /* If the EMACSLOADPATH environment variable is set, use its value.
2615 This doesn't apply if we're dumping. */
2617 if (NILP (Vpurify_flag
)
2618 && egetenv ("EMACSLOADPATH"))
2620 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
2624 load_in_progress
= 0;
2625 Vload_file_name
= Qnil
;
2627 load_descriptor_list
= Qnil
;
2630 /* Print a warning, using format string FORMAT, that directory DIRNAME
2631 does not exist. Print it on stderr and put it in *Message*. */
2633 dir_warning (format
, dirname
)
2635 Lisp_Object dirname
;
2638 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
2640 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
2641 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
2642 message_dolog (buffer
, strlen (buffer
), 0);
2649 defsubr (&Sread_from_string
);
2651 defsubr (&Sintern_soft
);
2652 defsubr (&Sunintern
);
2654 defsubr (&Seval_buffer
);
2655 defsubr (&Seval_region
);
2656 defsubr (&Sread_char
);
2657 defsubr (&Sread_char_exclusive
);
2658 defsubr (&Sread_event
);
2659 defsubr (&Sget_file_char
);
2660 defsubr (&Smapatoms
);
2662 DEFVAR_LISP ("obarray", &Vobarray
,
2663 "Symbol table for use by `intern' and `read'.\n\
2664 It is a vector whose length ought to be prime for best results.\n\
2665 The vector's contents don't make sense if examined from Lisp programs;\n\
2666 to find all the symbols in an obarray, use `mapatoms'.");
2668 DEFVAR_LISP ("values", &Vvalues
,
2669 "List of values of all expressions which were read, evaluated and printed.\n\
2670 Order is reverse chronological.");
2672 DEFVAR_LISP ("standard-input", &Vstandard_input
,
2673 "Stream for read to get input from.\n\
2674 See documentation of `read' for possible values.");
2675 Vstandard_input
= Qt
;
2677 DEFVAR_LISP ("load-path", &Vload_path
,
2678 "*List of directories to search for files to load.\n\
2679 Each element is a string (directory name) or nil (try default directory).\n\
2680 Initialized based on EMACSLOADPATH environment variable, if any,\n\
2681 otherwise to default specified by file `paths.h' when Emacs was built.");
2683 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
2684 "Non-nil iff inside of `load'.");
2686 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
2687 "An alist of expressions to be evalled when particular files are loaded.\n\
2688 Each element looks like (FILENAME FORMS...).\n\
2689 When `load' is run and the file-name argument is FILENAME,\n\
2690 the FORMS in the corresponding element are executed at the end of loading.\n\n\
2691 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
2692 with no directory specified, since that is how `load' is normally called.\n\
2693 An error in FORMS does not undo the load,\n\
2694 but does prevent execution of the rest of the FORMS.");
2695 Vafter_load_alist
= Qnil
;
2697 DEFVAR_LISP ("load-history", &Vload_history
,
2698 "Alist mapping source file names to symbols and features.\n\
2699 Each alist element is a list that starts with a file name,\n\
2700 except for one element (optional) that starts with nil and describes\n\
2701 definitions evaluated from buffers not visiting files.\n\
2702 The remaining elements of each list are symbols defined as functions\n\
2703 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2704 Vload_history
= Qnil
;
2706 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
2707 "Full name of file being loaded by `load'.");
2708 Vload_file_name
= Qnil
;
2710 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
2711 "Used for internal purposes by `load'.");
2712 Vcurrent_load_list
= Qnil
;
2714 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
2715 "Function used by `load' and `eval-region' for reading expressions.\n\
2716 The default is nil, which means use the function `read'.");
2717 Vload_read_function
= Qnil
;
2719 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
2720 "Function called in `load' for loading an Emacs lisp source file.\n\
2721 This function is for doing code conversion before reading the source file.\n\
2722 If nil, loading is done without any code conversion.\n\
2723 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
2724 FULLNAME is the full name of FILE.\n\
2725 See `load' for the meaning of the remaining arguments.");
2726 Vload_source_file_function
= Qnil
;
2728 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
2729 "Non-nil means `load' should force-load all dynamic doc strings.\n\
2730 This is useful when the file being loaded is a temporary copy.");
2731 load_force_doc_strings
= 0;
2733 DEFVAR_LISP ("source-directory", &Vsource_directory
,
2734 "Directory in which Emacs sources were found when Emacs was built.\n\
2735 You cannot count on them to still be there!");
2737 = Fexpand_file_name (build_string ("../"),
2738 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
2740 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
2741 "List of files that were preloaded (when dumping Emacs).");
2742 Vpreloaded_file_list
= Qnil
;
2744 /* Vsource_directory was initialized in init_lread. */
2746 load_descriptor_list
= Qnil
;
2747 staticpro (&load_descriptor_list
);
2749 Qcurrent_load_list
= intern ("current-load-list");
2750 staticpro (&Qcurrent_load_list
);
2752 Qstandard_input
= intern ("standard-input");
2753 staticpro (&Qstandard_input
);
2755 Qread_char
= intern ("read-char");
2756 staticpro (&Qread_char
);
2758 Qget_file_char
= intern ("get-file-char");
2759 staticpro (&Qget_file_char
);
2761 Qbackquote
= intern ("`");
2762 staticpro (&Qbackquote
);
2763 Qcomma
= intern (",");
2764 staticpro (&Qcomma
);
2765 Qcomma_at
= intern (",@");
2766 staticpro (&Qcomma_at
);
2767 Qcomma_dot
= intern (",.");
2768 staticpro (&Qcomma_dot
);
2770 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
2771 staticpro (&Qinhibit_file_name_operation
);
2773 Qascii_character
= intern ("ascii-character");
2774 staticpro (&Qascii_character
);
2776 Qfunction
= intern ("function");
2777 staticpro (&Qfunction
);
2779 Qload
= intern ("load");
2782 Qload_file_name
= intern ("load-file-name");
2783 staticpro (&Qload_file_name
);
2785 staticpro (&dump_path
);
2787 staticpro (&read_objects
);
2788 read_objects
= Qnil
;