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
2001 if (*cp
== '+' || *cp
== '-')
2004 if (*cp
>= '0' && *cp
<= '9')
2007 while (*cp
>= '0' && *cp
<= '9')
2015 if (*cp
>= '0' && *cp
<= '9')
2018 while (*cp
>= '0' && *cp
<= '9')
2021 if (*cp
== 'e' || *cp
== 'E')
2025 if (*cp
== '+' || *cp
== '-')
2029 if (*cp
>= '0' && *cp
<= '9')
2032 while (*cp
>= '0' && *cp
<= '9')
2035 else if (cp
== start
)
2037 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2042 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2048 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2049 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2050 || state
== (DOT_CHAR
|TRAIL_INT
)
2051 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2052 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2053 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2055 #endif /* LISP_FLOAT_TYPE */
2058 read_vector (readcharfun
)
2059 Lisp_Object readcharfun
;
2063 register Lisp_Object
*ptr
;
2064 register Lisp_Object tem
, vector
;
2065 register struct Lisp_Cons
*otem
;
2068 tem
= read_list (1, readcharfun
);
2069 len
= Flength (tem
);
2070 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2073 size
= XVECTOR (vector
)->size
;
2074 ptr
= XVECTOR (vector
)->contents
;
2075 for (i
= 0; i
< size
; i
++)
2077 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
2085 /* FLAG = 1 means check for ] to terminate rather than ) and .
2086 FLAG = -1 means check for starting with defun
2087 and make structure pure. */
2090 read_list (flag
, readcharfun
)
2092 register Lisp_Object readcharfun
;
2094 /* -1 means check next element for defun,
2095 0 means don't check,
2096 1 means already checked and found defun. */
2097 int defunflag
= flag
< 0 ? -1 : 0;
2098 Lisp_Object val
, tail
;
2099 register Lisp_Object elt
, tem
;
2100 struct gcpro gcpro1
, gcpro2
;
2101 /* 0 is the normal case.
2102 1 means this list is a doc reference; replace it with the number 0.
2103 2 means this list is a doc reference; replace it with the doc string. */
2104 int doc_reference
= 0;
2106 /* Initialize this to 1 if we are reading a list. */
2107 int first_in_list
= flag
<= 0;
2116 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2121 /* While building, if the list starts with #$, treat it specially. */
2122 if (EQ (elt
, Vload_file_name
)
2124 && !NILP (Vpurify_flag
))
2126 if (NILP (Vdoc_file_name
))
2127 /* We have not yet called Snarf-documentation, so assume
2128 this file is described in the DOC-MM.NN file
2129 and Snarf-documentation will fill in the right value later.
2130 For now, replace the whole list with 0. */
2133 /* We have already called Snarf-documentation, so make a relative
2134 file name for this file, so it can be found properly
2135 in the installed Lisp directory.
2136 We don't use Fexpand_file_name because that would make
2137 the directory absolute now. */
2138 elt
= concat2 (build_string ("../lisp/"),
2139 Ffile_name_nondirectory (elt
));
2141 else if (EQ (elt
, Vload_file_name
)
2143 && load_force_doc_strings
)
2152 Fsignal (Qinvalid_read_syntax
,
2153 Fcons (make_string (") or . in a vector", 18), Qnil
));
2161 XCONS (tail
)->cdr
= read0 (readcharfun
);
2163 val
= read0 (readcharfun
);
2164 read1 (readcharfun
, &ch
, 0);
2168 if (doc_reference
== 1)
2169 return make_number (0);
2170 if (doc_reference
== 2)
2172 /* Get a doc string from the file we are loading.
2173 If it's in saved_doc_string, get it from there. */
2174 int pos
= XINT (XCONS (val
)->cdr
);
2175 if (pos
>= saved_doc_string_position
2176 && pos
< (saved_doc_string_position
2177 + saved_doc_string_length
))
2179 int start
= pos
- saved_doc_string_position
;
2182 /* Process quoting with ^A,
2183 and find the end of the string,
2184 which is marked with ^_ (037). */
2185 for (from
= start
, to
= start
;
2186 saved_doc_string
[from
] != 037;)
2188 int c
= saved_doc_string
[from
++];
2191 c
= saved_doc_string
[from
++];
2193 saved_doc_string
[to
++] = c
;
2195 saved_doc_string
[to
++] = 0;
2197 saved_doc_string
[to
++] = 037;
2200 saved_doc_string
[to
++] = c
;
2203 return make_string (saved_doc_string
+ start
,
2207 return read_doc_string (val
);
2212 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2214 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2216 tem
= (read_pure
&& flag
<= 0
2217 ? pure_cons (elt
, Qnil
)
2218 : Fcons (elt
, Qnil
));
2220 XCONS (tail
)->cdr
= tem
;
2225 defunflag
= EQ (elt
, Qdefun
);
2226 else if (defunflag
> 0)
2231 Lisp_Object Vobarray
;
2232 Lisp_Object initial_obarray
;
2234 /* oblookup stores the bucket number here, for the sake of Funintern. */
2236 int oblookup_last_bucket_number
;
2238 static int hash_string ();
2239 Lisp_Object
oblookup ();
2241 /* Get an error if OBARRAY is not an obarray.
2242 If it is one, return it. */
2245 check_obarray (obarray
)
2246 Lisp_Object obarray
;
2248 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2250 /* If Vobarray is now invalid, force it to be valid. */
2251 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2253 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2258 /* Intern the C string STR: return a symbol with that name,
2259 interned in the current obarray. */
2266 int len
= strlen (str
);
2267 Lisp_Object obarray
;
2270 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2271 obarray
= check_obarray (obarray
);
2272 tem
= oblookup (obarray
, str
, len
, len
);
2275 return Fintern (make_string (str
, len
), obarray
);
2278 /* Create an uninterned symbol with name STR. */
2284 int len
= strlen (str
);
2286 return Fmake_symbol ((!NILP (Vpurify_flag
)
2287 ? make_pure_string (str
, len
, len
, 0)
2288 : make_string (str
, len
)));
2291 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2292 "Return the canonical symbol whose name is STRING.\n\
2293 If there is none, one is created by this function and returned.\n\
2294 A second optional argument specifies the obarray to use;\n\
2295 it defaults to the value of `obarray'.")
2297 Lisp_Object string
, obarray
;
2299 register Lisp_Object tem
, sym
, *ptr
;
2301 if (NILP (obarray
)) obarray
= Vobarray
;
2302 obarray
= check_obarray (obarray
);
2304 CHECK_STRING (string
, 0);
2306 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2307 XSTRING (string
)->size
,
2308 STRING_BYTES (XSTRING (string
)));
2309 if (!INTEGERP (tem
))
2312 if (!NILP (Vpurify_flag
))
2313 string
= Fpurecopy (string
);
2314 sym
= Fmake_symbol (string
);
2315 XSYMBOL (sym
)->obarray
= obarray
;
2317 if ((XSTRING (string
)->data
[0] == ':')
2318 && obarray
== initial_obarray
)
2319 XSYMBOL (sym
)->value
= sym
;
2321 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2323 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2325 XSYMBOL (sym
)->next
= 0;
2330 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2331 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2332 A second optional argument specifies the obarray to use;\n\
2333 it defaults to the value of `obarray'.")
2335 Lisp_Object string
, obarray
;
2337 register Lisp_Object tem
;
2339 if (NILP (obarray
)) obarray
= Vobarray
;
2340 obarray
= check_obarray (obarray
);
2342 CHECK_STRING (string
, 0);
2344 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2345 XSTRING (string
)->size
,
2346 STRING_BYTES (XSTRING (string
)));
2347 if (!INTEGERP (tem
))
2352 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2353 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2354 The value is t if a symbol was found and deleted, nil otherwise.\n\
2355 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2356 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2357 OBARRAY defaults to the value of the variable `obarray'.")
2359 Lisp_Object name
, obarray
;
2361 register Lisp_Object string
, tem
;
2364 if (NILP (obarray
)) obarray
= Vobarray
;
2365 obarray
= check_obarray (obarray
);
2368 XSETSTRING (string
, XSYMBOL (name
)->name
);
2371 CHECK_STRING (name
, 0);
2375 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2376 XSTRING (string
)->size
,
2377 STRING_BYTES (XSTRING (string
)));
2380 /* If arg was a symbol, don't delete anything but that symbol itself. */
2381 if (SYMBOLP (name
) && !EQ (name
, tem
))
2384 XSYMBOL (tem
)->obarray
= Qnil
;
2386 hash
= oblookup_last_bucket_number
;
2388 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2390 if (XSYMBOL (tem
)->next
)
2391 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2393 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2397 Lisp_Object tail
, following
;
2399 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2400 XSYMBOL (tail
)->next
;
2403 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2404 if (EQ (following
, tem
))
2406 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2415 /* Return the symbol in OBARRAY whose names matches the string
2416 of SIZE characters (SIZE_BYTE bytes) at PTR.
2417 If there is no such symbol in OBARRAY, return nil.
2419 Also store the bucket number in oblookup_last_bucket_number. */
2422 oblookup (obarray
, ptr
, size
, size_byte
)
2423 Lisp_Object obarray
;
2425 int size
, size_byte
;
2429 register Lisp_Object tail
;
2430 Lisp_Object bucket
, tem
;
2432 if (!VECTORP (obarray
)
2433 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2435 obarray
= check_obarray (obarray
);
2436 obsize
= XVECTOR (obarray
)->size
;
2438 /* This is sometimes needed in the middle of GC. */
2439 obsize
&= ~ARRAY_MARK_FLAG
;
2440 /* Combining next two lines breaks VMS C 2.3. */
2441 hash
= hash_string (ptr
, size_byte
);
2443 bucket
= XVECTOR (obarray
)->contents
[hash
];
2444 oblookup_last_bucket_number
= hash
;
2445 if (XFASTINT (bucket
) == 0)
2447 else if (!SYMBOLP (bucket
))
2448 error ("Bad data in guts of obarray"); /* Like CADR error message */
2450 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2452 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2453 && XSYMBOL (tail
)->name
->size
== size
2454 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2456 else if (XSYMBOL (tail
)->next
== 0)
2459 XSETINT (tem
, hash
);
2464 hash_string (ptr
, len
)
2468 register unsigned char *p
= ptr
;
2469 register unsigned char *end
= p
+ len
;
2470 register unsigned char c
;
2471 register int hash
= 0;
2476 if (c
>= 0140) c
-= 40;
2477 hash
= ((hash
<<3) + (hash
>>28) + c
);
2479 return hash
& 07777777777;
2483 map_obarray (obarray
, fn
, arg
)
2484 Lisp_Object obarray
;
2485 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2489 register Lisp_Object tail
;
2490 CHECK_VECTOR (obarray
, 1);
2491 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2493 tail
= XVECTOR (obarray
)->contents
[i
];
2498 if (XSYMBOL (tail
)->next
== 0)
2500 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2506 mapatoms_1 (sym
, function
)
2507 Lisp_Object sym
, function
;
2509 call1 (function
, sym
);
2512 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2513 "Call FUNCTION on every symbol in OBARRAY.\n\
2514 OBARRAY defaults to the value of `obarray'.")
2516 Lisp_Object function
, obarray
;
2520 if (NILP (obarray
)) obarray
= Vobarray
;
2521 obarray
= check_obarray (obarray
);
2523 map_obarray (obarray
, mapatoms_1
, function
);
2527 #define OBARRAY_SIZE 1511
2532 Lisp_Object oblength
;
2536 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2538 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
2539 Vobarray
= Fmake_vector (oblength
, make_number (0));
2540 initial_obarray
= Vobarray
;
2541 staticpro (&initial_obarray
);
2542 /* Intern nil in the obarray */
2543 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2544 /* These locals are to kludge around a pyramid compiler bug. */
2545 hash
= hash_string ("nil", 3);
2546 /* Separate statement here to avoid VAXC bug. */
2547 hash
%= OBARRAY_SIZE
;
2548 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2551 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
2552 XSYMBOL (Qnil
)->function
= Qunbound
;
2553 XSYMBOL (Qunbound
)->value
= Qunbound
;
2554 XSYMBOL (Qunbound
)->function
= Qunbound
;
2557 XSYMBOL (Qnil
)->value
= Qnil
;
2558 XSYMBOL (Qnil
)->plist
= Qnil
;
2559 XSYMBOL (Qt
)->value
= Qt
;
2561 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2564 Qvariable_documentation
= intern ("variable-documentation");
2565 staticpro (&Qvariable_documentation
);
2567 read_buffer_size
= 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM
;
2568 read_buffer
= (char *) malloc (read_buffer_size
);
2573 struct Lisp_Subr
*sname
;
2576 sym
= intern (sname
->symbol_name
);
2577 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2580 #ifdef NOTDEF /* use fset in subr.el now */
2582 defalias (sname
, string
)
2583 struct Lisp_Subr
*sname
;
2587 sym
= intern (string
);
2588 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2592 /* Define an "integer variable"; a symbol whose value is forwarded
2593 to a C variable of type int. Sample call: */
2594 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2596 defvar_int (namestring
, address
)
2600 Lisp_Object sym
, val
;
2601 sym
= intern (namestring
);
2602 val
= allocate_misc ();
2603 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2604 XINTFWD (val
)->intvar
= address
;
2605 XSYMBOL (sym
)->value
= val
;
2608 /* Similar but define a variable whose value is T if address contains 1,
2609 NIL if address contains 0 */
2611 defvar_bool (namestring
, address
)
2615 Lisp_Object sym
, val
;
2616 sym
= intern (namestring
);
2617 val
= allocate_misc ();
2618 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2619 XBOOLFWD (val
)->boolvar
= address
;
2620 XSYMBOL (sym
)->value
= val
;
2623 /* Similar but define a variable whose value is the Lisp Object stored
2624 at address. Two versions: with and without gc-marking of the C
2625 variable. The nopro version is used when that variable will be
2626 gc-marked for some other reason, since marking the same slot twice
2627 can cause trouble with strings. */
2629 defvar_lisp_nopro (namestring
, address
)
2631 Lisp_Object
*address
;
2633 Lisp_Object sym
, val
;
2634 sym
= intern (namestring
);
2635 val
= allocate_misc ();
2636 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2637 XOBJFWD (val
)->objvar
= address
;
2638 XSYMBOL (sym
)->value
= val
;
2642 defvar_lisp (namestring
, address
)
2644 Lisp_Object
*address
;
2646 defvar_lisp_nopro (namestring
, address
);
2647 staticpro (address
);
2652 /* Similar but define a variable whose value is the Lisp Object stored in
2653 the current buffer. address is the address of the slot in the buffer
2654 that is current now. */
2657 defvar_per_buffer (namestring
, address
, type
, doc
)
2659 Lisp_Object
*address
;
2663 Lisp_Object sym
, val
;
2665 extern struct buffer buffer_local_symbols
;
2667 sym
= intern (namestring
);
2668 val
= allocate_misc ();
2669 offset
= (char *)address
- (char *)current_buffer
;
2671 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2672 XBUFFER_OBJFWD (val
)->offset
= offset
;
2673 XSYMBOL (sym
)->value
= val
;
2674 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2675 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2676 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2677 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2678 slot of buffer_local_flags */
2682 #endif /* standalone */
2684 /* Similar but define a variable whose value is the Lisp Object stored
2685 at a particular offset in the current kboard object. */
2688 defvar_kboard (namestring
, offset
)
2692 Lisp_Object sym
, val
;
2693 sym
= intern (namestring
);
2694 val
= allocate_misc ();
2695 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2696 XKBOARD_OBJFWD (val
)->offset
= offset
;
2697 XSYMBOL (sym
)->value
= val
;
2700 /* Record the value of load-path used at the start of dumping
2701 so we can see if the site changed it later during dumping. */
2702 static Lisp_Object dump_path
;
2708 int turn_off_warning
= 0;
2710 #ifdef HAVE_SETLOCALE
2711 /* Make sure numbers are parsed as we expect. */
2712 setlocale (LC_NUMERIC
, "C");
2713 #endif /* HAVE_SETLOCALE */
2715 /* Compute the default load-path. */
2717 normal
= PATH_LOADSEARCH
;
2718 Vload_path
= decode_env_path (0, normal
);
2720 if (NILP (Vpurify_flag
))
2721 normal
= PATH_LOADSEARCH
;
2723 normal
= PATH_DUMPLOADSEARCH
;
2725 /* In a dumped Emacs, we normally have to reset the value of
2726 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2727 uses ../lisp, instead of the path of the installed elisp
2728 libraries. However, if it appears that Vload_path was changed
2729 from the default before dumping, don't override that value. */
2732 if (! NILP (Fequal (dump_path
, Vload_path
)))
2734 Vload_path
= decode_env_path (0, normal
);
2735 if (!NILP (Vinstallation_directory
))
2737 /* Add to the path the lisp subdir of the
2738 installation dir, if it exists. */
2739 Lisp_Object tem
, tem1
;
2740 tem
= Fexpand_file_name (build_string ("lisp"),
2741 Vinstallation_directory
);
2742 tem1
= Ffile_exists_p (tem
);
2745 if (NILP (Fmember (tem
, Vload_path
)))
2747 turn_off_warning
= 1;
2748 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2752 /* That dir doesn't exist, so add the build-time
2753 Lisp dirs instead. */
2754 Vload_path
= nconc2 (Vload_path
, dump_path
);
2756 /* Add leim under the installation dir, if it exists. */
2757 tem
= Fexpand_file_name (build_string ("leim"),
2758 Vinstallation_directory
);
2759 tem1
= Ffile_exists_p (tem
);
2762 if (NILP (Fmember (tem
, Vload_path
)))
2763 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2766 /* Add site-list under the installation dir, if it exists. */
2767 tem
= Fexpand_file_name (build_string ("site-lisp"),
2768 Vinstallation_directory
);
2769 tem1
= Ffile_exists_p (tem
);
2772 if (NILP (Fmember (tem
, Vload_path
)))
2773 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2776 /* If Emacs was not built in the source directory,
2777 and it is run from where it was built, add to load-path
2778 the lisp, leim and site-lisp dirs under that directory. */
2780 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
2784 tem
= Fexpand_file_name (build_string ("src/Makefile"),
2785 Vinstallation_directory
);
2786 tem1
= Ffile_exists_p (tem
);
2788 /* Don't be fooled if they moved the entire source tree
2789 AFTER dumping Emacs. If the build directory is indeed
2790 different from the source dir, src/Makefile.in and
2791 src/Makefile will not be found together. */
2792 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
2793 Vinstallation_directory
);
2794 tem2
= Ffile_exists_p (tem
);
2795 if (!NILP (tem1
) && NILP (tem2
))
2797 tem
= Fexpand_file_name (build_string ("lisp"),
2800 if (NILP (Fmember (tem
, Vload_path
)))
2801 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2803 tem
= Fexpand_file_name (build_string ("leim"),
2806 if (NILP (Fmember (tem
, Vload_path
)))
2807 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2809 tem
= Fexpand_file_name (build_string ("site-lisp"),
2812 if (NILP (Fmember (tem
, Vload_path
)))
2813 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2821 /* NORMAL refers to the lisp dir in the source directory. */
2822 /* We used to add ../lisp at the front here, but
2823 that caused trouble because it was copied from dump_path
2824 into Vload_path, aboe, when Vinstallation_directory was non-nil.
2825 It should be unnecessary. */
2826 Vload_path
= decode_env_path (0, normal
);
2827 dump_path
= Vload_path
;
2832 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
2833 almost never correct, thereby causing a warning to be printed out that
2834 confuses users. Since PATH_LOADSEARCH is always overridden by the
2835 EMACSLOADPATH environment variable below, disable the warning on NT. */
2837 /* Warn if dirs in the *standard* path don't exist. */
2838 if (!turn_off_warning
)
2840 Lisp_Object path_tail
;
2842 for (path_tail
= Vload_path
;
2844 path_tail
= XCONS (path_tail
)->cdr
)
2846 Lisp_Object dirfile
;
2847 dirfile
= Fcar (path_tail
);
2848 if (STRINGP (dirfile
))
2850 dirfile
= Fdirectory_file_name (dirfile
);
2851 if (access (XSTRING (dirfile
)->data
, 0) < 0)
2852 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
2853 XCONS (path_tail
)->car
);
2857 #endif /* WINDOWSNT */
2859 /* If the EMACSLOADPATH environment variable is set, use its value.
2860 This doesn't apply if we're dumping. */
2862 if (NILP (Vpurify_flag
)
2863 && egetenv ("EMACSLOADPATH"))
2865 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
2869 load_in_progress
= 0;
2870 Vload_file_name
= Qnil
;
2872 load_descriptor_list
= Qnil
;
2874 Vstandard_input
= Qt
;
2877 /* Print a warning, using format string FORMAT, that directory DIRNAME
2878 does not exist. Print it on stderr and put it in *Message*. */
2881 dir_warning (format
, dirname
)
2883 Lisp_Object dirname
;
2886 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
2888 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
2889 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
2890 /* Don't log the warning before we've initialized!! */
2892 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
2899 defsubr (&Sread_from_string
);
2901 defsubr (&Sintern_soft
);
2902 defsubr (&Sunintern
);
2904 defsubr (&Seval_buffer
);
2905 defsubr (&Seval_region
);
2906 defsubr (&Sread_char
);
2907 defsubr (&Sread_char_exclusive
);
2908 defsubr (&Sread_event
);
2909 defsubr (&Sget_file_char
);
2910 defsubr (&Smapatoms
);
2912 DEFVAR_LISP ("obarray", &Vobarray
,
2913 "Symbol table for use by `intern' and `read'.\n\
2914 It is a vector whose length ought to be prime for best results.\n\
2915 The vector's contents don't make sense if examined from Lisp programs;\n\
2916 to find all the symbols in an obarray, use `mapatoms'.");
2918 DEFVAR_LISP ("values", &Vvalues
,
2919 "List of values of all expressions which were read, evaluated and printed.\n\
2920 Order is reverse chronological.");
2922 DEFVAR_LISP ("standard-input", &Vstandard_input
,
2923 "Stream for read to get input from.\n\
2924 See documentation of `read' for possible values.");
2925 Vstandard_input
= Qt
;
2927 DEFVAR_LISP ("load-path", &Vload_path
,
2928 "*List of directories to search for files to load.\n\
2929 Each element is a string (directory name) or nil (try default directory).\n\
2930 Initialized based on EMACSLOADPATH environment variable, if any,\n\
2931 otherwise to default specified by file `paths.h' when Emacs was built.");
2933 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
2934 "Non-nil iff inside of `load'.");
2936 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
2937 "An alist of expressions to be evalled when particular files are loaded.\n\
2938 Each element looks like (FILENAME FORMS...).\n\
2939 When `load' is run and the file-name argument is FILENAME,\n\
2940 the FORMS in the corresponding element are executed at the end of loading.\n\n\
2941 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
2942 with no directory specified, since that is how `load' is normally called.\n\
2943 An error in FORMS does not undo the load,\n\
2944 but does prevent execution of the rest of the FORMS.");
2945 Vafter_load_alist
= Qnil
;
2947 DEFVAR_LISP ("load-history", &Vload_history
,
2948 "Alist mapping source file names to symbols and features.\n\
2949 Each alist element is a list that starts with a file name,\n\
2950 except for one element (optional) that starts with nil and describes\n\
2951 definitions evaluated from buffers not visiting files.\n\
2952 The remaining elements of each list are symbols defined as functions\n\
2953 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2954 Vload_history
= Qnil
;
2956 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
2957 "Full name of file being loaded by `load'.");
2958 Vload_file_name
= Qnil
;
2960 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
2961 "Used for internal purposes by `load'.");
2962 Vcurrent_load_list
= Qnil
;
2964 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
2965 "Function used by `load' and `eval-region' for reading expressions.\n\
2966 The default is nil, which means use the function `read'.");
2967 Vload_read_function
= Qnil
;
2969 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
2970 "Function called in `load' for loading an Emacs lisp source file.\n\
2971 This function is for doing code conversion before reading the source file.\n\
2972 If nil, loading is done without any code conversion.\n\
2973 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
2974 FULLNAME is the full name of FILE.\n\
2975 See `load' for the meaning of the remaining arguments.");
2976 Vload_source_file_function
= Qnil
;
2978 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
2979 "Non-nil means `load' should force-load all dynamic doc strings.\n\
2980 This is useful when the file being loaded is a temporary copy.");
2981 load_force_doc_strings
= 0;
2983 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
2984 "Non-nil means `load' converts strings to unibyte whenever possible.\n\
2985 This is normally used in `load-with-code-conversion'\n\
2986 for loading non-compiled files.");
2987 load_convert_to_unibyte
= 0;
2989 DEFVAR_LISP ("source-directory", &Vsource_directory
,
2990 "Directory in which Emacs sources were found when Emacs was built.\n\
2991 You cannot count on them to still be there!");
2993 = Fexpand_file_name (build_string ("../"),
2994 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
2996 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
2997 "List of files that were preloaded (when dumping Emacs).");
2998 Vpreloaded_file_list
= Qnil
;
3000 /* Vsource_directory was initialized in init_lread. */
3002 load_descriptor_list
= Qnil
;
3003 staticpro (&load_descriptor_list
);
3005 Qcurrent_load_list
= intern ("current-load-list");
3006 staticpro (&Qcurrent_load_list
);
3008 Qstandard_input
= intern ("standard-input");
3009 staticpro (&Qstandard_input
);
3011 Qread_char
= intern ("read-char");
3012 staticpro (&Qread_char
);
3014 Qget_file_char
= intern ("get-file-char");
3015 staticpro (&Qget_file_char
);
3017 Qbackquote
= intern ("`");
3018 staticpro (&Qbackquote
);
3019 Qcomma
= intern (",");
3020 staticpro (&Qcomma
);
3021 Qcomma_at
= intern (",@");
3022 staticpro (&Qcomma_at
);
3023 Qcomma_dot
= intern (",.");
3024 staticpro (&Qcomma_dot
);
3026 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3027 staticpro (&Qinhibit_file_name_operation
);
3029 Qascii_character
= intern ("ascii-character");
3030 staticpro (&Qascii_character
);
3032 Qfunction
= intern ("function");
3033 staticpro (&Qfunction
);
3035 Qload
= intern ("load");
3038 Qload_file_name
= intern ("load-file-name");
3039 staticpro (&Qload_file_name
);
3041 staticpro (&dump_path
);
3043 staticpro (&read_objects
);
3044 read_objects
= Qnil
;