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
++;
305 if (EQ (readcharfun
, Qget_file_char
))
309 /* Interrupted reads have been observed while reading over the network */
310 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
319 if (STRINGP (readcharfun
))
321 if (read_from_string_index
>= read_from_string_limit
)
323 else if (STRING_MULTIBYTE (readcharfun
))
324 FETCH_STRING_CHAR_ADVANCE (c
, readcharfun
,
325 read_from_string_index
,
326 read_from_string_index_byte
);
328 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
333 tem
= call0 (readcharfun
);
340 /* Unread the character C in the way appropriate for the stream READCHARFUN.
341 If the stream is a user function, call it with the char as argument. */
344 unreadchar (readcharfun
, c
)
345 Lisp_Object readcharfun
;
349 /* Don't back up the pointer if we're unreading the end-of-input mark,
350 since readchar didn't advance it when we read it. */
352 else if (BUFFERP (readcharfun
))
354 struct buffer
*b
= XBUFFER (readcharfun
);
355 int bytepos
= BUF_PT_BYTE (b
);
357 if (readchar_backlog
>= 0)
362 if (! NILP (b
->enable_multibyte_characters
))
363 BUF_DEC_POS (b
, bytepos
);
367 BUF_PT_BYTE (b
) = bytepos
;
370 else if (MARKERP (readcharfun
))
372 struct buffer
*b
= XMARKER (readcharfun
)->buffer
;
373 int bytepos
= XMARKER (readcharfun
)->bytepos
;
375 if (readchar_backlog
>= 0)
379 XMARKER (readcharfun
)->charpos
--;
380 if (! NILP (b
->enable_multibyte_characters
))
381 BUF_DEC_POS (b
, bytepos
);
385 XMARKER (readcharfun
)->bytepos
= bytepos
;
388 else if (STRINGP (readcharfun
))
390 read_from_string_index
--;
391 read_from_string_index_byte
392 = string_char_to_byte (readcharfun
, read_from_string_index
);
394 else if (EQ (readcharfun
, Qget_file_char
))
395 ungetc (c
, instream
);
397 call1 (readcharfun
, make_number (c
));
400 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
401 static int read_multibyte ();
403 /* Get a character from the tty. */
405 extern Lisp_Object
read_char ();
407 /* Read input events until we get one that's acceptable for our purposes.
409 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
410 until we get a character we like, and then stuffed into
413 If ASCII_REQUIRED is non-zero, we check function key events to see
414 if the unmodified version of the symbol has a Qascii_character
415 property, and use that character, if present.
417 If ERROR_NONASCII is non-zero, we signal an error if the input we
418 get isn't an ASCII character with modifiers. If it's zero but
419 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
423 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
424 int no_switch_frame
, ascii_required
, error_nonascii
;
427 return make_number (getchar ());
429 register Lisp_Object val
, delayed_switch_frame
;
431 delayed_switch_frame
= Qnil
;
433 /* Read until we get an acceptable event. */
435 val
= read_char (0, 0, 0, Qnil
, 0);
440 /* switch-frame events are put off until after the next ASCII
441 character. This is better than signaling an error just because
442 the last characters were typed to a separate minibuffer frame,
443 for example. Eventually, some code which can deal with
444 switch-frame events will read it and process it. */
446 && EVENT_HAS_PARAMETERS (val
)
447 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
449 delayed_switch_frame
= val
;
455 /* Convert certain symbols to their ASCII equivalents. */
458 Lisp_Object tem
, tem1
, tem2
;
459 tem
= Fget (val
, Qevent_symbol_element_mask
);
462 tem1
= Fget (Fcar (tem
), Qascii_character
);
463 /* Merge this symbol's modifier bits
464 with the ASCII equivalent of its basic code. */
466 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
470 /* If we don't have a character now, deal with it appropriately. */
475 Vunread_command_events
= Fcons (val
, Qnil
);
476 error ("Non-character input-event");
483 if (! NILP (delayed_switch_frame
))
484 unread_switch_frame
= delayed_switch_frame
;
490 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
491 "Read a character from the command input (keyboard or macro).\n\
492 It is returned as a number.\n\
493 If the user generates an event which is not a character (i.e. a mouse\n\
494 click or function key event), `read-char' signals an error. As an\n\
495 exception, switch-frame events are put off until non-ASCII events can\n\
497 If you want to read non-character events, or ignore them, call\n\
498 `read-event' or `read-char-exclusive' instead.")
501 return read_filtered_event (1, 1, 1);
504 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
505 "Read an event object from the input stream.")
508 return read_filtered_event (0, 0, 0);
511 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
512 "Read a character from the command input (keyboard or macro).\n\
513 It is returned as a number. Non-character events are ignored.")
516 return read_filtered_event (1, 1, 0);
519 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
520 "Don't use this yourself.")
523 register Lisp_Object val
;
524 XSETINT (val
, getc (instream
));
528 static void readevalloop ();
529 static Lisp_Object
load_unwind ();
530 static Lisp_Object
load_descriptor_unwind ();
532 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
533 "Execute a file of Lisp code named FILE.\n\
534 First try FILE with `.elc' appended, then try with `.el',\n\
535 then try FILE unmodified.\n\
536 This function searches the directories in `load-path'.\n\
537 If optional second arg NOERROR is non-nil,\n\
538 report no error if FILE doesn't exist.\n\
539 Print messages at start and end of loading unless\n\
540 optional third arg NOMESSAGE is non-nil.\n\
541 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
542 suffixes `.elc' or `.el' to the specified name FILE.\n\
543 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
544 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
545 it ends in one of those suffixes or includes a directory name.\n\
546 Return t if file exists.")
547 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
548 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
550 register FILE *stream
;
551 register int fd
= -1;
552 register Lisp_Object lispstream
;
553 int count
= specpdl_ptr
- specpdl
;
557 /* 1 means we printed the ".el is newer" message. */
559 /* 1 means we are loading a compiled file. */
567 CHECK_STRING (file
, 0);
569 /* If file name is magic, call the handler. */
570 handler
= Ffind_file_name_handler (file
, Qload
);
572 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
574 /* Do this after the handler to avoid
575 the need to gcpro noerror, nomessage and nosuffix.
576 (Below here, we care only whether they are nil or not.) */
577 file
= Fsubstitute_in_file_name (file
);
579 /* Avoid weird lossage with null string as arg,
580 since it would try to load a directory as a Lisp file */
581 if (XSTRING (file
)->size
> 0)
583 int size
= XSTRING (file
)->size
;
587 if (! NILP (must_suffix
))
589 /* Don't insist on adding a suffix if FILE already ends with one. */
591 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
594 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
596 /* Don't insist on adding a suffix
597 if the argument includes a directory name. */
598 else if (! NILP (Ffile_name_directory (file
)))
602 fd
= openp (Vload_path
, file
,
603 (!NILP (nosuffix
) ? ""
604 : ! NILP (must_suffix
) ? ".elc:.el"
614 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
615 Fcons (file
, Qnil
)));
620 /* If FD is 0, that means openp found a remote file. */
623 handler
= Ffind_file_name_handler (found
, Qload
);
624 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
627 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
638 stat ((char *)XSTRING (found
)->data
, &s1
);
639 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
640 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
641 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
643 /* Make the progress messages mention that source is newer. */
646 /* If we won't print another message, mention this anyway. */
647 if (! NILP (nomessage
))
648 message_with_string ("Source file `%s' newer than byte-compiled file",
651 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
655 /* We are loading a source file (*.el). */
656 if (!NILP (Vload_source_file_function
))
659 return call4 (Vload_source_file_function
, found
, file
,
660 NILP (noerror
) ? Qnil
: Qt
,
661 NILP (nomessage
) ? Qnil
: Qt
);
667 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
668 #else /* not WINDOWSNT */
669 stream
= fdopen (fd
, fmode
);
670 #endif /* not WINDOWSNT */
674 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
677 if (! NILP (Vpurify_flag
))
678 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
680 if (NILP (nomessage
))
683 message_with_string ("Loading %s (source)...", file
, 1);
685 message_with_string ("Loading %s (compiled; note, source file is newer)...",
687 else /* The typical case; compiled file newer than source file. */
688 message_with_string ("Loading %s...", file
, 1);
692 lispstream
= Fcons (Qnil
, Qnil
);
693 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
694 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
695 record_unwind_protect (load_unwind
, lispstream
);
696 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
697 specbind (Qload_file_name
, found
);
698 specbind (Qinhibit_file_name_operation
, Qnil
);
700 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
702 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
);
703 unbind_to (count
, Qnil
);
705 /* Run any load-hooks for this file. */
706 temp
= Fassoc (file
, Vafter_load_alist
);
708 Fprogn (Fcdr (temp
));
711 if (saved_doc_string
)
712 free (saved_doc_string
);
713 saved_doc_string
= 0;
714 saved_doc_string_size
= 0;
716 if (prev_saved_doc_string
)
717 free (prev_saved_doc_string
);
718 prev_saved_doc_string
= 0;
719 prev_saved_doc_string_size
= 0;
721 if (!noninteractive
&& NILP (nomessage
))
724 message_with_string ("Loading %s (source)...done", file
, 1);
726 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
728 else /* The typical case; compiled file newer than source file. */
729 message_with_string ("Loading %s...done", file
, 1);
735 load_unwind (stream
) /* used as unwind-protect function in load */
738 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
739 | XFASTINT (XCONS (stream
)->cdr
)));
740 if (--load_in_progress
< 0) load_in_progress
= 0;
745 load_descriptor_unwind (oldlist
)
748 load_descriptor_list
= oldlist
;
752 /* Close all descriptors in use for Floads.
753 This is used when starting a subprocess. */
760 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
761 close (XFASTINT (XCONS (tail
)->car
));
766 complete_filename_p (pathname
)
767 Lisp_Object pathname
;
769 register unsigned char *s
= XSTRING (pathname
)->data
;
770 return (IS_DIRECTORY_SEP (s
[0])
771 || (XSTRING (pathname
)->size
> 2
772 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
782 /* Search for a file whose name is STR, looking in directories
783 in the Lisp list PATH, and trying suffixes from SUFFIX.
784 SUFFIX is a string containing possible suffixes separated by colons.
785 On success, returns a file descriptor. On failure, returns -1.
787 EXEC_ONLY nonzero means don't open the files,
788 just look for one that is executable. In this case,
789 returns 1 on success.
791 If STOREPTR is nonzero, it points to a slot where the name of
792 the file actually found should be stored as a Lisp string.
793 nil is stored there on failure.
795 If the file we find is remote, return 0
796 but store the found remote file name in *STOREPTR.
797 We do not check for remote files if EXEC_ONLY is nonzero. */
800 openp (path
, str
, suffix
, storeptr
, exec_only
)
801 Lisp_Object path
, str
;
803 Lisp_Object
*storeptr
;
809 register char *fn
= buf
;
812 Lisp_Object filename
;
820 if (complete_filename_p (str
))
823 for (; !NILP (path
); path
= Fcdr (path
))
827 filename
= Fexpand_file_name (str
, Fcar (path
));
828 if (!complete_filename_p (filename
))
829 /* If there are non-absolute elts in PATH (eg ".") */
830 /* Of course, this could conceivably lose if luser sets
831 default-directory to be something non-absolute... */
833 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
834 if (!complete_filename_p (filename
))
835 /* Give up on this path element! */
839 /* Calculate maximum size of any filename made from
840 this path element/specified file name and any possible suffix. */
841 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
842 if (fn_size
< want_size
)
843 fn
= (char *) alloca (fn_size
= 100 + want_size
);
847 /* Loop over suffixes. */
850 char *esuffix
= (char *) index (nsuffix
, ':');
851 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
854 /* Concatenate path element/specified name with the suffix.
855 If the directory starts with /:, remove that. */
856 if (XSTRING (filename
)->size
> 2
857 && XSTRING (filename
)->data
[0] == '/'
858 && XSTRING (filename
)->data
[1] == ':')
860 strncpy (fn
, XSTRING (filename
)->data
+ 2,
861 XSTRING (filename
)->size
- 2);
862 fn
[XSTRING (filename
)->size
- 2] = 0;
866 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
867 fn
[XSTRING (filename
)->size
] = 0;
870 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
871 strncat (fn
, nsuffix
, lsuffix
);
873 /* Check that the file exists and is not a directory. */
877 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
878 if (! NILP (handler
) && ! exec_only
)
883 string
= build_string (fn
);
884 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
885 : Ffile_readable_p (string
));
887 && ! NILP (Ffile_directory_p (build_string (fn
))))
892 /* We succeeded; return this descriptor and filename. */
894 *storeptr
= build_string (fn
);
901 int exists
= (stat (fn
, &st
) >= 0
902 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
905 /* Check that we can access or open it. */
907 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
909 fd
= open (fn
, O_RDONLY
, 0);
913 /* We succeeded; return this descriptor and filename. */
915 *storeptr
= build_string (fn
);
922 /* Advance to next suffix. */
925 nsuffix
+= lsuffix
+ 1;
936 /* Merge the list we've accumulated of globals from the current input source
937 into the load_history variable. The details depend on whether
938 the source has an associated file name or not. */
941 build_load_history (stream
, source
)
945 register Lisp_Object tail
, prev
, newelt
;
946 register Lisp_Object tem
, tem2
;
947 register int foundit
, loading
;
949 /* Don't bother recording anything for preloaded files. */
950 if (!NILP (Vpurify_flag
))
953 loading
= stream
|| !NARROWED
;
955 tail
= Vload_history
;
962 /* Find the feature's previous assoc list... */
963 if (!NILP (Fequal (source
, Fcar (tem
))))
967 /* If we're loading, remove it. */
971 Vload_history
= Fcdr (tail
);
973 Fsetcdr (prev
, Fcdr (tail
));
976 /* Otherwise, cons on new symbols that are not already members. */
979 tem2
= Vcurrent_load_list
;
983 newelt
= Fcar (tem2
);
985 if (NILP (Fmemq (newelt
, tem
)))
986 Fsetcar (tail
, Fcons (Fcar (tem
),
987 Fcons (newelt
, Fcdr (tem
))));
1000 /* If we're loading, cons the new assoc onto the front of load-history,
1001 the most-recently-loaded position. Also do this if we didn't find
1002 an existing member for the current source. */
1003 if (loading
|| !foundit
)
1004 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1009 unreadpure () /* Used as unwind-protect function in readevalloop */
1016 readevalloop_1 (old
)
1019 load_convert_to_unibyte
= ! NILP (old
);
1023 /* UNIBYTE specifies how to set load_convert_to_unibyte
1024 for this invocation. */
1027 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
)
1028 Lisp_Object readcharfun
;
1030 Lisp_Object sourcename
;
1031 Lisp_Object (*evalfun
) ();
1033 Lisp_Object unibyte
;
1036 register Lisp_Object val
;
1037 int count
= specpdl_ptr
- specpdl
;
1038 struct gcpro gcpro1
;
1039 struct buffer
*b
= 0;
1041 if (BUFFERP (readcharfun
))
1042 b
= XBUFFER (readcharfun
);
1043 else if (MARKERP (readcharfun
))
1044 b
= XMARKER (readcharfun
)->buffer
;
1046 specbind (Qstandard_input
, readcharfun
);
1047 specbind (Qcurrent_load_list
, Qnil
);
1048 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1049 load_convert_to_unibyte
= !NILP (unibyte
);
1051 readchar_backlog
= -1;
1053 GCPRO1 (sourcename
);
1055 LOADHIST_ATTACH (sourcename
);
1059 if (b
!= 0 && NILP (b
->name
))
1060 error ("Reading from killed buffer");
1066 while ((c
= READCHAR
) != '\n' && c
!= -1);
1071 /* Ignore whitespace here, so we can detect eof. */
1072 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1075 if (!NILP (Vpurify_flag
) && c
== '(')
1077 int count1
= specpdl_ptr
- specpdl
;
1078 record_unwind_protect (unreadpure
, Qnil
);
1079 val
= read_list (-1, readcharfun
);
1080 unbind_to (count1
, Qnil
);
1085 read_objects
= Qnil
;
1086 if (NILP (Vload_read_function
))
1087 val
= read0 (readcharfun
);
1089 val
= call1 (Vload_read_function
, readcharfun
);
1092 val
= (*evalfun
) (val
);
1095 Vvalues
= Fcons (val
, Vvalues
);
1096 if (EQ (Vstandard_output
, Qt
))
1103 build_load_history (stream
, sourcename
);
1106 unbind_to (count
, Qnil
);
1111 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 4, "",
1112 "Execute the current buffer as Lisp code.\n\
1113 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1114 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1115 PRINTFLAG controls printing of output:\n\
1116 nil means discard it; anything else is stream for print.\n\
1118 If the optional third argument FILENAME is non-nil,\n\
1119 it specifies the file name to use for `load-history'.\n\
1121 This function preserves the position of point.")
1122 (buffer
, printflag
, filename
, unibyte
)
1123 Lisp_Object buffer
, printflag
, filename
, unibyte
;
1125 int count
= specpdl_ptr
- specpdl
;
1126 Lisp_Object tem
, buf
;
1129 buf
= Fcurrent_buffer ();
1131 buf
= Fget_buffer (buffer
);
1133 error ("No such buffer");
1135 if (NILP (printflag
))
1140 if (NILP (filename
))
1141 filename
= XBUFFER (buf
)->filename
;
1143 specbind (Qstandard_output
, tem
);
1144 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1145 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1146 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
);
1147 unbind_to (count
, Qnil
);
1153 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1154 "Execute the current buffer as Lisp code.\n\
1155 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1156 nil means discard it; anything else is stream for print.\n\
1158 If there is no error, point does not move. If there is an error,\n\
1159 point remains at the end of the last character read from the buffer.")
1161 Lisp_Object printflag
;
1163 int count
= specpdl_ptr
- specpdl
;
1164 Lisp_Object tem
, cbuf
;
1166 cbuf
= Fcurrent_buffer ()
1168 if (NILP (printflag
))
1172 specbind (Qstandard_output
, tem
);
1173 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1175 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1176 !NILP (printflag
), Qnil
);
1177 return unbind_to (count
, Qnil
);
1181 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
1182 "Execute the region as Lisp code.\n\
1183 When called from programs, expects two arguments,\n\
1184 giving starting and ending indices in the current buffer\n\
1185 of the text to be executed.\n\
1186 Programs can pass third argument PRINTFLAG which controls output:\n\
1187 nil means discard it; anything else is stream for printing it.\n\
1189 This function does not move point.")
1190 (start
, end
, printflag
)
1191 Lisp_Object start
, end
, printflag
;
1193 int count
= specpdl_ptr
- specpdl
;
1194 Lisp_Object tem
, cbuf
;
1196 cbuf
= Fcurrent_buffer ();
1198 if (NILP (printflag
))
1202 specbind (Qstandard_output
, tem
);
1204 if (NILP (printflag
))
1205 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1206 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1208 /* This both uses start and checks its type. */
1210 Fnarrow_to_region (make_number (BEGV
), end
);
1211 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1212 !NILP (printflag
), Qnil
);
1214 return unbind_to (count
, Qnil
);
1217 #endif /* standalone */
1219 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1220 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1221 If STREAM is nil, use the value of `standard-input' (which see).\n\
1222 STREAM or the value of `standard-input' may be:\n\
1223 a buffer (read from point and advance it)\n\
1224 a marker (read from where it points and advance it)\n\
1225 a function (call it with no arguments for each character,\n\
1226 call it with a char as argument to push a char back)\n\
1227 a string (takes text from string, starting at the beginning)\n\
1228 t (read text line using minibuffer and use it).")
1232 extern Lisp_Object
Fread_minibuffer ();
1235 stream
= Vstandard_input
;
1236 if (EQ (stream
, Qt
))
1237 stream
= Qread_char
;
1239 readchar_backlog
= -1;
1240 new_backquote_flag
= 0;
1241 read_objects
= Qnil
;
1244 if (EQ (stream
, Qread_char
))
1245 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1248 if (STRINGP (stream
))
1249 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1251 return read0 (stream
);
1254 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1255 "Read one Lisp expression which is represented as text by STRING.\n\
1256 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1257 START and END optionally delimit a substring of STRING from which to read;\n\
1258 they default to 0 and (length STRING) respectively.")
1259 (string
, start
, end
)
1260 Lisp_Object string
, start
, end
;
1262 int startval
, endval
;
1265 CHECK_STRING (string
,0);
1268 endval
= XSTRING (string
)->size
;
1271 CHECK_NUMBER (end
, 2);
1272 endval
= XINT (end
);
1273 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1274 args_out_of_range (string
, end
);
1281 CHECK_NUMBER (start
, 1);
1282 startval
= XINT (start
);
1283 if (startval
< 0 || startval
> endval
)
1284 args_out_of_range (string
, start
);
1287 read_from_string_index
= startval
;
1288 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1289 read_from_string_limit
= endval
;
1291 new_backquote_flag
= 0;
1292 read_objects
= Qnil
;
1294 tem
= read0 (string
);
1295 return Fcons (tem
, make_number (read_from_string_index
));
1298 /* Use this for recursive reads, in contexts where internal tokens
1303 Lisp_Object readcharfun
;
1305 register Lisp_Object val
;
1308 val
= read1 (readcharfun
, &c
, 0);
1310 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1317 static int read_buffer_size
;
1318 static char *read_buffer
;
1320 /* Read multibyte form and return it as a character. C is a first
1321 byte of multibyte form, and rest of them are read from
1325 read_multibyte (c
, readcharfun
)
1327 Lisp_Object readcharfun
;
1329 /* We need the actual character code of this multibyte
1331 unsigned char str
[MAX_LENGTH_OF_MULTI_BYTE_FORM
];
1335 while ((c
= READCHAR
) >= 0xA0
1336 && len
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1339 return STRING_CHAR (str
, len
);
1342 /* Read a \-escape sequence, assuming we already read the `\'. */
1345 read_escape (readcharfun
, stringp
)
1346 Lisp_Object readcharfun
;
1349 register int c
= READCHAR
;
1353 error ("End of file");
1383 error ("Invalid escape character syntax");
1386 c
= read_escape (readcharfun
, 0);
1387 return c
| meta_modifier
;
1392 error ("Invalid escape character syntax");
1395 c
= read_escape (readcharfun
, 0);
1396 return c
| shift_modifier
;
1401 error ("Invalid escape character syntax");
1404 c
= read_escape (readcharfun
, 0);
1405 return c
| hyper_modifier
;
1410 error ("Invalid escape character syntax");
1413 c
= read_escape (readcharfun
, 0);
1414 return c
| alt_modifier
;
1419 error ("Invalid escape character syntax");
1422 c
= read_escape (readcharfun
, 0);
1423 return c
| super_modifier
;
1428 error ("Invalid escape character syntax");
1432 c
= read_escape (readcharfun
, 0);
1433 if ((c
& 0177) == '?')
1435 /* ASCII control chars are made from letters (both cases),
1436 as well as the non-letters within 0100...0137. */
1437 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1438 return (c
& (037 | ~0177));
1439 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1440 return (c
& (037 | ~0177));
1442 return c
| ctrl_modifier
;
1452 /* An octal escape, as in ANSI C. */
1454 register int i
= c
- '0';
1455 register int count
= 0;
1458 if ((c
= READCHAR
) >= '0' && c
<= '7')
1473 /* A hex escape, as in ANSI C. */
1479 if (c
>= '0' && c
<= '9')
1484 else if ((c
>= 'a' && c
<= 'f')
1485 || (c
>= 'A' && c
<= 'F'))
1488 if (c
>= 'a' && c
<= 'f')
1503 if (BASE_LEADING_CODE_P (c
))
1504 c
= read_multibyte (c
, readcharfun
);
1509 /* If the next token is ')' or ']' or '.', we store that character
1510 in *PCH and the return value is not interesting. Else, we store
1511 zero in *PCH and we read and return one lisp object.
1513 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1516 read1 (readcharfun
, pch
, first_in_list
)
1517 register Lisp_Object readcharfun
;
1522 int uninterned_symbol
= 0;
1529 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1534 return read_list (0, readcharfun
);
1537 return read_vector (readcharfun
, 0);
1554 tmp
= read_vector (readcharfun
, 0);
1555 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1556 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1557 error ("Invalid size char-table");
1558 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1559 XCHAR_TABLE (tmp
)->top
= Qt
;
1568 tmp
= read_vector (readcharfun
, 0);
1569 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1570 error ("Invalid size char-table");
1571 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1572 XCHAR_TABLE (tmp
)->top
= Qnil
;
1575 Fsignal (Qinvalid_read_syntax
,
1576 Fcons (make_string ("#^^", 3), Qnil
));
1578 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1583 length
= read1 (readcharfun
, pch
, first_in_list
);
1587 Lisp_Object tmp
, val
;
1588 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1592 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1593 if (size_in_chars
!= XSTRING (tmp
)->size
1594 /* We used to print 1 char too many
1595 when the number of bits was a multiple of 8.
1596 Accept such input in case it came from an old version. */
1597 && ! (XFASTINT (length
)
1598 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1599 Fsignal (Qinvalid_read_syntax
,
1600 Fcons (make_string ("#&...", 5), Qnil
));
1602 val
= Fmake_bool_vector (length
, Qnil
);
1603 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1605 /* Clear the extraneous bits in the last byte. */
1606 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1607 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1608 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1611 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1616 /* Accept compiled functions at read-time so that we don't have to
1617 build them using function calls. */
1619 tmp
= read_vector (readcharfun
, 1);
1620 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1621 XVECTOR (tmp
)->contents
);
1623 #ifdef USE_TEXT_PROPERTIES
1627 struct gcpro gcpro1
;
1630 /* Read the string itself. */
1631 tmp
= read1 (readcharfun
, &ch
, 0);
1632 if (ch
!= 0 || !STRINGP (tmp
))
1633 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1635 /* Read the intervals and their properties. */
1638 Lisp_Object beg
, end
, plist
;
1640 beg
= read1 (readcharfun
, &ch
, 0);
1644 end
= read1 (readcharfun
, &ch
, 0);
1646 plist
= read1 (readcharfun
, &ch
, 0);
1648 Fsignal (Qinvalid_read_syntax
,
1649 Fcons (build_string ("invalid string property list"),
1651 Fset_text_properties (beg
, end
, plist
, tmp
);
1657 /* #@NUMBER is used to skip NUMBER following characters.
1658 That's used in .elc files to skip over doc strings
1659 and function definitions. */
1664 /* Read a decimal integer. */
1665 while ((c
= READCHAR
) >= 0
1666 && c
>= '0' && c
<= '9')
1674 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1676 /* If we are supposed to force doc strings into core right now,
1677 record the last string that we skipped,
1678 and record where in the file it comes from. */
1680 /* But first exchange saved_doc_string
1681 with prev_saved_doc_string, so we save two strings. */
1683 char *temp
= saved_doc_string
;
1684 int temp_size
= saved_doc_string_size
;
1685 int temp_pos
= saved_doc_string_position
;
1686 int temp_len
= saved_doc_string_length
;
1688 saved_doc_string
= prev_saved_doc_string
;
1689 saved_doc_string_size
= prev_saved_doc_string_size
;
1690 saved_doc_string_position
= prev_saved_doc_string_position
;
1691 saved_doc_string_length
= prev_saved_doc_string_length
;
1693 prev_saved_doc_string
= temp
;
1694 prev_saved_doc_string_size
= temp_size
;
1695 prev_saved_doc_string_position
= temp_pos
;
1696 prev_saved_doc_string_length
= temp_len
;
1699 if (saved_doc_string_size
== 0)
1701 saved_doc_string_size
= nskip
+ 100;
1702 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1704 if (nskip
> saved_doc_string_size
)
1706 saved_doc_string_size
= nskip
+ 100;
1707 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1708 saved_doc_string_size
);
1711 saved_doc_string_position
= ftell (instream
);
1713 /* Copy that many characters into saved_doc_string. */
1714 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1715 saved_doc_string
[i
] = c
= READCHAR
;
1717 saved_doc_string_length
= i
;
1721 /* Skip that many characters. */
1722 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1729 return Vload_file_name
;
1731 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1732 /* #:foo is the uninterned symbol named foo. */
1735 uninterned_symbol
= 1;
1739 /* Reader forms that can reuse previously read objects. */
1740 if (c
>= '0' && c
<= '9')
1745 /* Read a non-negative integer. */
1746 while (c
>= '0' && c
<= '9')
1752 /* #n=object returns object, but associates it with n for #n#. */
1755 tem
= read0 (readcharfun
);
1756 read_objects
= Fcons (Fcons (make_number (n
), tem
), read_objects
);
1759 /* #n# returns a previously read object. */
1762 tem
= Fassq (make_number (n
), read_objects
);
1765 /* Fall through to error message. */
1767 /* Fall through to error message. */
1771 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1774 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1779 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1789 new_backquote_flag
= 1;
1790 value
= read0 (readcharfun
);
1791 new_backquote_flag
= 0;
1793 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1797 if (new_backquote_flag
)
1799 Lisp_Object comma_type
= Qnil
;
1804 comma_type
= Qcomma_at
;
1806 comma_type
= Qcomma_dot
;
1809 if (ch
>= 0) UNREAD (ch
);
1810 comma_type
= Qcomma
;
1813 new_backquote_flag
= 0;
1814 value
= read0 (readcharfun
);
1815 new_backquote_flag
= 1;
1816 return Fcons (comma_type
, Fcons (value
, Qnil
));
1823 register Lisp_Object val
;
1826 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1829 c
= read_escape (readcharfun
, 0);
1830 else if (BASE_LEADING_CODE_P (c
))
1831 c
= read_multibyte (c
, readcharfun
);
1833 return make_number (c
);
1838 register char *p
= read_buffer
;
1839 register char *end
= read_buffer
+ read_buffer_size
;
1841 /* Nonzero if we saw an escape sequence specifying
1842 a multibyte character. */
1843 int force_multibyte
= 0;
1844 /* Nonzero if we saw an escape sequence specifying
1845 a single-byte character. */
1846 int force_singlebyte
= 0;
1850 while ((c
= READCHAR
) >= 0
1853 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1855 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1856 p
+= new - read_buffer
;
1857 read_buffer
+= new - read_buffer
;
1858 end
= read_buffer
+ read_buffer_size
;
1863 c
= read_escape (readcharfun
, 1);
1865 /* C is -1 if \ newline has just been seen */
1868 if (p
== read_buffer
)
1873 /* If an escape specifies a non-ASCII single-byte character,
1874 this must be a unibyte string. */
1875 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
))
1876 && ! ASCII_BYTE_P (c
))
1877 force_singlebyte
= 1;
1880 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
)))
1882 unsigned char workbuf
[4];
1883 unsigned char *str
= workbuf
;
1886 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1888 force_multibyte
= 1;
1890 bcopy (str
, p
, length
);
1895 /* Allow `\C- ' and `\C-?'. */
1896 if (c
== (CHAR_CTL
| ' '))
1898 else if (c
== (CHAR_CTL
| '?'))
1902 /* Move the meta bit to the right place for a string. */
1903 c
= (c
& ~CHAR_META
) | 0x80;
1905 error ("Invalid modifier in string");
1910 return Fsignal (Qend_of_file
, Qnil
);
1912 /* If purifying, and string starts with \ newline,
1913 return zero instead. This is for doc strings
1914 that we are really going to find in etc/DOC.nn.nn */
1915 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1916 return make_number (0);
1918 if (force_multibyte
)
1919 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1920 else if (force_singlebyte
)
1921 nchars
= p
- read_buffer
;
1922 else if (load_convert_to_unibyte
)
1925 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1926 if (p
- read_buffer
!= nchars
)
1928 string
= make_multibyte_string (read_buffer
, nchars
,
1930 return Fstring_make_unibyte (string
);
1933 else if (EQ (readcharfun
, Qget_file_char
))
1934 /* Nowadays, reading directly from a file
1935 is used only for compiled Emacs Lisp files,
1936 and those always use the Emacs internal encoding. */
1937 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1939 /* In all other cases, if we read these bytes as
1940 separate characters, treat them as separate characters now. */
1941 nchars
= p
- read_buffer
;
1944 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
1946 || (p
- read_buffer
!= nchars
)));
1947 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
1949 || (p
- read_buffer
!= nchars
)));
1954 #ifdef LISP_FLOAT_TYPE
1955 /* If a period is followed by a number, then we should read it
1956 as a floating point number. Otherwise, it denotes a dotted
1958 int next_char
= READCHAR
;
1961 if (! (next_char
>= '0' && next_char
<= '9'))
1968 /* Otherwise, we fall through! Note that the atom-reading loop
1969 below will now loop at least once, assuring that we will not
1970 try to UNREAD two characters in a row. */
1974 if (c
<= 040) goto retry
;
1976 register char *p
= read_buffer
;
1980 register char *end
= read_buffer
+ read_buffer_size
;
1983 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1984 || c
== '(' || c
== ')'
1985 #ifndef LISP_FLOAT_TYPE
1986 /* If we have floating-point support, then we need
1987 to allow <digits><dot><digits>. */
1989 #endif /* not LISP_FLOAT_TYPE */
1990 || c
== '[' || c
== ']' || c
== '#'
1993 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1995 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1996 p
+= new - read_buffer
;
1997 read_buffer
+= new - read_buffer
;
1998 end
= read_buffer
+ read_buffer_size
;
2006 if (! SINGLE_BYTE_CHAR_P (c
))
2008 unsigned char workbuf
[4];
2009 unsigned char *str
= workbuf
;
2012 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
2014 bcopy (str
, p
, length
);
2025 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2026 p
+= new - read_buffer
;
2027 read_buffer
+= new - read_buffer
;
2028 /* end = read_buffer + read_buffer_size; */
2035 if (!quoted
&& !uninterned_symbol
)
2038 register Lisp_Object val
;
2040 if (*p1
== '+' || *p1
== '-') p1
++;
2041 /* Is it an integer? */
2044 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2045 #ifdef LISP_FLOAT_TYPE
2046 /* Integers can have trailing decimal points. */
2047 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2050 /* It is an integer. */
2052 #ifdef LISP_FLOAT_TYPE
2056 if (sizeof (int) == sizeof (EMACS_INT
))
2057 XSETINT (val
, atoi (read_buffer
));
2058 else if (sizeof (long) == sizeof (EMACS_INT
))
2059 XSETINT (val
, atol (read_buffer
));
2065 #ifdef LISP_FLOAT_TYPE
2066 if (isfloat_string (read_buffer
))
2069 double value
= atof (read_buffer
);
2070 if (read_buffer
[0] == '-' && value
== 0.0)
2072 /* The only way this can be true, after isfloat_string
2073 returns 1, is if the input ends in e+INF or e+NaN. */
2074 if (p
[-1] == 'F' || p
[-1] == 'N')
2077 value
= zero
/ zero
;
2078 else if (read_buffer
[0] == '-')
2079 value
= - 1.0 / zero
;
2083 return make_float (value
);
2088 if (uninterned_symbol
)
2089 return make_symbol (read_buffer
);
2091 return intern (read_buffer
);
2096 #ifdef LISP_FLOAT_TYPE
2113 if (*cp
== '+' || *cp
== '-')
2116 if (*cp
>= '0' && *cp
<= '9')
2119 while (*cp
>= '0' && *cp
<= '9')
2127 if (*cp
>= '0' && *cp
<= '9')
2130 while (*cp
>= '0' && *cp
<= '9')
2133 if (*cp
== 'e' || *cp
== 'E')
2137 if (*cp
== '+' || *cp
== '-')
2141 if (*cp
>= '0' && *cp
<= '9')
2144 while (*cp
>= '0' && *cp
<= '9')
2147 else if (cp
== start
)
2149 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2154 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2160 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2161 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2162 || state
== (DOT_CHAR
|TRAIL_INT
)
2163 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2164 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2165 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2167 #endif /* LISP_FLOAT_TYPE */
2170 read_vector (readcharfun
, bytecodeflag
)
2171 Lisp_Object readcharfun
;
2176 register Lisp_Object
*ptr
;
2177 register Lisp_Object tem
, item
, vector
;
2178 register struct Lisp_Cons
*otem
;
2181 tem
= read_list (1, readcharfun
);
2182 len
= Flength (tem
);
2183 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2185 size
= XVECTOR (vector
)->size
;
2186 ptr
= XVECTOR (vector
)->contents
;
2187 for (i
= 0; i
< size
; i
++)
2190 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2191 bytecode object, the docstring containing the bytecode and
2192 constants values must be treated as unibyte and passed to
2193 Fread, to get the actual bytecode string and constants vector. */
2194 if (bytecodeflag
&& load_force_doc_strings
)
2196 if (i
== COMPILED_BYTECODE
)
2198 if (!STRINGP (item
))
2199 error ("invalid byte code");
2201 /* Delay handling the bytecode slot until we know whether
2202 it is lazily-loaded (we can tell by whether the
2203 constants slot is nil). */
2204 ptr
[COMPILED_CONSTANTS
] = item
;
2207 else if (i
== COMPILED_CONSTANTS
)
2209 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2213 /* Coerce string to unibyte (like string-as-unibyte,
2214 but without generating extra garbage and
2215 guaranteeing no change in the contents). */
2216 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2217 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2219 item
= Fread (bytestr
);
2221 error ("invalid byte code");
2223 otem
= XCONS (item
);
2224 bytestr
= XCONS (item
)->car
;
2225 item
= XCONS (item
)->cdr
;
2229 /* Now handle the bytecode slot. */
2230 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2233 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2241 /* FLAG = 1 means check for ] to terminate rather than ) and .
2242 FLAG = -1 means check for starting with defun
2243 and make structure pure. */
2246 read_list (flag
, readcharfun
)
2248 register Lisp_Object readcharfun
;
2250 /* -1 means check next element for defun,
2251 0 means don't check,
2252 1 means already checked and found defun. */
2253 int defunflag
= flag
< 0 ? -1 : 0;
2254 Lisp_Object val
, tail
;
2255 register Lisp_Object elt
, tem
;
2256 struct gcpro gcpro1
, gcpro2
;
2257 /* 0 is the normal case.
2258 1 means this list is a doc reference; replace it with the number 0.
2259 2 means this list is a doc reference; replace it with the doc string. */
2260 int doc_reference
= 0;
2262 /* Initialize this to 1 if we are reading a list. */
2263 int first_in_list
= flag
<= 0;
2272 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2277 /* While building, if the list starts with #$, treat it specially. */
2278 if (EQ (elt
, Vload_file_name
)
2280 && !NILP (Vpurify_flag
))
2282 if (NILP (Vdoc_file_name
))
2283 /* We have not yet called Snarf-documentation, so assume
2284 this file is described in the DOC-MM.NN file
2285 and Snarf-documentation will fill in the right value later.
2286 For now, replace the whole list with 0. */
2289 /* We have already called Snarf-documentation, so make a relative
2290 file name for this file, so it can be found properly
2291 in the installed Lisp directory.
2292 We don't use Fexpand_file_name because that would make
2293 the directory absolute now. */
2294 elt
= concat2 (build_string ("../lisp/"),
2295 Ffile_name_nondirectory (elt
));
2297 else if (EQ (elt
, Vload_file_name
)
2299 && load_force_doc_strings
)
2308 Fsignal (Qinvalid_read_syntax
,
2309 Fcons (make_string (") or . in a vector", 18), Qnil
));
2317 XCONS (tail
)->cdr
= read0 (readcharfun
);
2319 val
= read0 (readcharfun
);
2320 read1 (readcharfun
, &ch
, 0);
2324 if (doc_reference
== 1)
2325 return make_number (0);
2326 if (doc_reference
== 2)
2328 /* Get a doc string from the file we are loading.
2329 If it's in saved_doc_string, get it from there. */
2330 int pos
= XINT (XCONS (val
)->cdr
);
2331 /* Position is negative for user variables. */
2332 if (pos
< 0) pos
= -pos
;
2333 if (pos
>= saved_doc_string_position
2334 && pos
< (saved_doc_string_position
2335 + saved_doc_string_length
))
2337 int start
= pos
- saved_doc_string_position
;
2340 /* Process quoting with ^A,
2341 and find the end of the string,
2342 which is marked with ^_ (037). */
2343 for (from
= start
, to
= start
;
2344 saved_doc_string
[from
] != 037;)
2346 int c
= saved_doc_string
[from
++];
2349 c
= saved_doc_string
[from
++];
2351 saved_doc_string
[to
++] = c
;
2353 saved_doc_string
[to
++] = 0;
2355 saved_doc_string
[to
++] = 037;
2358 saved_doc_string
[to
++] = c
;
2361 return make_string (saved_doc_string
+ start
,
2364 /* Look in prev_saved_doc_string the same way. */
2365 else if (pos
>= prev_saved_doc_string_position
2366 && pos
< (prev_saved_doc_string_position
2367 + prev_saved_doc_string_length
))
2369 int start
= pos
- prev_saved_doc_string_position
;
2372 /* Process quoting with ^A,
2373 and find the end of the string,
2374 which is marked with ^_ (037). */
2375 for (from
= start
, to
= start
;
2376 prev_saved_doc_string
[from
] != 037;)
2378 int c
= prev_saved_doc_string
[from
++];
2381 c
= prev_saved_doc_string
[from
++];
2383 prev_saved_doc_string
[to
++] = c
;
2385 prev_saved_doc_string
[to
++] = 0;
2387 prev_saved_doc_string
[to
++] = 037;
2390 prev_saved_doc_string
[to
++] = c
;
2393 return make_string (prev_saved_doc_string
+ start
,
2397 return get_doc_string (val
, 0);
2402 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2404 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2406 tem
= (read_pure
&& flag
<= 0
2407 ? pure_cons (elt
, Qnil
)
2408 : Fcons (elt
, Qnil
));
2410 XCONS (tail
)->cdr
= tem
;
2415 defunflag
= EQ (elt
, Qdefun
);
2416 else if (defunflag
> 0)
2421 Lisp_Object Vobarray
;
2422 Lisp_Object initial_obarray
;
2424 /* oblookup stores the bucket number here, for the sake of Funintern. */
2426 int oblookup_last_bucket_number
;
2428 static int hash_string ();
2429 Lisp_Object
oblookup ();
2431 /* Get an error if OBARRAY is not an obarray.
2432 If it is one, return it. */
2435 check_obarray (obarray
)
2436 Lisp_Object obarray
;
2438 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2440 /* If Vobarray is now invalid, force it to be valid. */
2441 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2443 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2448 /* Intern the C string STR: return a symbol with that name,
2449 interned in the current obarray. */
2456 int len
= strlen (str
);
2457 Lisp_Object obarray
;
2460 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2461 obarray
= check_obarray (obarray
);
2462 tem
= oblookup (obarray
, str
, len
, len
);
2465 return Fintern (make_string (str
, len
), obarray
);
2468 /* Create an uninterned symbol with name STR. */
2474 int len
= strlen (str
);
2476 return Fmake_symbol ((!NILP (Vpurify_flag
)
2477 ? make_pure_string (str
, len
, len
, 0)
2478 : make_string (str
, len
)));
2481 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2482 "Return the canonical symbol whose name is STRING.\n\
2483 If there is none, one is created by this function and returned.\n\
2484 A second optional argument specifies the obarray to use;\n\
2485 it defaults to the value of `obarray'.")
2487 Lisp_Object string
, obarray
;
2489 register Lisp_Object tem
, sym
, *ptr
;
2491 if (NILP (obarray
)) obarray
= Vobarray
;
2492 obarray
= check_obarray (obarray
);
2494 CHECK_STRING (string
, 0);
2496 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2497 XSTRING (string
)->size
,
2498 STRING_BYTES (XSTRING (string
)));
2499 if (!INTEGERP (tem
))
2502 if (!NILP (Vpurify_flag
))
2503 string
= Fpurecopy (string
);
2504 sym
= Fmake_symbol (string
);
2505 XSYMBOL (sym
)->obarray
= obarray
;
2507 if ((XSTRING (string
)->data
[0] == ':')
2508 && EQ (obarray
, initial_obarray
))
2509 XSYMBOL (sym
)->value
= sym
;
2511 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2513 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2515 XSYMBOL (sym
)->next
= 0;
2520 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2521 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2522 A second optional argument specifies the obarray to use;\n\
2523 it defaults to the value of `obarray'.")
2525 Lisp_Object string
, obarray
;
2527 register Lisp_Object tem
;
2529 if (NILP (obarray
)) obarray
= Vobarray
;
2530 obarray
= check_obarray (obarray
);
2532 CHECK_STRING (string
, 0);
2534 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2535 XSTRING (string
)->size
,
2536 STRING_BYTES (XSTRING (string
)));
2537 if (!INTEGERP (tem
))
2542 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2543 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2544 The value is t if a symbol was found and deleted, nil otherwise.\n\
2545 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2546 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2547 OBARRAY defaults to the value of the variable `obarray'.")
2549 Lisp_Object name
, obarray
;
2551 register Lisp_Object string
, tem
;
2554 if (NILP (obarray
)) obarray
= Vobarray
;
2555 obarray
= check_obarray (obarray
);
2558 XSETSTRING (string
, XSYMBOL (name
)->name
);
2561 CHECK_STRING (name
, 0);
2565 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2566 XSTRING (string
)->size
,
2567 STRING_BYTES (XSTRING (string
)));
2570 /* If arg was a symbol, don't delete anything but that symbol itself. */
2571 if (SYMBOLP (name
) && !EQ (name
, tem
))
2574 XSYMBOL (tem
)->obarray
= Qnil
;
2576 hash
= oblookup_last_bucket_number
;
2578 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2580 if (XSYMBOL (tem
)->next
)
2581 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2583 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2587 Lisp_Object tail
, following
;
2589 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2590 XSYMBOL (tail
)->next
;
2593 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2594 if (EQ (following
, tem
))
2596 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2605 /* Return the symbol in OBARRAY whose names matches the string
2606 of SIZE characters (SIZE_BYTE bytes) at PTR.
2607 If there is no such symbol in OBARRAY, return nil.
2609 Also store the bucket number in oblookup_last_bucket_number. */
2612 oblookup (obarray
, ptr
, size
, size_byte
)
2613 Lisp_Object obarray
;
2615 int size
, size_byte
;
2619 register Lisp_Object tail
;
2620 Lisp_Object bucket
, tem
;
2622 if (!VECTORP (obarray
)
2623 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2625 obarray
= check_obarray (obarray
);
2626 obsize
= XVECTOR (obarray
)->size
;
2628 /* This is sometimes needed in the middle of GC. */
2629 obsize
&= ~ARRAY_MARK_FLAG
;
2630 /* Combining next two lines breaks VMS C 2.3. */
2631 hash
= hash_string (ptr
, size_byte
);
2633 bucket
= XVECTOR (obarray
)->contents
[hash
];
2634 oblookup_last_bucket_number
= hash
;
2635 if (XFASTINT (bucket
) == 0)
2637 else if (!SYMBOLP (bucket
))
2638 error ("Bad data in guts of obarray"); /* Like CADR error message */
2640 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2642 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2643 && XSYMBOL (tail
)->name
->size
== size
2644 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2646 else if (XSYMBOL (tail
)->next
== 0)
2649 XSETINT (tem
, hash
);
2654 hash_string (ptr
, len
)
2658 register unsigned char *p
= ptr
;
2659 register unsigned char *end
= p
+ len
;
2660 register unsigned char c
;
2661 register int hash
= 0;
2666 if (c
>= 0140) c
-= 40;
2667 hash
= ((hash
<<3) + (hash
>>28) + c
);
2669 return hash
& 07777777777;
2673 map_obarray (obarray
, fn
, arg
)
2674 Lisp_Object obarray
;
2675 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2679 register Lisp_Object tail
;
2680 CHECK_VECTOR (obarray
, 1);
2681 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2683 tail
= XVECTOR (obarray
)->contents
[i
];
2688 if (XSYMBOL (tail
)->next
== 0)
2690 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2696 mapatoms_1 (sym
, function
)
2697 Lisp_Object sym
, function
;
2699 call1 (function
, sym
);
2702 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2703 "Call FUNCTION on every symbol in OBARRAY.\n\
2704 OBARRAY defaults to the value of `obarray'.")
2706 Lisp_Object function
, obarray
;
2710 if (NILP (obarray
)) obarray
= Vobarray
;
2711 obarray
= check_obarray (obarray
);
2713 map_obarray (obarray
, mapatoms_1
, function
);
2717 #define OBARRAY_SIZE 1511
2722 Lisp_Object oblength
;
2726 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2728 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
2729 Vobarray
= Fmake_vector (oblength
, make_number (0));
2730 initial_obarray
= Vobarray
;
2731 staticpro (&initial_obarray
);
2732 /* Intern nil in the obarray */
2733 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2734 /* These locals are to kludge around a pyramid compiler bug. */
2735 hash
= hash_string ("nil", 3);
2736 /* Separate statement here to avoid VAXC bug. */
2737 hash
%= OBARRAY_SIZE
;
2738 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2741 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
2742 XSYMBOL (Qnil
)->function
= Qunbound
;
2743 XSYMBOL (Qunbound
)->value
= Qunbound
;
2744 XSYMBOL (Qunbound
)->function
= Qunbound
;
2747 XSYMBOL (Qnil
)->value
= Qnil
;
2748 XSYMBOL (Qnil
)->plist
= Qnil
;
2749 XSYMBOL (Qt
)->value
= Qt
;
2751 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2754 Qvariable_documentation
= intern ("variable-documentation");
2755 staticpro (&Qvariable_documentation
);
2757 read_buffer_size
= 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM
;
2758 read_buffer
= (char *) malloc (read_buffer_size
);
2763 struct Lisp_Subr
*sname
;
2766 sym
= intern (sname
->symbol_name
);
2767 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2770 #ifdef NOTDEF /* use fset in subr.el now */
2772 defalias (sname
, string
)
2773 struct Lisp_Subr
*sname
;
2777 sym
= intern (string
);
2778 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2782 /* Define an "integer variable"; a symbol whose value is forwarded
2783 to a C variable of type int. Sample call: */
2784 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2786 defvar_int (namestring
, address
)
2790 Lisp_Object sym
, val
;
2791 sym
= intern (namestring
);
2792 val
= allocate_misc ();
2793 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2794 XINTFWD (val
)->intvar
= address
;
2795 XSYMBOL (sym
)->value
= val
;
2798 /* Similar but define a variable whose value is T if address contains 1,
2799 NIL if address contains 0 */
2801 defvar_bool (namestring
, address
)
2805 Lisp_Object sym
, val
;
2806 sym
= intern (namestring
);
2807 val
= allocate_misc ();
2808 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2809 XBOOLFWD (val
)->boolvar
= address
;
2810 XSYMBOL (sym
)->value
= val
;
2813 /* Similar but define a variable whose value is the Lisp Object stored
2814 at address. Two versions: with and without gc-marking of the C
2815 variable. The nopro version is used when that variable will be
2816 gc-marked for some other reason, since marking the same slot twice
2817 can cause trouble with strings. */
2819 defvar_lisp_nopro (namestring
, address
)
2821 Lisp_Object
*address
;
2823 Lisp_Object sym
, val
;
2824 sym
= intern (namestring
);
2825 val
= allocate_misc ();
2826 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2827 XOBJFWD (val
)->objvar
= address
;
2828 XSYMBOL (sym
)->value
= val
;
2832 defvar_lisp (namestring
, address
)
2834 Lisp_Object
*address
;
2836 defvar_lisp_nopro (namestring
, address
);
2837 staticpro (address
);
2842 /* Similar but define a variable whose value is the Lisp Object stored in
2843 the current buffer. address is the address of the slot in the buffer
2844 that is current now. */
2847 defvar_per_buffer (namestring
, address
, type
, doc
)
2849 Lisp_Object
*address
;
2853 Lisp_Object sym
, val
;
2855 extern struct buffer buffer_local_symbols
;
2857 sym
= intern (namestring
);
2858 val
= allocate_misc ();
2859 offset
= (char *)address
- (char *)current_buffer
;
2861 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2862 XBUFFER_OBJFWD (val
)->offset
= offset
;
2863 XSYMBOL (sym
)->value
= val
;
2864 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2865 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2866 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2867 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2868 slot of buffer_local_flags */
2872 #endif /* standalone */
2874 /* Similar but define a variable whose value is the Lisp Object stored
2875 at a particular offset in the current kboard object. */
2878 defvar_kboard (namestring
, offset
)
2882 Lisp_Object sym
, val
;
2883 sym
= intern (namestring
);
2884 val
= allocate_misc ();
2885 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2886 XKBOARD_OBJFWD (val
)->offset
= offset
;
2887 XSYMBOL (sym
)->value
= val
;
2890 /* Record the value of load-path used at the start of dumping
2891 so we can see if the site changed it later during dumping. */
2892 static Lisp_Object dump_path
;
2898 int turn_off_warning
= 0;
2900 #ifdef HAVE_SETLOCALE
2901 /* Make sure numbers are parsed as we expect. */
2902 setlocale (LC_NUMERIC
, "C");
2903 #endif /* HAVE_SETLOCALE */
2905 /* Compute the default load-path. */
2907 normal
= PATH_LOADSEARCH
;
2908 Vload_path
= decode_env_path (0, normal
);
2910 if (NILP (Vpurify_flag
))
2911 normal
= PATH_LOADSEARCH
;
2913 normal
= PATH_DUMPLOADSEARCH
;
2915 /* In a dumped Emacs, we normally have to reset the value of
2916 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2917 uses ../lisp, instead of the path of the installed elisp
2918 libraries. However, if it appears that Vload_path was changed
2919 from the default before dumping, don't override that value. */
2922 if (! NILP (Fequal (dump_path
, Vload_path
)))
2924 Vload_path
= decode_env_path (0, normal
);
2925 if (!NILP (Vinstallation_directory
))
2927 /* Add to the path the lisp subdir of the
2928 installation dir, if it exists. */
2929 Lisp_Object tem
, tem1
;
2930 tem
= Fexpand_file_name (build_string ("lisp"),
2931 Vinstallation_directory
);
2932 tem1
= Ffile_exists_p (tem
);
2935 if (NILP (Fmember (tem
, Vload_path
)))
2937 turn_off_warning
= 1;
2938 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2942 /* That dir doesn't exist, so add the build-time
2943 Lisp dirs instead. */
2944 Vload_path
= nconc2 (Vload_path
, dump_path
);
2946 /* Add leim under the installation dir, if it exists. */
2947 tem
= Fexpand_file_name (build_string ("leim"),
2948 Vinstallation_directory
);
2949 tem1
= Ffile_exists_p (tem
);
2952 if (NILP (Fmember (tem
, Vload_path
)))
2953 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2956 /* Add site-list under the installation dir, if it exists. */
2957 tem
= Fexpand_file_name (build_string ("site-lisp"),
2958 Vinstallation_directory
);
2959 tem1
= Ffile_exists_p (tem
);
2962 if (NILP (Fmember (tem
, Vload_path
)))
2963 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2966 /* If Emacs was not built in the source directory,
2967 and it is run from where it was built, add to load-path
2968 the lisp, leim and site-lisp dirs under that directory. */
2970 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
2974 tem
= Fexpand_file_name (build_string ("src/Makefile"),
2975 Vinstallation_directory
);
2976 tem1
= Ffile_exists_p (tem
);
2978 /* Don't be fooled if they moved the entire source tree
2979 AFTER dumping Emacs. If the build directory is indeed
2980 different from the source dir, src/Makefile.in and
2981 src/Makefile will not be found together. */
2982 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
2983 Vinstallation_directory
);
2984 tem2
= Ffile_exists_p (tem
);
2985 if (!NILP (tem1
) && NILP (tem2
))
2987 tem
= Fexpand_file_name (build_string ("lisp"),
2990 if (NILP (Fmember (tem
, Vload_path
)))
2991 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2993 tem
= Fexpand_file_name (build_string ("leim"),
2996 if (NILP (Fmember (tem
, Vload_path
)))
2997 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2999 tem
= Fexpand_file_name (build_string ("site-lisp"),
3002 if (NILP (Fmember (tem
, Vload_path
)))
3003 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3011 /* NORMAL refers to the lisp dir in the source directory. */
3012 /* We used to add ../lisp at the front here, but
3013 that caused trouble because it was copied from dump_path
3014 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3015 It should be unnecessary. */
3016 Vload_path
= decode_env_path (0, normal
);
3017 dump_path
= Vload_path
;
3022 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3023 almost never correct, thereby causing a warning to be printed out that
3024 confuses users. Since PATH_LOADSEARCH is always overridden by the
3025 EMACSLOADPATH environment variable below, disable the warning on NT. */
3027 /* Warn if dirs in the *standard* path don't exist. */
3028 if (!turn_off_warning
)
3030 Lisp_Object path_tail
;
3032 for (path_tail
= Vload_path
;
3034 path_tail
= XCONS (path_tail
)->cdr
)
3036 Lisp_Object dirfile
;
3037 dirfile
= Fcar (path_tail
);
3038 if (STRINGP (dirfile
))
3040 dirfile
= Fdirectory_file_name (dirfile
);
3041 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3042 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3043 XCONS (path_tail
)->car
);
3047 #endif /* WINDOWSNT */
3049 /* If the EMACSLOADPATH environment variable is set, use its value.
3050 This doesn't apply if we're dumping. */
3052 if (NILP (Vpurify_flag
)
3053 && egetenv ("EMACSLOADPATH"))
3055 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3059 load_in_progress
= 0;
3060 Vload_file_name
= Qnil
;
3062 load_descriptor_list
= Qnil
;
3064 Vstandard_input
= Qt
;
3067 /* Print a warning, using format string FORMAT, that directory DIRNAME
3068 does not exist. Print it on stderr and put it in *Message*. */
3071 dir_warning (format
, dirname
)
3073 Lisp_Object dirname
;
3076 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3078 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3079 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3080 /* Don't log the warning before we've initialized!! */
3082 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3089 defsubr (&Sread_from_string
);
3091 defsubr (&Sintern_soft
);
3092 defsubr (&Sunintern
);
3094 defsubr (&Seval_buffer
);
3095 defsubr (&Seval_region
);
3096 defsubr (&Sread_char
);
3097 defsubr (&Sread_char_exclusive
);
3098 defsubr (&Sread_event
);
3099 defsubr (&Sget_file_char
);
3100 defsubr (&Smapatoms
);
3102 DEFVAR_LISP ("obarray", &Vobarray
,
3103 "Symbol table for use by `intern' and `read'.\n\
3104 It is a vector whose length ought to be prime for best results.\n\
3105 The vector's contents don't make sense if examined from Lisp programs;\n\
3106 to find all the symbols in an obarray, use `mapatoms'.");
3108 DEFVAR_LISP ("values", &Vvalues
,
3109 "List of values of all expressions which were read, evaluated and printed.\n\
3110 Order is reverse chronological.");
3112 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3113 "Stream for read to get input from.\n\
3114 See documentation of `read' for possible values.");
3115 Vstandard_input
= Qt
;
3117 DEFVAR_LISP ("load-path", &Vload_path
,
3118 "*List of directories to search for files to load.\n\
3119 Each element is a string (directory name) or nil (try default directory).\n\
3120 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3121 otherwise to default specified by file `paths.h' when Emacs was built.");
3123 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3124 "Non-nil iff inside of `load'.");
3126 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3127 "An alist of expressions to be evalled when particular files are loaded.\n\
3128 Each element looks like (FILENAME FORMS...).\n\
3129 When `load' is run and the file-name argument is FILENAME,\n\
3130 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3131 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3132 with no directory specified, since that is how `load' is normally called.\n\
3133 An error in FORMS does not undo the load,\n\
3134 but does prevent execution of the rest of the FORMS.");
3135 Vafter_load_alist
= Qnil
;
3137 DEFVAR_LISP ("load-history", &Vload_history
,
3138 "Alist mapping source file names to symbols and features.\n\
3139 Each alist element is a list that starts with a file name,\n\
3140 except for one element (optional) that starts with nil and describes\n\
3141 definitions evaluated from buffers not visiting files.\n\
3142 The remaining elements of each list are symbols defined as functions\n\
3143 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
3144 Vload_history
= Qnil
;
3146 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3147 "Full name of file being loaded by `load'.");
3148 Vload_file_name
= Qnil
;
3150 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3151 "Used for internal purposes by `load'.");
3152 Vcurrent_load_list
= Qnil
;
3154 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3155 "Function used by `load' and `eval-region' for reading expressions.\n\
3156 The default is nil, which means use the function `read'.");
3157 Vload_read_function
= Qnil
;
3159 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3160 "Function called in `load' for loading an Emacs lisp source file.\n\
3161 This function is for doing code conversion before reading the source file.\n\
3162 If nil, loading is done without any code conversion.\n\
3163 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3164 FULLNAME is the full name of FILE.\n\
3165 See `load' for the meaning of the remaining arguments.");
3166 Vload_source_file_function
= Qnil
;
3168 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3169 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3170 This is useful when the file being loaded is a temporary copy.");
3171 load_force_doc_strings
= 0;
3173 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3174 "Non-nil means `load' converts strings to unibyte whenever possible.\n\
3175 This is normally used in `load-with-code-conversion'\n\
3176 for loading non-compiled files.");
3177 load_convert_to_unibyte
= 0;
3179 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3180 "Directory in which Emacs sources were found when Emacs was built.\n\
3181 You cannot count on them to still be there!");
3183 = Fexpand_file_name (build_string ("../"),
3184 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3186 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3187 "List of files that were preloaded (when dumping Emacs).");
3188 Vpreloaded_file_list
= Qnil
;
3190 /* Vsource_directory was initialized in init_lread. */
3192 load_descriptor_list
= Qnil
;
3193 staticpro (&load_descriptor_list
);
3195 Qcurrent_load_list
= intern ("current-load-list");
3196 staticpro (&Qcurrent_load_list
);
3198 Qstandard_input
= intern ("standard-input");
3199 staticpro (&Qstandard_input
);
3201 Qread_char
= intern ("read-char");
3202 staticpro (&Qread_char
);
3204 Qget_file_char
= intern ("get-file-char");
3205 staticpro (&Qget_file_char
);
3207 Qbackquote
= intern ("`");
3208 staticpro (&Qbackquote
);
3209 Qcomma
= intern (",");
3210 staticpro (&Qcomma
);
3211 Qcomma_at
= intern (",@");
3212 staticpro (&Qcomma_at
);
3213 Qcomma_dot
= intern (",.");
3214 staticpro (&Qcomma_dot
);
3216 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3217 staticpro (&Qinhibit_file_name_operation
);
3219 Qascii_character
= intern ("ascii-character");
3220 staticpro (&Qascii_character
);
3222 Qfunction
= intern ("function");
3223 staticpro (&Qfunction
);
3225 Qload
= intern ("load");
3228 Qload_file_name
= intern ("load-file-name");
3229 staticpro (&Qload_file_name
);
3231 staticpro (&dump_path
);
3233 staticpro (&read_objects
);
3234 read_objects
= Qnil
;