1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
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>
30 #include "intervals.h"
36 #include "termhooks.h"
40 #include <sys/inode.h>
45 #include <unistd.h> /* to get X_OK */
62 #endif /* HAVE_SETLOCALE */
69 #define file_offset off_t
70 #define file_tell ftello
72 #define file_offset long
73 #define file_tell ftell
80 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
81 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
82 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
83 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
84 Lisp_Object Qinhibit_file_name_operation
;
86 extern Lisp_Object Qevent_symbol_element_mask
;
87 extern Lisp_Object Qfile_exists_p
;
89 /* non-zero if inside `load' */
92 /* Directory in which the sources were found. */
93 Lisp_Object Vsource_directory
;
95 /* Search path and suffixes for files to be loaded. */
96 Lisp_Object Vload_path
, Vload_suffixes
, default_suffixes
;
98 /* File name of user's init file. */
99 Lisp_Object Vuser_init_file
;
101 /* This is the user-visible association list that maps features to
102 lists of defs in their load files. */
103 Lisp_Object Vload_history
;
105 /* This is used to build the load history. */
106 Lisp_Object Vcurrent_load_list
;
108 /* List of files that were preloaded. */
109 Lisp_Object Vpreloaded_file_list
;
111 /* Name of file actually being read by `load'. */
112 Lisp_Object Vload_file_name
;
114 /* Function to use for reading, in `load' and friends. */
115 Lisp_Object Vload_read_function
;
117 /* The association list of objects read with the #n=object form.
118 Each member of the list has the form (n . object), and is used to
119 look up the object for the corresponding #n# construct.
120 It must be set to nil before all top-level calls to read0. */
121 Lisp_Object read_objects
;
123 /* Nonzero means load should forcibly load all dynamic doc strings. */
124 static int load_force_doc_strings
;
126 /* Nonzero means read should convert strings to unibyte. */
127 static int load_convert_to_unibyte
;
129 /* Function to use for loading an Emacs lisp source file (not
130 compiled) instead of readevalloop. */
131 Lisp_Object Vload_source_file_function
;
133 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
134 Lisp_Object Vbyte_boolean_vars
;
136 /* Whether or not to add a `read-positions' property to symbols
138 Lisp_Object Vread_with_symbol_positions
;
140 /* List of (SYMBOL . POSITION) accumulated so far. */
141 Lisp_Object Vread_symbol_positions_list
;
143 /* List of descriptors now open for Fload. */
144 static Lisp_Object load_descriptor_list
;
146 /* File for get_file_char to read from. Use by load. */
147 static FILE *instream
;
149 /* When nonzero, read conses in pure space */
150 static int read_pure
;
152 /* For use within read-from-string (this reader is non-reentrant!!) */
153 static int read_from_string_index
;
154 static int read_from_string_index_byte
;
155 static int read_from_string_limit
;
157 /* Number of bytes left to read in the buffer character
158 that `readchar' has already advanced over. */
159 static int readchar_backlog
;
160 /* Number of characters read in the current call to Fread or
161 Fread_from_string. */
162 static int readchar_count
;
164 /* This contains the last string skipped with #@. */
165 static char *saved_doc_string
;
166 /* Length of buffer allocated in saved_doc_string. */
167 static int saved_doc_string_size
;
168 /* Length of actual data in saved_doc_string. */
169 static int saved_doc_string_length
;
170 /* This is the file position that string came from. */
171 static file_offset saved_doc_string_position
;
173 /* This contains the previous string skipped with #@.
174 We copy it from saved_doc_string when a new string
175 is put in saved_doc_string. */
176 static char *prev_saved_doc_string
;
177 /* Length of buffer allocated in prev_saved_doc_string. */
178 static int prev_saved_doc_string_size
;
179 /* Length of actual data in prev_saved_doc_string. */
180 static int prev_saved_doc_string_length
;
181 /* This is the file position that string came from. */
182 static file_offset prev_saved_doc_string_position
;
184 /* Nonzero means inside a new-style backquote
185 with no surrounding parentheses.
186 Fread initializes this to zero, so we need not specbind it
187 or worry about what happens to it when there is an error. */
188 static int new_backquote_flag
;
190 /* A list of file names for files being loaded in Fload. Used to
191 check for recursive loads. */
193 static Lisp_Object Vloads_in_progress
;
195 /* Non-zero means load dangerous compiled Lisp files. */
197 int load_dangerous_libraries
;
199 /* A regular expression used to detect files compiled with Emacs. */
201 static Lisp_Object Vbytecomp_version_regexp
;
203 static void to_multibyte
P_ ((char **, char **, int *));
204 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
205 Lisp_Object (*) (), int,
206 Lisp_Object
, Lisp_Object
));
207 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
208 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
211 /* Handle unreading and rereading of characters.
212 Write READCHAR to read a character,
213 UNREAD(c) to unread c to be read again.
215 The READCHAR and UNREAD macros are meant for reading/unreading a
216 byte code; they do not handle multibyte characters. The caller
217 should manage them if necessary.
219 [ Actually that seems to be a lie; READCHAR will definitely read
220 multibyte characters from buffer sources, at least. Is the
221 comment just out of date?
222 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
225 #define READCHAR readchar (readcharfun)
226 #define UNREAD(c) unreadchar (readcharfun, c)
229 readchar (readcharfun
)
230 Lisp_Object readcharfun
;
237 if (BUFFERP (readcharfun
))
239 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
241 int pt_byte
= BUF_PT_BYTE (inbuffer
);
242 int orig_pt_byte
= pt_byte
;
244 if (readchar_backlog
> 0)
245 /* We get the address of the byte just passed,
246 which is the last byte of the character.
247 The other bytes in this character are consecutive with it,
248 because the gap can't be in the middle of a character. */
249 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
250 - --readchar_backlog
);
252 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
255 readchar_backlog
= -1;
257 if (! NILP (inbuffer
->enable_multibyte_characters
))
259 /* Fetch the character code from the buffer. */
260 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
261 BUF_INC_POS (inbuffer
, pt_byte
);
262 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
266 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
269 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
273 if (MARKERP (readcharfun
))
275 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
277 int bytepos
= marker_byte_position (readcharfun
);
278 int orig_bytepos
= bytepos
;
280 if (readchar_backlog
> 0)
281 /* We get the address of the byte just passed,
282 which is the last byte of the character.
283 The other bytes in this character are consecutive with it,
284 because the gap can't be in the middle of a character. */
285 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
286 - --readchar_backlog
);
288 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
291 readchar_backlog
= -1;
293 if (! NILP (inbuffer
->enable_multibyte_characters
))
295 /* Fetch the character code from the buffer. */
296 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
297 BUF_INC_POS (inbuffer
, bytepos
);
298 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
302 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
306 XMARKER (readcharfun
)->bytepos
= bytepos
;
307 XMARKER (readcharfun
)->charpos
++;
312 if (EQ (readcharfun
, Qlambda
))
313 return read_bytecode_char (0);
315 if (EQ (readcharfun
, Qget_file_char
))
319 /* Interrupted reads have been observed while reading over the network */
320 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
329 if (STRINGP (readcharfun
))
331 if (read_from_string_index
>= read_from_string_limit
)
334 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
335 read_from_string_index
,
336 read_from_string_index_byte
);
341 tem
= call0 (readcharfun
);
348 /* Unread the character C in the way appropriate for the stream READCHARFUN.
349 If the stream is a user function, call it with the char as argument. */
352 unreadchar (readcharfun
, c
)
353 Lisp_Object readcharfun
;
358 /* Don't back up the pointer if we're unreading the end-of-input mark,
359 since readchar didn't advance it when we read it. */
361 else if (BUFFERP (readcharfun
))
363 struct buffer
*b
= XBUFFER (readcharfun
);
364 int bytepos
= BUF_PT_BYTE (b
);
366 if (readchar_backlog
>= 0)
371 if (! NILP (b
->enable_multibyte_characters
))
372 BUF_DEC_POS (b
, bytepos
);
376 BUF_PT_BYTE (b
) = bytepos
;
379 else if (MARKERP (readcharfun
))
381 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
382 int bytepos
= XMARKER (readcharfun
)->bytepos
;
384 if (readchar_backlog
>= 0)
388 XMARKER (readcharfun
)->charpos
--;
389 if (! NILP (b
->enable_multibyte_characters
))
390 BUF_DEC_POS (b
, bytepos
);
394 XMARKER (readcharfun
)->bytepos
= bytepos
;
397 else if (STRINGP (readcharfun
))
399 read_from_string_index
--;
400 read_from_string_index_byte
401 = string_char_to_byte (readcharfun
, read_from_string_index
);
403 else if (EQ (readcharfun
, Qlambda
))
404 read_bytecode_char (1);
405 else if (EQ (readcharfun
, Qget_file_char
))
406 ungetc (c
, instream
);
408 call1 (readcharfun
, make_number (c
));
411 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
413 static Lisp_Object read0
P_ ((Lisp_Object
));
414 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
416 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
417 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
418 static int read_multibyte
P_ ((int, Lisp_Object
));
420 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
422 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
424 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
427 /* Get a character from the tty. */
429 extern Lisp_Object
read_char ();
431 /* Read input events until we get one that's acceptable for our purposes.
433 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
434 until we get a character we like, and then stuffed into
437 If ASCII_REQUIRED is non-zero, we check function key events to see
438 if the unmodified version of the symbol has a Qascii_character
439 property, and use that character, if present.
441 If ERROR_NONASCII is non-zero, we signal an error if the input we
442 get isn't an ASCII character with modifiers. If it's zero but
443 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
446 If INPUT_METHOD is nonzero, we invoke the current input method
447 if the character warrants that. */
450 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
452 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
454 register Lisp_Object val
, delayed_switch_frame
;
456 #ifdef HAVE_WINDOW_SYSTEM
457 if (display_hourglass_p
)
461 delayed_switch_frame
= Qnil
;
463 /* Read until we get an acceptable event. */
465 val
= read_char (0, 0, 0,
466 (input_method
? Qnil
: Qt
),
472 /* switch-frame events are put off until after the next ASCII
473 character. This is better than signaling an error just because
474 the last characters were typed to a separate minibuffer frame,
475 for example. Eventually, some code which can deal with
476 switch-frame events will read it and process it. */
478 && EVENT_HAS_PARAMETERS (val
)
479 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
481 delayed_switch_frame
= val
;
487 /* Convert certain symbols to their ASCII equivalents. */
490 Lisp_Object tem
, tem1
;
491 tem
= Fget (val
, Qevent_symbol_element_mask
);
494 tem1
= Fget (Fcar (tem
), Qascii_character
);
495 /* Merge this symbol's modifier bits
496 with the ASCII equivalent of its basic code. */
498 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
502 /* If we don't have a character now, deal with it appropriately. */
507 Vunread_command_events
= Fcons (val
, Qnil
);
508 error ("Non-character input-event");
515 if (! NILP (delayed_switch_frame
))
516 unread_switch_frame
= delayed_switch_frame
;
520 #ifdef HAVE_WINDOW_SYSTEM
521 if (display_hourglass_p
)
530 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
531 doc
: /* Read a character from the command input (keyboard or macro).
532 It is returned as a number.
533 If the user generates an event which is not a character (i.e. a mouse
534 click or function key event), `read-char' signals an error. As an
535 exception, switch-frame events are put off until non-ASCII events can
537 If you want to read non-character events, or ignore them, call
538 `read-event' or `read-char-exclusive' instead.
540 If the optional argument PROMPT is non-nil, display that as a prompt.
541 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
542 input method is turned on in the current buffer, that input method
543 is used for reading a character. */)
544 (prompt
, inherit_input_method
)
545 Lisp_Object prompt
, inherit_input_method
;
548 message_with_string ("%s", prompt
, 0);
549 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
552 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
553 doc
: /* Read an event object from the input stream.
554 If the optional argument PROMPT is non-nil, display that as a prompt.
555 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
556 input method is turned on in the current buffer, that input method
557 is used for reading a character. */)
558 (prompt
, inherit_input_method
)
559 Lisp_Object prompt
, inherit_input_method
;
562 message_with_string ("%s", prompt
, 0);
563 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
566 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
567 doc
: /* Read a character from the command input (keyboard or macro).
568 It is returned as a number. Non-character events are ignored.
570 If the optional argument PROMPT is non-nil, display that as a prompt.
571 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
572 input method is turned on in the current buffer, that input method
573 is used for reading a character. */)
574 (prompt
, inherit_input_method
)
575 Lisp_Object prompt
, inherit_input_method
;
578 message_with_string ("%s", prompt
, 0);
579 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
582 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
583 doc
: /* Don't use this yourself. */)
586 register Lisp_Object val
;
587 XSETINT (val
, getc (instream
));
593 /* Value is non-zero if the file asswociated with file descriptor FD
594 is a compiled Lisp file that's safe to load. Only files compiled
595 with Emacs are safe to load. Files compiled with XEmacs can lead
596 to a crash in Fbyte_code because of an incompatible change in the
607 /* Read the first few bytes from the file, and look for a line
608 specifying the byte compiler version used. */
609 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
614 /* Skip to the next newline, skipping over the initial `ELC'
615 with NUL bytes following it. */
616 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
620 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
625 lseek (fd
, 0, SEEK_SET
);
630 /* Callback for record_unwind_protect. Restore the old load list OLD,
631 after loading a file successfully. */
634 record_load_unwind (old
)
637 return Vloads_in_progress
= old
;
640 /* This handler function is used via internal_condition_case_1. */
643 load_error_handler (data
)
649 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
650 doc
: /* Execute a file of Lisp code named FILE.
651 First try FILE with `.elc' appended, then try with `.el',
652 then try FILE unmodified (the exact suffixes are determined by
653 `load-suffixes'). Environment variable references in FILE
654 are replaced with their values by calling `substitute-in-file-name'.
655 This function searches the directories in `load-path'.
656 If optional second arg NOERROR is non-nil,
657 report no error if FILE doesn't exist.
658 Print messages at start and end of loading unless
659 optional third arg NOMESSAGE is non-nil.
660 If optional fourth arg NOSUFFIX is non-nil, don't try adding
661 suffixes `.elc' or `.el' to the specified name FILE.
662 If optional fifth arg MUST-SUFFIX is non-nil, insist on
663 the suffix `.elc' or `.el'; don't accept just FILE unless
664 it ends in one of those suffixes or includes a directory name.
665 Return t if file exists. */)
666 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
667 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
669 register FILE *stream
;
670 register int fd
= -1;
671 register Lisp_Object lispstream
;
672 int count
= SPECPDL_INDEX ();
675 Lisp_Object found
, efound
;
676 /* 1 means we printed the ".el is newer" message. */
678 /* 1 means we are loading a compiled file. */
689 /* If file name is magic, call the handler. */
690 /* This shouldn't be necessary any more now that `openp' handles it right.
691 handler = Ffind_file_name_handler (file, Qload);
693 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
695 /* Do this after the handler to avoid
696 the need to gcpro noerror, nomessage and nosuffix.
697 (Below here, we care only whether they are nil or not.)
698 The presence of this call is the result of a historical accident:
699 it used to be in every file-operations and when it got removed
700 everywhere, it accidentally stayed here. Since then, enough people
701 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
702 that it seemed risky to remove. */
703 if (! NILP (noerror
))
705 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
706 Qt
, load_error_handler
);
711 file
= Fsubstitute_in_file_name (file
);
714 /* Avoid weird lossage with null string as arg,
715 since it would try to load a directory as a Lisp file */
716 if (SCHARS (file
) > 0)
718 int size
= SBYTES (file
);
723 if (! NILP (must_suffix
))
725 /* Don't insist on adding a suffix if FILE already ends with one. */
727 && !strcmp (SDATA (file
) + size
- 3, ".el"))
730 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
732 /* Don't insist on adding a suffix
733 if the argument includes a directory name. */
734 else if (! NILP (Ffile_name_directory (file
)))
738 fd
= openp (Vload_path
, file
,
739 (!NILP (nosuffix
) ? Qnil
740 : !NILP (must_suffix
) ? Vload_suffixes
741 : Fappend (2, (tmp
[0] = Vload_suffixes
,
742 tmp
[1] = default_suffixes
,
751 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
752 Fcons (file
, Qnil
)));
757 /* Tell startup.el whether or not we found the user's init file. */
758 if (EQ (Qt
, Vuser_init_file
))
759 Vuser_init_file
= found
;
761 /* If FD is -2, that means openp found a magic file. */
764 if (NILP (Fequal (found
, file
)))
765 /* If FOUND is a different file name from FILE,
766 find its handler even if we have already inhibited
767 the `load' operation on FILE. */
768 handler
= Ffind_file_name_handler (found
, Qt
);
770 handler
= Ffind_file_name_handler (found
, Qload
);
771 if (! NILP (handler
))
772 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
775 /* Check if we're stuck in a recursive load cycle.
777 2000-09-21: It's not possible to just check for the file loaded
778 being a member of Vloads_in_progress. This fails because of the
779 way the byte compiler currently works; `provide's are not
780 evaluted, see font-lock.el/jit-lock.el as an example. This
781 leads to a certain amount of ``normal'' recursion.
783 Also, just loading a file recursively is not always an error in
784 the general case; the second load may do something different. */
788 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
789 if (!NILP (Fequal (found
, XCAR (tem
))))
792 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
793 Fcons (found
, Vloads_in_progress
)));
794 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
795 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
798 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
800 /* Load .elc files directly, but not when they are
801 remote and have no handler! */
808 if (!safe_to_load_p (fd
))
811 if (!load_dangerous_libraries
)
815 error ("File `%s' was not compiled in Emacs",
818 else if (!NILP (nomessage
))
819 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
825 efound
= ENCODE_FILE (found
);
830 stat ((char *)SDATA (efound
), &s1
);
831 SSET (efound
, SBYTES (efound
) - 1, 0);
832 result
= stat ((char *)SDATA (efound
), &s2
);
833 SSET (efound
, SBYTES (efound
) - 1, 'c');
836 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
838 /* Make the progress messages mention that source is newer. */
841 /* If we won't print another message, mention this anyway. */
842 if (!NILP (nomessage
))
845 file
= Fsubstring (found
, make_number (0), make_number (-1));
846 message_with_string ("Source file `%s' newer than byte-compiled file",
854 /* We are loading a source file (*.el). */
855 if (!NILP (Vload_source_file_function
))
861 val
= call4 (Vload_source_file_function
, found
, file
,
862 NILP (noerror
) ? Qnil
: Qt
,
863 NILP (nomessage
) ? Qnil
: Qt
);
864 return unbind_to (count
, val
);
871 efound
= ENCODE_FILE (found
);
872 stream
= fopen ((char *) SDATA (efound
), fmode
);
874 #else /* not WINDOWSNT */
875 stream
= fdopen (fd
, fmode
);
876 #endif /* not WINDOWSNT */
880 error ("Failure to create stdio stream for %s", SDATA (file
));
883 if (! NILP (Vpurify_flag
))
884 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
886 if (NILP (nomessage
))
889 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
892 message_with_string ("Loading %s (source)...", file
, 1);
894 message_with_string ("Loading %s (compiled; note, source file is newer)...",
896 else /* The typical case; compiled file newer than source file. */
897 message_with_string ("Loading %s...", file
, 1);
901 lispstream
= Fcons (Qnil
, Qnil
);
902 XSETCARFASTINT (lispstream
, (EMACS_UINT
)stream
>> 16);
903 XSETCDRFASTINT (lispstream
, (EMACS_UINT
)stream
& 0xffff);
904 record_unwind_protect (load_unwind
, lispstream
);
905 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
906 specbind (Qload_file_name
, found
);
907 specbind (Qinhibit_file_name_operation
, Qnil
);
909 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
911 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
912 unbind_to (count
, Qnil
);
914 /* Run any load-hooks for this file. */
915 temp
= Fassoc (file
, Vafter_load_alist
);
917 Fprogn (Fcdr (temp
));
920 if (saved_doc_string
)
921 free (saved_doc_string
);
922 saved_doc_string
= 0;
923 saved_doc_string_size
= 0;
925 if (prev_saved_doc_string
)
926 xfree (prev_saved_doc_string
);
927 prev_saved_doc_string
= 0;
928 prev_saved_doc_string_size
= 0;
930 if (!noninteractive
&& NILP (nomessage
))
933 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
936 message_with_string ("Loading %s (source)...done", file
, 1);
938 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
940 else /* The typical case; compiled file newer than source file. */
941 message_with_string ("Loading %s...done", file
, 1);
948 load_unwind (stream
) /* used as unwind-protect function in load */
951 fclose ((FILE *) (XFASTINT (XCAR (stream
)) << 16
952 | XFASTINT (XCDR (stream
))));
953 if (--load_in_progress
< 0) load_in_progress
= 0;
958 load_descriptor_unwind (oldlist
)
961 load_descriptor_list
= oldlist
;
965 /* Close all descriptors in use for Floads.
966 This is used when starting a subprocess. */
973 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
974 emacs_close (XFASTINT (XCAR (tail
)));
979 complete_filename_p (pathname
)
980 Lisp_Object pathname
;
982 register const unsigned char *s
= SDATA (pathname
);
983 return (IS_DIRECTORY_SEP (s
[0])
984 || (SCHARS (pathname
) > 2
985 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
995 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
996 doc
: /* Search for FILENAME through PATH.
997 If SUFFIXES is non-nil, it should be a list of suffixes to append to
998 file name when searching.
999 If non-nil, PREDICATE is used instead of `file-readable-p'.
1000 PREDICATE can also be an integer to pass to the access(2) function,
1001 in which case file-name-handlers are ignored. */)
1002 (filename
, path
, suffixes
, predicate
)
1003 Lisp_Object filename
, path
, suffixes
, predicate
;
1006 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1007 if (NILP (predicate
) && fd
> 0)
1013 /* Search for a file whose name is STR, looking in directories
1014 in the Lisp list PATH, and trying suffixes from SUFFIX.
1015 On success, returns a file descriptor. On failure, returns -1.
1017 SUFFIXES is a list of strings containing possible suffixes.
1018 The empty suffix is automatically added iff the list is empty.
1020 PREDICATE non-nil means don't open the files,
1021 just look for one that satisfies the predicate. In this case,
1022 returns 1 on success. The predicate can be a lisp function or
1023 an integer to pass to `access' (in which case file-name-handlers
1026 If STOREPTR is nonzero, it points to a slot where the name of
1027 the file actually found should be stored as a Lisp string.
1028 nil is stored there on failure.
1030 If the file we find is remote, return -2
1031 but store the found remote file name in *STOREPTR. */
1034 openp (path
, str
, suffixes
, storeptr
, predicate
)
1035 Lisp_Object path
, str
;
1036 Lisp_Object suffixes
;
1037 Lisp_Object
*storeptr
;
1038 Lisp_Object predicate
;
1043 register char *fn
= buf
;
1046 Lisp_Object filename
;
1048 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1049 Lisp_Object string
, tail
, encoded_fn
;
1050 int max_suffix_len
= 0;
1052 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1054 CHECK_STRING_CAR (tail
);
1055 max_suffix_len
= max (max_suffix_len
,
1056 SBYTES (XCAR (tail
)));
1059 string
= filename
= Qnil
;
1060 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1065 if (complete_filename_p (str
))
1068 for (; CONSP (path
); path
= XCDR (path
))
1070 filename
= Fexpand_file_name (str
, XCAR (path
));
1071 if (!complete_filename_p (filename
))
1072 /* If there are non-absolute elts in PATH (eg ".") */
1073 /* Of course, this could conceivably lose if luser sets
1074 default-directory to be something non-absolute... */
1076 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1077 if (!complete_filename_p (filename
))
1078 /* Give up on this path element! */
1082 /* Calculate maximum size of any filename made from
1083 this path element/specified file name and any possible suffix. */
1084 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1085 if (fn_size
< want_size
)
1086 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1088 /* Loop over suffixes. */
1089 for (tail
= NILP (suffixes
) ? default_suffixes
: suffixes
;
1090 CONSP (tail
); tail
= XCDR (tail
))
1092 int lsuffix
= SBYTES (XCAR (tail
));
1093 Lisp_Object handler
;
1096 /* Concatenate path element/specified name with the suffix.
1097 If the directory starts with /:, remove that. */
1098 if (SCHARS (filename
) > 2
1099 && SREF (filename
, 0) == '/'
1100 && SREF (filename
, 1) == ':')
1102 strncpy (fn
, SDATA (filename
) + 2,
1103 SBYTES (filename
) - 2);
1104 fn
[SBYTES (filename
) - 2] = 0;
1108 strncpy (fn
, SDATA (filename
),
1110 fn
[SBYTES (filename
)] = 0;
1113 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1114 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1116 /* Check that the file exists and is not a directory. */
1117 /* We used to only check for handlers on non-absolute file names:
1121 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1122 It's not clear why that was the case and it breaks things like
1123 (load "/bar.el") where the file is actually "/bar.el.gz". */
1124 string
= build_string (fn
);
1125 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1126 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1128 if (NILP (predicate
))
1129 exists
= !NILP (Ffile_readable_p (string
));
1131 exists
= !NILP (call1 (predicate
, string
));
1132 if (exists
&& !NILP (Ffile_directory_p (string
)))
1137 /* We succeeded; return this descriptor and filename. */
1148 encoded_fn
= ENCODE_FILE (string
);
1149 pfn
= SDATA (encoded_fn
);
1150 exists
= (stat (pfn
, &st
) >= 0
1151 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1154 /* Check that we can access or open it. */
1155 if (NATNUMP (predicate
))
1156 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1158 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1162 /* We succeeded; return this descriptor and filename. */
1180 /* Merge the list we've accumulated of globals from the current input source
1181 into the load_history variable. The details depend on whether
1182 the source has an associated file name or not. */
1185 build_load_history (stream
, source
)
1189 register Lisp_Object tail
, prev
, newelt
;
1190 register Lisp_Object tem
, tem2
;
1191 register int foundit
, loading
;
1193 loading
= stream
|| !NARROWED
;
1195 tail
= Vload_history
;
1198 while (CONSP (tail
))
1202 /* Find the feature's previous assoc list... */
1203 if (!NILP (Fequal (source
, Fcar (tem
))))
1207 /* If we're loading, remove it. */
1211 Vload_history
= XCDR (tail
);
1213 Fsetcdr (prev
, XCDR (tail
));
1216 /* Otherwise, cons on new symbols that are not already members. */
1219 tem2
= Vcurrent_load_list
;
1221 while (CONSP (tem2
))
1223 newelt
= XCAR (tem2
);
1225 if (NILP (Fmember (newelt
, tem
)))
1226 Fsetcar (tail
, Fcons (XCAR (tem
),
1227 Fcons (newelt
, XCDR (tem
))));
1240 /* If we're loading, cons the new assoc onto the front of load-history,
1241 the most-recently-loaded position. Also do this if we didn't find
1242 an existing member for the current source. */
1243 if (loading
|| !foundit
)
1244 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1249 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1257 readevalloop_1 (old
)
1260 load_convert_to_unibyte
= ! NILP (old
);
1264 /* Signal an `end-of-file' error, if possible with file name
1268 end_of_file_error ()
1272 if (STRINGP (Vload_file_name
))
1273 data
= Fcons (Vload_file_name
, Qnil
);
1277 Fsignal (Qend_of_file
, data
);
1280 /* UNIBYTE specifies how to set load_convert_to_unibyte
1281 for this invocation.
1282 READFUN, if non-nil, is used instead of `read'. */
1285 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1286 Lisp_Object readcharfun
;
1288 Lisp_Object sourcename
;
1289 Lisp_Object (*evalfun
) ();
1291 Lisp_Object unibyte
, readfun
;
1294 register Lisp_Object val
;
1295 int count
= SPECPDL_INDEX ();
1296 struct gcpro gcpro1
;
1297 struct buffer
*b
= 0;
1298 int continue_reading_p
;
1300 if (BUFFERP (readcharfun
))
1301 b
= XBUFFER (readcharfun
);
1302 else if (MARKERP (readcharfun
))
1303 b
= XMARKER (readcharfun
)->buffer
;
1305 specbind (Qstandard_input
, readcharfun
);
1306 specbind (Qcurrent_load_list
, Qnil
);
1307 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1308 load_convert_to_unibyte
= !NILP (unibyte
);
1310 readchar_backlog
= -1;
1312 GCPRO1 (sourcename
);
1314 LOADHIST_ATTACH (sourcename
);
1316 continue_reading_p
= 1;
1317 while (continue_reading_p
)
1319 if (b
!= 0 && NILP (b
->name
))
1320 error ("Reading from killed buffer");
1326 while ((c
= READCHAR
) != '\n' && c
!= -1);
1331 /* Ignore whitespace here, so we can detect eof. */
1332 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1335 if (!NILP (Vpurify_flag
) && c
== '(')
1337 int count1
= SPECPDL_INDEX ();
1338 record_unwind_protect (unreadpure
, Qnil
);
1339 val
= read_list (-1, readcharfun
);
1340 unbind_to (count1
, Qnil
);
1345 read_objects
= Qnil
;
1346 if (!NILP (readfun
))
1348 val
= call1 (readfun
, readcharfun
);
1350 /* If READCHARFUN has set point to ZV, we should
1351 stop reading, even if the form read sets point
1352 to a different value when evaluated. */
1353 if (BUFFERP (readcharfun
))
1355 struct buffer
*b
= XBUFFER (readcharfun
);
1356 if (BUF_PT (b
) == BUF_ZV (b
))
1357 continue_reading_p
= 0;
1360 else if (! NILP (Vload_read_function
))
1361 val
= call1 (Vload_read_function
, readcharfun
);
1363 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1366 val
= (*evalfun
) (val
);
1370 Vvalues
= Fcons (val
, Vvalues
);
1371 if (EQ (Vstandard_output
, Qt
))
1378 build_load_history (stream
, sourcename
);
1381 unbind_to (count
, Qnil
);
1384 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1385 doc
: /* Execute the current buffer as Lisp code.
1386 Programs can pass two arguments, BUFFER and PRINTFLAG.
1387 BUFFER is the buffer to evaluate (nil means use current buffer).
1388 PRINTFLAG controls printing of output:
1389 nil means discard it; anything else is stream for print.
1391 If the optional third argument FILENAME is non-nil,
1392 it specifies the file name to use for `load-history'.
1393 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1394 for this invocation.
1396 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1397 `print' and related functions should work normally even if PRINTFLAG is nil.
1399 This function preserves the position of point. */)
1400 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1401 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1403 int count
= SPECPDL_INDEX ();
1404 Lisp_Object tem
, buf
;
1407 buf
= Fcurrent_buffer ();
1409 buf
= Fget_buffer (buffer
);
1411 error ("No such buffer");
1413 if (NILP (printflag
) && NILP (do_allow_print
))
1418 if (NILP (filename
))
1419 filename
= XBUFFER (buf
)->filename
;
1421 specbind (Qstandard_output
, tem
);
1422 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1423 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1424 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1425 unbind_to (count
, Qnil
);
1430 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1431 doc
: /* Execute the region as Lisp code.
1432 When called from programs, expects two arguments,
1433 giving starting and ending indices in the current buffer
1434 of the text to be executed.
1435 Programs can pass third argument PRINTFLAG which controls output:
1436 nil means discard it; anything else is stream for printing it.
1437 Also the fourth argument READ-FUNCTION, if non-nil, is used
1438 instead of `read' to read each expression. It gets one argument
1439 which is the input stream for reading characters.
1441 This function does not move point. */)
1442 (start
, end
, printflag
, read_function
)
1443 Lisp_Object start
, end
, printflag
, read_function
;
1445 int count
= SPECPDL_INDEX ();
1446 Lisp_Object tem
, cbuf
;
1448 cbuf
= Fcurrent_buffer ();
1450 if (NILP (printflag
))
1454 specbind (Qstandard_output
, tem
);
1456 if (NILP (printflag
))
1457 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1458 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1460 /* This both uses start and checks its type. */
1462 Fnarrow_to_region (make_number (BEGV
), end
);
1463 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1464 !NILP (printflag
), Qnil
, read_function
);
1466 return unbind_to (count
, Qnil
);
1470 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1471 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1472 If STREAM is nil, use the value of `standard-input' (which see).
1473 STREAM or the value of `standard-input' may be:
1474 a buffer (read from point and advance it)
1475 a marker (read from where it points and advance it)
1476 a function (call it with no arguments for each character,
1477 call it with a char as argument to push a char back)
1478 a string (takes text from string, starting at the beginning)
1479 t (read text line using minibuffer and use it, or read from
1480 standard input in batch mode). */)
1485 stream
= Vstandard_input
;
1486 if (EQ (stream
, Qt
))
1487 stream
= Qread_char
;
1488 if (EQ (stream
, Qread_char
))
1489 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1491 return read_internal_start (stream
, Qnil
, Qnil
);
1494 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1495 doc
: /* Read one Lisp expression which is represented as text by STRING.
1496 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1497 START and END optionally delimit a substring of STRING from which to read;
1498 they default to 0 and (length STRING) respectively. */)
1499 (string
, start
, end
)
1500 Lisp_Object string
, start
, end
;
1503 CHECK_STRING (string
);
1504 /* read_internal_start sets read_from_string_index. */
1505 ret
= read_internal_start (string
, start
, end
);
1506 return Fcons (ret
, make_number (read_from_string_index
));
1509 /* Function to set up the global context we need in toplevel read
1512 read_internal_start (stream
, start
, end
)
1514 Lisp_Object start
; /* Only used when stream is a string. */
1515 Lisp_Object end
; /* Only used when stream is a string. */
1519 readchar_backlog
= -1;
1521 new_backquote_flag
= 0;
1522 read_objects
= Qnil
;
1523 if (EQ (Vread_with_symbol_positions
, Qt
)
1524 || EQ (Vread_with_symbol_positions
, stream
))
1525 Vread_symbol_positions_list
= Qnil
;
1527 if (STRINGP (stream
))
1529 int startval
, endval
;
1531 endval
= SCHARS (stream
);
1535 endval
= XINT (end
);
1536 if (endval
< 0 || endval
> SCHARS (stream
))
1537 args_out_of_range (stream
, end
);
1544 CHECK_NUMBER (start
);
1545 startval
= XINT (start
);
1546 if (startval
< 0 || startval
> endval
)
1547 args_out_of_range (stream
, start
);
1549 read_from_string_index
= startval
;
1550 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1551 read_from_string_limit
= endval
;
1554 retval
= read0 (stream
);
1555 if (EQ (Vread_with_symbol_positions
, Qt
)
1556 || EQ (Vread_with_symbol_positions
, stream
))
1557 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1561 /* Use this for recursive reads, in contexts where internal tokens
1566 Lisp_Object readcharfun
;
1568 register Lisp_Object val
;
1571 val
= read1 (readcharfun
, &c
, 0);
1573 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1580 static int read_buffer_size
;
1581 static char *read_buffer
;
1583 /* Read multibyte form and return it as a character. C is a first
1584 byte of multibyte form, and rest of them are read from
1588 read_multibyte (c
, readcharfun
)
1590 Lisp_Object readcharfun
;
1592 /* We need the actual character code of this multibyte
1594 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1602 while ((c
= READCHAR
) >= 0xA0
1603 && len
< MAX_MULTIBYTE_LENGTH
)
1609 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1610 return STRING_CHAR (str
, len
);
1611 /* The byte sequence is not valid as multibyte. Unread all bytes
1612 but the first one, and return the first byte. */
1618 /* Read a \-escape sequence, assuming we already read the `\'.
1619 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1620 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1621 Otherwise store 0 into *BYTEREP. */
1624 read_escape (readcharfun
, stringp
, byterep
)
1625 Lisp_Object readcharfun
;
1629 register int c
= READCHAR
;
1636 end_of_file_error ();
1666 error ("Invalid escape character syntax");
1669 c
= read_escape (readcharfun
, 0, byterep
);
1670 return c
| meta_modifier
;
1675 error ("Invalid escape character syntax");
1678 c
= read_escape (readcharfun
, 0, byterep
);
1679 return c
| shift_modifier
;
1684 error ("Invalid escape character syntax");
1687 c
= read_escape (readcharfun
, 0, byterep
);
1688 return c
| hyper_modifier
;
1693 error ("Invalid escape character syntax");
1696 c
= read_escape (readcharfun
, 0, byterep
);
1697 return c
| alt_modifier
;
1709 c
= read_escape (readcharfun
, 0, byterep
);
1710 return c
| super_modifier
;
1715 error ("Invalid escape character syntax");
1719 c
= read_escape (readcharfun
, 0, byterep
);
1720 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1721 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1722 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1723 return c
| ctrl_modifier
;
1724 /* ASCII control chars are made from letters (both cases),
1725 as well as the non-letters within 0100...0137. */
1726 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1727 return (c
& (037 | ~0177));
1728 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1729 return (c
& (037 | ~0177));
1731 return c
| ctrl_modifier
;
1741 /* An octal escape, as in ANSI C. */
1743 register int i
= c
- '0';
1744 register int count
= 0;
1747 if ((c
= READCHAR
) >= '0' && c
<= '7')
1764 /* A hex escape, as in ANSI C. */
1770 if (c
>= '0' && c
<= '9')
1775 else if ((c
>= 'a' && c
<= 'f')
1776 || (c
>= 'A' && c
<= 'F'))
1779 if (c
>= 'a' && c
<= 'f')
1796 if (BASE_LEADING_CODE_P (c
))
1797 c
= read_multibyte (c
, readcharfun
);
1803 /* Read an integer in radix RADIX using READCHARFUN to read
1804 characters. RADIX must be in the interval [2..36]; if it isn't, a
1805 read error is signaled . Value is the integer read. Signals an
1806 error if encountering invalid read syntax or if RADIX is out of
1810 read_integer (readcharfun
, radix
)
1811 Lisp_Object readcharfun
;
1814 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1815 EMACS_INT number
= 0;
1817 if (radix
< 2 || radix
> 36)
1821 number
= ndigits
= invalid_p
= 0;
1837 if (c
>= '0' && c
<= '9')
1839 else if (c
>= 'a' && c
<= 'z')
1840 digit
= c
- 'a' + 10;
1841 else if (c
>= 'A' && c
<= 'Z')
1842 digit
= c
- 'A' + 10;
1849 if (digit
< 0 || digit
>= radix
)
1852 number
= radix
* number
+ digit
;
1858 if (ndigits
== 0 || invalid_p
)
1861 sprintf (buf
, "integer, radix %d", radix
);
1862 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1865 return make_number (sign
* number
);
1869 /* Convert unibyte text in read_buffer to multibyte.
1871 Initially, *P is a pointer after the end of the unibyte text, and
1872 the pointer *END points after the end of read_buffer.
1874 If read_buffer doesn't have enough room to hold the result
1875 of the conversion, reallocate it and adjust *P and *END.
1877 At the end, make *P point after the result of the conversion, and
1878 return in *NCHARS the number of characters in the converted
1882 to_multibyte (p
, end
, nchars
)
1888 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
1889 if (read_buffer_size
< 2 * nbytes
)
1891 int offset
= *p
- read_buffer
;
1892 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
1893 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
1894 *p
= read_buffer
+ offset
;
1895 *end
= read_buffer
+ read_buffer_size
;
1898 if (nbytes
!= *nchars
)
1899 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
1900 *p
- read_buffer
, nchars
);
1902 *p
= read_buffer
+ nbytes
;
1906 /* If the next token is ')' or ']' or '.', we store that character
1907 in *PCH and the return value is not interesting. Else, we store
1908 zero in *PCH and we read and return one lisp object.
1910 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1913 read1 (readcharfun
, pch
, first_in_list
)
1914 register Lisp_Object readcharfun
;
1919 int uninterned_symbol
= 0;
1927 end_of_file_error ();
1932 return read_list (0, readcharfun
);
1935 return read_vector (readcharfun
, 0);
1952 tmp
= read_vector (readcharfun
, 0);
1953 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1954 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1955 error ("Invalid size char-table");
1956 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1957 XCHAR_TABLE (tmp
)->top
= Qt
;
1966 tmp
= read_vector (readcharfun
, 0);
1967 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1968 error ("Invalid size char-table");
1969 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1970 XCHAR_TABLE (tmp
)->top
= Qnil
;
1973 Fsignal (Qinvalid_read_syntax
,
1974 Fcons (make_string ("#^^", 3), Qnil
));
1976 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1981 length
= read1 (readcharfun
, pch
, first_in_list
);
1985 Lisp_Object tmp
, val
;
1986 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1990 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1991 if (size_in_chars
!= SCHARS (tmp
)
1992 /* We used to print 1 char too many
1993 when the number of bits was a multiple of 8.
1994 Accept such input in case it came from an old version. */
1995 && ! (XFASTINT (length
)
1996 == (SCHARS (tmp
) - 1) * BITS_PER_CHAR
))
1997 Fsignal (Qinvalid_read_syntax
,
1998 Fcons (make_string ("#&...", 5), Qnil
));
2000 val
= Fmake_bool_vector (length
, Qnil
);
2001 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2003 /* Clear the extraneous bits in the last byte. */
2004 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
2005 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2006 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
2009 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2014 /* Accept compiled functions at read-time so that we don't have to
2015 build them using function calls. */
2017 tmp
= read_vector (readcharfun
, 1);
2018 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2019 XVECTOR (tmp
)->contents
);
2024 struct gcpro gcpro1
;
2027 /* Read the string itself. */
2028 tmp
= read1 (readcharfun
, &ch
, 0);
2029 if (ch
!= 0 || !STRINGP (tmp
))
2030 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2032 /* Read the intervals and their properties. */
2035 Lisp_Object beg
, end
, plist
;
2037 beg
= read1 (readcharfun
, &ch
, 0);
2042 end
= read1 (readcharfun
, &ch
, 0);
2044 plist
= read1 (readcharfun
, &ch
, 0);
2046 Fsignal (Qinvalid_read_syntax
,
2047 Fcons (build_string ("invalid string property list"),
2049 Fset_text_properties (beg
, end
, plist
, tmp
);
2055 /* #@NUMBER is used to skip NUMBER following characters.
2056 That's used in .elc files to skip over doc strings
2057 and function definitions. */
2062 /* Read a decimal integer. */
2063 while ((c
= READCHAR
) >= 0
2064 && c
>= '0' && c
<= '9')
2072 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2074 /* If we are supposed to force doc strings into core right now,
2075 record the last string that we skipped,
2076 and record where in the file it comes from. */
2078 /* But first exchange saved_doc_string
2079 with prev_saved_doc_string, so we save two strings. */
2081 char *temp
= saved_doc_string
;
2082 int temp_size
= saved_doc_string_size
;
2083 file_offset temp_pos
= saved_doc_string_position
;
2084 int temp_len
= saved_doc_string_length
;
2086 saved_doc_string
= prev_saved_doc_string
;
2087 saved_doc_string_size
= prev_saved_doc_string_size
;
2088 saved_doc_string_position
= prev_saved_doc_string_position
;
2089 saved_doc_string_length
= prev_saved_doc_string_length
;
2091 prev_saved_doc_string
= temp
;
2092 prev_saved_doc_string_size
= temp_size
;
2093 prev_saved_doc_string_position
= temp_pos
;
2094 prev_saved_doc_string_length
= temp_len
;
2097 if (saved_doc_string_size
== 0)
2099 saved_doc_string_size
= nskip
+ 100;
2100 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2102 if (nskip
> saved_doc_string_size
)
2104 saved_doc_string_size
= nskip
+ 100;
2105 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2106 saved_doc_string_size
);
2109 saved_doc_string_position
= file_tell (instream
);
2111 /* Copy that many characters into saved_doc_string. */
2112 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2113 saved_doc_string
[i
] = c
= READCHAR
;
2115 saved_doc_string_length
= i
;
2119 /* Skip that many characters. */
2120 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2128 /* #! appears at the beginning of an executable file.
2129 Skip the first line. */
2130 while (c
!= '\n' && c
>= 0)
2135 return Vload_file_name
;
2137 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2138 /* #:foo is the uninterned symbol named foo. */
2141 uninterned_symbol
= 1;
2145 /* Reader forms that can reuse previously read objects. */
2146 if (c
>= '0' && c
<= '9')
2151 /* Read a non-negative integer. */
2152 while (c
>= '0' && c
<= '9')
2158 /* #n=object returns object, but associates it with n for #n#. */
2161 /* Make a placeholder for #n# to use temporarily */
2162 Lisp_Object placeholder
;
2165 placeholder
= Fcons(Qnil
, Qnil
);
2166 cell
= Fcons (make_number (n
), placeholder
);
2167 read_objects
= Fcons (cell
, read_objects
);
2169 /* Read the object itself. */
2170 tem
= read0 (readcharfun
);
2172 /* Now put it everywhere the placeholder was... */
2173 substitute_object_in_subtree (tem
, placeholder
);
2175 /* ...and #n# will use the real value from now on. */
2176 Fsetcdr (cell
, tem
);
2180 /* #n# returns a previously read object. */
2183 tem
= Fassq (make_number (n
), read_objects
);
2186 /* Fall through to error message. */
2188 else if (c
== 'r' || c
== 'R')
2189 return read_integer (readcharfun
, n
);
2191 /* Fall through to error message. */
2193 else if (c
== 'x' || c
== 'X')
2194 return read_integer (readcharfun
, 16);
2195 else if (c
== 'o' || c
== 'O')
2196 return read_integer (readcharfun
, 8);
2197 else if (c
== 'b' || c
== 'B')
2198 return read_integer (readcharfun
, 2);
2201 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2204 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2209 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2219 new_backquote_flag
++;
2220 value
= read0 (readcharfun
);
2221 new_backquote_flag
--;
2223 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2227 if (new_backquote_flag
)
2229 Lisp_Object comma_type
= Qnil
;
2234 comma_type
= Qcomma_at
;
2236 comma_type
= Qcomma_dot
;
2239 if (ch
>= 0) UNREAD (ch
);
2240 comma_type
= Qcomma
;
2243 new_backquote_flag
--;
2244 value
= read0 (readcharfun
);
2245 new_backquote_flag
++;
2246 return Fcons (comma_type
, Fcons (value
, Qnil
));
2259 end_of_file_error ();
2261 /* Accept `single space' syntax like (list ? x) where the
2262 whitespace character is SPC or TAB.
2263 Other literal whitespace like NL, CR, and FF are not accepted,
2264 as there are well-established escape sequences for these. */
2265 if (c
== ' ' || c
== '\t')
2266 return make_number (c
);
2269 c
= read_escape (readcharfun
, 0, &discard
);
2270 else if (BASE_LEADING_CODE_P (c
))
2271 c
= read_multibyte (c
, readcharfun
);
2273 next_char
= READCHAR
;
2274 if (next_char
== '.')
2276 /* Only a dotted-pair dot is valid after a char constant. */
2277 int next_next_char
= READCHAR
;
2278 UNREAD (next_next_char
);
2280 ok
= (next_next_char
<= 040
2281 || (next_next_char
< 0200
2282 && (index ("\"';([#?", next_next_char
)
2283 || (!first_in_list
&& next_next_char
== '`')
2284 || (new_backquote_flag
&& next_next_char
== ','))));
2288 ok
= (next_char
<= 040
2289 || (next_char
< 0200
2290 && (index ("\"';()[]#?", next_char
)
2291 || (!first_in_list
&& next_char
== '`')
2292 || (new_backquote_flag
&& next_char
== ','))));
2296 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2298 return make_number (c
);
2303 char *p
= read_buffer
;
2304 char *end
= read_buffer
+ read_buffer_size
;
2306 /* 1 if we saw an escape sequence specifying
2307 a multibyte character, or a multibyte character. */
2308 int force_multibyte
= 0;
2309 /* 1 if we saw an escape sequence specifying
2310 a single-byte character. */
2311 int force_singlebyte
= 0;
2312 /* 1 if read_buffer contains multibyte text now. */
2313 int is_multibyte
= 0;
2317 while ((c
= READCHAR
) >= 0
2320 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2322 int offset
= p
- read_buffer
;
2323 read_buffer
= (char *) xrealloc (read_buffer
,
2324 read_buffer_size
*= 2);
2325 p
= read_buffer
+ offset
;
2326 end
= read_buffer
+ read_buffer_size
;
2333 c
= read_escape (readcharfun
, 1, &byterep
);
2335 /* C is -1 if \ newline has just been seen */
2338 if (p
== read_buffer
)
2344 force_singlebyte
= 1;
2345 else if (byterep
== 2)
2346 force_multibyte
= 1;
2349 /* A character that must be multibyte forces multibyte. */
2350 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2351 force_multibyte
= 1;
2353 /* If we just discovered the need to be multibyte,
2354 convert the text accumulated thus far. */
2355 if (force_multibyte
&& ! is_multibyte
)
2358 to_multibyte (&p
, &end
, &nchars
);
2361 /* Allow `\C- ' and `\C-?'. */
2362 if (c
== (CHAR_CTL
| ' '))
2364 else if (c
== (CHAR_CTL
| '?'))
2369 /* Shift modifier is valid only with [A-Za-z]. */
2370 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2372 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2373 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2377 /* Move the meta bit to the right place for a string. */
2378 c
= (c
& ~CHAR_META
) | 0x80;
2379 if (c
& CHAR_MODIFIER_MASK
)
2380 error ("Invalid modifier in string");
2383 p
+= CHAR_STRING (c
, p
);
2391 end_of_file_error ();
2393 /* If purifying, and string starts with \ newline,
2394 return zero instead. This is for doc strings
2395 that we are really going to find in etc/DOC.nn.nn */
2396 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2397 return make_number (0);
2399 if (is_multibyte
|| force_singlebyte
)
2401 else if (load_convert_to_unibyte
)
2404 to_multibyte (&p
, &end
, &nchars
);
2405 if (p
- read_buffer
!= nchars
)
2407 string
= make_multibyte_string (read_buffer
, nchars
,
2409 return Fstring_make_unibyte (string
);
2411 /* We can make a unibyte string directly. */
2414 else if (EQ (readcharfun
, Qget_file_char
)
2415 || EQ (readcharfun
, Qlambda
))
2417 /* Nowadays, reading directly from a file is used only for
2418 compiled Emacs Lisp files, and those always use the
2419 Emacs internal encoding. Meanwhile, Qlambda is used
2420 for reading dynamic byte code (compiled with
2421 byte-compile-dynamic = t). So make the string multibyte
2422 if the string contains any multibyte sequences.
2423 (to_multibyte is a no-op if not.) */
2424 to_multibyte (&p
, &end
, &nchars
);
2425 is_multibyte
= (p
- read_buffer
) != nchars
;
2428 /* In all other cases, if we read these bytes as
2429 separate characters, treat them as separate characters now. */
2432 /* We want readchar_count to be the number of characters, not
2433 bytes. Hence we adjust for multibyte characters in the
2434 string. ... But it doesn't seem to be necessary, because
2435 READCHAR *does* read multibyte characters from buffers. */
2436 /* readchar_count -= (p - read_buffer) - nchars; */
2438 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2440 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2446 int next_char
= READCHAR
;
2449 if (next_char
<= 040
2450 || (next_char
< 0200
2451 && index ("\"';([#?", next_char
)
2452 || (!first_in_list
&& next_char
== '`')
2453 || (new_backquote_flag
&& next_char
== ',')))
2459 /* Otherwise, we fall through! Note that the atom-reading loop
2460 below will now loop at least once, assuring that we will not
2461 try to UNREAD two characters in a row. */
2465 if (c
<= 040) goto retry
;
2467 char *p
= read_buffer
;
2471 char *end
= read_buffer
+ read_buffer_size
;
2475 || (!index ("\"';()[]#", c
)
2476 && !(!first_in_list
&& c
== '`')
2477 && !(new_backquote_flag
&& c
== ','))))
2479 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2481 int offset
= p
- read_buffer
;
2482 read_buffer
= (char *) xrealloc (read_buffer
,
2483 read_buffer_size
*= 2);
2484 p
= read_buffer
+ offset
;
2485 end
= read_buffer
+ read_buffer_size
;
2492 end_of_file_error ();
2496 if (! SINGLE_BYTE_CHAR_P (c
))
2497 p
+= CHAR_STRING (c
, p
);
2506 int offset
= p
- read_buffer
;
2507 read_buffer
= (char *) xrealloc (read_buffer
,
2508 read_buffer_size
*= 2);
2509 p
= read_buffer
+ offset
;
2510 end
= read_buffer
+ read_buffer_size
;
2517 if (!quoted
&& !uninterned_symbol
)
2520 register Lisp_Object val
;
2522 if (*p1
== '+' || *p1
== '-') p1
++;
2523 /* Is it an integer? */
2526 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2527 /* Integers can have trailing decimal points. */
2528 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2530 /* It is an integer. */
2534 if (sizeof (int) == sizeof (EMACS_INT
))
2535 XSETINT (val
, atoi (read_buffer
));
2536 else if (sizeof (long) == sizeof (EMACS_INT
))
2537 XSETINT (val
, atol (read_buffer
));
2543 if (isfloat_string (read_buffer
))
2545 /* Compute NaN and infinities using 0.0 in a variable,
2546 to cope with compilers that think they are smarter
2552 /* Negate the value ourselves. This treats 0, NaNs,
2553 and infinity properly on IEEE floating point hosts,
2554 and works around a common bug where atof ("-0.0")
2556 int negative
= read_buffer
[0] == '-';
2558 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2559 returns 1, is if the input ends in e+INF or e+NaN. */
2566 value
= zero
/ zero
;
2569 value
= atof (read_buffer
+ negative
);
2573 return make_float (negative
? - value
: value
);
2577 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2578 : intern (read_buffer
);
2579 if (EQ (Vread_with_symbol_positions
, Qt
)
2580 || EQ (Vread_with_symbol_positions
, readcharfun
))
2581 Vread_symbol_positions_list
=
2582 /* Kind of a hack; this will probably fail if characters
2583 in the symbol name were escaped. Not really a big
2585 Fcons (Fcons (result
,
2586 make_number (readchar_count
2587 - XFASTINT (Flength (Fsymbol_name (result
))))),
2588 Vread_symbol_positions_list
);
2596 /* List of nodes we've seen during substitute_object_in_subtree. */
2597 static Lisp_Object seen_list
;
2600 substitute_object_in_subtree (object
, placeholder
)
2602 Lisp_Object placeholder
;
2604 Lisp_Object check_object
;
2606 /* We haven't seen any objects when we start. */
2609 /* Make all the substitutions. */
2611 = substitute_object_recurse (object
, placeholder
, object
);
2613 /* Clear seen_list because we're done with it. */
2616 /* The returned object here is expected to always eq the
2618 if (!EQ (check_object
, object
))
2619 error ("Unexpected mutation error in reader");
2622 /* Feval doesn't get called from here, so no gc protection is needed. */
2623 #define SUBSTITUTE(get_val, set_val) \
2625 Lisp_Object old_value = get_val; \
2626 Lisp_Object true_value \
2627 = substitute_object_recurse (object, placeholder,\
2630 if (!EQ (old_value, true_value)) \
2637 substitute_object_recurse (object
, placeholder
, subtree
)
2639 Lisp_Object placeholder
;
2640 Lisp_Object subtree
;
2642 /* If we find the placeholder, return the target object. */
2643 if (EQ (placeholder
, subtree
))
2646 /* If we've been to this node before, don't explore it again. */
2647 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2650 /* If this node can be the entry point to a cycle, remember that
2651 we've seen it. It can only be such an entry point if it was made
2652 by #n=, which means that we can find it as a value in
2654 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2655 seen_list
= Fcons (subtree
, seen_list
);
2657 /* Recurse according to subtree's type.
2658 Every branch must return a Lisp_Object. */
2659 switch (XTYPE (subtree
))
2661 case Lisp_Vectorlike
:
2664 int length
= XINT (Flength(subtree
));
2665 for (i
= 0; i
< length
; i
++)
2667 Lisp_Object idx
= make_number (i
);
2668 SUBSTITUTE (Faref (subtree
, idx
),
2669 Faset (subtree
, idx
, true_value
));
2676 SUBSTITUTE (Fcar_safe (subtree
),
2677 Fsetcar (subtree
, true_value
));
2678 SUBSTITUTE (Fcdr_safe (subtree
),
2679 Fsetcdr (subtree
, true_value
));
2685 /* Check for text properties in each interval.
2686 substitute_in_interval contains part of the logic. */
2688 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2689 Lisp_Object arg
= Fcons (object
, placeholder
);
2691 traverse_intervals_noorder (root_interval
,
2692 &substitute_in_interval
, arg
);
2697 /* Other types don't recurse any further. */
2703 /* Helper function for substitute_object_recurse. */
2705 substitute_in_interval (interval
, arg
)
2709 Lisp_Object object
= Fcar (arg
);
2710 Lisp_Object placeholder
= Fcdr (arg
);
2712 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2731 if (*cp
== '+' || *cp
== '-')
2734 if (*cp
>= '0' && *cp
<= '9')
2737 while (*cp
>= '0' && *cp
<= '9')
2745 if (*cp
>= '0' && *cp
<= '9')
2748 while (*cp
>= '0' && *cp
<= '9')
2751 if (*cp
== 'e' || *cp
== 'E')
2755 if (*cp
== '+' || *cp
== '-')
2759 if (*cp
>= '0' && *cp
<= '9')
2762 while (*cp
>= '0' && *cp
<= '9')
2765 else if (cp
== start
)
2767 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2772 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2778 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2779 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2780 || state
== (DOT_CHAR
|TRAIL_INT
)
2781 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2782 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2783 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2788 read_vector (readcharfun
, bytecodeflag
)
2789 Lisp_Object readcharfun
;
2794 register Lisp_Object
*ptr
;
2795 register Lisp_Object tem
, item
, vector
;
2796 register struct Lisp_Cons
*otem
;
2799 tem
= read_list (1, readcharfun
);
2800 len
= Flength (tem
);
2801 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2803 size
= XVECTOR (vector
)->size
;
2804 ptr
= XVECTOR (vector
)->contents
;
2805 for (i
= 0; i
< size
; i
++)
2808 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2809 bytecode object, the docstring containing the bytecode and
2810 constants values must be treated as unibyte and passed to
2811 Fread, to get the actual bytecode string and constants vector. */
2812 if (bytecodeflag
&& load_force_doc_strings
)
2814 if (i
== COMPILED_BYTECODE
)
2816 if (!STRINGP (item
))
2817 error ("invalid byte code");
2819 /* Delay handling the bytecode slot until we know whether
2820 it is lazily-loaded (we can tell by whether the
2821 constants slot is nil). */
2822 ptr
[COMPILED_CONSTANTS
] = item
;
2825 else if (i
== COMPILED_CONSTANTS
)
2827 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2831 /* Coerce string to unibyte (like string-as-unibyte,
2832 but without generating extra garbage and
2833 guaranteeing no change in the contents). */
2834 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2835 STRING_SET_UNIBYTE (bytestr
);
2837 item
= Fread (bytestr
);
2839 error ("invalid byte code");
2841 otem
= XCONS (item
);
2842 bytestr
= XCAR (item
);
2847 /* Now handle the bytecode slot. */
2848 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2851 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2859 /* FLAG = 1 means check for ] to terminate rather than ) and .
2860 FLAG = -1 means check for starting with defun
2861 and make structure pure. */
2864 read_list (flag
, readcharfun
)
2866 register Lisp_Object readcharfun
;
2868 /* -1 means check next element for defun,
2869 0 means don't check,
2870 1 means already checked and found defun. */
2871 int defunflag
= flag
< 0 ? -1 : 0;
2872 Lisp_Object val
, tail
;
2873 register Lisp_Object elt
, tem
;
2874 struct gcpro gcpro1
, gcpro2
;
2875 /* 0 is the normal case.
2876 1 means this list is a doc reference; replace it with the number 0.
2877 2 means this list is a doc reference; replace it with the doc string. */
2878 int doc_reference
= 0;
2880 /* Initialize this to 1 if we are reading a list. */
2881 int first_in_list
= flag
<= 0;
2890 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2895 /* While building, if the list starts with #$, treat it specially. */
2896 if (EQ (elt
, Vload_file_name
)
2898 && !NILP (Vpurify_flag
))
2900 if (NILP (Vdoc_file_name
))
2901 /* We have not yet called Snarf-documentation, so assume
2902 this file is described in the DOC-MM.NN file
2903 and Snarf-documentation will fill in the right value later.
2904 For now, replace the whole list with 0. */
2907 /* We have already called Snarf-documentation, so make a relative
2908 file name for this file, so it can be found properly
2909 in the installed Lisp directory.
2910 We don't use Fexpand_file_name because that would make
2911 the directory absolute now. */
2912 elt
= concat2 (build_string ("../lisp/"),
2913 Ffile_name_nondirectory (elt
));
2915 else if (EQ (elt
, Vload_file_name
)
2917 && load_force_doc_strings
)
2926 Fsignal (Qinvalid_read_syntax
,
2927 Fcons (make_string (") or . in a vector", 18), Qnil
));
2935 XSETCDR (tail
, read0 (readcharfun
));
2937 val
= read0 (readcharfun
);
2938 read1 (readcharfun
, &ch
, 0);
2942 if (doc_reference
== 1)
2943 return make_number (0);
2944 if (doc_reference
== 2)
2946 /* Get a doc string from the file we are loading.
2947 If it's in saved_doc_string, get it from there. */
2948 int pos
= XINT (XCDR (val
));
2949 /* Position is negative for user variables. */
2950 if (pos
< 0) pos
= -pos
;
2951 if (pos
>= saved_doc_string_position
2952 && pos
< (saved_doc_string_position
2953 + saved_doc_string_length
))
2955 int start
= pos
- saved_doc_string_position
;
2958 /* Process quoting with ^A,
2959 and find the end of the string,
2960 which is marked with ^_ (037). */
2961 for (from
= start
, to
= start
;
2962 saved_doc_string
[from
] != 037;)
2964 int c
= saved_doc_string
[from
++];
2967 c
= saved_doc_string
[from
++];
2969 saved_doc_string
[to
++] = c
;
2971 saved_doc_string
[to
++] = 0;
2973 saved_doc_string
[to
++] = 037;
2976 saved_doc_string
[to
++] = c
;
2979 return make_string (saved_doc_string
+ start
,
2982 /* Look in prev_saved_doc_string the same way. */
2983 else if (pos
>= prev_saved_doc_string_position
2984 && pos
< (prev_saved_doc_string_position
2985 + prev_saved_doc_string_length
))
2987 int start
= pos
- prev_saved_doc_string_position
;
2990 /* Process quoting with ^A,
2991 and find the end of the string,
2992 which is marked with ^_ (037). */
2993 for (from
= start
, to
= start
;
2994 prev_saved_doc_string
[from
] != 037;)
2996 int c
= prev_saved_doc_string
[from
++];
2999 c
= prev_saved_doc_string
[from
++];
3001 prev_saved_doc_string
[to
++] = c
;
3003 prev_saved_doc_string
[to
++] = 0;
3005 prev_saved_doc_string
[to
++] = 037;
3008 prev_saved_doc_string
[to
++] = c
;
3011 return make_string (prev_saved_doc_string
+ start
,
3015 return get_doc_string (val
, 0, 0);
3020 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3022 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3024 tem
= (read_pure
&& flag
<= 0
3025 ? pure_cons (elt
, Qnil
)
3026 : Fcons (elt
, Qnil
));
3028 XSETCDR (tail
, tem
);
3033 defunflag
= EQ (elt
, Qdefun
);
3034 else if (defunflag
> 0)
3039 Lisp_Object Vobarray
;
3040 Lisp_Object initial_obarray
;
3042 /* oblookup stores the bucket number here, for the sake of Funintern. */
3044 int oblookup_last_bucket_number
;
3046 static int hash_string ();
3048 /* Get an error if OBARRAY is not an obarray.
3049 If it is one, return it. */
3052 check_obarray (obarray
)
3053 Lisp_Object obarray
;
3055 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3057 /* If Vobarray is now invalid, force it to be valid. */
3058 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3060 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3065 /* Intern the C string STR: return a symbol with that name,
3066 interned in the current obarray. */
3073 int len
= strlen (str
);
3074 Lisp_Object obarray
;
3077 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3078 obarray
= check_obarray (obarray
);
3079 tem
= oblookup (obarray
, str
, len
, len
);
3082 return Fintern (make_string (str
, len
), obarray
);
3085 /* Create an uninterned symbol with name STR. */
3091 int len
= strlen (str
);
3093 return Fmake_symbol ((!NILP (Vpurify_flag
)
3094 ? make_pure_string (str
, len
, len
, 0)
3095 : make_string (str
, len
)));
3098 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3099 doc
: /* Return the canonical symbol whose name is STRING.
3100 If there is none, one is created by this function and returned.
3101 A second optional argument specifies the obarray to use;
3102 it defaults to the value of `obarray'. */)
3104 Lisp_Object string
, obarray
;
3106 register Lisp_Object tem
, sym
, *ptr
;
3108 if (NILP (obarray
)) obarray
= Vobarray
;
3109 obarray
= check_obarray (obarray
);
3111 CHECK_STRING (string
);
3113 tem
= oblookup (obarray
, SDATA (string
),
3116 if (!INTEGERP (tem
))
3119 if (!NILP (Vpurify_flag
))
3120 string
= Fpurecopy (string
);
3121 sym
= Fmake_symbol (string
);
3123 if (EQ (obarray
, initial_obarray
))
3124 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3126 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3128 if ((SREF (string
, 0) == ':')
3129 && EQ (obarray
, initial_obarray
))
3131 XSYMBOL (sym
)->constant
= 1;
3132 XSYMBOL (sym
)->value
= sym
;
3135 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3137 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3139 XSYMBOL (sym
)->next
= 0;
3144 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3145 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3146 NAME may be a string or a symbol. If it is a symbol, that exact
3147 symbol is searched for.
3148 A second optional argument specifies the obarray to use;
3149 it defaults to the value of `obarray'. */)
3151 Lisp_Object name
, obarray
;
3153 register Lisp_Object tem
, string
;
3155 if (NILP (obarray
)) obarray
= Vobarray
;
3156 obarray
= check_obarray (obarray
);
3158 if (!SYMBOLP (name
))
3160 CHECK_STRING (name
);
3164 string
= SYMBOL_NAME (name
);
3166 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3167 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3173 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3174 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3175 The value is t if a symbol was found and deleted, nil otherwise.
3176 NAME may be a string or a symbol. If it is a symbol, that symbol
3177 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3178 OBARRAY defaults to the value of the variable `obarray'. */)
3180 Lisp_Object name
, obarray
;
3182 register Lisp_Object string
, tem
;
3185 if (NILP (obarray
)) obarray
= Vobarray
;
3186 obarray
= check_obarray (obarray
);
3189 string
= SYMBOL_NAME (name
);
3192 CHECK_STRING (name
);
3196 tem
= oblookup (obarray
, SDATA (string
),
3201 /* If arg was a symbol, don't delete anything but that symbol itself. */
3202 if (SYMBOLP (name
) && !EQ (name
, tem
))
3205 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3206 XSYMBOL (tem
)->constant
= 0;
3207 XSYMBOL (tem
)->indirect_variable
= 0;
3209 hash
= oblookup_last_bucket_number
;
3211 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3213 if (XSYMBOL (tem
)->next
)
3214 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3216 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3220 Lisp_Object tail
, following
;
3222 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3223 XSYMBOL (tail
)->next
;
3226 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3227 if (EQ (following
, tem
))
3229 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3238 /* Return the symbol in OBARRAY whose names matches the string
3239 of SIZE characters (SIZE_BYTE bytes) at PTR.
3240 If there is no such symbol in OBARRAY, return nil.
3242 Also store the bucket number in oblookup_last_bucket_number. */
3245 oblookup (obarray
, ptr
, size
, size_byte
)
3246 Lisp_Object obarray
;
3247 register const char *ptr
;
3248 int size
, size_byte
;
3252 register Lisp_Object tail
;
3253 Lisp_Object bucket
, tem
;
3255 if (!VECTORP (obarray
)
3256 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3258 obarray
= check_obarray (obarray
);
3259 obsize
= XVECTOR (obarray
)->size
;
3261 /* This is sometimes needed in the middle of GC. */
3262 obsize
&= ~ARRAY_MARK_FLAG
;
3263 /* Combining next two lines breaks VMS C 2.3. */
3264 hash
= hash_string (ptr
, size_byte
);
3266 bucket
= XVECTOR (obarray
)->contents
[hash
];
3267 oblookup_last_bucket_number
= hash
;
3268 if (XFASTINT (bucket
) == 0)
3270 else if (!SYMBOLP (bucket
))
3271 error ("Bad data in guts of obarray"); /* Like CADR error message */
3273 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3275 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3276 && SCHARS (SYMBOL_NAME (tail
)) == size
3277 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3279 else if (XSYMBOL (tail
)->next
== 0)
3282 XSETINT (tem
, hash
);
3287 hash_string (ptr
, len
)
3288 const unsigned char *ptr
;
3291 register const unsigned char *p
= ptr
;
3292 register const unsigned char *end
= p
+ len
;
3293 register unsigned char c
;
3294 register int hash
= 0;
3299 if (c
>= 0140) c
-= 40;
3300 hash
= ((hash
<<3) + (hash
>>28) + c
);
3302 return hash
& 07777777777;
3306 map_obarray (obarray
, fn
, arg
)
3307 Lisp_Object obarray
;
3308 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3312 register Lisp_Object tail
;
3313 CHECK_VECTOR (obarray
);
3314 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3316 tail
= XVECTOR (obarray
)->contents
[i
];
3321 if (XSYMBOL (tail
)->next
== 0)
3323 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3329 mapatoms_1 (sym
, function
)
3330 Lisp_Object sym
, function
;
3332 call1 (function
, sym
);
3335 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3336 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3337 OBARRAY defaults to the value of `obarray'. */)
3339 Lisp_Object function
, obarray
;
3341 if (NILP (obarray
)) obarray
= Vobarray
;
3342 obarray
= check_obarray (obarray
);
3344 map_obarray (obarray
, mapatoms_1
, function
);
3348 #define OBARRAY_SIZE 1511
3353 Lisp_Object oblength
;
3357 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3359 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3360 Vobarray
= Fmake_vector (oblength
, make_number (0));
3361 initial_obarray
= Vobarray
;
3362 staticpro (&initial_obarray
);
3363 /* Intern nil in the obarray */
3364 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3365 XSYMBOL (Qnil
)->constant
= 1;
3367 /* These locals are to kludge around a pyramid compiler bug. */
3368 hash
= hash_string ("nil", 3);
3369 /* Separate statement here to avoid VAXC bug. */
3370 hash
%= OBARRAY_SIZE
;
3371 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3374 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3375 XSYMBOL (Qnil
)->function
= Qunbound
;
3376 XSYMBOL (Qunbound
)->value
= Qunbound
;
3377 XSYMBOL (Qunbound
)->function
= Qunbound
;
3380 XSYMBOL (Qnil
)->value
= Qnil
;
3381 XSYMBOL (Qnil
)->plist
= Qnil
;
3382 XSYMBOL (Qt
)->value
= Qt
;
3383 XSYMBOL (Qt
)->constant
= 1;
3385 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3388 Qvariable_documentation
= intern ("variable-documentation");
3389 staticpro (&Qvariable_documentation
);
3391 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3392 read_buffer
= (char *) xmalloc (read_buffer_size
);
3397 struct Lisp_Subr
*sname
;
3400 sym
= intern (sname
->symbol_name
);
3401 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3404 #ifdef NOTDEF /* use fset in subr.el now */
3406 defalias (sname
, string
)
3407 struct Lisp_Subr
*sname
;
3411 sym
= intern (string
);
3412 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3416 /* Define an "integer variable"; a symbol whose value is forwarded
3417 to a C variable of type int. Sample call: */
3418 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3420 defvar_int (namestring
, address
)
3424 Lisp_Object sym
, val
;
3425 sym
= intern (namestring
);
3426 val
= allocate_misc ();
3427 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3428 XINTFWD (val
)->intvar
= address
;
3429 SET_SYMBOL_VALUE (sym
, val
);
3432 /* Similar but define a variable whose value is t if address contains 1,
3433 nil if address contains 0 */
3435 defvar_bool (namestring
, address
)
3439 Lisp_Object sym
, val
;
3440 sym
= intern (namestring
);
3441 val
= allocate_misc ();
3442 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3443 XBOOLFWD (val
)->boolvar
= address
;
3444 SET_SYMBOL_VALUE (sym
, val
);
3445 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3448 /* Similar but define a variable whose value is the Lisp Object stored
3449 at address. Two versions: with and without gc-marking of the C
3450 variable. The nopro version is used when that variable will be
3451 gc-marked for some other reason, since marking the same slot twice
3452 can cause trouble with strings. */
3454 defvar_lisp_nopro (namestring
, address
)
3456 Lisp_Object
*address
;
3458 Lisp_Object sym
, val
;
3459 sym
= intern (namestring
);
3460 val
= allocate_misc ();
3461 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3462 XOBJFWD (val
)->objvar
= address
;
3463 SET_SYMBOL_VALUE (sym
, val
);
3467 defvar_lisp (namestring
, address
)
3469 Lisp_Object
*address
;
3471 defvar_lisp_nopro (namestring
, address
);
3472 staticpro (address
);
3475 /* Similar but define a variable whose value is the Lisp Object stored in
3476 the current buffer. address is the address of the slot in the buffer
3477 that is current now. */
3480 defvar_per_buffer (namestring
, address
, type
, doc
)
3482 Lisp_Object
*address
;
3486 Lisp_Object sym
, val
;
3488 extern struct buffer buffer_local_symbols
;
3490 sym
= intern (namestring
);
3491 val
= allocate_misc ();
3492 offset
= (char *)address
- (char *)current_buffer
;
3494 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3495 XBUFFER_OBJFWD (val
)->offset
= offset
;
3496 SET_SYMBOL_VALUE (sym
, val
);
3497 PER_BUFFER_SYMBOL (offset
) = sym
;
3498 PER_BUFFER_TYPE (offset
) = type
;
3500 if (PER_BUFFER_IDX (offset
) == 0)
3501 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3502 slot of buffer_local_flags */
3507 /* Similar but define a variable whose value is the Lisp Object stored
3508 at a particular offset in the current kboard object. */
3511 defvar_kboard (namestring
, offset
)
3515 Lisp_Object sym
, val
;
3516 sym
= intern (namestring
);
3517 val
= allocate_misc ();
3518 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3519 XKBOARD_OBJFWD (val
)->offset
= offset
;
3520 SET_SYMBOL_VALUE (sym
, val
);
3523 /* Record the value of load-path used at the start of dumping
3524 so we can see if the site changed it later during dumping. */
3525 static Lisp_Object dump_path
;
3531 int turn_off_warning
= 0;
3533 /* Compute the default load-path. */
3535 normal
= PATH_LOADSEARCH
;
3536 Vload_path
= decode_env_path (0, normal
);
3538 if (NILP (Vpurify_flag
))
3539 normal
= PATH_LOADSEARCH
;
3541 normal
= PATH_DUMPLOADSEARCH
;
3543 /* In a dumped Emacs, we normally have to reset the value of
3544 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3545 uses ../lisp, instead of the path of the installed elisp
3546 libraries. However, if it appears that Vload_path was changed
3547 from the default before dumping, don't override that value. */
3550 if (! NILP (Fequal (dump_path
, Vload_path
)))
3552 Vload_path
= decode_env_path (0, normal
);
3553 if (!NILP (Vinstallation_directory
))
3555 Lisp_Object tem
, tem1
, sitelisp
;
3557 /* Remove site-lisp dirs from path temporarily and store
3558 them in sitelisp, then conc them on at the end so
3559 they're always first in path. */
3563 tem
= Fcar (Vload_path
);
3564 tem1
= Fstring_match (build_string ("site-lisp"),
3568 Vload_path
= Fcdr (Vload_path
);
3569 sitelisp
= Fcons (tem
, sitelisp
);
3575 /* Add to the path the lisp subdir of the
3576 installation dir, if it exists. */
3577 tem
= Fexpand_file_name (build_string ("lisp"),
3578 Vinstallation_directory
);
3579 tem1
= Ffile_exists_p (tem
);
3582 if (NILP (Fmember (tem
, Vload_path
)))
3584 turn_off_warning
= 1;
3585 Vload_path
= Fcons (tem
, Vload_path
);
3589 /* That dir doesn't exist, so add the build-time
3590 Lisp dirs instead. */
3591 Vload_path
= nconc2 (Vload_path
, dump_path
);
3593 /* Add leim under the installation dir, if it exists. */
3594 tem
= Fexpand_file_name (build_string ("leim"),
3595 Vinstallation_directory
);
3596 tem1
= Ffile_exists_p (tem
);
3599 if (NILP (Fmember (tem
, Vload_path
)))
3600 Vload_path
= Fcons (tem
, Vload_path
);
3603 /* Add site-list under the installation dir, if it exists. */
3604 tem
= Fexpand_file_name (build_string ("site-lisp"),
3605 Vinstallation_directory
);
3606 tem1
= Ffile_exists_p (tem
);
3609 if (NILP (Fmember (tem
, Vload_path
)))
3610 Vload_path
= Fcons (tem
, Vload_path
);
3613 /* If Emacs was not built in the source directory,
3614 and it is run from where it was built, add to load-path
3615 the lisp, leim and site-lisp dirs under that directory. */
3617 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3621 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3622 Vinstallation_directory
);
3623 tem1
= Ffile_exists_p (tem
);
3625 /* Don't be fooled if they moved the entire source tree
3626 AFTER dumping Emacs. If the build directory is indeed
3627 different from the source dir, src/Makefile.in and
3628 src/Makefile will not be found together. */
3629 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3630 Vinstallation_directory
);
3631 tem2
= Ffile_exists_p (tem
);
3632 if (!NILP (tem1
) && NILP (tem2
))
3634 tem
= Fexpand_file_name (build_string ("lisp"),
3637 if (NILP (Fmember (tem
, Vload_path
)))
3638 Vload_path
= Fcons (tem
, Vload_path
);
3640 tem
= Fexpand_file_name (build_string ("leim"),
3643 if (NILP (Fmember (tem
, Vload_path
)))
3644 Vload_path
= Fcons (tem
, Vload_path
);
3646 tem
= Fexpand_file_name (build_string ("site-lisp"),
3649 if (NILP (Fmember (tem
, Vload_path
)))
3650 Vload_path
= Fcons (tem
, Vload_path
);
3653 if (!NILP (sitelisp
))
3654 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3660 /* NORMAL refers to the lisp dir in the source directory. */
3661 /* We used to add ../lisp at the front here, but
3662 that caused trouble because it was copied from dump_path
3663 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3664 It should be unnecessary. */
3665 Vload_path
= decode_env_path (0, normal
);
3666 dump_path
= Vload_path
;
3671 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3672 almost never correct, thereby causing a warning to be printed out that
3673 confuses users. Since PATH_LOADSEARCH is always overridden by the
3674 EMACSLOADPATH environment variable below, disable the warning on NT. */
3676 /* Warn if dirs in the *standard* path don't exist. */
3677 if (!turn_off_warning
)
3679 Lisp_Object path_tail
;
3681 for (path_tail
= Vload_path
;
3683 path_tail
= XCDR (path_tail
))
3685 Lisp_Object dirfile
;
3686 dirfile
= Fcar (path_tail
);
3687 if (STRINGP (dirfile
))
3689 dirfile
= Fdirectory_file_name (dirfile
);
3690 if (access (SDATA (dirfile
), 0) < 0)
3691 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3696 #endif /* WINDOWSNT */
3698 /* If the EMACSLOADPATH environment variable is set, use its value.
3699 This doesn't apply if we're dumping. */
3701 if (NILP (Vpurify_flag
)
3702 && egetenv ("EMACSLOADPATH"))
3704 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3708 load_in_progress
= 0;
3709 Vload_file_name
= Qnil
;
3711 load_descriptor_list
= Qnil
;
3713 Vstandard_input
= Qt
;
3714 Vloads_in_progress
= Qnil
;
3717 /* Print a warning, using format string FORMAT, that directory DIRNAME
3718 does not exist. Print it on stderr and put it in *Message*. */
3721 dir_warning (format
, dirname
)
3723 Lisp_Object dirname
;
3726 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3728 fprintf (stderr
, format
, SDATA (dirname
));
3729 sprintf (buffer
, format
, SDATA (dirname
));
3730 /* Don't log the warning before we've initialized!! */
3732 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3739 defsubr (&Sread_from_string
);
3741 defsubr (&Sintern_soft
);
3742 defsubr (&Sunintern
);
3744 defsubr (&Seval_buffer
);
3745 defsubr (&Seval_region
);
3746 defsubr (&Sread_char
);
3747 defsubr (&Sread_char_exclusive
);
3748 defsubr (&Sread_event
);
3749 defsubr (&Sget_file_char
);
3750 defsubr (&Smapatoms
);
3751 defsubr (&Slocate_file_internal
);
3753 DEFVAR_LISP ("obarray", &Vobarray
,
3754 doc
: /* Symbol table for use by `intern' and `read'.
3755 It is a vector whose length ought to be prime for best results.
3756 The vector's contents don't make sense if examined from Lisp programs;
3757 to find all the symbols in an obarray, use `mapatoms'. */);
3759 DEFVAR_LISP ("values", &Vvalues
,
3760 doc
: /* List of values of all expressions which were read, evaluated and printed.
3761 Order is reverse chronological. */);
3763 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3764 doc
: /* Stream for read to get input from.
3765 See documentation of `read' for possible values. */);
3766 Vstandard_input
= Qt
;
3768 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3769 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3771 If this variable is a buffer, then only forms read from that buffer
3772 will be added to `read-symbol-positions-list'.
3773 If this variable is t, then all read forms will be added.
3774 The effect of all other values other than nil are not currently
3775 defined, although they may be in the future.
3777 The positions are relative to the last call to `read' or
3778 `read-from-string'. It is probably a bad idea to set this variable at
3779 the toplevel; bind it instead. */);
3780 Vread_with_symbol_positions
= Qnil
;
3782 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3783 doc
: /* A list mapping read symbols to their positions.
3784 This variable is modified during calls to `read' or
3785 `read-from-string', but only when `read-with-symbol-positions' is
3788 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3789 CHAR-POSITION is an integer giving the offset of that occurrence of the
3790 symbol from the position where `read' or `read-from-string' started.
3792 Note that a symbol will appear multiple times in this list, if it was
3793 read multiple times. The list is in the same order as the symbols
3795 Vread_symbol_positions_list
= Qnil
;
3797 DEFVAR_LISP ("load-path", &Vload_path
,
3798 doc
: /* *List of directories to search for files to load.
3799 Each element is a string (directory name) or nil (try default directory).
3800 Initialized based on EMACSLOADPATH environment variable, if any,
3801 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3803 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3804 doc
: /* *List of suffixes to try for files to load.
3805 This list should not include the empty string. */);
3806 Vload_suffixes
= Fcons (build_string (".elc"),
3807 Fcons (build_string (".el"), Qnil
));
3808 /* We don't use empty_string because it's not initialized yet. */
3809 default_suffixes
= Fcons (build_string (""), Qnil
);
3810 staticpro (&default_suffixes
);
3812 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3813 doc
: /* Non-nil iff inside of `load'. */);
3815 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3816 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3817 Each element looks like (FILENAME FORMS...).
3818 When `load' is run and the file-name argument is FILENAME,
3819 the FORMS in the corresponding element are executed at the end of loading.
3821 FILENAME must match exactly! Normally FILENAME is the name of a library,
3822 with no directory specified, since that is how `load' is normally called.
3823 An error in FORMS does not undo the load,
3824 but does prevent execution of the rest of the FORMS.
3825 FILENAME can also be a symbol (a feature) and FORMS are then executed
3826 when the corresponding call to `provide' is made. */);
3827 Vafter_load_alist
= Qnil
;
3829 DEFVAR_LISP ("load-history", &Vload_history
,
3830 doc
: /* Alist mapping source file names to symbols and features.
3831 Each alist element is a list that starts with a file name,
3832 except for one element (optional) that starts with nil and describes
3833 definitions evaluated from buffers not visiting files.
3834 The remaining elements of each list are symbols defined as functions,
3835 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3836 `(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3837 An element `(t . SYMBOL)' precedes an entry that is just SYMBOL,
3838 and means that SYMBOL was an autoload before this file redefined it
3840 Vload_history
= Qnil
;
3842 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3843 doc
: /* Full name of file being loaded by `load'. */);
3844 Vload_file_name
= Qnil
;
3846 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
3847 doc
: /* File name, including directory, of user's initialization file.
3848 If the file loaded had extension `.elc' and there was a corresponding `.el'
3849 file, this variable contains the name of the .el file, suitable for use
3850 by functions like `custom-save-all' which edit the init file. */);
3851 Vuser_init_file
= Qnil
;
3853 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3854 doc
: /* Used for internal purposes by `load'. */);
3855 Vcurrent_load_list
= Qnil
;
3857 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3858 doc
: /* Function used by `load' and `eval-region' for reading expressions.
3859 The default is nil, which means use the function `read'. */);
3860 Vload_read_function
= Qnil
;
3862 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3863 doc
: /* Function called in `load' for loading an Emacs lisp source file.
3864 This function is for doing code conversion before reading the source file.
3865 If nil, loading is done without any code conversion.
3866 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3867 FULLNAME is the full name of FILE.
3868 See `load' for the meaning of the remaining arguments. */);
3869 Vload_source_file_function
= Qnil
;
3871 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3872 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
3873 This is useful when the file being loaded is a temporary copy. */);
3874 load_force_doc_strings
= 0;
3876 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3877 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
3878 This is normally bound by `load' and `eval-buffer' to control `read',
3879 and is not meant for users to change. */);
3880 load_convert_to_unibyte
= 0;
3882 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3883 doc
: /* Directory in which Emacs sources were found when Emacs was built.
3884 You cannot count on them to still be there! */);
3886 = Fexpand_file_name (build_string ("../"),
3887 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3889 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3890 doc
: /* List of files that were preloaded (when dumping Emacs). */);
3891 Vpreloaded_file_list
= Qnil
;
3893 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
3894 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3895 Vbyte_boolean_vars
= Qnil
;
3897 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
3898 doc
: /* Non-nil means load dangerous compiled Lisp files.
3899 Some versions of XEmacs use different byte codes than Emacs. These
3900 incompatible byte codes can make Emacs crash when it tries to execute
3902 load_dangerous_libraries
= 0;
3904 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
3905 doc
: /* Regular expression matching safe to load compiled Lisp files.
3906 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3907 from the file, and matches them against this regular expression.
3908 When the regular expression matches, the file is considered to be safe
3909 to load. See also `load-dangerous-libraries'. */);
3910 Vbytecomp_version_regexp
3911 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3913 /* Vsource_directory was initialized in init_lread. */
3915 load_descriptor_list
= Qnil
;
3916 staticpro (&load_descriptor_list
);
3918 Qcurrent_load_list
= intern ("current-load-list");
3919 staticpro (&Qcurrent_load_list
);
3921 Qstandard_input
= intern ("standard-input");
3922 staticpro (&Qstandard_input
);
3924 Qread_char
= intern ("read-char");
3925 staticpro (&Qread_char
);
3927 Qget_file_char
= intern ("get-file-char");
3928 staticpro (&Qget_file_char
);
3930 Qbackquote
= intern ("`");
3931 staticpro (&Qbackquote
);
3932 Qcomma
= intern (",");
3933 staticpro (&Qcomma
);
3934 Qcomma_at
= intern (",@");
3935 staticpro (&Qcomma_at
);
3936 Qcomma_dot
= intern (",.");
3937 staticpro (&Qcomma_dot
);
3939 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3940 staticpro (&Qinhibit_file_name_operation
);
3942 Qascii_character
= intern ("ascii-character");
3943 staticpro (&Qascii_character
);
3945 Qfunction
= intern ("function");
3946 staticpro (&Qfunction
);
3948 Qload
= intern ("load");
3951 Qload_file_name
= intern ("load-file-name");
3952 staticpro (&Qload_file_name
);
3954 staticpro (&dump_path
);
3956 staticpro (&read_objects
);
3957 read_objects
= Qnil
;
3958 staticpro (&seen_list
);
3960 Vloads_in_progress
= Qnil
;
3961 staticpro (&Vloads_in_progress
);