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
428 If INPUT_METHOD is nonzero, we invoke the current input method
429 if the character warrants that. */
432 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
,
434 int no_switch_frame
, ascii_required
, error_nonascii
, input_method
;
437 return make_number (getchar ());
439 register Lisp_Object val
, delayed_switch_frame
;
441 delayed_switch_frame
= Qnil
;
443 /* Read until we get an acceptable event. */
445 val
= read_char (0, 0, 0,
446 (input_method
? Qnil
: Qt
),
452 /* switch-frame events are put off until after the next ASCII
453 character. This is better than signaling an error just because
454 the last characters were typed to a separate minibuffer frame,
455 for example. Eventually, some code which can deal with
456 switch-frame events will read it and process it. */
458 && EVENT_HAS_PARAMETERS (val
)
459 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
461 delayed_switch_frame
= val
;
467 /* Convert certain symbols to their ASCII equivalents. */
470 Lisp_Object tem
, tem1
, tem2
;
471 tem
= Fget (val
, Qevent_symbol_element_mask
);
474 tem1
= Fget (Fcar (tem
), Qascii_character
);
475 /* Merge this symbol's modifier bits
476 with the ASCII equivalent of its basic code. */
478 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
482 /* If we don't have a character now, deal with it appropriately. */
487 Vunread_command_events
= Fcons (val
, Qnil
);
488 error ("Non-character input-event");
495 if (! NILP (delayed_switch_frame
))
496 unread_switch_frame
= delayed_switch_frame
;
502 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 2, 0,
503 "Read a character from the command input (keyboard or macro).\n\
504 It is returned as a number.\n\
505 If the user generates an event which is not a character (i.e. a mouse\n\
506 click or function key event), `read-char' signals an error. As an\n\
507 exception, switch-frame events are put off until non-ASCII events can\n\
509 If you want to read non-character events, or ignore them, call\n\
510 `read-event' or `read-char-exclusive' instead.\n\
512 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
513 If the optional argument SUPPRESS-INPUT-METHOD is non-nil,\n\
514 disable input method processing for this character.")
515 (prompt
, suppress_input_method
)
516 Lisp_Object prompt
, suppress_input_method
;
519 message_with_string ("%s", prompt
, 0);
520 return read_filtered_event (1, 1, 1, NILP (suppress_input_method
));
523 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 2, 0,
524 "Read an event object from the input stream.\n\
525 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
526 If the optional argument SUPPRESS-INPUT-METHOD is non-nil,\n\
527 disable input method processing for this character.")
528 (prompt
, suppress_input_method
)
529 Lisp_Object prompt
, suppress_input_method
;
532 message_with_string ("%s", prompt
, 0);
533 return read_filtered_event (0, 0, 0, NILP (suppress_input_method
));
536 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 2, 0,
537 "Read a character from the command input (keyboard or macro).\n\
538 It is returned as a number. Non-character events are ignored.\n\
540 If the optional argument PROMPT is non-nil, display that as a prompt.\n\
541 If the optional argument SUPPRESS-INPUT-METHOD is non-nil,\n\
542 disable input method processing for this character.")
543 (prompt
, suppress_input_method
)
544 Lisp_Object prompt
, suppress_input_method
;
547 message_with_string ("%s", prompt
, 0);
548 return read_filtered_event (1, 1, 0, NILP (suppress_input_method
));
551 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
552 "Don't use this yourself.")
555 register Lisp_Object val
;
556 XSETINT (val
, getc (instream
));
560 static void readevalloop ();
561 static Lisp_Object
load_unwind ();
562 static Lisp_Object
load_descriptor_unwind ();
564 DEFUN ("load", Fload
, Sload
, 1, 5, 0,
565 "Execute a file of Lisp code named FILE.\n\
566 First try FILE with `.elc' appended, then try with `.el',\n\
567 then try FILE unmodified.\n\
568 This function searches the directories in `load-path'.\n\
569 If optional second arg NOERROR is non-nil,\n\
570 report no error if FILE doesn't exist.\n\
571 Print messages at start and end of loading unless\n\
572 optional third arg NOMESSAGE is non-nil.\n\
573 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
574 suffixes `.elc' or `.el' to the specified name FILE.\n\
575 If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\
576 the suffix `.elc' or `.el'; don't accept just FILE unless\n\
577 it ends in one of those suffixes or includes a directory name.\n\
578 Return t if file exists.")
579 (file
, noerror
, nomessage
, nosuffix
, must_suffix
)
580 Lisp_Object file
, noerror
, nomessage
, nosuffix
, must_suffix
;
582 register FILE *stream
;
583 register int fd
= -1;
584 register Lisp_Object lispstream
;
585 int count
= specpdl_ptr
- specpdl
;
589 /* 1 means we printed the ".el is newer" message. */
591 /* 1 means we are loading a compiled file. */
599 CHECK_STRING (file
, 0);
601 /* If file name is magic, call the handler. */
602 handler
= Ffind_file_name_handler (file
, Qload
);
604 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
606 /* Do this after the handler to avoid
607 the need to gcpro noerror, nomessage and nosuffix.
608 (Below here, we care only whether they are nil or not.) */
609 file
= Fsubstitute_in_file_name (file
);
611 /* Avoid weird lossage with null string as arg,
612 since it would try to load a directory as a Lisp file */
613 if (XSTRING (file
)->size
> 0)
615 int size
= XSTRING (file
)->size
;
619 if (! NILP (must_suffix
))
621 /* Don't insist on adding a suffix if FILE already ends with one. */
623 && !strcmp (XSTRING (file
)->data
+ size
- 3, ".el"))
626 && !strcmp (XSTRING (file
)->data
+ size
- 4, ".elc"))
628 /* Don't insist on adding a suffix
629 if the argument includes a directory name. */
630 else if (! NILP (Ffile_name_directory (file
)))
634 fd
= openp (Vload_path
, file
,
635 (!NILP (nosuffix
) ? ""
636 : ! NILP (must_suffix
) ? ".elc:.el"
646 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
647 Fcons (file
, Qnil
)));
652 /* If FD is 0, that means openp found a remote file. */
655 handler
= Ffind_file_name_handler (found
, Qload
);
656 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
659 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
670 stat ((char *)XSTRING (found
)->data
, &s1
);
671 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
672 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
673 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
675 /* Make the progress messages mention that source is newer. */
678 /* If we won't print another message, mention this anyway. */
679 if (! NILP (nomessage
))
680 message_with_string ("Source file `%s' newer than byte-compiled file",
683 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
687 /* We are loading a source file (*.el). */
688 if (!NILP (Vload_source_file_function
))
691 return call4 (Vload_source_file_function
, found
, file
,
692 NILP (noerror
) ? Qnil
: Qt
,
693 NILP (nomessage
) ? Qnil
: Qt
);
699 stream
= fopen ((char *) XSTRING (found
)->data
, fmode
);
700 #else /* not WINDOWSNT */
701 stream
= fdopen (fd
, fmode
);
702 #endif /* not WINDOWSNT */
706 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
709 if (! NILP (Vpurify_flag
))
710 Vpreloaded_file_list
= Fcons (file
, Vpreloaded_file_list
);
712 if (NILP (nomessage
))
715 message_with_string ("Loading %s (source)...", file
, 1);
717 message_with_string ("Loading %s (compiled; note, source file is newer)...",
719 else /* The typical case; compiled file newer than source file. */
720 message_with_string ("Loading %s...", file
, 1);
724 lispstream
= Fcons (Qnil
, Qnil
);
725 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
726 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
727 record_unwind_protect (load_unwind
, lispstream
);
728 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
729 specbind (Qload_file_name
, found
);
730 specbind (Qinhibit_file_name_operation
, Qnil
);
732 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
734 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0, Qnil
, Qnil
);
735 unbind_to (count
, Qnil
);
737 /* Run any load-hooks for this file. */
738 temp
= Fassoc (file
, Vafter_load_alist
);
740 Fprogn (Fcdr (temp
));
743 if (saved_doc_string
)
744 free (saved_doc_string
);
745 saved_doc_string
= 0;
746 saved_doc_string_size
= 0;
748 if (prev_saved_doc_string
)
749 free (prev_saved_doc_string
);
750 prev_saved_doc_string
= 0;
751 prev_saved_doc_string_size
= 0;
753 if (!noninteractive
&& NILP (nomessage
))
756 message_with_string ("Loading %s (source)...done", file
, 1);
758 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
760 else /* The typical case; compiled file newer than source file. */
761 message_with_string ("Loading %s...done", file
, 1);
767 load_unwind (stream
) /* used as unwind-protect function in load */
770 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
771 | XFASTINT (XCONS (stream
)->cdr
)));
772 if (--load_in_progress
< 0) load_in_progress
= 0;
777 load_descriptor_unwind (oldlist
)
780 load_descriptor_list
= oldlist
;
784 /* Close all descriptors in use for Floads.
785 This is used when starting a subprocess. */
792 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
793 close (XFASTINT (XCONS (tail
)->car
));
798 complete_filename_p (pathname
)
799 Lisp_Object pathname
;
801 register unsigned char *s
= XSTRING (pathname
)->data
;
802 return (IS_DIRECTORY_SEP (s
[0])
803 || (XSTRING (pathname
)->size
> 2
804 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
814 /* Search for a file whose name is STR, looking in directories
815 in the Lisp list PATH, and trying suffixes from SUFFIX.
816 SUFFIX is a string containing possible suffixes separated by colons.
817 On success, returns a file descriptor. On failure, returns -1.
819 EXEC_ONLY nonzero means don't open the files,
820 just look for one that is executable. In this case,
821 returns 1 on success.
823 If STOREPTR is nonzero, it points to a slot where the name of
824 the file actually found should be stored as a Lisp string.
825 nil is stored there on failure.
827 If the file we find is remote, return 0
828 but store the found remote file name in *STOREPTR.
829 We do not check for remote files if EXEC_ONLY is nonzero. */
832 openp (path
, str
, suffix
, storeptr
, exec_only
)
833 Lisp_Object path
, str
;
835 Lisp_Object
*storeptr
;
841 register char *fn
= buf
;
844 Lisp_Object filename
;
852 if (complete_filename_p (str
))
855 for (; !NILP (path
); path
= Fcdr (path
))
859 filename
= Fexpand_file_name (str
, Fcar (path
));
860 if (!complete_filename_p (filename
))
861 /* If there are non-absolute elts in PATH (eg ".") */
862 /* Of course, this could conceivably lose if luser sets
863 default-directory to be something non-absolute... */
865 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
866 if (!complete_filename_p (filename
))
867 /* Give up on this path element! */
871 /* Calculate maximum size of any filename made from
872 this path element/specified file name and any possible suffix. */
873 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
874 if (fn_size
< want_size
)
875 fn
= (char *) alloca (fn_size
= 100 + want_size
);
879 /* Loop over suffixes. */
882 char *esuffix
= (char *) index (nsuffix
, ':');
883 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
886 /* Concatenate path element/specified name with the suffix.
887 If the directory starts with /:, remove that. */
888 if (XSTRING (filename
)->size
> 2
889 && XSTRING (filename
)->data
[0] == '/'
890 && XSTRING (filename
)->data
[1] == ':')
892 strncpy (fn
, XSTRING (filename
)->data
+ 2,
893 XSTRING (filename
)->size
- 2);
894 fn
[XSTRING (filename
)->size
- 2] = 0;
898 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
899 fn
[XSTRING (filename
)->size
] = 0;
902 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
903 strncat (fn
, nsuffix
, lsuffix
);
905 /* Check that the file exists and is not a directory. */
909 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
910 if (! NILP (handler
) && ! exec_only
)
915 string
= build_string (fn
);
916 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
917 : Ffile_readable_p (string
));
919 && ! NILP (Ffile_directory_p (build_string (fn
))))
924 /* We succeeded; return this descriptor and filename. */
926 *storeptr
= build_string (fn
);
933 int exists
= (stat (fn
, &st
) >= 0
934 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
937 /* Check that we can access or open it. */
939 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
941 fd
= open (fn
, O_RDONLY
, 0);
945 /* We succeeded; return this descriptor and filename. */
947 *storeptr
= build_string (fn
);
954 /* Advance to next suffix. */
957 nsuffix
+= lsuffix
+ 1;
968 /* Merge the list we've accumulated of globals from the current input source
969 into the load_history variable. The details depend on whether
970 the source has an associated file name or not. */
973 build_load_history (stream
, source
)
977 register Lisp_Object tail
, prev
, newelt
;
978 register Lisp_Object tem
, tem2
;
979 register int foundit
, loading
;
981 /* Don't bother recording anything for preloaded files. */
982 if (!NILP (Vpurify_flag
))
985 loading
= stream
|| !NARROWED
;
987 tail
= Vload_history
;
994 /* Find the feature's previous assoc list... */
995 if (!NILP (Fequal (source
, Fcar (tem
))))
999 /* If we're loading, remove it. */
1003 Vload_history
= Fcdr (tail
);
1005 Fsetcdr (prev
, Fcdr (tail
));
1008 /* Otherwise, cons on new symbols that are not already members. */
1011 tem2
= Vcurrent_load_list
;
1013 while (CONSP (tem2
))
1015 newelt
= Fcar (tem2
);
1017 if (NILP (Fmemq (newelt
, tem
)))
1018 Fsetcar (tail
, Fcons (Fcar (tem
),
1019 Fcons (newelt
, Fcdr (tem
))));
1032 /* If we're loading, cons the new assoc onto the front of load-history,
1033 the most-recently-loaded position. Also do this if we didn't find
1034 an existing member for the current source. */
1035 if (loading
|| !foundit
)
1036 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
1041 unreadpure () /* Used as unwind-protect function in readevalloop */
1048 readevalloop_1 (old
)
1051 load_convert_to_unibyte
= ! NILP (old
);
1055 /* UNIBYTE specifies how to set load_convert_to_unibyte
1056 for this invocation.
1057 READFUN, if non-nil, is used instead of `read'. */
1060 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
, unibyte
, readfun
)
1061 Lisp_Object readcharfun
;
1063 Lisp_Object sourcename
;
1064 Lisp_Object (*evalfun
) ();
1066 Lisp_Object unibyte
, readfun
;
1069 register Lisp_Object val
;
1070 int count
= specpdl_ptr
- specpdl
;
1071 struct gcpro gcpro1
;
1072 struct buffer
*b
= 0;
1074 if (BUFFERP (readcharfun
))
1075 b
= XBUFFER (readcharfun
);
1076 else if (MARKERP (readcharfun
))
1077 b
= XMARKER (readcharfun
)->buffer
;
1079 specbind (Qstandard_input
, readcharfun
);
1080 specbind (Qcurrent_load_list
, Qnil
);
1081 record_unwind_protect (readevalloop_1
, load_convert_to_unibyte
? Qt
: Qnil
);
1082 load_convert_to_unibyte
= !NILP (unibyte
);
1084 readchar_backlog
= -1;
1086 GCPRO1 (sourcename
);
1088 LOADHIST_ATTACH (sourcename
);
1092 if (b
!= 0 && NILP (b
->name
))
1093 error ("Reading from killed buffer");
1099 while ((c
= READCHAR
) != '\n' && c
!= -1);
1104 /* Ignore whitespace here, so we can detect eof. */
1105 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
1108 if (!NILP (Vpurify_flag
) && c
== '(')
1110 int count1
= specpdl_ptr
- specpdl
;
1111 record_unwind_protect (unreadpure
, Qnil
);
1112 val
= read_list (-1, readcharfun
);
1113 unbind_to (count1
, Qnil
);
1118 read_objects
= Qnil
;
1119 if (! NILP (readfun
))
1120 val
= call1 (readfun
, readcharfun
);
1121 else if (! NILP (Vload_read_function
))
1122 val
= call1 (Vload_read_function
, readcharfun
);
1124 val
= read0 (readcharfun
);
1127 val
= (*evalfun
) (val
);
1130 Vvalues
= Fcons (val
, Vvalues
);
1131 if (EQ (Vstandard_output
, Qt
))
1138 build_load_history (stream
, sourcename
);
1141 unbind_to (count
, Qnil
);
1146 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 4, "",
1147 "Execute the current buffer as Lisp code.\n\
1148 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
1149 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
1150 PRINTFLAG controls printing of output:\n\
1151 nil means discard it; anything else is stream for print.\n\
1153 If the optional third argument FILENAME is non-nil,\n\
1154 it specifies the file name to use for `load-history'.\n\
1156 This function preserves the position of point.")
1157 (buffer
, printflag
, filename
, unibyte
)
1158 Lisp_Object buffer
, printflag
, filename
, unibyte
;
1160 int count
= specpdl_ptr
- specpdl
;
1161 Lisp_Object tem
, buf
;
1164 buf
= Fcurrent_buffer ();
1166 buf
= Fget_buffer (buffer
);
1168 error ("No such buffer");
1170 if (NILP (printflag
))
1175 if (NILP (filename
))
1176 filename
= XBUFFER (buf
)->filename
;
1178 specbind (Qstandard_output
, tem
);
1179 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1180 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
1181 readevalloop (buf
, 0, filename
, Feval
, !NILP (printflag
), unibyte
, Qnil
);
1182 unbind_to (count
, Qnil
);
1188 XDEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
1189 "Execute the current buffer as Lisp code.\n\
1190 Programs can pass argument PRINTFLAG which controls printing of output:\n\
1191 nil means discard it; anything else is stream for print.\n\
1193 If there is no error, point does not move. If there is an error,\n\
1194 point remains at the end of the last character read from the buffer.")
1196 Lisp_Object printflag
;
1198 int count
= specpdl_ptr
- specpdl
;
1199 Lisp_Object tem
, cbuf
;
1201 cbuf
= Fcurrent_buffer ()
1203 if (NILP (printflag
))
1207 specbind (Qstandard_output
, tem
);
1208 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1210 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1211 !NILP (printflag
), Qnil
, Qnil
);
1212 return unbind_to (count
, Qnil
);
1216 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 4, "r",
1217 "Execute the region as Lisp code.\n\
1218 When called from programs, expects two arguments,\n\
1219 giving starting and ending indices in the current buffer\n\
1220 of the text to be executed.\n\
1221 Programs can pass third argument PRINTFLAG which controls output:\n\
1222 nil means discard it; anything else is stream for printing it.\n\
1223 Also the fourth argument READ-FUNCTION, if non-nil, is used\n\
1224 instead of `read' to read each expression. It gets one argument\n\
1225 which is the input stream for reading characters.\n\
1227 This function does not move point.")
1228 (start
, end
, printflag
, read_function
)
1229 Lisp_Object start
, end
, printflag
, read_function
;
1231 int count
= specpdl_ptr
- specpdl
;
1232 Lisp_Object tem
, cbuf
;
1234 cbuf
= Fcurrent_buffer ();
1236 if (NILP (printflag
))
1240 specbind (Qstandard_output
, tem
);
1242 if (NILP (printflag
))
1243 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1244 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1246 /* This both uses start and checks its type. */
1248 Fnarrow_to_region (make_number (BEGV
), end
);
1249 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
,
1250 !NILP (printflag
), Qnil
, read_function
);
1252 return unbind_to (count
, Qnil
);
1255 #endif /* standalone */
1257 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1258 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1259 If STREAM is nil, use the value of `standard-input' (which see).\n\
1260 STREAM or the value of `standard-input' may be:\n\
1261 a buffer (read from point and advance it)\n\
1262 a marker (read from where it points and advance it)\n\
1263 a function (call it with no arguments for each character,\n\
1264 call it with a char as argument to push a char back)\n\
1265 a string (takes text from string, starting at the beginning)\n\
1266 t (read text line using minibuffer and use it).")
1270 extern Lisp_Object
Fread_minibuffer ();
1273 stream
= Vstandard_input
;
1274 if (EQ (stream
, Qt
))
1275 stream
= Qread_char
;
1277 readchar_backlog
= -1;
1278 new_backquote_flag
= 0;
1279 read_objects
= Qnil
;
1282 if (EQ (stream
, Qread_char
))
1283 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1286 if (STRINGP (stream
))
1287 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1289 return read0 (stream
);
1292 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1293 "Read one Lisp expression which is represented as text by STRING.\n\
1294 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1295 START and END optionally delimit a substring of STRING from which to read;\n\
1296 they default to 0 and (length STRING) respectively.")
1297 (string
, start
, end
)
1298 Lisp_Object string
, start
, end
;
1300 int startval
, endval
;
1303 CHECK_STRING (string
,0);
1306 endval
= XSTRING (string
)->size
;
1309 CHECK_NUMBER (end
, 2);
1310 endval
= XINT (end
);
1311 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1312 args_out_of_range (string
, end
);
1319 CHECK_NUMBER (start
, 1);
1320 startval
= XINT (start
);
1321 if (startval
< 0 || startval
> endval
)
1322 args_out_of_range (string
, start
);
1325 read_from_string_index
= startval
;
1326 read_from_string_index_byte
= string_char_to_byte (string
, startval
);
1327 read_from_string_limit
= endval
;
1329 new_backquote_flag
= 0;
1330 read_objects
= Qnil
;
1332 tem
= read0 (string
);
1333 return Fcons (tem
, make_number (read_from_string_index
));
1336 /* Use this for recursive reads, in contexts where internal tokens
1341 Lisp_Object readcharfun
;
1343 register Lisp_Object val
;
1346 val
= read1 (readcharfun
, &c
, 0);
1348 Fsignal (Qinvalid_read_syntax
, Fcons (Fmake_string (make_number (1),
1355 static int read_buffer_size
;
1356 static char *read_buffer
;
1358 /* Read multibyte form and return it as a character. C is a first
1359 byte of multibyte form, and rest of them are read from
1363 read_multibyte (c
, readcharfun
)
1365 Lisp_Object readcharfun
;
1367 /* We need the actual character code of this multibyte
1369 unsigned char str
[MAX_LENGTH_OF_MULTI_BYTE_FORM
];
1373 while ((c
= READCHAR
) >= 0xA0
1374 && len
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1377 return STRING_CHAR (str
, len
);
1380 /* Read a \-escape sequence, assuming we already read the `\'. */
1383 read_escape (readcharfun
, stringp
)
1384 Lisp_Object readcharfun
;
1387 register int c
= READCHAR
;
1391 error ("End of file");
1421 error ("Invalid escape character syntax");
1424 c
= read_escape (readcharfun
, 0);
1425 return c
| meta_modifier
;
1430 error ("Invalid escape character syntax");
1433 c
= read_escape (readcharfun
, 0);
1434 return c
| shift_modifier
;
1439 error ("Invalid escape character syntax");
1442 c
= read_escape (readcharfun
, 0);
1443 return c
| hyper_modifier
;
1448 error ("Invalid escape character syntax");
1451 c
= read_escape (readcharfun
, 0);
1452 return c
| alt_modifier
;
1457 error ("Invalid escape character syntax");
1460 c
= read_escape (readcharfun
, 0);
1461 return c
| super_modifier
;
1466 error ("Invalid escape character syntax");
1470 c
= read_escape (readcharfun
, 0);
1471 if ((c
& 0177) == '?')
1473 /* ASCII control chars are made from letters (both cases),
1474 as well as the non-letters within 0100...0137. */
1475 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1476 return (c
& (037 | ~0177));
1477 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1478 return (c
& (037 | ~0177));
1480 return c
| ctrl_modifier
;
1490 /* An octal escape, as in ANSI C. */
1492 register int i
= c
- '0';
1493 register int count
= 0;
1496 if ((c
= READCHAR
) >= '0' && c
<= '7')
1511 /* A hex escape, as in ANSI C. */
1517 if (c
>= '0' && c
<= '9')
1522 else if ((c
>= 'a' && c
<= 'f')
1523 || (c
>= 'A' && c
<= 'F'))
1526 if (c
>= 'a' && c
<= 'f')
1541 if (BASE_LEADING_CODE_P (c
))
1542 c
= read_multibyte (c
, readcharfun
);
1547 /* If the next token is ')' or ']' or '.', we store that character
1548 in *PCH and the return value is not interesting. Else, we store
1549 zero in *PCH and we read and return one lisp object.
1551 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1554 read1 (readcharfun
, pch
, first_in_list
)
1555 register Lisp_Object readcharfun
;
1560 int uninterned_symbol
= 0;
1567 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1572 return read_list (0, readcharfun
);
1575 return read_vector (readcharfun
, 0);
1592 tmp
= read_vector (readcharfun
, 0);
1593 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1594 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1595 error ("Invalid size char-table");
1596 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1597 XCHAR_TABLE (tmp
)->top
= Qt
;
1606 tmp
= read_vector (readcharfun
, 0);
1607 if (XVECTOR (tmp
)->size
!= SUB_CHAR_TABLE_STANDARD_SLOTS
)
1608 error ("Invalid size char-table");
1609 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1610 XCHAR_TABLE (tmp
)->top
= Qnil
;
1613 Fsignal (Qinvalid_read_syntax
,
1614 Fcons (make_string ("#^^", 3), Qnil
));
1616 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1621 length
= read1 (readcharfun
, pch
, first_in_list
);
1625 Lisp_Object tmp
, val
;
1626 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1630 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1631 if (size_in_chars
!= XSTRING (tmp
)->size
1632 /* We used to print 1 char too many
1633 when the number of bits was a multiple of 8.
1634 Accept such input in case it came from an old version. */
1635 && ! (XFASTINT (length
)
1636 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1637 Fsignal (Qinvalid_read_syntax
,
1638 Fcons (make_string ("#&...", 5), Qnil
));
1640 val
= Fmake_bool_vector (length
, Qnil
);
1641 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1643 /* Clear the extraneous bits in the last byte. */
1644 if (XINT (length
) != size_in_chars
* BITS_PER_CHAR
)
1645 XBOOL_VECTOR (val
)->data
[size_in_chars
- 1]
1646 &= (1 << (XINT (length
) % BITS_PER_CHAR
)) - 1;
1649 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1654 /* Accept compiled functions at read-time so that we don't have to
1655 build them using function calls. */
1657 tmp
= read_vector (readcharfun
, 1);
1658 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1659 XVECTOR (tmp
)->contents
);
1661 #ifdef USE_TEXT_PROPERTIES
1665 struct gcpro gcpro1
;
1668 /* Read the string itself. */
1669 tmp
= read1 (readcharfun
, &ch
, 0);
1670 if (ch
!= 0 || !STRINGP (tmp
))
1671 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1673 /* Read the intervals and their properties. */
1676 Lisp_Object beg
, end
, plist
;
1678 beg
= read1 (readcharfun
, &ch
, 0);
1682 end
= read1 (readcharfun
, &ch
, 0);
1684 plist
= read1 (readcharfun
, &ch
, 0);
1686 Fsignal (Qinvalid_read_syntax
,
1687 Fcons (build_string ("invalid string property list"),
1689 Fset_text_properties (beg
, end
, plist
, tmp
);
1695 /* #@NUMBER is used to skip NUMBER following characters.
1696 That's used in .elc files to skip over doc strings
1697 and function definitions. */
1702 /* Read a decimal integer. */
1703 while ((c
= READCHAR
) >= 0
1704 && c
>= '0' && c
<= '9')
1712 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1714 /* If we are supposed to force doc strings into core right now,
1715 record the last string that we skipped,
1716 and record where in the file it comes from. */
1718 /* But first exchange saved_doc_string
1719 with prev_saved_doc_string, so we save two strings. */
1721 char *temp
= saved_doc_string
;
1722 int temp_size
= saved_doc_string_size
;
1723 int temp_pos
= saved_doc_string_position
;
1724 int temp_len
= saved_doc_string_length
;
1726 saved_doc_string
= prev_saved_doc_string
;
1727 saved_doc_string_size
= prev_saved_doc_string_size
;
1728 saved_doc_string_position
= prev_saved_doc_string_position
;
1729 saved_doc_string_length
= prev_saved_doc_string_length
;
1731 prev_saved_doc_string
= temp
;
1732 prev_saved_doc_string_size
= temp_size
;
1733 prev_saved_doc_string_position
= temp_pos
;
1734 prev_saved_doc_string_length
= temp_len
;
1737 if (saved_doc_string_size
== 0)
1739 saved_doc_string_size
= nskip
+ 100;
1740 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1742 if (nskip
> saved_doc_string_size
)
1744 saved_doc_string_size
= nskip
+ 100;
1745 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1746 saved_doc_string_size
);
1749 saved_doc_string_position
= ftell (instream
);
1751 /* Copy that many characters into saved_doc_string. */
1752 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1753 saved_doc_string
[i
] = c
= READCHAR
;
1755 saved_doc_string_length
= i
;
1759 /* Skip that many characters. */
1760 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1767 return Vload_file_name
;
1769 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1770 /* #:foo is the uninterned symbol named foo. */
1773 uninterned_symbol
= 1;
1777 /* Reader forms that can reuse previously read objects. */
1778 if (c
>= '0' && c
<= '9')
1783 /* Read a non-negative integer. */
1784 while (c
>= '0' && c
<= '9')
1790 /* #n=object returns object, but associates it with n for #n#. */
1793 tem
= read0 (readcharfun
);
1794 read_objects
= Fcons (Fcons (make_number (n
), tem
), read_objects
);
1797 /* #n# returns a previously read object. */
1800 tem
= Fassq (make_number (n
), read_objects
);
1803 /* Fall through to error message. */
1805 /* Fall through to error message. */
1809 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1812 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1817 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1827 new_backquote_flag
= 1;
1828 value
= read0 (readcharfun
);
1829 new_backquote_flag
= 0;
1831 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1835 if (new_backquote_flag
)
1837 Lisp_Object comma_type
= Qnil
;
1842 comma_type
= Qcomma_at
;
1844 comma_type
= Qcomma_dot
;
1847 if (ch
>= 0) UNREAD (ch
);
1848 comma_type
= Qcomma
;
1851 new_backquote_flag
= 0;
1852 value
= read0 (readcharfun
);
1853 new_backquote_flag
= 1;
1854 return Fcons (comma_type
, Fcons (value
, Qnil
));
1861 register Lisp_Object val
;
1864 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1867 c
= read_escape (readcharfun
, 0);
1868 else if (BASE_LEADING_CODE_P (c
))
1869 c
= read_multibyte (c
, readcharfun
);
1871 return make_number (c
);
1876 register char *p
= read_buffer
;
1877 register char *end
= read_buffer
+ read_buffer_size
;
1879 /* Nonzero if we saw an escape sequence specifying
1880 a multibyte character. */
1881 int force_multibyte
= 0;
1882 /* Nonzero if we saw an escape sequence specifying
1883 a single-byte character. */
1884 int force_singlebyte
= 0;
1888 while ((c
= READCHAR
) >= 0
1891 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1893 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1894 p
+= new - read_buffer
;
1895 read_buffer
+= new - read_buffer
;
1896 end
= read_buffer
+ read_buffer_size
;
1901 c
= read_escape (readcharfun
, 1);
1903 /* C is -1 if \ newline has just been seen */
1906 if (p
== read_buffer
)
1911 /* If an escape specifies a non-ASCII single-byte character,
1912 this must be a unibyte string. */
1913 if (SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
))
1914 && ! ASCII_BYTE_P (c
))
1915 force_singlebyte
= 1;
1918 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_META
)))
1920 unsigned char workbuf
[4];
1921 unsigned char *str
= workbuf
;
1924 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
1926 force_multibyte
= 1;
1928 bcopy (str
, p
, length
);
1933 /* Allow `\C- ' and `\C-?'. */
1934 if (c
== (CHAR_CTL
| ' '))
1936 else if (c
== (CHAR_CTL
| '?'))
1940 /* Move the meta bit to the right place for a string. */
1941 c
= (c
& ~CHAR_META
) | 0x80;
1943 error ("Invalid modifier in string");
1948 return Fsignal (Qend_of_file
, Qnil
);
1950 /* If purifying, and string starts with \ newline,
1951 return zero instead. This is for doc strings
1952 that we are really going to find in etc/DOC.nn.nn */
1953 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1954 return make_number (0);
1956 if (force_multibyte
)
1957 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1958 else if (force_singlebyte
)
1959 nchars
= p
- read_buffer
;
1960 else if (load_convert_to_unibyte
)
1963 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1964 if (p
- read_buffer
!= nchars
)
1966 string
= make_multibyte_string (read_buffer
, nchars
,
1968 return Fstring_make_unibyte (string
);
1971 else if (EQ (readcharfun
, Qget_file_char
)
1972 || EQ (readcharfun
, Qlambda
))
1973 /* Nowadays, reading directly from a file
1974 is used only for compiled Emacs Lisp files,
1975 and those always use the Emacs internal encoding.
1976 Meanwhile, Qlambda is used for reading dynamic byte code
1977 (compiled with byte-compile-dynamic = t). */
1978 nchars
= multibyte_chars_in_text (read_buffer
, p
- read_buffer
);
1980 /* In all other cases, if we read these bytes as
1981 separate characters, treat them as separate characters now. */
1982 nchars
= p
- read_buffer
;
1985 return make_pure_string (read_buffer
, nchars
, p
- read_buffer
,
1987 || (p
- read_buffer
!= nchars
)));
1988 return make_specified_string (read_buffer
, nchars
, p
- read_buffer
,
1990 || (p
- read_buffer
!= nchars
)));
1995 #ifdef LISP_FLOAT_TYPE
1996 /* If a period is followed by a number, then we should read it
1997 as a floating point number. Otherwise, it denotes a dotted
1999 int next_char
= READCHAR
;
2002 if (! (next_char
>= '0' && next_char
<= '9'))
2009 /* Otherwise, we fall through! Note that the atom-reading loop
2010 below will now loop at least once, assuring that we will not
2011 try to UNREAD two characters in a row. */
2015 if (c
<= 040) goto retry
;
2017 register char *p
= read_buffer
;
2021 register char *end
= read_buffer
+ read_buffer_size
;
2024 && !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
2025 || c
== '(' || c
== ')'
2026 #ifndef LISP_FLOAT_TYPE
2027 /* If we have floating-point support, then we need
2028 to allow <digits><dot><digits>. */
2030 #endif /* not LISP_FLOAT_TYPE */
2031 || c
== '[' || c
== ']' || c
== '#'
2034 if (end
- p
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
2036 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2037 p
+= new - read_buffer
;
2038 read_buffer
+= new - read_buffer
;
2039 end
= read_buffer
+ read_buffer_size
;
2047 if (! SINGLE_BYTE_CHAR_P (c
))
2049 unsigned char workbuf
[4];
2050 unsigned char *str
= workbuf
;
2053 length
= non_ascii_char_to_string (c
, workbuf
, &str
);
2055 bcopy (str
, p
, length
);
2066 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
2067 p
+= new - read_buffer
;
2068 read_buffer
+= new - read_buffer
;
2069 /* end = read_buffer + read_buffer_size; */
2076 if (!quoted
&& !uninterned_symbol
)
2079 register Lisp_Object val
;
2081 if (*p1
== '+' || *p1
== '-') p1
++;
2082 /* Is it an integer? */
2085 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
2086 #ifdef LISP_FLOAT_TYPE
2087 /* Integers can have trailing decimal points. */
2088 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
2091 /* It is an integer. */
2093 #ifdef LISP_FLOAT_TYPE
2097 if (sizeof (int) == sizeof (EMACS_INT
))
2098 XSETINT (val
, atoi (read_buffer
));
2099 else if (sizeof (long) == sizeof (EMACS_INT
))
2100 XSETINT (val
, atol (read_buffer
));
2106 #ifdef LISP_FLOAT_TYPE
2107 if (isfloat_string (read_buffer
))
2110 double value
= atof (read_buffer
);
2111 if (read_buffer
[0] == '-' && value
== 0.0)
2113 /* The only way this can be true, after isfloat_string
2114 returns 1, is if the input ends in e+INF or e+NaN. */
2115 if (p
[-1] == 'F' || p
[-1] == 'N')
2118 value
= zero
/ zero
;
2119 else if (read_buffer
[0] == '-')
2120 value
= - 1.0 / zero
;
2124 return make_float (value
);
2129 if (uninterned_symbol
)
2130 return make_symbol (read_buffer
);
2132 return intern (read_buffer
);
2137 #ifdef LISP_FLOAT_TYPE
2154 if (*cp
== '+' || *cp
== '-')
2157 if (*cp
>= '0' && *cp
<= '9')
2160 while (*cp
>= '0' && *cp
<= '9')
2168 if (*cp
>= '0' && *cp
<= '9')
2171 while (*cp
>= '0' && *cp
<= '9')
2174 if (*cp
== 'e' || *cp
== 'E')
2178 if (*cp
== '+' || *cp
== '-')
2182 if (*cp
>= '0' && *cp
<= '9')
2185 while (*cp
>= '0' && *cp
<= '9')
2188 else if (cp
== start
)
2190 else if (cp
[-1] == '+' && cp
[0] == 'I' && cp
[1] == 'N' && cp
[2] == 'F')
2195 else if (cp
[-1] == '+' && cp
[0] == 'N' && cp
[1] == 'a' && cp
[2] == 'N')
2201 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
2202 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
2203 || state
== (DOT_CHAR
|TRAIL_INT
)
2204 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
2205 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
2206 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
2208 #endif /* LISP_FLOAT_TYPE */
2211 read_vector (readcharfun
, bytecodeflag
)
2212 Lisp_Object readcharfun
;
2217 register Lisp_Object
*ptr
;
2218 register Lisp_Object tem
, item
, vector
;
2219 register struct Lisp_Cons
*otem
;
2222 tem
= read_list (1, readcharfun
);
2223 len
= Flength (tem
);
2224 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
2226 size
= XVECTOR (vector
)->size
;
2227 ptr
= XVECTOR (vector
)->contents
;
2228 for (i
= 0; i
< size
; i
++)
2231 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2232 bytecode object, the docstring containing the bytecode and
2233 constants values must be treated as unibyte and passed to
2234 Fread, to get the actual bytecode string and constants vector. */
2235 if (bytecodeflag
&& load_force_doc_strings
)
2237 if (i
== COMPILED_BYTECODE
)
2239 if (!STRINGP (item
))
2240 error ("invalid byte code");
2242 /* Delay handling the bytecode slot until we know whether
2243 it is lazily-loaded (we can tell by whether the
2244 constants slot is nil). */
2245 ptr
[COMPILED_CONSTANTS
] = item
;
2248 else if (i
== COMPILED_CONSTANTS
)
2250 Lisp_Object bytestr
= ptr
[COMPILED_CONSTANTS
];
2254 /* Coerce string to unibyte (like string-as-unibyte,
2255 but without generating extra garbage and
2256 guaranteeing no change in the contents). */
2257 XSTRING (bytestr
)->size
= STRING_BYTES (XSTRING (bytestr
));
2258 SET_STRING_BYTES (XSTRING (bytestr
), -1);
2260 item
= Fread (bytestr
);
2262 error ("invalid byte code");
2264 otem
= XCONS (item
);
2265 bytestr
= XCONS (item
)->car
;
2266 item
= XCONS (item
)->cdr
;
2270 /* Now handle the bytecode slot. */
2271 ptr
[COMPILED_BYTECODE
] = read_pure
? Fpurecopy (bytestr
) : bytestr
;
2274 ptr
[i
] = read_pure
? Fpurecopy (item
) : item
;
2282 /* FLAG = 1 means check for ] to terminate rather than ) and .
2283 FLAG = -1 means check for starting with defun
2284 and make structure pure. */
2287 read_list (flag
, readcharfun
)
2289 register Lisp_Object readcharfun
;
2291 /* -1 means check next element for defun,
2292 0 means don't check,
2293 1 means already checked and found defun. */
2294 int defunflag
= flag
< 0 ? -1 : 0;
2295 Lisp_Object val
, tail
;
2296 register Lisp_Object elt
, tem
;
2297 struct gcpro gcpro1
, gcpro2
;
2298 /* 0 is the normal case.
2299 1 means this list is a doc reference; replace it with the number 0.
2300 2 means this list is a doc reference; replace it with the doc string. */
2301 int doc_reference
= 0;
2303 /* Initialize this to 1 if we are reading a list. */
2304 int first_in_list
= flag
<= 0;
2313 elt
= read1 (readcharfun
, &ch
, first_in_list
);
2318 /* While building, if the list starts with #$, treat it specially. */
2319 if (EQ (elt
, Vload_file_name
)
2321 && !NILP (Vpurify_flag
))
2323 if (NILP (Vdoc_file_name
))
2324 /* We have not yet called Snarf-documentation, so assume
2325 this file is described in the DOC-MM.NN file
2326 and Snarf-documentation will fill in the right value later.
2327 For now, replace the whole list with 0. */
2330 /* We have already called Snarf-documentation, so make a relative
2331 file name for this file, so it can be found properly
2332 in the installed Lisp directory.
2333 We don't use Fexpand_file_name because that would make
2334 the directory absolute now. */
2335 elt
= concat2 (build_string ("../lisp/"),
2336 Ffile_name_nondirectory (elt
));
2338 else if (EQ (elt
, Vload_file_name
)
2340 && load_force_doc_strings
)
2349 Fsignal (Qinvalid_read_syntax
,
2350 Fcons (make_string (") or . in a vector", 18), Qnil
));
2358 XCONS (tail
)->cdr
= read0 (readcharfun
);
2360 val
= read0 (readcharfun
);
2361 read1 (readcharfun
, &ch
, 0);
2365 if (doc_reference
== 1)
2366 return make_number (0);
2367 if (doc_reference
== 2)
2369 /* Get a doc string from the file we are loading.
2370 If it's in saved_doc_string, get it from there. */
2371 int pos
= XINT (XCONS (val
)->cdr
);
2372 /* Position is negative for user variables. */
2373 if (pos
< 0) pos
= -pos
;
2374 if (pos
>= saved_doc_string_position
2375 && pos
< (saved_doc_string_position
2376 + saved_doc_string_length
))
2378 int start
= pos
- saved_doc_string_position
;
2381 /* Process quoting with ^A,
2382 and find the end of the string,
2383 which is marked with ^_ (037). */
2384 for (from
= start
, to
= start
;
2385 saved_doc_string
[from
] != 037;)
2387 int c
= saved_doc_string
[from
++];
2390 c
= saved_doc_string
[from
++];
2392 saved_doc_string
[to
++] = c
;
2394 saved_doc_string
[to
++] = 0;
2396 saved_doc_string
[to
++] = 037;
2399 saved_doc_string
[to
++] = c
;
2402 return make_string (saved_doc_string
+ start
,
2405 /* Look in prev_saved_doc_string the same way. */
2406 else if (pos
>= prev_saved_doc_string_position
2407 && pos
< (prev_saved_doc_string_position
2408 + prev_saved_doc_string_length
))
2410 int start
= pos
- prev_saved_doc_string_position
;
2413 /* Process quoting with ^A,
2414 and find the end of the string,
2415 which is marked with ^_ (037). */
2416 for (from
= start
, to
= start
;
2417 prev_saved_doc_string
[from
] != 037;)
2419 int c
= prev_saved_doc_string
[from
++];
2422 c
= prev_saved_doc_string
[from
++];
2424 prev_saved_doc_string
[to
++] = c
;
2426 prev_saved_doc_string
[to
++] = 0;
2428 prev_saved_doc_string
[to
++] = 037;
2431 prev_saved_doc_string
[to
++] = c
;
2434 return make_string (prev_saved_doc_string
+ start
,
2438 return get_doc_string (val
, 0, 0);
2443 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
2445 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
2447 tem
= (read_pure
&& flag
<= 0
2448 ? pure_cons (elt
, Qnil
)
2449 : Fcons (elt
, Qnil
));
2451 XCONS (tail
)->cdr
= tem
;
2456 defunflag
= EQ (elt
, Qdefun
);
2457 else if (defunflag
> 0)
2462 Lisp_Object Vobarray
;
2463 Lisp_Object initial_obarray
;
2465 /* oblookup stores the bucket number here, for the sake of Funintern. */
2467 int oblookup_last_bucket_number
;
2469 static int hash_string ();
2470 Lisp_Object
oblookup ();
2472 /* Get an error if OBARRAY is not an obarray.
2473 If it is one, return it. */
2476 check_obarray (obarray
)
2477 Lisp_Object obarray
;
2479 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2481 /* If Vobarray is now invalid, force it to be valid. */
2482 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
2484 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2489 /* Intern the C string STR: return a symbol with that name,
2490 interned in the current obarray. */
2497 int len
= strlen (str
);
2498 Lisp_Object obarray
;
2501 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2502 obarray
= check_obarray (obarray
);
2503 tem
= oblookup (obarray
, str
, len
, len
);
2506 return Fintern (make_string (str
, len
), obarray
);
2509 /* Create an uninterned symbol with name STR. */
2515 int len
= strlen (str
);
2517 return Fmake_symbol ((!NILP (Vpurify_flag
)
2518 ? make_pure_string (str
, len
, len
, 0)
2519 : make_string (str
, len
)));
2522 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2523 "Return the canonical symbol whose name is STRING.\n\
2524 If there is none, one is created by this function and returned.\n\
2525 A second optional argument specifies the obarray to use;\n\
2526 it defaults to the value of `obarray'.")
2528 Lisp_Object string
, obarray
;
2530 register Lisp_Object tem
, sym
, *ptr
;
2532 if (NILP (obarray
)) obarray
= Vobarray
;
2533 obarray
= check_obarray (obarray
);
2535 CHECK_STRING (string
, 0);
2537 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2538 XSTRING (string
)->size
,
2539 STRING_BYTES (XSTRING (string
)));
2540 if (!INTEGERP (tem
))
2543 if (!NILP (Vpurify_flag
))
2544 string
= Fpurecopy (string
);
2545 sym
= Fmake_symbol (string
);
2546 XSYMBOL (sym
)->obarray
= obarray
;
2548 if ((XSTRING (string
)->data
[0] == ':')
2549 && EQ (obarray
, initial_obarray
))
2550 XSYMBOL (sym
)->value
= sym
;
2552 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2554 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2556 XSYMBOL (sym
)->next
= 0;
2561 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2562 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2563 A second optional argument specifies the obarray to use;\n\
2564 it defaults to the value of `obarray'.")
2566 Lisp_Object string
, obarray
;
2568 register Lisp_Object tem
;
2570 if (NILP (obarray
)) obarray
= Vobarray
;
2571 obarray
= check_obarray (obarray
);
2573 CHECK_STRING (string
, 0);
2575 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2576 XSTRING (string
)->size
,
2577 STRING_BYTES (XSTRING (string
)));
2578 if (!INTEGERP (tem
))
2583 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2584 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2585 The value is t if a symbol was found and deleted, nil otherwise.\n\
2586 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2587 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2588 OBARRAY defaults to the value of the variable `obarray'.")
2590 Lisp_Object name
, obarray
;
2592 register Lisp_Object string
, tem
;
2595 if (NILP (obarray
)) obarray
= Vobarray
;
2596 obarray
= check_obarray (obarray
);
2599 XSETSTRING (string
, XSYMBOL (name
)->name
);
2602 CHECK_STRING (name
, 0);
2606 tem
= oblookup (obarray
, XSTRING (string
)->data
,
2607 XSTRING (string
)->size
,
2608 STRING_BYTES (XSTRING (string
)));
2611 /* If arg was a symbol, don't delete anything but that symbol itself. */
2612 if (SYMBOLP (name
) && !EQ (name
, tem
))
2615 XSYMBOL (tem
)->obarray
= Qnil
;
2617 hash
= oblookup_last_bucket_number
;
2619 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2621 if (XSYMBOL (tem
)->next
)
2622 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2624 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2628 Lisp_Object tail
, following
;
2630 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2631 XSYMBOL (tail
)->next
;
2634 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2635 if (EQ (following
, tem
))
2637 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2646 /* Return the symbol in OBARRAY whose names matches the string
2647 of SIZE characters (SIZE_BYTE bytes) at PTR.
2648 If there is no such symbol in OBARRAY, return nil.
2650 Also store the bucket number in oblookup_last_bucket_number. */
2653 oblookup (obarray
, ptr
, size
, size_byte
)
2654 Lisp_Object obarray
;
2656 int size
, size_byte
;
2660 register Lisp_Object tail
;
2661 Lisp_Object bucket
, tem
;
2663 if (!VECTORP (obarray
)
2664 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2666 obarray
= check_obarray (obarray
);
2667 obsize
= XVECTOR (obarray
)->size
;
2669 /* This is sometimes needed in the middle of GC. */
2670 obsize
&= ~ARRAY_MARK_FLAG
;
2671 /* Combining next two lines breaks VMS C 2.3. */
2672 hash
= hash_string (ptr
, size_byte
);
2674 bucket
= XVECTOR (obarray
)->contents
[hash
];
2675 oblookup_last_bucket_number
= hash
;
2676 if (XFASTINT (bucket
) == 0)
2678 else if (!SYMBOLP (bucket
))
2679 error ("Bad data in guts of obarray"); /* Like CADR error message */
2681 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2683 if (STRING_BYTES (XSYMBOL (tail
)->name
) == size_byte
2684 && XSYMBOL (tail
)->name
->size
== size
2685 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size_byte
))
2687 else if (XSYMBOL (tail
)->next
== 0)
2690 XSETINT (tem
, hash
);
2695 hash_string (ptr
, len
)
2699 register unsigned char *p
= ptr
;
2700 register unsigned char *end
= p
+ len
;
2701 register unsigned char c
;
2702 register int hash
= 0;
2707 if (c
>= 0140) c
-= 40;
2708 hash
= ((hash
<<3) + (hash
>>28) + c
);
2710 return hash
& 07777777777;
2714 map_obarray (obarray
, fn
, arg
)
2715 Lisp_Object obarray
;
2716 void (*fn
) P_ ((Lisp_Object
, Lisp_Object
));
2720 register Lisp_Object tail
;
2721 CHECK_VECTOR (obarray
, 1);
2722 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2724 tail
= XVECTOR (obarray
)->contents
[i
];
2729 if (XSYMBOL (tail
)->next
== 0)
2731 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2737 mapatoms_1 (sym
, function
)
2738 Lisp_Object sym
, function
;
2740 call1 (function
, sym
);
2743 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2744 "Call FUNCTION on every symbol in OBARRAY.\n\
2745 OBARRAY defaults to the value of `obarray'.")
2747 Lisp_Object function
, obarray
;
2751 if (NILP (obarray
)) obarray
= Vobarray
;
2752 obarray
= check_obarray (obarray
);
2754 map_obarray (obarray
, mapatoms_1
, function
);
2758 #define OBARRAY_SIZE 1511
2763 Lisp_Object oblength
;
2767 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2769 Qnil
= Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
2770 Vobarray
= Fmake_vector (oblength
, make_number (0));
2771 initial_obarray
= Vobarray
;
2772 staticpro (&initial_obarray
);
2773 /* Intern nil in the obarray */
2774 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2775 /* These locals are to kludge around a pyramid compiler bug. */
2776 hash
= hash_string ("nil", 3);
2777 /* Separate statement here to avoid VAXC bug. */
2778 hash
%= OBARRAY_SIZE
;
2779 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2782 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
2783 XSYMBOL (Qnil
)->function
= Qunbound
;
2784 XSYMBOL (Qunbound
)->value
= Qunbound
;
2785 XSYMBOL (Qunbound
)->function
= Qunbound
;
2788 XSYMBOL (Qnil
)->value
= Qnil
;
2789 XSYMBOL (Qnil
)->plist
= Qnil
;
2790 XSYMBOL (Qt
)->value
= Qt
;
2792 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2795 Qvariable_documentation
= intern ("variable-documentation");
2796 staticpro (&Qvariable_documentation
);
2798 read_buffer_size
= 100 + MAX_LENGTH_OF_MULTI_BYTE_FORM
;
2799 read_buffer
= (char *) malloc (read_buffer_size
);
2804 struct Lisp_Subr
*sname
;
2807 sym
= intern (sname
->symbol_name
);
2808 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2811 #ifdef NOTDEF /* use fset in subr.el now */
2813 defalias (sname
, string
)
2814 struct Lisp_Subr
*sname
;
2818 sym
= intern (string
);
2819 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2823 /* Define an "integer variable"; a symbol whose value is forwarded
2824 to a C variable of type int. Sample call: */
2825 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2827 defvar_int (namestring
, address
)
2831 Lisp_Object sym
, val
;
2832 sym
= intern (namestring
);
2833 val
= allocate_misc ();
2834 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2835 XINTFWD (val
)->intvar
= address
;
2836 XSYMBOL (sym
)->value
= val
;
2839 /* Similar but define a variable whose value is T if address contains 1,
2840 NIL if address contains 0 */
2842 defvar_bool (namestring
, address
)
2846 Lisp_Object sym
, val
;
2847 sym
= intern (namestring
);
2848 val
= allocate_misc ();
2849 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2850 XBOOLFWD (val
)->boolvar
= address
;
2851 XSYMBOL (sym
)->value
= val
;
2854 /* Similar but define a variable whose value is the Lisp Object stored
2855 at address. Two versions: with and without gc-marking of the C
2856 variable. The nopro version is used when that variable will be
2857 gc-marked for some other reason, since marking the same slot twice
2858 can cause trouble with strings. */
2860 defvar_lisp_nopro (namestring
, address
)
2862 Lisp_Object
*address
;
2864 Lisp_Object sym
, val
;
2865 sym
= intern (namestring
);
2866 val
= allocate_misc ();
2867 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2868 XOBJFWD (val
)->objvar
= address
;
2869 XSYMBOL (sym
)->value
= val
;
2873 defvar_lisp (namestring
, address
)
2875 Lisp_Object
*address
;
2877 defvar_lisp_nopro (namestring
, address
);
2878 staticpro (address
);
2883 /* Similar but define a variable whose value is the Lisp Object stored in
2884 the current buffer. address is the address of the slot in the buffer
2885 that is current now. */
2888 defvar_per_buffer (namestring
, address
, type
, doc
)
2890 Lisp_Object
*address
;
2894 Lisp_Object sym
, val
;
2896 extern struct buffer buffer_local_symbols
;
2898 sym
= intern (namestring
);
2899 val
= allocate_misc ();
2900 offset
= (char *)address
- (char *)current_buffer
;
2902 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2903 XBUFFER_OBJFWD (val
)->offset
= offset
;
2904 XSYMBOL (sym
)->value
= val
;
2905 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2906 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2907 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2908 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2909 slot of buffer_local_flags */
2913 #endif /* standalone */
2915 /* Similar but define a variable whose value is the Lisp Object stored
2916 at a particular offset in the current kboard object. */
2919 defvar_kboard (namestring
, offset
)
2923 Lisp_Object sym
, val
;
2924 sym
= intern (namestring
);
2925 val
= allocate_misc ();
2926 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2927 XKBOARD_OBJFWD (val
)->offset
= offset
;
2928 XSYMBOL (sym
)->value
= val
;
2931 /* Record the value of load-path used at the start of dumping
2932 so we can see if the site changed it later during dumping. */
2933 static Lisp_Object dump_path
;
2939 int turn_off_warning
= 0;
2941 #ifdef HAVE_SETLOCALE
2942 /* Make sure numbers are parsed as we expect. */
2943 setlocale (LC_NUMERIC
, "C");
2944 #endif /* HAVE_SETLOCALE */
2946 /* Compute the default load-path. */
2948 normal
= PATH_LOADSEARCH
;
2949 Vload_path
= decode_env_path (0, normal
);
2951 if (NILP (Vpurify_flag
))
2952 normal
= PATH_LOADSEARCH
;
2954 normal
= PATH_DUMPLOADSEARCH
;
2956 /* In a dumped Emacs, we normally have to reset the value of
2957 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2958 uses ../lisp, instead of the path of the installed elisp
2959 libraries. However, if it appears that Vload_path was changed
2960 from the default before dumping, don't override that value. */
2963 if (! NILP (Fequal (dump_path
, Vload_path
)))
2965 Vload_path
= decode_env_path (0, normal
);
2966 if (!NILP (Vinstallation_directory
))
2968 /* Add to the path the lisp subdir of the
2969 installation dir, if it exists. */
2970 Lisp_Object tem
, tem1
;
2971 tem
= Fexpand_file_name (build_string ("lisp"),
2972 Vinstallation_directory
);
2973 tem1
= Ffile_exists_p (tem
);
2976 if (NILP (Fmember (tem
, Vload_path
)))
2978 turn_off_warning
= 1;
2979 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2983 /* That dir doesn't exist, so add the build-time
2984 Lisp dirs instead. */
2985 Vload_path
= nconc2 (Vload_path
, dump_path
);
2987 /* Add leim under the installation dir, if it exists. */
2988 tem
= Fexpand_file_name (build_string ("leim"),
2989 Vinstallation_directory
);
2990 tem1
= Ffile_exists_p (tem
);
2993 if (NILP (Fmember (tem
, Vload_path
)))
2994 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2997 /* Add site-list under the installation dir, if it exists. */
2998 tem
= Fexpand_file_name (build_string ("site-lisp"),
2999 Vinstallation_directory
);
3000 tem1
= Ffile_exists_p (tem
);
3003 if (NILP (Fmember (tem
, Vload_path
)))
3004 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3007 /* If Emacs was not built in the source directory,
3008 and it is run from where it was built, add to load-path
3009 the lisp, leim and site-lisp dirs under that directory. */
3011 if (NILP (Fequal (Vinstallation_directory
, Vsource_directory
)))
3015 tem
= Fexpand_file_name (build_string ("src/Makefile"),
3016 Vinstallation_directory
);
3017 tem1
= Ffile_exists_p (tem
);
3019 /* Don't be fooled if they moved the entire source tree
3020 AFTER dumping Emacs. If the build directory is indeed
3021 different from the source dir, src/Makefile.in and
3022 src/Makefile will not be found together. */
3023 tem
= Fexpand_file_name (build_string ("src/Makefile.in"),
3024 Vinstallation_directory
);
3025 tem2
= Ffile_exists_p (tem
);
3026 if (!NILP (tem1
) && NILP (tem2
))
3028 tem
= Fexpand_file_name (build_string ("lisp"),
3031 if (NILP (Fmember (tem
, Vload_path
)))
3032 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3034 tem
= Fexpand_file_name (build_string ("leim"),
3037 if (NILP (Fmember (tem
, Vload_path
)))
3038 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3040 tem
= Fexpand_file_name (build_string ("site-lisp"),
3043 if (NILP (Fmember (tem
, Vload_path
)))
3044 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
3052 /* NORMAL refers to the lisp dir in the source directory. */
3053 /* We used to add ../lisp at the front here, but
3054 that caused trouble because it was copied from dump_path
3055 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3056 It should be unnecessary. */
3057 Vload_path
= decode_env_path (0, normal
);
3058 dump_path
= Vload_path
;
3063 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3064 almost never correct, thereby causing a warning to be printed out that
3065 confuses users. Since PATH_LOADSEARCH is always overridden by the
3066 EMACSLOADPATH environment variable below, disable the warning on NT. */
3068 /* Warn if dirs in the *standard* path don't exist. */
3069 if (!turn_off_warning
)
3071 Lisp_Object path_tail
;
3073 for (path_tail
= Vload_path
;
3075 path_tail
= XCONS (path_tail
)->cdr
)
3077 Lisp_Object dirfile
;
3078 dirfile
= Fcar (path_tail
);
3079 if (STRINGP (dirfile
))
3081 dirfile
= Fdirectory_file_name (dirfile
);
3082 if (access (XSTRING (dirfile
)->data
, 0) < 0)
3083 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3084 XCONS (path_tail
)->car
);
3088 #endif /* WINDOWSNT */
3090 /* If the EMACSLOADPATH environment variable is set, use its value.
3091 This doesn't apply if we're dumping. */
3093 if (NILP (Vpurify_flag
)
3094 && egetenv ("EMACSLOADPATH"))
3096 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
3100 load_in_progress
= 0;
3101 Vload_file_name
= Qnil
;
3103 load_descriptor_list
= Qnil
;
3105 Vstandard_input
= Qt
;
3108 /* Print a warning, using format string FORMAT, that directory DIRNAME
3109 does not exist. Print it on stderr and put it in *Message*. */
3112 dir_warning (format
, dirname
)
3114 Lisp_Object dirname
;
3117 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
3119 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
3120 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
3121 /* Don't log the warning before we've initialized!! */
3123 message_dolog (buffer
, strlen (buffer
), 0, STRING_MULTIBYTE (dirname
));
3130 defsubr (&Sread_from_string
);
3132 defsubr (&Sintern_soft
);
3133 defsubr (&Sunintern
);
3135 defsubr (&Seval_buffer
);
3136 defsubr (&Seval_region
);
3137 defsubr (&Sread_char
);
3138 defsubr (&Sread_char_exclusive
);
3139 defsubr (&Sread_event
);
3140 defsubr (&Sget_file_char
);
3141 defsubr (&Smapatoms
);
3143 DEFVAR_LISP ("obarray", &Vobarray
,
3144 "Symbol table for use by `intern' and `read'.\n\
3145 It is a vector whose length ought to be prime for best results.\n\
3146 The vector's contents don't make sense if examined from Lisp programs;\n\
3147 to find all the symbols in an obarray, use `mapatoms'.");
3149 DEFVAR_LISP ("values", &Vvalues
,
3150 "List of values of all expressions which were read, evaluated and printed.\n\
3151 Order is reverse chronological.");
3153 DEFVAR_LISP ("standard-input", &Vstandard_input
,
3154 "Stream for read to get input from.\n\
3155 See documentation of `read' for possible values.");
3156 Vstandard_input
= Qt
;
3158 DEFVAR_LISP ("load-path", &Vload_path
,
3159 "*List of directories to search for files to load.\n\
3160 Each element is a string (directory name) or nil (try default directory).\n\
3161 Initialized based on EMACSLOADPATH environment variable, if any,\n\
3162 otherwise to default specified by file `paths.h' when Emacs was built.");
3164 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
3165 "Non-nil iff inside of `load'.");
3167 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
3168 "An alist of expressions to be evalled when particular files are loaded.\n\
3169 Each element looks like (FILENAME FORMS...).\n\
3170 When `load' is run and the file-name argument is FILENAME,\n\
3171 the FORMS in the corresponding element are executed at the end of loading.\n\n\
3172 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
3173 with no directory specified, since that is how `load' is normally called.\n\
3174 An error in FORMS does not undo the load,\n\
3175 but does prevent execution of the rest of the FORMS.");
3176 Vafter_load_alist
= Qnil
;
3178 DEFVAR_LISP ("load-history", &Vload_history
,
3179 "Alist mapping source file names to symbols and features.\n\
3180 Each alist element is a list that starts with a file name,\n\
3181 except for one element (optional) that starts with nil and describes\n\
3182 definitions evaluated from buffers not visiting files.\n\
3183 The remaining elements of each list are symbols defined as functions\n\
3184 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
3185 Vload_history
= Qnil
;
3187 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
3188 "Full name of file being loaded by `load'.");
3189 Vload_file_name
= Qnil
;
3191 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
3192 "Used for internal purposes by `load'.");
3193 Vcurrent_load_list
= Qnil
;
3195 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
3196 "Function used by `load' and `eval-region' for reading expressions.\n\
3197 The default is nil, which means use the function `read'.");
3198 Vload_read_function
= Qnil
;
3200 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
3201 "Function called in `load' for loading an Emacs lisp source file.\n\
3202 This function is for doing code conversion before reading the source file.\n\
3203 If nil, loading is done without any code conversion.\n\
3204 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
3205 FULLNAME is the full name of FILE.\n\
3206 See `load' for the meaning of the remaining arguments.");
3207 Vload_source_file_function
= Qnil
;
3209 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
3210 "Non-nil means `load' should force-load all dynamic doc strings.\n\
3211 This is useful when the file being loaded is a temporary copy.");
3212 load_force_doc_strings
= 0;
3214 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte
,
3215 "Non-nil means `load' converts strings to unibyte whenever possible.\n\
3216 This is normally used in `load-with-code-conversion'\n\
3217 for loading non-compiled files.");
3218 load_convert_to_unibyte
= 0;
3220 DEFVAR_LISP ("source-directory", &Vsource_directory
,
3221 "Directory in which Emacs sources were found when Emacs was built.\n\
3222 You cannot count on them to still be there!");
3224 = Fexpand_file_name (build_string ("../"),
3225 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
3227 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list
,
3228 "List of files that were preloaded (when dumping Emacs).");
3229 Vpreloaded_file_list
= Qnil
;
3231 /* Vsource_directory was initialized in init_lread. */
3233 load_descriptor_list
= Qnil
;
3234 staticpro (&load_descriptor_list
);
3236 Qcurrent_load_list
= intern ("current-load-list");
3237 staticpro (&Qcurrent_load_list
);
3239 Qstandard_input
= intern ("standard-input");
3240 staticpro (&Qstandard_input
);
3242 Qread_char
= intern ("read-char");
3243 staticpro (&Qread_char
);
3245 Qget_file_char
= intern ("get-file-char");
3246 staticpro (&Qget_file_char
);
3248 Qbackquote
= intern ("`");
3249 staticpro (&Qbackquote
);
3250 Qcomma
= intern (",");
3251 staticpro (&Qcomma
);
3252 Qcomma_at
= intern (",@");
3253 staticpro (&Qcomma_at
);
3254 Qcomma_dot
= intern (",.");
3255 staticpro (&Qcomma_dot
);
3257 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
3258 staticpro (&Qinhibit_file_name_operation
);
3260 Qascii_character
= intern ("ascii-character");
3261 staticpro (&Qascii_character
);
3263 Qfunction
= intern ("function");
3264 staticpro (&Qfunction
);
3266 Qload
= intern ("load");
3269 Qload_file_name
= intern ("load-file-name");
3270 staticpro (&Qload_file_name
);
3272 staticpro (&dump_path
);
3274 staticpro (&read_objects
);
3275 read_objects
= Qnil
;