1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 1998
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
25 #include <sys/types.h>
37 #include "termhooks.h"
41 #include <sys/inode.h>
46 #include <unistd.h> /* to get X_OK */
59 #ifdef LISP_FLOAT_TYPE
65 #endif /* LISP_FLOAT_TYPE */
69 #endif /* HAVE_SETLOCALE */
77 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
78 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
79 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
80 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
81 Lisp_Object Qinhibit_file_name_operation
;
83 extern Lisp_Object Qevent_symbol_element_mask
;
84 extern Lisp_Object Qfile_exists_p
;
86 /* non-zero if inside `load' */
89 /* Directory in which the sources were found. */
90 Lisp_Object Vsource_directory
;
92 /* Search path for files to be loaded. */
93 Lisp_Object Vload_path
;
95 /* This is the user-visible association list that maps features to
96 lists of defs in their load files. */
97 Lisp_Object Vload_history
;
99 /* This is used to build the load history. */
100 Lisp_Object Vcurrent_load_list
;
102 /* List of files that were preloaded. */
103 Lisp_Object Vpreloaded_file_list
;
105 /* Name of file actually being read by `load'. */
106 Lisp_Object Vload_file_name
;
108 /* Function to use for reading, in `load' and friends. */
109 Lisp_Object Vload_read_function
;
111 /* The association list of objects read with the #n=object form.
112 Each member of the list has the form (n . object), and is used to
113 look up the object for the corresponding #n# construct.
114 It must be set to nil before all top-level calls to read0. */
115 Lisp_Object read_objects
;
117 /* Nonzero means load should forcibly load all dynamic doc strings. */
118 static int load_force_doc_strings
;
120 /* Nonzero means read should convert strings to unibyte. */
121 static int load_convert_to_unibyte
;
123 /* Function to use for loading an Emacs lisp source file (not
124 compiled) instead of readevalloop. */
125 Lisp_Object Vload_source_file_function
;
127 /* List of descriptors now open for Fload. */
128 static Lisp_Object load_descriptor_list
;
130 /* File for get_file_char to read from. Use by load. */
131 static FILE *instream
;
133 /* When nonzero, read conses in pure space */
134 static int read_pure
;
136 /* For use within read-from-string (this reader is non-reentrant!!) */
137 static int read_from_string_index
;
138 static int read_from_string_index_byte
;
139 static int read_from_string_limit
;
141 /* Number of bytes left to read in the buffer character
142 that `readchar' has already advanced over. */
143 static int readchar_backlog
;
145 /* This contains the last string skipped with #@. */
146 static char *saved_doc_string
;
147 /* Length of buffer allocated in saved_doc_string. */
148 static int saved_doc_string_size
;
149 /* Length of actual data in saved_doc_string. */
150 static int saved_doc_string_length
;
151 /* This is the file position that string came from. */
152 static int saved_doc_string_position
;
154 /* This contains the previous string skipped with #@.
155 We copy it from saved_doc_string when a new string
156 is put in saved_doc_string. */
157 static char *prev_saved_doc_string
;
158 /* Length of buffer allocated in prev_saved_doc_string. */
159 static int prev_saved_doc_string_size
;
160 /* Length of actual data in prev_saved_doc_string. */
161 static int prev_saved_doc_string_length
;
162 /* This is the file position that string came from. */
163 static int prev_saved_doc_string_position
;
165 /* Nonzero means inside a new-style backquote
166 with no surrounding parentheses.
167 Fread initializes this to zero, so we need not specbind it
168 or worry about what happens to it when there is an error. */
169 static int new_backquote_flag
;
171 /* Handle unreading and rereading of characters.
172 Write READCHAR to read a character,
173 UNREAD(c) to unread c to be read again.
175 These macros actually read/unread a byte code, multibyte characters
176 are not handled here. The caller should manage them if necessary.
179 #define READCHAR readchar (readcharfun)
180 #define UNREAD(c) unreadchar (readcharfun, c)
183 readchar (readcharfun
)
184 Lisp_Object readcharfun
;
187 register int c
, mpos
;
189 if (BUFFERP (readcharfun
))
191 register struct buffer
*inbuffer
= XBUFFER (readcharfun
);
193 int pt_byte
= BUF_PT_BYTE (inbuffer
);
194 int orig_pt_byte
= pt_byte
;
196 if (readchar_backlog
> 0)
197 /* We get the address of the byte just passed,
198 which is the last byte of the character.
199 The other bytes in this character are consecutive with it,
200 because the gap can't be in the middle of a character. */
201 return *(BUF_BYTE_ADDRESS (inbuffer
, BUF_PT_BYTE (inbuffer
) - 1)
202 - --readchar_backlog
);
204 if (pt_byte
>= BUF_ZV_BYTE (inbuffer
))
207 readchar_backlog
= -1;
209 if (! NILP (inbuffer
->enable_multibyte_characters
))
211 unsigned char workbuf
[4];
212 unsigned char *str
= workbuf
;
215 /* Fetch the character code from the buffer. */
216 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, pt_byte
);
217 BUF_INC_POS (inbuffer
, pt_byte
);
218 c
= STRING_CHAR (p
, pt_byte
- orig_pt_byte
);
220 /* Find the byte-sequence representation of that character. */
221 if (SINGLE_BYTE_CHAR_P (c
))
222 length
= 1, workbuf
[0] = c
;
224 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
226 /* If the bytes for this character in the buffer
227 are not identical with what the character code implies,
228 read the bytes one by one from the buffer. */
229 if (length
!= pt_byte
- orig_pt_byte
230 || (length
== 1 ? *str
!= *p
: bcmp (str
, p
, length
)))
232 readchar_backlog
= pt_byte
- orig_pt_byte
;
233 c
= BUF_FETCH_BYTE (inbuffer
, orig_pt_byte
);
239 c
= BUF_FETCH_BYTE (inbuffer
, pt_byte
);
242 SET_BUF_PT_BOTH (inbuffer
, BUF_PT (inbuffer
) + 1, pt_byte
);
246 if (MARKERP (readcharfun
))
248 register struct buffer
*inbuffer
= XMARKER (readcharfun
)->buffer
;
250 int bytepos
= marker_byte_position (readcharfun
);
251 int orig_bytepos
= bytepos
;
253 if (readchar_backlog
> 0)
254 /* We get the address of the byte just passed,
255 which is the last byte of the character.
256 The other bytes in this character are consecutive with it,
257 because the gap can't be in the middle of a character. */
258 return *(BUF_BYTE_ADDRESS (inbuffer
, XMARKER (readcharfun
)->bytepos
- 1)
259 - --readchar_backlog
);
261 if (bytepos
>= BUF_ZV_BYTE (inbuffer
))
264 readchar_backlog
= -1;
266 if (! NILP (inbuffer
->enable_multibyte_characters
))
268 unsigned char workbuf
[4];
269 unsigned char *str
= workbuf
;
272 /* Fetch the character code from the buffer. */
273 unsigned char *p
= BUF_BYTE_ADDRESS (inbuffer
, bytepos
);
274 BUF_INC_POS (inbuffer
, bytepos
);
275 c
= STRING_CHAR (p
, bytepos
- orig_bytepos
);
277 /* Find the byte-sequence representation of that character. */
278 if (SINGLE_BYTE_CHAR_P (c
))
279 length
= 1, workbuf
[0] = c
;
281 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
283 /* If the bytes for this character in the buffer
284 are not identical with what the character code implies,
285 read the bytes one by one from the buffer. */
286 if (length
!= bytepos
- orig_bytepos
287 || (length
== 1 ? *str
!= *p
: bcmp (str
, p
, length
)))
289 readchar_backlog
= bytepos
- orig_bytepos
;
290 c
= BUF_FETCH_BYTE (inbuffer
, orig_bytepos
);
296 c
= BUF_FETCH_BYTE (inbuffer
, bytepos
);
300 XMARKER (readcharfun
)->bytepos
= bytepos
;
301 XMARKER (readcharfun
)->charpos
++;
306 if (EQ (readcharfun
, Qlambda
))
307 return read_bytecode_char (0);
309 if (EQ (readcharfun
, Qget_file_char
))
313 /* Interrupted reads have been observed while reading over the network */
314 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
323 if (STRINGP (readcharfun
))
325 if (read_from_string_index
>= read_from_string_limit
)
327 else if (STRING_MULTIBYTE (readcharfun
))
328 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
329 read_from_string_index
,
330 read_from_string_index_byte
);
332 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
337 tem
= call0 (readcharfun
);
344 /* Unread the character C in the way appropriate for the stream READCHARFUN.
345 If the stream is a user function, call it with the char as argument. */
348 unreadchar (readcharfun
, c
)
349 Lisp_Object readcharfun
;
353 /* Don't back up the pointer if we're unreading the end-of-input mark,
354 since readchar didn't advance it when we read it. */
356 else if (BUFFERP (readcharfun
))
358 struct buffer
*b
= XBUFFER (readcharfun
);
359 int bytepos
= BUF_PT_BYTE (b
);
361 if (readchar_backlog
>= 0)
366 if (! NILP (b
->enable_multibyte_characters
))
367 BUF_DEC_POS (b
, bytepos
);
371 BUF_PT_BYTE (b
) = bytepos
;
374 else if (MARKERP (readcharfun
))
376 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
377 int bytepos
= XMARKER (readcharfun
)->bytepos
;
379 if (readchar_backlog
>= 0)
383 XMARKER (readcharfun
)->charpos
--;
384 if (! NILP (b
->enable_multibyte_characters
))
385 BUF_DEC_POS (b
, bytepos
);
389 XMARKER (readcharfun
)->bytepos
= bytepos
;
392 else if (STRINGP (readcharfun
))
394 read_from_string_index
--;
395 read_from_string_index_byte
396 = string_char_to_byte (readcharfun
, read_from_string_index
);
398 else if (EQ (readcharfun
, Qlambda
))
399 read_bytecode_char (1);
400 else if (EQ (readcharfun
, Qget_file_char
))
401 ungetc (c
, instream
);
403 call1 (readcharfun
, make_number (c
));
406 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
407 static int read_multibyte ();
409 /* Get a character from the tty. */
411 extern Lisp_Object
read_char ();
413 /* Read input events until we get one that's acceptable for our purposes.
415 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
416 until we get a character we like, and then stuffed into
419 If ASCII_REQUIRED is non-zero, we check function key events to see
420 if the unmodified version of the symbol has a Qascii_character
421 property, and use that character, if present.
423 If ERROR_NONASCII is non-zero, we signal an error if the input we
424 get isn't an ASCII character with modifiers. If it's zero but
425 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
429 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
430 int no_switch_frame
, ascii_required
, error_nonascii
;
433 return make_number (getchar ());
435 register Lisp_Object val
, delayed_switch_frame
;
437 delayed_switch_frame
= Qnil
;
439 /* Read until we get an acceptable event. */
441 val
= read_char (0, 0, 0, Qnil
, 0);
446 /* switch-frame events are put off until after the next ASCII
447 character. This is better than signaling an error just because
448 the last characters were typed to a separate minibuffer frame,
449 for example. Eventually, some code which can deal with
450 switch-frame events will read it and process it. */
452 && EVENT_HAS_PARAMETERS (val
)
453 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
455 delayed_switch_frame
= val
;
461 /* Convert certain symbols to their ASCII equivalents. */
464 Lisp_Object tem
, tem1
, tem2
;
465 tem
= Fget (val
, Qevent_symbol_element_mask
);
468 tem1
= Fget (Fcar (tem
), Qascii_character
);
469 /* Merge this symbol's modifier bits
470 with the ASCII equivalent of its basic code. */
472 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
476 /* If we don't have a character now, deal with it appropriately. */
481 Vunread_command_events
= Fcons (val
, Qnil
);
482 error ("Non-character input-event");
489 if (! NILP (delayed_switch_frame
))
490 unread_switch_frame
= delayed_switch_frame
;
496 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
497 "Read a character from the command input (keyboard or macro).\n\
498 It is returned as a number.\n\
499 If the user generates an event which is not a character (i.e. a mouse\n\
500 click or function key event), `read-char' signals an error. As an\n\
501 exception, switch-frame events are put off until non-ASCII events can\n\
503 If you want to read non-character events, or ignore them, call\n\
504 `read-event' or `read-char-exclusive' instead.")
507 return read_filtered_event (1, 1, 1);
510 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
511 "Read an event object from the input stream.")
514 return read_filtered_event (0, 0, 0);
517 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
518 "Read a character from the command input (keyboard or macro).\n\
519 It is returned as a number. Non-character events are ignored.")
522 return read_filtered_event (1, 1, 0);
525 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
526 "Don't use this yourself.")
529 register Lisp_Object val
;
530 XSETINT (val
, getc (instream
));
534 static void readevalloop ();
535 static Lisp_Object
load_unwind ();
536 static Lisp_Object
load_descriptor_unwind ();
538 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
539 "Execute a file of Lisp code named FILE.\n\
540 First try FILE with `.elc' appended, then try with `.el',\n\
541 then try FILE unmodified.\n\
542 This function searches the directories in `load-path'.\n\
543 If optional second arg NOERROR is non-nil,\n\
544 report no error if FILE doesn't exist.\n\
545 Print messages at start and end of loading unless\n\
546 optional third arg NOMESSAGE is non-nil.\n\
547 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
548 suffixes `.elc' or `.el' to the specified name FILE.\n\
549 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
550 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
551 it ends in one of those suffixes or includes a directory name.\n\
552 Return t if file exists.")
553 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
554 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
556 register FILE *stream
;
557 register int fd
= -1;
558 register Lisp_Object lispstream
;
559 int count
= specpdl_ptr
- specpdl
;
563 /* 1 means we printed the ".el is newer" message. */
565 /* 1 means we are loading a compiled file. */
573 CHECK_STRING (file
, 0);
575 /* If file name is magic, call the handler. */
576 handler
= Ffind_file_name_handler (file
, Qload
);
578 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
580 /* Do this after the handler to avoid
581 the need to gcpro noerror, nomessage and nosuffix.
582 (Below here, we care only whether they are nil or not.) */
583 file
= Fsubstitute_in_file_name (file
);
585 /* Avoid weird lossage with null string as arg,
586 since it would try to load a directory as a Lisp file */
587 if (XSTRING (file
)->size
> 0)
589 int size
= XSTRING (file
)->size
;
593 if (! NILP (must_suffix
))
595 /* Don't insist on adding a suffix if FILE already ends with one. */
597 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
600 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
602 /* Don't insist on adding a suffix
603 if the argument includes a directory name. */
604 else if (! NILP (Ffile_name_directory (file
)))
608 fd
= openp (Vload_path
, file
,
609 (!NILP (nosuffix
) ? ""
610 : ! NILP (must_suffix
) ? ".elc:.el"
620 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
621 Fcons (file
, Qnil
)));
626 /* If FD is 0, that means openp found a remote file. */
629 handler
= Ffind_file_name_handler (found
, Qload
);
630 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
633 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
644 stat ((char *)XSTRING (found
)->data
, &s1
);
645 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
646 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
647 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
649 /* Make the progress messages mention that source is newer. */
652 /* If we won't print another message, mention this anyway. */
653 if (! NILP (nomessage
))
654 message_with_string ("Source file `%s' newer than byte-compiled file",
657 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
661 /* We are loading a source file (*.el). */
662 if (!NILP (Vload_source_file_function
))
665 return call4 (Vload_source_file_function
, found
, file
,
666 NILP (noerror
) ? Qnil
: Qt
,
667 NILP (nomessage
) ? Qnil
: Qt
);
673 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
674 #else /* not WINDOWSNT */
675 stream
= fdopen (fd
, fmode
);
676 #endif /* not WINDOWSNT */
680 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
683 if (! NILP (Vpurify_flag
))
684 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
686 if (NILP (nomessage
))
689 message_with_string ("Loading %s (source)...", file
, 1);
691 message_with_string ("Loading %s (compiled; note, source file is newer)...",
693 else /* The typical case; compiled file newer than source file. */
694 message_with_string ("Loading %s...", file
, 1);
698 lispstream
= Fcons (Qnil
, Qnil
);
699 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
700 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
701 record_unwind_protect (load_unwind
, lispstream
);
702 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
703 specbind (Qload_file_name
, found
);
704 specbind (Qinhibit_file_name_operation
, Qnil
);
706 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
708 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
709 unbind_to (count
, Qnil
);
711 /* Run any load-hooks for this file. */
712 temp
= Fassoc (file
, Vafter_load_alist
);
714 Fprogn (Fcdr (temp
));
717 if (saved_doc_string
)
718 free (saved_doc_string
);
719 saved_doc_string
= 0;
720 saved_doc_string_size
= 0;
722 if (prev_saved_doc_string
)
723 free (prev_saved_doc_string
);
724 prev_saved_doc_string
= 0;
725 prev_saved_doc_string_size
= 0;
727 if (!noninteractive
&& NILP (nomessage
))
730 message_with_string ("Loading %s (source)...done", file
, 1);
732 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
734 else /* The typical case; compiled file newer than source file. */
735 message_with_string ("Loading %s...done", file
, 1);
741 load_unwind (stream
) /* used as unwind-protect function in load */
744 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
745 | XFASTINT (XCONS (stream
)->cdr
)));
746 if (--load_in_progress
< 0) load_in_progress
= 0;
751 load_descriptor_unwind (oldlist
)
754 load_descriptor_list
= oldlist
;
758 /* Close all descriptors in use for Floads.
759 This is used when starting a subprocess. */
766 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
767 close (XFASTINT (XCONS (tail
)->car
));
772 complete_filename_p (pathname
)
773 Lisp_Object pathname
;
775 register unsigned char *s
= XSTRING (pathname
)->data
;
776 return (IS_DIRECTORY_SEP (s
[0])
777 || (XSTRING (pathname
)->size
> 2
778 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
788 /* Search for a file whose name is STR, looking in directories
789 in the Lisp list PATH, and trying suffixes from SUFFIX.
790 SUFFIX is a string containing possible suffixes separated by colons.
791 On success, returns a file descriptor. On failure, returns -1.
793 EXEC_ONLY nonzero means don't open the files,
794 just look for one that is executable. In this case,
795 returns 1 on success.
797 If STOREPTR is nonzero, it points to a slot where the name of
798 the file actually found should be stored as a Lisp string.
799 nil is stored there on failure.
801 If the file we find is remote, return 0
802 but store the found remote file name in *STOREPTR.
803 We do not check for remote files if EXEC_ONLY is nonzero. */
806 openp (path
, str
, suffix
, storeptr
, exec_only
)
807 Lisp_Object path
, str
;
809 Lisp_Object
*storeptr
;
815 register char *fn
= buf
;
818 Lisp_Object filename
;
826 if (complete_filename_p (str
))
829 for (; !NILP (path
); path
= Fcdr (path
))
833 filename
= Fexpand_file_name (str
, Fcar (path
));
834 if (!complete_filename_p (filename
))
835 /* If there are non-absolute elts in PATH (eg ".") */
836 /* Of course, this could conceivably lose if luser sets
837 default-directory to be something non-absolute... */
839 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
840 if (!complete_filename_p (filename
))
841 /* Give up on this path element! */
845 /* Calculate maximum size of any filename made from
846 this path element/specified file name and any possible suffix. */
847 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
848 if (fn_size
< want_size
)
849 fn
= (char *) alloca (fn_size
= 100 + want_size
);
853 /* Loop over suffixes. */
856 char *esuffix
= (char *) index (nsuffix
, ':');
857 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
860 /* Concatenate path element/specified name with the suffix.
861 If the directory starts with /:, remove that. */
862 if (XSTRING (filename
)->size
> 2
863 && XSTRING (filename
)->data
[0] == '/'
864 && XSTRING (filename
)->data
[1] == ':')
866 strncpy (fn
, XSTRING (filename
)->data
+ 2,
867 XSTRING (filename
)->size
- 2);
868 fn
[XSTRING (filename
)->size
- 2] = 0;
872 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
873 fn
[XSTRING (filename
)->size
] = 0;
876 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
877 strncat (fn
, nsuffix
, lsuffix
);
879 /* Check that the file exists and is not a directory. */
883 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
884 if (! NILP (handler
) && ! exec_only
)
889 string
= build_string (fn
);
890 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
891 : Ffile_readable_p (string
));
893 && ! NILP (Ffile_directory_p (build_string (fn
))))
898 /* We succeeded; return this descriptor and filename. */
900 *storeptr
= build_string (fn
);
907 int exists
= (stat (fn
, &st
) >= 0
908 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
911 /* Check that we can access or open it. */
913 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
915 fd
= open (fn
, O_RDONLY
, 0);
919 /* We succeeded; return this descriptor and filename. */
921 *storeptr
= build_string (fn
);
928 /* Advance to next suffix. */
931 nsuffix
+= lsuffix
+ 1;
942 /* Merge the list we've accumulated of globals from the current input source
943 into the load_history variable. The details depend on whether
944 the source has an associated file name or not. */
947 build_load_history (stream
, source
)
951 register Lisp_Object tail
, prev
, newelt
;
952 register Lisp_Object tem
, tem2
;
953 register int foundit
, loading
;
955 /* Don't bother recording anything for preloaded files. */
956 if (!NILP (Vpurify_flag
))
959 loading
= stream
|| !NARROWED
;
961 tail
= Vload_history
;
968 /* Find the feature's previous assoc list... */
969 if (!NILP (Fequal (source
, Fcar (tem
))))
973 /* If we're loading, remove it. */
977 Vload_history
= Fcdr (tail
);
979 Fsetcdr (prev
, Fcdr (tail
));
982 /* Otherwise, cons on new symbols that are not already members. */
985 tem2
= Vcurrent_load_list
;
989 newelt
= Fcar (tem2
);
991 if (NILP (Fmemq (newelt
, tem
)))
992 Fsetcar (tail
, Fcons (Fcar (tem
),
993 Fcons (newelt
, Fcdr (tem
))));
1006 /* If we're loading, cons the new assoc onto the front of load-history,
1007 the most-recently-loaded position. Also do this if we didn't find
1008 an existing member for the current source. */
1009 if (loading
|| !foundit
)
1010 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1015 unreadpure () /* Used as unwind-protect function in readevalloop */
1022 readevalloop_1 (old
)
1025 load_convert_to_unibyte
= ! NILP (old
);
1029 /* UNIBYTE specifies how to set load_convert_to_unibyte
1030 for this invocation.
1031 READFUN, if non-nil, is used instead of `read'. */
1034 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1035 Lisp_Object readcharfun
;
1037 Lisp_Object sourcename
;
1038 Lisp_Object (*evalfun
) ();
1040 Lisp_Object unibyte
, readfun
;
1043 register Lisp_Object val
;
1044 int count
= specpdl_ptr
- specpdl
;
1045 struct gcpro gcpro1
;
1046 struct buffer
*b
= 0;
1048 if (BUFFERP (readcharfun
))
1049 b
= XBUFFER (readcharfun
);
1050 else if (MARKERP (readcharfun
))
1051 b
= XMARKER (readcharfun
)->buffer
;
1053 specbind (Qstandard_input
, readcharfun
);
1054 specbind (Qcurrent_load_list
, Qnil
);
1055 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1056 load_convert_to_unibyte
= !NILP (unibyte
);
1058 readchar_backlog
= -1;
1060 GCPRO1 (sourcename
);
1062 LOADHIST_ATTACH (sourcename
);
1066 if (b
!= 0 && NILP (b
->name
))
1067 error ("Reading from killed buffer");
1073 while ((c
= READCHAR
) != '\n' && c
!= -1);
1078 /* Ignore whitespace here, so we can detect eof. */
1079 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1082 if (!NILP (Vpurify_flag
) && c
== '(')
1084 int count1
= specpdl_ptr
- specpdl
;
1085 record_unwind_protect (unreadpure
, Qnil
);
1086 val
= read_list (-1, readcharfun
);
1087 unbind_to (count1
, Qnil
);
1092 read_objects
= Qnil
;
1093 if (! NILP (readfun
))
1094 val
= call1 (readfun
, readcharfun
);
1095 else if (! NILP (Vload_read_function
))
1096 val
= call1 (Vload_read_function
, readcharfun
);
1098 val
= read0 (readcharfun
);
1101 val
= (*evalfun
) (val
);
1104 Vvalues
= Fcons (val
, Vvalues
);
1105 if (EQ (Vstandard_output
, Qt
))
1112 build_load_history (stream
, sourcename
);
1115 unbind_to (count
, Qnil
);
1120 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 4, "",
1121 "Execute the current buffer as Lisp code.\n\
1122 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1123 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1124 PRINTFLAG controls printing of output:\n\
1125 nil means discard it; anything else is stream for print.\n\
1127 If the optional third argument FILENAME is non-nil,\n\
1128 it specifies the file name to use for `load-history'.\n\
1130 This function preserves the position of point.")
1131 (buffer
, printflag
, filename
, unibyte
)
1132 Lisp_Object buffer
, printflag
, filename
, unibyte
;
1134 int count
= specpdl_ptr
- specpdl
;
1135 Lisp_Object tem
, buf
;
1138 buf
= Fcurrent_buffer ();
1140 buf
= Fget_buffer (buffer
);
1142 error ("No such buffer");
1144 if (NILP (printflag
))
1149 if (NILP (filename
))
1150 filename
= XBUFFER (buf
)->filename
;
1152 specbind (Qstandard_output
, tem
);
1153 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1154 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1155 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1156 unbind_to (count
, Qnil
);
1162 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1163 "Execute the current buffer as Lisp code.\n\
1164 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1165 nil means discard it; anything else is stream for print.\n\
1167 If there is no error, point does not move. If there is an error,\n\
1168 point remains at the end of the last character read from the buffer.")
1170 Lisp_Object printflag
;
1172 int count
= specpdl_ptr
- specpdl
;
1173 Lisp_Object tem
, cbuf
;
1175 cbuf
= Fcurrent_buffer ()
1177 if (NILP (printflag
))
1181 specbind (Qstandard_output
, tem
);
1182 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1184 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1185 !NILP (printflag
), Qnil
, Qnil
);
1186 return unbind_to (count
, Qnil
);
1190 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1191 "Execute the region as Lisp code.\n\
1192 When called from programs, expects two arguments,\n\
1193 giving starting and ending indices in the current buffer\n\
1194 of the text to be executed.\n\
1195 Programs can pass third argument PRINTFLAG which controls output:\n\
1196 nil means discard it; anything else is stream for printing it.\n\
1197 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1198 instead of `read' to read each expression. It gets one argument\n\
1199 which is the input stream for reading characters.\n\
1201 This function does not move point.")
1202 (start
, end
, printflag
, read_function
)
1203 Lisp_Object start
, end
, printflag
, read_function
;
1205 int count
= specpdl_ptr
- specpdl
;
1206 Lisp_Object tem
, cbuf
;
1208 cbuf
= Fcurrent_buffer ();
1210 if (NILP (printflag
))
1214 specbind (Qstandard_output
, tem
);
1216 if (NILP (printflag
))
1217 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1218 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1220 /* This both uses start and checks its type. */
1222 Fnarrow_to_region (make_number (BEGV
), end
);
1223 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1224 !NILP (printflag
), Qnil
, read_function
);
1226 return unbind_to (count
, Qnil
);
1229 #endif /* standalone */
1231 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1232 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1233 If STREAM is nil, use the value of `standard-input' (which see).\n\
1234 STREAM or the value of `standard-input' may be:\n\
1235 a buffer (read from point and advance it)\n\
1236 a marker (read from where it points and advance it)\n\
1237 a function (call it with no arguments for each character,\n\
1238 call it with a char as argument to push a char back)\n\
1239 a string (takes text from string, starting at the beginning)\n\
1240 t (read text line using minibuffer and use it).")
1244 extern Lisp_Object
Fread_minibuffer ();
1247 stream
= Vstandard_input
;
1248 if (EQ (stream
, Qt
))
1249 stream
= Qread_char
;
1251 readchar_backlog
= -1;
1252 new_backquote_flag
= 0;
1253 read_objects
= Qnil
;
1256 if (EQ (stream
, Qread_char
))
1257 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1260 if (STRINGP (stream
))
1261 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1263 return read0 (stream
);
1266 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1267 "Read one Lisp expression which is represented as text by STRING.\n\
1268 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1269 START and END optionally delimit a substring of STRING from which to read;\n\
1270 they default to 0 and (length STRING) respectively.")
1271 (string
, start
, end
)
1272 Lisp_Object string
, start
, end
;
1274 int startval
, endval
;
1277 CHECK_STRING (string
,0);
1280 endval
= XSTRING (string
)->size
;
1283 CHECK_NUMBER (end
, 2);
1284 endval
= XINT (end
);
1285 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1286 args_out_of_range (string
, end
);
1293 CHECK_NUMBER (start
, 1);
1294 startval
= XINT (start
);
1295 if (startval
< 0 || startval
> endval
)
1296 args_out_of_range (string
, start
);
1299 read_from_string_index
= startval
;
1300 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1301 read_from_string_limit
= endval
;
1303 new_backquote_flag
= 0;
1304 read_objects
= Qnil
;
1306 tem
= read0 (string
);
1307 return Fcons (tem
, make_number (read_from_string_index
));
1310 /* Use this for recursive reads, in contexts where internal tokens
1315 Lisp_Object readcharfun
;
1317 register Lisp_Object val
;
1320 val
= read1 (readcharfun
, &c
, 0);
1322 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1329 static int read_buffer_size
;
1330 static char *read_buffer
;
1332 /* Read multibyte form and return it as a character. C is a first
1333 byte of multibyte form, and rest of them are read from
1337 read_multibyte (c
, readcharfun
)
1339 Lisp_Object readcharfun
;
1341 /* We need the actual character code of this multibyte
1343 unsigned char str
[MAX_LENGTH_OF_MULTI_BYTE_FORM
];
1347 while ((c
= READCHAR
) >= 0xA0
1348 && len
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1351 return STRING_CHAR (str
, len
);
1354 /* Read a \-escape sequence, assuming we already read the `\'. */
1357 read_escape (readcharfun
, stringp
)
1358 Lisp_Object readcharfun
;
1361 register int c
= READCHAR
;
1365 error ("End of file");
1395 error ("Invalid escape character syntax");
1398 c
= read_escape (readcharfun
, 0);
1399 return c
| meta_modifier
;
1404 error ("Invalid escape character syntax");
1407 c
= read_escape (readcharfun
, 0);
1408 return c
| shift_modifier
;
1413 error ("Invalid escape character syntax");
1416 c
= read_escape (readcharfun
, 0);
1417 return c
| hyper_modifier
;
1422 error ("Invalid escape character syntax");
1425 c
= read_escape (readcharfun
, 0);
1426 return c
| alt_modifier
;
1431 error ("Invalid escape character syntax");
1434 c
= read_escape (readcharfun
, 0);
1435 return c
| super_modifier
;
1440 error ("Invalid escape character syntax");
1444 c
= read_escape (readcharfun
, 0);
1445 if ((c
& 0177) == '?')
1447 /* ASCII control chars are made from letters (both cases),
1448 as well as the non-letters within 0100...0137. */
1449 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1450 return (c
& (037 | ~0177));
1451 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1452 return (c
& (037 | ~0177));
1454 return c
| ctrl_modifier
;
1464 /* An octal escape, as in ANSI C. */
1466 register int i
= c
- '0';
1467 register int count
= 0;
1470 if ((c
= READCHAR
) >= '0' && c
<= '7')
1485 /* A hex escape, as in ANSI C. */
1491 if (c
>= '0' && c
<= '9')
1496 else if ((c
>= 'a' && c
<= 'f')
1497 || (c
>= 'A' && c
<= 'F'))
1500 if (c
>= 'a' && c
<= 'f')
1515 if (BASE_LEADING_CODE_P (c
))
1516 c
= read_multibyte (c
, readcharfun
);
1521 /* If the next token is ')' or ']' or '.', we store that character
1522 in *PCH and the return value is not interesting. Else, we store
1523 zero in *PCH and we read and return one lisp object.
1525 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1528 read1 (readcharfun
, pch
, first_in_list
)
1529 register Lisp_Object readcharfun
;
1534 int uninterned_symbol
= 0;
1541 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1546 return read_list (0, readcharfun
);
1549 return read_vector (readcharfun
, 0);
1566 tmp
= read_vector (readcharfun
, 0);
1567 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1568 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1569 error ("Invalid size char-table");
1570 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1571 XCHAR_TABLE (tmp
)->top
= Qt
;
1580 tmp
= read_vector (readcharfun
, 0);
1581 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1582 error ("Invalid size char-table");
1583 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1584 XCHAR_TABLE (tmp
)->top
= Qnil
;
1587 Fsignal (Qinvalid_read_syntax
,
1588 Fcons (make_string ("#^^", 3), Qnil
));
1590 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1595 length
= read1 (readcharfun
, pch
, first_in_list
);
1599 Lisp_Object tmp
, val
;
1600 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1604 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1605 if (size_in_chars
!= XSTRING (tmp
)->size
1606 /* We used to print 1 char too many
1607 when the number of bits was a multiple of 8.
1608 Accept such input in case it came from an old version. */
1609 && ! (XFASTINT (length
)
1610 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1611 Fsignal (Qinvalid_read_syntax
,
1612 Fcons (make_string ("#&...", 5), Qnil
));
1614 val
= Fmake_bool_vector (length
, Qnil
);
1615 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1617 /* Clear the extraneous bits in the last byte. */
1618 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1619 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1620 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1623 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1628 /* Accept compiled functions at read-time so that we don't have to
1629 build them using function calls. */
1631 tmp
= read_vector (readcharfun
, 1);
1632 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1633 XVECTOR (tmp
)->contents
);
1635 #ifdef USE_TEXT_PROPERTIES
1639 struct gcpro gcpro1
;
1642 /* Read the string itself. */
1643 tmp
= read1 (readcharfun
, &ch
, 0);
1644 if (ch
!= 0 || !STRINGP (tmp
))
1645 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1647 /* Read the intervals and their properties. */
1650 Lisp_Object beg
, end
, plist
;
1652 beg
= read1 (readcharfun
, &ch
, 0);
1656 end
= read1 (readcharfun
, &ch
, 0);
1658 plist
= read1 (readcharfun
, &ch
, 0);
1660 Fsignal (Qinvalid_read_syntax
,
1661 Fcons (build_string ("invalid string property list"),
1663 Fset_text_properties (beg
, end
, plist
, tmp
);
1669 /* #@NUMBER is used to skip NUMBER following characters.
1670 That's used in .elc files to skip over doc strings
1671 and function definitions. */
1676 /* Read a decimal integer. */
1677 while ((c
= READCHAR
) >= 0
1678 && c
>= '0' && c
<= '9')
1686 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1688 /* If we are supposed to force doc strings into core right now,
1689 record the last string that we skipped,
1690 and record where in the file it comes from. */
1692 /* But first exchange saved_doc_string
1693 with prev_saved_doc_string, so we save two strings. */
1695 char *temp
= saved_doc_string
;
1696 int temp_size
= saved_doc_string_size
;
1697 int temp_pos
= saved_doc_string_position
;
1698 int temp_len
= saved_doc_string_length
;
1700 saved_doc_string
= prev_saved_doc_string
;
1701 saved_doc_string_size
= prev_saved_doc_string_size
;
1702 saved_doc_string_position
= prev_saved_doc_string_position
;
1703 saved_doc_string_length
= prev_saved_doc_string_length
;
1705 prev_saved_doc_string
= temp
;
1706 prev_saved_doc_string_size
= temp_size
;
1707 prev_saved_doc_string_position
= temp_pos
;
1708 prev_saved_doc_string_length
= temp_len
;
1711 if (saved_doc_string_size
== 0)
1713 saved_doc_string_size
= nskip
+ 100;
1714 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1716 if (nskip
> saved_doc_string_size
)
1718 saved_doc_string_size
= nskip
+ 100;
1719 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1720 saved_doc_string_size
);
1723 saved_doc_string_position
= ftell (instream
);
1725 /* Copy that many characters into saved_doc_string. */
1726 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1727 saved_doc_string
[i
] = c
= READCHAR
;
1729 saved_doc_string_length
= i
;
1733 /* Skip that many characters. */
1734 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1741 return Vload_file_name
;
1743 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1744 /* #:foo is the uninterned symbol named foo. */
1747 uninterned_symbol
= 1;
1751 /* Reader forms that can reuse previously read objects. */
1752 if (c
>= '0' && c
<= '9')
1757 /* Read a non-negative integer. */
1758 while (c
>= '0' && c
<= '9')
1764 /* #n=object returns object, but associates it with n for #n#. */
1767 tem
= read0 (readcharfun
);
1768 read_objects
= Fcons (Fcons (make_number (n
), tem
), read_objects
);
1771 /* #n# returns a previously read object. */
1774 tem
= Fassq (make_number (n
), read_objects
);
1777 /* Fall through to error message. */
1779 /* Fall through to error message. */
1783 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1786 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1791 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1801 new_backquote_flag
= 1;
1802 value
= read0 (readcharfun
);
1803 new_backquote_flag
= 0;
1805 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1809 if (new_backquote_flag
)
1811 Lisp_Object comma_type
= Qnil
;
1816 comma_type
= Qcomma_at
;
1818 comma_type
= Qcomma_dot
;
1821 if (ch
>= 0) UNREAD (ch
);
1822 comma_type
= Qcomma
;
1825 new_backquote_flag
= 0;
1826 value
= read0 (readcharfun
);
1827 new_backquote_flag
= 1;
1828 return Fcons (comma_type
, Fcons (value
, Qnil
));
1835 register Lisp_Object val
;
1838 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1841 c
= read_escape (readcharfun
, 0);
1842 else if (BASE_LEADING_CODE_P (c
))
1843 c
= read_multibyte (c
, readcharfun
);
1845 return make_number (c
);
1850 register char *p
= read_buffer
;
1851 register char *end
= read_buffer
+ read_buffer_size
;
1853 /* Nonzero if we saw an escape sequence specifying
1854 a multibyte character. */
1855 int force_multibyte
= 0;
1856 /* Nonzero if we saw an escape sequence specifying
1857 a single-byte character. */
1858 int force_singlebyte
= 0;
1862 while ((c
= READCHAR
) >= 0
1865 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1867 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1868 p
+= new - read_buffer
;
1869 read_buffer
+= new - read_buffer
;
1870 end
= read_buffer
+ read_buffer_size
;
1875 c
= read_escape (readcharfun
, 1);
1877 /* C is -1 if \ newline has just been seen */
1880 if (p
== read_buffer
)
1885 /* If an escape specifies a non-ASCII single-byte character,
1886 this must be a unibyte string. */
1887 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
))
1888 && ! ASCII_BYTE_P (c
))
1889 force_singlebyte
= 1;
1892 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
)))
1894 unsigned char workbuf
[4];
1895 unsigned char *str
= workbuf
;
1898 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1900 force_multibyte
= 1;
1902 bcopy (str
, p
, length
);
1907 /* Allow `\C- ' and `\C-?'. */
1908 if (c
== (CHAR_CTL
| ' '))
1910 else if (c
== (CHAR_CTL
| '?'))
1914 /* Move the meta bit to the right place for a string. */
1915 c
= (c
& ~CHAR_META
) | 0x80;
1917 error ("Invalid modifier in string");
1922 return Fsignal (Qend_of_file
, Qnil
);
1924 /* If purifying, and string starts with \ newline,
1925 return zero instead. This is for doc strings
1926 that we are really going to find in etc/DOC.nn.nn */
1927 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1928 return make_number (0);
1930 if (force_multibyte
)
1931 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1932 else if (force_singlebyte
)
1933 nchars
= p
- read_buffer
;
1934 else if (load_convert_to_unibyte
)
1937 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1938 if (p
- read_buffer
!= nchars
)
1940 string
= make_multibyte_string (read_buffer
, nchars
,
1942 return Fstring_make_unibyte (string
);
1945 else if (EQ (readcharfun
, Qget_file_char
)
1946 || EQ (readcharfun
, Qlambda
))
1947 /* Nowadays, reading directly from a file
1948 is used only for compiled Emacs Lisp files,
1949 and those always use the Emacs internal encoding.
1950 Meanwhile, Qlambda is used for reading dynamic byte code
1951 (compiled with byte-compile-dynamic = t). */
1952 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1954 /* In all other cases, if we read these bytes as
1955 separate characters, treat them as separate characters now. */
1956 nchars
= p
- read_buffer
;
1959 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
1961 || (p
- read_buffer
!= nchars
)));
1962 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
1964 || (p
- read_buffer
!= nchars
)));
1969 #ifdef LISP_FLOAT_TYPE
1970 /* If a period is followed by a number, then we should read it
1971 as a floating point number. Otherwise, it denotes a dotted
1973 int next_char
= READCHAR
;
1976 if (! (next_char
>= '0' && next_char
<= '9'))
1983 /* Otherwise, we fall through! Note that the atom-reading loop
1984 below will now loop at least once, assuring that we will not
1985 try to UNREAD two characters in a row. */
1989 if (c
<= 040) goto retry
;
1991 register char *p
= read_buffer
;
1995 register char *end
= read_buffer
+ read_buffer_size
;
1998 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1999 || c
== '(' || c
== ')'
2000 #ifndef LISP_FLOAT_TYPE
2001 /* If we have floating-point support, then we need
2002 to allow <digits><dot><digits>. */
2004 #endif /* not LISP_FLOAT_TYPE */
2005 || c
== '[' || c
== ']' || c
== '#'
2008 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
2010 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2011 p
+= new - read_buffer
;
2012 read_buffer
+= new - read_buffer
;
2013 end
= read_buffer
+ read_buffer_size
;
2021 if (! SINGLE_BYTE_CHAR_P (c
))
2023 unsigned char workbuf
[4];
2024 unsigned char *str
= workbuf
;
2027 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
2029 bcopy (str
, p
, length
);
2040 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2041 p
+= new - read_buffer
;
2042 read_buffer
+= new - read_buffer
;
2043 /* end = read_buffer + read_buffer_size; */
2050 if (!quoted
&& !uninterned_symbol
)
2053 register Lisp_Object val
;
2055 if (*p1
== '+' || *p1
== '-') p1
++;
2056 /* Is it an integer? */
2059 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2060 #ifdef LISP_FLOAT_TYPE
2061 /* Integers can have trailing decimal points. */
2062 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2065 /* It is an integer. */
2067 #ifdef LISP_FLOAT_TYPE
2071 if (sizeof (int) == sizeof (EMACS_INT
))
2072 XSETINT (val
, atoi (read_buffer
));
2073 else if (sizeof (long) == sizeof (EMACS_INT
))
2074 XSETINT (val
, atol (read_buffer
));
2080 #ifdef LISP_FLOAT_TYPE
2081 if (isfloat_string (read_buffer
))
2084 double value
= atof (read_buffer
);
2085 if (read_buffer
[0] == '-' && value
== 0.0)
2087 /* The only way this can be true, after isfloat_string
2088 returns 1, is if the input ends in e+INF or e+NaN. */
2089 if (p
[-1] == 'F' || p
[-1] == 'N')
2092 value
= zero
/ zero
;
2093 else if (read_buffer
[0] == '-')
2094 value
= - 1.0 / zero
;
2098 return make_float (value
);
2103 if (uninterned_symbol
)
2104 return make_symbol (read_buffer
);
2106 return intern (read_buffer
);
2111 #ifdef LISP_FLOAT_TYPE
2128 if (*cp
== '+' || *cp
== '-')
2131 if (*cp
>= '0' && *cp
<= '9')
2134 while (*cp
>= '0' && *cp
<= '9')
2142 if (*cp
>= '0' && *cp
<= '9')
2145 while (*cp
>= '0' && *cp
<= '9')
2148 if (*cp
== 'e' || *cp
== 'E')
2152 if (*cp
== '+' || *cp
== '-')
2156 if (*cp
>= '0' && *cp
<= '9')
2159 while (*cp
>= '0' && *cp
<= '9')
2162 else if (cp
== start
)
2164 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2169 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2175 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2176 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2177 || state
== (DOT_CHAR
|TRAIL_INT
)
2178 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2179 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2180 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2182 #endif /* LISP_FLOAT_TYPE */
2185 read_vector (readcharfun
, bytecodeflag
)
2186 Lisp_Object readcharfun
;
2191 register Lisp_Object
*ptr
;
2192 register Lisp_Object tem
, item
, vector
;
2193 register struct Lisp_Cons
*otem
;
2196 tem
= read_list (1, readcharfun
);
2197 len
= Flength (tem
);
2198 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2200 size
= XVECTOR (vector
)->size
;
2201 ptr
= XVECTOR (vector
)->contents
;
2202 for (i
= 0; i
< size
; i
++)
2205 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2206 bytecode object, the docstring containing the bytecode and
2207 constants values must be treated as unibyte and passed to
2208 Fread, to get the actual bytecode string and constants vector. */
2209 if (bytecodeflag
&& load_force_doc_strings
)
2211 if (i
== COMPILED_BYTECODE
)
2213 if (!STRINGP (item
))
2214 error ("invalid byte code");
2216 /* Delay handling the bytecode slot until we know whether
2217 it is lazily-loaded (we can tell by whether the
2218 constants slot is nil). */
2219 ptr
[COMPILED_CONSTANTS
] = item
;
2222 else if (i
== COMPILED_CONSTANTS
)
2224 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2228 /* Coerce string to unibyte (like string-as-unibyte,
2229 but without generating extra garbage and
2230 guaranteeing no change in the contents). */
2231 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2232 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2234 item
= Fread (bytestr
);
2236 error ("invalid byte code");
2238 otem
= XCONS (item
);
2239 bytestr
= XCONS (item
)->car
;
2240 item
= XCONS (item
)->cdr
;
2244 /* Now handle the bytecode slot. */
2245 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2248 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2256 /* FLAG = 1 means check for ] to terminate rather than ) and .
2257 FLAG = -1 means check for starting with defun
2258 and make structure pure. */
2261 read_list (flag
, readcharfun
)
2263 register Lisp_Object readcharfun
;
2265 /* -1 means check next element for defun,
2266 0 means don't check,
2267 1 means already checked and found defun. */
2268 int defunflag
= flag
< 0 ? -1 : 0;
2269 Lisp_Object val
, tail
;
2270 register Lisp_Object elt
, tem
;
2271 struct gcpro gcpro1
, gcpro2
;
2272 /* 0 is the normal case.
2273 1 means this list is a doc reference; replace it with the number 0.
2274 2 means this list is a doc reference; replace it with the doc string. */
2275 int doc_reference
= 0;
2277 /* Initialize this to 1 if we are reading a list. */
2278 int first_in_list
= flag
<= 0;
2287 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2292 /* While building, if the list starts with #$, treat it specially. */
2293 if (EQ (elt
, Vload_file_name
)
2295 && !NILP (Vpurify_flag
))
2297 if (NILP (Vdoc_file_name
))
2298 /* We have not yet called Snarf-documentation, so assume
2299 this file is described in the DOC-MM.NN file
2300 and Snarf-documentation will fill in the right value later.
2301 For now, replace the whole list with 0. */
2304 /* We have already called Snarf-documentation, so make a relative
2305 file name for this file, so it can be found properly
2306 in the installed Lisp directory.
2307 We don't use Fexpand_file_name because that would make
2308 the directory absolute now. */
2309 elt
= concat2 (build_string ("../lisp/"),
2310 Ffile_name_nondirectory (elt
));
2312 else if (EQ (elt
, Vload_file_name
)
2314 && load_force_doc_strings
)
2323 Fsignal (Qinvalid_read_syntax
,
2324 Fcons (make_string (") or . in a vector", 18), Qnil
));
2332 XCONS (tail
)->cdr
= read0 (readcharfun
);
2334 val
= read0 (readcharfun
);
2335 read1 (readcharfun
, &ch
, 0);
2339 if (doc_reference
== 1)
2340 return make_number (0);
2341 if (doc_reference
== 2)
2343 /* Get a doc string from the file we are loading.
2344 If it's in saved_doc_string, get it from there. */
2345 int pos
= XINT (XCONS (val
)->cdr
);
2346 /* Position is negative for user variables. */
2347 if (pos
< 0) pos
= -pos
;
2348 if (pos
>= saved_doc_string_position
2349 && pos
< (saved_doc_string_position
2350 + saved_doc_string_length
))
2352 int start
= pos
- saved_doc_string_position
;
2355 /* Process quoting with ^A,
2356 and find the end of the string,
2357 which is marked with ^_ (037). */
2358 for (from
= start
, to
= start
;
2359 saved_doc_string
[from
] != 037;)
2361 int c
= saved_doc_string
[from
++];
2364 c
= saved_doc_string
[from
++];
2366 saved_doc_string
[to
++] = c
;
2368 saved_doc_string
[to
++] = 0;
2370 saved_doc_string
[to
++] = 037;
2373 saved_doc_string
[to
++] = c
;
2376 return make_string (saved_doc_string
+ start
,
2379 /* Look in prev_saved_doc_string the same way. */
2380 else if (pos
>= prev_saved_doc_string_position
2381 && pos
< (prev_saved_doc_string_position
2382 + prev_saved_doc_string_length
))
2384 int start
= pos
- prev_saved_doc_string_position
;
2387 /* Process quoting with ^A,
2388 and find the end of the string,
2389 which is marked with ^_ (037). */
2390 for (from
= start
, to
= start
;
2391 prev_saved_doc_string
[from
] != 037;)
2393 int c
= prev_saved_doc_string
[from
++];
2396 c
= prev_saved_doc_string
[from
++];
2398 prev_saved_doc_string
[to
++] = c
;
2400 prev_saved_doc_string
[to
++] = 0;
2402 prev_saved_doc_string
[to
++] = 037;
2405 prev_saved_doc_string
[to
++] = c
;
2408 return make_string (prev_saved_doc_string
+ start
,
2412 return get_doc_string (val
, 0, 0);
2417 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2419 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2421 tem
= (read_pure
&& flag
<= 0
2422 ? pure_cons (elt
, Qnil
)
2423 : Fcons (elt
, Qnil
));
2425 XCONS (tail
)->cdr
= tem
;
2430 defunflag
= EQ (elt
, Qdefun
);
2431 else if (defunflag
> 0)
2436 Lisp_Object Vobarray
;
2437 Lisp_Object initial_obarray
;
2439 /* oblookup stores the bucket number here, for the sake of Funintern. */
2441 int oblookup_last_bucket_number
;
2443 static int hash_string ();
2444 Lisp_Object
oblookup ();
2446 /* Get an error if OBARRAY is not an obarray.
2447 If it is one, return it. */
2450 check_obarray (obarray
)
2451 Lisp_Object obarray
;
2453 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2455 /* If Vobarray is now invalid, force it to be valid. */
2456 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2458 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2463 /* Intern the C string STR: return a symbol with that name,
2464 interned in the current obarray. */
2471 int len
= strlen (str
);
2472 Lisp_Object obarray
;
2475 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2476 obarray
= check_obarray (obarray
);
2477 tem
= oblookup (obarray
, str
, len
, len
);
2480 return Fintern (make_string (str
, len
), obarray
);
2483 /* Create an uninterned symbol with name STR. */
2489 int len
= strlen (str
);
2491 return Fmake_symbol ((!NILP (Vpurify_flag
)
2492 ? make_pure_string (str
, len
, len
, 0)
2493 : make_string (str
, len
)));
2496 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2497 "Return the canonical symbol whose name is STRING.\n\
2498 If there is none, one is created by this function and returned.\n\
2499 A second optional argument specifies the obarray to use;\n\
2500 it defaults to the value of `obarray'.")
2502 Lisp_Object string
, obarray
;
2504 register Lisp_Object tem
, sym
, *ptr
;
2506 if (NILP (obarray
)) obarray
= Vobarray
;
2507 obarray
= check_obarray (obarray
);
2509 CHECK_STRING (string
, 0);
2511 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2512 XSTRING (string
)->size
,
2513 STRING_BYTES (XSTRING (string
)));
2514 if (!INTEGERP (tem
))
2517 if (!NILP (Vpurify_flag
))
2518 string
= Fpurecopy (string
);
2519 sym
= Fmake_symbol (string
);
2520 XSYMBOL (sym
)->obarray
= obarray
;
2522 if ((XSTRING (string
)->data
[0] == ':')
2523 && EQ (obarray
, initial_obarray
))
2524 XSYMBOL (sym
)->value
= sym
;
2526 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2528 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2530 XSYMBOL (sym
)->next
= 0;
2535 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2536 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2537 A second optional argument specifies the obarray to use;\n\
2538 it defaults to the value of `obarray'.")
2540 Lisp_Object string
, obarray
;
2542 register Lisp_Object tem
;
2544 if (NILP (obarray
)) obarray
= Vobarray
;
2545 obarray
= check_obarray (obarray
);
2547 CHECK_STRING (string
, 0);
2549 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2550 XSTRING (string
)->size
,
2551 STRING_BYTES (XSTRING (string
)));
2552 if (!INTEGERP (tem
))
2557 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2558 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2559 The value is t if a symbol was found and deleted, nil otherwise.\n\
2560 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2561 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2562 OBARRAY defaults to the value of the variable `obarray'.")
2564 Lisp_Object name
, obarray
;
2566 register Lisp_Object string
, tem
;
2569 if (NILP (obarray
)) obarray
= Vobarray
;
2570 obarray
= check_obarray (obarray
);
2573 XSETSTRING (string
, XSYMBOL (name
)->name
);
2576 CHECK_STRING (name
, 0);
2580 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2581 XSTRING (string
)->size
,
2582 STRING_BYTES (XSTRING (string
)));
2585 /* If arg was a symbol, don't delete anything but that symbol itself. */
2586 if (SYMBOLP (name
) && !EQ (name
, tem
))
2589 XSYMBOL (tem
)->obarray
= Qnil
;
2591 hash
= oblookup_last_bucket_number
;
2593 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2595 if (XSYMBOL (tem
)->next
)
2596 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2598 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2602 Lisp_Object tail
, following
;
2604 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2605 XSYMBOL (tail
)->next
;
2608 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2609 if (EQ (following
, tem
))
2611 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2620 /* Return the symbol in OBARRAY whose names matches the string
2621 of SIZE characters (SIZE_BYTE bytes) at PTR.
2622 If there is no such symbol in OBARRAY, return nil.
2624 Also store the bucket number in oblookup_last_bucket_number. */
2627 oblookup (obarray
, ptr
, size
, size_byte
)
2628 Lisp_Object obarray
;
2630 int size
, size_byte
;
2634 register Lisp_Object tail
;
2635 Lisp_Object bucket
, tem
;
2637 if (!VECTORP (obarray
)
2638 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2640 obarray
= check_obarray (obarray
);
2641 obsize
= XVECTOR (obarray
)->size
;
2643 /* This is sometimes needed in the middle of GC. */
2644 obsize
&= ~ARRAY_MARK_FLAG
;
2645 /* Combining next two lines breaks VMS C 2.3. */
2646 hash
= hash_string (ptr
, size_byte
);
2648 bucket
= XVECTOR (obarray
)->contents
[hash
];
2649 oblookup_last_bucket_number
= hash
;
2650 if (XFASTINT (bucket
) == 0)
2652 else if (!SYMBOLP (bucket
))
2653 error ("Bad data in guts of obarray"); /* Like CADR error message */
2655 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2657 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2658 && XSYMBOL (tail
)->name
->size
== size
2659 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2661 else if (XSYMBOL (tail
)->next
== 0)
2664 XSETINT (tem
, hash
);
2669 hash_string (ptr
, len
)
2673 register unsigned char *p
= ptr
;
2674 register unsigned char *end
= p
+ len
;
2675 register unsigned char c
;
2676 register int hash
= 0;
2681 if (c
>= 0140) c
-= 40;
2682 hash
= ((hash
<<3) + (hash
>>28) + c
);
2684 return hash
& 07777777777;
2688 map_obarray (obarray
, fn
, arg
)
2689 Lisp_Object obarray
;
2690 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2694 register Lisp_Object tail
;
2695 CHECK_VECTOR (obarray
, 1);
2696 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2698 tail
= XVECTOR (obarray
)->contents
[i
];
2703 if (XSYMBOL (tail
)->next
== 0)
2705 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2711 mapatoms_1 (sym
, function
)
2712 Lisp_Object sym
, function
;
2714 call1 (function
, sym
);
2717 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2718 "Call FUNCTION on every symbol in OBARRAY.\n\
2719 OBARRAY defaults to the value of `obarray'.")
2721 Lisp_Object function
, obarray
;
2725 if (NILP (obarray
)) obarray
= Vobarray
;
2726 obarray
= check_obarray (obarray
);
2728 map_obarray (obarray
, mapatoms_1
, function
);
2732 #define OBARRAY_SIZE 1511
2737 Lisp_Object oblength
;
2741 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2743 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
2744 Vobarray
= Fmake_vector (oblength
, make_number (0));
2745 initial_obarray
= Vobarray
;
2746 staticpro (&initial_obarray
);
2747 /* Intern nil in the obarray */
2748 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2749 /* These locals are to kludge around a pyramid compiler bug. */
2750 hash
= hash_string ("nil", 3);
2751 /* Separate statement here to avoid VAXC bug. */
2752 hash
%= OBARRAY_SIZE
;
2753 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2756 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
2757 XSYMBOL (Qnil
)->function
= Qunbound
;
2758 XSYMBOL (Qunbound
)->value
= Qunbound
;
2759 XSYMBOL (Qunbound
)->function
= Qunbound
;
2762 XSYMBOL (Qnil
)->value
= Qnil
;
2763 XSYMBOL (Qnil
)->plist
= Qnil
;
2764 XSYMBOL (Qt
)->value
= Qt
;
2766 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2769 Qvariable_documentation
= intern ("variable-documentation");
2770 staticpro (&Qvariable_documentation
);
2772 read_buffer_size
= 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM
;
2773 read_buffer
= (char *) malloc (read_buffer_size
);
2778 struct Lisp_Subr
*sname
;
2781 sym
= intern (sname
->symbol_name
);
2782 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2785 #ifdef NOTDEF /* use fset in subr.el now */
2787 defalias (sname
, string
)
2788 struct Lisp_Subr
*sname
;
2792 sym
= intern (string
);
2793 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2797 /* Define an "integer variable"; a symbol whose value is forwarded
2798 to a C variable of type int. Sample call: */
2799 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2801 defvar_int (namestring
, address
)
2805 Lisp_Object sym
, val
;
2806 sym
= intern (namestring
);
2807 val
= allocate_misc ();
2808 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2809 XINTFWD (val
)->intvar
= address
;
2810 XSYMBOL (sym
)->value
= val
;
2813 /* Similar but define a variable whose value is T if address contains 1,
2814 NIL if address contains 0 */
2816 defvar_bool (namestring
, address
)
2820 Lisp_Object sym
, val
;
2821 sym
= intern (namestring
);
2822 val
= allocate_misc ();
2823 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2824 XBOOLFWD (val
)->boolvar
= address
;
2825 XSYMBOL (sym
)->value
= val
;
2828 /* Similar but define a variable whose value is the Lisp Object stored
2829 at address. Two versions: with and without gc-marking of the C
2830 variable. The nopro version is used when that variable will be
2831 gc-marked for some other reason, since marking the same slot twice
2832 can cause trouble with strings. */
2834 defvar_lisp_nopro (namestring
, address
)
2836 Lisp_Object
*address
;
2838 Lisp_Object sym
, val
;
2839 sym
= intern (namestring
);
2840 val
= allocate_misc ();
2841 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2842 XOBJFWD (val
)->objvar
= address
;
2843 XSYMBOL (sym
)->value
= val
;
2847 defvar_lisp (namestring
, address
)
2849 Lisp_Object
*address
;
2851 defvar_lisp_nopro (namestring
, address
);
2852 staticpro (address
);
2857 /* Similar but define a variable whose value is the Lisp Object stored in
2858 the current buffer. address is the address of the slot in the buffer
2859 that is current now. */
2862 defvar_per_buffer (namestring
, address
, type
, doc
)
2864 Lisp_Object
*address
;
2868 Lisp_Object sym
, val
;
2870 extern struct buffer buffer_local_symbols
;
2872 sym
= intern (namestring
);
2873 val
= allocate_misc ();
2874 offset
= (char *)address
- (char *)current_buffer
;
2876 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2877 XBUFFER_OBJFWD (val
)->offset
= offset
;
2878 XSYMBOL (sym
)->value
= val
;
2879 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2880 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2881 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2882 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2883 slot of buffer_local_flags */
2887 #endif /* standalone */
2889 /* Similar but define a variable whose value is the Lisp Object stored
2890 at a particular offset in the current kboard object. */
2893 defvar_kboard (namestring
, offset
)
2897 Lisp_Object sym
, val
;
2898 sym
= intern (namestring
);
2899 val
= allocate_misc ();
2900 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2901 XKBOARD_OBJFWD (val
)->offset
= offset
;
2902 XSYMBOL (sym
)->value
= val
;
2905 /* Record the value of load-path used at the start of dumping
2906 so we can see if the site changed it later during dumping. */
2907 static Lisp_Object dump_path
;
2913 int turn_off_warning
= 0;
2915 #ifdef HAVE_SETLOCALE
2916 /* Make sure numbers are parsed as we expect. */
2917 setlocale (LC_NUMERIC
, "C");
2918 #endif /* HAVE_SETLOCALE */
2920 /* Compute the default load-path. */
2922 normal
= PATH_LOADSEARCH
;
2923 Vload_path
= decode_env_path (0, normal
);
2925 if (NILP (Vpurify_flag
))
2926 normal
= PATH_LOADSEARCH
;
2928 normal
= PATH_DUMPLOADSEARCH
;
2930 /* In a dumped Emacs, we normally have to reset the value of
2931 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2932 uses ../lisp, instead of the path of the installed elisp
2933 libraries. However, if it appears that Vload_path was changed
2934 from the default before dumping, don't override that value. */
2937 if (! NILP (Fequal (dump_path
, Vload_path
)))
2939 Vload_path
= decode_env_path (0, normal
);
2940 if (!NILP (Vinstallation_directory
))
2942 /* Add to the path the lisp subdir of the
2943 installation dir, if it exists. */
2944 Lisp_Object tem
, tem1
;
2945 tem
= Fexpand_file_name (build_string ("lisp"),
2946 Vinstallation_directory
);
2947 tem1
= Ffile_exists_p (tem
);
2950 if (NILP (Fmember (tem
, Vload_path
)))
2952 turn_off_warning
= 1;
2953 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2957 /* That dir doesn't exist, so add the build-time
2958 Lisp dirs instead. */
2959 Vload_path
= nconc2 (Vload_path
, dump_path
);
2961 /* Add leim under the installation dir, if it exists. */
2962 tem
= Fexpand_file_name (build_string ("leim"),
2963 Vinstallation_directory
);
2964 tem1
= Ffile_exists_p (tem
);
2967 if (NILP (Fmember (tem
, Vload_path
)))
2968 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2971 /* Add site-list under the installation dir, if it exists. */
2972 tem
= Fexpand_file_name (build_string ("site-lisp"),
2973 Vinstallation_directory
);
2974 tem1
= Ffile_exists_p (tem
);
2977 if (NILP (Fmember (tem
, Vload_path
)))
2978 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2981 /* If Emacs was not built in the source directory,
2982 and it is run from where it was built, add to load-path
2983 the lisp, leim and site-lisp dirs under that directory. */
2985 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
2989 tem
= Fexpand_file_name (build_string ("src/Makefile"),
2990 Vinstallation_directory
);
2991 tem1
= Ffile_exists_p (tem
);
2993 /* Don't be fooled if they moved the entire source tree
2994 AFTER dumping Emacs. If the build directory is indeed
2995 different from the source dir, src/Makefile.in and
2996 src/Makefile will not be found together. */
2997 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
2998 Vinstallation_directory
);
2999 tem2
= Ffile_exists_p (tem
);
3000 if (!NILP (tem1
) && NILP (tem2
))
3002 tem
= Fexpand_file_name (build_string ("lisp"),
3005 if (NILP (Fmember (tem
, Vload_path
)))
3006 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3008 tem
= Fexpand_file_name (build_string ("leim"),
3011 if (NILP (Fmember (tem
, Vload_path
)))
3012 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3014 tem
= Fexpand_file_name (build_string ("site-lisp"),
3017 if (NILP (Fmember (tem
, Vload_path
)))
3018 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3026 /* NORMAL refers to the lisp dir in the source directory. */
3027 /* We used to add ../lisp at the front here, but
3028 that caused trouble because it was copied from dump_path
3029 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3030 It should be unnecessary. */
3031 Vload_path
= decode_env_path (0, normal
);
3032 dump_path
= Vload_path
;
3037 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3038 almost never correct, thereby causing a warning to be printed out that
3039 confuses users. Since PATH_LOADSEARCH is always overridden by the
3040 EMACSLOADPATH environment variable below, disable the warning on NT. */
3042 /* Warn if dirs in the *standard* path don't exist. */
3043 if (!turn_off_warning
)
3045 Lisp_Object path_tail
;
3047 for (path_tail
= Vload_path
;
3049 path_tail
= XCONS (path_tail
)->cdr
)
3051 Lisp_Object dirfile
;
3052 dirfile
= Fcar (path_tail
);
3053 if (STRINGP (dirfile
))
3055 dirfile
= Fdirectory_file_name (dirfile
);
3056 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3057 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3058 XCONS (path_tail
)->car
);
3062 #endif /* WINDOWSNT */
3064 /* If the EMACSLOADPATH environment variable is set, use its value.
3065 This doesn't apply if we're dumping. */
3067 if (NILP (Vpurify_flag
)
3068 && egetenv ("EMACSLOADPATH"))
3070 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3074 load_in_progress
= 0;
3075 Vload_file_name
= Qnil
;
3077 load_descriptor_list
= Qnil
;
3079 Vstandard_input
= Qt
;
3082 /* Print a warning, using format string FORMAT, that directory DIRNAME
3083 does not exist. Print it on stderr and put it in *Message*. */
3086 dir_warning (format
, dirname
)
3088 Lisp_Object dirname
;
3091 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3093 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3094 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3095 /* Don't log the warning before we've initialized!! */
3097 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3104 defsubr (&Sread_from_string
);
3106 defsubr (&Sintern_soft
);
3107 defsubr (&Sunintern
);
3109 defsubr (&Seval_buffer
);
3110 defsubr (&Seval_region
);
3111 defsubr (&Sread_char
);
3112 defsubr (&Sread_char_exclusive
);
3113 defsubr (&Sread_event
);
3114 defsubr (&Sget_file_char
);
3115 defsubr (&Smapatoms
);
3117 DEFVAR_LISP ("obarray", &Vobarray
,
3118 "Symbol table for use by `intern' and `read'.\n\
3119 It is a vector whose length ought to be prime for best results.\n\
3120 The vector's contents don't make sense if examined from Lisp programs;\n\
3121 to find all the symbols in an obarray, use `mapatoms'.");
3123 DEFVAR_LISP ("values", &Vvalues
,
3124 "List of values of all expressions which were read, evaluated and printed.\n\
3125 Order is reverse chronological.");
3127 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3128 "Stream for read to get input from.\n\
3129 See documentation of `read' for possible values.");
3130 Vstandard_input
= Qt
;
3132 DEFVAR_LISP ("load-path", &Vload_path
,
3133 "*List of directories to search for files to load.\n\
3134 Each element is a string (directory name) or nil (try default directory).\n\
3135 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3136 otherwise to default specified by file `paths.h' when Emacs was built.");
3138 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3139 "Non-nil iff inside of `load'.");
3141 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3142 "An alist of expressions to be evalled when particular files are loaded.\n\
3143 Each element looks like (FILENAME FORMS...).\n\
3144 When `load' is run and the file-name argument is FILENAME,\n\
3145 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3146 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3147 with no directory specified, since that is how `load' is normally called.\n\
3148 An error in FORMS does not undo the load,\n\
3149 but does prevent execution of the rest of the FORMS.");
3150 Vafter_load_alist
= Qnil
;
3152 DEFVAR_LISP ("load-history", &Vload_history
,
3153 "Alist mapping source file names to symbols and features.\n\
3154 Each alist element is a list that starts with a file name,\n\
3155 except for one element (optional) that starts with nil and describes\n\
3156 definitions evaluated from buffers not visiting files.\n\
3157 The remaining elements of each list are symbols defined as functions\n\
3158 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
3159 Vload_history
= Qnil
;
3161 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3162 "Full name of file being loaded by `load'.");
3163 Vload_file_name
= Qnil
;
3165 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3166 "Used for internal purposes by `load'.");
3167 Vcurrent_load_list
= Qnil
;
3169 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3170 "Function used by `load' and `eval-region' for reading expressions.\n\
3171 The default is nil, which means use the function `read'.");
3172 Vload_read_function
= Qnil
;
3174 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3175 "Function called in `load' for loading an Emacs lisp source file.\n\
3176 This function is for doing code conversion before reading the source file.\n\
3177 If nil, loading is done without any code conversion.\n\
3178 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3179 FULLNAME is the full name of FILE.\n\
3180 See `load' for the meaning of the remaining arguments.");
3181 Vload_source_file_function
= Qnil
;
3183 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3184 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3185 This is useful when the file being loaded is a temporary copy.");
3186 load_force_doc_strings
= 0;
3188 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3189 "Non-nil means `load' converts strings to unibyte whenever possible.\n\
3190 This is normally used in `load-with-code-conversion'\n\
3191 for loading non-compiled files.");
3192 load_convert_to_unibyte
= 0;
3194 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3195 "Directory in which Emacs sources were found when Emacs was built.\n\
3196 You cannot count on them to still be there!");
3198 = Fexpand_file_name (build_string ("../"),
3199 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3201 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3202 "List of files that were preloaded (when dumping Emacs).");
3203 Vpreloaded_file_list
= Qnil
;
3205 /* Vsource_directory was initialized in init_lread. */
3207 load_descriptor_list
= Qnil
;
3208 staticpro (&load_descriptor_list
);
3210 Qcurrent_load_list
= intern ("current-load-list");
3211 staticpro (&Qcurrent_load_list
);
3213 Qstandard_input
= intern ("standard-input");
3214 staticpro (&Qstandard_input
);
3216 Qread_char
= intern ("read-char");
3217 staticpro (&Qread_char
);
3219 Qget_file_char
= intern ("get-file-char");
3220 staticpro (&Qget_file_char
);
3222 Qbackquote
= intern ("`");
3223 staticpro (&Qbackquote
);
3224 Qcomma
= intern (",");
3225 staticpro (&Qcomma
);
3226 Qcomma_at
= intern (",@");
3227 staticpro (&Qcomma_at
);
3228 Qcomma_dot
= intern (",.");
3229 staticpro (&Qcomma_dot
);
3231 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3232 staticpro (&Qinhibit_file_name_operation
);
3234 Qascii_character
= intern ("ascii-character");
3235 staticpro (&Qascii_character
);
3237 Qfunction
= intern ("function");
3238 staticpro (&Qfunction
);
3240 Qload
= intern ("load");
3243 Qload_file_name
= intern ("load-file-name");
3244 staticpro (&Qload_file_name
);
3246 staticpro (&dump_path
);
3248 staticpro (&read_objects
);
3249 read_objects
= Qnil
;