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 (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
189 if (! NILP (inbuffer
->enable_multibyte_characters
))
191 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
192 BUF_INC_POS (inbuffer
, pt_byte
);
193 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
197 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
200 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
204 if (MARKERP (readcharfun
))
206 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
208 int bytepos
= marker_byte_position (readcharfun
);
209 int orig_bytepos
= bytepos
;
211 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
214 if (! NILP (inbuffer
->enable_multibyte_characters
))
216 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
217 BUF_INC_POS (inbuffer
, bytepos
);
218 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
222 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
226 XMARKER (readcharfun
)->bytepos
= bytepos
;
227 XMARKER (readcharfun
)->charpos
++;
231 if (EQ (readcharfun
, Qget_file_char
))
235 /* Interrupted reads have been observed while reading over the network */
236 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
245 if (STRINGP (readcharfun
))
247 if (read_from_string_index
>= read_from_string_limit
)
249 else if (STRING_MULTIBYTE (readcharfun
))
250 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
251 read_from_string_index
,
252 read_from_string_index_byte
);
254 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
259 tem
= call0 (readcharfun
);
266 /* Unread the character C in the way appropriate for the stream READCHARFUN.
267 If the stream is a user function, call it with the char as argument. */
270 unreadchar (readcharfun
, c
)
271 Lisp_Object readcharfun
;
275 /* Don't back up the pointer if we're unreading the end-of-input mark,
276 since readchar didn't advance it when we read it. */
278 else if (BUFFERP (readcharfun
))
280 struct buffer
*b
= XBUFFER (readcharfun
);
281 int bytepos
= BUF_PT_BYTE (b
);
284 if (! NILP (b
->enable_multibyte_characters
))
285 BUF_DEC_POS (b
, bytepos
);
289 BUF_PT_BYTE (b
) = bytepos
;
291 else if (MARKERP (readcharfun
))
293 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
294 int bytepos
= XMARKER (readcharfun
)->bytepos
;
296 XMARKER (readcharfun
)->charpos
--;
297 if (! NILP (b
->enable_multibyte_characters
))
298 BUF_DEC_POS (b
, bytepos
);
302 XMARKER (readcharfun
)->bytepos
= bytepos
;
304 else if (STRINGP (readcharfun
))
306 read_from_string_index
--;
307 read_from_string_index_byte
308 = string_char_to_byte (readcharfun
, read_from_string_index
);
310 else if (EQ (readcharfun
, Qget_file_char
))
311 ungetc (c
, instream
);
313 call1 (readcharfun
, make_number (c
));
316 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
317 static int read_multibyte ();
319 /* Get a character from the tty. */
321 extern Lisp_Object
read_char ();
323 /* Read input events until we get one that's acceptable for our purposes.
325 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
326 until we get a character we like, and then stuffed into
329 If ASCII_REQUIRED is non-zero, we check function key events to see
330 if the unmodified version of the symbol has a Qascii_character
331 property, and use that character, if present.
333 If ERROR_NONASCII is non-zero, we signal an error if the input we
334 get isn't an ASCII character with modifiers. If it's zero but
335 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
339 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
340 int no_switch_frame
, ascii_required
, error_nonascii
;
343 return make_number (getchar ());
345 register Lisp_Object val
, delayed_switch_frame
;
347 delayed_switch_frame
= Qnil
;
349 /* Read until we get an acceptable event. */
351 val
= read_char (0, 0, 0, Qnil
, 0);
356 /* switch-frame events are put off until after the next ASCII
357 character. This is better than signaling an error just because
358 the last characters were typed to a separate minibuffer frame,
359 for example. Eventually, some code which can deal with
360 switch-frame events will read it and process it. */
362 && EVENT_HAS_PARAMETERS (val
)
363 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
365 delayed_switch_frame
= val
;
371 /* Convert certain symbols to their ASCII equivalents. */
374 Lisp_Object tem
, tem1
, tem2
;
375 tem
= Fget (val
, Qevent_symbol_element_mask
);
378 tem1
= Fget (Fcar (tem
), Qascii_character
);
379 /* Merge this symbol's modifier bits
380 with the ASCII equivalent of its basic code. */
382 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
386 /* If we don't have a character now, deal with it appropriately. */
391 Vunread_command_events
= Fcons (val
, Qnil
);
392 error ("Non-character input-event");
399 if (! NILP (delayed_switch_frame
))
400 unread_switch_frame
= delayed_switch_frame
;
406 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
407 "Read a character from the command input (keyboard or macro).\n\
408 It is returned as a number.\n\
409 If the user generates an event which is not a character (i.e. a mouse\n\
410 click or function key event), `read-char' signals an error. As an\n\
411 exception, switch-frame events are put off until non-ASCII events can\n\
413 If you want to read non-character events, or ignore them, call\n\
414 `read-event' or `read-char-exclusive' instead.")
417 return read_filtered_event (1, 1, 1);
420 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
421 "Read an event object from the input stream.")
424 return read_filtered_event (0, 0, 0);
427 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
428 "Read a character from the command input (keyboard or macro).\n\
429 It is returned as a number. Non-character events are ignored.")
432 return read_filtered_event (1, 1, 0);
435 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
436 "Don't use this yourself.")
439 register Lisp_Object val
;
440 XSETINT (val
, getc (instream
));
444 static void readevalloop ();
445 static Lisp_Object
load_unwind ();
446 static Lisp_Object
load_descriptor_unwind ();
448 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
449 "Execute a file of Lisp code named FILE.\n\
450 First try FILE with `.elc' appended, then try with `.el',\n\
451 then try FILE unmodified.\n\
452 This function searches the directories in `load-path'.\n\
453 If optional second arg NOERROR is non-nil,\n\
454 report no error if FILE doesn't exist.\n\
455 Print messages at start and end of loading unless\n\
456 optional third arg NOMESSAGE is non-nil.\n\
457 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
458 suffixes `.elc' or `.el' to the specified name FILE.\n\
459 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
460 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
461 it ends in one of those suffixes or includes a directory name.\n\
462 Return t if file exists.")
463 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
464 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
466 register FILE *stream
;
467 register int fd
= -1;
468 register Lisp_Object lispstream
;
469 int count
= specpdl_ptr
- specpdl
;
473 /* 1 means we printed the ".el is newer" message. */
475 /* 1 means we are loading a compiled file. */
479 char *dosmode
= "rt";
482 CHECK_STRING (file
, 0);
484 /* If file name is magic, call the handler. */
485 handler
= Ffind_file_name_handler (file
, Qload
);
487 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
489 /* Do this after the handler to avoid
490 the need to gcpro noerror, nomessage and nosuffix.
491 (Below here, we care only whether they are nil or not.) */
492 file
= Fsubstitute_in_file_name (file
);
494 /* Avoid weird lossage with null string as arg,
495 since it would try to load a directory as a Lisp file */
496 if (XSTRING (file
)->size
> 0)
498 int size
= XSTRING (file
)->size
;
502 if (! NILP (must_suffix
))
504 /* Don't insist on adding a suffix if FILE already ends with one. */
506 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
509 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
511 /* Don't insist on adding a suffix
512 if the argument includes a directory name. */
513 else if (! NILP (Ffile_name_directory (file
)))
517 fd
= openp (Vload_path
, file
,
518 (!NILP (nosuffix
) ? ""
519 : ! NILP (must_suffix
) ? ".elc:.el"
529 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
530 Fcons (file
, Qnil
)));
535 /* If FD is 0, that means openp found a remote file. */
538 handler
= Ffind_file_name_handler (found
, Qload
);
539 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
542 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
553 stat ((char *)XSTRING (found
)->data
, &s1
);
554 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
555 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
556 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
558 /* Make the progress messages mention that source is newer. */
561 /* If we won't print another message, mention this anyway. */
562 if (! NILP (nomessage
))
563 message_with_string ("Source file `%s' newer than byte-compiled file",
566 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
570 /* We are loading a source file (*.el). */
571 if (!NILP (Vload_source_file_function
))
574 return call4 (Vload_source_file_function
, found
, file
,
575 NILP (noerror
) ? Qnil
: Qt
,
576 NILP (nomessage
) ? Qnil
: Qt
);
582 stream
= fopen ((char *) XSTRING (found
)->data
, dosmode
);
583 #else /* not DOS_NT */
584 stream
= fdopen (fd
, "r");
585 #endif /* not DOS_NT */
589 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
592 if (! NILP (Vpurify_flag
))
593 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
595 if (NILP (nomessage
))
598 message_with_string ("Loading %s (source)...", file
, 1);
600 message_with_string ("Loading %s (compiled; note, source file is newer)...",
602 else /* The typical case; compiled file newer than source file. */
603 message_with_string ("Loading %s...", file
, 1);
607 lispstream
= Fcons (Qnil
, Qnil
);
608 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
609 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
610 record_unwind_protect (load_unwind
, lispstream
);
611 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
612 specbind (Qload_file_name
, found
);
613 specbind (Qinhibit_file_name_operation
, Qnil
);
615 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
617 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
);
618 unbind_to (count
, Qnil
);
620 /* Run any load-hooks for this file. */
621 temp
= Fassoc (file
, Vafter_load_alist
);
623 Fprogn (Fcdr (temp
));
626 if (saved_doc_string
)
627 free (saved_doc_string
);
628 saved_doc_string
= 0;
629 saved_doc_string_size
= 0;
631 if (!noninteractive
&& NILP (nomessage
))
634 message_with_string ("Loading %s (source)...done", file
, 1);
636 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
638 else /* The typical case; compiled file newer than source file. */
639 message_with_string ("Loading %s...done", file
, 1);
645 load_unwind (stream
) /* used as unwind-protect function in load */
648 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
649 | XFASTINT (XCONS (stream
)->cdr
)));
650 if (--load_in_progress
< 0) load_in_progress
= 0;
655 load_descriptor_unwind (oldlist
)
658 load_descriptor_list
= oldlist
;
662 /* Close all descriptors in use for Floads.
663 This is used when starting a subprocess. */
670 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
671 close (XFASTINT (XCONS (tail
)->car
));
676 complete_filename_p (pathname
)
677 Lisp_Object pathname
;
679 register unsigned char *s
= XSTRING (pathname
)->data
;
680 return (IS_DIRECTORY_SEP (s
[0])
681 || (XSTRING (pathname
)->size
> 2
682 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
692 /* Search for a file whose name is STR, looking in directories
693 in the Lisp list PATH, and trying suffixes from SUFFIX.
694 SUFFIX is a string containing possible suffixes separated by colons.
695 On success, returns a file descriptor. On failure, returns -1.
697 EXEC_ONLY nonzero means don't open the files,
698 just look for one that is executable. In this case,
699 returns 1 on success.
701 If STOREPTR is nonzero, it points to a slot where the name of
702 the file actually found should be stored as a Lisp string.
703 nil is stored there on failure.
705 If the file we find is remote, return 0
706 but store the found remote file name in *STOREPTR.
707 We do not check for remote files if EXEC_ONLY is nonzero. */
710 openp (path
, str
, suffix
, storeptr
, exec_only
)
711 Lisp_Object path
, str
;
713 Lisp_Object
*storeptr
;
719 register char *fn
= buf
;
722 Lisp_Object filename
;
730 if (complete_filename_p (str
))
733 for (; !NILP (path
); path
= Fcdr (path
))
737 filename
= Fexpand_file_name (str
, Fcar (path
));
738 if (!complete_filename_p (filename
))
739 /* If there are non-absolute elts in PATH (eg ".") */
740 /* Of course, this could conceivably lose if luser sets
741 default-directory to be something non-absolute... */
743 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
744 if (!complete_filename_p (filename
))
745 /* Give up on this path element! */
749 /* Calculate maximum size of any filename made from
750 this path element/specified file name and any possible suffix. */
751 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
752 if (fn_size
< want_size
)
753 fn
= (char *) alloca (fn_size
= 100 + want_size
);
757 /* Loop over suffixes. */
760 char *esuffix
= (char *) index (nsuffix
, ':');
761 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
764 /* Concatenate path element/specified name with the suffix.
765 If the directory starts with /:, remove that. */
766 if (XSTRING (filename
)->size
> 2
767 && XSTRING (filename
)->data
[0] == '/'
768 && XSTRING (filename
)->data
[1] == ':')
770 strncpy (fn
, XSTRING (filename
)->data
+ 2,
771 XSTRING (filename
)->size
- 2);
772 fn
[XSTRING (filename
)->size
- 2] = 0;
776 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
777 fn
[XSTRING (filename
)->size
] = 0;
780 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
781 strncat (fn
, nsuffix
, lsuffix
);
783 /* Check that the file exists and is not a directory. */
787 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
788 if (! NILP (handler
) && ! exec_only
)
793 string
= build_string (fn
);
794 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
795 : Ffile_readable_p (string
));
797 && ! NILP (Ffile_directory_p (build_string (fn
))))
802 /* We succeeded; return this descriptor and filename. */
804 *storeptr
= build_string (fn
);
811 int exists
= (stat (fn
, &st
) >= 0
812 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
815 /* Check that we can access or open it. */
817 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
819 fd
= open (fn
, O_RDONLY
, 0);
823 /* We succeeded; return this descriptor and filename. */
825 *storeptr
= build_string (fn
);
832 /* Advance to next suffix. */
835 nsuffix
+= lsuffix
+ 1;
846 /* Merge the list we've accumulated of globals from the current input source
847 into the load_history variable. The details depend on whether
848 the source has an associated file name or not. */
851 build_load_history (stream
, source
)
855 register Lisp_Object tail
, prev
, newelt
;
856 register Lisp_Object tem
, tem2
;
857 register int foundit
, loading
;
859 /* Don't bother recording anything for preloaded files. */
860 if (!NILP (Vpurify_flag
))
863 loading
= stream
|| !NARROWED
;
865 tail
= Vload_history
;
872 /* Find the feature's previous assoc list... */
873 if (!NILP (Fequal (source
, Fcar (tem
))))
877 /* If we're loading, remove it. */
881 Vload_history
= Fcdr (tail
);
883 Fsetcdr (prev
, Fcdr (tail
));
886 /* Otherwise, cons on new symbols that are not already members. */
889 tem2
= Vcurrent_load_list
;
893 newelt
= Fcar (tem2
);
895 if (NILP (Fmemq (newelt
, tem
)))
896 Fsetcar (tail
, Fcons (Fcar (tem
),
897 Fcons (newelt
, Fcdr (tem
))));
910 /* If we're loading, cons the new assoc onto the front of load-history,
911 the most-recently-loaded position. Also do this if we didn't find
912 an existing member for the current source. */
913 if (loading
|| !foundit
)
914 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
919 unreadpure () /* Used as unwind-protect function in readevalloop */
929 load_convert_to_unibyte
= ! NILP (old
);
933 /* UNIBYTE specifies how to set load_convert_to_unibyte
934 for this invocation. */
937 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
)
938 Lisp_Object readcharfun
;
940 Lisp_Object sourcename
;
941 Lisp_Object (*evalfun
) ();
946 register Lisp_Object val
;
947 int count
= specpdl_ptr
- specpdl
;
949 struct buffer
*b
= 0;
951 if (BUFFERP (readcharfun
))
952 b
= XBUFFER (readcharfun
);
953 else if (MARKERP (readcharfun
))
954 b
= XMARKER (readcharfun
)->buffer
;
956 specbind (Qstandard_input
, readcharfun
);
957 specbind (Qcurrent_load_list
, Qnil
);
958 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
959 load_convert_to_unibyte
= !NILP (unibyte
);
961 readchar_backlog
= 0;
965 LOADHIST_ATTACH (sourcename
);
969 if (b
!= 0 && NILP (b
->name
))
970 error ("Reading from killed buffer");
976 while ((c
= READCHAR
) != '\n' && c
!= -1);
981 /* Ignore whitespace here, so we can detect eof. */
982 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
985 if (!NILP (Vpurify_flag
) && c
== '(')
987 int count1
= specpdl_ptr
- specpdl
;
988 record_unwind_protect (unreadpure
, Qnil
);
989 val
= read_list (-1, readcharfun
);
990 unbind_to (count1
, Qnil
);
996 if (NILP (Vload_read_function
))
997 val
= read0 (readcharfun
);
999 val
= call1 (Vload_read_function
, readcharfun
);
1002 val
= (*evalfun
) (val
);
1005 Vvalues
= Fcons (val
, Vvalues
);
1006 if (EQ (Vstandard_output
, Qt
))
1013 build_load_history (stream
, sourcename
);
1016 unbind_to (count
, Qnil
);
1021 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 4, "",
1022 "Execute the current buffer as Lisp code.\n\
1023 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1024 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1025 PRINTFLAG controls printing of output:\n\
1026 nil means discard it; anything else is stream for print.\n\
1028 If the optional third argument FILENAME is non-nil,\n\
1029 it specifies the file name to use for `load-history'.\n\
1031 This function preserves the position of point.")
1032 (buffer
, printflag
, filename
, unibyte
)
1033 Lisp_Object buffer
, printflag
, filename
, unibyte
;
1035 int count
= specpdl_ptr
- specpdl
;
1036 Lisp_Object tem
, buf
;
1039 buf
= Fcurrent_buffer ();
1041 buf
= Fget_buffer (buffer
);
1043 error ("No such buffer");
1045 if (NILP (printflag
))
1050 if (NILP (filename
))
1051 filename
= XBUFFER (buf
)->filename
;
1053 specbind (Qstandard_output
, tem
);
1054 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1055 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1056 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
);
1057 unbind_to (count
, Qnil
);
1063 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1064 "Execute the current buffer as Lisp code.\n\
1065 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1066 nil means discard it; anything else is stream for print.\n\
1068 If there is no error, point does not move. If there is an error,\n\
1069 point remains at the end of the last character read from the buffer.")
1071 Lisp_Object printflag
;
1073 int count
= specpdl_ptr
- specpdl
;
1074 Lisp_Object tem
, cbuf
;
1076 cbuf
= Fcurrent_buffer ()
1078 if (NILP (printflag
))
1082 specbind (Qstandard_output
, tem
);
1083 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1085 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1086 !NILP (printflag
), Qnil
);
1087 return unbind_to (count
, Qnil
);
1091 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
1092 "Execute the region as Lisp code.\n\
1093 When called from programs, expects two arguments,\n\
1094 giving starting and ending indices in the current buffer\n\
1095 of the text to be executed.\n\
1096 Programs can pass third argument PRINTFLAG which controls output:\n\
1097 nil means discard it; anything else is stream for printing it.\n\
1099 This function does not move point.")
1100 (start
, end
, printflag
)
1101 Lisp_Object start
, end
, printflag
;
1103 int count
= specpdl_ptr
- specpdl
;
1104 Lisp_Object tem
, cbuf
;
1106 cbuf
= Fcurrent_buffer ();
1108 if (NILP (printflag
))
1112 specbind (Qstandard_output
, tem
);
1114 if (NILP (printflag
))
1115 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1116 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1118 /* This both uses start and checks its type. */
1120 Fnarrow_to_region (make_number (BEGV
), end
);
1121 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1122 !NILP (printflag
), Qnil
);
1124 return unbind_to (count
, Qnil
);
1127 #endif /* standalone */
1129 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1130 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1131 If STREAM is nil, use the value of `standard-input' (which see).\n\
1132 STREAM or the value of `standard-input' may be:\n\
1133 a buffer (read from point and advance it)\n\
1134 a marker (read from where it points and advance it)\n\
1135 a function (call it with no arguments for each character,\n\
1136 call it with a char as argument to push a char back)\n\
1137 a string (takes text from string, starting at the beginning)\n\
1138 t (read text line using minibuffer and use it).")
1142 extern Lisp_Object
Fread_minibuffer ();
1145 stream
= Vstandard_input
;
1146 if (EQ (stream
, Qt
))
1147 stream
= Qread_char
;
1149 readchar_backlog
= 0;
1150 new_backquote_flag
= 0;
1151 read_objects
= Qnil
;
1154 if (EQ (stream
, Qread_char
))
1155 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1158 if (STRINGP (stream
))
1159 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1161 return read0 (stream
);
1164 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1165 "Read one Lisp expression which is represented as text by STRING.\n\
1166 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1167 START and END optionally delimit a substring of STRING from which to read;\n\
1168 they default to 0 and (length STRING) respectively.")
1169 (string
, start
, end
)
1170 Lisp_Object string
, start
, end
;
1172 int startval
, endval
;
1175 CHECK_STRING (string
,0);
1178 endval
= XSTRING (string
)->size
;
1181 CHECK_NUMBER (end
, 2);
1182 endval
= XINT (end
);
1183 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1184 args_out_of_range (string
, end
);
1191 CHECK_NUMBER (start
, 1);
1192 startval
= XINT (start
);
1193 if (startval
< 0 || startval
> endval
)
1194 args_out_of_range (string
, start
);
1197 read_from_string_index
= startval
;
1198 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1199 read_from_string_limit
= endval
;
1201 new_backquote_flag
= 0;
1202 read_objects
= Qnil
;
1204 tem
= read0 (string
);
1205 return Fcons (tem
, make_number (read_from_string_index
));
1208 /* Use this for recursive reads, in contexts where internal tokens
1213 Lisp_Object readcharfun
;
1215 register Lisp_Object val
;
1218 val
= read1 (readcharfun
, &c
, 0);
1220 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1227 static int read_buffer_size
;
1228 static char *read_buffer
;
1230 /* Read multibyte form and return it as a character. C is a first
1231 byte of multibyte form, and rest of them are read from
1235 read_multibyte (c
, readcharfun
)
1237 Lisp_Object readcharfun
;
1239 /* We need the actual character code of this multibyte
1241 unsigned char str
[MAX_LENGTH_OF_MULTI_BYTE_FORM
];
1245 while ((c
= READCHAR
) >= 0xA0
1246 && len
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1249 return STRING_CHAR (str
, len
);
1252 /* Read a \-escape sequence, assuming we already read the `\'. */
1255 read_escape (readcharfun
, stringp
)
1256 Lisp_Object readcharfun
;
1259 register int c
= READCHAR
;
1263 error ("End of file");
1293 error ("Invalid escape character syntax");
1296 c
= read_escape (readcharfun
, 0);
1297 return c
| meta_modifier
;
1302 error ("Invalid escape character syntax");
1305 c
= read_escape (readcharfun
, 0);
1306 return c
| shift_modifier
;
1311 error ("Invalid escape character syntax");
1314 c
= read_escape (readcharfun
, 0);
1315 return c
| hyper_modifier
;
1320 error ("Invalid escape character syntax");
1323 c
= read_escape (readcharfun
, 0);
1324 return c
| alt_modifier
;
1329 error ("Invalid escape character syntax");
1332 c
= read_escape (readcharfun
, 0);
1333 return c
| super_modifier
;
1338 error ("Invalid escape character syntax");
1342 c
= read_escape (readcharfun
, 0);
1343 if ((c
& 0177) == '?')
1345 /* ASCII control chars are made from letters (both cases),
1346 as well as the non-letters within 0100...0137. */
1347 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1348 return (c
& (037 | ~0177));
1349 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1350 return (c
& (037 | ~0177));
1352 return c
| ctrl_modifier
;
1362 /* An octal escape, as in ANSI C. */
1364 register int i
= c
- '0';
1365 register int count
= 0;
1368 if ((c
= READCHAR
) >= '0' && c
<= '7')
1383 /* A hex escape, as in ANSI C. */
1389 if (c
>= '0' && c
<= '9')
1394 else if ((c
>= 'a' && c
<= 'f')
1395 || (c
>= 'A' && c
<= 'F'))
1398 if (c
>= 'a' && c
<= 'f')
1413 if (BASE_LEADING_CODE_P (c
))
1414 c
= read_multibyte (c
, readcharfun
);
1419 /* If the next token is ')' or ']' or '.', we store that character
1420 in *PCH and the return value is not interesting. Else, we store
1421 zero in *PCH and we read and return one lisp object.
1423 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1426 read1 (readcharfun
, pch
, first_in_list
)
1427 register Lisp_Object readcharfun
;
1432 int uninterned_symbol
= 0;
1439 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1444 return read_list (0, readcharfun
);
1447 return read_vector (readcharfun
);
1464 tmp
= read_vector (readcharfun
);
1465 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1466 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1467 error ("Invalid size char-table");
1468 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1469 XCHAR_TABLE (tmp
)->top
= Qt
;
1478 tmp
= read_vector (readcharfun
);
1479 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1480 error ("Invalid size char-table");
1481 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1482 XCHAR_TABLE (tmp
)->top
= Qnil
;
1485 Fsignal (Qinvalid_read_syntax
,
1486 Fcons (make_string ("#^^", 3), Qnil
));
1488 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1493 length
= read1 (readcharfun
, pch
, first_in_list
);
1497 Lisp_Object tmp
, val
;
1498 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1502 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1503 if (size_in_chars
!= XSTRING (tmp
)->size
1504 /* We used to print 1 char too many
1505 when the number of bits was a multiple of 8.
1506 Accept such input in case it came from an old version. */
1507 && ! (XFASTINT (length
)
1508 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1509 Fsignal (Qinvalid_read_syntax
,
1510 Fcons (make_string ("#&...", 5), Qnil
));
1512 val
= Fmake_bool_vector (length
, Qnil
);
1513 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1515 /* Clear the extraneous bits in the last byte. */
1516 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1517 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1518 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1521 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1526 /* Accept compiled functions at read-time so that we don't have to
1527 build them using function calls. */
1529 tmp
= read_vector (readcharfun
);
1530 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1531 XVECTOR (tmp
)->contents
);
1533 #ifdef USE_TEXT_PROPERTIES
1537 struct gcpro gcpro1
;
1540 /* Read the string itself. */
1541 tmp
= read1 (readcharfun
, &ch
, 0);
1542 if (ch
!= 0 || !STRINGP (tmp
))
1543 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1545 /* Read the intervals and their properties. */
1548 Lisp_Object beg
, end
, plist
;
1550 beg
= read1 (readcharfun
, &ch
, 0);
1554 end
= read1 (readcharfun
, &ch
, 0);
1556 plist
= read1 (readcharfun
, &ch
, 0);
1558 Fsignal (Qinvalid_read_syntax
,
1559 Fcons (build_string ("invalid string property list"),
1561 Fset_text_properties (beg
, end
, plist
, tmp
);
1567 /* #@NUMBER is used to skip NUMBER following characters.
1568 That's used in .elc files to skip over doc strings
1569 and function definitions. */
1574 /* Read a decimal integer. */
1575 while ((c
= READCHAR
) >= 0
1576 && c
>= '0' && c
<= '9')
1584 #ifndef DOS_NT /* I don't know if filepos works right on MSDOS and Windoze. */
1585 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1587 /* If we are supposed to force doc strings into core right now,
1588 record the last string that we skipped,
1589 and record where in the file it comes from. */
1590 if (saved_doc_string_size
== 0)
1592 saved_doc_string_size
= nskip
+ 100;
1593 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1595 if (nskip
> saved_doc_string_size
)
1597 saved_doc_string_size
= nskip
+ 100;
1598 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1599 saved_doc_string_size
);
1602 saved_doc_string_position
= ftell (instream
);
1604 /* Copy that many characters into saved_doc_string. */
1605 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1606 saved_doc_string
[i
] = c
= READCHAR
;
1608 saved_doc_string_length
= i
;
1611 #endif /* not DOS_NT */
1613 /* Skip that many characters. */
1614 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1621 return Vload_file_name
;
1623 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1624 /* #:foo is the uninterned symbol named foo. */
1627 uninterned_symbol
= 1;
1631 /* Reader forms that can reuse previously read objects. */
1632 if (c
>= '0' && c
<= '9')
1637 /* Read a non-negative integer. */
1638 while (c
>= '0' && c
<= '9')
1644 /* #n=object returns object, but associates it with n for #n#. */
1647 tem
= read0 (readcharfun
);
1648 read_objects
= Fcons (Fcons (make_number (n
), tem
), read_objects
);
1651 /* #n# returns a previously read object. */
1654 tem
= Fassq (make_number (n
), read_objects
);
1657 /* Fall through to error message. */
1659 /* Fall through to error message. */
1663 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1666 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1671 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1681 new_backquote_flag
= 1;
1682 value
= read0 (readcharfun
);
1683 new_backquote_flag
= 0;
1685 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1689 if (new_backquote_flag
)
1691 Lisp_Object comma_type
= Qnil
;
1696 comma_type
= Qcomma_at
;
1698 comma_type
= Qcomma_dot
;
1701 if (ch
>= 0) UNREAD (ch
);
1702 comma_type
= Qcomma
;
1705 new_backquote_flag
= 0;
1706 value
= read0 (readcharfun
);
1707 new_backquote_flag
= 1;
1708 return Fcons (comma_type
, Fcons (value
, Qnil
));
1715 register Lisp_Object val
;
1718 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1721 c
= read_escape (readcharfun
, 0);
1722 else if (BASE_LEADING_CODE_P (c
))
1723 c
= read_multibyte (c
, readcharfun
);
1725 return make_number (c
);
1730 register char *p
= read_buffer
;
1731 register char *end
= read_buffer
+ read_buffer_size
;
1733 /* Nonzero if we saw an escape sequence specifying
1734 a multibyte character. */
1735 int force_multibyte
= 0;
1736 /* Nonzero if we saw an escape sequence specifying
1737 a single-byte character. */
1738 int force_singlebyte
= 0;
1742 while ((c
= READCHAR
) >= 0
1745 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1747 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1748 p
+= new - read_buffer
;
1749 read_buffer
+= new - read_buffer
;
1750 end
= read_buffer
+ read_buffer_size
;
1755 c
= read_escape (readcharfun
, 1);
1757 /* C is -1 if \ newline has just been seen */
1760 if (p
== read_buffer
)
1765 /* If an escape specifies a non-ASCII single-byte character,
1766 this must be a unibyte string. */
1767 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
))
1768 && ! ASCII_BYTE_P (c
))
1769 force_singlebyte
= 1;
1772 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
)))
1774 unsigned char workbuf
[4];
1775 unsigned char *str
= workbuf
;
1778 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1780 force_multibyte
= 1;
1782 bcopy (str
, p
, length
);
1787 /* Allow `\C- ' and `\C-?'. */
1788 if (c
== (CHAR_CTL
| ' '))
1790 else if (c
== (CHAR_CTL
| '?'))
1794 /* Move the meta bit to the right place for a string. */
1795 c
= (c
& ~CHAR_META
) | 0x80;
1797 error ("Invalid modifier in string");
1802 return Fsignal (Qend_of_file
, Qnil
);
1804 /* If purifying, and string starts with \ newline,
1805 return zero instead. This is for doc strings
1806 that we are really going to find in etc/DOC.nn.nn */
1807 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1808 return make_number (0);
1810 if (force_multibyte
)
1811 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1812 else if (force_singlebyte
)
1813 nchars
= p
- read_buffer
;
1814 else if (load_convert_to_unibyte
)
1817 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1818 if (p
- read_buffer
!= nchars
)
1820 string
= make_multibyte_string (read_buffer
, nchars
,
1822 return Fstring_make_unibyte (string
);
1825 else if (EQ (readcharfun
, Qget_file_char
))
1826 /* Nowadays, reading directly from a file
1827 is used only for compiled Emacs Lisp files,
1828 and those always use the Emacs internal encoding. */
1829 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1831 /* In all other cases, if we read these bytes as
1832 separate characters, treat them as separate characters now. */
1833 nchars
= p
- read_buffer
;
1836 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
1838 || (p
- read_buffer
!= nchars
)));
1839 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
1841 || (p
- read_buffer
!= nchars
)));
1846 #ifdef LISP_FLOAT_TYPE
1847 /* If a period is followed by a number, then we should read it
1848 as a floating point number. Otherwise, it denotes a dotted
1850 int next_char
= READCHAR
;
1853 if (! (next_char
>= '0' && next_char
<= '9'))
1860 /* Otherwise, we fall through! Note that the atom-reading loop
1861 below will now loop at least once, assuring that we will not
1862 try to UNREAD two characters in a row. */
1866 if (c
<= 040) goto retry
;
1868 register char *p
= read_buffer
;
1872 register char *end
= read_buffer
+ read_buffer_size
;
1875 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1876 || c
== '(' || c
== ')'
1877 #ifndef LISP_FLOAT_TYPE
1878 /* If we have floating-point support, then we need
1879 to allow <digits><dot><digits>. */
1881 #endif /* not LISP_FLOAT_TYPE */
1882 || c
== '[' || c
== ']' || c
== '#'
1885 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1887 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1888 p
+= new - read_buffer
;
1889 read_buffer
+= new - read_buffer
;
1890 end
= read_buffer
+ read_buffer_size
;
1898 if (! SINGLE_BYTE_CHAR_P (c
))
1900 unsigned char workbuf
[4];
1901 unsigned char *str
= workbuf
;
1904 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1906 bcopy (str
, p
, length
);
1917 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1918 p
+= new - read_buffer
;
1919 read_buffer
+= new - read_buffer
;
1920 /* end = read_buffer + read_buffer_size; */
1927 if (!quoted
&& !uninterned_symbol
)
1930 register Lisp_Object val
;
1932 if (*p1
== '+' || *p1
== '-') p1
++;
1933 /* Is it an integer? */
1936 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1937 #ifdef LISP_FLOAT_TYPE
1938 /* Integers can have trailing decimal points. */
1939 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
1942 /* It is an integer. */
1944 #ifdef LISP_FLOAT_TYPE
1948 if (sizeof (int) == sizeof (EMACS_INT
))
1949 XSETINT (val
, atoi (read_buffer
));
1950 else if (sizeof (long) == sizeof (EMACS_INT
))
1951 XSETINT (val
, atol (read_buffer
));
1957 #ifdef LISP_FLOAT_TYPE
1958 if (isfloat_string (read_buffer
))
1961 double value
= atof (read_buffer
);
1962 if (read_buffer
[0] == '-' && value
== 0.0)
1964 /* The only way this can be true, after isfloat_string
1965 returns 1, is if the input ends in e+INF or e+NaN. */
1966 if (p
[-1] == 'F' || p
[-1] == 'N')
1969 value
= zero
/ zero
;
1970 else if (read_buffer
[0] == '-')
1971 value
= - 1.0 / zero
;
1975 return make_float (value
);
1980 if (uninterned_symbol
)
1981 return make_symbol (read_buffer
);
1983 return intern (read_buffer
);
1988 #ifdef LISP_FLOAT_TYPE
2005 if (*cp
== '+' || *cp
== '-')
2008 if (*cp
>= '0' && *cp
<= '9')
2011 while (*cp
>= '0' && *cp
<= '9')
2019 if (*cp
>= '0' && *cp
<= '9')
2022 while (*cp
>= '0' && *cp
<= '9')
2025 if (*cp
== 'e' || *cp
== 'E')
2029 if (*cp
== '+' || *cp
== '-')
2033 if (*cp
>= '0' && *cp
<= '9')
2036 while (*cp
>= '0' && *cp
<= '9')
2039 else if (cp
== start
)
2041 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2046 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2052 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2053 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2054 || state
== (DOT_CHAR
|TRAIL_INT
)
2055 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2056 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2057 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2059 #endif /* LISP_FLOAT_TYPE */
2062 read_vector (readcharfun
)
2063 Lisp_Object readcharfun
;
2067 register Lisp_Object
*ptr
;
2068 register Lisp_Object tem
, vector
;
2069 register struct Lisp_Cons
*otem
;
2072 tem
= read_list (1, readcharfun
);
2073 len
= Flength (tem
);
2074 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2077 size
= XVECTOR (vector
)->size
;
2078 ptr
= XVECTOR (vector
)->contents
;
2079 for (i
= 0; i
< size
; i
++)
2081 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
2089 /* FLAG = 1 means check for ] to terminate rather than ) and .
2090 FLAG = -1 means check for starting with defun
2091 and make structure pure. */
2094 read_list (flag
, readcharfun
)
2096 register Lisp_Object readcharfun
;
2098 /* -1 means check next element for defun,
2099 0 means don't check,
2100 1 means already checked and found defun. */
2101 int defunflag
= flag
< 0 ? -1 : 0;
2102 Lisp_Object val
, tail
;
2103 register Lisp_Object elt
, tem
;
2104 struct gcpro gcpro1
, gcpro2
;
2105 /* 0 is the normal case.
2106 1 means this list is a doc reference; replace it with the number 0.
2107 2 means this list is a doc reference; replace it with the doc string. */
2108 int doc_reference
= 0;
2110 /* Initialize this to 1 if we are reading a list. */
2111 int first_in_list
= flag
<= 0;
2120 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2125 /* While building, if the list starts with #$, treat it specially. */
2126 if (EQ (elt
, Vload_file_name
)
2128 && !NILP (Vpurify_flag
))
2130 if (NILP (Vdoc_file_name
))
2131 /* We have not yet called Snarf-documentation, so assume
2132 this file is described in the DOC-MM.NN file
2133 and Snarf-documentation will fill in the right value later.
2134 For now, replace the whole list with 0. */
2137 /* We have already called Snarf-documentation, so make a relative
2138 file name for this file, so it can be found properly
2139 in the installed Lisp directory.
2140 We don't use Fexpand_file_name because that would make
2141 the directory absolute now. */
2142 elt
= concat2 (build_string ("../lisp/"),
2143 Ffile_name_nondirectory (elt
));
2145 else if (EQ (elt
, Vload_file_name
)
2147 && load_force_doc_strings
)
2156 Fsignal (Qinvalid_read_syntax
,
2157 Fcons (make_string (") or . in a vector", 18), Qnil
));
2165 XCONS (tail
)->cdr
= read0 (readcharfun
);
2167 val
= read0 (readcharfun
);
2168 read1 (readcharfun
, &ch
, 0);
2172 if (doc_reference
== 1)
2173 return make_number (0);
2174 if (doc_reference
== 2)
2176 /* Get a doc string from the file we are loading.
2177 If it's in saved_doc_string, get it from there. */
2178 int pos
= XINT (XCONS (val
)->cdr
);
2179 if (pos
>= saved_doc_string_position
2180 && pos
< (saved_doc_string_position
2181 + saved_doc_string_length
))
2183 int start
= pos
- saved_doc_string_position
;
2186 /* Process quoting with ^A,
2187 and find the end of the string,
2188 which is marked with ^_ (037). */
2189 for (from
= start
, to
= start
;
2190 saved_doc_string
[from
] != 037;)
2192 int c
= saved_doc_string
[from
++];
2195 c
= saved_doc_string
[from
++];
2197 saved_doc_string
[to
++] = c
;
2199 saved_doc_string
[to
++] = 0;
2201 saved_doc_string
[to
++] = 037;
2204 saved_doc_string
[to
++] = c
;
2207 return make_string (saved_doc_string
+ start
,
2211 return read_doc_string (val
);
2216 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2218 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2220 tem
= (read_pure
&& flag
<= 0
2221 ? pure_cons (elt
, Qnil
)
2222 : Fcons (elt
, Qnil
));
2224 XCONS (tail
)->cdr
= tem
;
2229 defunflag
= EQ (elt
, Qdefun
);
2230 else if (defunflag
> 0)
2235 Lisp_Object Vobarray
;
2236 Lisp_Object initial_obarray
;
2238 /* oblookup stores the bucket number here, for the sake of Funintern. */
2240 int oblookup_last_bucket_number
;
2242 static int hash_string ();
2243 Lisp_Object
oblookup ();
2245 /* Get an error if OBARRAY is not an obarray.
2246 If it is one, return it. */
2249 check_obarray (obarray
)
2250 Lisp_Object obarray
;
2252 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2254 /* If Vobarray is now invalid, force it to be valid. */
2255 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2257 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2262 /* Intern the C string STR: return a symbol with that name,
2263 interned in the current obarray. */
2270 int len
= strlen (str
);
2271 Lisp_Object obarray
;
2274 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2275 obarray
= check_obarray (obarray
);
2276 tem
= oblookup (obarray
, str
, len
, len
);
2279 return Fintern (make_string (str
, len
), obarray
);
2282 /* Create an uninterned symbol with name STR. */
2288 int len
= strlen (str
);
2290 return Fmake_symbol ((!NILP (Vpurify_flag
)
2291 ? make_pure_string (str
, len
, len
, 0)
2292 : make_string (str
, len
)));
2295 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2296 "Return the canonical symbol whose name is STRING.\n\
2297 If there is none, one is created by this function and returned.\n\
2298 A second optional argument specifies the obarray to use;\n\
2299 it defaults to the value of `obarray'.")
2301 Lisp_Object string
, obarray
;
2303 register Lisp_Object tem
, sym
, *ptr
;
2305 if (NILP (obarray
)) obarray
= Vobarray
;
2306 obarray
= check_obarray (obarray
);
2308 CHECK_STRING (string
, 0);
2310 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2311 XSTRING (string
)->size
,
2312 STRING_BYTES (XSTRING (string
)));
2313 if (!INTEGERP (tem
))
2316 if (!NILP (Vpurify_flag
))
2317 string
= Fpurecopy (string
);
2318 sym
= Fmake_symbol (string
);
2319 XSYMBOL (sym
)->obarray
= obarray
;
2321 if ((XSTRING (string
)->data
[0] == ':')
2322 && obarray
== initial_obarray
)
2323 XSYMBOL (sym
)->value
= sym
;
2325 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2327 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2329 XSYMBOL (sym
)->next
= 0;
2334 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2335 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2336 A second optional argument specifies the obarray to use;\n\
2337 it defaults to the value of `obarray'.")
2339 Lisp_Object string
, obarray
;
2341 register Lisp_Object tem
;
2343 if (NILP (obarray
)) obarray
= Vobarray
;
2344 obarray
= check_obarray (obarray
);
2346 CHECK_STRING (string
, 0);
2348 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2349 XSTRING (string
)->size
,
2350 STRING_BYTES (XSTRING (string
)));
2351 if (!INTEGERP (tem
))
2356 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2357 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2358 The value is t if a symbol was found and deleted, nil otherwise.\n\
2359 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2360 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2361 OBARRAY defaults to the value of the variable `obarray'.")
2363 Lisp_Object name
, obarray
;
2365 register Lisp_Object string
, tem
;
2368 if (NILP (obarray
)) obarray
= Vobarray
;
2369 obarray
= check_obarray (obarray
);
2372 XSETSTRING (string
, XSYMBOL (name
)->name
);
2375 CHECK_STRING (name
, 0);
2379 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2380 XSTRING (string
)->size
,
2381 STRING_BYTES (XSTRING (string
)));
2384 /* If arg was a symbol, don't delete anything but that symbol itself. */
2385 if (SYMBOLP (name
) && !EQ (name
, tem
))
2388 XSYMBOL (tem
)->obarray
= Qnil
;
2390 hash
= oblookup_last_bucket_number
;
2392 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2394 if (XSYMBOL (tem
)->next
)
2395 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2397 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2401 Lisp_Object tail
, following
;
2403 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2404 XSYMBOL (tail
)->next
;
2407 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2408 if (EQ (following
, tem
))
2410 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2419 /* Return the symbol in OBARRAY whose names matches the string
2420 of SIZE characters (SIZE_BYTE bytes) at PTR.
2421 If there is no such symbol in OBARRAY, return nil.
2423 Also store the bucket number in oblookup_last_bucket_number. */
2426 oblookup (obarray
, ptr
, size
, size_byte
)
2427 Lisp_Object obarray
;
2429 int size
, size_byte
;
2433 register Lisp_Object tail
;
2434 Lisp_Object bucket
, tem
;
2436 if (!VECTORP (obarray
)
2437 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2439 obarray
= check_obarray (obarray
);
2440 obsize
= XVECTOR (obarray
)->size
;
2442 /* This is sometimes needed in the middle of GC. */
2443 obsize
&= ~ARRAY_MARK_FLAG
;
2444 /* Combining next two lines breaks VMS C 2.3. */
2445 hash
= hash_string (ptr
, size_byte
);
2447 bucket
= XVECTOR (obarray
)->contents
[hash
];
2448 oblookup_last_bucket_number
= hash
;
2449 if (XFASTINT (bucket
) == 0)
2451 else if (!SYMBOLP (bucket
))
2452 error ("Bad data in guts of obarray"); /* Like CADR error message */
2454 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2456 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2457 && XSYMBOL (tail
)->name
->size
== size
2458 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2460 else if (XSYMBOL (tail
)->next
== 0)
2463 XSETINT (tem
, hash
);
2468 hash_string (ptr
, len
)
2472 register unsigned char *p
= ptr
;
2473 register unsigned char *end
= p
+ len
;
2474 register unsigned char c
;
2475 register int hash
= 0;
2480 if (c
>= 0140) c
-= 40;
2481 hash
= ((hash
<<3) + (hash
>>28) + c
);
2483 return hash
& 07777777777;
2487 map_obarray (obarray
, fn
, arg
)
2488 Lisp_Object obarray
;
2489 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2493 register Lisp_Object tail
;
2494 CHECK_VECTOR (obarray
, 1);
2495 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2497 tail
= XVECTOR (obarray
)->contents
[i
];
2502 if (XSYMBOL (tail
)->next
== 0)
2504 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2510 mapatoms_1 (sym
, function
)
2511 Lisp_Object sym
, function
;
2513 call1 (function
, sym
);
2516 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2517 "Call FUNCTION on every symbol in OBARRAY.\n\
2518 OBARRAY defaults to the value of `obarray'.")
2520 Lisp_Object function
, obarray
;
2524 if (NILP (obarray
)) obarray
= Vobarray
;
2525 obarray
= check_obarray (obarray
);
2527 map_obarray (obarray
, mapatoms_1
, function
);
2531 #define OBARRAY_SIZE 1511
2536 Lisp_Object oblength
;
2540 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2542 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
2543 Vobarray
= Fmake_vector (oblength
, make_number (0));
2544 initial_obarray
= Vobarray
;
2545 staticpro (&initial_obarray
);
2546 /* Intern nil in the obarray */
2547 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2548 /* These locals are to kludge around a pyramid compiler bug. */
2549 hash
= hash_string ("nil", 3);
2550 /* Separate statement here to avoid VAXC bug. */
2551 hash
%= OBARRAY_SIZE
;
2552 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2555 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
2556 XSYMBOL (Qnil
)->function
= Qunbound
;
2557 XSYMBOL (Qunbound
)->value
= Qunbound
;
2558 XSYMBOL (Qunbound
)->function
= Qunbound
;
2561 XSYMBOL (Qnil
)->value
= Qnil
;
2562 XSYMBOL (Qnil
)->plist
= Qnil
;
2563 XSYMBOL (Qt
)->value
= Qt
;
2565 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2568 Qvariable_documentation
= intern ("variable-documentation");
2569 staticpro (&Qvariable_documentation
);
2571 read_buffer_size
= 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM
;
2572 read_buffer
= (char *) malloc (read_buffer_size
);
2577 struct Lisp_Subr
*sname
;
2580 sym
= intern (sname
->symbol_name
);
2581 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2584 #ifdef NOTDEF /* use fset in subr.el now */
2586 defalias (sname
, string
)
2587 struct Lisp_Subr
*sname
;
2591 sym
= intern (string
);
2592 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2596 /* Define an "integer variable"; a symbol whose value is forwarded
2597 to a C variable of type int. Sample call: */
2598 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2600 defvar_int (namestring
, address
)
2604 Lisp_Object sym
, val
;
2605 sym
= intern (namestring
);
2606 val
= allocate_misc ();
2607 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2608 XINTFWD (val
)->intvar
= address
;
2609 XSYMBOL (sym
)->value
= val
;
2612 /* Similar but define a variable whose value is T if address contains 1,
2613 NIL if address contains 0 */
2615 defvar_bool (namestring
, address
)
2619 Lisp_Object sym
, val
;
2620 sym
= intern (namestring
);
2621 val
= allocate_misc ();
2622 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2623 XBOOLFWD (val
)->boolvar
= address
;
2624 XSYMBOL (sym
)->value
= val
;
2627 /* Similar but define a variable whose value is the Lisp Object stored
2628 at address. Two versions: with and without gc-marking of the C
2629 variable. The nopro version is used when that variable will be
2630 gc-marked for some other reason, since marking the same slot twice
2631 can cause trouble with strings. */
2633 defvar_lisp_nopro (namestring
, address
)
2635 Lisp_Object
*address
;
2637 Lisp_Object sym
, val
;
2638 sym
= intern (namestring
);
2639 val
= allocate_misc ();
2640 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2641 XOBJFWD (val
)->objvar
= address
;
2642 XSYMBOL (sym
)->value
= val
;
2646 defvar_lisp (namestring
, address
)
2648 Lisp_Object
*address
;
2650 defvar_lisp_nopro (namestring
, address
);
2651 staticpro (address
);
2656 /* Similar but define a variable whose value is the Lisp Object stored in
2657 the current buffer. address is the address of the slot in the buffer
2658 that is current now. */
2661 defvar_per_buffer (namestring
, address
, type
, doc
)
2663 Lisp_Object
*address
;
2667 Lisp_Object sym
, val
;
2669 extern struct buffer buffer_local_symbols
;
2671 sym
= intern (namestring
);
2672 val
= allocate_misc ();
2673 offset
= (char *)address
- (char *)current_buffer
;
2675 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2676 XBUFFER_OBJFWD (val
)->offset
= offset
;
2677 XSYMBOL (sym
)->value
= val
;
2678 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2679 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2680 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2681 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2682 slot of buffer_local_flags */
2686 #endif /* standalone */
2688 /* Similar but define a variable whose value is the Lisp Object stored
2689 at a particular offset in the current kboard object. */
2692 defvar_kboard (namestring
, offset
)
2696 Lisp_Object sym
, val
;
2697 sym
= intern (namestring
);
2698 val
= allocate_misc ();
2699 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2700 XKBOARD_OBJFWD (val
)->offset
= offset
;
2701 XSYMBOL (sym
)->value
= val
;
2704 /* Record the value of load-path used at the start of dumping
2705 so we can see if the site changed it later during dumping. */
2706 static Lisp_Object dump_path
;
2712 int turn_off_warning
= 0;
2714 #ifdef HAVE_SETLOCALE
2715 /* Make sure numbers are parsed as we expect. */
2716 setlocale (LC_NUMERIC
, "C");
2717 #endif /* HAVE_SETLOCALE */
2719 /* Compute the default load-path. */
2721 normal
= PATH_LOADSEARCH
;
2722 Vload_path
= decode_env_path (0, normal
);
2724 if (NILP (Vpurify_flag
))
2725 normal
= PATH_LOADSEARCH
;
2727 normal
= PATH_DUMPLOADSEARCH
;
2729 /* In a dumped Emacs, we normally have to reset the value of
2730 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2731 uses ../lisp, instead of the path of the installed elisp
2732 libraries. However, if it appears that Vload_path was changed
2733 from the default before dumping, don't override that value. */
2736 if (! NILP (Fequal (dump_path
, Vload_path
)))
2738 Vload_path
= decode_env_path (0, normal
);
2739 if (!NILP (Vinstallation_directory
))
2741 /* Add to the path the lisp subdir of the
2742 installation dir, if it exists. */
2743 Lisp_Object tem
, tem1
;
2744 tem
= Fexpand_file_name (build_string ("lisp"),
2745 Vinstallation_directory
);
2746 tem1
= Ffile_exists_p (tem
);
2749 if (NILP (Fmember (tem
, Vload_path
)))
2751 turn_off_warning
= 1;
2752 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2756 /* That dir doesn't exist, so add the build-time
2757 Lisp dirs instead. */
2758 Vload_path
= nconc2 (Vload_path
, dump_path
);
2760 /* Add leim under the installation dir, if it exists. */
2761 tem
= Fexpand_file_name (build_string ("leim"),
2762 Vinstallation_directory
);
2763 tem1
= Ffile_exists_p (tem
);
2766 if (NILP (Fmember (tem
, Vload_path
)))
2767 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2770 /* Add site-list under the installation dir, if it exists. */
2771 tem
= Fexpand_file_name (build_string ("site-lisp"),
2772 Vinstallation_directory
);
2773 tem1
= Ffile_exists_p (tem
);
2776 if (NILP (Fmember (tem
, Vload_path
)))
2777 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2780 /* If Emacs was not built in the source directory,
2781 and it is run from where it was built, add to load-path
2782 the lisp, leim and site-lisp dirs under that directory. */
2784 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
2788 tem
= Fexpand_file_name (build_string ("src/Makefile"),
2789 Vinstallation_directory
);
2790 tem1
= Ffile_exists_p (tem
);
2792 /* Don't be fooled if they moved the entire source tree
2793 AFTER dumping Emacs. If the build directory is indeed
2794 different from the source dir, src/Makefile.in and
2795 src/Makefile will not be found together. */
2796 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
2797 Vinstallation_directory
);
2798 tem2
= Ffile_exists_p (tem
);
2799 if (!NILP (tem1
) && NILP (tem2
))
2801 tem
= Fexpand_file_name (build_string ("lisp"),
2804 if (NILP (Fmember (tem
, Vload_path
)))
2805 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2807 tem
= Fexpand_file_name (build_string ("leim"),
2810 if (NILP (Fmember (tem
, Vload_path
)))
2811 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2813 tem
= Fexpand_file_name (build_string ("site-lisp"),
2816 if (NILP (Fmember (tem
, Vload_path
)))
2817 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2825 /* NORMAL refers to the lisp dir in the source directory. */
2826 /* We used to add ../lisp at the front here, but
2827 that caused trouble because it was copied from dump_path
2828 into Vload_path, aboe, when Vinstallation_directory was non-nil.
2829 It should be unnecessary. */
2830 Vload_path
= decode_env_path (0, normal
);
2831 dump_path
= Vload_path
;
2836 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
2837 almost never correct, thereby causing a warning to be printed out that
2838 confuses users. Since PATH_LOADSEARCH is always overridden by the
2839 EMACSLOADPATH environment variable below, disable the warning on NT. */
2841 /* Warn if dirs in the *standard* path don't exist. */
2842 if (!turn_off_warning
)
2844 Lisp_Object path_tail
;
2846 for (path_tail
= Vload_path
;
2848 path_tail
= XCONS (path_tail
)->cdr
)
2850 Lisp_Object dirfile
;
2851 dirfile
= Fcar (path_tail
);
2852 if (STRINGP (dirfile
))
2854 dirfile
= Fdirectory_file_name (dirfile
);
2855 if (access (XSTRING (dirfile
)->data
, 0) < 0)
2856 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
2857 XCONS (path_tail
)->car
);
2861 #endif /* WINDOWSNT */
2863 /* If the EMACSLOADPATH environment variable is set, use its value.
2864 This doesn't apply if we're dumping. */
2866 if (NILP (Vpurify_flag
)
2867 && egetenv ("EMACSLOADPATH"))
2869 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
2873 load_in_progress
= 0;
2874 Vload_file_name
= Qnil
;
2876 load_descriptor_list
= Qnil
;
2878 Vstandard_input
= Qt
;
2881 /* Print a warning, using format string FORMAT, that directory DIRNAME
2882 does not exist. Print it on stderr and put it in *Message*. */
2885 dir_warning (format
, dirname
)
2887 Lisp_Object dirname
;
2890 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
2892 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
2893 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
2894 /* Don't log the warning before we've initialized!! */
2896 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
2903 defsubr (&Sread_from_string
);
2905 defsubr (&Sintern_soft
);
2906 defsubr (&Sunintern
);
2908 defsubr (&Seval_buffer
);
2909 defsubr (&Seval_region
);
2910 defsubr (&Sread_char
);
2911 defsubr (&Sread_char_exclusive
);
2912 defsubr (&Sread_event
);
2913 defsubr (&Sget_file_char
);
2914 defsubr (&Smapatoms
);
2916 DEFVAR_LISP ("obarray", &Vobarray
,
2917 "Symbol table for use by `intern' and `read'.\n\
2918 It is a vector whose length ought to be prime for best results.\n\
2919 The vector's contents don't make sense if examined from Lisp programs;\n\
2920 to find all the symbols in an obarray, use `mapatoms'.");
2922 DEFVAR_LISP ("values", &Vvalues
,
2923 "List of values of all expressions which were read, evaluated and printed.\n\
2924 Order is reverse chronological.");
2926 DEFVAR_LISP ("standard-input", &Vstandard_input
,
2927 "Stream for read to get input from.\n\
2928 See documentation of `read' for possible values.");
2929 Vstandard_input
= Qt
;
2931 DEFVAR_LISP ("load-path", &Vload_path
,
2932 "*List of directories to search for files to load.\n\
2933 Each element is a string (directory name) or nil (try default directory).\n\
2934 Initialized based on EMACSLOADPATH environment variable, if any,\n\
2935 otherwise to default specified by file `paths.h' when Emacs was built.");
2937 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
2938 "Non-nil iff inside of `load'.");
2940 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
2941 "An alist of expressions to be evalled when particular files are loaded.\n\
2942 Each element looks like (FILENAME FORMS...).\n\
2943 When `load' is run and the file-name argument is FILENAME,\n\
2944 the FORMS in the corresponding element are executed at the end of loading.\n\n\
2945 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
2946 with no directory specified, since that is how `load' is normally called.\n\
2947 An error in FORMS does not undo the load,\n\
2948 but does prevent execution of the rest of the FORMS.");
2949 Vafter_load_alist
= Qnil
;
2951 DEFVAR_LISP ("load-history", &Vload_history
,
2952 "Alist mapping source file names to symbols and features.\n\
2953 Each alist element is a list that starts with a file name,\n\
2954 except for one element (optional) that starts with nil and describes\n\
2955 definitions evaluated from buffers not visiting files.\n\
2956 The remaining elements of each list are symbols defined as functions\n\
2957 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2958 Vload_history
= Qnil
;
2960 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
2961 "Full name of file being loaded by `load'.");
2962 Vload_file_name
= Qnil
;
2964 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
2965 "Used for internal purposes by `load'.");
2966 Vcurrent_load_list
= Qnil
;
2968 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
2969 "Function used by `load' and `eval-region' for reading expressions.\n\
2970 The default is nil, which means use the function `read'.");
2971 Vload_read_function
= Qnil
;
2973 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
2974 "Function called in `load' for loading an Emacs lisp source file.\n\
2975 This function is for doing code conversion before reading the source file.\n\
2976 If nil, loading is done without any code conversion.\n\
2977 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
2978 FULLNAME is the full name of FILE.\n\
2979 See `load' for the meaning of the remaining arguments.");
2980 Vload_source_file_function
= Qnil
;
2982 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
2983 "Non-nil means `load' should force-load all dynamic doc strings.\n\
2984 This is useful when the file being loaded is a temporary copy.");
2985 load_force_doc_strings
= 0;
2987 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
2988 "Non-nil means `load' converts strings to unibyte whenever possible.\n\
2989 This is normally used in `load-with-code-conversion'\n\
2990 for loading non-compiled files.");
2991 load_convert_to_unibyte
= 0;
2993 DEFVAR_LISP ("source-directory", &Vsource_directory
,
2994 "Directory in which Emacs sources were found when Emacs was built.\n\
2995 You cannot count on them to still be there!");
2997 = Fexpand_file_name (build_string ("../"),
2998 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3000 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3001 "List of files that were preloaded (when dumping Emacs).");
3002 Vpreloaded_file_list
= Qnil
;
3004 /* Vsource_directory was initialized in init_lread. */
3006 load_descriptor_list
= Qnil
;
3007 staticpro (&load_descriptor_list
);
3009 Qcurrent_load_list
= intern ("current-load-list");
3010 staticpro (&Qcurrent_load_list
);
3012 Qstandard_input
= intern ("standard-input");
3013 staticpro (&Qstandard_input
);
3015 Qread_char
= intern ("read-char");
3016 staticpro (&Qread_char
);
3018 Qget_file_char
= intern ("get-file-char");
3019 staticpro (&Qget_file_char
);
3021 Qbackquote
= intern ("`");
3022 staticpro (&Qbackquote
);
3023 Qcomma
= intern (",");
3024 staticpro (&Qcomma
);
3025 Qcomma_at
= intern (",@");
3026 staticpro (&Qcomma_at
);
3027 Qcomma_dot
= intern (",.");
3028 staticpro (&Qcomma_dot
);
3030 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3031 staticpro (&Qinhibit_file_name_operation
);
3033 Qascii_character
= intern ("ascii-character");
3034 staticpro (&Qascii_character
);
3036 Qfunction
= intern ("function");
3037 staticpro (&Qfunction
);
3039 Qload
= intern ("load");
3042 Qload_file_name
= intern ("load-file-name");
3043 staticpro (&Qload_file_name
);
3045 staticpro (&dump_path
);
3047 staticpro (&read_objects
);
3048 read_objects
= Qnil
;