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>
35 #include "termhooks.h"
39 #include <sys/inode.h>
46 #ifdef LISP_FLOAT_TYPE
53 /* These are redefined (correctly, but differently) in values.h. */
60 #endif /* LISP_FLOAT_TYPE */
68 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
69 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
70 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
72 extern Lisp_Object Qevent_symbol_element_mask
;
74 /* non-zero if inside `load' */
77 /* Search path for files to be loaded. */
78 Lisp_Object Vload_path
;
80 /* This is the user-visible association list that maps features to
81 lists of defs in their load files. */
82 Lisp_Object Vload_history
;
84 /* This is used to build the load history. */
85 Lisp_Object Vcurrent_load_list
;
87 /* Name of file actually being read by `load'. */
88 Lisp_Object Vload_file_name
;
90 /* List of descriptors now open for Fload. */
91 static Lisp_Object load_descriptor_list
;
93 /* File for get_file_char to read from. Use by load */
94 static FILE *instream
;
96 /* When nonzero, read conses in pure space */
99 /* For use within read-from-string (this reader is non-reentrant!!) */
100 static int read_from_string_index
;
101 static int read_from_string_limit
;
103 /* Handle unreading and rereading of characters.
104 Write READCHAR to read a character,
105 UNREAD(c) to unread c to be read again. */
107 #define READCHAR readchar (readcharfun)
108 #define UNREAD(c) unreadchar (readcharfun, c)
111 readchar (readcharfun
)
112 Lisp_Object readcharfun
;
115 register struct buffer
*inbuffer
;
116 register int c
, mpos
;
118 if (BUFFERP (readcharfun
))
120 inbuffer
= XBUFFER (readcharfun
);
122 if (BUF_PT (inbuffer
) >= BUF_ZV (inbuffer
))
124 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, BUF_PT (inbuffer
));
125 SET_BUF_PT (inbuffer
, BUF_PT (inbuffer
) + 1);
129 if (MARKERP (readcharfun
))
131 inbuffer
= XMARKER (readcharfun
)->buffer
;
133 mpos
= marker_position (readcharfun
);
135 if (mpos
> BUF_ZV (inbuffer
) - 1)
137 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, mpos
);
138 if (mpos
!= BUF_GPT (inbuffer
))
139 XMARKER (readcharfun
)->bufpos
++;
141 Fset_marker (readcharfun
, make_number (mpos
+ 1),
142 Fmarker_buffer (readcharfun
));
145 if (EQ (readcharfun
, Qget_file_char
))
149 /* Interrupted reads have been observed while reading over the network */
150 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
159 if (STRINGP (readcharfun
))
162 /* This used to be return of a conditional expression,
163 but that truncated -1 to a char on VMS. */
164 if (read_from_string_index
< read_from_string_limit
)
165 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
171 tem
= call0 (readcharfun
);
178 /* Unread the character C in the way appropriate for the stream READCHARFUN.
179 If the stream is a user function, call it with the char as argument. */
182 unreadchar (readcharfun
, c
)
183 Lisp_Object readcharfun
;
187 /* Don't back up the pointer if we're unreading the end-of-input mark,
188 since readchar didn't advance it when we read it. */
190 else if (BUFFERP (readcharfun
))
192 if (XBUFFER (readcharfun
) == current_buffer
)
195 SET_BUF_PT (XBUFFER (readcharfun
), BUF_PT (XBUFFER (readcharfun
)) - 1);
197 else if (MARKERP (readcharfun
))
198 XMARKER (readcharfun
)->bufpos
--;
199 else if (STRINGP (readcharfun
))
200 read_from_string_index
--;
201 else if (EQ (readcharfun
, Qget_file_char
))
202 ungetc (c
, instream
);
204 call1 (readcharfun
, make_number (c
));
207 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
209 /* get a character from the tty */
211 extern Lisp_Object
read_char ();
213 /* Read input events until we get one that's acceptable for our purposes.
215 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
216 until we get a character we like, and then stuffed into
219 If ASCII_REQUIRED is non-zero, we check function key events to see
220 if the unmodified version of the symbol has a Qascii_character
221 property, and use that character, if present.
223 If ERROR_NONASCII is non-zero, we signal an error if the input we
224 get isn't an ASCII character with modifiers. If it's zero but
225 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
228 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
229 int no_switch_frame
, ascii_required
, error_nonascii
;
232 return make_number (getchar ());
234 register Lisp_Object val
, delayed_switch_frame
;
236 delayed_switch_frame
= Qnil
;
238 /* Read until we get an acceptable event. */
240 val
= read_char (0, 0, 0, Qnil
, 0);
245 /* switch-frame events are put off until after the next ASCII
246 character. This is better than signalling an error just because
247 the last characters were typed to a separate minibuffer frame,
248 for example. Eventually, some code which can deal with
249 switch-frame events will read it and process it. */
251 && EVENT_HAS_PARAMETERS (val
)
252 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
254 delayed_switch_frame
= val
;
260 /* Convert certain symbols to their ASCII equivalents. */
263 Lisp_Object tem
, tem1
, tem2
;
264 tem
= Fget (val
, Qevent_symbol_element_mask
);
267 tem1
= Fget (Fcar (tem
), Qascii_character
);
268 /* Merge this symbol's modifier bits
269 with the ASCII equivalent of its basic code. */
271 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
275 /* If we don't have a character now, deal with it appropriately. */
280 Vunread_command_events
= Fcons (val
, Qnil
);
281 error ("Non-character input-event");
288 if (! NILP (delayed_switch_frame
))
289 unread_switch_frame
= delayed_switch_frame
;
295 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
296 "Read a character from the command input (keyboard or macro).\n\
297 It is returned as a number.\n\
298 If the user generates an event which is not a character (i.e. a mouse\n\
299 click or function key event), `read-char' signals an error. As an\n\
300 exception, switch-frame events are put off until non-ASCII events can\n\
302 If you want to read non-character events, or ignore them, call\n\
303 `read-event' or `read-char-exclusive' instead.")
306 return read_filtered_event (1, 1, 1);
309 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
310 "Read an event object from the input stream.")
313 return read_filtered_event (0, 0, 0);
316 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
317 "Read a character from the command input (keyboard or macro).\n\
318 It is returned as a number. Non character events are ignored.")
321 return read_filtered_event (1, 1, 0);
324 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
325 "Don't use this yourself.")
328 register Lisp_Object val
;
329 XSETINT (val
, getc (instream
));
333 static void readevalloop ();
334 static Lisp_Object
load_unwind ();
335 static Lisp_Object
load_descriptor_unwind ();
337 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
338 "Execute a file of Lisp code named FILE.\n\
339 First try FILE with `.elc' appended, then try with `.el',\n\
340 then try FILE unmodified.\n\
341 This function searches the directories in `load-path'.\n\
342 If optional second arg NOERROR is non-nil,\n\
343 report no error if FILE doesn't exist.\n\
344 Print messages at start and end of loading unless\n\
345 optional third arg NOMESSAGE is non-nil.\n\
346 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
347 suffixes `.elc' or `.el' to the specified name FILE.\n\
348 Return t if file exists.")
349 (str
, noerror
, nomessage
, nosuffix
)
350 Lisp_Object str
, noerror
, nomessage
, nosuffix
;
352 register FILE *stream
;
353 register int fd
= -1;
354 register Lisp_Object lispstream
;
355 int count
= specpdl_ptr
- specpdl
;
359 /* 1 means inhibit the message at the beginning. */
363 char *dosmode
= "rt";
366 CHECK_STRING (str
, 0);
368 /* If file name is magic, call the handler. */
369 handler
= Ffind_file_name_handler (str
, Qload
);
371 return call5 (handler
, Qload
, str
, noerror
, nomessage
, nosuffix
);
373 /* Do this after the handler to avoid
374 the need to gcpro noerror, nomessage and nosuffix.
375 (Below here, we care only whether they are nil or not.) */
376 str
= Fsubstitute_in_file_name (str
);
378 /* Avoid weird lossage with null string as arg,
379 since it would try to load a directory as a Lisp file */
380 if (XSTRING (str
)->size
> 0)
383 fd
= openp (Vload_path
, str
, !NILP (nosuffix
) ? "" : ".elc:.el:",
392 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
398 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
407 stat ((char *)XSTRING (found
)->data
, &s1
);
408 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
409 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
410 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
412 message ("Source file `%s' newer than byte-compiled file",
413 XSTRING (found
)->data
);
414 /* Don't immediately overwrite this message. */
418 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
423 stream
= fopen ((char *) XSTRING (found
)->data
, dosmode
);
424 #else /* not DOS_NT */
425 stream
= fdopen (fd
, "r");
426 #endif /* not DOS_NT */
430 error ("Failure to create stdio stream for %s", XSTRING (str
)->data
);
433 if (NILP (nomessage
) && !nomessage1
)
434 message ("Loading %s...", XSTRING (str
)->data
);
437 lispstream
= Fcons (Qnil
, Qnil
);
438 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
439 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
440 record_unwind_protect (load_unwind
, lispstream
);
441 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
442 specbind (Qload_file_name
, found
);
444 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
446 readevalloop (Qget_file_char
, stream
, str
, Feval
, 0);
447 unbind_to (count
, Qnil
);
449 /* Run any load-hooks for this file. */
450 temp
= Fassoc (str
, Vafter_load_alist
);
452 Fprogn (Fcdr (temp
));
455 if (!noninteractive
&& NILP (nomessage
))
456 message ("Loading %s...done", XSTRING (str
)->data
);
461 load_unwind (stream
) /* used as unwind-protect function in load */
464 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
465 | XFASTINT (XCONS (stream
)->cdr
)));
466 if (--load_in_progress
< 0) load_in_progress
= 0;
471 load_descriptor_unwind (oldlist
)
474 load_descriptor_list
= oldlist
;
478 /* Close all descriptors in use for Floads.
479 This is used when starting a subprocess. */
485 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
486 close (XFASTINT (XCONS (tail
)->car
));
490 complete_filename_p (pathname
)
491 Lisp_Object pathname
;
493 register unsigned char *s
= XSTRING (pathname
)->data
;
494 return (IS_DIRECTORY_SEP (s
[0])
495 || (XSTRING (pathname
)->size
> 2
496 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
506 /* Search for a file whose name is STR, looking in directories
507 in the Lisp list PATH, and trying suffixes from SUFFIX.
508 SUFFIX is a string containing possible suffixes separated by colons.
509 On success, returns a file descriptor. On failure, returns -1.
511 EXEC_ONLY nonzero means don't open the files,
512 just look for one that is executable. In this case,
513 returns 1 on success.
515 If STOREPTR is nonzero, it points to a slot where the name of
516 the file actually found should be stored as a Lisp string.
517 Nil is stored there on failure. */
520 openp (path
, str
, suffix
, storeptr
, exec_only
)
521 Lisp_Object path
, str
;
523 Lisp_Object
*storeptr
;
529 register char *fn
= buf
;
532 register Lisp_Object filename
;
540 if (complete_filename_p (str
))
543 for (; !NILP (path
); path
= Fcdr (path
))
547 filename
= Fexpand_file_name (str
, Fcar (path
));
548 if (!complete_filename_p (filename
))
549 /* If there are non-absolute elts in PATH (eg ".") */
550 /* Of course, this could conceivably lose if luser sets
551 default-directory to be something non-absolute... */
553 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
554 if (!complete_filename_p (filename
))
555 /* Give up on this path element! */
559 /* Calculate maximum size of any filename made from
560 this path element/specified file name and any possible suffix. */
561 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
562 if (fn_size
< want_size
)
563 fn
= (char *) alloca (fn_size
= 100 + want_size
);
567 /* Loop over suffixes. */
570 char *esuffix
= (char *) index (nsuffix
, ':');
571 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
573 /* Concatenate path element/specified name with the suffix. */
574 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
575 fn
[XSTRING (filename
)->size
] = 0;
576 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
577 strncat (fn
, nsuffix
, lsuffix
);
579 /* Ignore file if it's a directory. */
580 if (stat (fn
, &st
) >= 0
581 && (st
.st_mode
& S_IFMT
) != S_IFDIR
)
583 /* Check that we can access or open it. */
585 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
587 fd
= open (fn
, O_RDONLY
, 0);
591 /* We succeeded; return this descriptor and filename. */
593 *storeptr
= build_string (fn
);
599 /* Advance to next suffix. */
602 nsuffix
+= lsuffix
+ 1;
613 /* Merge the list we've accumulated of globals from the current input source
614 into the load_history variable. The details depend on whether
615 the source has an associated file name or not. */
618 build_load_history (stream
, source
)
622 register Lisp_Object tail
, prev
, newelt
;
623 register Lisp_Object tem
, tem2
;
624 register int foundit
, loading
;
626 /* Don't bother recording anything for preloaded files. */
627 if (!NILP (Vpurify_flag
))
630 loading
= stream
|| !NARROWED
;
632 tail
= Vload_history
;
639 /* Find the feature's previous assoc list... */
640 if (!NILP (Fequal (source
, Fcar (tem
))))
644 /* If we're loading, remove it. */
648 Vload_history
= Fcdr (tail
);
650 Fsetcdr (prev
, Fcdr (tail
));
653 /* Otherwise, cons on new symbols that are not already members. */
656 tem2
= Vcurrent_load_list
;
660 newelt
= Fcar (tem2
);
662 if (NILP (Fmemq (newelt
, tem
)))
663 Fsetcar (tail
, Fcons (Fcar (tem
),
664 Fcons (newelt
, Fcdr (tem
))));
677 /* If we're loading, cons the new assoc onto the front of load-history,
678 the most-recently-loaded position. Also do this if we didn't find
679 an existing member for the current source. */
680 if (loading
|| !foundit
)
681 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
686 unreadpure () /* Used as unwind-protect function in readevalloop */
693 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
)
694 Lisp_Object readcharfun
;
696 Lisp_Object sourcename
;
697 Lisp_Object (*evalfun
) ();
701 register Lisp_Object val
;
702 int count
= specpdl_ptr
- specpdl
;
704 struct buffer
*b
= 0;
706 if (BUFFERP (readcharfun
))
707 b
= XBUFFER (readcharfun
);
708 else if (MARKERP (readcharfun
))
709 b
= XMARKER (readcharfun
)->buffer
;
711 specbind (Qstandard_input
, readcharfun
);
712 specbind (Qcurrent_load_list
, Qnil
);
716 LOADHIST_ATTACH (sourcename
);
720 if (b
!= 0 && NILP (b
->name
))
721 error ("Reading from killed buffer");
727 while ((c
= READCHAR
) != '\n' && c
!= -1);
732 /* Ignore whitespace here, so we can detect eof. */
733 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
736 if (!NILP (Vpurify_flag
) && c
== '(')
738 int count1
= specpdl_ptr
- specpdl
;
739 record_unwind_protect (unreadpure
, Qnil
);
740 val
= read_list (-1, readcharfun
);
741 unbind_to (count1
, Qnil
);
746 val
= read0 (readcharfun
);
749 val
= (*evalfun
) (val
);
752 Vvalues
= Fcons (val
, Vvalues
);
753 if (EQ (Vstandard_output
, Qt
))
760 build_load_history (stream
, sourcename
);
763 unbind_to (count
, Qnil
);
768 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
769 "Execute the current buffer as Lisp code.\n\
770 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
771 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
772 PRINTFLAG controls printing of output:\n\
773 nil means discard it; anything else is stream for print.\n\
775 If there is no error, point does not move. If there is an error,\n\
776 point remains at the end of the last character read from the buffer.")
778 Lisp_Object bufname
, printflag
;
780 int count
= specpdl_ptr
- specpdl
;
781 Lisp_Object tem
, buf
;
784 buf
= Fcurrent_buffer ();
786 buf
= Fget_buffer (bufname
);
788 error ("No such buffer.");
790 if (NILP (printflag
))
794 specbind (Qstandard_output
, tem
);
795 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
796 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
797 readevalloop (buf
, 0, XBUFFER (buf
)->filename
, Feval
, !NILP (printflag
));
798 unbind_to (count
, Qnil
);
804 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
805 "Execute the current buffer as Lisp code.\n\
806 Programs can pass argument PRINTFLAG which controls printing of output:\n\
807 nil means discard it; anything else is stream for print.\n\
809 If there is no error, point does not move. If there is an error,\n\
810 point remains at the end of the last character read from the buffer.")
812 Lisp_Object printflag
;
814 int count
= specpdl_ptr
- specpdl
;
815 Lisp_Object tem
, cbuf
;
817 cbuf
= Fcurrent_buffer ()
819 if (NILP (printflag
))
823 specbind (Qstandard_output
, tem
);
824 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
826 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
827 return unbind_to (count
, Qnil
);
831 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
832 "Execute the region as Lisp code.\n\
833 When called from programs, expects two arguments,\n\
834 giving starting and ending indices in the current buffer\n\
835 of the text to be executed.\n\
836 Programs can pass third argument PRINTFLAG which controls output:\n\
837 nil means discard it; anything else is stream for printing it.\n\
839 If there is no error, point does not move. If there is an error,\n\
840 point remains at the end of the last character read from the buffer.")
842 Lisp_Object b
, e
, printflag
;
844 int count
= specpdl_ptr
- specpdl
;
845 Lisp_Object tem
, cbuf
;
847 cbuf
= Fcurrent_buffer ();
849 if (NILP (printflag
))
853 specbind (Qstandard_output
, tem
);
855 if (NILP (printflag
))
856 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
857 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
859 /* This both uses b and checks its type. */
861 Fnarrow_to_region (make_number (BEGV
), e
);
862 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
864 return unbind_to (count
, Qnil
);
867 #endif /* standalone */
869 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
870 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
871 If STREAM is nil, use the value of `standard-input' (which see).\n\
872 STREAM or the value of `standard-input' may be:\n\
873 a buffer (read from point and advance it)\n\
874 a marker (read from where it points and advance it)\n\
875 a function (call it with no arguments for each character,\n\
876 call it with a char as argument to push a char back)\n\
877 a string (takes text from string, starting at the beginning)\n\
878 t (read text line using minibuffer and use it).")
880 Lisp_Object readcharfun
;
882 extern Lisp_Object
Fread_minibuffer ();
884 if (NILP (readcharfun
))
885 readcharfun
= Vstandard_input
;
886 if (EQ (readcharfun
, Qt
))
887 readcharfun
= Qread_char
;
890 if (EQ (readcharfun
, Qread_char
))
891 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
894 if (STRINGP (readcharfun
))
895 return Fcar (Fread_from_string (readcharfun
, Qnil
, Qnil
));
897 return read0 (readcharfun
);
900 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
901 "Read one Lisp expression which is represented as text by STRING.\n\
902 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
903 START and END optionally delimit a substring of STRING from which to read;\n\
904 they default to 0 and (length STRING) respectively.")
906 Lisp_Object string
, start
, end
;
908 int startval
, endval
;
911 CHECK_STRING (string
,0);
914 endval
= XSTRING (string
)->size
;
916 { CHECK_NUMBER (end
,2);
918 if (endval
< 0 || endval
> XSTRING (string
)->size
)
919 args_out_of_range (string
, end
);
925 { CHECK_NUMBER (start
,1);
926 startval
= XINT (start
);
927 if (startval
< 0 || startval
> endval
)
928 args_out_of_range (string
, start
);
931 read_from_string_index
= startval
;
932 read_from_string_limit
= endval
;
934 tem
= read0 (string
);
935 return Fcons (tem
, make_number (read_from_string_index
));
938 /* Use this for recursive reads, in contexts where internal tokens
942 Lisp_Object readcharfun
;
944 register Lisp_Object val
;
947 val
= read1 (readcharfun
, &c
);
949 Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
954 static int read_buffer_size
;
955 static char *read_buffer
;
958 read_escape (readcharfun
)
959 Lisp_Object readcharfun
;
961 register int c
= READCHAR
;
988 error ("Invalid escape character syntax");
991 c
= read_escape (readcharfun
);
992 return c
| meta_modifier
;
997 error ("Invalid escape character syntax");
1000 c
= read_escape (readcharfun
);
1001 if ((c
& 0xff) >= 'a' && (c
& 0xff) <= 'z')
1002 return c
- ('a' - 'A');
1003 return c
| shift_modifier
;
1008 error ("Invalid escape character syntax");
1011 c
= read_escape (readcharfun
);
1012 return c
| hyper_modifier
;
1017 error ("Invalid escape character syntax");
1020 c
= read_escape (readcharfun
);
1021 return c
| alt_modifier
;
1026 error ("Invalid escape character syntax");
1029 c
= read_escape (readcharfun
);
1030 return c
| super_modifier
;
1035 error ("Invalid escape character syntax");
1039 c
= read_escape (readcharfun
);
1040 if ((c
& 0177) == '?')
1042 /* ASCII control chars are made from letters (both cases),
1043 as well as the non-letters within 0100...0137. */
1044 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1045 return (c
& (037 | ~0177));
1046 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1047 return (c
& (037 | ~0177));
1049 return c
| ctrl_modifier
;
1059 /* An octal escape, as in ANSI C. */
1061 register int i
= c
- '0';
1062 register int count
= 0;
1065 if ((c
= READCHAR
) >= '0' && c
<= '7')
1080 /* A hex escape, as in ANSI C. */
1086 if (c
>= '0' && c
<= '9')
1091 else if ((c
>= 'a' && c
<= 'f')
1092 || (c
>= 'A' && c
<= 'F'))
1095 if (c
>= 'a' && c
<= 'f')
1114 /* If the next token is ')' or ']' or '.', we store that character
1115 in *PCH and the return value is not interesting. Else, we store
1116 zero in *PCH and we read and return one lisp object. */
1118 read1 (readcharfun
, pch
)
1119 register Lisp_Object readcharfun
;
1128 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1133 return read_list (0, readcharfun
);
1136 return read_vector (readcharfun
);
1149 /* Accept compiled functions at read-time so that we don't have to
1150 build them using function calls. */
1152 tmp
= read_vector (readcharfun
);
1153 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1154 XVECTOR (tmp
)->contents
);
1156 #ifdef USE_TEXT_PROPERTIES
1160 struct gcpro gcpro1
;
1163 /* Read the string itself. */
1164 tmp
= read1 (readcharfun
, &ch
);
1165 if (ch
!= 0 || !STRINGP (tmp
))
1166 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1168 /* Read the intervals and their properties. */
1171 Lisp_Object beg
, end
, plist
;
1173 beg
= read1 (readcharfun
, &ch
);
1177 end
= read1 (readcharfun
, &ch
);
1179 plist
= read1 (readcharfun
, &ch
);
1181 Fsignal (Qinvalid_read_syntax
,
1182 Fcons (build_string ("invalid string property list"),
1184 Fset_text_properties (beg
, end
, plist
, tmp
);
1190 /* #@NUMBER is used to skip NUMBER following characters.
1191 That's used in .elc files to skip over doc strings
1192 and function definitions. */
1197 /* Read a decimal integer. */
1198 while ((c
= READCHAR
) >= 0
1199 && c
>= '0' && c
<= '9')
1207 /* Skip that many characters. */
1208 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1213 return Vload_file_name
;
1216 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1219 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1224 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1229 register Lisp_Object val
;
1232 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1235 XSETINT (val
, read_escape (readcharfun
));
1244 register char *p
= read_buffer
;
1245 register char *end
= read_buffer
+ read_buffer_size
;
1249 while ((c
= READCHAR
) >= 0
1254 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1255 p
+= new - read_buffer
;
1256 read_buffer
+= new - read_buffer
;
1257 end
= read_buffer
+ read_buffer_size
;
1260 c
= read_escape (readcharfun
);
1261 /* c is -1 if \ newline has just been seen */
1264 if (p
== read_buffer
)
1269 /* Allow `\C- ' and `\C-?'. */
1270 if (c
== (CHAR_CTL
| ' '))
1272 else if (c
== (CHAR_CTL
| '?'))
1276 /* Move the meta bit to the right place for a string. */
1277 c
= (c
& ~CHAR_META
) | 0x80;
1279 error ("Invalid modifier in string");
1283 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1285 /* If purifying, and string starts with \ newline,
1286 return zero instead. This is for doc strings
1287 that we are really going to find in etc/DOC.nn.nn */
1288 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1289 return make_number (0);
1292 return make_pure_string (read_buffer
, p
- read_buffer
);
1294 return make_string (read_buffer
, p
- read_buffer
);
1299 #ifdef LISP_FLOAT_TYPE
1300 /* If a period is followed by a number, then we should read it
1301 as a floating point number. Otherwise, it denotes a dotted
1303 int next_char
= READCHAR
;
1306 if (! (next_char
>= '0' && next_char
<= '9'))
1313 /* Otherwise, we fall through! Note that the atom-reading loop
1314 below will now loop at least once, assuring that we will not
1315 try to UNREAD two characters in a row. */
1318 if (c
<= 040) goto retry
;
1320 register char *p
= read_buffer
;
1324 register char *end
= read_buffer
+ read_buffer_size
;
1327 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1328 || c
== '(' || c
== ')'
1329 #ifndef LISP_FLOAT_TYPE
1330 /* If we have floating-point support, then we need
1331 to allow <digits><dot><digits>. */
1333 #endif /* not LISP_FLOAT_TYPE */
1334 || c
== '[' || c
== ']' || c
== '#'
1339 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1340 p
+= new - read_buffer
;
1341 read_buffer
+= new - read_buffer
;
1342 end
= read_buffer
+ read_buffer_size
;
1355 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1356 p
+= new - read_buffer
;
1357 read_buffer
+= new - read_buffer
;
1358 /* end = read_buffer + read_buffer_size; */
1368 register Lisp_Object val
;
1370 if (*p1
== '+' || *p1
== '-') p1
++;
1371 /* Is it an integer? */
1374 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1375 #ifdef LISP_FLOAT_TYPE
1376 /* Integers can have trailing decimal points. */
1377 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
1380 /* It is an integer. */
1382 #ifdef LISP_FLOAT_TYPE
1386 XSETINT (val
, atoi (read_buffer
));
1390 #ifdef LISP_FLOAT_TYPE
1391 if (isfloat_string (read_buffer
))
1392 return make_float (atof (read_buffer
));
1396 return intern (read_buffer
);
1401 #ifdef LISP_FLOAT_TYPE
1416 if (*cp
== '+' || *cp
== '-')
1419 if (*cp
>= '0' && *cp
<= '9')
1422 while (*cp
>= '0' && *cp
<= '9')
1430 if (*cp
>= '0' && *cp
<= '9')
1433 while (*cp
>= '0' && *cp
<= '9')
1441 if ((*cp
== '+') || (*cp
== '-'))
1444 if (*cp
>= '0' && *cp
<= '9')
1447 while (*cp
>= '0' && *cp
<= '9')
1451 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1452 || state
== (DOT_CHAR
|TRAIL_INT
)
1453 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1454 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1455 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1457 #endif /* LISP_FLOAT_TYPE */
1460 read_vector (readcharfun
)
1461 Lisp_Object readcharfun
;
1465 register Lisp_Object
*ptr
;
1466 register Lisp_Object tem
, vector
;
1467 register struct Lisp_Cons
*otem
;
1470 tem
= read_list (1, readcharfun
);
1471 len
= Flength (tem
);
1472 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1475 size
= XVECTOR (vector
)->size
;
1476 ptr
= XVECTOR (vector
)->contents
;
1477 for (i
= 0; i
< size
; i
++)
1479 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1487 /* flag = 1 means check for ] to terminate rather than ) and .
1488 flag = -1 means check for starting with defun
1489 and make structure pure. */
1492 read_list (flag
, readcharfun
)
1494 register Lisp_Object readcharfun
;
1496 /* -1 means check next element for defun,
1497 0 means don't check,
1498 1 means already checked and found defun. */
1499 int defunflag
= flag
< 0 ? -1 : 0;
1500 Lisp_Object val
, tail
;
1501 register Lisp_Object elt
, tem
;
1502 struct gcpro gcpro1
, gcpro2
;
1512 elt
= read1 (readcharfun
, &ch
);
1515 /* If purifying, and the list starts with #$,
1516 return 0 instead. This is a doc string reference
1517 and it will be replaced anyway by Snarf-documentation,
1518 so don't waste pure space with it. */
1519 if (EQ (elt
, Vload_file_name
)
1520 && !NILP (Vpurify_flag
) && NILP (Vdoc_file_name
))
1529 Fsignal (Qinvalid_read_syntax
, Fcons (make_string (") or . in a vector", 18), Qnil
));
1537 XCONS (tail
)->cdr
= read0 (readcharfun
);
1539 val
= read0 (readcharfun
);
1540 read1 (readcharfun
, &ch
);
1543 return (cancel
? make_number (0) : val
);
1544 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1546 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1548 tem
= (read_pure
&& flag
<= 0
1549 ? pure_cons (elt
, Qnil
)
1550 : Fcons (elt
, Qnil
));
1552 XCONS (tail
)->cdr
= tem
;
1557 defunflag
= EQ (elt
, Qdefun
);
1558 else if (defunflag
> 0)
1563 Lisp_Object Vobarray
;
1564 Lisp_Object initial_obarray
;
1567 check_obarray (obarray
)
1568 Lisp_Object obarray
;
1570 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
1572 /* If Vobarray is now invalid, force it to be valid. */
1573 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
1575 obarray
= wrong_type_argument (Qvectorp
, obarray
);
1580 static int hash_string ();
1581 Lisp_Object
oblookup ();
1588 int len
= strlen (str
);
1589 Lisp_Object obarray
;
1592 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
1593 obarray
= check_obarray (obarray
);
1594 tem
= oblookup (obarray
, str
, len
);
1597 return Fintern ((!NILP (Vpurify_flag
)
1598 ? make_pure_string (str
, len
)
1599 : make_string (str
, len
)),
1603 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
1604 "Return the canonical symbol whose name is STRING.\n\
1605 If there is none, one is created by this function and returned.\n\
1606 A second optional argument specifies the obarray to use;\n\
1607 it defaults to the value of `obarray'.")
1609 Lisp_Object str
, obarray
;
1611 register Lisp_Object tem
, sym
, *ptr
;
1613 if (NILP (obarray
)) obarray
= Vobarray
;
1614 obarray
= check_obarray (obarray
);
1616 CHECK_STRING (str
, 0);
1618 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1619 if (!INTEGERP (tem
))
1622 if (!NILP (Vpurify_flag
))
1623 str
= Fpurecopy (str
);
1624 sym
= Fmake_symbol (str
);
1626 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
1628 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
1630 XSYMBOL (sym
)->next
= 0;
1635 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
1636 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
1637 A second optional argument specifies the obarray to use;\n\
1638 it defaults to the value of `obarray'.")
1640 Lisp_Object str
, obarray
;
1642 register Lisp_Object tem
;
1644 if (NILP (obarray
)) obarray
= Vobarray
;
1645 obarray
= check_obarray (obarray
);
1647 CHECK_STRING (str
, 0);
1649 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1650 if (!INTEGERP (tem
))
1656 oblookup (obarray
, ptr
, size
)
1657 Lisp_Object obarray
;
1663 register Lisp_Object tail
;
1664 Lisp_Object bucket
, tem
;
1666 if (!VECTORP (obarray
)
1667 || (obsize
= XVECTOR (obarray
)->size
) == 0)
1669 obarray
= check_obarray (obarray
);
1670 obsize
= XVECTOR (obarray
)->size
;
1672 /* Combining next two lines breaks VMS C 2.3. */
1673 hash
= hash_string (ptr
, size
);
1675 bucket
= XVECTOR (obarray
)->contents
[hash
];
1676 if (XFASTINT (bucket
) == 0)
1678 else if (!SYMBOLP (bucket
))
1679 error ("Bad data in guts of obarray"); /* Like CADR error message */
1680 else for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
1682 if (XSYMBOL (tail
)->name
->size
== size
&&
1683 !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
1685 else if (XSYMBOL (tail
)->next
== 0)
1688 XSETINT (tem
, hash
);
1693 hash_string (ptr
, len
)
1697 register unsigned char *p
= ptr
;
1698 register unsigned char *end
= p
+ len
;
1699 register unsigned char c
;
1700 register int hash
= 0;
1705 if (c
>= 0140) c
-= 40;
1706 hash
= ((hash
<<3) + (hash
>>28) + c
);
1708 return hash
& 07777777777;
1712 map_obarray (obarray
, fn
, arg
)
1713 Lisp_Object obarray
;
1718 register Lisp_Object tail
;
1719 CHECK_VECTOR (obarray
, 1);
1720 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
1722 tail
= XVECTOR (obarray
)->contents
[i
];
1723 if (XFASTINT (tail
) != 0)
1727 if (XSYMBOL (tail
)->next
== 0)
1729 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
1734 mapatoms_1 (sym
, function
)
1735 Lisp_Object sym
, function
;
1737 call1 (function
, sym
);
1740 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
1741 "Call FUNCTION on every symbol in OBARRAY.\n\
1742 OBARRAY defaults to the value of `obarray'.")
1744 Lisp_Object function
, obarray
;
1748 if (NILP (obarray
)) obarray
= Vobarray
;
1749 obarray
= check_obarray (obarray
);
1751 map_obarray (obarray
, mapatoms_1
, function
);
1755 #define OBARRAY_SIZE 1511
1760 Lisp_Object oblength
;
1764 XSETFASTINT (oblength
, OBARRAY_SIZE
);
1766 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
1767 Vobarray
= Fmake_vector (oblength
, make_number (0));
1768 initial_obarray
= Vobarray
;
1769 staticpro (&initial_obarray
);
1770 /* Intern nil in the obarray */
1771 /* These locals are to kludge around a pyramid compiler bug. */
1772 hash
= hash_string ("nil", 3);
1773 /* Separate statement here to avoid VAXC bug. */
1774 hash
%= OBARRAY_SIZE
;
1775 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
1778 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
1779 XSYMBOL (Qnil
)->function
= Qunbound
;
1780 XSYMBOL (Qunbound
)->value
= Qunbound
;
1781 XSYMBOL (Qunbound
)->function
= Qunbound
;
1784 XSYMBOL (Qnil
)->value
= Qnil
;
1785 XSYMBOL (Qnil
)->plist
= Qnil
;
1786 XSYMBOL (Qt
)->value
= Qt
;
1788 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
1791 Qvariable_documentation
= intern ("variable-documentation");
1793 read_buffer_size
= 100;
1794 read_buffer
= (char *) malloc (read_buffer_size
);
1799 struct Lisp_Subr
*sname
;
1802 sym
= intern (sname
->symbol_name
);
1803 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
1806 #ifdef NOTDEF /* use fset in subr.el now */
1808 defalias (sname
, string
)
1809 struct Lisp_Subr
*sname
;
1813 sym
= intern (string
);
1814 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
1818 /* Define an "integer variable"; a symbol whose value is forwarded
1819 to a C variable of type int. Sample call: */
1820 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
1822 defvar_int (namestring
, address
)
1826 Lisp_Object sym
, val
;
1827 sym
= intern (namestring
);
1828 val
= allocate_misc ();
1829 XMISC (val
)->type
= Lisp_Misc_Intfwd
;
1830 XINTFWD (val
)->intvar
= address
;
1831 XSYMBOL (sym
)->value
= val
;
1834 /* Similar but define a variable whose value is T if address contains 1,
1835 NIL if address contains 0 */
1837 defvar_bool (namestring
, address
)
1841 Lisp_Object sym
, val
;
1842 sym
= intern (namestring
);
1843 val
= allocate_misc ();
1844 XMISC (val
)->type
= Lisp_Misc_Boolfwd
;
1845 XBOOLFWD (val
)->boolvar
= address
;
1846 XSYMBOL (sym
)->value
= val
;
1849 /* Similar but define a variable whose value is the Lisp Object stored
1850 at address. Two versions: with and without gc-marking of the C
1851 variable. The nopro version is used when that variable will be
1852 gc-marked for some other reason, since marking the same slot twice
1853 can cause trouble with strings. */
1855 defvar_lisp_nopro (namestring
, address
)
1857 Lisp_Object
*address
;
1859 Lisp_Object sym
, val
;
1860 sym
= intern (namestring
);
1861 val
= allocate_misc ();
1862 XMISC (val
)->type
= Lisp_Misc_Objfwd
;
1863 XOBJFWD (val
)->objvar
= address
;
1864 XSYMBOL (sym
)->value
= val
;
1868 defvar_lisp (namestring
, address
)
1870 Lisp_Object
*address
;
1872 defvar_lisp_nopro (namestring
, address
);
1873 staticpro (address
);
1878 /* Similar but define a variable whose value is the Lisp Object stored in
1879 the current buffer. address is the address of the slot in the buffer
1880 that is current now. */
1883 defvar_per_buffer (namestring
, address
, type
, doc
)
1885 Lisp_Object
*address
;
1889 Lisp_Object sym
, val
;
1891 extern struct buffer buffer_local_symbols
;
1893 sym
= intern (namestring
);
1894 val
= allocate_misc ();
1895 offset
= (char *)address
- (char *)current_buffer
;
1897 XMISC (val
)->type
= Lisp_Misc_Buffer_Objfwd
;
1898 XBUFFER_OBJFWD (val
)->offset
= offset
;
1899 XSYMBOL (sym
)->value
= val
;
1900 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
1901 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
1902 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
1903 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
1904 slot of buffer_local_flags */
1908 #endif /* standalone */
1910 /* Similar but define a variable whose value is the Lisp Object stored
1911 at a particular offset in the current perdisplay object. */
1914 defvar_display (namestring
, offset
)
1918 Lisp_Object sym
, val
;
1919 sym
= intern (namestring
);
1920 val
= allocate_misc ();
1921 XMISC (val
)->type
= Lisp_Misc_Display_Objfwd
;
1922 XDISPLAY_OBJFWD (val
)->offset
= offset
;
1923 XSYMBOL (sym
)->value
= val
;
1930 /* Compute the default load-path. */
1932 normal
= PATH_LOADSEARCH
;
1933 Vload_path
= decode_env_path (0, normal
);
1935 if (NILP (Vpurify_flag
))
1936 normal
= PATH_LOADSEARCH
;
1938 normal
= PATH_DUMPLOADSEARCH
;
1940 /* In a dumped Emacs, we normally have to reset the value of
1941 Vload_path from PATH_LOADSEARCH, since the value that was dumped
1942 uses ../lisp, instead of the path of the installed elisp
1943 libraries. However, if it appears that Vload_path was changed
1944 from the default before dumping, don't override that value. */
1947 Lisp_Object dump_path
;
1949 dump_path
= decode_env_path (0, PATH_DUMPLOADSEARCH
);
1950 if (! NILP (Fequal (dump_path
, Vload_path
)))
1952 Vload_path
= decode_env_path (0, normal
);
1953 if (!NILP (Vinstallation_directory
))
1955 /* Add to the path the lisp subdir of the
1956 installation dir, if it exists. */
1957 Lisp_Object tem
, tem1
;
1958 tem
= Fexpand_file_name (build_string ("lisp"),
1959 Vinstallation_directory
);
1960 tem1
= Ffile_exists_p (tem
);
1963 if (NILP (Fmember (tem
, Vload_path
)))
1964 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
1967 /* That dir doesn't exist, so add the build-time
1968 Lisp dirs instead. */
1969 Vload_path
= nconc2 (Vload_path
, dump_path
);
1974 Vload_path
= decode_env_path (0, normal
);
1978 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
1979 almost never correct, thereby causing a warning to be printed out that
1980 confuses users. Since PATH_LOADSEARCH is always overriden by the
1981 EMACSLOADPATH environment variable below, disable the warning on NT. */
1983 /* Warn if dirs in the *standard* path don't exist. */
1985 Lisp_Object path_tail
;
1987 for (path_tail
= Vload_path
;
1989 path_tail
= XCONS (path_tail
)->cdr
)
1991 Lisp_Object dirfile
;
1992 dirfile
= Fcar (path_tail
);
1993 if (STRINGP (dirfile
))
1995 dirfile
= Fdirectory_file_name (dirfile
);
1996 if (access (XSTRING (dirfile
)->data
, 0) < 0)
1998 "Warning: Lisp directory `%s' does not exist.\n",
1999 XSTRING (Fcar (path_tail
))->data
);
2003 #endif /* WINDOWSNT */
2005 /* If the EMACSLOADPATH environment variable is set, use its value.
2006 This doesn't apply if we're dumping. */
2007 if (NILP (Vpurify_flag
)
2008 && egetenv ("EMACSLOADPATH"))
2009 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
2013 load_in_progress
= 0;
2015 load_descriptor_list
= Qnil
;
2022 defsubr (&Sread_from_string
);
2024 defsubr (&Sintern_soft
);
2026 defsubr (&Seval_buffer
);
2027 defsubr (&Seval_region
);
2028 defsubr (&Sread_char
);
2029 defsubr (&Sread_char_exclusive
);
2030 defsubr (&Sread_event
);
2031 defsubr (&Sget_file_char
);
2032 defsubr (&Smapatoms
);
2034 DEFVAR_LISP ("obarray", &Vobarray
,
2035 "Symbol table for use by `intern' and `read'.\n\
2036 It is a vector whose length ought to be prime for best results.\n\
2037 The vector's contents don't make sense if examined from Lisp programs;\n\
2038 to find all the symbols in an obarray, use `mapatoms'.");
2040 DEFVAR_LISP ("values", &Vvalues
,
2041 "List of values of all expressions which were read, evaluated and printed.\n\
2042 Order is reverse chronological.");
2044 DEFVAR_LISP ("standard-input", &Vstandard_input
,
2045 "Stream for read to get input from.\n\
2046 See documentation of `read' for possible values.");
2047 Vstandard_input
= Qt
;
2049 DEFVAR_LISP ("load-path", &Vload_path
,
2050 "*List of directories to search for files to load.\n\
2051 Each element is a string (directory name) or nil (try default directory).\n\
2052 Initialized based on EMACSLOADPATH environment variable, if any,\n\
2053 otherwise to default specified by file `paths.h' when Emacs was built.");
2055 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
2056 "Non-nil iff inside of `load'.");
2058 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
2059 "An alist of expressions to be evalled when particular files are loaded.\n\
2060 Each element looks like (FILENAME FORMS...).\n\
2061 When `load' is run and the file-name argument is FILENAME,\n\
2062 the FORMS in the corresponding element are executed at the end of loading.\n\n\
2063 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
2064 with no directory specified, since that is how `load' is normally called.\n\
2065 An error in FORMS does not undo the load,\n\
2066 but does prevent execution of the rest of the FORMS.");
2067 Vafter_load_alist
= Qnil
;
2069 DEFVAR_LISP ("load-history", &Vload_history
,
2070 "Alist mapping source file names to symbols and features.\n\
2071 Each alist element is a list that starts with a file name,\n\
2072 except for one element (optional) that starts with nil and describes\n\
2073 definitions evaluated from buffers not visiting files.\n\
2074 The remaining elements of each list are symbols defined as functions\n\
2075 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2076 Vload_history
= Qnil
;
2078 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
2079 "Full name of file being loaded by `load'.");
2080 Vload_file_name
= Qnil
;
2082 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
2083 "Used for internal purposes by `load'.");
2084 Vcurrent_load_list
= Qnil
;
2086 load_descriptor_list
= Qnil
;
2087 staticpro (&load_descriptor_list
);
2089 Qcurrent_load_list
= intern ("current-load-list");
2090 staticpro (&Qcurrent_load_list
);
2092 Qstandard_input
= intern ("standard-input");
2093 staticpro (&Qstandard_input
);
2095 Qread_char
= intern ("read-char");
2096 staticpro (&Qread_char
);
2098 Qget_file_char
= intern ("get-file-char");
2099 staticpro (&Qget_file_char
);
2101 Qascii_character
= intern ("ascii-character");
2102 staticpro (&Qascii_character
);
2104 Qload
= intern ("load");
2107 Qload_file_name
= intern ("load-file-name");
2108 staticpro (&Qload_file_name
);