1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
26 #include <sys/types.h>
32 #include "intervals.h"
39 #include "termhooks.h"
43 #include <sys/inode.h>
48 #include <unistd.h> /* to get X_OK */
65 #endif /* HAVE_SETLOCALE */
75 #define file_offset off_t
76 #define file_tell ftello
78 #define file_offset long
79 #define file_tell ftell
86 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
87 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
88 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
89 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
90 Lisp_Object Qinhibit_file_name_operation
;
91 Lisp_Object Qeval_buffer_list
, Veval_buffer_list
;
93 extern Lisp_Object Qevent_symbol_element_mask
;
94 extern Lisp_Object Qfile_exists_p
;
96 /* non-zero iff inside `load' */
99 /* Directory in which the sources were found. */
100 Lisp_Object Vsource_directory
;
102 /* Search path and suffixes for files to be loaded. */
103 Lisp_Object Vload_path
, Vload_suffixes
, Vload_file_rep_suffixes
;
105 /* File name of user's init file. */
106 Lisp_Object Vuser_init_file
;
108 /* This is the user-visible association list that maps features to
109 lists of defs in their load files. */
110 Lisp_Object Vload_history
;
112 /* This is used to build the load history. */
113 Lisp_Object Vcurrent_load_list
;
115 /* List of files that were preloaded. */
116 Lisp_Object Vpreloaded_file_list
;
118 /* Name of file actually being read by `load'. */
119 Lisp_Object Vload_file_name
;
121 /* Function to use for reading, in `load' and friends. */
122 Lisp_Object Vload_read_function
;
124 /* The association list of objects read with the #n=object form.
125 Each member of the list has the form (n . object), and is used to
126 look up the object for the corresponding #n# construct.
127 It must be set to nil before all top-level calls to read0. */
128 Lisp_Object read_objects
;
130 /* Nonzero means load should forcibly load all dynamic doc strings. */
131 static int load_force_doc_strings
;
133 /* Nonzero means read should convert strings to unibyte. */
134 static int load_convert_to_unibyte
;
136 /* Function to use for loading an Emacs lisp source file (not
137 compiled) instead of readevalloop. */
138 Lisp_Object Vload_source_file_function
;
140 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
141 Lisp_Object Vbyte_boolean_vars
;
143 /* Whether or not to add a `read-positions' property to symbols
145 Lisp_Object Vread_with_symbol_positions
;
147 /* List of (SYMBOL . POSITION) accumulated so far. */
148 Lisp_Object Vread_symbol_positions_list
;
150 /* List of descriptors now open for Fload. */
151 static Lisp_Object load_descriptor_list
;
153 /* File for get_file_char to read from. Use by load. */
154 static FILE *instream
;
156 /* When nonzero, read conses in pure space */
157 static int read_pure
;
159 /* For use within read-from-string (this reader is non-reentrant!!) */
160 static int read_from_string_index
;
161 static int read_from_string_index_byte
;
162 static int read_from_string_limit
;
164 /* Number of bytes left to read in the buffer character
165 that `readchar' has already advanced over. */
166 static int readchar_backlog
;
167 /* Number of characters read in the current call to Fread or
168 Fread_from_string. */
169 static int readchar_count
;
171 /* This contains the last string skipped with #@. */
172 static char *saved_doc_string
;
173 /* Length of buffer allocated in saved_doc_string. */
174 static int saved_doc_string_size
;
175 /* Length of actual data in saved_doc_string. */
176 static int saved_doc_string_length
;
177 /* This is the file position that string came from. */
178 static file_offset saved_doc_string_position
;
180 /* This contains the previous string skipped with #@.
181 We copy it from saved_doc_string when a new string
182 is put in saved_doc_string. */
183 static char *prev_saved_doc_string
;
184 /* Length of buffer allocated in prev_saved_doc_string. */
185 static int prev_saved_doc_string_size
;
186 /* Length of actual data in prev_saved_doc_string. */
187 static int prev_saved_doc_string_length
;
188 /* This is the file position that string came from. */
189 static file_offset prev_saved_doc_string_position
;
191 /* Nonzero means inside a new-style backquote
192 with no surrounding parentheses.
193 Fread initializes this to zero, so we need not specbind it
194 or worry about what happens to it when there is an error. */
195 static int new_backquote_flag
;
197 /* A list of file names for files being loaded in Fload. Used to
198 check for recursive loads. */
200 static Lisp_Object Vloads_in_progress
;
202 /* Non-zero means load dangerous compiled Lisp files. */
204 int load_dangerous_libraries
;
206 /* A regular expression used to detect files compiled with Emacs. */
208 static Lisp_Object Vbytecomp_version_regexp
;
210 static void to_multibyte
P_ ((char **, char **, int *));
211 static void readevalloop
P_ ((Lisp_Object
, FILE*, Lisp_Object
,
212 Lisp_Object (*) (), int,
213 Lisp_Object
, Lisp_Object
,
214 Lisp_Object
, Lisp_Object
));
215 static Lisp_Object load_unwind
P_ ((Lisp_Object
));
216 static Lisp_Object load_descriptor_unwind
P_ ((Lisp_Object
));
219 /* Handle unreading and rereading of characters.
220 Write READCHAR to read a character,
221 UNREAD(c) to unread c to be read again.
223 The READCHAR and UNREAD macros are meant for reading/unreading a
224 byte code; they do not handle multibyte characters. The caller
225 should manage them if necessary.
227 [ Actually that seems to be a lie; READCHAR will definitely read
228 multibyte characters from buffer sources, at least. Is the
229 comment just out of date?
230 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
233 #define READCHAR readchar (readcharfun)
234 #define UNREAD(c) unreadchar (readcharfun, c)
237 readchar (readcharfun
)
238 Lisp_Object readcharfun
;
245 if (BUFFERP (readcharfun
))
247 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
249 int pt_byte
= BUF_PT_BYTE (inbuffer
);
250 int orig_pt_byte
= pt_byte
;
252 if (readchar_backlog
> 0)
253 /* We get the address of the byte just passed,
254 which is the last byte of the character.
255 The other bytes in this character are consecutive with it,
256 because the gap can't be in the middle of a character. */
257 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
258 - --readchar_backlog
);
260 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
263 readchar_backlog
= -1;
265 if (! NILP (inbuffer
->enable_multibyte_characters
))
267 /* Fetch the character code from the buffer. */
268 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
269 BUF_INC_POS (inbuffer
, pt_byte
);
270 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
274 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
277 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
281 if (MARKERP (readcharfun
))
283 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
285 int bytepos
= marker_byte_position (readcharfun
);
286 int orig_bytepos
= bytepos
;
288 if (readchar_backlog
> 0)
289 /* We get the address of the byte just passed,
290 which is the last byte of the character.
291 The other bytes in this character are consecutive with it,
292 because the gap can't be in the middle of a character. */
293 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
294 - --readchar_backlog
);
296 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
299 readchar_backlog
= -1;
301 if (! NILP (inbuffer
->enable_multibyte_characters
))
303 /* Fetch the character code from the buffer. */
304 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
305 BUF_INC_POS (inbuffer
, bytepos
);
306 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
310 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
314 XMARKER (readcharfun
)->bytepos
= bytepos
;
315 XMARKER (readcharfun
)->charpos
++;
320 if (EQ (readcharfun
, Qlambda
))
321 return read_bytecode_char (0);
323 if (EQ (readcharfun
, Qget_file_char
))
327 /* Interrupted reads have been observed while reading over the network */
328 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
338 if (STRINGP (readcharfun
))
340 if (read_from_string_index
>= read_from_string_limit
)
343 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
344 read_from_string_index
,
345 read_from_string_index_byte
);
350 tem
= call0 (readcharfun
);
357 /* Unread the character C in the way appropriate for the stream READCHARFUN.
358 If the stream is a user function, call it with the char as argument. */
361 unreadchar (readcharfun
, c
)
362 Lisp_Object readcharfun
;
367 /* Don't back up the pointer if we're unreading the end-of-input mark,
368 since readchar didn't advance it when we read it. */
370 else if (BUFFERP (readcharfun
))
372 struct buffer
*b
= XBUFFER (readcharfun
);
373 int bytepos
= BUF_PT_BYTE (b
);
375 if (readchar_backlog
>= 0)
380 if (! NILP (b
->enable_multibyte_characters
))
381 BUF_DEC_POS (b
, bytepos
);
385 BUF_PT_BYTE (b
) = bytepos
;
388 else if (MARKERP (readcharfun
))
390 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
391 int bytepos
= XMARKER (readcharfun
)->bytepos
;
393 if (readchar_backlog
>= 0)
397 XMARKER (readcharfun
)->charpos
--;
398 if (! NILP (b
->enable_multibyte_characters
))
399 BUF_DEC_POS (b
, bytepos
);
403 XMARKER (readcharfun
)->bytepos
= bytepos
;
406 else if (STRINGP (readcharfun
))
408 read_from_string_index
--;
409 read_from_string_index_byte
410 = string_char_to_byte (readcharfun
, read_from_string_index
);
412 else if (EQ (readcharfun
, Qlambda
))
413 read_bytecode_char (1);
414 else if (EQ (readcharfun
, Qget_file_char
))
415 ungetc (c
, instream
);
417 call1 (readcharfun
, make_number (c
));
420 static Lisp_Object read_internal_start
P_ ((Lisp_Object
, Lisp_Object
,
422 static Lisp_Object read0
P_ ((Lisp_Object
));
423 static Lisp_Object read1
P_ ((Lisp_Object
, int *, int));
425 static Lisp_Object read_list
P_ ((int, Lisp_Object
));
426 static Lisp_Object read_vector
P_ ((Lisp_Object
, int));
427 static int read_multibyte
P_ ((int, Lisp_Object
));
429 static Lisp_Object substitute_object_recurse
P_ ((Lisp_Object
, Lisp_Object
,
431 static void substitute_object_in_subtree
P_ ((Lisp_Object
,
433 static void substitute_in_interval
P_ ((INTERVAL
, Lisp_Object
));
436 /* Get a character from the tty. */
438 extern Lisp_Object read_char
P_ ((int, int, Lisp_Object
*, Lisp_Object
, int *));
440 /* Read input events until we get one that's acceptable for our purposes.
442 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
443 until we get a character we like, and then stuffed into
446 If ASCII_REQUIRED is non-zero, we check function key events to see
447 if the unmodified version of the symbol has a Qascii_character
448 property, and use that character, if present.
450 If ERROR_NONASCII is non-zero, we signal an error if the input we
451 get isn't an ASCII character with modifiers. If it's zero but
452 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
455 If INPUT_METHOD is nonzero, we invoke the current input method
456 if the character warrants that. */
459 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
461 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
463 volatile register Lisp_Object val
, delayed_switch_frame
;
465 #ifdef HAVE_WINDOW_SYSTEM
466 if (display_hourglass_p
)
470 delayed_switch_frame
= Qnil
;
472 /* Read until we get an acceptable event. */
475 val
= read_char (0, 0, 0, (input_method
? Qnil
: Qt
), 0);
476 while (INTEGERP (val
) && XINT (val
) == -2); /* wrong_kboard_jmpbuf */
481 /* switch-frame events are put off until after the next ASCII
482 character. This is better than signaling an error just because
483 the last characters were typed to a separate minibuffer frame,
484 for example. Eventually, some code which can deal with
485 switch-frame events will read it and process it. */
487 && EVENT_HAS_PARAMETERS (val
)
488 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
490 delayed_switch_frame
= val
;
496 /* Convert certain symbols to their ASCII equivalents. */
499 Lisp_Object tem
, tem1
;
500 tem
= Fget (val
, Qevent_symbol_element_mask
);
503 tem1
= Fget (Fcar (tem
), Qascii_character
);
504 /* Merge this symbol's modifier bits
505 with the ASCII equivalent of its basic code. */
507 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
511 /* If we don't have a character now, deal with it appropriately. */
516 Vunread_command_events
= Fcons (val
, Qnil
);
517 error ("Non-character input-event");
524 if (! NILP (delayed_switch_frame
))
525 unread_switch_frame
= delayed_switch_frame
;
529 #ifdef HAVE_WINDOW_SYSTEM
530 if (display_hourglass_p
)
539 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
540 doc
: /* Read a character from the command input (keyboard or macro).
541 It is returned as a number.
542 If the user generates an event which is not a character (i.e. a mouse
543 click or function key event), `read-char' signals an error. As an
544 exception, switch-frame events are put off until non-ASCII events can
546 If you want to read non-character events, or ignore them, call
547 `read-event' or `read-char-exclusive' instead.
549 If the optional argument PROMPT is non-nil, display that as a prompt.
550 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
551 input method is turned on in the current buffer, that input method
552 is used for reading a character. */)
553 (prompt
, inherit_input_method
)
554 Lisp_Object prompt
, inherit_input_method
;
557 message_with_string ("%s", prompt
, 0);
558 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method
));
561 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
562 doc
: /* Read an event object from the input stream.
563 If the optional argument PROMPT is non-nil, display that as a prompt.
564 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
565 input method is turned on in the current buffer, that input method
566 is used for reading a character. */)
567 (prompt
, inherit_input_method
)
568 Lisp_Object prompt
, inherit_input_method
;
571 message_with_string ("%s", prompt
, 0);
572 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method
));
575 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
576 doc
: /* Read a character from the command input (keyboard or macro).
577 It is returned as a number. Non-character events are ignored.
579 If the optional argument PROMPT is non-nil, display that as a prompt.
580 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
581 input method is turned on in the current buffer, that input method
582 is used for reading a character. */)
583 (prompt
, inherit_input_method
)
584 Lisp_Object prompt
, inherit_input_method
;
587 message_with_string ("%s", prompt
, 0);
588 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method
));
591 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
592 doc
: /* Don't use this yourself. */)
595 register Lisp_Object val
;
596 XSETINT (val
, getc (instream
));
602 /* Value is non-zero if the file asswociated with file descriptor FD
603 is a compiled Lisp file that's safe to load. Only files compiled
604 with Emacs are safe to load. Files compiled with XEmacs can lead
605 to a crash in Fbyte_code because of an incompatible change in the
616 /* Read the first few bytes from the file, and look for a line
617 specifying the byte compiler version used. */
618 nbytes
= emacs_read (fd
, buf
, sizeof buf
- 1);
623 /* Skip to the next newline, skipping over the initial `ELC'
624 with NUL bytes following it. */
625 for (i
= 0; i
< nbytes
&& buf
[i
] != '\n'; ++i
)
629 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp
,
634 lseek (fd
, 0, SEEK_SET
);
639 /* Callback for record_unwind_protect. Restore the old load list OLD,
640 after loading a file successfully. */
643 record_load_unwind (old
)
646 return Vloads_in_progress
= old
;
649 /* This handler function is used via internal_condition_case_1. */
652 load_error_handler (data
)
658 DEFUN ("get-load-suffixes", Fget_load_suffixes
, Sget_load_suffixes
, 0, 0, 0,
659 doc
: /* Return the suffixes that `load' should try if a suffix is \
661 This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
664 Lisp_Object lst
= Qnil
, suffixes
= Vload_suffixes
, suffix
, ext
;
665 while (CONSP (suffixes
))
667 Lisp_Object exts
= Vload_file_rep_suffixes
;
668 suffix
= XCAR (suffixes
);
669 suffixes
= XCDR (suffixes
);
674 lst
= Fcons (concat2 (suffix
, ext
), lst
);
677 return Fnreverse (lst
);
680 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
681 doc
: /* Execute a file of Lisp code named FILE.
682 First try FILE with `.elc' appended, then try with `.el',
683 then try FILE unmodified (the exact suffixes in the exact order are
684 determined by `load-suffixes'). Environment variable references in
685 FILE are replaced with their values by calling `substitute-in-file-name'.
686 This function searches the directories in `load-path'.
688 If optional second arg NOERROR is non-nil,
689 report no error if FILE doesn't exist.
690 Print messages at start and end of loading unless
691 optional third arg NOMESSAGE is non-nil.
692 If optional fourth arg NOSUFFIX is non-nil, don't try adding
693 suffixes `.elc' or `.el' to the specified name FILE.
694 If optional fifth arg MUST-SUFFIX is non-nil, insist on
695 the suffix `.elc' or `.el'; don't accept just FILE unless
696 it ends in one of those suffixes or includes a directory name.
698 If this function fails to find a file, it may look for different
699 representations of that file before trying another file.
700 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
701 to the file name. Emacs uses this feature mainly to find compressed
702 versions of files when Auto Compression mode is enabled.
704 The exact suffixes that this function tries out, in the exact order,
705 are given by the value of the variable `load-file-rep-suffixes' if
706 NOSUFFIX is non-nil and by the return value of the function
707 `get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and
708 MUST-SUFFIX are nil, this function first tries out the latter suffixes
711 Loading a file records its definitions, and its `provide' and
712 `require' calls, in an element of `load-history' whose
713 car is the file name loaded. See `load-history'.
715 Return t if the file exists and loads successfully. */)
716 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
717 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
719 register FILE *stream
;
720 register int fd
= -1;
721 int count
= SPECPDL_INDEX ();
723 struct gcpro gcpro1
, gcpro2
;
724 Lisp_Object found
, efound
;
725 /* 1 means we printed the ".el is newer" message. */
727 /* 1 means we are loading a compiled file. */
738 /* If file name is magic, call the handler. */
739 /* This shouldn't be necessary any more now that `openp' handles it right.
740 handler = Ffind_file_name_handler (file, Qload);
742 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
744 /* Do this after the handler to avoid
745 the need to gcpro noerror, nomessage and nosuffix.
746 (Below here, we care only whether they are nil or not.)
747 The presence of this call is the result of a historical accident:
748 it used to be in every file-operations and when it got removed
749 everywhere, it accidentally stayed here. Since then, enough people
750 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
751 that it seemed risky to remove. */
752 if (! NILP (noerror
))
754 file
= internal_condition_case_1 (Fsubstitute_in_file_name
, file
,
755 Qt
, load_error_handler
);
760 file
= Fsubstitute_in_file_name (file
);
763 /* Avoid weird lossage with null string as arg,
764 since it would try to load a directory as a Lisp file */
765 if (SCHARS (file
) > 0)
767 int size
= SBYTES (file
);
771 GCPRO2 (file
, found
);
773 if (! NILP (must_suffix
))
775 /* Don't insist on adding a suffix if FILE already ends with one. */
777 && !strcmp (SDATA (file
) + size
- 3, ".el"))
780 && !strcmp (SDATA (file
) + size
- 4, ".elc"))
782 /* Don't insist on adding a suffix
783 if the argument includes a directory name. */
784 else if (! NILP (Ffile_name_directory (file
)))
788 fd
= openp (Vload_path
, file
,
789 (!NILP (nosuffix
) ? Qnil
790 : !NILP (must_suffix
) ? Fget_load_suffixes ()
791 : Fappend (2, (tmp
[0] = Fget_load_suffixes (),
792 tmp
[1] = Vload_file_rep_suffixes
,
801 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
802 Fcons (file
, Qnil
)));
807 /* Tell startup.el whether or not we found the user's init file. */
808 if (EQ (Qt
, Vuser_init_file
))
809 Vuser_init_file
= found
;
811 /* If FD is -2, that means openp found a magic file. */
814 if (NILP (Fequal (found
, file
)))
815 /* If FOUND is a different file name from FILE,
816 find its handler even if we have already inhibited
817 the `load' operation on FILE. */
818 handler
= Ffind_file_name_handler (found
, Qt
);
820 handler
= Ffind_file_name_handler (found
, Qload
);
821 if (! NILP (handler
))
822 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
825 /* Check if we're stuck in a recursive load cycle.
827 2000-09-21: It's not possible to just check for the file loaded
828 being a member of Vloads_in_progress. This fails because of the
829 way the byte compiler currently works; `provide's are not
830 evaluted, see font-lock.el/jit-lock.el as an example. This
831 leads to a certain amount of ``normal'' recursion.
833 Also, just loading a file recursively is not always an error in
834 the general case; the second load may do something different. */
838 for (tem
= Vloads_in_progress
; CONSP (tem
); tem
= XCDR (tem
))
839 if (!NILP (Fequal (found
, XCAR (tem
))))
845 Fsignal (Qerror
, Fcons (build_string ("Recursive load"),
846 Fcons (found
, Vloads_in_progress
)));
848 record_unwind_protect (record_load_unwind
, Vloads_in_progress
);
849 Vloads_in_progress
= Fcons (found
, Vloads_in_progress
);
852 if (!bcmp (SDATA (found
) + SBYTES (found
) - 4,
854 /* Load .elc files directly, but not when they are
855 remote and have no handler! */
862 GCPRO2 (file
, found
);
864 if (!safe_to_load_p (fd
))
867 if (!load_dangerous_libraries
)
871 error ("File `%s' was not compiled in Emacs",
874 else if (!NILP (nomessage
))
875 message_with_string ("File `%s' not compiled in Emacs", found
, 1);
880 efound
= ENCODE_FILE (found
);
885 stat ((char *)SDATA (efound
), &s1
);
886 SSET (efound
, SBYTES (efound
) - 1, 0);
887 result
= stat ((char *)SDATA (efound
), &s2
);
888 SSET (efound
, SBYTES (efound
) - 1, 'c');
890 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
892 /* Make the progress messages mention that source is newer. */
895 /* If we won't print another message, mention this anyway. */
896 if (!NILP (nomessage
))
898 Lisp_Object msg_file
;
899 msg_file
= Fsubstring (found
, make_number (0), make_number (-1));
900 message_with_string ("Source file `%s' newer than byte-compiled file",
909 /* We are loading a source file (*.el). */
910 if (!NILP (Vload_source_file_function
))
916 val
= call4 (Vload_source_file_function
, found
, file
,
917 NILP (noerror
) ? Qnil
: Qt
,
918 NILP (nomessage
) ? Qnil
: Qt
);
919 return unbind_to (count
, val
);
923 GCPRO2 (file
, found
);
927 efound
= ENCODE_FILE (found
);
928 stream
= fopen ((char *) SDATA (efound
), fmode
);
929 #else /* not WINDOWSNT */
930 stream
= fdopen (fd
, fmode
);
931 #endif /* not WINDOWSNT */
935 error ("Failure to create stdio stream for %s", SDATA (file
));
938 if (! NILP (Vpurify_flag
))
939 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
941 if (NILP (nomessage
))
944 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
947 message_with_string ("Loading %s (source)...", file
, 1);
949 message_with_string ("Loading %s (compiled; note, source file is newer)...",
951 else /* The typical case; compiled file newer than source file. */
952 message_with_string ("Loading %s...", file
, 1);
955 record_unwind_protect (load_unwind
, make_save_value (stream
, 0));
956 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
957 specbind (Qload_file_name
, found
);
958 specbind (Qinhibit_file_name_operation
, Qnil
);
960 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
962 readevalloop (Qget_file_char
, stream
, (! NILP (Vpurify_flag
) ? file
: found
),
963 Feval
, 0, Qnil
, Qnil
, Qnil
, Qnil
);
964 unbind_to (count
, Qnil
);
966 /* Run any load-hooks for this file. */
967 temp
= Fassoc (file
, Vafter_load_alist
);
969 Fprogn (Fcdr (temp
));
972 if (saved_doc_string
)
973 free (saved_doc_string
);
974 saved_doc_string
= 0;
975 saved_doc_string_size
= 0;
977 if (prev_saved_doc_string
)
978 xfree (prev_saved_doc_string
);
979 prev_saved_doc_string
= 0;
980 prev_saved_doc_string_size
= 0;
982 if (!noninteractive
&& NILP (nomessage
))
985 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
988 message_with_string ("Loading %s (source)...done", file
, 1);
990 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
992 else /* The typical case; compiled file newer than source file. */
993 message_with_string ("Loading %s...done", file
, 1);
996 if (!NILP (Fequal (build_string ("obsolete"),
997 Ffile_name_nondirectory
998 (Fdirectory_file_name (Ffile_name_directory (found
))))))
999 message_with_string ("Package %s is obsolete", file
, 1);
1005 load_unwind (arg
) /* used as unwind-protect function in load */
1008 FILE *stream
= (FILE *) XSAVE_VALUE (arg
)->pointer
;
1011 if (--load_in_progress
< 0) load_in_progress
= 0;
1016 load_descriptor_unwind (oldlist
)
1017 Lisp_Object oldlist
;
1019 load_descriptor_list
= oldlist
;
1023 /* Close all descriptors in use for Floads.
1024 This is used when starting a subprocess. */
1031 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCDR (tail
))
1032 emacs_close (XFASTINT (XCAR (tail
)));
1037 complete_filename_p (pathname
)
1038 Lisp_Object pathname
;
1040 register const unsigned char *s
= SDATA (pathname
);
1041 return (IS_DIRECTORY_SEP (s
[0])
1042 || (SCHARS (pathname
) > 2
1043 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
1053 DEFUN ("locate-file-internal", Flocate_file_internal
, Slocate_file_internal
, 2, 4, 0,
1054 doc
: /* Search for FILENAME through PATH.
1055 Returns the file's name in absolute form, or nil if not found.
1056 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1057 file name when searching.
1058 If non-nil, PREDICATE is used instead of `file-readable-p'.
1059 PREDICATE can also be an integer to pass to the access(2) function,
1060 in which case file-name-handlers are ignored. */)
1061 (filename
, path
, suffixes
, predicate
)
1062 Lisp_Object filename
, path
, suffixes
, predicate
;
1065 int fd
= openp (path
, filename
, suffixes
, &file
, predicate
);
1066 if (NILP (predicate
) && fd
> 0)
1072 /* Search for a file whose name is STR, looking in directories
1073 in the Lisp list PATH, and trying suffixes from SUFFIX.
1074 On success, returns a file descriptor. On failure, returns -1.
1076 SUFFIXES is a list of strings containing possible suffixes.
1077 The empty suffix is automatically added iff the list is empty.
1079 PREDICATE non-nil means don't open the files,
1080 just look for one that satisfies the predicate. In this case,
1081 returns 1 on success. The predicate can be a lisp function or
1082 an integer to pass to `access' (in which case file-name-handlers
1085 If STOREPTR is nonzero, it points to a slot where the name of
1086 the file actually found should be stored as a Lisp string.
1087 nil is stored there on failure.
1089 If the file we find is remote, return -2
1090 but store the found remote file name in *STOREPTR. */
1093 openp (path
, str
, suffixes
, storeptr
, predicate
)
1094 Lisp_Object path
, str
;
1095 Lisp_Object suffixes
;
1096 Lisp_Object
*storeptr
;
1097 Lisp_Object predicate
;
1102 register char *fn
= buf
;
1105 Lisp_Object filename
;
1107 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
1108 Lisp_Object string
, tail
, encoded_fn
;
1109 int max_suffix_len
= 0;
1113 for (tail
= suffixes
; CONSP (tail
); tail
= XCDR (tail
))
1115 CHECK_STRING_CAR (tail
);
1116 max_suffix_len
= max (max_suffix_len
,
1117 SBYTES (XCAR (tail
)));
1120 string
= filename
= encoded_fn
= Qnil
;
1121 GCPRO6 (str
, string
, filename
, path
, suffixes
, encoded_fn
);
1126 if (complete_filename_p (str
))
1129 for (; CONSP (path
); path
= XCDR (path
))
1131 filename
= Fexpand_file_name (str
, XCAR (path
));
1132 if (!complete_filename_p (filename
))
1133 /* If there are non-absolute elts in PATH (eg ".") */
1134 /* Of course, this could conceivably lose if luser sets
1135 default-directory to be something non-absolute... */
1137 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
1138 if (!complete_filename_p (filename
))
1139 /* Give up on this path element! */
1143 /* Calculate maximum size of any filename made from
1144 this path element/specified file name and any possible suffix. */
1145 want_size
= max_suffix_len
+ SBYTES (filename
) + 1;
1146 if (fn_size
< want_size
)
1147 fn
= (char *) alloca (fn_size
= 100 + want_size
);
1149 /* Loop over suffixes. */
1150 for (tail
= NILP (suffixes
) ? Fcons (build_string (""), Qnil
) : suffixes
;
1151 CONSP (tail
); tail
= XCDR (tail
))
1153 int lsuffix
= SBYTES (XCAR (tail
));
1154 Lisp_Object handler
;
1157 /* Concatenate path element/specified name with the suffix.
1158 If the directory starts with /:, remove that. */
1159 if (SCHARS (filename
) > 2
1160 && SREF (filename
, 0) == '/'
1161 && SREF (filename
, 1) == ':')
1163 strncpy (fn
, SDATA (filename
) + 2,
1164 SBYTES (filename
) - 2);
1165 fn
[SBYTES (filename
) - 2] = 0;
1169 strncpy (fn
, SDATA (filename
),
1171 fn
[SBYTES (filename
)] = 0;
1174 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
1175 strncat (fn
, SDATA (XCAR (tail
)), lsuffix
);
1177 /* Check that the file exists and is not a directory. */
1178 /* We used to only check for handlers on non-absolute file names:
1182 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1183 It's not clear why that was the case and it breaks things like
1184 (load "/bar.el") where the file is actually "/bar.el.gz". */
1185 string
= build_string (fn
);
1186 handler
= Ffind_file_name_handler (string
, Qfile_exists_p
);
1187 if ((!NILP (handler
) || !NILP (predicate
)) && !NATNUMP (predicate
))
1189 if (NILP (predicate
))
1190 exists
= !NILP (Ffile_readable_p (string
));
1192 exists
= !NILP (call1 (predicate
, string
));
1193 if (exists
&& !NILP (Ffile_directory_p (string
)))
1198 /* We succeeded; return this descriptor and filename. */
1209 encoded_fn
= ENCODE_FILE (string
);
1210 pfn
= SDATA (encoded_fn
);
1211 exists
= (stat (pfn
, &st
) >= 0
1212 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
1215 /* Check that we can access or open it. */
1216 if (NATNUMP (predicate
))
1217 fd
= (access (pfn
, XFASTINT (predicate
)) == 0) ? 1 : -1;
1219 fd
= emacs_open (pfn
, O_RDONLY
, 0);
1223 /* We succeeded; return this descriptor and filename. */
1241 /* Merge the list we've accumulated of globals from the current input source
1242 into the load_history variable. The details depend on whether
1243 the source has an associated file name or not.
1245 FILENAME is the file name that we are loading from.
1246 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */
1249 build_load_history (filename
, entire
)
1250 Lisp_Object filename
;
1253 register Lisp_Object tail
, prev
, newelt
;
1254 register Lisp_Object tem
, tem2
;
1255 register int foundit
= 0;
1257 tail
= Vload_history
;
1260 while (CONSP (tail
))
1264 /* Find the feature's previous assoc list... */
1265 if (!NILP (Fequal (filename
, Fcar (tem
))))
1269 /* If we're loading the entire file, remove old data. */
1273 Vload_history
= XCDR (tail
);
1275 Fsetcdr (prev
, XCDR (tail
));
1278 /* Otherwise, cons on new symbols that are not already members. */
1281 tem2
= Vcurrent_load_list
;
1283 while (CONSP (tem2
))
1285 newelt
= XCAR (tem2
);
1287 if (NILP (Fmember (newelt
, tem
)))
1288 Fsetcar (tail
, Fcons (XCAR (tem
),
1289 Fcons (newelt
, XCDR (tem
))));
1302 /* If we're loading an entire file, cons the new assoc onto the
1303 front of load-history, the most-recently-loaded position. Also
1304 do this if we didn't find an existing member for the file. */
1305 if (entire
|| !foundit
)
1306 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1311 unreadpure (junk
) /* Used as unwind-protect function in readevalloop */
1319 readevalloop_1 (old
)
1322 load_convert_to_unibyte
= ! NILP (old
);
1326 /* Signal an `end-of-file' error, if possible with file name
1330 end_of_file_error ()
1334 if (STRINGP (Vload_file_name
))
1335 data
= Fcons (Vload_file_name
, Qnil
);
1339 Fsignal (Qend_of_file
, data
);
1342 /* UNIBYTE specifies how to set load_convert_to_unibyte
1343 for this invocation.
1344 READFUN, if non-nil, is used instead of `read'.
1345 START, END is region in current buffer (from eval-region). */
1348 readevalloop (readcharfun
, stream
, sourcename
, evalfun
,
1349 printflag
, unibyte
, readfun
, start
, end
)
1350 Lisp_Object readcharfun
;
1352 Lisp_Object sourcename
;
1353 Lisp_Object (*evalfun
) ();
1355 Lisp_Object unibyte
, readfun
;
1356 Lisp_Object start
, end
;
1359 register Lisp_Object val
;
1360 int count
= SPECPDL_INDEX ();
1361 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1362 struct buffer
*b
= 0;
1364 int continue_reading_p
;
1365 /* Nonzero if reading an entire buffer. */
1366 int whole_buffer
= 0;
1367 /* 1 on the first time around. */
1370 if (MARKERP (readcharfun
))
1373 start
= readcharfun
;
1376 if (BUFFERP (readcharfun
))
1377 b
= XBUFFER (readcharfun
);
1378 else if (MARKERP (readcharfun
))
1379 b
= XMARKER (readcharfun
)->buffer
;
1381 specbind (Qstandard_input
, readcharfun
); /* GCPROs readcharfun. */
1382 specbind (Qcurrent_load_list
, Qnil
);
1383 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1384 load_convert_to_unibyte
= !NILP (unibyte
);
1386 readchar_backlog
= -1;
1388 GCPRO4 (sourcename
, readfun
, start
, end
);
1390 LOADHIST_ATTACH (sourcename
);
1392 continue_reading_p
= 1;
1393 while (continue_reading_p
)
1395 int count1
= SPECPDL_INDEX ();
1397 if (b
!= 0 && NILP (b
->name
))
1398 error ("Reading from killed buffer");
1402 /* Switch to the buffer we are reading from. */
1403 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1404 set_buffer_internal (b
);
1406 /* Save point in it. */
1407 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1408 /* Save ZV in it. */
1409 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1410 /* Those get unbound after we read one expression. */
1412 /* Set point and ZV around stuff to be read. */
1415 Fnarrow_to_region (make_number (BEGV
), end
);
1417 /* Just for cleanliness, convert END to a marker
1418 if it is an integer. */
1420 end
= Fpoint_max_marker ();
1423 /* On the first cycle, we can easily test here
1424 whether we are reading the whole buffer. */
1425 if (b
&& first_sexp
)
1426 whole_buffer
= (PT
== BEG
&& ZV
== Z
);
1433 while ((c
= READCHAR
) != '\n' && c
!= -1);
1438 unbind_to (count1
, Qnil
);
1442 /* Ignore whitespace here, so we can detect eof. */
1443 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1446 if (!NILP (Vpurify_flag
) && c
== '(')
1448 record_unwind_protect (unreadpure
, Qnil
);
1449 val
= read_list (-1, readcharfun
);
1454 read_objects
= Qnil
;
1455 if (!NILP (readfun
))
1457 val
= call1 (readfun
, readcharfun
);
1459 /* If READCHARFUN has set point to ZV, we should
1460 stop reading, even if the form read sets point
1461 to a different value when evaluated. */
1462 if (BUFFERP (readcharfun
))
1464 struct buffer
*b
= XBUFFER (readcharfun
);
1465 if (BUF_PT (b
) == BUF_ZV (b
))
1466 continue_reading_p
= 0;
1469 else if (! NILP (Vload_read_function
))
1470 val
= call1 (Vload_read_function
, readcharfun
);
1472 val
= read_internal_start (readcharfun
, Qnil
, Qnil
);
1475 if (!NILP (start
) && continue_reading_p
)
1476 start
= Fpoint_marker ();
1478 /* Restore saved point and BEGV. */
1479 unbind_to (count1
, Qnil
);
1481 /* Now eval what we just read. */
1482 val
= (*evalfun
) (val
);
1486 Vvalues
= Fcons (val
, Vvalues
);
1487 if (EQ (Vstandard_output
, Qt
))
1496 build_load_history (sourcename
,
1497 stream
|| whole_buffer
);
1501 unbind_to (count
, Qnil
);
1504 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 5, "",
1505 doc
: /* Execute the current buffer as Lisp code.
1506 Programs can pass two arguments, BUFFER and PRINTFLAG.
1507 BUFFER is the buffer to evaluate (nil means use current buffer).
1508 PRINTFLAG controls printing of output:
1509 nil means discard it; anything else is stream for print.
1511 If the optional third argument FILENAME is non-nil,
1512 it specifies the file name to use for `load-history'.
1513 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1514 for this invocation.
1516 The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
1517 `print' and related functions should work normally even if PRINTFLAG is nil.
1519 This function preserves the position of point. */)
1520 (buffer
, printflag
, filename
, unibyte
, do_allow_print
)
1521 Lisp_Object buffer
, printflag
, filename
, unibyte
, do_allow_print
;
1523 int count
= SPECPDL_INDEX ();
1524 Lisp_Object tem
, buf
;
1527 buf
= Fcurrent_buffer ();
1529 buf
= Fget_buffer (buffer
);
1531 error ("No such buffer");
1533 if (NILP (printflag
) && NILP (do_allow_print
))
1538 if (NILP (filename
))
1539 filename
= XBUFFER (buf
)->filename
;
1541 specbind (Qeval_buffer_list
, Fcons (buf
, Veval_buffer_list
));
1542 specbind (Qstandard_output
, tem
);
1543 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1544 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1545 readevalloop (buf
, 0, filename
, Feval
,
1546 !NILP (printflag
), unibyte
, Qnil
, Qnil
, Qnil
);
1547 unbind_to (count
, Qnil
);
1552 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1553 doc
: /* Execute the region as Lisp code.
1554 When called from programs, expects two arguments,
1555 giving starting and ending indices in the current buffer
1556 of the text to be executed.
1557 Programs can pass third argument PRINTFLAG which controls output:
1558 nil means discard it; anything else is stream for printing it.
1559 Also the fourth argument READ-FUNCTION, if non-nil, is used
1560 instead of `read' to read each expression. It gets one argument
1561 which is the input stream for reading characters.
1563 This function does not move point. */)
1564 (start
, end
, printflag
, read_function
)
1565 Lisp_Object start
, end
, printflag
, read_function
;
1567 int count
= SPECPDL_INDEX ();
1568 Lisp_Object tem
, cbuf
;
1570 cbuf
= Fcurrent_buffer ();
1572 if (NILP (printflag
))
1576 specbind (Qstandard_output
, tem
);
1577 specbind (Qeval_buffer_list
, Fcons (cbuf
, Veval_buffer_list
));
1579 /* readevalloop calls functions which check the type of start and end. */
1580 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1581 !NILP (printflag
), Qnil
, read_function
,
1584 return unbind_to (count
, Qnil
);
1588 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1589 doc
: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1590 If STREAM is nil, use the value of `standard-input' (which see).
1591 STREAM or the value of `standard-input' may be:
1592 a buffer (read from point and advance it)
1593 a marker (read from where it points and advance it)
1594 a function (call it with no arguments for each character,
1595 call it with a char as argument to push a char back)
1596 a string (takes text from string, starting at the beginning)
1597 t (read text line using minibuffer and use it, or read from
1598 standard input in batch mode). */)
1603 stream
= Vstandard_input
;
1604 if (EQ (stream
, Qt
))
1605 stream
= Qread_char
;
1606 if (EQ (stream
, Qread_char
))
1607 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1609 return read_internal_start (stream
, Qnil
, Qnil
);
1612 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1613 doc
: /* Read one Lisp expression which is represented as text by STRING.
1614 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1615 START and END optionally delimit a substring of STRING from which to read;
1616 they default to 0 and (length STRING) respectively. */)
1617 (string
, start
, end
)
1618 Lisp_Object string
, start
, end
;
1621 CHECK_STRING (string
);
1622 /* read_internal_start sets read_from_string_index. */
1623 ret
= read_internal_start (string
, start
, end
);
1624 return Fcons (ret
, make_number (read_from_string_index
));
1627 /* Function to set up the global context we need in toplevel read
1630 read_internal_start (stream
, start
, end
)
1632 Lisp_Object start
; /* Only used when stream is a string. */
1633 Lisp_Object end
; /* Only used when stream is a string. */
1637 readchar_backlog
= -1;
1639 new_backquote_flag
= 0;
1640 read_objects
= Qnil
;
1641 if (EQ (Vread_with_symbol_positions
, Qt
)
1642 || EQ (Vread_with_symbol_positions
, stream
))
1643 Vread_symbol_positions_list
= Qnil
;
1645 if (STRINGP (stream
))
1647 int startval
, endval
;
1649 endval
= SCHARS (stream
);
1653 endval
= XINT (end
);
1654 if (endval
< 0 || endval
> SCHARS (stream
))
1655 args_out_of_range (stream
, end
);
1662 CHECK_NUMBER (start
);
1663 startval
= XINT (start
);
1664 if (startval
< 0 || startval
> endval
)
1665 args_out_of_range (stream
, start
);
1667 read_from_string_index
= startval
;
1668 read_from_string_index_byte
= string_char_to_byte (stream
, startval
);
1669 read_from_string_limit
= endval
;
1672 retval
= read0 (stream
);
1673 if (EQ (Vread_with_symbol_positions
, Qt
)
1674 || EQ (Vread_with_symbol_positions
, stream
))
1675 Vread_symbol_positions_list
= Fnreverse (Vread_symbol_positions_list
);
1679 /* Use this for recursive reads, in contexts where internal tokens
1684 Lisp_Object readcharfun
;
1686 register Lisp_Object val
;
1689 val
= read1 (readcharfun
, &c
, 0);
1691 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1698 static int read_buffer_size
;
1699 static char *read_buffer
;
1701 /* Read multibyte form and return it as a character. C is a first
1702 byte of multibyte form, and rest of them are read from
1706 read_multibyte (c
, readcharfun
)
1708 Lisp_Object readcharfun
;
1710 /* We need the actual character code of this multibyte
1712 unsigned char str
[MAX_MULTIBYTE_LENGTH
];
1720 while ((c
= READCHAR
) >= 0xA0
1721 && len
< MAX_MULTIBYTE_LENGTH
)
1727 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, len
, bytes
))
1728 return STRING_CHAR (str
, len
);
1729 /* The byte sequence is not valid as multibyte. Unread all bytes
1730 but the first one, and return the first byte. */
1736 /* Read a \-escape sequence, assuming we already read the `\'.
1737 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1738 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1739 Otherwise store 0 into *BYTEREP. */
1742 read_escape (readcharfun
, stringp
, byterep
)
1743 Lisp_Object readcharfun
;
1747 register int c
= READCHAR
;
1754 end_of_file_error ();
1784 error ("Invalid escape character syntax");
1787 c
= read_escape (readcharfun
, 0, byterep
);
1788 return c
| meta_modifier
;
1793 error ("Invalid escape character syntax");
1796 c
= read_escape (readcharfun
, 0, byterep
);
1797 return c
| shift_modifier
;
1802 error ("Invalid escape character syntax");
1805 c
= read_escape (readcharfun
, 0, byterep
);
1806 return c
| hyper_modifier
;
1811 error ("Invalid escape character syntax");
1814 c
= read_escape (readcharfun
, 0, byterep
);
1815 return c
| alt_modifier
;
1826 c
= read_escape (readcharfun
, 0, byterep
);
1827 return c
| super_modifier
;
1832 error ("Invalid escape character syntax");
1836 c
= read_escape (readcharfun
, 0, byterep
);
1837 if ((c
& ~CHAR_MODIFIER_MASK
) == '?')
1838 return 0177 | (c
& CHAR_MODIFIER_MASK
);
1839 else if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
1840 return c
| ctrl_modifier
;
1841 /* ASCII control chars are made from letters (both cases),
1842 as well as the non-letters within 0100...0137. */
1843 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1844 return (c
& (037 | ~0177));
1845 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1846 return (c
& (037 | ~0177));
1848 return c
| ctrl_modifier
;
1858 /* An octal escape, as in ANSI C. */
1860 register int i
= c
- '0';
1861 register int count
= 0;
1864 if ((c
= READCHAR
) >= '0' && c
<= '7')
1881 /* A hex escape, as in ANSI C. */
1887 if (c
>= '0' && c
<= '9')
1892 else if ((c
>= 'a' && c
<= 'f')
1893 || (c
>= 'A' && c
<= 'F'))
1896 if (c
>= 'a' && c
<= 'f')
1913 if (BASE_LEADING_CODE_P (c
))
1914 c
= read_multibyte (c
, readcharfun
);
1920 /* Read an integer in radix RADIX using READCHARFUN to read
1921 characters. RADIX must be in the interval [2..36]; if it isn't, a
1922 read error is signaled . Value is the integer read. Signals an
1923 error if encountering invalid read syntax or if RADIX is out of
1927 read_integer (readcharfun
, radix
)
1928 Lisp_Object readcharfun
;
1931 int ndigits
= 0, invalid_p
, c
, sign
= 0;
1932 EMACS_INT number
= 0;
1934 if (radix
< 2 || radix
> 36)
1938 number
= ndigits
= invalid_p
= 0;
1954 if (c
>= '0' && c
<= '9')
1956 else if (c
>= 'a' && c
<= 'z')
1957 digit
= c
- 'a' + 10;
1958 else if (c
>= 'A' && c
<= 'Z')
1959 digit
= c
- 'A' + 10;
1966 if (digit
< 0 || digit
>= radix
)
1969 number
= radix
* number
+ digit
;
1975 if (ndigits
== 0 || invalid_p
)
1978 sprintf (buf
, "integer, radix %d", radix
);
1979 Fsignal (Qinvalid_read_syntax
, Fcons (build_string (buf
), Qnil
));
1982 return make_number (sign
* number
);
1986 /* Convert unibyte text in read_buffer to multibyte.
1988 Initially, *P is a pointer after the end of the unibyte text, and
1989 the pointer *END points after the end of read_buffer.
1991 If read_buffer doesn't have enough room to hold the result
1992 of the conversion, reallocate it and adjust *P and *END.
1994 At the end, make *P point after the result of the conversion, and
1995 return in *NCHARS the number of characters in the converted
1999 to_multibyte (p
, end
, nchars
)
2005 parse_str_as_multibyte (read_buffer
, *p
- read_buffer
, &nbytes
, nchars
);
2006 if (read_buffer_size
< 2 * nbytes
)
2008 int offset
= *p
- read_buffer
;
2009 read_buffer_size
= 2 * max (read_buffer_size
, nbytes
);
2010 read_buffer
= (char *) xrealloc (read_buffer
, read_buffer_size
);
2011 *p
= read_buffer
+ offset
;
2012 *end
= read_buffer
+ read_buffer_size
;
2015 if (nbytes
!= *nchars
)
2016 nbytes
= str_as_multibyte (read_buffer
, read_buffer_size
,
2017 *p
- read_buffer
, nchars
);
2019 *p
= read_buffer
+ nbytes
;
2023 /* If the next token is ')' or ']' or '.', we store that character
2024 in *PCH and the return value is not interesting. Else, we store
2025 zero in *PCH and we read and return one lisp object.
2027 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2030 read1 (readcharfun
, pch
, first_in_list
)
2031 register Lisp_Object readcharfun
;
2036 int uninterned_symbol
= 0;
2044 end_of_file_error ();
2049 return read_list (0, readcharfun
);
2052 return read_vector (readcharfun
, 0);
2069 tmp
= read_vector (readcharfun
, 0);
2070 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
2071 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
2072 error ("Invalid size char-table");
2073 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2074 XCHAR_TABLE (tmp
)->top
= Qt
;
2083 tmp
= read_vector (readcharfun
, 0);
2084 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
2085 error ("Invalid size char-table");
2086 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
2087 XCHAR_TABLE (tmp
)->top
= Qnil
;
2090 Fsignal (Qinvalid_read_syntax
,
2091 Fcons (make_string ("#^^", 3), Qnil
));
2093 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
2098 length
= read1 (readcharfun
, pch
, first_in_list
);
2102 Lisp_Object tmp
, val
;
2104 = ((XFASTINT (length
) + BOOL_VECTOR_BITS_PER_CHAR
- 1)
2105 / BOOL_VECTOR_BITS_PER_CHAR
);
2108 tmp
= read1 (readcharfun
, pch
, first_in_list
);
2109 if (size_in_chars
!= SCHARS (tmp
)
2110 /* We used to print 1 char too many
2111 when the number of bits was a multiple of 8.
2112 Accept such input in case it came from an old version. */
2113 && ! (XFASTINT (length
)
2114 == (SCHARS (tmp
) - 1) * BOOL_VECTOR_BITS_PER_CHAR
))
2115 Fsignal (Qinvalid_read_syntax
,
2116 Fcons (make_string ("#&...", 5), Qnil
));
2118 val
= Fmake_bool_vector (length
, Qnil
);
2119 bcopy (SDATA (tmp
), XBOOL_VECTOR (val
)->data
,
2121 /* Clear the extraneous bits in the last byte. */
2122 if (XINT (length
) != size_in_chars
* BOOL_VECTOR_BITS_PER_CHAR
)
2123 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
2124 &= (1 << (XINT (length
) % BOOL_VECTOR_BITS_PER_CHAR
)) - 1;
2127 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
2132 /* Accept compiled functions at read-time so that we don't have to
2133 build them using function calls. */
2135 tmp
= read_vector (readcharfun
, 1);
2136 return Fmake_byte_code (XVECTOR (tmp
)->size
,
2137 XVECTOR (tmp
)->contents
);
2142 struct gcpro gcpro1
;
2145 /* Read the string itself. */
2146 tmp
= read1 (readcharfun
, &ch
, 0);
2147 if (ch
!= 0 || !STRINGP (tmp
))
2148 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2150 /* Read the intervals and their properties. */
2153 Lisp_Object beg
, end
, plist
;
2155 beg
= read1 (readcharfun
, &ch
, 0);
2160 end
= read1 (readcharfun
, &ch
, 0);
2162 plist
= read1 (readcharfun
, &ch
, 0);
2164 Fsignal (Qinvalid_read_syntax
,
2165 Fcons (build_string ("invalid string property list"),
2167 Fset_text_properties (beg
, end
, plist
, tmp
);
2173 /* #@NUMBER is used to skip NUMBER following characters.
2174 That's used in .elc files to skip over doc strings
2175 and function definitions. */
2180 /* Read a decimal integer. */
2181 while ((c
= READCHAR
) >= 0
2182 && c
>= '0' && c
<= '9')
2190 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
2192 /* If we are supposed to force doc strings into core right now,
2193 record the last string that we skipped,
2194 and record where in the file it comes from. */
2196 /* But first exchange saved_doc_string
2197 with prev_saved_doc_string, so we save two strings. */
2199 char *temp
= saved_doc_string
;
2200 int temp_size
= saved_doc_string_size
;
2201 file_offset temp_pos
= saved_doc_string_position
;
2202 int temp_len
= saved_doc_string_length
;
2204 saved_doc_string
= prev_saved_doc_string
;
2205 saved_doc_string_size
= prev_saved_doc_string_size
;
2206 saved_doc_string_position
= prev_saved_doc_string_position
;
2207 saved_doc_string_length
= prev_saved_doc_string_length
;
2209 prev_saved_doc_string
= temp
;
2210 prev_saved_doc_string_size
= temp_size
;
2211 prev_saved_doc_string_position
= temp_pos
;
2212 prev_saved_doc_string_length
= temp_len
;
2215 if (saved_doc_string_size
== 0)
2217 saved_doc_string_size
= nskip
+ 100;
2218 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
2220 if (nskip
> saved_doc_string_size
)
2222 saved_doc_string_size
= nskip
+ 100;
2223 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
2224 saved_doc_string_size
);
2227 saved_doc_string_position
= file_tell (instream
);
2229 /* Copy that many characters into saved_doc_string. */
2230 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2231 saved_doc_string
[i
] = c
= READCHAR
;
2233 saved_doc_string_length
= i
;
2237 /* Skip that many characters. */
2238 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
2246 /* #! appears at the beginning of an executable file.
2247 Skip the first line. */
2248 while (c
!= '\n' && c
>= 0)
2253 return Vload_file_name
;
2255 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
2256 /* #:foo is the uninterned symbol named foo. */
2259 uninterned_symbol
= 1;
2263 /* Reader forms that can reuse previously read objects. */
2264 if (c
>= '0' && c
<= '9')
2269 /* Read a non-negative integer. */
2270 while (c
>= '0' && c
<= '9')
2276 /* #n=object returns object, but associates it with n for #n#. */
2279 /* Make a placeholder for #n# to use temporarily */
2280 Lisp_Object placeholder
;
2283 placeholder
= Fcons(Qnil
, Qnil
);
2284 cell
= Fcons (make_number (n
), placeholder
);
2285 read_objects
= Fcons (cell
, read_objects
);
2287 /* Read the object itself. */
2288 tem
= read0 (readcharfun
);
2290 /* Now put it everywhere the placeholder was... */
2291 substitute_object_in_subtree (tem
, placeholder
);
2293 /* ...and #n# will use the real value from now on. */
2294 Fsetcdr (cell
, tem
);
2298 /* #n# returns a previously read object. */
2301 tem
= Fassq (make_number (n
), read_objects
);
2304 /* Fall through to error message. */
2306 else if (c
== 'r' || c
== 'R')
2307 return read_integer (readcharfun
, n
);
2309 /* Fall through to error message. */
2311 else if (c
== 'x' || c
== 'X')
2312 return read_integer (readcharfun
, 16);
2313 else if (c
== 'o' || c
== 'O')
2314 return read_integer (readcharfun
, 8);
2315 else if (c
== 'b' || c
== 'B')
2316 return read_integer (readcharfun
, 2);
2319 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
2322 while ((c
= READCHAR
) >= 0 && c
!= '\n');
2327 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
2337 new_backquote_flag
++;
2338 value
= read0 (readcharfun
);
2339 new_backquote_flag
--;
2341 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
2345 if (new_backquote_flag
)
2347 Lisp_Object comma_type
= Qnil
;
2352 comma_type
= Qcomma_at
;
2354 comma_type
= Qcomma_dot
;
2357 if (ch
>= 0) UNREAD (ch
);
2358 comma_type
= Qcomma
;
2361 new_backquote_flag
--;
2362 value
= read0 (readcharfun
);
2363 new_backquote_flag
++;
2364 return Fcons (comma_type
, Fcons (value
, Qnil
));
2377 end_of_file_error ();
2379 /* Accept `single space' syntax like (list ? x) where the
2380 whitespace character is SPC or TAB.
2381 Other literal whitespace like NL, CR, and FF are not accepted,
2382 as there are well-established escape sequences for these. */
2383 if (c
== ' ' || c
== '\t')
2384 return make_number (c
);
2387 c
= read_escape (readcharfun
, 0, &discard
);
2388 else if (BASE_LEADING_CODE_P (c
))
2389 c
= read_multibyte (c
, readcharfun
);
2391 next_char
= READCHAR
;
2392 if (next_char
== '.')
2394 /* Only a dotted-pair dot is valid after a char constant. */
2395 int next_next_char
= READCHAR
;
2396 UNREAD (next_next_char
);
2398 ok
= (next_next_char
<= 040
2399 || (next_next_char
< 0200
2400 && (index ("\"';([#?", next_next_char
)
2401 || (!first_in_list
&& next_next_char
== '`')
2402 || (new_backquote_flag
&& next_next_char
== ','))));
2406 ok
= (next_char
<= 040
2407 || (next_char
< 0200
2408 && (index ("\"';()[]#?", next_char
)
2409 || (!first_in_list
&& next_char
== '`')
2410 || (new_backquote_flag
&& next_char
== ','))));
2414 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("?", 1), Qnil
));
2416 return make_number (c
);
2421 char *p
= read_buffer
;
2422 char *end
= read_buffer
+ read_buffer_size
;
2424 /* 1 if we saw an escape sequence specifying
2425 a multibyte character, or a multibyte character. */
2426 int force_multibyte
= 0;
2427 /* 1 if we saw an escape sequence specifying
2428 a single-byte character. */
2429 int force_singlebyte
= 0;
2430 /* 1 if read_buffer contains multibyte text now. */
2431 int is_multibyte
= 0;
2435 while ((c
= READCHAR
) >= 0
2438 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2440 int offset
= p
- read_buffer
;
2441 read_buffer
= (char *) xrealloc (read_buffer
,
2442 read_buffer_size
*= 2);
2443 p
= read_buffer
+ offset
;
2444 end
= read_buffer
+ read_buffer_size
;
2451 c
= read_escape (readcharfun
, 1, &byterep
);
2453 /* C is -1 if \ newline has just been seen */
2456 if (p
== read_buffer
)
2462 force_singlebyte
= 1;
2463 else if (byterep
== 2)
2464 force_multibyte
= 1;
2467 /* A character that must be multibyte forces multibyte. */
2468 if (! SINGLE_BYTE_CHAR_P (c
& ~CHAR_MODIFIER_MASK
))
2469 force_multibyte
= 1;
2471 /* If we just discovered the need to be multibyte,
2472 convert the text accumulated thus far. */
2473 if (force_multibyte
&& ! is_multibyte
)
2476 to_multibyte (&p
, &end
, &nchars
);
2479 /* Allow `\C- ' and `\C-?'. */
2480 if (c
== (CHAR_CTL
| ' '))
2482 else if (c
== (CHAR_CTL
| '?'))
2487 /* Shift modifier is valid only with [A-Za-z]. */
2488 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
2490 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
2491 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
2495 /* Move the meta bit to the right place for a string. */
2496 c
= (c
& ~CHAR_META
) | 0x80;
2497 if (c
& CHAR_MODIFIER_MASK
)
2498 error ("Invalid modifier in string");
2501 p
+= CHAR_STRING (c
, p
);
2509 end_of_file_error ();
2511 /* If purifying, and string starts with \ newline,
2512 return zero instead. This is for doc strings
2513 that we are really going to find in etc/DOC.nn.nn */
2514 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
2515 return make_number (0);
2517 if (is_multibyte
|| force_singlebyte
)
2519 else if (load_convert_to_unibyte
)
2522 to_multibyte (&p
, &end
, &nchars
);
2523 if (p
- read_buffer
!= nchars
)
2525 string
= make_multibyte_string (read_buffer
, nchars
,
2527 return Fstring_make_unibyte (string
);
2529 /* We can make a unibyte string directly. */
2532 else if (EQ (readcharfun
, Qget_file_char
)
2533 || EQ (readcharfun
, Qlambda
))
2535 /* Nowadays, reading directly from a file is used only for
2536 compiled Emacs Lisp files, and those always use the
2537 Emacs internal encoding. Meanwhile, Qlambda is used
2538 for reading dynamic byte code (compiled with
2539 byte-compile-dynamic = t). So make the string multibyte
2540 if the string contains any multibyte sequences.
2541 (to_multibyte is a no-op if not.) */
2542 to_multibyte (&p
, &end
, &nchars
);
2543 is_multibyte
= (p
- read_buffer
) != nchars
;
2546 /* In all other cases, if we read these bytes as
2547 separate characters, treat them as separate characters now. */
2550 /* We want readchar_count to be the number of characters, not
2551 bytes. Hence we adjust for multibyte characters in the
2552 string. ... But it doesn't seem to be necessary, because
2553 READCHAR *does* read multibyte characters from buffers. */
2554 /* readchar_count -= (p - read_buffer) - nchars; */
2556 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
2558 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
2564 int next_char
= READCHAR
;
2567 if (next_char
<= 040
2568 || (next_char
< 0200
2569 && (index ("\"';([#?", next_char
)
2570 || (!first_in_list
&& next_char
== '`')
2571 || (new_backquote_flag
&& next_char
== ','))))
2577 /* Otherwise, we fall through! Note that the atom-reading loop
2578 below will now loop at least once, assuring that we will not
2579 try to UNREAD two characters in a row. */
2583 if (c
<= 040) goto retry
;
2585 char *p
= read_buffer
;
2589 char *end
= read_buffer
+ read_buffer_size
;
2593 || (!index ("\"';()[]#", c
)
2594 && !(!first_in_list
&& c
== '`')
2595 && !(new_backquote_flag
&& c
== ','))))
2597 if (end
- p
< MAX_MULTIBYTE_LENGTH
)
2599 int offset
= p
- read_buffer
;
2600 read_buffer
= (char *) xrealloc (read_buffer
,
2601 read_buffer_size
*= 2);
2602 p
= read_buffer
+ offset
;
2603 end
= read_buffer
+ read_buffer_size
;
2610 end_of_file_error ();
2614 if (! SINGLE_BYTE_CHAR_P (c
))
2615 p
+= CHAR_STRING (c
, p
);
2624 int offset
= p
- read_buffer
;
2625 read_buffer
= (char *) xrealloc (read_buffer
,
2626 read_buffer_size
*= 2);
2627 p
= read_buffer
+ offset
;
2628 end
= read_buffer
+ read_buffer_size
;
2635 if (!quoted
&& !uninterned_symbol
)
2638 register Lisp_Object val
;
2640 if (*p1
== '+' || *p1
== '-') p1
++;
2641 /* Is it an integer? */
2644 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2645 /* Integers can have trailing decimal points. */
2646 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2648 /* It is an integer. */
2652 if (sizeof (int) == sizeof (EMACS_INT
))
2653 XSETINT (val
, atoi (read_buffer
));
2654 else if (sizeof (long) == sizeof (EMACS_INT
))
2655 XSETINT (val
, atol (read_buffer
));
2661 if (isfloat_string (read_buffer
))
2663 /* Compute NaN and infinities using 0.0 in a variable,
2664 to cope with compilers that think they are smarter
2670 /* Negate the value ourselves. This treats 0, NaNs,
2671 and infinity properly on IEEE floating point hosts,
2672 and works around a common bug where atof ("-0.0")
2674 int negative
= read_buffer
[0] == '-';
2676 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2677 returns 1, is if the input ends in e+INF or e+NaN. */
2684 value
= zero
/ zero
;
2686 /* If that made a "negative" NaN, negate it. */
2690 union { double d
; char c
[sizeof (double)]; } u_data
, u_minus_zero
;
2693 u_minus_zero
.d
= - 0.0;
2694 for (i
= 0; i
< sizeof (double); i
++)
2695 if (u_data
.c
[i
] & u_minus_zero
.c
[i
])
2701 /* Now VALUE is a positive NaN. */
2704 value
= atof (read_buffer
+ negative
);
2708 return make_float (negative
? - value
: value
);
2712 Lisp_Object result
= uninterned_symbol
? make_symbol (read_buffer
)
2713 : intern (read_buffer
);
2714 if (EQ (Vread_with_symbol_positions
, Qt
)
2715 || EQ (Vread_with_symbol_positions
, readcharfun
))
2716 Vread_symbol_positions_list
=
2717 /* Kind of a hack; this will probably fail if characters
2718 in the symbol name were escaped. Not really a big
2720 Fcons (Fcons (result
,
2721 make_number (readchar_count
2722 - XFASTINT (Flength (Fsymbol_name (result
))))),
2723 Vread_symbol_positions_list
);
2731 /* List of nodes we've seen during substitute_object_in_subtree. */
2732 static Lisp_Object seen_list
;
2735 substitute_object_in_subtree (object
, placeholder
)
2737 Lisp_Object placeholder
;
2739 Lisp_Object check_object
;
2741 /* We haven't seen any objects when we start. */
2744 /* Make all the substitutions. */
2746 = substitute_object_recurse (object
, placeholder
, object
);
2748 /* Clear seen_list because we're done with it. */
2751 /* The returned object here is expected to always eq the
2753 if (!EQ (check_object
, object
))
2754 error ("Unexpected mutation error in reader");
2757 /* Feval doesn't get called from here, so no gc protection is needed. */
2758 #define SUBSTITUTE(get_val, set_val) \
2760 Lisp_Object old_value = get_val; \
2761 Lisp_Object true_value \
2762 = substitute_object_recurse (object, placeholder,\
2765 if (!EQ (old_value, true_value)) \
2772 substitute_object_recurse (object
, placeholder
, subtree
)
2774 Lisp_Object placeholder
;
2775 Lisp_Object subtree
;
2777 /* If we find the placeholder, return the target object. */
2778 if (EQ (placeholder
, subtree
))
2781 /* If we've been to this node before, don't explore it again. */
2782 if (!EQ (Qnil
, Fmemq (subtree
, seen_list
)))
2785 /* If this node can be the entry point to a cycle, remember that
2786 we've seen it. It can only be such an entry point if it was made
2787 by #n=, which means that we can find it as a value in
2789 if (!EQ (Qnil
, Frassq (subtree
, read_objects
)))
2790 seen_list
= Fcons (subtree
, seen_list
);
2792 /* Recurse according to subtree's type.
2793 Every branch must return a Lisp_Object. */
2794 switch (XTYPE (subtree
))
2796 case Lisp_Vectorlike
:
2799 int length
= XINT (Flength(subtree
));
2800 for (i
= 0; i
< length
; i
++)
2802 Lisp_Object idx
= make_number (i
);
2803 SUBSTITUTE (Faref (subtree
, idx
),
2804 Faset (subtree
, idx
, true_value
));
2811 SUBSTITUTE (Fcar_safe (subtree
),
2812 Fsetcar (subtree
, true_value
));
2813 SUBSTITUTE (Fcdr_safe (subtree
),
2814 Fsetcdr (subtree
, true_value
));
2820 /* Check for text properties in each interval.
2821 substitute_in_interval contains part of the logic. */
2823 INTERVAL root_interval
= STRING_INTERVALS (subtree
);
2824 Lisp_Object arg
= Fcons (object
, placeholder
);
2826 traverse_intervals_noorder (root_interval
,
2827 &substitute_in_interval
, arg
);
2832 /* Other types don't recurse any further. */
2838 /* Helper function for substitute_object_recurse. */
2840 substitute_in_interval (interval
, arg
)
2844 Lisp_Object object
= Fcar (arg
);
2845 Lisp_Object placeholder
= Fcdr (arg
);
2847 SUBSTITUTE(interval
->plist
, interval
->plist
= true_value
);
2866 if (*cp
== '+' || *cp
== '-')
2869 if (*cp
>= '0' && *cp
<= '9')
2872 while (*cp
>= '0' && *cp
<= '9')
2880 if (*cp
>= '0' && *cp
<= '9')
2883 while (*cp
>= '0' && *cp
<= '9')
2886 if (*cp
== 'e' || *cp
== 'E')
2890 if (*cp
== '+' || *cp
== '-')
2894 if (*cp
>= '0' && *cp
<= '9')
2897 while (*cp
>= '0' && *cp
<= '9')
2900 else if (cp
== start
)
2902 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2907 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2913 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2914 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2915 || state
== (DOT_CHAR
|TRAIL_INT
)
2916 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2917 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2918 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2923 read_vector (readcharfun
, bytecodeflag
)
2924 Lisp_Object readcharfun
;
2929 register Lisp_Object
*ptr
;
2930 register Lisp_Object tem
, item
, vector
;
2931 register struct Lisp_Cons
*otem
;
2934 tem
= read_list (1, readcharfun
);
2935 len
= Flength (tem
);
2936 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2938 size
= XVECTOR (vector
)->size
;
2939 ptr
= XVECTOR (vector
)->contents
;
2940 for (i
= 0; i
< size
; i
++)
2943 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2944 bytecode object, the docstring containing the bytecode and
2945 constants values must be treated as unibyte and passed to
2946 Fread, to get the actual bytecode string and constants vector. */
2947 if (bytecodeflag
&& load_force_doc_strings
)
2949 if (i
== COMPILED_BYTECODE
)
2951 if (!STRINGP (item
))
2952 error ("Invalid byte code");
2954 /* Delay handling the bytecode slot until we know whether
2955 it is lazily-loaded (we can tell by whether the
2956 constants slot is nil). */
2957 ptr
[COMPILED_CONSTANTS
] = item
;
2960 else if (i
== COMPILED_CONSTANTS
)
2962 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2966 /* Coerce string to unibyte (like string-as-unibyte,
2967 but without generating extra garbage and
2968 guaranteeing no change in the contents). */
2969 STRING_SET_CHARS (bytestr
, SBYTES (bytestr
));
2970 STRING_SET_UNIBYTE (bytestr
);
2972 item
= Fread (bytestr
);
2974 error ("Invalid byte code");
2976 otem
= XCONS (item
);
2977 bytestr
= XCAR (item
);
2982 /* Now handle the bytecode slot. */
2983 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2986 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2994 /* FLAG = 1 means check for ] to terminate rather than ) and .
2995 FLAG = -1 means check for starting with defun
2996 and make structure pure. */
2999 read_list (flag
, readcharfun
)
3001 register Lisp_Object readcharfun
;
3003 /* -1 means check next element for defun,
3004 0 means don't check,
3005 1 means already checked and found defun. */
3006 int defunflag
= flag
< 0 ? -1 : 0;
3007 Lisp_Object val
, tail
;
3008 register Lisp_Object elt
, tem
;
3009 struct gcpro gcpro1
, gcpro2
;
3010 /* 0 is the normal case.
3011 1 means this list is a doc reference; replace it with the number 0.
3012 2 means this list is a doc reference; replace it with the doc string. */
3013 int doc_reference
= 0;
3015 /* Initialize this to 1 if we are reading a list. */
3016 int first_in_list
= flag
<= 0;
3025 elt
= read1 (readcharfun
, &ch
, first_in_list
);
3030 /* While building, if the list starts with #$, treat it specially. */
3031 if (EQ (elt
, Vload_file_name
)
3033 && !NILP (Vpurify_flag
))
3035 if (NILP (Vdoc_file_name
))
3036 /* We have not yet called Snarf-documentation, so assume
3037 this file is described in the DOC-MM.NN file
3038 and Snarf-documentation will fill in the right value later.
3039 For now, replace the whole list with 0. */
3042 /* We have already called Snarf-documentation, so make a relative
3043 file name for this file, so it can be found properly
3044 in the installed Lisp directory.
3045 We don't use Fexpand_file_name because that would make
3046 the directory absolute now. */
3047 elt
= concat2 (build_string ("../lisp/"),
3048 Ffile_name_nondirectory (elt
));
3050 else if (EQ (elt
, Vload_file_name
)
3052 && load_force_doc_strings
)
3061 Fsignal (Qinvalid_read_syntax
,
3062 Fcons (make_string (") or . in a vector", 18), Qnil
));
3070 XSETCDR (tail
, read0 (readcharfun
));
3072 val
= read0 (readcharfun
);
3073 read1 (readcharfun
, &ch
, 0);
3077 if (doc_reference
== 1)
3078 return make_number (0);
3079 if (doc_reference
== 2)
3081 /* Get a doc string from the file we are loading.
3082 If it's in saved_doc_string, get it from there. */
3083 int pos
= XINT (XCDR (val
));
3084 /* Position is negative for user variables. */
3085 if (pos
< 0) pos
= -pos
;
3086 if (pos
>= saved_doc_string_position
3087 && pos
< (saved_doc_string_position
3088 + saved_doc_string_length
))
3090 int start
= pos
- saved_doc_string_position
;
3093 /* Process quoting with ^A,
3094 and find the end of the string,
3095 which is marked with ^_ (037). */
3096 for (from
= start
, to
= start
;
3097 saved_doc_string
[from
] != 037;)
3099 int c
= saved_doc_string
[from
++];
3102 c
= saved_doc_string
[from
++];
3104 saved_doc_string
[to
++] = c
;
3106 saved_doc_string
[to
++] = 0;
3108 saved_doc_string
[to
++] = 037;
3111 saved_doc_string
[to
++] = c
;
3114 return make_string (saved_doc_string
+ start
,
3117 /* Look in prev_saved_doc_string the same way. */
3118 else if (pos
>= prev_saved_doc_string_position
3119 && pos
< (prev_saved_doc_string_position
3120 + prev_saved_doc_string_length
))
3122 int start
= pos
- prev_saved_doc_string_position
;
3125 /* Process quoting with ^A,
3126 and find the end of the string,
3127 which is marked with ^_ (037). */
3128 for (from
= start
, to
= start
;
3129 prev_saved_doc_string
[from
] != 037;)
3131 int c
= prev_saved_doc_string
[from
++];
3134 c
= prev_saved_doc_string
[from
++];
3136 prev_saved_doc_string
[to
++] = c
;
3138 prev_saved_doc_string
[to
++] = 0;
3140 prev_saved_doc_string
[to
++] = 037;
3143 prev_saved_doc_string
[to
++] = c
;
3146 return make_string (prev_saved_doc_string
+ start
,
3150 return get_doc_string (val
, 0, 0);
3155 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
3157 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
3159 tem
= (read_pure
&& flag
<= 0
3160 ? pure_cons (elt
, Qnil
)
3161 : Fcons (elt
, Qnil
));
3163 XSETCDR (tail
, tem
);
3168 defunflag
= EQ (elt
, Qdefun
);
3169 else if (defunflag
> 0)
3174 Lisp_Object Vobarray
;
3175 Lisp_Object initial_obarray
;
3177 /* oblookup stores the bucket number here, for the sake of Funintern. */
3179 int oblookup_last_bucket_number
;
3181 static int hash_string ();
3183 /* Get an error if OBARRAY is not an obarray.
3184 If it is one, return it. */
3187 check_obarray (obarray
)
3188 Lisp_Object obarray
;
3190 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3192 /* If Vobarray is now invalid, force it to be valid. */
3193 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
3195 obarray
= wrong_type_argument (Qvectorp
, obarray
);
3200 /* Intern the C string STR: return a symbol with that name,
3201 interned in the current obarray. */
3208 int len
= strlen (str
);
3209 Lisp_Object obarray
;
3212 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
3213 obarray
= check_obarray (obarray
);
3214 tem
= oblookup (obarray
, str
, len
, len
);
3217 return Fintern (make_string (str
, len
), obarray
);
3220 /* Create an uninterned symbol with name STR. */
3226 int len
= strlen (str
);
3228 return Fmake_symbol ((!NILP (Vpurify_flag
)
3229 ? make_pure_string (str
, len
, len
, 0)
3230 : make_string (str
, len
)));
3233 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
3234 doc
: /* Return the canonical symbol whose name is STRING.
3235 If there is none, one is created by this function and returned.
3236 A second optional argument specifies the obarray to use;
3237 it defaults to the value of `obarray'. */)
3239 Lisp_Object string
, obarray
;
3241 register Lisp_Object tem
, sym
, *ptr
;
3243 if (NILP (obarray
)) obarray
= Vobarray
;
3244 obarray
= check_obarray (obarray
);
3246 CHECK_STRING (string
);
3248 tem
= oblookup (obarray
, SDATA (string
),
3251 if (!INTEGERP (tem
))
3254 if (!NILP (Vpurify_flag
))
3255 string
= Fpurecopy (string
);
3256 sym
= Fmake_symbol (string
);
3258 if (EQ (obarray
, initial_obarray
))
3259 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3261 XSYMBOL (sym
)->interned
= SYMBOL_INTERNED
;
3263 if ((SREF (string
, 0) == ':')
3264 && EQ (obarray
, initial_obarray
))
3266 XSYMBOL (sym
)->constant
= 1;
3267 XSYMBOL (sym
)->value
= sym
;
3270 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
3272 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
3274 XSYMBOL (sym
)->next
= 0;
3279 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
3280 doc
: /* Return the canonical symbol named NAME, or nil if none exists.
3281 NAME may be a string or a symbol. If it is a symbol, that exact
3282 symbol is searched for.
3283 A second optional argument specifies the obarray to use;
3284 it defaults to the value of `obarray'. */)
3286 Lisp_Object name
, obarray
;
3288 register Lisp_Object tem
, string
;
3290 if (NILP (obarray
)) obarray
= Vobarray
;
3291 obarray
= check_obarray (obarray
);
3293 if (!SYMBOLP (name
))
3295 CHECK_STRING (name
);
3299 string
= SYMBOL_NAME (name
);
3301 tem
= oblookup (obarray
, SDATA (string
), SCHARS (string
), SBYTES (string
));
3302 if (INTEGERP (tem
) || (SYMBOLP (name
) && !EQ (name
, tem
)))
3308 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
3309 doc
: /* Delete the symbol named NAME, if any, from OBARRAY.
3310 The value is t if a symbol was found and deleted, nil otherwise.
3311 NAME may be a string or a symbol. If it is a symbol, that symbol
3312 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3313 OBARRAY defaults to the value of the variable `obarray'. */)
3315 Lisp_Object name
, obarray
;
3317 register Lisp_Object string
, tem
;
3320 if (NILP (obarray
)) obarray
= Vobarray
;
3321 obarray
= check_obarray (obarray
);
3324 string
= SYMBOL_NAME (name
);
3327 CHECK_STRING (name
);
3331 tem
= oblookup (obarray
, SDATA (string
),
3336 /* If arg was a symbol, don't delete anything but that symbol itself. */
3337 if (SYMBOLP (name
) && !EQ (name
, tem
))
3340 XSYMBOL (tem
)->interned
= SYMBOL_UNINTERNED
;
3341 XSYMBOL (tem
)->constant
= 0;
3342 XSYMBOL (tem
)->indirect_variable
= 0;
3344 hash
= oblookup_last_bucket_number
;
3346 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
3348 if (XSYMBOL (tem
)->next
)
3349 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
3351 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
3355 Lisp_Object tail
, following
;
3357 for (tail
= XVECTOR (obarray
)->contents
[hash
];
3358 XSYMBOL (tail
)->next
;
3361 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
3362 if (EQ (following
, tem
))
3364 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
3373 /* Return the symbol in OBARRAY whose names matches the string
3374 of SIZE characters (SIZE_BYTE bytes) at PTR.
3375 If there is no such symbol in OBARRAY, return nil.
3377 Also store the bucket number in oblookup_last_bucket_number. */
3380 oblookup (obarray
, ptr
, size
, size_byte
)
3381 Lisp_Object obarray
;
3382 register const char *ptr
;
3383 int size
, size_byte
;
3387 register Lisp_Object tail
;
3388 Lisp_Object bucket
, tem
;
3390 if (!VECTORP (obarray
)
3391 || (obsize
= XVECTOR (obarray
)->size
) == 0)
3393 obarray
= check_obarray (obarray
);
3394 obsize
= XVECTOR (obarray
)->size
;
3396 /* This is sometimes needed in the middle of GC. */
3397 obsize
&= ~ARRAY_MARK_FLAG
;
3398 /* Combining next two lines breaks VMS C 2.3. */
3399 hash
= hash_string (ptr
, size_byte
);
3401 bucket
= XVECTOR (obarray
)->contents
[hash
];
3402 oblookup_last_bucket_number
= hash
;
3403 if (EQ (bucket
, make_number (0)))
3405 else if (!SYMBOLP (bucket
))
3406 error ("Bad data in guts of obarray"); /* Like CADR error message */
3408 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
3410 if (SBYTES (SYMBOL_NAME (tail
)) == size_byte
3411 && SCHARS (SYMBOL_NAME (tail
)) == size
3412 && !bcmp (SDATA (SYMBOL_NAME (tail
)), ptr
, size_byte
))
3414 else if (XSYMBOL (tail
)->next
== 0)
3417 XSETINT (tem
, hash
);
3422 hash_string (ptr
, len
)
3423 const unsigned char *ptr
;
3426 register const unsigned char *p
= ptr
;
3427 register const unsigned char *end
= p
+ len
;
3428 register unsigned char c
;
3429 register int hash
= 0;
3434 if (c
>= 0140) c
-= 40;
3435 hash
= ((hash
<<3) + (hash
>>28) + c
);
3437 return hash
& 07777777777;
3441 map_obarray (obarray
, fn
, arg
)
3442 Lisp_Object obarray
;
3443 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
3447 register Lisp_Object tail
;
3448 CHECK_VECTOR (obarray
);
3449 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
3451 tail
= XVECTOR (obarray
)->contents
[i
];
3456 if (XSYMBOL (tail
)->next
== 0)
3458 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
3464 mapatoms_1 (sym
, function
)
3465 Lisp_Object sym
, function
;
3467 call1 (function
, sym
);
3470 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
3471 doc
: /* Call FUNCTION on every symbol in OBARRAY.
3472 OBARRAY defaults to the value of `obarray'. */)
3474 Lisp_Object function
, obarray
;
3476 if (NILP (obarray
)) obarray
= Vobarray
;
3477 obarray
= check_obarray (obarray
);
3479 map_obarray (obarray
, mapatoms_1
, function
);
3483 #define OBARRAY_SIZE 1511
3488 Lisp_Object oblength
;
3492 XSETFASTINT (oblength
, OBARRAY_SIZE
);
3494 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3495 Vobarray
= Fmake_vector (oblength
, make_number (0));
3496 initial_obarray
= Vobarray
;
3497 staticpro (&initial_obarray
);
3498 /* Intern nil in the obarray */
3499 XSYMBOL (Qnil
)->interned
= SYMBOL_INTERNED_IN_INITIAL_OBARRAY
;
3500 XSYMBOL (Qnil
)->constant
= 1;
3502 /* These locals are to kludge around a pyramid compiler bug. */
3503 hash
= hash_string ("nil", 3);
3504 /* Separate statement here to avoid VAXC bug. */
3505 hash
%= OBARRAY_SIZE
;
3506 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
3509 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3510 XSYMBOL (Qnil
)->function
= Qunbound
;
3511 XSYMBOL (Qunbound
)->value
= Qunbound
;
3512 XSYMBOL (Qunbound
)->function
= Qunbound
;
3515 XSYMBOL (Qnil
)->value
= Qnil
;
3516 XSYMBOL (Qnil
)->plist
= Qnil
;
3517 XSYMBOL (Qt
)->value
= Qt
;
3518 XSYMBOL (Qt
)->constant
= 1;
3520 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3523 Qvariable_documentation
= intern ("variable-documentation");
3524 staticpro (&Qvariable_documentation
);
3526 read_buffer_size
= 100 + MAX_MULTIBYTE_LENGTH
;
3527 read_buffer
= (char *) xmalloc (read_buffer_size
);
3532 struct Lisp_Subr
*sname
;
3535 sym
= intern (sname
->symbol_name
);
3536 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3539 #ifdef NOTDEF /* use fset in subr.el now */
3541 defalias (sname
, string
)
3542 struct Lisp_Subr
*sname
;
3546 sym
= intern (string
);
3547 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
3551 /* Define an "integer variable"; a symbol whose value is forwarded
3552 to a C variable of type int. Sample call: */
3553 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3555 defvar_int (namestring
, address
)
3559 Lisp_Object sym
, val
;
3560 sym
= intern (namestring
);
3561 val
= allocate_misc ();
3562 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
3563 XINTFWD (val
)->intvar
= address
;
3564 SET_SYMBOL_VALUE (sym
, val
);
3567 /* Similar but define a variable whose value is t if address contains 1,
3568 nil if address contains 0 */
3570 defvar_bool (namestring
, address
)
3574 Lisp_Object sym
, val
;
3575 sym
= intern (namestring
);
3576 val
= allocate_misc ();
3577 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
3578 XBOOLFWD (val
)->boolvar
= address
;
3579 SET_SYMBOL_VALUE (sym
, val
);
3580 Vbyte_boolean_vars
= Fcons (sym
, Vbyte_boolean_vars
);
3583 /* Similar but define a variable whose value is the Lisp Object stored
3584 at address. Two versions: with and without gc-marking of the C
3585 variable. The nopro version is used when that variable will be
3586 gc-marked for some other reason, since marking the same slot twice
3587 can cause trouble with strings. */
3589 defvar_lisp_nopro (namestring
, address
)
3591 Lisp_Object
*address
;
3593 Lisp_Object sym
, val
;
3594 sym
= intern (namestring
);
3595 val
= allocate_misc ();
3596 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
3597 XOBJFWD (val
)->objvar
= address
;
3598 SET_SYMBOL_VALUE (sym
, val
);
3602 defvar_lisp (namestring
, address
)
3604 Lisp_Object
*address
;
3606 defvar_lisp_nopro (namestring
, address
);
3607 staticpro (address
);
3610 /* Similar but define a variable whose value is the Lisp Object stored in
3611 the current buffer. address is the address of the slot in the buffer
3612 that is current now. */
3615 defvar_per_buffer (namestring
, address
, type
, doc
)
3617 Lisp_Object
*address
;
3621 Lisp_Object sym
, val
;
3624 sym
= intern (namestring
);
3625 val
= allocate_misc ();
3626 offset
= (char *)address
- (char *)current_buffer
;
3628 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
3629 XBUFFER_OBJFWD (val
)->offset
= offset
;
3630 SET_SYMBOL_VALUE (sym
, val
);
3631 PER_BUFFER_SYMBOL (offset
) = sym
;
3632 PER_BUFFER_TYPE (offset
) = type
;
3634 if (PER_BUFFER_IDX (offset
) == 0)
3635 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3636 slot of buffer_local_flags */
3641 /* Similar but define a variable whose value is the Lisp Object stored
3642 at a particular offset in the current kboard object. */
3645 defvar_kboard (namestring
, offset
)
3649 Lisp_Object sym
, val
;
3650 sym
= intern (namestring
);
3651 val
= allocate_misc ();
3652 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
3653 XKBOARD_OBJFWD (val
)->offset
= offset
;
3654 SET_SYMBOL_VALUE (sym
, val
);
3657 /* Record the value of load-path used at the start of dumping
3658 so we can see if the site changed it later during dumping. */
3659 static Lisp_Object dump_path
;
3665 int turn_off_warning
= 0;
3667 /* Compute the default load-path. */
3669 normal
= PATH_LOADSEARCH
;
3670 Vload_path
= decode_env_path (0, normal
);
3672 if (NILP (Vpurify_flag
))
3673 normal
= PATH_LOADSEARCH
;
3675 normal
= PATH_DUMPLOADSEARCH
;
3677 /* In a dumped Emacs, we normally have to reset the value of
3678 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3679 uses ../lisp, instead of the path of the installed elisp
3680 libraries. However, if it appears that Vload_path was changed
3681 from the default before dumping, don't override that value. */
3684 if (! NILP (Fequal (dump_path
, Vload_path
)))
3686 Vload_path
= decode_env_path (0, normal
);
3687 if (!NILP (Vinstallation_directory
))
3689 Lisp_Object tem
, tem1
, sitelisp
;
3691 /* Remove site-lisp dirs from path temporarily and store
3692 them in sitelisp, then conc them on at the end so
3693 they're always first in path. */
3697 tem
= Fcar (Vload_path
);
3698 tem1
= Fstring_match (build_string ("site-lisp"),
3702 Vload_path
= Fcdr (Vload_path
);
3703 sitelisp
= Fcons (tem
, sitelisp
);
3709 /* Add to the path the lisp subdir of the
3710 installation dir, if it exists. */
3711 tem
= Fexpand_file_name (build_string ("lisp"),
3712 Vinstallation_directory
);
3713 tem1
= Ffile_exists_p (tem
);
3716 if (NILP (Fmember (tem
, Vload_path
)))
3718 turn_off_warning
= 1;
3719 Vload_path
= Fcons (tem
, Vload_path
);
3723 /* That dir doesn't exist, so add the build-time
3724 Lisp dirs instead. */
3725 Vload_path
= nconc2 (Vload_path
, dump_path
);
3727 /* Add leim under the installation dir, if it exists. */
3728 tem
= Fexpand_file_name (build_string ("leim"),
3729 Vinstallation_directory
);
3730 tem1
= Ffile_exists_p (tem
);
3733 if (NILP (Fmember (tem
, Vload_path
)))
3734 Vload_path
= Fcons (tem
, Vload_path
);
3737 /* Add site-list under the installation dir, if it exists. */
3738 tem
= Fexpand_file_name (build_string ("site-lisp"),
3739 Vinstallation_directory
);
3740 tem1
= Ffile_exists_p (tem
);
3743 if (NILP (Fmember (tem
, Vload_path
)))
3744 Vload_path
= Fcons (tem
, Vload_path
);
3747 /* If Emacs was not built in the source directory,
3748 and it is run from where it was built, add to load-path
3749 the lisp, leim and site-lisp dirs under that directory. */
3751 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3755 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3756 Vinstallation_directory
);
3757 tem1
= Ffile_exists_p (tem
);
3759 /* Don't be fooled if they moved the entire source tree
3760 AFTER dumping Emacs. If the build directory is indeed
3761 different from the source dir, src/Makefile.in and
3762 src/Makefile will not be found together. */
3763 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3764 Vinstallation_directory
);
3765 tem2
= Ffile_exists_p (tem
);
3766 if (!NILP (tem1
) && NILP (tem2
))
3768 tem
= Fexpand_file_name (build_string ("lisp"),
3771 if (NILP (Fmember (tem
, Vload_path
)))
3772 Vload_path
= Fcons (tem
, Vload_path
);
3774 tem
= Fexpand_file_name (build_string ("leim"),
3777 if (NILP (Fmember (tem
, Vload_path
)))
3778 Vload_path
= Fcons (tem
, Vload_path
);
3780 tem
= Fexpand_file_name (build_string ("site-lisp"),
3783 if (NILP (Fmember (tem
, Vload_path
)))
3784 Vload_path
= Fcons (tem
, Vload_path
);
3787 if (!NILP (sitelisp
))
3788 Vload_path
= nconc2 (Fnreverse (sitelisp
), Vload_path
);
3794 /* NORMAL refers to the lisp dir in the source directory. */
3795 /* We used to add ../lisp at the front here, but
3796 that caused trouble because it was copied from dump_path
3797 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3798 It should be unnecessary. */
3799 Vload_path
= decode_env_path (0, normal
);
3800 dump_path
= Vload_path
;
3804 #if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3805 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3806 almost never correct, thereby causing a warning to be printed out that
3807 confuses users. Since PATH_LOADSEARCH is always overridden by the
3808 EMACSLOADPATH environment variable below, disable the warning on NT.
3809 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3810 the "standard" paths may not exist and would be overridden by
3811 EMACSLOADPATH as on NT. Since this depends on how the executable
3812 was build and packaged, turn off the warnings in general */
3814 /* Warn if dirs in the *standard* path don't exist. */
3815 if (!turn_off_warning
)
3817 Lisp_Object path_tail
;
3819 for (path_tail
= Vload_path
;
3821 path_tail
= XCDR (path_tail
))
3823 Lisp_Object dirfile
;
3824 dirfile
= Fcar (path_tail
);
3825 if (STRINGP (dirfile
))
3827 dirfile
= Fdirectory_file_name (dirfile
);
3828 if (access (SDATA (dirfile
), 0) < 0)
3829 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3834 #endif /* !(WINDOWSNT || HAVE_CARBON) */
3836 /* If the EMACSLOADPATH environment variable is set, use its value.
3837 This doesn't apply if we're dumping. */
3839 if (NILP (Vpurify_flag
)
3840 && egetenv ("EMACSLOADPATH"))
3842 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3846 load_in_progress
= 0;
3847 Vload_file_name
= Qnil
;
3849 load_descriptor_list
= Qnil
;
3851 Vstandard_input
= Qt
;
3852 Vloads_in_progress
= Qnil
;
3855 /* Print a warning, using format string FORMAT, that directory DIRNAME
3856 does not exist. Print it on stderr and put it in *Message*. */
3859 dir_warning (format
, dirname
)
3861 Lisp_Object dirname
;
3864 = (char *) alloca (SCHARS (dirname
) + strlen (format
) + 5);
3866 fprintf (stderr
, format
, SDATA (dirname
));
3867 sprintf (buffer
, format
, SDATA (dirname
));
3868 /* Don't log the warning before we've initialized!! */
3870 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3877 defsubr (&Sread_from_string
);
3879 defsubr (&Sintern_soft
);
3880 defsubr (&Sunintern
);
3881 defsubr (&Sget_load_suffixes
);
3883 defsubr (&Seval_buffer
);
3884 defsubr (&Seval_region
);
3885 defsubr (&Sread_char
);
3886 defsubr (&Sread_char_exclusive
);
3887 defsubr (&Sread_event
);
3888 defsubr (&Sget_file_char
);
3889 defsubr (&Smapatoms
);
3890 defsubr (&Slocate_file_internal
);
3892 DEFVAR_LISP ("obarray", &Vobarray
,
3893 doc
: /* Symbol table for use by `intern' and `read'.
3894 It is a vector whose length ought to be prime for best results.
3895 The vector's contents don't make sense if examined from Lisp programs;
3896 to find all the symbols in an obarray, use `mapatoms'. */);
3898 DEFVAR_LISP ("values", &Vvalues
,
3899 doc
: /* List of values of all expressions which were read, evaluated and printed.
3900 Order is reverse chronological. */);
3902 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3903 doc
: /* Stream for read to get input from.
3904 See documentation of `read' for possible values. */);
3905 Vstandard_input
= Qt
;
3907 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions
,
3908 doc
: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3910 If this variable is a buffer, then only forms read from that buffer
3911 will be added to `read-symbol-positions-list'.
3912 If this variable is t, then all read forms will be added.
3913 The effect of all other values other than nil are not currently
3914 defined, although they may be in the future.
3916 The positions are relative to the last call to `read' or
3917 `read-from-string'. It is probably a bad idea to set this variable at
3918 the toplevel; bind it instead. */);
3919 Vread_with_symbol_positions
= Qnil
;
3921 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list
,
3922 doc
: /* A list mapping read symbols to their positions.
3923 This variable is modified during calls to `read' or
3924 `read-from-string', but only when `read-with-symbol-positions' is
3927 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3928 CHAR-POSITION is an integer giving the offset of that occurrence of the
3929 symbol from the position where `read' or `read-from-string' started.
3931 Note that a symbol will appear multiple times in this list, if it was
3932 read multiple times. The list is in the same order as the symbols
3934 Vread_symbol_positions_list
= Qnil
;
3936 DEFVAR_LISP ("load-path", &Vload_path
,
3937 doc
: /* *List of directories to search for files to load.
3938 Each element is a string (directory name) or nil (try default directory).
3939 Initialized based on EMACSLOADPATH environment variable, if any,
3940 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3942 DEFVAR_LISP ("load-suffixes", &Vload_suffixes
,
3943 doc
: /* List of suffixes for (compiled or source) Emacs Lisp files.
3944 This list should not include the empty string.
3945 `load' and related functions try to append these suffixes, in order,
3946 to the specified file name if a Lisp suffix is allowed or required. */);
3947 Vload_suffixes
= Fcons (build_string (".elc"),
3948 Fcons (build_string (".el"), Qnil
));
3949 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes
,
3950 doc
: /* List of suffixes that indicate representations of \
3952 This list should normally start with the empty string.
3954 Enabling Auto Compression mode appends the suffixes in
3955 `jka-compr-load-suffixes' to this list and disabling Auto Compression
3956 mode removes them again. `load' and related functions use this list to
3957 determine whether they should look for compressed versions of a file
3958 and, if so, which suffixes they should try to append to the file name
3959 in order to do so. However, if you want to customize which suffixes
3960 the loading functions recognize as compression suffixes, you should
3961 customize `jka-compr-load-suffixes' rather than the present variable. */);
3962 /* We don't use empty_string because it's not initialized yet. */
3963 Vload_file_rep_suffixes
= Fcons (build_string (""), Qnil
);
3965 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3966 doc
: /* Non-nil iff inside of `load'. */);
3968 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3969 doc
: /* An alist of expressions to be evalled when particular files are loaded.
3970 Each element looks like (FILENAME FORMS...).
3971 When `load' is run and the file-name argument is FILENAME,
3972 the FORMS in the corresponding element are executed at the end of loading.
3974 FILENAME must match exactly! Normally FILENAME is the name of a library,
3975 with no directory specified, since that is how `load' is normally called.
3976 An error in FORMS does not undo the load,
3977 but does prevent execution of the rest of the FORMS.
3978 FILENAME can also be a symbol (a feature) and FORMS are then executed
3979 when the corresponding call to `provide' is made. */);
3980 Vafter_load_alist
= Qnil
;
3982 DEFVAR_LISP ("load-history", &Vload_history
,
3983 doc
: /* Alist mapping file names to symbols and features.
3984 Each alist element is a list that starts with a file name,
3985 except for one element (optional) that starts with nil and describes
3986 definitions evaluated from buffers not visiting files.
3987 The remaining elements of each list are symbols defined as variables
3988 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
3989 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3990 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)',
3991 and means that SYMBOL was an autoload before this file redefined it
3994 During preloading, the file name recorded is relative to the main Lisp
3995 directory. These file names are converted to absolute at startup. */);
3996 Vload_history
= Qnil
;
3998 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3999 doc
: /* Full name of file being loaded by `load'. */);
4000 Vload_file_name
= Qnil
;
4002 DEFVAR_LISP ("user-init-file", &Vuser_init_file
,
4003 doc
: /* File name, including directory, of user's initialization file.
4004 If the file loaded had extension `.elc', and the corresponding source file
4005 exists, this variable contains the name of source file, suitable for use
4006 by functions like `custom-save-all' which edit the init file. */);
4007 Vuser_init_file
= Qnil
;
4009 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
4010 doc
: /* Used for internal purposes by `load'. */);
4011 Vcurrent_load_list
= Qnil
;
4013 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
4014 doc
: /* Function used by `load' and `eval-region' for reading expressions.
4015 The default is nil, which means use the function `read'. */);
4016 Vload_read_function
= Qnil
;
4018 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
4019 doc
: /* Function called in `load' for loading an Emacs lisp source file.
4020 This function is for doing code conversion before reading the source file.
4021 If nil, loading is done without any code conversion.
4022 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4023 FULLNAME is the full name of FILE.
4024 See `load' for the meaning of the remaining arguments. */);
4025 Vload_source_file_function
= Qnil
;
4027 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
4028 doc
: /* Non-nil means `load' should force-load all dynamic doc strings.
4029 This is useful when the file being loaded is a temporary copy. */);
4030 load_force_doc_strings
= 0;
4032 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
4033 doc
: /* Non-nil means `read' converts strings to unibyte whenever possible.
4034 This is normally bound by `load' and `eval-buffer' to control `read',
4035 and is not meant for users to change. */);
4036 load_convert_to_unibyte
= 0;
4038 DEFVAR_LISP ("source-directory", &Vsource_directory
,
4039 doc
: /* Directory in which Emacs sources were found when Emacs was built.
4040 You cannot count on them to still be there! */);
4042 = Fexpand_file_name (build_string ("../"),
4043 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
4045 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
4046 doc
: /* List of files that were preloaded (when dumping Emacs). */);
4047 Vpreloaded_file_list
= Qnil
;
4049 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars
,
4050 doc
: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
4051 Vbyte_boolean_vars
= Qnil
;
4053 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries
,
4054 doc
: /* Non-nil means load dangerous compiled Lisp files.
4055 Some versions of XEmacs use different byte codes than Emacs. These
4056 incompatible byte codes can make Emacs crash when it tries to execute
4058 load_dangerous_libraries
= 0;
4060 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp
,
4061 doc
: /* Regular expression matching safe to load compiled Lisp files.
4062 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4063 from the file, and matches them against this regular expression.
4064 When the regular expression matches, the file is considered to be safe
4065 to load. See also `load-dangerous-libraries'. */);
4066 Vbytecomp_version_regexp
4067 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4069 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list
,
4070 doc
: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
4071 Veval_buffer_list
= Qnil
;
4073 /* Vsource_directory was initialized in init_lread. */
4075 load_descriptor_list
= Qnil
;
4076 staticpro (&load_descriptor_list
);
4078 Qcurrent_load_list
= intern ("current-load-list");
4079 staticpro (&Qcurrent_load_list
);
4081 Qstandard_input
= intern ("standard-input");
4082 staticpro (&Qstandard_input
);
4084 Qread_char
= intern ("read-char");
4085 staticpro (&Qread_char
);
4087 Qget_file_char
= intern ("get-file-char");
4088 staticpro (&Qget_file_char
);
4090 Qbackquote
= intern ("`");
4091 staticpro (&Qbackquote
);
4092 Qcomma
= intern (",");
4093 staticpro (&Qcomma
);
4094 Qcomma_at
= intern (",@");
4095 staticpro (&Qcomma_at
);
4096 Qcomma_dot
= intern (",.");
4097 staticpro (&Qcomma_dot
);
4099 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
4100 staticpro (&Qinhibit_file_name_operation
);
4102 Qascii_character
= intern ("ascii-character");
4103 staticpro (&Qascii_character
);
4105 Qfunction
= intern ("function");
4106 staticpro (&Qfunction
);
4108 Qload
= intern ("load");
4111 Qload_file_name
= intern ("load-file-name");
4112 staticpro (&Qload_file_name
);
4114 Qeval_buffer_list
= intern ("eval-buffer-list");
4115 staticpro (&Qeval_buffer_list
);
4117 staticpro (&dump_path
);
4119 staticpro (&read_objects
);
4120 read_objects
= Qnil
;
4121 staticpro (&seen_list
);
4124 Vloads_in_progress
= Qnil
;
4125 staticpro (&Vloads_in_progress
);
4128 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4129 (do not change this comment) */