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
,
1517 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1522 /* Accept compiled functions at read-time so that we don't have to
1523 build them using function calls. */
1525 tmp
= read_vector (readcharfun
);
1526 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1527 XVECTOR (tmp
)->contents
);
1529 #ifdef USE_TEXT_PROPERTIES
1533 struct gcpro gcpro1
;
1536 /* Read the string itself. */
1537 tmp
= read1 (readcharfun
, &ch
, 0);
1538 if (ch
!= 0 || !STRINGP (tmp
))
1539 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1541 /* Read the intervals and their properties. */
1544 Lisp_Object beg
, end
, plist
;
1546 beg
= read1 (readcharfun
, &ch
, 0);
1550 end
= read1 (readcharfun
, &ch
, 0);
1552 plist
= read1 (readcharfun
, &ch
, 0);
1554 Fsignal (Qinvalid_read_syntax
,
1555 Fcons (build_string ("invalid string property list"),
1557 Fset_text_properties (beg
, end
, plist
, tmp
);
1563 /* #@NUMBER is used to skip NUMBER following characters.
1564 That's used in .elc files to skip over doc strings
1565 and function definitions. */
1570 /* Read a decimal integer. */
1571 while ((c
= READCHAR
) >= 0
1572 && c
>= '0' && c
<= '9')
1580 #ifndef DOS_NT /* I don't know if filepos works right on MSDOS and Windoze. */
1581 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1583 /* If we are supposed to force doc strings into core right now,
1584 record the last string that we skipped,
1585 and record where in the file it comes from. */
1586 if (saved_doc_string_size
== 0)
1588 saved_doc_string_size
= nskip
+ 100;
1589 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1591 if (nskip
> saved_doc_string_size
)
1593 saved_doc_string_size
= nskip
+ 100;
1594 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1595 saved_doc_string_size
);
1598 saved_doc_string_position
= ftell (instream
);
1600 /* Copy that many characters into saved_doc_string. */
1601 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1602 saved_doc_string
[i
] = c
= READCHAR
;
1604 saved_doc_string_length
= i
;
1607 #endif /* not DOS_NT */
1609 /* Skip that many characters. */
1610 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1617 return Vload_file_name
;
1619 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1620 /* #:foo is the uninterned symbol named foo. */
1623 uninterned_symbol
= 1;
1627 /* Reader forms that can reuse previously read objects. */
1628 if (c
>= '0' && c
<= '9')
1633 /* Read a non-negative integer. */
1634 while (c
>= '0' && c
<= '9')
1640 /* #n=object returns object, but associates it with n for #n#. */
1643 tem
= read0 (readcharfun
);
1644 read_objects
= Fcons (Fcons (make_number (n
), tem
), read_objects
);
1647 /* #n# returns a previously read object. */
1650 tem
= Fassq (make_number (n
), read_objects
);
1653 /* Fall through to error message. */
1655 /* Fall through to error message. */
1659 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1662 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1667 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1677 new_backquote_flag
= 1;
1678 value
= read0 (readcharfun
);
1679 new_backquote_flag
= 0;
1681 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1685 if (new_backquote_flag
)
1687 Lisp_Object comma_type
= Qnil
;
1692 comma_type
= Qcomma_at
;
1694 comma_type
= Qcomma_dot
;
1697 if (ch
>= 0) UNREAD (ch
);
1698 comma_type
= Qcomma
;
1701 new_backquote_flag
= 0;
1702 value
= read0 (readcharfun
);
1703 new_backquote_flag
= 1;
1704 return Fcons (comma_type
, Fcons (value
, Qnil
));
1711 register Lisp_Object val
;
1714 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1717 c
= read_escape (readcharfun
, 0);
1718 else if (BASE_LEADING_CODE_P (c
))
1719 c
= read_multibyte (c
, readcharfun
);
1721 return make_number (c
);
1726 register char *p
= read_buffer
;
1727 register char *end
= read_buffer
+ read_buffer_size
;
1729 /* Nonzero if we saw an escape sequence specifying
1730 a multibyte character. */
1731 int force_multibyte
= 0;
1732 /* Nonzero if we saw an escape sequence specifying
1733 a single-byte character. */
1734 int force_singlebyte
= 0;
1738 while ((c
= READCHAR
) >= 0
1741 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1743 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1744 p
+= new - read_buffer
;
1745 read_buffer
+= new - read_buffer
;
1746 end
= read_buffer
+ read_buffer_size
;
1751 c
= read_escape (readcharfun
, 1);
1753 /* C is -1 if \ newline has just been seen */
1756 if (p
== read_buffer
)
1761 /* If an escape specifies a non-ASCII single-byte character,
1762 this must be a unibyte string. */
1763 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
))
1764 && ! ASCII_BYTE_P (c
))
1765 force_singlebyte
= 1;
1768 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
)))
1770 unsigned char workbuf
[4];
1771 unsigned char *str
= workbuf
;
1774 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1776 force_multibyte
= 1;
1778 bcopy (str
, p
, length
);
1783 /* Allow `\C- ' and `\C-?'. */
1784 if (c
== (CHAR_CTL
| ' '))
1786 else if (c
== (CHAR_CTL
| '?'))
1790 /* Move the meta bit to the right place for a string. */
1791 c
= (c
& ~CHAR_META
) | 0x80;
1793 error ("Invalid modifier in string");
1798 return Fsignal (Qend_of_file
, Qnil
);
1800 /* If purifying, and string starts with \ newline,
1801 return zero instead. This is for doc strings
1802 that we are really going to find in etc/DOC.nn.nn */
1803 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1804 return make_number (0);
1806 if (force_multibyte
)
1807 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1808 else if (force_singlebyte
)
1809 nchars
= p
- read_buffer
;
1810 else if (load_convert_to_unibyte
)
1813 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1814 if (p
- read_buffer
!= nchars
)
1816 string
= make_multibyte_string (read_buffer
, nchars
,
1818 return Fstring_make_unibyte (string
);
1821 else if (EQ (readcharfun
, Qget_file_char
))
1822 /* Nowadays, reading directly from a file
1823 is used only for compiled Emacs Lisp files,
1824 and those always use the Emacs internal encoding. */
1825 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1827 /* In all other cases, if we read these bytes as
1828 separate characters, treat them as separate characters now. */
1829 nchars
= p
- read_buffer
;
1832 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
1834 || (p
- read_buffer
!= nchars
)));
1835 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
1837 || (p
- read_buffer
!= nchars
)));
1842 #ifdef LISP_FLOAT_TYPE
1843 /* If a period is followed by a number, then we should read it
1844 as a floating point number. Otherwise, it denotes a dotted
1846 int next_char
= READCHAR
;
1849 if (! (next_char
>= '0' && next_char
<= '9'))
1856 /* Otherwise, we fall through! Note that the atom-reading loop
1857 below will now loop at least once, assuring that we will not
1858 try to UNREAD two characters in a row. */
1862 if (c
<= 040) goto retry
;
1864 register char *p
= read_buffer
;
1868 register char *end
= read_buffer
+ read_buffer_size
;
1871 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1872 || c
== '(' || c
== ')'
1873 #ifndef LISP_FLOAT_TYPE
1874 /* If we have floating-point support, then we need
1875 to allow <digits><dot><digits>. */
1877 #endif /* not LISP_FLOAT_TYPE */
1878 || c
== '[' || c
== ']' || c
== '#'
1881 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1883 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1884 p
+= new - read_buffer
;
1885 read_buffer
+= new - read_buffer
;
1886 end
= read_buffer
+ read_buffer_size
;
1894 if (! SINGLE_BYTE_CHAR_P (c
))
1896 unsigned char workbuf
[4];
1897 unsigned char *str
= workbuf
;
1900 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1902 bcopy (str
, p
, length
);
1913 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1914 p
+= new - read_buffer
;
1915 read_buffer
+= new - read_buffer
;
1916 /* end = read_buffer + read_buffer_size; */
1923 if (!quoted
&& !uninterned_symbol
)
1926 register Lisp_Object val
;
1928 if (*p1
== '+' || *p1
== '-') p1
++;
1929 /* Is it an integer? */
1932 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1933 #ifdef LISP_FLOAT_TYPE
1934 /* Integers can have trailing decimal points. */
1935 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
1938 /* It is an integer. */
1940 #ifdef LISP_FLOAT_TYPE
1944 if (sizeof (int) == sizeof (EMACS_INT
))
1945 XSETINT (val
, atoi (read_buffer
));
1946 else if (sizeof (long) == sizeof (EMACS_INT
))
1947 XSETINT (val
, atol (read_buffer
));
1953 #ifdef LISP_FLOAT_TYPE
1954 if (isfloat_string (read_buffer
))
1957 double value
= atof (read_buffer
);
1958 if (read_buffer
[0] == '-' && value
== 0.0)
1960 /* The only way this can be true, after isfloat_string
1961 returns 1, is if the input ends in e+INF or e+NaN. */
1962 if (p
[-1] == 'F' || p
[-1] == 'N')
1965 value
= zero
/ zero
;
1966 else if (read_buffer
[0] == '-')
1967 value
= - 1.0 / zero
;
1971 return make_float (value
);
1976 if (uninterned_symbol
)
1977 return make_symbol (read_buffer
);
1979 return intern (read_buffer
);
1984 #ifdef LISP_FLOAT_TYPE
1999 if (*cp
== '+' || *cp
== '-')
2002 if (*cp
>= '0' && *cp
<= '9')
2005 while (*cp
>= '0' && *cp
<= '9')
2013 if (*cp
>= '0' && *cp
<= '9')
2016 while (*cp
>= '0' && *cp
<= '9')
2019 if (*cp
== 'e' || *cp
== 'E')
2023 if (*cp
== '+' || *cp
== '-')
2027 if (*cp
>= '0' && *cp
<= '9')
2030 while (*cp
>= '0' && *cp
<= '9')
2033 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2038 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2044 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2045 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2046 || state
== (DOT_CHAR
|TRAIL_INT
)
2047 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2048 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2049 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2051 #endif /* LISP_FLOAT_TYPE */
2054 read_vector (readcharfun
)
2055 Lisp_Object readcharfun
;
2059 register Lisp_Object
*ptr
;
2060 register Lisp_Object tem
, vector
;
2061 register struct Lisp_Cons
*otem
;
2064 tem
= read_list (1, readcharfun
);
2065 len
= Flength (tem
);
2066 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2069 size
= XVECTOR (vector
)->size
;
2070 ptr
= XVECTOR (vector
)->contents
;
2071 for (i
= 0; i
< size
; i
++)
2073 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
2081 /* FLAG = 1 means check for ] to terminate rather than ) and .
2082 FLAG = -1 means check for starting with defun
2083 and make structure pure. */
2086 read_list (flag
, readcharfun
)
2088 register Lisp_Object readcharfun
;
2090 /* -1 means check next element for defun,
2091 0 means don't check,
2092 1 means already checked and found defun. */
2093 int defunflag
= flag
< 0 ? -1 : 0;
2094 Lisp_Object val
, tail
;
2095 register Lisp_Object elt
, tem
;
2096 struct gcpro gcpro1
, gcpro2
;
2097 /* 0 is the normal case.
2098 1 means this list is a doc reference; replace it with the number 0.
2099 2 means this list is a doc reference; replace it with the doc string. */
2100 int doc_reference
= 0;
2102 /* Initialize this to 1 if we are reading a list. */
2103 int first_in_list
= flag
<= 0;
2112 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2117 /* While building, if the list starts with #$, treat it specially. */
2118 if (EQ (elt
, Vload_file_name
)
2120 && !NILP (Vpurify_flag
))
2122 if (NILP (Vdoc_file_name
))
2123 /* We have not yet called Snarf-documentation, so assume
2124 this file is described in the DOC-MM.NN file
2125 and Snarf-documentation will fill in the right value later.
2126 For now, replace the whole list with 0. */
2129 /* We have already called Snarf-documentation, so make a relative
2130 file name for this file, so it can be found properly
2131 in the installed Lisp directory.
2132 We don't use Fexpand_file_name because that would make
2133 the directory absolute now. */
2134 elt
= concat2 (build_string ("../lisp/"),
2135 Ffile_name_nondirectory (elt
));
2137 else if (EQ (elt
, Vload_file_name
)
2139 && load_force_doc_strings
)
2148 Fsignal (Qinvalid_read_syntax
,
2149 Fcons (make_string (") or . in a vector", 18), Qnil
));
2157 XCONS (tail
)->cdr
= read0 (readcharfun
);
2159 val
= read0 (readcharfun
);
2160 read1 (readcharfun
, &ch
, 0);
2164 if (doc_reference
== 1)
2165 return make_number (0);
2166 if (doc_reference
== 2)
2168 /* Get a doc string from the file we are loading.
2169 If it's in saved_doc_string, get it from there. */
2170 int pos
= XINT (XCONS (val
)->cdr
);
2171 if (pos
>= saved_doc_string_position
2172 && pos
< (saved_doc_string_position
2173 + saved_doc_string_length
))
2175 int start
= pos
- saved_doc_string_position
;
2178 /* Process quoting with ^A,
2179 and find the end of the string,
2180 which is marked with ^_ (037). */
2181 for (from
= start
, to
= start
;
2182 saved_doc_string
[from
] != 037;)
2184 int c
= saved_doc_string
[from
++];
2187 c
= saved_doc_string
[from
++];
2189 saved_doc_string
[to
++] = c
;
2191 saved_doc_string
[to
++] = 0;
2193 saved_doc_string
[to
++] = 037;
2196 saved_doc_string
[to
++] = c
;
2199 return make_string (saved_doc_string
+ start
,
2203 return read_doc_string (val
);
2208 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2210 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2212 tem
= (read_pure
&& flag
<= 0
2213 ? pure_cons (elt
, Qnil
)
2214 : Fcons (elt
, Qnil
));
2216 XCONS (tail
)->cdr
= tem
;
2221 defunflag
= EQ (elt
, Qdefun
);
2222 else if (defunflag
> 0)
2227 Lisp_Object Vobarray
;
2228 Lisp_Object initial_obarray
;
2230 /* oblookup stores the bucket number here, for the sake of Funintern. */
2232 int oblookup_last_bucket_number
;
2234 static int hash_string ();
2235 Lisp_Object
oblookup ();
2237 /* Get an error if OBARRAY is not an obarray.
2238 If it is one, return it. */
2241 check_obarray (obarray
)
2242 Lisp_Object obarray
;
2244 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2246 /* If Vobarray is now invalid, force it to be valid. */
2247 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2249 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2254 /* Intern the C string STR: return a symbol with that name,
2255 interned in the current obarray. */
2262 int len
= strlen (str
);
2263 Lisp_Object obarray
;
2266 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2267 obarray
= check_obarray (obarray
);
2268 tem
= oblookup (obarray
, str
, len
, len
);
2271 return Fintern (make_string (str
, len
), obarray
);
2274 /* Create an uninterned symbol with name STR. */
2280 int len
= strlen (str
);
2282 return Fmake_symbol ((!NILP (Vpurify_flag
)
2283 ? make_pure_string (str
, len
, len
, 0)
2284 : make_string (str
, len
)));
2287 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2288 "Return the canonical symbol whose name is STRING.\n\
2289 If there is none, one is created by this function and returned.\n\
2290 A second optional argument specifies the obarray to use;\n\
2291 it defaults to the value of `obarray'.")
2293 Lisp_Object string
, obarray
;
2295 register Lisp_Object tem
, sym
, *ptr
;
2297 if (NILP (obarray
)) obarray
= Vobarray
;
2298 obarray
= check_obarray (obarray
);
2300 CHECK_STRING (string
, 0);
2302 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2303 XSTRING (string
)->size
,
2304 STRING_BYTES (XSTRING (string
)));
2305 if (!INTEGERP (tem
))
2308 if (!NILP (Vpurify_flag
))
2309 string
= Fpurecopy (string
);
2310 sym
= Fmake_symbol (string
);
2311 XSYMBOL (sym
)->obarray
= obarray
;
2313 if ((XSTRING (string
)->data
[0] == ':')
2314 && obarray
== initial_obarray
)
2315 XSYMBOL (sym
)->value
= sym
;
2317 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2319 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2321 XSYMBOL (sym
)->next
= 0;
2326 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2327 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2328 A second optional argument specifies the obarray to use;\n\
2329 it defaults to the value of `obarray'.")
2331 Lisp_Object string
, obarray
;
2333 register Lisp_Object tem
;
2335 if (NILP (obarray
)) obarray
= Vobarray
;
2336 obarray
= check_obarray (obarray
);
2338 CHECK_STRING (string
, 0);
2340 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2341 XSTRING (string
)->size
,
2342 STRING_BYTES (XSTRING (string
)));
2343 if (!INTEGERP (tem
))
2348 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2349 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2350 The value is t if a symbol was found and deleted, nil otherwise.\n\
2351 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2352 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2353 OBARRAY defaults to the value of the variable `obarray'.")
2355 Lisp_Object name
, obarray
;
2357 register Lisp_Object string
, tem
;
2360 if (NILP (obarray
)) obarray
= Vobarray
;
2361 obarray
= check_obarray (obarray
);
2364 XSETSTRING (string
, XSYMBOL (name
)->name
);
2367 CHECK_STRING (name
, 0);
2371 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2372 XSTRING (string
)->size
,
2373 STRING_BYTES (XSTRING (string
)));
2376 /* If arg was a symbol, don't delete anything but that symbol itself. */
2377 if (SYMBOLP (name
) && !EQ (name
, tem
))
2380 XSYMBOL (tem
)->obarray
= Qnil
;
2382 hash
= oblookup_last_bucket_number
;
2384 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2386 if (XSYMBOL (tem
)->next
)
2387 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2389 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2393 Lisp_Object tail
, following
;
2395 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2396 XSYMBOL (tail
)->next
;
2399 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2400 if (EQ (following
, tem
))
2402 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2411 /* Return the symbol in OBARRAY whose names matches the string
2412 of SIZE characters (SIZE_BYTE bytes) at PTR.
2413 If there is no such symbol in OBARRAY, return nil.
2415 Also store the bucket number in oblookup_last_bucket_number. */
2418 oblookup (obarray
, ptr
, size
, size_byte
)
2419 Lisp_Object obarray
;
2421 int size
, size_byte
;
2425 register Lisp_Object tail
;
2426 Lisp_Object bucket
, tem
;
2428 if (!VECTORP (obarray
)
2429 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2431 obarray
= check_obarray (obarray
);
2432 obsize
= XVECTOR (obarray
)->size
;
2434 /* This is sometimes needed in the middle of GC. */
2435 obsize
&= ~ARRAY_MARK_FLAG
;
2436 /* Combining next two lines breaks VMS C 2.3. */
2437 hash
= hash_string (ptr
, size_byte
);
2439 bucket
= XVECTOR (obarray
)->contents
[hash
];
2440 oblookup_last_bucket_number
= hash
;
2441 if (XFASTINT (bucket
) == 0)
2443 else if (!SYMBOLP (bucket
))
2444 error ("Bad data in guts of obarray"); /* Like CADR error message */
2446 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2448 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2449 && XSYMBOL (tail
)->name
->size
== size
2450 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2452 else if (XSYMBOL (tail
)->next
== 0)
2455 XSETINT (tem
, hash
);
2460 hash_string (ptr
, len
)
2464 register unsigned char *p
= ptr
;
2465 register unsigned char *end
= p
+ len
;
2466 register unsigned char c
;
2467 register int hash
= 0;
2472 if (c
>= 0140) c
-= 40;
2473 hash
= ((hash
<<3) + (hash
>>28) + c
);
2475 return hash
& 07777777777;
2479 map_obarray (obarray
, fn
, arg
)
2480 Lisp_Object obarray
;
2481 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2485 register Lisp_Object tail
;
2486 CHECK_VECTOR (obarray
, 1);
2487 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2489 tail
= XVECTOR (obarray
)->contents
[i
];
2494 if (XSYMBOL (tail
)->next
== 0)
2496 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2502 mapatoms_1 (sym
, function
)
2503 Lisp_Object sym
, function
;
2505 call1 (function
, sym
);
2508 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2509 "Call FUNCTION on every symbol in OBARRAY.\n\
2510 OBARRAY defaults to the value of `obarray'.")
2512 Lisp_Object function
, obarray
;
2516 if (NILP (obarray
)) obarray
= Vobarray
;
2517 obarray
= check_obarray (obarray
);
2519 map_obarray (obarray
, mapatoms_1
, function
);
2523 #define OBARRAY_SIZE 1511
2528 Lisp_Object oblength
;
2532 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2534 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
2535 Vobarray
= Fmake_vector (oblength
, make_number (0));
2536 initial_obarray
= Vobarray
;
2537 staticpro (&initial_obarray
);
2538 /* Intern nil in the obarray */
2539 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2540 /* These locals are to kludge around a pyramid compiler bug. */
2541 hash
= hash_string ("nil", 3);
2542 /* Separate statement here to avoid VAXC bug. */
2543 hash
%= OBARRAY_SIZE
;
2544 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2547 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
2548 XSYMBOL (Qnil
)->function
= Qunbound
;
2549 XSYMBOL (Qunbound
)->value
= Qunbound
;
2550 XSYMBOL (Qunbound
)->function
= Qunbound
;
2553 XSYMBOL (Qnil
)->value
= Qnil
;
2554 XSYMBOL (Qnil
)->plist
= Qnil
;
2555 XSYMBOL (Qt
)->value
= Qt
;
2557 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2560 Qvariable_documentation
= intern ("variable-documentation");
2561 staticpro (&Qvariable_documentation
);
2563 read_buffer_size
= 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM
;
2564 read_buffer
= (char *) malloc (read_buffer_size
);
2569 struct Lisp_Subr
*sname
;
2572 sym
= intern (sname
->symbol_name
);
2573 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2576 #ifdef NOTDEF /* use fset in subr.el now */
2578 defalias (sname
, string
)
2579 struct Lisp_Subr
*sname
;
2583 sym
= intern (string
);
2584 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2588 /* Define an "integer variable"; a symbol whose value is forwarded
2589 to a C variable of type int. Sample call: */
2590 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2592 defvar_int (namestring
, address
)
2596 Lisp_Object sym
, val
;
2597 sym
= intern (namestring
);
2598 val
= allocate_misc ();
2599 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2600 XINTFWD (val
)->intvar
= address
;
2601 XSYMBOL (sym
)->value
= val
;
2604 /* Similar but define a variable whose value is T if address contains 1,
2605 NIL if address contains 0 */
2607 defvar_bool (namestring
, address
)
2611 Lisp_Object sym
, val
;
2612 sym
= intern (namestring
);
2613 val
= allocate_misc ();
2614 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2615 XBOOLFWD (val
)->boolvar
= address
;
2616 XSYMBOL (sym
)->value
= val
;
2619 /* Similar but define a variable whose value is the Lisp Object stored
2620 at address. Two versions: with and without gc-marking of the C
2621 variable. The nopro version is used when that variable will be
2622 gc-marked for some other reason, since marking the same slot twice
2623 can cause trouble with strings. */
2625 defvar_lisp_nopro (namestring
, address
)
2627 Lisp_Object
*address
;
2629 Lisp_Object sym
, val
;
2630 sym
= intern (namestring
);
2631 val
= allocate_misc ();
2632 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2633 XOBJFWD (val
)->objvar
= address
;
2634 XSYMBOL (sym
)->value
= val
;
2638 defvar_lisp (namestring
, address
)
2640 Lisp_Object
*address
;
2642 defvar_lisp_nopro (namestring
, address
);
2643 staticpro (address
);
2648 /* Similar but define a variable whose value is the Lisp Object stored in
2649 the current buffer. address is the address of the slot in the buffer
2650 that is current now. */
2653 defvar_per_buffer (namestring
, address
, type
, doc
)
2655 Lisp_Object
*address
;
2659 Lisp_Object sym
, val
;
2661 extern struct buffer buffer_local_symbols
;
2663 sym
= intern (namestring
);
2664 val
= allocate_misc ();
2665 offset
= (char *)address
- (char *)current_buffer
;
2667 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2668 XBUFFER_OBJFWD (val
)->offset
= offset
;
2669 XSYMBOL (sym
)->value
= val
;
2670 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2671 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2672 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2673 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2674 slot of buffer_local_flags */
2678 #endif /* standalone */
2680 /* Similar but define a variable whose value is the Lisp Object stored
2681 at a particular offset in the current kboard object. */
2684 defvar_kboard (namestring
, offset
)
2688 Lisp_Object sym
, val
;
2689 sym
= intern (namestring
);
2690 val
= allocate_misc ();
2691 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2692 XKBOARD_OBJFWD (val
)->offset
= offset
;
2693 XSYMBOL (sym
)->value
= val
;
2696 /* Record the value of load-path used at the start of dumping
2697 so we can see if the site changed it later during dumping. */
2698 static Lisp_Object dump_path
;
2704 int turn_off_warning
= 0;
2706 #ifdef HAVE_SETLOCALE
2707 /* Make sure numbers are parsed as we expect. */
2708 setlocale (LC_NUMERIC
, "C");
2709 #endif /* HAVE_SETLOCALE */
2711 /* Compute the default load-path. */
2713 normal
= PATH_LOADSEARCH
;
2714 Vload_path
= decode_env_path (0, normal
);
2716 if (NILP (Vpurify_flag
))
2717 normal
= PATH_LOADSEARCH
;
2719 normal
= PATH_DUMPLOADSEARCH
;
2721 /* In a dumped Emacs, we normally have to reset the value of
2722 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2723 uses ../lisp, instead of the path of the installed elisp
2724 libraries. However, if it appears that Vload_path was changed
2725 from the default before dumping, don't override that value. */
2728 if (! NILP (Fequal (dump_path
, Vload_path
)))
2730 Vload_path
= decode_env_path (0, normal
);
2731 if (!NILP (Vinstallation_directory
))
2733 /* Add to the path the lisp subdir of the
2734 installation dir, if it exists. */
2735 Lisp_Object tem
, tem1
;
2736 tem
= Fexpand_file_name (build_string ("lisp"),
2737 Vinstallation_directory
);
2738 tem1
= Ffile_exists_p (tem
);
2741 if (NILP (Fmember (tem
, Vload_path
)))
2743 turn_off_warning
= 1;
2744 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2748 /* That dir doesn't exist, so add the build-time
2749 Lisp dirs instead. */
2750 Vload_path
= nconc2 (Vload_path
, dump_path
);
2752 /* Add leim under the installation dir, if it exists. */
2753 tem
= Fexpand_file_name (build_string ("leim"),
2754 Vinstallation_directory
);
2755 tem1
= Ffile_exists_p (tem
);
2758 if (NILP (Fmember (tem
, Vload_path
)))
2759 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2762 /* Add site-list under the installation dir, if it exists. */
2763 tem
= Fexpand_file_name (build_string ("site-lisp"),
2764 Vinstallation_directory
);
2765 tem1
= Ffile_exists_p (tem
);
2768 if (NILP (Fmember (tem
, Vload_path
)))
2769 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2772 /* If Emacs was not built in the source directory,
2773 and it is run from where it was built, add to load-path
2774 the lisp, leim and site-lisp dirs under that directory. */
2776 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
2780 tem
= Fexpand_file_name (build_string ("src/Makefile"),
2781 Vinstallation_directory
);
2782 tem1
= Ffile_exists_p (tem
);
2784 /* Don't be fooled if they moved the entire source tree
2785 AFTER dumping Emacs. If the build directory is indeed
2786 different from the source dir, src/Makefile.in and
2787 src/Makefile will not be found together. */
2788 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
2789 Vinstallation_directory
);
2790 tem2
= Ffile_exists_p (tem
);
2791 if (!NILP (tem1
) && NILP (tem2
))
2793 tem
= Fexpand_file_name (build_string ("lisp"),
2796 if (NILP (Fmember (tem
, Vload_path
)))
2797 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2799 tem
= Fexpand_file_name (build_string ("leim"),
2802 if (NILP (Fmember (tem
, Vload_path
)))
2803 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2805 tem
= Fexpand_file_name (build_string ("site-lisp"),
2808 if (NILP (Fmember (tem
, Vload_path
)))
2809 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2817 /* NORMAL refers to the lisp dir in the source directory. */
2818 /* We used to add ../lisp at the front here, but
2819 that caused trouble because it was copied from dump_path
2820 into Vload_path, aboe, when Vinstallation_directory was non-nil.
2821 It should be unnecessary. */
2822 Vload_path
= decode_env_path (0, normal
);
2823 dump_path
= Vload_path
;
2828 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
2829 almost never correct, thereby causing a warning to be printed out that
2830 confuses users. Since PATH_LOADSEARCH is always overridden by the
2831 EMACSLOADPATH environment variable below, disable the warning on NT. */
2833 /* Warn if dirs in the *standard* path don't exist. */
2834 if (!turn_off_warning
)
2836 Lisp_Object path_tail
;
2838 for (path_tail
= Vload_path
;
2840 path_tail
= XCONS (path_tail
)->cdr
)
2842 Lisp_Object dirfile
;
2843 dirfile
= Fcar (path_tail
);
2844 if (STRINGP (dirfile
))
2846 dirfile
= Fdirectory_file_name (dirfile
);
2847 if (access (XSTRING (dirfile
)->data
, 0) < 0)
2848 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
2849 XCONS (path_tail
)->car
);
2853 #endif /* WINDOWSNT */
2855 /* If the EMACSLOADPATH environment variable is set, use its value.
2856 This doesn't apply if we're dumping. */
2858 if (NILP (Vpurify_flag
)
2859 && egetenv ("EMACSLOADPATH"))
2861 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
2865 load_in_progress
= 0;
2866 Vload_file_name
= Qnil
;
2868 load_descriptor_list
= Qnil
;
2870 Vstandard_input
= Qt
;
2873 /* Print a warning, using format string FORMAT, that directory DIRNAME
2874 does not exist. Print it on stderr and put it in *Message*. */
2877 dir_warning (format
, dirname
)
2879 Lisp_Object dirname
;
2882 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
2884 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
2885 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
2886 /* Don't log the warning before we've initialized!! */
2888 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
2895 defsubr (&Sread_from_string
);
2897 defsubr (&Sintern_soft
);
2898 defsubr (&Sunintern
);
2900 defsubr (&Seval_buffer
);
2901 defsubr (&Seval_region
);
2902 defsubr (&Sread_char
);
2903 defsubr (&Sread_char_exclusive
);
2904 defsubr (&Sread_event
);
2905 defsubr (&Sget_file_char
);
2906 defsubr (&Smapatoms
);
2908 DEFVAR_LISP ("obarray", &Vobarray
,
2909 "Symbol table for use by `intern' and `read'.\n\
2910 It is a vector whose length ought to be prime for best results.\n\
2911 The vector's contents don't make sense if examined from Lisp programs;\n\
2912 to find all the symbols in an obarray, use `mapatoms'.");
2914 DEFVAR_LISP ("values", &Vvalues
,
2915 "List of values of all expressions which were read, evaluated and printed.\n\
2916 Order is reverse chronological.");
2918 DEFVAR_LISP ("standard-input", &Vstandard_input
,
2919 "Stream for read to get input from.\n\
2920 See documentation of `read' for possible values.");
2921 Vstandard_input
= Qt
;
2923 DEFVAR_LISP ("load-path", &Vload_path
,
2924 "*List of directories to search for files to load.\n\
2925 Each element is a string (directory name) or nil (try default directory).\n\
2926 Initialized based on EMACSLOADPATH environment variable, if any,\n\
2927 otherwise to default specified by file `paths.h' when Emacs was built.");
2929 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
2930 "Non-nil iff inside of `load'.");
2932 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
2933 "An alist of expressions to be evalled when particular files are loaded.\n\
2934 Each element looks like (FILENAME FORMS...).\n\
2935 When `load' is run and the file-name argument is FILENAME,\n\
2936 the FORMS in the corresponding element are executed at the end of loading.\n\n\
2937 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
2938 with no directory specified, since that is how `load' is normally called.\n\
2939 An error in FORMS does not undo the load,\n\
2940 but does prevent execution of the rest of the FORMS.");
2941 Vafter_load_alist
= Qnil
;
2943 DEFVAR_LISP ("load-history", &Vload_history
,
2944 "Alist mapping source file names to symbols and features.\n\
2945 Each alist element is a list that starts with a file name,\n\
2946 except for one element (optional) that starts with nil and describes\n\
2947 definitions evaluated from buffers not visiting files.\n\
2948 The remaining elements of each list are symbols defined as functions\n\
2949 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2950 Vload_history
= Qnil
;
2952 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
2953 "Full name of file being loaded by `load'.");
2954 Vload_file_name
= Qnil
;
2956 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
2957 "Used for internal purposes by `load'.");
2958 Vcurrent_load_list
= Qnil
;
2960 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
2961 "Function used by `load' and `eval-region' for reading expressions.\n\
2962 The default is nil, which means use the function `read'.");
2963 Vload_read_function
= Qnil
;
2965 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
2966 "Function called in `load' for loading an Emacs lisp source file.\n\
2967 This function is for doing code conversion before reading the source file.\n\
2968 If nil, loading is done without any code conversion.\n\
2969 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
2970 FULLNAME is the full name of FILE.\n\
2971 See `load' for the meaning of the remaining arguments.");
2972 Vload_source_file_function
= Qnil
;
2974 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
2975 "Non-nil means `load' should force-load all dynamic doc strings.\n\
2976 This is useful when the file being loaded is a temporary copy.");
2977 load_force_doc_strings
= 0;
2979 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
2980 "Non-nil means `load' converts strings to unibyte whenever possible.\n\
2981 This is normally used in `load-with-code-conversion'\n\
2982 for loading non-compiled files.");
2983 load_convert_to_unibyte
= 0;
2985 DEFVAR_LISP ("source-directory", &Vsource_directory
,
2986 "Directory in which Emacs sources were found when Emacs was built.\n\
2987 You cannot count on them to still be there!");
2989 = Fexpand_file_name (build_string ("../"),
2990 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
2992 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
2993 "List of files that were preloaded (when dumping Emacs).");
2994 Vpreloaded_file_list
= Qnil
;
2996 /* Vsource_directory was initialized in init_lread. */
2998 load_descriptor_list
= Qnil
;
2999 staticpro (&load_descriptor_list
);
3001 Qcurrent_load_list
= intern ("current-load-list");
3002 staticpro (&Qcurrent_load_list
);
3004 Qstandard_input
= intern ("standard-input");
3005 staticpro (&Qstandard_input
);
3007 Qread_char
= intern ("read-char");
3008 staticpro (&Qread_char
);
3010 Qget_file_char
= intern ("get-file-char");
3011 staticpro (&Qget_file_char
);
3013 Qbackquote
= intern ("`");
3014 staticpro (&Qbackquote
);
3015 Qcomma
= intern (",");
3016 staticpro (&Qcomma
);
3017 Qcomma_at
= intern (",@");
3018 staticpro (&Qcomma_at
);
3019 Qcomma_dot
= intern (",.");
3020 staticpro (&Qcomma_dot
);
3022 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3023 staticpro (&Qinhibit_file_name_operation
);
3025 Qascii_character
= intern ("ascii-character");
3026 staticpro (&Qascii_character
);
3028 Qfunction
= intern ("function");
3029 staticpro (&Qfunction
);
3031 Qload
= intern ("load");
3034 Qload_file_name
= intern ("load-file-name");
3035 staticpro (&Qload_file_name
);
3037 staticpro (&dump_path
);
3039 staticpro (&read_objects
);
3040 read_objects
= Qnil
;