1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 1998
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 */
59 #ifdef LISP_FLOAT_TYPE
65 #endif /* LISP_FLOAT_TYPE */
69 #endif /* HAVE_SETLOCALE */
77 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
78 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
79 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
80 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
81 Lisp_Object Qinhibit_file_name_operation
;
83 extern Lisp_Object Qevent_symbol_element_mask
;
84 extern Lisp_Object Qfile_exists_p
;
86 /* non-zero if inside `load' */
89 /* Directory in which the sources were found. */
90 Lisp_Object Vsource_directory
;
92 /* Search path for files to be loaded. */
93 Lisp_Object Vload_path
;
95 /* This is the user-visible association list that maps features to
96 lists of defs in their load files. */
97 Lisp_Object Vload_history
;
99 /* This is used to build the load history. */
100 Lisp_Object Vcurrent_load_list
;
102 /* List of files that were preloaded. */
103 Lisp_Object Vpreloaded_file_list
;
105 /* Name of file actually being read by `load'. */
106 Lisp_Object Vload_file_name
;
108 /* Function to use for reading, in `load' and friends. */
109 Lisp_Object Vload_read_function
;
111 /* The association list of objects read with the #n=object form.
112 Each member of the list has the form (n . object), and is used to
113 look up the object for the corresponding #n# construct.
114 It must be set to nil before all top-level calls to read0. */
115 Lisp_Object read_objects
;
117 /* Nonzero means load should forcibly load all dynamic doc strings. */
118 static int load_force_doc_strings
;
120 /* Nonzero means read should convert strings to unibyte. */
121 static int load_convert_to_unibyte
;
123 /* Function to use for loading an Emacs lisp source file (not
124 compiled) instead of readevalloop. */
125 Lisp_Object Vload_source_file_function
;
127 /* List of descriptors now open for Fload. */
128 static Lisp_Object load_descriptor_list
;
130 /* File for get_file_char to read from. Use by load. */
131 static FILE *instream
;
133 /* When nonzero, read conses in pure space */
134 static int read_pure
;
136 /* For use within read-from-string (this reader is non-reentrant!!) */
137 static int read_from_string_index
;
138 static int read_from_string_index_byte
;
139 static int read_from_string_limit
;
141 /* Number of bytes left to read in the buffer character
142 that `readchar' has already advanced over. */
143 static int readchar_backlog
;
145 /* This contains the last string skipped with #@, but only on some systems.
146 On other systems we can't put the string here. */
147 static char *saved_doc_string
;
148 /* Length of buffer allocated in saved_doc_string. */
149 static int saved_doc_string_size
;
150 /* Length of actual data in saved_doc_string. */
151 static int saved_doc_string_length
;
152 /* This is the file position that string came from. */
153 static int saved_doc_string_position
;
155 /* Nonzero means inside a new-style backquote
156 with no surrounding parentheses.
157 Fread initializes this to zero, so we need not specbind it
158 or worry about what happens to it when there is an error. */
159 static int new_backquote_flag
;
161 /* Handle unreading and rereading of characters.
162 Write READCHAR to read a character,
163 UNREAD(c) to unread c to be read again.
165 These macros actually read/unread a byte code, multibyte characters
166 are not handled here. The caller should manage them if necessary.
169 #define READCHAR readchar (readcharfun)
170 #define UNREAD(c) unreadchar (readcharfun, c)
173 readchar (readcharfun
)
174 Lisp_Object readcharfun
;
177 register int c
, mpos
;
179 if (BUFFERP (readcharfun
))
181 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
183 int pt_byte
= BUF_PT_BYTE (inbuffer
);
184 int orig_pt_byte
= pt_byte
;
186 if (readchar_backlog
> 0)
187 /* We get the address of the byte just passed,
188 which is the last byte of the character.
189 The other bytes in this character are consecutive with it,
190 because the gap can't be in the middle of a character. */
191 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
192 - --readchar_backlog
);
194 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
197 readchar_backlog
= -1;
199 if (! NILP (inbuffer
->enable_multibyte_characters
))
201 unsigned char workbuf
[4];
202 unsigned char *str
= workbuf
;
205 /* Fetch the character code from the buffer. */
206 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
207 BUF_INC_POS (inbuffer
, pt_byte
);
208 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
210 /* Find the byte-sequence representation of that character. */
211 if (SINGLE_BYTE_CHAR_P (c
))
212 length
= 1, workbuf
[0] = c
;
214 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
216 /* If the bytes for this character in the buffer
217 are not identical with what the character code implies,
218 read the bytes one by one from the buffer. */
219 if (length
!= pt_byte
- orig_pt_byte
220 || (length
== 1 ? *str
!= *p
: bcmp (str
, p
, length
)))
222 readchar_backlog
= pt_byte
- orig_pt_byte
;
223 c
= BUF_FETCH_BYTE (inbuffer
, orig_pt_byte
);
229 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
232 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
236 if (MARKERP (readcharfun
))
238 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
240 int bytepos
= marker_byte_position (readcharfun
);
241 int orig_bytepos
= bytepos
;
243 if (readchar_backlog
> 0)
244 /* We get the address of the byte just passed,
245 which is the last byte of the character.
246 The other bytes in this character are consecutive with it,
247 because the gap can't be in the middle of a character. */
248 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
249 - --readchar_backlog
);
251 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
254 readchar_backlog
= -1;
256 if (! NILP (inbuffer
->enable_multibyte_characters
))
258 unsigned char workbuf
[4];
259 unsigned char *str
= workbuf
;
262 /* Fetch the character code from the buffer. */
263 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
264 BUF_INC_POS (inbuffer
, bytepos
);
265 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
267 /* Find the byte-sequence representation of that character. */
268 if (SINGLE_BYTE_CHAR_P (c
))
269 length
= 1, workbuf
[0] = c
;
271 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
273 /* If the bytes for this character in the buffer
274 are not identical with what the character code implies,
275 read the bytes one by one from the buffer. */
276 if (length
!= bytepos
- orig_bytepos
277 || (length
== 1 ? *str
!= *p
: bcmp (str
, p
, length
)))
279 readchar_backlog
= bytepos
- orig_bytepos
;
280 c
= BUF_FETCH_BYTE (inbuffer
, orig_bytepos
);
286 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
290 XMARKER (readcharfun
)->bytepos
= bytepos
;
291 XMARKER (readcharfun
)->charpos
++;
295 if (EQ (readcharfun
, Qget_file_char
))
299 /* Interrupted reads have been observed while reading over the network */
300 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
309 if (STRINGP (readcharfun
))
311 if (read_from_string_index
>= read_from_string_limit
)
313 else if (STRING_MULTIBYTE (readcharfun
))
314 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
315 read_from_string_index
,
316 read_from_string_index_byte
);
318 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
323 tem
= call0 (readcharfun
);
330 /* Unread the character C in the way appropriate for the stream READCHARFUN.
331 If the stream is a user function, call it with the char as argument. */
334 unreadchar (readcharfun
, c
)
335 Lisp_Object readcharfun
;
339 /* Don't back up the pointer if we're unreading the end-of-input mark,
340 since readchar didn't advance it when we read it. */
342 else if (BUFFERP (readcharfun
))
344 struct buffer
*b
= XBUFFER (readcharfun
);
345 int bytepos
= BUF_PT_BYTE (b
);
347 if (readchar_backlog
>= 0)
352 if (! NILP (b
->enable_multibyte_characters
))
353 BUF_DEC_POS (b
, bytepos
);
357 BUF_PT_BYTE (b
) = bytepos
;
360 else if (MARKERP (readcharfun
))
362 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
363 int bytepos
= XMARKER (readcharfun
)->bytepos
;
365 if (readchar_backlog
>= 0)
369 XMARKER (readcharfun
)->charpos
--;
370 if (! NILP (b
->enable_multibyte_characters
))
371 BUF_DEC_POS (b
, bytepos
);
375 XMARKER (readcharfun
)->bytepos
= bytepos
;
378 else if (STRINGP (readcharfun
))
380 read_from_string_index
--;
381 read_from_string_index_byte
382 = string_char_to_byte (readcharfun
, read_from_string_index
);
384 else if (EQ (readcharfun
, Qget_file_char
))
385 ungetc (c
, instream
);
387 call1 (readcharfun
, make_number (c
));
390 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
391 static int read_multibyte ();
393 /* Get a character from the tty. */
395 extern Lisp_Object
read_char ();
397 /* Read input events until we get one that's acceptable for our purposes.
399 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
400 until we get a character we like, and then stuffed into
403 If ASCII_REQUIRED is non-zero, we check function key events to see
404 if the unmodified version of the symbol has a Qascii_character
405 property, and use that character, if present.
407 If ERROR_NONASCII is non-zero, we signal an error if the input we
408 get isn't an ASCII character with modifiers. If it's zero but
409 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
413 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
414 int no_switch_frame
, ascii_required
, error_nonascii
;
417 return make_number (getchar ());
419 register Lisp_Object val
, delayed_switch_frame
;
421 delayed_switch_frame
= Qnil
;
423 /* Read until we get an acceptable event. */
425 val
= read_char (0, 0, 0, Qnil
, 0);
430 /* switch-frame events are put off until after the next ASCII
431 character. This is better than signaling an error just because
432 the last characters were typed to a separate minibuffer frame,
433 for example. Eventually, some code which can deal with
434 switch-frame events will read it and process it. */
436 && EVENT_HAS_PARAMETERS (val
)
437 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
439 delayed_switch_frame
= val
;
445 /* Convert certain symbols to their ASCII equivalents. */
448 Lisp_Object tem
, tem1
, tem2
;
449 tem
= Fget (val
, Qevent_symbol_element_mask
);
452 tem1
= Fget (Fcar (tem
), Qascii_character
);
453 /* Merge this symbol's modifier bits
454 with the ASCII equivalent of its basic code. */
456 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
460 /* If we don't have a character now, deal with it appropriately. */
465 Vunread_command_events
= Fcons (val
, Qnil
);
466 error ("Non-character input-event");
473 if (! NILP (delayed_switch_frame
))
474 unread_switch_frame
= delayed_switch_frame
;
480 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
481 "Read a character from the command input (keyboard or macro).\n\
482 It is returned as a number.\n\
483 If the user generates an event which is not a character (i.e. a mouse\n\
484 click or function key event), `read-char' signals an error. As an\n\
485 exception, switch-frame events are put off until non-ASCII events can\n\
487 If you want to read non-character events, or ignore them, call\n\
488 `read-event' or `read-char-exclusive' instead.")
491 return read_filtered_event (1, 1, 1);
494 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
495 "Read an event object from the input stream.")
498 return read_filtered_event (0, 0, 0);
501 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
502 "Read a character from the command input (keyboard or macro).\n\
503 It is returned as a number. Non-character events are ignored.")
506 return read_filtered_event (1, 1, 0);
509 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
510 "Don't use this yourself.")
513 register Lisp_Object val
;
514 XSETINT (val
, getc (instream
));
518 static void readevalloop ();
519 static Lisp_Object
load_unwind ();
520 static Lisp_Object
load_descriptor_unwind ();
522 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
523 "Execute a file of Lisp code named FILE.\n\
524 First try FILE with `.elc' appended, then try with `.el',\n\
525 then try FILE unmodified.\n\
526 This function searches the directories in `load-path'.\n\
527 If optional second arg NOERROR is non-nil,\n\
528 report no error if FILE doesn't exist.\n\
529 Print messages at start and end of loading unless\n\
530 optional third arg NOMESSAGE is non-nil.\n\
531 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
532 suffixes `.elc' or `.el' to the specified name FILE.\n\
533 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
534 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
535 it ends in one of those suffixes or includes a directory name.\n\
536 Return t if file exists.")
537 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
538 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
540 register FILE *stream
;
541 register int fd
= -1;
542 register Lisp_Object lispstream
;
543 int count
= specpdl_ptr
- specpdl
;
547 /* 1 means we printed the ".el is newer" message. */
549 /* 1 means we are loading a compiled file. */
557 CHECK_STRING (file
, 0);
559 /* If file name is magic, call the handler. */
560 handler
= Ffind_file_name_handler (file
, Qload
);
562 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
564 /* Do this after the handler to avoid
565 the need to gcpro noerror, nomessage and nosuffix.
566 (Below here, we care only whether they are nil or not.) */
567 file
= Fsubstitute_in_file_name (file
);
569 /* Avoid weird lossage with null string as arg,
570 since it would try to load a directory as a Lisp file */
571 if (XSTRING (file
)->size
> 0)
573 int size
= XSTRING (file
)->size
;
577 if (! NILP (must_suffix
))
579 /* Don't insist on adding a suffix if FILE already ends with one. */
581 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
584 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
586 /* Don't insist on adding a suffix
587 if the argument includes a directory name. */
588 else if (! NILP (Ffile_name_directory (file
)))
592 fd
= openp (Vload_path
, file
,
593 (!NILP (nosuffix
) ? ""
594 : ! NILP (must_suffix
) ? ".elc:.el"
604 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
605 Fcons (file
, Qnil
)));
610 /* If FD is 0, that means openp found a remote file. */
613 handler
= Ffind_file_name_handler (found
, Qload
);
614 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
617 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
628 stat ((char *)XSTRING (found
)->data
, &s1
);
629 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
630 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
631 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
633 /* Make the progress messages mention that source is newer. */
636 /* If we won't print another message, mention this anyway. */
637 if (! NILP (nomessage
))
638 message_with_string ("Source file `%s' newer than byte-compiled file",
641 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
645 /* We are loading a source file (*.el). */
646 if (!NILP (Vload_source_file_function
))
649 return call4 (Vload_source_file_function
, found
, file
,
650 NILP (noerror
) ? Qnil
: Qt
,
651 NILP (nomessage
) ? Qnil
: Qt
);
657 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
658 #else /* not WINDOWSNT */
659 stream
= fdopen (fd
, fmode
);
660 #endif /* not WINDOWSNT */
664 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
667 if (! NILP (Vpurify_flag
))
668 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
670 if (NILP (nomessage
))
673 message_with_string ("Loading %s (source)...", file
, 1);
675 message_with_string ("Loading %s (compiled; note, source file is newer)...",
677 else /* The typical case; compiled file newer than source file. */
678 message_with_string ("Loading %s...", file
, 1);
682 lispstream
= Fcons (Qnil
, Qnil
);
683 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
684 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
685 record_unwind_protect (load_unwind
, lispstream
);
686 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
687 specbind (Qload_file_name
, found
);
688 specbind (Qinhibit_file_name_operation
, Qnil
);
690 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
692 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
);
693 unbind_to (count
, Qnil
);
695 /* Run any load-hooks for this file. */
696 temp
= Fassoc (file
, Vafter_load_alist
);
698 Fprogn (Fcdr (temp
));
701 if (saved_doc_string
)
702 free (saved_doc_string
);
703 saved_doc_string
= 0;
704 saved_doc_string_size
= 0;
706 if (!noninteractive
&& NILP (nomessage
))
709 message_with_string ("Loading %s (source)...done", file
, 1);
711 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
713 else /* The typical case; compiled file newer than source file. */
714 message_with_string ("Loading %s...done", file
, 1);
720 load_unwind (stream
) /* used as unwind-protect function in load */
723 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
724 | XFASTINT (XCONS (stream
)->cdr
)));
725 if (--load_in_progress
< 0) load_in_progress
= 0;
730 load_descriptor_unwind (oldlist
)
733 load_descriptor_list
= oldlist
;
737 /* Close all descriptors in use for Floads.
738 This is used when starting a subprocess. */
745 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
746 close (XFASTINT (XCONS (tail
)->car
));
751 complete_filename_p (pathname
)
752 Lisp_Object pathname
;
754 register unsigned char *s
= XSTRING (pathname
)->data
;
755 return (IS_DIRECTORY_SEP (s
[0])
756 || (XSTRING (pathname
)->size
> 2
757 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
767 /* Search for a file whose name is STR, looking in directories
768 in the Lisp list PATH, and trying suffixes from SUFFIX.
769 SUFFIX is a string containing possible suffixes separated by colons.
770 On success, returns a file descriptor. On failure, returns -1.
772 EXEC_ONLY nonzero means don't open the files,
773 just look for one that is executable. In this case,
774 returns 1 on success.
776 If STOREPTR is nonzero, it points to a slot where the name of
777 the file actually found should be stored as a Lisp string.
778 nil is stored there on failure.
780 If the file we find is remote, return 0
781 but store the found remote file name in *STOREPTR.
782 We do not check for remote files if EXEC_ONLY is nonzero. */
785 openp (path
, str
, suffix
, storeptr
, exec_only
)
786 Lisp_Object path
, str
;
788 Lisp_Object
*storeptr
;
794 register char *fn
= buf
;
797 Lisp_Object filename
;
805 if (complete_filename_p (str
))
808 for (; !NILP (path
); path
= Fcdr (path
))
812 filename
= Fexpand_file_name (str
, Fcar (path
));
813 if (!complete_filename_p (filename
))
814 /* If there are non-absolute elts in PATH (eg ".") */
815 /* Of course, this could conceivably lose if luser sets
816 default-directory to be something non-absolute... */
818 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
819 if (!complete_filename_p (filename
))
820 /* Give up on this path element! */
824 /* Calculate maximum size of any filename made from
825 this path element/specified file name and any possible suffix. */
826 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
827 if (fn_size
< want_size
)
828 fn
= (char *) alloca (fn_size
= 100 + want_size
);
832 /* Loop over suffixes. */
835 char *esuffix
= (char *) index (nsuffix
, ':');
836 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
839 /* Concatenate path element/specified name with the suffix.
840 If the directory starts with /:, remove that. */
841 if (XSTRING (filename
)->size
> 2
842 && XSTRING (filename
)->data
[0] == '/'
843 && XSTRING (filename
)->data
[1] == ':')
845 strncpy (fn
, XSTRING (filename
)->data
+ 2,
846 XSTRING (filename
)->size
- 2);
847 fn
[XSTRING (filename
)->size
- 2] = 0;
851 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
852 fn
[XSTRING (filename
)->size
] = 0;
855 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
856 strncat (fn
, nsuffix
, lsuffix
);
858 /* Check that the file exists and is not a directory. */
862 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
863 if (! NILP (handler
) && ! exec_only
)
868 string
= build_string (fn
);
869 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
870 : Ffile_readable_p (string
));
872 && ! NILP (Ffile_directory_p (build_string (fn
))))
877 /* We succeeded; return this descriptor and filename. */
879 *storeptr
= build_string (fn
);
886 int exists
= (stat (fn
, &st
) >= 0
887 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
890 /* Check that we can access or open it. */
892 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
894 fd
= open (fn
, O_RDONLY
, 0);
898 /* We succeeded; return this descriptor and filename. */
900 *storeptr
= build_string (fn
);
907 /* Advance to next suffix. */
910 nsuffix
+= lsuffix
+ 1;
921 /* Merge the list we've accumulated of globals from the current input source
922 into the load_history variable. The details depend on whether
923 the source has an associated file name or not. */
926 build_load_history (stream
, source
)
930 register Lisp_Object tail
, prev
, newelt
;
931 register Lisp_Object tem
, tem2
;
932 register int foundit
, loading
;
934 /* Don't bother recording anything for preloaded files. */
935 if (!NILP (Vpurify_flag
))
938 loading
= stream
|| !NARROWED
;
940 tail
= Vload_history
;
947 /* Find the feature's previous assoc list... */
948 if (!NILP (Fequal (source
, Fcar (tem
))))
952 /* If we're loading, remove it. */
956 Vload_history
= Fcdr (tail
);
958 Fsetcdr (prev
, Fcdr (tail
));
961 /* Otherwise, cons on new symbols that are not already members. */
964 tem2
= Vcurrent_load_list
;
968 newelt
= Fcar (tem2
);
970 if (NILP (Fmemq (newelt
, tem
)))
971 Fsetcar (tail
, Fcons (Fcar (tem
),
972 Fcons (newelt
, Fcdr (tem
))));
985 /* If we're loading, cons the new assoc onto the front of load-history,
986 the most-recently-loaded position. Also do this if we didn't find
987 an existing member for the current source. */
988 if (loading
|| !foundit
)
989 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
994 unreadpure () /* Used as unwind-protect function in readevalloop */
1001 readevalloop_1 (old
)
1004 load_convert_to_unibyte
= ! NILP (old
);
1008 /* UNIBYTE specifies how to set load_convert_to_unibyte
1009 for this invocation. */
1012 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
)
1013 Lisp_Object readcharfun
;
1015 Lisp_Object sourcename
;
1016 Lisp_Object (*evalfun
) ();
1018 Lisp_Object unibyte
;
1021 register Lisp_Object val
;
1022 int count
= specpdl_ptr
- specpdl
;
1023 struct gcpro gcpro1
;
1024 struct buffer
*b
= 0;
1026 if (BUFFERP (readcharfun
))
1027 b
= XBUFFER (readcharfun
);
1028 else if (MARKERP (readcharfun
))
1029 b
= XMARKER (readcharfun
)->buffer
;
1031 specbind (Qstandard_input
, readcharfun
);
1032 specbind (Qcurrent_load_list
, Qnil
);
1033 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1034 load_convert_to_unibyte
= !NILP (unibyte
);
1036 readchar_backlog
= -1;
1038 GCPRO1 (sourcename
);
1040 LOADHIST_ATTACH (sourcename
);
1044 if (b
!= 0 && NILP (b
->name
))
1045 error ("Reading from killed buffer");
1051 while ((c
= READCHAR
) != '\n' && c
!= -1);
1056 /* Ignore whitespace here, so we can detect eof. */
1057 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1060 if (!NILP (Vpurify_flag
) && c
== '(')
1062 int count1
= specpdl_ptr
- specpdl
;
1063 record_unwind_protect (unreadpure
, Qnil
);
1064 val
= read_list (-1, readcharfun
);
1065 unbind_to (count1
, Qnil
);
1070 read_objects
= Qnil
;
1071 if (NILP (Vload_read_function
))
1072 val
= read0 (readcharfun
);
1074 val
= call1 (Vload_read_function
, readcharfun
);
1077 val
= (*evalfun
) (val
);
1080 Vvalues
= Fcons (val
, Vvalues
);
1081 if (EQ (Vstandard_output
, Qt
))
1088 build_load_history (stream
, sourcename
);
1091 unbind_to (count
, Qnil
);
1096 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 4, "",
1097 "Execute the current buffer as Lisp code.\n\
1098 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1099 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1100 PRINTFLAG controls printing of output:\n\
1101 nil means discard it; anything else is stream for print.\n\
1103 If the optional third argument FILENAME is non-nil,\n\
1104 it specifies the file name to use for `load-history'.\n\
1106 This function preserves the position of point.")
1107 (buffer
, printflag
, filename
, unibyte
)
1108 Lisp_Object buffer
, printflag
, filename
, unibyte
;
1110 int count
= specpdl_ptr
- specpdl
;
1111 Lisp_Object tem
, buf
;
1114 buf
= Fcurrent_buffer ();
1116 buf
= Fget_buffer (buffer
);
1118 error ("No such buffer");
1120 if (NILP (printflag
))
1125 if (NILP (filename
))
1126 filename
= XBUFFER (buf
)->filename
;
1128 specbind (Qstandard_output
, tem
);
1129 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1130 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1131 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
);
1132 unbind_to (count
, Qnil
);
1138 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1139 "Execute the current buffer as Lisp code.\n\
1140 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1141 nil means discard it; anything else is stream for print.\n\
1143 If there is no error, point does not move. If there is an error,\n\
1144 point remains at the end of the last character read from the buffer.")
1146 Lisp_Object printflag
;
1148 int count
= specpdl_ptr
- specpdl
;
1149 Lisp_Object tem
, cbuf
;
1151 cbuf
= Fcurrent_buffer ()
1153 if (NILP (printflag
))
1157 specbind (Qstandard_output
, tem
);
1158 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1160 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1161 !NILP (printflag
), Qnil
);
1162 return unbind_to (count
, Qnil
);
1166 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
1167 "Execute the region as Lisp code.\n\
1168 When called from programs, expects two arguments,\n\
1169 giving starting and ending indices in the current buffer\n\
1170 of the text to be executed.\n\
1171 Programs can pass third argument PRINTFLAG which controls output:\n\
1172 nil means discard it; anything else is stream for printing it.\n\
1174 This function does not move point.")
1175 (start
, end
, printflag
)
1176 Lisp_Object start
, end
, printflag
;
1178 int count
= specpdl_ptr
- specpdl
;
1179 Lisp_Object tem
, cbuf
;
1181 cbuf
= Fcurrent_buffer ();
1183 if (NILP (printflag
))
1187 specbind (Qstandard_output
, tem
);
1189 if (NILP (printflag
))
1190 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1191 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1193 /* This both uses start and checks its type. */
1195 Fnarrow_to_region (make_number (BEGV
), end
);
1196 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1197 !NILP (printflag
), Qnil
);
1199 return unbind_to (count
, Qnil
);
1202 #endif /* standalone */
1204 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1205 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1206 If STREAM is nil, use the value of `standard-input' (which see).\n\
1207 STREAM or the value of `standard-input' may be:\n\
1208 a buffer (read from point and advance it)\n\
1209 a marker (read from where it points and advance it)\n\
1210 a function (call it with no arguments for each character,\n\
1211 call it with a char as argument to push a char back)\n\
1212 a string (takes text from string, starting at the beginning)\n\
1213 t (read text line using minibuffer and use it).")
1217 extern Lisp_Object
Fread_minibuffer ();
1220 stream
= Vstandard_input
;
1221 if (EQ (stream
, Qt
))
1222 stream
= Qread_char
;
1224 readchar_backlog
= -1;
1225 new_backquote_flag
= 0;
1226 read_objects
= Qnil
;
1229 if (EQ (stream
, Qread_char
))
1230 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1233 if (STRINGP (stream
))
1234 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1236 return read0 (stream
);
1239 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1240 "Read one Lisp expression which is represented as text by STRING.\n\
1241 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1242 START and END optionally delimit a substring of STRING from which to read;\n\
1243 they default to 0 and (length STRING) respectively.")
1244 (string
, start
, end
)
1245 Lisp_Object string
, start
, end
;
1247 int startval
, endval
;
1250 CHECK_STRING (string
,0);
1253 endval
= XSTRING (string
)->size
;
1256 CHECK_NUMBER (end
, 2);
1257 endval
= XINT (end
);
1258 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1259 args_out_of_range (string
, end
);
1266 CHECK_NUMBER (start
, 1);
1267 startval
= XINT (start
);
1268 if (startval
< 0 || startval
> endval
)
1269 args_out_of_range (string
, start
);
1272 read_from_string_index
= startval
;
1273 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1274 read_from_string_limit
= endval
;
1276 new_backquote_flag
= 0;
1277 read_objects
= Qnil
;
1279 tem
= read0 (string
);
1280 return Fcons (tem
, make_number (read_from_string_index
));
1283 /* Use this for recursive reads, in contexts where internal tokens
1288 Lisp_Object readcharfun
;
1290 register Lisp_Object val
;
1293 val
= read1 (readcharfun
, &c
, 0);
1295 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1302 static int read_buffer_size
;
1303 static char *read_buffer
;
1305 /* Read multibyte form and return it as a character. C is a first
1306 byte of multibyte form, and rest of them are read from
1310 read_multibyte (c
, readcharfun
)
1312 Lisp_Object readcharfun
;
1314 /* We need the actual character code of this multibyte
1316 unsigned char str
[MAX_LENGTH_OF_MULTI_BYTE_FORM
];
1320 while ((c
= READCHAR
) >= 0xA0
1321 && len
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1324 return STRING_CHAR (str
, len
);
1327 /* Read a \-escape sequence, assuming we already read the `\'. */
1330 read_escape (readcharfun
, stringp
)
1331 Lisp_Object readcharfun
;
1334 register int c
= READCHAR
;
1338 error ("End of file");
1368 error ("Invalid escape character syntax");
1371 c
= read_escape (readcharfun
, 0);
1372 return c
| meta_modifier
;
1377 error ("Invalid escape character syntax");
1380 c
= read_escape (readcharfun
, 0);
1381 return c
| shift_modifier
;
1386 error ("Invalid escape character syntax");
1389 c
= read_escape (readcharfun
, 0);
1390 return c
| hyper_modifier
;
1395 error ("Invalid escape character syntax");
1398 c
= read_escape (readcharfun
, 0);
1399 return c
| alt_modifier
;
1404 error ("Invalid escape character syntax");
1407 c
= read_escape (readcharfun
, 0);
1408 return c
| super_modifier
;
1413 error ("Invalid escape character syntax");
1417 c
= read_escape (readcharfun
, 0);
1418 if ((c
& 0177) == '?')
1420 /* ASCII control chars are made from letters (both cases),
1421 as well as the non-letters within 0100...0137. */
1422 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1423 return (c
& (037 | ~0177));
1424 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1425 return (c
& (037 | ~0177));
1427 return c
| ctrl_modifier
;
1437 /* An octal escape, as in ANSI C. */
1439 register int i
= c
- '0';
1440 register int count
= 0;
1443 if ((c
= READCHAR
) >= '0' && c
<= '7')
1458 /* A hex escape, as in ANSI C. */
1464 if (c
>= '0' && c
<= '9')
1469 else if ((c
>= 'a' && c
<= 'f')
1470 || (c
>= 'A' && c
<= 'F'))
1473 if (c
>= 'a' && c
<= 'f')
1488 if (BASE_LEADING_CODE_P (c
))
1489 c
= read_multibyte (c
, readcharfun
);
1494 /* If the next token is ')' or ']' or '.', we store that character
1495 in *PCH and the return value is not interesting. Else, we store
1496 zero in *PCH and we read and return one lisp object.
1498 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1501 read1 (readcharfun
, pch
, first_in_list
)
1502 register Lisp_Object readcharfun
;
1507 int uninterned_symbol
= 0;
1514 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1519 return read_list (0, readcharfun
);
1522 return read_vector (readcharfun
);
1539 tmp
= read_vector (readcharfun
);
1540 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1541 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1542 error ("Invalid size char-table");
1543 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1544 XCHAR_TABLE (tmp
)->top
= Qt
;
1553 tmp
= read_vector (readcharfun
);
1554 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1555 error ("Invalid size char-table");
1556 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1557 XCHAR_TABLE (tmp
)->top
= Qnil
;
1560 Fsignal (Qinvalid_read_syntax
,
1561 Fcons (make_string ("#^^", 3), Qnil
));
1563 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1568 length
= read1 (readcharfun
, pch
, first_in_list
);
1572 Lisp_Object tmp
, val
;
1573 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1577 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1578 if (size_in_chars
!= XSTRING (tmp
)->size
1579 /* We used to print 1 char too many
1580 when the number of bits was a multiple of 8.
1581 Accept such input in case it came from an old version. */
1582 && ! (XFASTINT (length
)
1583 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1584 Fsignal (Qinvalid_read_syntax
,
1585 Fcons (make_string ("#&...", 5), Qnil
));
1587 val
= Fmake_bool_vector (length
, Qnil
);
1588 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1590 /* Clear the extraneous bits in the last byte. */
1591 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1592 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1593 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1596 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1601 /* Accept compiled functions at read-time so that we don't have to
1602 build them using function calls. */
1604 tmp
= read_vector (readcharfun
);
1605 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1606 XVECTOR (tmp
)->contents
);
1608 #ifdef USE_TEXT_PROPERTIES
1612 struct gcpro gcpro1
;
1615 /* Read the string itself. */
1616 tmp
= read1 (readcharfun
, &ch
, 0);
1617 if (ch
!= 0 || !STRINGP (tmp
))
1618 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1620 /* Read the intervals and their properties. */
1623 Lisp_Object beg
, end
, plist
;
1625 beg
= read1 (readcharfun
, &ch
, 0);
1629 end
= read1 (readcharfun
, &ch
, 0);
1631 plist
= read1 (readcharfun
, &ch
, 0);
1633 Fsignal (Qinvalid_read_syntax
,
1634 Fcons (build_string ("invalid string property list"),
1636 Fset_text_properties (beg
, end
, plist
, tmp
);
1642 /* #@NUMBER is used to skip NUMBER following characters.
1643 That's used in .elc files to skip over doc strings
1644 and function definitions. */
1649 /* Read a decimal integer. */
1650 while ((c
= READCHAR
) >= 0
1651 && c
>= '0' && c
<= '9')
1659 #ifndef WINDOWSNT /* I don't know if filepos works right on Windoze. */
1660 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1662 /* If we are supposed to force doc strings into core right now,
1663 record the last string that we skipped,
1664 and record where in the file it comes from. */
1665 if (saved_doc_string_size
== 0)
1667 saved_doc_string_size
= nskip
+ 100;
1668 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1670 if (nskip
> saved_doc_string_size
)
1672 saved_doc_string_size
= nskip
+ 100;
1673 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1674 saved_doc_string_size
);
1677 saved_doc_string_position
= ftell (instream
);
1679 /* Copy that many characters into saved_doc_string. */
1680 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1681 saved_doc_string
[i
] = c
= READCHAR
;
1683 saved_doc_string_length
= i
;
1686 #endif /* not WINDOWSNT */
1688 /* Skip that many characters. */
1689 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1696 return Vload_file_name
;
1698 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1699 /* #:foo is the uninterned symbol named foo. */
1702 uninterned_symbol
= 1;
1706 /* Reader forms that can reuse previously read objects. */
1707 if (c
>= '0' && c
<= '9')
1712 /* Read a non-negative integer. */
1713 while (c
>= '0' && c
<= '9')
1719 /* #n=object returns object, but associates it with n for #n#. */
1722 tem
= read0 (readcharfun
);
1723 read_objects
= Fcons (Fcons (make_number (n
), tem
), read_objects
);
1726 /* #n# returns a previously read object. */
1729 tem
= Fassq (make_number (n
), read_objects
);
1732 /* Fall through to error message. */
1734 /* Fall through to error message. */
1738 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1741 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1746 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1756 new_backquote_flag
= 1;
1757 value
= read0 (readcharfun
);
1758 new_backquote_flag
= 0;
1760 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1764 if (new_backquote_flag
)
1766 Lisp_Object comma_type
= Qnil
;
1771 comma_type
= Qcomma_at
;
1773 comma_type
= Qcomma_dot
;
1776 if (ch
>= 0) UNREAD (ch
);
1777 comma_type
= Qcomma
;
1780 new_backquote_flag
= 0;
1781 value
= read0 (readcharfun
);
1782 new_backquote_flag
= 1;
1783 return Fcons (comma_type
, Fcons (value
, Qnil
));
1790 register Lisp_Object val
;
1793 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1796 c
= read_escape (readcharfun
, 0);
1797 else if (BASE_LEADING_CODE_P (c
))
1798 c
= read_multibyte (c
, readcharfun
);
1800 return make_number (c
);
1805 register char *p
= read_buffer
;
1806 register char *end
= read_buffer
+ read_buffer_size
;
1808 /* Nonzero if we saw an escape sequence specifying
1809 a multibyte character. */
1810 int force_multibyte
= 0;
1811 /* Nonzero if we saw an escape sequence specifying
1812 a single-byte character. */
1813 int force_singlebyte
= 0;
1817 while ((c
= READCHAR
) >= 0
1820 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1822 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1823 p
+= new - read_buffer
;
1824 read_buffer
+= new - read_buffer
;
1825 end
= read_buffer
+ read_buffer_size
;
1830 c
= read_escape (readcharfun
, 1);
1832 /* C is -1 if \ newline has just been seen */
1835 if (p
== read_buffer
)
1840 /* If an escape specifies a non-ASCII single-byte character,
1841 this must be a unibyte string. */
1842 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
))
1843 && ! ASCII_BYTE_P (c
))
1844 force_singlebyte
= 1;
1847 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
)))
1849 unsigned char workbuf
[4];
1850 unsigned char *str
= workbuf
;
1853 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1855 force_multibyte
= 1;
1857 bcopy (str
, p
, length
);
1862 /* Allow `\C- ' and `\C-?'. */
1863 if (c
== (CHAR_CTL
| ' '))
1865 else if (c
== (CHAR_CTL
| '?'))
1869 /* Move the meta bit to the right place for a string. */
1870 c
= (c
& ~CHAR_META
) | 0x80;
1872 error ("Invalid modifier in string");
1877 return Fsignal (Qend_of_file
, Qnil
);
1879 /* If purifying, and string starts with \ newline,
1880 return zero instead. This is for doc strings
1881 that we are really going to find in etc/DOC.nn.nn */
1882 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1883 return make_number (0);
1885 if (force_multibyte
)
1886 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1887 else if (force_singlebyte
)
1888 nchars
= p
- read_buffer
;
1889 else if (load_convert_to_unibyte
)
1892 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1893 if (p
- read_buffer
!= nchars
)
1895 string
= make_multibyte_string (read_buffer
, nchars
,
1897 return Fstring_make_unibyte (string
);
1900 else if (EQ (readcharfun
, Qget_file_char
))
1901 /* Nowadays, reading directly from a file
1902 is used only for compiled Emacs Lisp files,
1903 and those always use the Emacs internal encoding. */
1904 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1906 /* In all other cases, if we read these bytes as
1907 separate characters, treat them as separate characters now. */
1908 nchars
= p
- read_buffer
;
1911 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
1913 || (p
- read_buffer
!= nchars
)));
1914 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
1916 || (p
- read_buffer
!= nchars
)));
1921 #ifdef LISP_FLOAT_TYPE
1922 /* If a period is followed by a number, then we should read it
1923 as a floating point number. Otherwise, it denotes a dotted
1925 int next_char
= READCHAR
;
1928 if (! (next_char
>= '0' && next_char
<= '9'))
1935 /* Otherwise, we fall through! Note that the atom-reading loop
1936 below will now loop at least once, assuring that we will not
1937 try to UNREAD two characters in a row. */
1941 if (c
<= 040) goto retry
;
1943 register char *p
= read_buffer
;
1947 register char *end
= read_buffer
+ read_buffer_size
;
1950 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1951 || c
== '(' || c
== ')'
1952 #ifndef LISP_FLOAT_TYPE
1953 /* If we have floating-point support, then we need
1954 to allow <digits><dot><digits>. */
1956 #endif /* not LISP_FLOAT_TYPE */
1957 || c
== '[' || c
== ']' || c
== '#'
1960 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1962 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1963 p
+= new - read_buffer
;
1964 read_buffer
+= new - read_buffer
;
1965 end
= read_buffer
+ read_buffer_size
;
1973 if (! SINGLE_BYTE_CHAR_P (c
))
1975 unsigned char workbuf
[4];
1976 unsigned char *str
= workbuf
;
1979 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1981 bcopy (str
, p
, length
);
1992 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1993 p
+= new - read_buffer
;
1994 read_buffer
+= new - read_buffer
;
1995 /* end = read_buffer + read_buffer_size; */
2002 if (!quoted
&& !uninterned_symbol
)
2005 register Lisp_Object val
;
2007 if (*p1
== '+' || *p1
== '-') p1
++;
2008 /* Is it an integer? */
2011 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2012 #ifdef LISP_FLOAT_TYPE
2013 /* Integers can have trailing decimal points. */
2014 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2017 /* It is an integer. */
2019 #ifdef LISP_FLOAT_TYPE
2023 if (sizeof (int) == sizeof (EMACS_INT
))
2024 XSETINT (val
, atoi (read_buffer
));
2025 else if (sizeof (long) == sizeof (EMACS_INT
))
2026 XSETINT (val
, atol (read_buffer
));
2032 #ifdef LISP_FLOAT_TYPE
2033 if (isfloat_string (read_buffer
))
2036 double value
= atof (read_buffer
);
2037 if (read_buffer
[0] == '-' && value
== 0.0)
2039 /* The only way this can be true, after isfloat_string
2040 returns 1, is if the input ends in e+INF or e+NaN. */
2041 if (p
[-1] == 'F' || p
[-1] == 'N')
2044 value
= zero
/ zero
;
2045 else if (read_buffer
[0] == '-')
2046 value
= - 1.0 / zero
;
2050 return make_float (value
);
2055 if (uninterned_symbol
)
2056 return make_symbol (read_buffer
);
2058 return intern (read_buffer
);
2063 #ifdef LISP_FLOAT_TYPE
2080 if (*cp
== '+' || *cp
== '-')
2083 if (*cp
>= '0' && *cp
<= '9')
2086 while (*cp
>= '0' && *cp
<= '9')
2094 if (*cp
>= '0' && *cp
<= '9')
2097 while (*cp
>= '0' && *cp
<= '9')
2100 if (*cp
== 'e' || *cp
== 'E')
2104 if (*cp
== '+' || *cp
== '-')
2108 if (*cp
>= '0' && *cp
<= '9')
2111 while (*cp
>= '0' && *cp
<= '9')
2114 else if (cp
== start
)
2116 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2121 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2127 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2128 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2129 || state
== (DOT_CHAR
|TRAIL_INT
)
2130 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2131 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2132 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2134 #endif /* LISP_FLOAT_TYPE */
2137 read_vector (readcharfun
)
2138 Lisp_Object readcharfun
;
2142 register Lisp_Object
*ptr
;
2143 register Lisp_Object tem
, vector
;
2144 register struct Lisp_Cons
*otem
;
2147 tem
= read_list (1, readcharfun
);
2148 len
= Flength (tem
);
2149 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2152 size
= XVECTOR (vector
)->size
;
2153 ptr
= XVECTOR (vector
)->contents
;
2154 for (i
= 0; i
< size
; i
++)
2156 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
2164 /* FLAG = 1 means check for ] to terminate rather than ) and .
2165 FLAG = -1 means check for starting with defun
2166 and make structure pure. */
2169 read_list (flag
, readcharfun
)
2171 register Lisp_Object readcharfun
;
2173 /* -1 means check next element for defun,
2174 0 means don't check,
2175 1 means already checked and found defun. */
2176 int defunflag
= flag
< 0 ? -1 : 0;
2177 Lisp_Object val
, tail
;
2178 register Lisp_Object elt
, tem
;
2179 struct gcpro gcpro1
, gcpro2
;
2180 /* 0 is the normal case.
2181 1 means this list is a doc reference; replace it with the number 0.
2182 2 means this list is a doc reference; replace it with the doc string. */
2183 int doc_reference
= 0;
2185 /* Initialize this to 1 if we are reading a list. */
2186 int first_in_list
= flag
<= 0;
2195 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2200 /* While building, if the list starts with #$, treat it specially. */
2201 if (EQ (elt
, Vload_file_name
)
2203 && !NILP (Vpurify_flag
))
2205 if (NILP (Vdoc_file_name
))
2206 /* We have not yet called Snarf-documentation, so assume
2207 this file is described in the DOC-MM.NN file
2208 and Snarf-documentation will fill in the right value later.
2209 For now, replace the whole list with 0. */
2212 /* We have already called Snarf-documentation, so make a relative
2213 file name for this file, so it can be found properly
2214 in the installed Lisp directory.
2215 We don't use Fexpand_file_name because that would make
2216 the directory absolute now. */
2217 elt
= concat2 (build_string ("../lisp/"),
2218 Ffile_name_nondirectory (elt
));
2220 else if (EQ (elt
, Vload_file_name
)
2222 && load_force_doc_strings
)
2231 Fsignal (Qinvalid_read_syntax
,
2232 Fcons (make_string (") or . in a vector", 18), Qnil
));
2240 XCONS (tail
)->cdr
= read0 (readcharfun
);
2242 val
= read0 (readcharfun
);
2243 read1 (readcharfun
, &ch
, 0);
2247 if (doc_reference
== 1)
2248 return make_number (0);
2249 if (doc_reference
== 2)
2251 /* Get a doc string from the file we are loading.
2252 If it's in saved_doc_string, get it from there. */
2253 int pos
= XINT (XCONS (val
)->cdr
);
2254 if (pos
>= saved_doc_string_position
2255 && pos
< (saved_doc_string_position
2256 + saved_doc_string_length
))
2258 int start
= pos
- saved_doc_string_position
;
2261 /* Process quoting with ^A,
2262 and find the end of the string,
2263 which is marked with ^_ (037). */
2264 for (from
= start
, to
= start
;
2265 saved_doc_string
[from
] != 037;)
2267 int c
= saved_doc_string
[from
++];
2270 c
= saved_doc_string
[from
++];
2272 saved_doc_string
[to
++] = c
;
2274 saved_doc_string
[to
++] = 0;
2276 saved_doc_string
[to
++] = 037;
2279 saved_doc_string
[to
++] = c
;
2282 return make_string (saved_doc_string
+ start
,
2286 return read_doc_string (val
);
2291 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2293 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2295 tem
= (read_pure
&& flag
<= 0
2296 ? pure_cons (elt
, Qnil
)
2297 : Fcons (elt
, Qnil
));
2299 XCONS (tail
)->cdr
= tem
;
2304 defunflag
= EQ (elt
, Qdefun
);
2305 else if (defunflag
> 0)
2310 Lisp_Object Vobarray
;
2311 Lisp_Object initial_obarray
;
2313 /* oblookup stores the bucket number here, for the sake of Funintern. */
2315 int oblookup_last_bucket_number
;
2317 static int hash_string ();
2318 Lisp_Object
oblookup ();
2320 /* Get an error if OBARRAY is not an obarray.
2321 If it is one, return it. */
2324 check_obarray (obarray
)
2325 Lisp_Object obarray
;
2327 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2329 /* If Vobarray is now invalid, force it to be valid. */
2330 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2332 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2337 /* Intern the C string STR: return a symbol with that name,
2338 interned in the current obarray. */
2345 int len
= strlen (str
);
2346 Lisp_Object obarray
;
2349 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2350 obarray
= check_obarray (obarray
);
2351 tem
= oblookup (obarray
, str
, len
, len
);
2354 return Fintern (make_string (str
, len
), obarray
);
2357 /* Create an uninterned symbol with name STR. */
2363 int len
= strlen (str
);
2365 return Fmake_symbol ((!NILP (Vpurify_flag
)
2366 ? make_pure_string (str
, len
, len
, 0)
2367 : make_string (str
, len
)));
2370 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2371 "Return the canonical symbol whose name is STRING.\n\
2372 If there is none, one is created by this function and returned.\n\
2373 A second optional argument specifies the obarray to use;\n\
2374 it defaults to the value of `obarray'.")
2376 Lisp_Object string
, obarray
;
2378 register Lisp_Object tem
, sym
, *ptr
;
2380 if (NILP (obarray
)) obarray
= Vobarray
;
2381 obarray
= check_obarray (obarray
);
2383 CHECK_STRING (string
, 0);
2385 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2386 XSTRING (string
)->size
,
2387 STRING_BYTES (XSTRING (string
)));
2388 if (!INTEGERP (tem
))
2391 if (!NILP (Vpurify_flag
))
2392 string
= Fpurecopy (string
);
2393 sym
= Fmake_symbol (string
);
2394 XSYMBOL (sym
)->obarray
= obarray
;
2396 if ((XSTRING (string
)->data
[0] == ':')
2397 && EQ (obarray
, initial_obarray
))
2398 XSYMBOL (sym
)->value
= sym
;
2400 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2402 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2404 XSYMBOL (sym
)->next
= 0;
2409 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2410 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2411 A second optional argument specifies the obarray to use;\n\
2412 it defaults to the value of `obarray'.")
2414 Lisp_Object string
, obarray
;
2416 register Lisp_Object tem
;
2418 if (NILP (obarray
)) obarray
= Vobarray
;
2419 obarray
= check_obarray (obarray
);
2421 CHECK_STRING (string
, 0);
2423 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2424 XSTRING (string
)->size
,
2425 STRING_BYTES (XSTRING (string
)));
2426 if (!INTEGERP (tem
))
2431 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2432 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2433 The value is t if a symbol was found and deleted, nil otherwise.\n\
2434 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2435 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2436 OBARRAY defaults to the value of the variable `obarray'.")
2438 Lisp_Object name
, obarray
;
2440 register Lisp_Object string
, tem
;
2443 if (NILP (obarray
)) obarray
= Vobarray
;
2444 obarray
= check_obarray (obarray
);
2447 XSETSTRING (string
, XSYMBOL (name
)->name
);
2450 CHECK_STRING (name
, 0);
2454 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2455 XSTRING (string
)->size
,
2456 STRING_BYTES (XSTRING (string
)));
2459 /* If arg was a symbol, don't delete anything but that symbol itself. */
2460 if (SYMBOLP (name
) && !EQ (name
, tem
))
2463 XSYMBOL (tem
)->obarray
= Qnil
;
2465 hash
= oblookup_last_bucket_number
;
2467 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2469 if (XSYMBOL (tem
)->next
)
2470 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2472 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2476 Lisp_Object tail
, following
;
2478 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2479 XSYMBOL (tail
)->next
;
2482 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2483 if (EQ (following
, tem
))
2485 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2494 /* Return the symbol in OBARRAY whose names matches the string
2495 of SIZE characters (SIZE_BYTE bytes) at PTR.
2496 If there is no such symbol in OBARRAY, return nil.
2498 Also store the bucket number in oblookup_last_bucket_number. */
2501 oblookup (obarray
, ptr
, size
, size_byte
)
2502 Lisp_Object obarray
;
2504 int size
, size_byte
;
2508 register Lisp_Object tail
;
2509 Lisp_Object bucket
, tem
;
2511 if (!VECTORP (obarray
)
2512 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2514 obarray
= check_obarray (obarray
);
2515 obsize
= XVECTOR (obarray
)->size
;
2517 /* This is sometimes needed in the middle of GC. */
2518 obsize
&= ~ARRAY_MARK_FLAG
;
2519 /* Combining next two lines breaks VMS C 2.3. */
2520 hash
= hash_string (ptr
, size_byte
);
2522 bucket
= XVECTOR (obarray
)->contents
[hash
];
2523 oblookup_last_bucket_number
= hash
;
2524 if (XFASTINT (bucket
) == 0)
2526 else if (!SYMBOLP (bucket
))
2527 error ("Bad data in guts of obarray"); /* Like CADR error message */
2529 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2531 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2532 && XSYMBOL (tail
)->name
->size
== size
2533 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2535 else if (XSYMBOL (tail
)->next
== 0)
2538 XSETINT (tem
, hash
);
2543 hash_string (ptr
, len
)
2547 register unsigned char *p
= ptr
;
2548 register unsigned char *end
= p
+ len
;
2549 register unsigned char c
;
2550 register int hash
= 0;
2555 if (c
>= 0140) c
-= 40;
2556 hash
= ((hash
<<3) + (hash
>>28) + c
);
2558 return hash
& 07777777777;
2562 map_obarray (obarray
, fn
, arg
)
2563 Lisp_Object obarray
;
2564 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2568 register Lisp_Object tail
;
2569 CHECK_VECTOR (obarray
, 1);
2570 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2572 tail
= XVECTOR (obarray
)->contents
[i
];
2577 if (XSYMBOL (tail
)->next
== 0)
2579 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2585 mapatoms_1 (sym
, function
)
2586 Lisp_Object sym
, function
;
2588 call1 (function
, sym
);
2591 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2592 "Call FUNCTION on every symbol in OBARRAY.\n\
2593 OBARRAY defaults to the value of `obarray'.")
2595 Lisp_Object function
, obarray
;
2599 if (NILP (obarray
)) obarray
= Vobarray
;
2600 obarray
= check_obarray (obarray
);
2602 map_obarray (obarray
, mapatoms_1
, function
);
2606 #define OBARRAY_SIZE 1511
2611 Lisp_Object oblength
;
2615 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2617 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
2618 Vobarray
= Fmake_vector (oblength
, make_number (0));
2619 initial_obarray
= Vobarray
;
2620 staticpro (&initial_obarray
);
2621 /* Intern nil in the obarray */
2622 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2623 /* These locals are to kludge around a pyramid compiler bug. */
2624 hash
= hash_string ("nil", 3);
2625 /* Separate statement here to avoid VAXC bug. */
2626 hash
%= OBARRAY_SIZE
;
2627 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2630 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
2631 XSYMBOL (Qnil
)->function
= Qunbound
;
2632 XSYMBOL (Qunbound
)->value
= Qunbound
;
2633 XSYMBOL (Qunbound
)->function
= Qunbound
;
2636 XSYMBOL (Qnil
)->value
= Qnil
;
2637 XSYMBOL (Qnil
)->plist
= Qnil
;
2638 XSYMBOL (Qt
)->value
= Qt
;
2640 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2643 Qvariable_documentation
= intern ("variable-documentation");
2644 staticpro (&Qvariable_documentation
);
2646 read_buffer_size
= 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM
;
2647 read_buffer
= (char *) malloc (read_buffer_size
);
2652 struct Lisp_Subr
*sname
;
2655 sym
= intern (sname
->symbol_name
);
2656 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2659 #ifdef NOTDEF /* use fset in subr.el now */
2661 defalias (sname
, string
)
2662 struct Lisp_Subr
*sname
;
2666 sym
= intern (string
);
2667 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2671 /* Define an "integer variable"; a symbol whose value is forwarded
2672 to a C variable of type int. Sample call: */
2673 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2675 defvar_int (namestring
, address
)
2679 Lisp_Object sym
, val
;
2680 sym
= intern (namestring
);
2681 val
= allocate_misc ();
2682 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2683 XINTFWD (val
)->intvar
= address
;
2684 XSYMBOL (sym
)->value
= val
;
2687 /* Similar but define a variable whose value is T if address contains 1,
2688 NIL if address contains 0 */
2690 defvar_bool (namestring
, address
)
2694 Lisp_Object sym
, val
;
2695 sym
= intern (namestring
);
2696 val
= allocate_misc ();
2697 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2698 XBOOLFWD (val
)->boolvar
= address
;
2699 XSYMBOL (sym
)->value
= val
;
2702 /* Similar but define a variable whose value is the Lisp Object stored
2703 at address. Two versions: with and without gc-marking of the C
2704 variable. The nopro version is used when that variable will be
2705 gc-marked for some other reason, since marking the same slot twice
2706 can cause trouble with strings. */
2708 defvar_lisp_nopro (namestring
, address
)
2710 Lisp_Object
*address
;
2712 Lisp_Object sym
, val
;
2713 sym
= intern (namestring
);
2714 val
= allocate_misc ();
2715 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2716 XOBJFWD (val
)->objvar
= address
;
2717 XSYMBOL (sym
)->value
= val
;
2721 defvar_lisp (namestring
, address
)
2723 Lisp_Object
*address
;
2725 defvar_lisp_nopro (namestring
, address
);
2726 staticpro (address
);
2731 /* Similar but define a variable whose value is the Lisp Object stored in
2732 the current buffer. address is the address of the slot in the buffer
2733 that is current now. */
2736 defvar_per_buffer (namestring
, address
, type
, doc
)
2738 Lisp_Object
*address
;
2742 Lisp_Object sym
, val
;
2744 extern struct buffer buffer_local_symbols
;
2746 sym
= intern (namestring
);
2747 val
= allocate_misc ();
2748 offset
= (char *)address
- (char *)current_buffer
;
2750 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2751 XBUFFER_OBJFWD (val
)->offset
= offset
;
2752 XSYMBOL (sym
)->value
= val
;
2753 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2754 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2755 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2756 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2757 slot of buffer_local_flags */
2761 #endif /* standalone */
2763 /* Similar but define a variable whose value is the Lisp Object stored
2764 at a particular offset in the current kboard object. */
2767 defvar_kboard (namestring
, offset
)
2771 Lisp_Object sym
, val
;
2772 sym
= intern (namestring
);
2773 val
= allocate_misc ();
2774 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2775 XKBOARD_OBJFWD (val
)->offset
= offset
;
2776 XSYMBOL (sym
)->value
= val
;
2779 /* Record the value of load-path used at the start of dumping
2780 so we can see if the site changed it later during dumping. */
2781 static Lisp_Object dump_path
;
2787 int turn_off_warning
= 0;
2789 #ifdef HAVE_SETLOCALE
2790 /* Make sure numbers are parsed as we expect. */
2791 setlocale (LC_NUMERIC
, "C");
2792 #endif /* HAVE_SETLOCALE */
2794 /* Compute the default load-path. */
2796 normal
= PATH_LOADSEARCH
;
2797 Vload_path
= decode_env_path (0, normal
);
2799 if (NILP (Vpurify_flag
))
2800 normal
= PATH_LOADSEARCH
;
2802 normal
= PATH_DUMPLOADSEARCH
;
2804 /* In a dumped Emacs, we normally have to reset the value of
2805 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2806 uses ../lisp, instead of the path of the installed elisp
2807 libraries. However, if it appears that Vload_path was changed
2808 from the default before dumping, don't override that value. */
2811 if (! NILP (Fequal (dump_path
, Vload_path
)))
2813 Vload_path
= decode_env_path (0, normal
);
2814 if (!NILP (Vinstallation_directory
))
2816 /* Add to the path the lisp subdir of the
2817 installation dir, if it exists. */
2818 Lisp_Object tem
, tem1
;
2819 tem
= Fexpand_file_name (build_string ("lisp"),
2820 Vinstallation_directory
);
2821 tem1
= Ffile_exists_p (tem
);
2824 if (NILP (Fmember (tem
, Vload_path
)))
2826 turn_off_warning
= 1;
2827 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2831 /* That dir doesn't exist, so add the build-time
2832 Lisp dirs instead. */
2833 Vload_path
= nconc2 (Vload_path
, dump_path
);
2835 /* Add leim under the installation dir, if it exists. */
2836 tem
= Fexpand_file_name (build_string ("leim"),
2837 Vinstallation_directory
);
2838 tem1
= Ffile_exists_p (tem
);
2841 if (NILP (Fmember (tem
, Vload_path
)))
2842 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2845 /* Add site-list under the installation dir, if it exists. */
2846 tem
= Fexpand_file_name (build_string ("site-lisp"),
2847 Vinstallation_directory
);
2848 tem1
= Ffile_exists_p (tem
);
2851 if (NILP (Fmember (tem
, Vload_path
)))
2852 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2855 /* If Emacs was not built in the source directory,
2856 and it is run from where it was built, add to load-path
2857 the lisp, leim and site-lisp dirs under that directory. */
2859 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
2863 tem
= Fexpand_file_name (build_string ("src/Makefile"),
2864 Vinstallation_directory
);
2865 tem1
= Ffile_exists_p (tem
);
2867 /* Don't be fooled if they moved the entire source tree
2868 AFTER dumping Emacs. If the build directory is indeed
2869 different from the source dir, src/Makefile.in and
2870 src/Makefile will not be found together. */
2871 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
2872 Vinstallation_directory
);
2873 tem2
= Ffile_exists_p (tem
);
2874 if (!NILP (tem1
) && NILP (tem2
))
2876 tem
= Fexpand_file_name (build_string ("lisp"),
2879 if (NILP (Fmember (tem
, Vload_path
)))
2880 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2882 tem
= Fexpand_file_name (build_string ("leim"),
2885 if (NILP (Fmember (tem
, Vload_path
)))
2886 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2888 tem
= Fexpand_file_name (build_string ("site-lisp"),
2891 if (NILP (Fmember (tem
, Vload_path
)))
2892 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2900 /* NORMAL refers to the lisp dir in the source directory. */
2901 /* We used to add ../lisp at the front here, but
2902 that caused trouble because it was copied from dump_path
2903 into Vload_path, aboe, when Vinstallation_directory was non-nil.
2904 It should be unnecessary. */
2905 Vload_path
= decode_env_path (0, normal
);
2906 dump_path
= Vload_path
;
2911 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
2912 almost never correct, thereby causing a warning to be printed out that
2913 confuses users. Since PATH_LOADSEARCH is always overridden by the
2914 EMACSLOADPATH environment variable below, disable the warning on NT. */
2916 /* Warn if dirs in the *standard* path don't exist. */
2917 if (!turn_off_warning
)
2919 Lisp_Object path_tail
;
2921 for (path_tail
= Vload_path
;
2923 path_tail
= XCONS (path_tail
)->cdr
)
2925 Lisp_Object dirfile
;
2926 dirfile
= Fcar (path_tail
);
2927 if (STRINGP (dirfile
))
2929 dirfile
= Fdirectory_file_name (dirfile
);
2930 if (access (XSTRING (dirfile
)->data
, 0) < 0)
2931 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
2932 XCONS (path_tail
)->car
);
2936 #endif /* WINDOWSNT */
2938 /* If the EMACSLOADPATH environment variable is set, use its value.
2939 This doesn't apply if we're dumping. */
2941 if (NILP (Vpurify_flag
)
2942 && egetenv ("EMACSLOADPATH"))
2944 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
2948 load_in_progress
= 0;
2949 Vload_file_name
= Qnil
;
2951 load_descriptor_list
= Qnil
;
2953 Vstandard_input
= Qt
;
2956 /* Print a warning, using format string FORMAT, that directory DIRNAME
2957 does not exist. Print it on stderr and put it in *Message*. */
2960 dir_warning (format
, dirname
)
2962 Lisp_Object dirname
;
2965 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
2967 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
2968 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
2969 /* Don't log the warning before we've initialized!! */
2971 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
2978 defsubr (&Sread_from_string
);
2980 defsubr (&Sintern_soft
);
2981 defsubr (&Sunintern
);
2983 defsubr (&Seval_buffer
);
2984 defsubr (&Seval_region
);
2985 defsubr (&Sread_char
);
2986 defsubr (&Sread_char_exclusive
);
2987 defsubr (&Sread_event
);
2988 defsubr (&Sget_file_char
);
2989 defsubr (&Smapatoms
);
2991 DEFVAR_LISP ("obarray", &Vobarray
,
2992 "Symbol table for use by `intern' and `read'.\n\
2993 It is a vector whose length ought to be prime for best results.\n\
2994 The vector's contents don't make sense if examined from Lisp programs;\n\
2995 to find all the symbols in an obarray, use `mapatoms'.");
2997 DEFVAR_LISP ("values", &Vvalues
,
2998 "List of values of all expressions which were read, evaluated and printed.\n\
2999 Order is reverse chronological.");
3001 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3002 "Stream for read to get input from.\n\
3003 See documentation of `read' for possible values.");
3004 Vstandard_input
= Qt
;
3006 DEFVAR_LISP ("load-path", &Vload_path
,
3007 "*List of directories to search for files to load.\n\
3008 Each element is a string (directory name) or nil (try default directory).\n\
3009 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3010 otherwise to default specified by file `paths.h' when Emacs was built.");
3012 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3013 "Non-nil iff inside of `load'.");
3015 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3016 "An alist of expressions to be evalled when particular files are loaded.\n\
3017 Each element looks like (FILENAME FORMS...).\n\
3018 When `load' is run and the file-name argument is FILENAME,\n\
3019 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3020 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3021 with no directory specified, since that is how `load' is normally called.\n\
3022 An error in FORMS does not undo the load,\n\
3023 but does prevent execution of the rest of the FORMS.");
3024 Vafter_load_alist
= Qnil
;
3026 DEFVAR_LISP ("load-history", &Vload_history
,
3027 "Alist mapping source file names to symbols and features.\n\
3028 Each alist element is a list that starts with a file name,\n\
3029 except for one element (optional) that starts with nil and describes\n\
3030 definitions evaluated from buffers not visiting files.\n\
3031 The remaining elements of each list are symbols defined as functions\n\
3032 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
3033 Vload_history
= Qnil
;
3035 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3036 "Full name of file being loaded by `load'.");
3037 Vload_file_name
= Qnil
;
3039 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3040 "Used for internal purposes by `load'.");
3041 Vcurrent_load_list
= Qnil
;
3043 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3044 "Function used by `load' and `eval-region' for reading expressions.\n\
3045 The default is nil, which means use the function `read'.");
3046 Vload_read_function
= Qnil
;
3048 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3049 "Function called in `load' for loading an Emacs lisp source file.\n\
3050 This function is for doing code conversion before reading the source file.\n\
3051 If nil, loading is done without any code conversion.\n\
3052 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3053 FULLNAME is the full name of FILE.\n\
3054 See `load' for the meaning of the remaining arguments.");
3055 Vload_source_file_function
= Qnil
;
3057 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3058 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3059 This is useful when the file being loaded is a temporary copy.");
3060 load_force_doc_strings
= 0;
3062 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3063 "Non-nil means `load' converts strings to unibyte whenever possible.\n\
3064 This is normally used in `load-with-code-conversion'\n\
3065 for loading non-compiled files.");
3066 load_convert_to_unibyte
= 0;
3068 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3069 "Directory in which Emacs sources were found when Emacs was built.\n\
3070 You cannot count on them to still be there!");
3072 = Fexpand_file_name (build_string ("../"),
3073 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3075 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3076 "List of files that were preloaded (when dumping Emacs).");
3077 Vpreloaded_file_list
= Qnil
;
3079 /* Vsource_directory was initialized in init_lread. */
3081 load_descriptor_list
= Qnil
;
3082 staticpro (&load_descriptor_list
);
3084 Qcurrent_load_list
= intern ("current-load-list");
3085 staticpro (&Qcurrent_load_list
);
3087 Qstandard_input
= intern ("standard-input");
3088 staticpro (&Qstandard_input
);
3090 Qread_char
= intern ("read-char");
3091 staticpro (&Qread_char
);
3093 Qget_file_char
= intern ("get-file-char");
3094 staticpro (&Qget_file_char
);
3096 Qbackquote
= intern ("`");
3097 staticpro (&Qbackquote
);
3098 Qcomma
= intern (",");
3099 staticpro (&Qcomma
);
3100 Qcomma_at
= intern (",@");
3101 staticpro (&Qcomma_at
);
3102 Qcomma_dot
= intern (",.");
3103 staticpro (&Qcomma_dot
);
3105 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3106 staticpro (&Qinhibit_file_name_operation
);
3108 Qascii_character
= intern ("ascii-character");
3109 staticpro (&Qascii_character
);
3111 Qfunction
= intern ("function");
3112 staticpro (&Qfunction
);
3114 Qload
= intern ("load");
3117 Qload_file_name
= intern ("load-file-name");
3118 staticpro (&Qload_file_name
);
3120 staticpro (&dump_path
);
3122 staticpro (&read_objects
);
3123 read_objects
= Qnil
;