1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989,
3 1993, 1994 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
24 #include <sys/types.h>
36 #include "termhooks.h"
40 #include <sys/inode.h>
47 #ifdef LISP_FLOAT_TYPE
54 /* These are redefined (correctly, but differently) in values.h. */
61 #endif /* LISP_FLOAT_TYPE */
69 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
70 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
71 Lisp_Object Qascii_character
, Qload
;
73 extern Lisp_Object Qevent_symbol_element_mask
;
75 /* non-zero if inside `load' */
78 /* Search path for files to be loaded. */
79 Lisp_Object Vload_path
;
81 /* This is the user-visible association list that maps features to
82 lists of defs in their load files. */
83 Lisp_Object Vload_history
;
85 /* This is useud to build the load history. */
86 Lisp_Object Vcurrent_load_list
;
88 /* List of descriptors now open for Fload. */
89 static Lisp_Object load_descriptor_list
;
91 /* File for get_file_char to read from. Use by load */
92 static FILE *instream
;
94 /* When nonzero, read conses in pure space */
97 /* For use within read-from-string (this reader is non-reentrant!!) */
98 static int read_from_string_index
;
99 static int read_from_string_limit
;
101 /* Handle unreading and rereading of characters.
102 Write READCHAR to read a character,
103 UNREAD(c) to unread c to be read again. */
105 #define READCHAR readchar (readcharfun)
106 #define UNREAD(c) unreadchar (readcharfun, c)
109 readchar (readcharfun
)
110 Lisp_Object readcharfun
;
113 register struct buffer
*inbuffer
;
114 register int c
, mpos
;
116 if (BUFFERP (readcharfun
))
118 inbuffer
= XBUFFER (readcharfun
);
120 if (BUF_PT (inbuffer
) >= BUF_ZV (inbuffer
))
122 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, BUF_PT (inbuffer
));
123 SET_BUF_PT (inbuffer
, BUF_PT (inbuffer
) + 1);
127 if (MARKERP (readcharfun
))
129 inbuffer
= XMARKER (readcharfun
)->buffer
;
131 mpos
= marker_position (readcharfun
);
133 if (mpos
> BUF_ZV (inbuffer
) - 1)
135 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, mpos
);
136 if (mpos
!= BUF_GPT (inbuffer
))
137 XMARKER (readcharfun
)->bufpos
++;
139 Fset_marker (readcharfun
, make_number (mpos
+ 1),
140 Fmarker_buffer (readcharfun
));
143 if (EQ (readcharfun
, Qget_file_char
))
147 /* Interrupted reads have been observed while reading over the network */
148 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
157 if (STRINGP (readcharfun
))
160 /* This used to be return of a conditional expression,
161 but that truncated -1 to a char on VMS. */
162 if (read_from_string_index
< read_from_string_limit
)
163 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
169 tem
= call0 (readcharfun
);
176 /* Unread the character C in the way appropriate for the stream READCHARFUN.
177 If the stream is a user function, call it with the char as argument. */
180 unreadchar (readcharfun
, c
)
181 Lisp_Object readcharfun
;
185 /* Don't back up the pointer if we're unreading the end-of-input mark,
186 since readchar didn't advance it when we read it. */
188 else if (BUFFERP (readcharfun
))
190 if (XBUFFER (readcharfun
) == current_buffer
)
193 SET_BUF_PT (XBUFFER (readcharfun
), BUF_PT (XBUFFER (readcharfun
)) - 1);
195 else if (MARKERP (readcharfun
))
196 XMARKER (readcharfun
)->bufpos
--;
197 else if (STRINGP (readcharfun
))
198 read_from_string_index
--;
199 else if (EQ (readcharfun
, Qget_file_char
))
200 ungetc (c
, instream
);
202 call1 (readcharfun
, make_number (c
));
205 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
207 /* get a character from the tty */
209 extern Lisp_Object
read_char ();
211 /* Read input events until we get one that's acceptable for our purposes.
213 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
214 until we get a character we like, and then stuffed into
217 If ASCII_REQUIRED is non-zero, we check function key events to see
218 if the unmodified version of the symbol has a Qascii_character
219 property, and use that character, if present.
221 If ERROR_NONASCII is non-zero, we signal an error if the input we
222 get isn't an ASCII character with modifiers. If it's zero but
223 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
226 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
227 int no_switch_frame
, ascii_required
, error_nonascii
;
230 return make_number (getchar ());
232 register Lisp_Object val
, delayed_switch_frame
;
234 delayed_switch_frame
= Qnil
;
236 /* Read until we get an acceptable event. */
238 val
= read_char (0, 0, 0, Qnil
, 0);
243 /* switch-frame events are put off until after the next ASCII
244 character. This is better than signalling an error just because
245 the last characters were typed to a separate minibuffer frame,
246 for example. Eventually, some code which can deal with
247 switch-frame events will read it and process it. */
249 && EVENT_HAS_PARAMETERS (val
)
250 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
252 delayed_switch_frame
= val
;
258 /* Convert certain symbols to their ASCII equivalents. */
261 Lisp_Object tem
, tem1
, tem2
;
262 tem
= Fget (val
, Qevent_symbol_element_mask
);
265 tem1
= Fget (Fcar (tem
), Qascii_character
);
266 /* Merge this symbol's modifier bits
267 with the ASCII equivalent of its basic code. */
269 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
273 /* If we don't have a character now, deal with it appropriately. */
278 Vunread_command_events
= Fcons (val
, Qnil
);
279 error ("Non-character input-event");
286 if (! NILP (delayed_switch_frame
))
287 unread_switch_frame
= delayed_switch_frame
;
293 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
294 "Read a character from the command input (keyboard or macro).\n\
295 It is returned as a number.\n\
296 If the user generates an event which is not a character (i.e. a mouse\n\
297 click or function key event), `read-char' signals an error. As an\n\
298 exception, switch-frame events are put off until non-ASCII events can\n\
300 If you want to read non-character events, or ignore them, call\n\
301 `read-event' or `read-char-exclusive' instead.")
304 return read_filtered_event (1, 1, 1);
307 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
308 "Read an event object from the input stream.")
311 return read_filtered_event (0, 0, 0);
314 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
315 "Read a character from the command input (keyboard or macro).\n\
316 It is returned as a number. Non character events are ignored.")
319 return read_filtered_event (1, 1, 0);
322 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
323 "Don't use this yourself.")
326 register Lisp_Object val
;
327 XSETINT (val
, getc (instream
));
331 static void readevalloop ();
332 static Lisp_Object
load_unwind ();
333 static Lisp_Object
load_descriptor_unwind ();
335 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
336 "Execute a file of Lisp code named FILE.\n\
337 First try FILE with `.elc' appended, then try with `.el',\n\
338 then try FILE unmodified.\n\
339 This function searches the directories in `load-path'.\n\
340 If optional second arg NOERROR is non-nil,\n\
341 report no error if FILE doesn't exist.\n\
342 Print messages at start and end of loading unless\n\
343 optional third arg NOMESSAGE is non-nil.\n\
344 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
345 suffixes `.elc' or `.el' to the specified name FILE.\n\
346 Return t if file exists.")
347 (str
, noerror
, nomessage
, nosuffix
)
348 Lisp_Object str
, noerror
, nomessage
, nosuffix
;
350 register FILE *stream
;
351 register int fd
= -1;
352 register Lisp_Object lispstream
;
353 int count
= specpdl_ptr
- specpdl
;
357 /* 1 means inhibit the message at the beginning. */
361 char *dosmode
= "rt";
364 CHECK_STRING (str
, 0);
365 str
= Fsubstitute_in_file_name (str
);
367 /* If file name is magic, call the handler. */
368 handler
= Ffind_file_name_handler (str
, Qload
);
370 return call5 (handler
, Qload
, str
, noerror
, nomessage
, nosuffix
);
372 /* Avoid weird lossage with null string as arg,
373 since it would try to load a directory as a Lisp file */
374 if (XSTRING (str
)->size
> 0)
377 fd
= openp (Vload_path
, str
, !NILP (nosuffix
) ? "" : ".elc:.el:",
386 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
392 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
401 stat ((char *)XSTRING (found
)->data
, &s1
);
402 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
403 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
404 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
406 message ("Source file `%s' newer than byte-compiled file",
407 XSTRING (found
)->data
);
408 /* Don't immediately overwrite this message. */
412 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
417 stream
= fopen ((char *) XSTRING (found
)->data
, dosmode
);
419 stream
= fdopen (fd
, "r");
424 error ("Failure to create stdio stream for %s", XSTRING (str
)->data
);
427 if (NILP (nomessage
) && !nomessage1
)
428 message ("Loading %s...", XSTRING (str
)->data
);
431 lispstream
= Fcons (Qnil
, Qnil
);
432 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
433 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
434 record_unwind_protect (load_unwind
, lispstream
);
435 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
437 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
439 readevalloop (Qget_file_char
, stream
, str
, Feval
, 0);
440 unbind_to (count
, Qnil
);
442 /* Run any load-hooks for this file. */
443 temp
= Fassoc (str
, Vafter_load_alist
);
445 Fprogn (Fcdr (temp
));
448 if (!noninteractive
&& NILP (nomessage
))
449 message ("Loading %s...done", XSTRING (str
)->data
);
454 load_unwind (stream
) /* used as unwind-protect function in load */
457 fclose (XFASTINT (XCONS (stream
)->car
) << 16
458 | XFASTINT (XCONS (stream
)->cdr
));
459 if (--load_in_progress
< 0) load_in_progress
= 0;
464 load_descriptor_unwind (oldlist
)
467 load_descriptor_list
= oldlist
;
471 /* Close all descriptors in use for Floads.
472 This is used when starting a subprocess. */
478 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
479 close (XFASTINT (XCONS (tail
)->car
));
483 complete_filename_p (pathname
)
484 Lisp_Object pathname
;
486 register unsigned char *s
= XSTRING (pathname
)->data
;
494 #ifdef MSDOS /* MW, May 1993 */
495 || (s
[0] != '\0' && s
[1] == ':' && s
[2] == '/')
500 /* Search for a file whose name is STR, looking in directories
501 in the Lisp list PATH, and trying suffixes from SUFFIX.
502 SUFFIX is a string containing possible suffixes separated by colons.
503 On success, returns a file descriptor. On failure, returns -1.
505 EXEC_ONLY nonzero means don't open the files,
506 just look for one that is executable. In this case,
507 returns 1 on success.
509 If STOREPTR is nonzero, it points to a slot where the name of
510 the file actually found should be stored as a Lisp string.
511 Nil is stored there on failure. */
514 openp (path
, str
, suffix
, storeptr
, exec_only
)
515 Lisp_Object path
, str
;
517 Lisp_Object
*storeptr
;
523 register char *fn
= buf
;
526 register Lisp_Object filename
;
534 if (complete_filename_p (str
))
537 for (; !NILP (path
); path
= Fcdr (path
))
541 filename
= Fexpand_file_name (str
, Fcar (path
));
542 if (!complete_filename_p (filename
))
543 /* If there are non-absolute elts in PATH (eg ".") */
544 /* Of course, this could conceivably lose if luser sets
545 default-directory to be something non-absolute... */
547 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
548 if (!complete_filename_p (filename
))
549 /* Give up on this path element! */
553 /* Calculate maximum size of any filename made from
554 this path element/specified file name and any possible suffix. */
555 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
556 if (fn_size
< want_size
)
557 fn
= (char *) alloca (fn_size
= 100 + want_size
);
561 /* Loop over suffixes. */
564 char *esuffix
= (char *) index (nsuffix
, ':');
565 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
567 /* Concatenate path element/specified name with the suffix. */
568 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
569 fn
[XSTRING (filename
)->size
] = 0;
570 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
571 strncat (fn
, nsuffix
, lsuffix
);
573 /* Ignore file if it's a directory. */
574 if (stat (fn
, &st
) >= 0
575 && (st
.st_mode
& S_IFMT
) != S_IFDIR
)
577 /* Check that we can access or open it. */
579 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
581 fd
= open (fn
, O_RDONLY
, 0);
585 /* We succeeded; return this descriptor and filename. */
587 *storeptr
= build_string (fn
);
593 /* Advance to next suffix. */
596 nsuffix
+= lsuffix
+ 1;
607 /* Merge the list we've accumulated of globals from the current input source
608 into the load_history variable. The details depend on whether
609 the source has an associated file name or not. */
612 build_load_history (stream
, source
)
616 register Lisp_Object tail
, prev
, newelt
;
617 register Lisp_Object tem
, tem2
;
618 register int foundit
, loading
;
620 /* Don't bother recording anything for preloaded files. */
621 if (!NILP (Vpurify_flag
))
624 loading
= stream
|| !NARROWED
;
626 tail
= Vload_history
;
633 /* Find the feature's previous assoc list... */
634 if (!NILP (Fequal (source
, Fcar (tem
))))
638 /* If we're loading, remove it. */
642 Vload_history
= Fcdr (tail
);
644 Fsetcdr (prev
, Fcdr (tail
));
647 /* Otherwise, cons on new symbols that are not already members. */
650 tem2
= Vcurrent_load_list
;
654 newelt
= Fcar (tem2
);
656 if (NILP (Fmemq (newelt
, tem
)))
657 Fsetcar (tail
, Fcons (Fcar (tem
),
658 Fcons (newelt
, Fcdr (tem
))));
671 /* If we're loading, cons the new assoc onto the front of load-history,
672 the most-recently-loaded position. Also do this if we didn't find
673 an existing member for the current source. */
674 if (loading
|| !foundit
)
675 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
680 unreadpure () /* Used as unwind-protect function in readevalloop */
687 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
)
688 Lisp_Object readcharfun
;
690 Lisp_Object sourcename
;
691 Lisp_Object (*evalfun
) ();
695 register Lisp_Object val
;
696 int count
= specpdl_ptr
- specpdl
;
698 struct buffer
*b
= 0;
700 if (BUFFERP (readcharfun
))
701 b
= XBUFFER (readcharfun
);
702 else if (MARKERP (readcharfun
))
703 b
= XMARKER (readcharfun
)->buffer
;
705 specbind (Qstandard_input
, readcharfun
);
706 specbind (Qcurrent_load_list
, Qnil
);
710 LOADHIST_ATTACH (sourcename
);
714 if (b
!= 0 && NILP (b
->name
))
715 error ("Reading from killed buffer");
721 while ((c
= READCHAR
) != '\n' && c
!= -1);
725 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f') continue;
727 if (!NILP (Vpurify_flag
) && c
== '(')
729 int count1
= specpdl_ptr
- specpdl
;
730 record_unwind_protect (unreadpure
, Qnil
);
731 val
= read_list (-1, readcharfun
);
732 unbind_to (count1
, Qnil
);
737 val
= read0 (readcharfun
);
740 val
= (*evalfun
) (val
);
743 Vvalues
= Fcons (val
, Vvalues
);
744 if (EQ (Vstandard_output
, Qt
))
751 build_load_history (stream
, sourcename
);
754 unbind_to (count
, Qnil
);
759 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
760 "Execute the current buffer as Lisp code.\n\
761 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
762 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
763 PRINTFLAG controls printing of output:\n\
764 nil means discard it; anything else is stream for print.\n\
766 If there is no error, point does not move. If there is an error,\n\
767 point remains at the end of the last character read from the buffer.")
769 Lisp_Object bufname
, printflag
;
771 int count
= specpdl_ptr
- specpdl
;
772 Lisp_Object tem
, buf
;
775 buf
= Fcurrent_buffer ();
777 buf
= Fget_buffer (bufname
);
779 error ("No such buffer.");
781 if (NILP (printflag
))
785 specbind (Qstandard_output
, tem
);
786 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
787 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
788 readevalloop (buf
, 0, XBUFFER (buf
)->filename
, Feval
, !NILP (printflag
));
789 unbind_to (count
, Qnil
);
795 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
796 "Execute the current buffer as Lisp code.\n\
797 Programs can pass argument PRINTFLAG which controls printing of output:\n\
798 nil means discard it; anything else is stream for print.\n\
800 If there is no error, point does not move. If there is an error,\n\
801 point remains at the end of the last character read from the buffer.")
803 Lisp_Object printflag
;
805 int count
= specpdl_ptr
- specpdl
;
806 Lisp_Object tem
, cbuf
;
808 cbuf
= Fcurrent_buffer ()
810 if (NILP (printflag
))
814 specbind (Qstandard_output
, tem
);
815 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
817 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
818 return unbind_to (count
, Qnil
);
822 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
823 "Execute the region as Lisp code.\n\
824 When called from programs, expects two arguments,\n\
825 giving starting and ending indices in the current buffer\n\
826 of the text to be executed.\n\
827 Programs can pass third argument PRINTFLAG which controls output:\n\
828 nil means discard it; anything else is stream for printing it.\n\
830 If there is no error, point does not move. If there is an error,\n\
831 point remains at the end of the last character read from the buffer.")
833 Lisp_Object b
, e
, printflag
;
835 int count
= specpdl_ptr
- specpdl
;
836 Lisp_Object tem
, cbuf
;
838 cbuf
= Fcurrent_buffer ();
840 if (NILP (printflag
))
844 specbind (Qstandard_output
, tem
);
846 if (NILP (printflag
))
847 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
848 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
850 /* This both uses b and checks its type. */
852 Fnarrow_to_region (make_number (BEGV
), e
);
853 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
855 return unbind_to (count
, Qnil
);
858 #endif /* standalone */
860 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
861 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
862 If STREAM is nil, use the value of `standard-input' (which see).\n\
863 STREAM or the value of `standard-input' may be:\n\
864 a buffer (read from point and advance it)\n\
865 a marker (read from where it points and advance it)\n\
866 a function (call it with no arguments for each character,\n\
867 call it with a char as argument to push a char back)\n\
868 a string (takes text from string, starting at the beginning)\n\
869 t (read text line using minibuffer and use it).")
871 Lisp_Object readcharfun
;
873 extern Lisp_Object
Fread_minibuffer ();
875 if (NILP (readcharfun
))
876 readcharfun
= Vstandard_input
;
877 if (EQ (readcharfun
, Qt
))
878 readcharfun
= Qread_char
;
881 if (EQ (readcharfun
, Qread_char
))
882 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
885 if (STRINGP (readcharfun
))
886 return Fcar (Fread_from_string (readcharfun
, Qnil
, Qnil
));
888 return read0 (readcharfun
);
891 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
892 "Read one Lisp expression which is represented as text by STRING.\n\
893 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
894 START and END optionally delimit a substring of STRING from which to read;\n\
895 they default to 0 and (length STRING) respectively.")
897 Lisp_Object string
, start
, end
;
899 int startval
, endval
;
902 CHECK_STRING (string
,0);
905 endval
= XSTRING (string
)->size
;
907 { CHECK_NUMBER (end
,2);
909 if (endval
< 0 || endval
> XSTRING (string
)->size
)
910 args_out_of_range (string
, end
);
916 { CHECK_NUMBER (start
,1);
917 startval
= XINT (start
);
918 if (startval
< 0 || startval
> endval
)
919 args_out_of_range (string
, start
);
922 read_from_string_index
= startval
;
923 read_from_string_limit
= endval
;
925 tem
= read0 (string
);
926 return Fcons (tem
, make_number (read_from_string_index
));
929 /* Use this for recursive reads, in contexts where internal tokens
933 Lisp_Object readcharfun
;
935 register Lisp_Object val
;
938 val
= read1 (readcharfun
, &c
);
940 Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
945 static int read_buffer_size
;
946 static char *read_buffer
;
949 read_escape (readcharfun
)
950 Lisp_Object readcharfun
;
952 register int c
= READCHAR
;
979 error ("Invalid escape character syntax");
982 c
= read_escape (readcharfun
);
983 return c
| meta_modifier
;
988 error ("Invalid escape character syntax");
991 c
= read_escape (readcharfun
);
992 return c
| shift_modifier
;
997 error ("Invalid escape character syntax");
1000 c
= read_escape (readcharfun
);
1001 return c
| hyper_modifier
;
1006 error ("Invalid escape character syntax");
1009 c
= read_escape (readcharfun
);
1010 return c
| alt_modifier
;
1015 error ("Invalid escape character syntax");
1018 c
= read_escape (readcharfun
);
1019 return c
| super_modifier
;
1024 error ("Invalid escape character syntax");
1028 c
= read_escape (readcharfun
);
1029 if ((c
& 0177) == '?')
1031 /* ASCII control chars are made from letters (both cases),
1032 as well as the non-letters within 0100...0137. */
1033 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1034 return (c
& (037 | ~0177));
1035 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1036 return (c
& (037 | ~0177));
1038 return c
| ctrl_modifier
;
1048 /* An octal escape, as in ANSI C. */
1050 register int i
= c
- '0';
1051 register int count
= 0;
1054 if ((c
= READCHAR
) >= '0' && c
<= '7')
1069 /* A hex escape, as in ANSI C. */
1075 if (c
>= '0' && c
<= '9')
1080 else if ((c
>= 'a' && c
<= 'f')
1081 || (c
>= 'A' && c
<= 'F'))
1084 if (c
>= 'a' && c
<= 'f')
1103 /* If the next token is ')' or ']' or '.', we store that character
1104 in *PCH and the return value is not interesting. Else, we store
1105 zero in *PCH and we read and return one lisp object. */
1107 read1 (readcharfun
, pch
)
1108 register Lisp_Object readcharfun
;
1117 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1122 return read_list (0, readcharfun
);
1125 return read_vector (readcharfun
);
1138 /* Accept compiled functions at read-time so that we don't have to
1139 build them using function calls. */
1141 tmp
= read_vector (readcharfun
);
1142 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1143 XVECTOR (tmp
)->contents
);
1145 #ifdef USE_TEXT_PROPERTIES
1149 struct gcpro gcpro1
;
1152 /* Read the string itself. */
1153 tmp
= read1 (readcharfun
, &ch
);
1154 if (ch
!= 0 || !STRINGP (tmp
))
1155 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1157 /* Read the intervals and their properties. */
1160 Lisp_Object beg
, end
, plist
;
1162 beg
= read1 (readcharfun
, &ch
);
1166 end
= read1 (readcharfun
, &ch
);
1168 plist
= read1 (readcharfun
, &ch
);
1170 Fsignal (Qinvalid_read_syntax
,
1171 Fcons (build_string ("invalid string property list"),
1173 Fset_text_properties (beg
, end
, plist
, tmp
);
1180 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1183 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1188 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1193 register Lisp_Object val
;
1196 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1199 XSETINT (val
, read_escape (readcharfun
));
1208 register char *p
= read_buffer
;
1209 register char *end
= read_buffer
+ read_buffer_size
;
1213 while ((c
= READCHAR
) >= 0
1218 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1219 p
+= new - read_buffer
;
1220 read_buffer
+= new - read_buffer
;
1221 end
= read_buffer
+ read_buffer_size
;
1224 c
= read_escape (readcharfun
);
1225 /* c is -1 if \ newline has just been seen */
1228 if (p
== read_buffer
)
1233 /* Allow `\C- ' and `\C-?'. */
1234 if (c
== (CHAR_CTL
| ' '))
1236 else if (c
== (CHAR_CTL
| '?'))
1240 /* Move the meta bit to the right place for a string. */
1241 c
= (c
& ~CHAR_META
) | 0x80;
1243 error ("Invalid modifier in string");
1247 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1249 /* If purifying, and string starts with \ newline,
1250 return zero instead. This is for doc strings
1251 that we are really going to find in etc/DOC.nn.nn */
1252 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1253 return make_number (0);
1256 return make_pure_string (read_buffer
, p
- read_buffer
);
1258 return make_string (read_buffer
, p
- read_buffer
);
1263 #ifdef LISP_FLOAT_TYPE
1264 /* If a period is followed by a number, then we should read it
1265 as a floating point number. Otherwise, it denotes a dotted
1267 int next_char
= READCHAR
;
1270 if (! isdigit (next_char
))
1277 /* Otherwise, we fall through! Note that the atom-reading loop
1278 below will now loop at least once, assuring that we will not
1279 try to UNREAD two characters in a row. */
1282 if (c
<= 040) goto retry
;
1284 register char *p
= read_buffer
;
1288 register char *end
= read_buffer
+ read_buffer_size
;
1291 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1292 || c
== '(' || c
== ')'
1293 #ifndef LISP_FLOAT_TYPE
1294 /* If we have floating-point support, then we need
1295 to allow <digits><dot><digits>. */
1297 #endif /* not LISP_FLOAT_TYPE */
1298 || c
== '[' || c
== ']' || c
== '#'
1303 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1304 p
+= new - read_buffer
;
1305 read_buffer
+= new - read_buffer
;
1306 end
= read_buffer
+ read_buffer_size
;
1319 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1320 p
+= new - read_buffer
;
1321 read_buffer
+= new - read_buffer
;
1322 /* end = read_buffer + read_buffer_size; */
1332 register Lisp_Object val
;
1334 if (*p1
== '+' || *p1
== '-') p1
++;
1335 /* Is it an integer? */
1338 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1339 #ifdef LISP_FLOAT_TYPE
1340 /* Integers can have trailing decimal points. */
1341 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
1344 /* It is an integer. */
1346 #ifdef LISP_FLOAT_TYPE
1350 XSETINT (val
, atoi (read_buffer
));
1354 #ifdef LISP_FLOAT_TYPE
1355 if (isfloat_string (read_buffer
))
1356 return make_float (atof (read_buffer
));
1360 return intern (read_buffer
);
1365 #ifdef LISP_FLOAT_TYPE
1380 if (*cp
== '+' || *cp
== '-')
1386 while (isdigit (*cp
))
1397 while (isdigit (*cp
))
1405 if ((*cp
== '+') || (*cp
== '-'))
1411 while (isdigit (*cp
))
1415 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1416 || state
== (DOT_CHAR
|TRAIL_INT
)
1417 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1418 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1419 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1421 #endif /* LISP_FLOAT_TYPE */
1424 read_vector (readcharfun
)
1425 Lisp_Object readcharfun
;
1429 register Lisp_Object
*ptr
;
1430 register Lisp_Object tem
, vector
;
1431 register struct Lisp_Cons
*otem
;
1434 tem
= read_list (1, readcharfun
);
1435 len
= Flength (tem
);
1436 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1439 size
= XVECTOR (vector
)->size
;
1440 ptr
= XVECTOR (vector
)->contents
;
1441 for (i
= 0; i
< size
; i
++)
1443 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1451 /* flag = 1 means check for ] to terminate rather than ) and .
1452 flag = -1 means check for starting with defun
1453 and make structure pure. */
1456 read_list (flag
, readcharfun
)
1458 register Lisp_Object readcharfun
;
1460 /* -1 means check next element for defun,
1461 0 means don't check,
1462 1 means already checked and found defun. */
1463 int defunflag
= flag
< 0 ? -1 : 0;
1464 Lisp_Object val
, tail
;
1465 register Lisp_Object elt
, tem
;
1466 struct gcpro gcpro1
, gcpro2
;
1475 elt
= read1 (readcharfun
, &ch
);
1483 Fsignal (Qinvalid_read_syntax
, Fcons (make_string (") or . in a vector", 18), Qnil
));
1491 XCONS (tail
)->cdr
= read0 (readcharfun
);
1493 val
= read0 (readcharfun
);
1494 read1 (readcharfun
, &ch
);
1498 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1500 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1502 tem
= (read_pure
&& flag
<= 0
1503 ? pure_cons (elt
, Qnil
)
1504 : Fcons (elt
, Qnil
));
1506 XCONS (tail
)->cdr
= tem
;
1511 defunflag
= EQ (elt
, Qdefun
);
1512 else if (defunflag
> 0)
1517 Lisp_Object Vobarray
;
1518 Lisp_Object initial_obarray
;
1521 check_obarray (obarray
)
1522 Lisp_Object obarray
;
1524 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
1526 /* If Vobarray is now invalid, force it to be valid. */
1527 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
1529 obarray
= wrong_type_argument (Qvectorp
, obarray
);
1534 static int hash_string ();
1535 Lisp_Object
oblookup ();
1542 int len
= strlen (str
);
1543 Lisp_Object obarray
;
1546 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
1547 obarray
= check_obarray (obarray
);
1548 tem
= oblookup (obarray
, str
, len
);
1551 return Fintern ((!NILP (Vpurify_flag
)
1552 ? make_pure_string (str
, len
)
1553 : make_string (str
, len
)),
1557 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
1558 "Return the canonical symbol whose name is STRING.\n\
1559 If there is none, one is created by this function and returned.\n\
1560 A second optional argument specifies the obarray to use;\n\
1561 it defaults to the value of `obarray'.")
1563 Lisp_Object str
, obarray
;
1565 register Lisp_Object tem
, sym
, *ptr
;
1567 if (NILP (obarray
)) obarray
= Vobarray
;
1568 obarray
= check_obarray (obarray
);
1570 CHECK_STRING (str
, 0);
1572 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1573 if (!INTEGERP (tem
))
1576 if (!NILP (Vpurify_flag
))
1577 str
= Fpurecopy (str
);
1578 sym
= Fmake_symbol (str
);
1580 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
1582 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
1584 XSYMBOL (sym
)->next
= 0;
1589 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
1590 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
1591 A second optional argument specifies the obarray to use;\n\
1592 it defaults to the value of `obarray'.")
1594 Lisp_Object str
, obarray
;
1596 register Lisp_Object tem
;
1598 if (NILP (obarray
)) obarray
= Vobarray
;
1599 obarray
= check_obarray (obarray
);
1601 CHECK_STRING (str
, 0);
1603 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1604 if (!INTEGERP (tem
))
1610 oblookup (obarray
, ptr
, size
)
1611 Lisp_Object obarray
;
1617 register Lisp_Object tail
;
1618 Lisp_Object bucket
, tem
;
1620 if (!VECTORP (obarray
)
1621 || (obsize
= XVECTOR (obarray
)->size
) == 0)
1623 obarray
= check_obarray (obarray
);
1624 obsize
= XVECTOR (obarray
)->size
;
1626 /* Combining next two lines breaks VMS C 2.3. */
1627 hash
= hash_string (ptr
, size
);
1629 bucket
= XVECTOR (obarray
)->contents
[hash
];
1630 if (XFASTINT (bucket
) == 0)
1632 else if (!SYMBOLP (bucket
))
1633 error ("Bad data in guts of obarray"); /* Like CADR error message */
1634 else for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
1636 if (XSYMBOL (tail
)->name
->size
== size
&&
1637 !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
1639 else if (XSYMBOL (tail
)->next
== 0)
1642 XSETINT (tem
, hash
);
1647 hash_string (ptr
, len
)
1651 register unsigned char *p
= ptr
;
1652 register unsigned char *end
= p
+ len
;
1653 register unsigned char c
;
1654 register int hash
= 0;
1659 if (c
>= 0140) c
-= 40;
1660 hash
= ((hash
<<3) + (hash
>>28) + c
);
1662 return hash
& 07777777777;
1666 map_obarray (obarray
, fn
, arg
)
1667 Lisp_Object obarray
;
1672 register Lisp_Object tail
;
1673 CHECK_VECTOR (obarray
, 1);
1674 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
1676 tail
= XVECTOR (obarray
)->contents
[i
];
1677 if (XFASTINT (tail
) != 0)
1681 if (XSYMBOL (tail
)->next
== 0)
1683 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
1688 mapatoms_1 (sym
, function
)
1689 Lisp_Object sym
, function
;
1691 call1 (function
, sym
);
1694 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
1695 "Call FUNCTION on every symbol in OBARRAY.\n\
1696 OBARRAY defaults to the value of `obarray'.")
1698 Lisp_Object function
, obarray
;
1702 if (NILP (obarray
)) obarray
= Vobarray
;
1703 obarray
= check_obarray (obarray
);
1705 map_obarray (obarray
, mapatoms_1
, function
);
1709 #define OBARRAY_SIZE 1511
1714 Lisp_Object oblength
;
1718 XSETFASTINT (oblength
, OBARRAY_SIZE
);
1720 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
1721 Vobarray
= Fmake_vector (oblength
, make_number (0));
1722 initial_obarray
= Vobarray
;
1723 staticpro (&initial_obarray
);
1724 /* Intern nil in the obarray */
1725 /* These locals are to kludge around a pyramid compiler bug. */
1726 hash
= hash_string ("nil", 3);
1727 /* Separate statement here to avoid VAXC bug. */
1728 hash
%= OBARRAY_SIZE
;
1729 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
1732 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
1733 XSYMBOL (Qnil
)->function
= Qunbound
;
1734 XSYMBOL (Qunbound
)->value
= Qunbound
;
1735 XSYMBOL (Qunbound
)->function
= Qunbound
;
1738 XSYMBOL (Qnil
)->value
= Qnil
;
1739 XSYMBOL (Qnil
)->plist
= Qnil
;
1740 XSYMBOL (Qt
)->value
= Qt
;
1742 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
1745 Qvariable_documentation
= intern ("variable-documentation");
1747 read_buffer_size
= 100;
1748 read_buffer
= (char *) malloc (read_buffer_size
);
1753 struct Lisp_Subr
*sname
;
1756 sym
= intern (sname
->symbol_name
);
1757 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
1760 #ifdef NOTDEF /* use fset in subr.el now */
1762 defalias (sname
, string
)
1763 struct Lisp_Subr
*sname
;
1767 sym
= intern (string
);
1768 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
1772 /* Define an "integer variable"; a symbol whose value is forwarded
1773 to a C variable of type int. Sample call: */
1774 /* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
1776 defvar_int (namestring
, address
)
1780 Lisp_Object sym
, val
;
1781 sym
= intern (namestring
);
1782 val
= allocate_misc ();
1783 XMISC (val
)->type
= Lisp_Misc_Intfwd
;
1784 XMISC (val
)->u_intfwd
.intvar
= address
;
1785 XSYMBOL (sym
)->value
= val
;
1788 /* Similar but define a variable whose value is T if address contains 1,
1789 NIL if address contains 0 */
1791 defvar_bool (namestring
, address
)
1795 Lisp_Object sym
, val
;
1796 sym
= intern (namestring
);
1797 val
= allocate_misc ();
1798 XMISC (val
)->type
= Lisp_Misc_Boolfwd
;
1799 XMISC (val
)->u_boolfwd
.boolvar
= address
;
1800 XSYMBOL (sym
)->value
= val
;
1803 /* Similar but define a variable whose value is the Lisp Object stored
1804 at address. Two versions: with and without gc-marking of the C
1805 variable. The nopro version is used when that variable will be
1806 gc-marked for some other reason, since marking the same slot twice
1807 can cause trouble with strings. */
1809 defvar_lisp_nopro (namestring
, address
)
1811 Lisp_Object
*address
;
1813 Lisp_Object sym
, val
;
1814 sym
= intern (namestring
);
1815 val
= allocate_misc ();
1816 XMISC (val
)->type
= Lisp_Misc_Objfwd
;
1817 XMISC (val
)->u_objfwd
.objvar
= address
;
1818 XSYMBOL (sym
)->value
= val
;
1822 defvar_lisp (namestring
, address
)
1824 Lisp_Object
*address
;
1826 defvar_lisp_nopro (namestring
, address
);
1827 staticpro (address
);
1832 /* Similar but define a variable whose value is the Lisp Object stored in
1833 the current buffer. address is the address of the slot in the buffer
1834 that is current now. */
1837 defvar_per_buffer (namestring
, address
, type
, doc
)
1839 Lisp_Object
*address
;
1843 Lisp_Object sym
, val
;
1845 extern struct buffer buffer_local_symbols
;
1847 sym
= intern (namestring
);
1848 val
= allocate_misc ();
1849 offset
= (char *)address
- (char *)current_buffer
;
1851 XMISC (val
)->type
= Lisp_Misc_Buffer_Objfwd
;
1852 XMISC (val
)->u_buffer_objfwd
.offset
= offset
;
1853 XSYMBOL (sym
)->value
= val
;
1854 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
1855 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
1856 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
1857 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
1858 slot of buffer_local_flags */
1862 #endif /* standalone */
1868 /* Compute the default load-path. */
1870 normal
= PATH_LOADSEARCH
;
1871 Vload_path
= decode_env_path (0, normal
);
1873 if (NILP (Vpurify_flag
))
1874 normal
= PATH_LOADSEARCH
;
1876 normal
= PATH_DUMPLOADSEARCH
;
1878 /* In a dumped Emacs, we normally have to reset the value of
1879 Vload_path from PATH_LOADSEARCH, since the value that was dumped
1880 uses ../lisp, instead of the path of the installed elisp
1881 libraries. However, if it appears that Vload_path was changed
1882 from the default before dumping, don't override that value. */
1885 Lisp_Object dump_path
;
1887 dump_path
= decode_env_path (0, PATH_DUMPLOADSEARCH
);
1888 if (! NILP (Fequal (dump_path
, Vload_path
)))
1890 Vload_path
= decode_env_path (0, normal
);
1891 if (!NILP (Vinstallation_directory
))
1893 /* Add to the path the lisp subdir of the
1894 installation dir, if it exists. */
1895 Lisp_Object tem
, tem1
;
1896 tem
= Fexpand_file_name (build_string ("lisp"),
1897 Vinstallation_directory
);
1898 tem1
= Ffile_exists_p (tem
);
1901 if (NILP (Fmember (tem
, Vload_path
)))
1902 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
1905 /* That dir doesn't exist, so add the build-time
1906 Lisp dirs instead. */
1907 Vload_path
= nconc2 (Vload_path
, dump_path
);
1912 Vload_path
= decode_env_path (0, normal
);
1915 /* Warn if dirs in the *standard* path don't exist. */
1917 Lisp_Object path_tail
;
1919 for (path_tail
= Vload_path
;
1921 path_tail
= XCONS (path_tail
)->cdr
)
1923 Lisp_Object dirfile
;
1924 dirfile
= Fcar (path_tail
);
1925 if (STRINGP (dirfile
))
1927 dirfile
= Fdirectory_file_name (dirfile
);
1928 if (access (XSTRING (dirfile
)->data
, 0) < 0)
1930 "Warning: Lisp directory `%s' does not exist.\n",
1931 XSTRING (Fcar (path_tail
))->data
);
1936 /* If the EMACSLOADPATH environment variable is set, use its value.
1937 This doesn't apply if we're dumping. */
1938 if (NILP (Vpurify_flag
)
1939 && egetenv ("EMACSLOADPATH"))
1940 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
1944 load_in_progress
= 0;
1946 load_descriptor_list
= Qnil
;
1953 defsubr (&Sread_from_string
);
1955 defsubr (&Sintern_soft
);
1957 defsubr (&Seval_buffer
);
1958 defsubr (&Seval_region
);
1959 defsubr (&Sread_char
);
1960 defsubr (&Sread_char_exclusive
);
1961 defsubr (&Sread_event
);
1962 defsubr (&Sget_file_char
);
1963 defsubr (&Smapatoms
);
1965 DEFVAR_LISP ("obarray", &Vobarray
,
1966 "Symbol table for use by `intern' and `read'.\n\
1967 It is a vector whose length ought to be prime for best results.\n\
1968 The vector's contents don't make sense if examined from Lisp programs;\n\
1969 to find all the symbols in an obarray, use `mapatoms'.");
1971 DEFVAR_LISP ("values", &Vvalues
,
1972 "List of values of all expressions which were read, evaluated and printed.\n\
1973 Order is reverse chronological.");
1975 DEFVAR_LISP ("standard-input", &Vstandard_input
,
1976 "Stream for read to get input from.\n\
1977 See documentation of `read' for possible values.");
1978 Vstandard_input
= Qt
;
1980 DEFVAR_LISP ("load-path", &Vload_path
,
1981 "*List of directories to search for files to load.\n\
1982 Each element is a string (directory name) or nil (try default directory).\n\
1983 Initialized based on EMACSLOADPATH environment variable, if any,\n\
1984 otherwise to default specified by file `paths.h' when Emacs was built.");
1986 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
1987 "Non-nil iff inside of `load'.");
1989 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
1990 "An alist of expressions to be evalled when particular files are loaded.\n\
1991 Each element looks like (FILENAME FORMS...).\n\
1992 When `load' is run and the file-name argument is FILENAME,\n\
1993 the FORMS in the corresponding element are executed at the end of loading.\n\n\
1994 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
1995 with no directory specified, since that is how `load' is normally called.\n\
1996 An error in FORMS does not undo the load,\n\
1997 but does prevent execution of the rest of the FORMS.");
1998 Vafter_load_alist
= Qnil
;
2000 DEFVAR_LISP ("load-history", &Vload_history
,
2001 "Alist mapping source file names to symbols and features.\n\
2002 Each alist element is a list that starts with a file name,\n\
2003 except for one element (optional) that starts with nil and describes\n\
2004 definitions evaluated from buffers not visiting files.\n\
2005 The remaining elements of each list are symbols defined as functions\n\
2006 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2007 Vload_history
= Qnil
;
2009 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
2010 "Used for internal purposes by `load'.");
2011 Vcurrent_load_list
= Qnil
;
2013 load_descriptor_list
= Qnil
;
2014 staticpro (&load_descriptor_list
);
2016 Qcurrent_load_list
= intern ("current-load-list");
2017 staticpro (&Qcurrent_load_list
);
2019 Qstandard_input
= intern ("standard-input");
2020 staticpro (&Qstandard_input
);
2022 Qread_char
= intern ("read-char");
2023 staticpro (&Qread_char
);
2025 Qget_file_char
= intern ("get-file-char");
2026 staticpro (&Qget_file_char
);
2028 Qascii_character
= intern ("ascii-character");
2029 staticpro (&Qascii_character
);
2031 Qload
= intern ("load");