1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989,
3 1993, 1994, 1995 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
24 #include <sys/types.h>
35 #include "termhooks.h"
39 #include <sys/inode.h>
46 #ifdef LISP_FLOAT_TYPE
53 /* These are redefined (correctly, but differently) in values.h. */
60 #endif /* LISP_FLOAT_TYPE */
68 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
69 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
70 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
71 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
;
73 extern Lisp_Object Qevent_symbol_element_mask
;
75 /* non-zero if inside `load' */
78 /* Search path for files to be loaded. */
79 Lisp_Object Vload_path
;
81 /* This is the user-visible association list that maps features to
82 lists of defs in their load files. */
83 Lisp_Object Vload_history
;
85 /* This is used to build the load history. */
86 Lisp_Object Vcurrent_load_list
;
88 /* Name of file actually being read by `load'. */
89 Lisp_Object Vload_file_name
;
91 /* Function to use for reading, in `load' and friends. */
92 Lisp_Object Vload_read_function
;
94 /* List of descriptors now open for Fload. */
95 static Lisp_Object load_descriptor_list
;
97 /* File for get_file_char to read from. Use by load */
98 static FILE *instream
;
100 /* When nonzero, read conses in pure space */
101 static int read_pure
;
103 /* For use within read-from-string (this reader is non-reentrant!!) */
104 static int read_from_string_index
;
105 static int read_from_string_limit
;
107 /* Nonzero means inside a new-style backquote
108 with no surrounding parentheses.
109 Fread initializes this to zero, so we need not specbind it
110 or worry about what happens to it when there is an error. */
111 static int new_backquote_flag
;
113 /* Handle unreading and rereading of characters.
114 Write READCHAR to read a character,
115 UNREAD(c) to unread c to be read again. */
117 #define READCHAR readchar (readcharfun)
118 #define UNREAD(c) unreadchar (readcharfun, c)
121 readchar (readcharfun
)
122 Lisp_Object readcharfun
;
125 register struct buffer
*inbuffer
;
126 register int c
, mpos
;
128 if (BUFFERP (readcharfun
))
130 inbuffer
= XBUFFER (readcharfun
);
132 if (BUF_PT (inbuffer
) >= BUF_ZV (inbuffer
))
134 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, BUF_PT (inbuffer
));
135 SET_BUF_PT (inbuffer
, BUF_PT (inbuffer
) + 1);
139 if (MARKERP (readcharfun
))
141 inbuffer
= XMARKER (readcharfun
)->buffer
;
143 mpos
= marker_position (readcharfun
);
145 if (mpos
> BUF_ZV (inbuffer
) - 1)
147 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, mpos
);
148 if (mpos
!= BUF_GPT (inbuffer
))
149 XMARKER (readcharfun
)->bufpos
++;
151 Fset_marker (readcharfun
, make_number (mpos
+ 1),
152 Fmarker_buffer (readcharfun
));
155 if (EQ (readcharfun
, Qget_file_char
))
159 /* Interrupted reads have been observed while reading over the network */
160 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
169 if (STRINGP (readcharfun
))
172 /* This used to be return of a conditional expression,
173 but that truncated -1 to a char on VMS. */
174 if (read_from_string_index
< read_from_string_limit
)
175 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
181 tem
= call0 (readcharfun
);
188 /* Unread the character C in the way appropriate for the stream READCHARFUN.
189 If the stream is a user function, call it with the char as argument. */
192 unreadchar (readcharfun
, c
)
193 Lisp_Object readcharfun
;
197 /* Don't back up the pointer if we're unreading the end-of-input mark,
198 since readchar didn't advance it when we read it. */
200 else if (BUFFERP (readcharfun
))
202 if (XBUFFER (readcharfun
) == current_buffer
)
205 SET_BUF_PT (XBUFFER (readcharfun
), BUF_PT (XBUFFER (readcharfun
)) - 1);
207 else if (MARKERP (readcharfun
))
208 XMARKER (readcharfun
)->bufpos
--;
209 else if (STRINGP (readcharfun
))
210 read_from_string_index
--;
211 else if (EQ (readcharfun
, Qget_file_char
))
212 ungetc (c
, instream
);
214 call1 (readcharfun
, make_number (c
));
217 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
219 /* get a character from the tty */
221 extern Lisp_Object
read_char ();
223 /* Read input events until we get one that's acceptable for our purposes.
225 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
226 until we get a character we like, and then stuffed into
229 If ASCII_REQUIRED is non-zero, we check function key events to see
230 if the unmodified version of the symbol has a Qascii_character
231 property, and use that character, if present.
233 If ERROR_NONASCII is non-zero, we signal an error if the input we
234 get isn't an ASCII character with modifiers. If it's zero but
235 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
238 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
239 int no_switch_frame
, ascii_required
, error_nonascii
;
242 return make_number (getchar ());
244 register Lisp_Object val
, delayed_switch_frame
;
246 delayed_switch_frame
= Qnil
;
248 /* Read until we get an acceptable event. */
250 val
= read_char (0, 0, 0, Qnil
, 0);
255 /* switch-frame events are put off until after the next ASCII
256 character. This is better than signalling an error just because
257 the last characters were typed to a separate minibuffer frame,
258 for example. Eventually, some code which can deal with
259 switch-frame events will read it and process it. */
261 && EVENT_HAS_PARAMETERS (val
)
262 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
264 delayed_switch_frame
= val
;
270 /* Convert certain symbols to their ASCII equivalents. */
273 Lisp_Object tem
, tem1
, tem2
;
274 tem
= Fget (val
, Qevent_symbol_element_mask
);
277 tem1
= Fget (Fcar (tem
), Qascii_character
);
278 /* Merge this symbol's modifier bits
279 with the ASCII equivalent of its basic code. */
281 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
285 /* If we don't have a character now, deal with it appropriately. */
290 Vunread_command_events
= Fcons (val
, Qnil
);
291 error ("Non-character input-event");
298 if (! NILP (delayed_switch_frame
))
299 unread_switch_frame
= delayed_switch_frame
;
305 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
306 "Read a character from the command input (keyboard or macro).\n\
307 It is returned as a number.\n\
308 If the user generates an event which is not a character (i.e. a mouse\n\
309 click or function key event), `read-char' signals an error. As an\n\
310 exception, switch-frame events are put off until non-ASCII events can\n\
312 If you want to read non-character events, or ignore them, call\n\
313 `read-event' or `read-char-exclusive' instead.")
316 return read_filtered_event (1, 1, 1);
319 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
320 "Read an event object from the input stream.")
323 return read_filtered_event (0, 0, 0);
326 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
327 "Read a character from the command input (keyboard or macro).\n\
328 It is returned as a number. Non character events are ignored.")
331 return read_filtered_event (1, 1, 0);
334 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
335 "Don't use this yourself.")
338 register Lisp_Object val
;
339 XSETINT (val
, getc (instream
));
343 static void readevalloop ();
344 static Lisp_Object
load_unwind ();
345 static Lisp_Object
load_descriptor_unwind ();
347 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
348 "Execute a file of Lisp code named FILE.\n\
349 First try FILE with `.elc' appended, then try with `.el',\n\
350 then try FILE unmodified.\n\
351 This function searches the directories in `load-path'.\n\
352 If optional second arg NOERROR is non-nil,\n\
353 report no error if FILE doesn't exist.\n\
354 Print messages at start and end of loading unless\n\
355 optional third arg NOMESSAGE is non-nil.\n\
356 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
357 suffixes `.elc' or `.el' to the specified name FILE.\n\
358 Return t if file exists.")
359 (str
, noerror
, nomessage
, nosuffix
)
360 Lisp_Object str
, noerror
, nomessage
, nosuffix
;
362 register FILE *stream
;
363 register int fd
= -1;
364 register Lisp_Object lispstream
;
365 int count
= specpdl_ptr
- specpdl
;
369 /* 1 means inhibit the message at the beginning. */
373 char *dosmode
= "rt";
376 CHECK_STRING (str
, 0);
378 /* If file name is magic, call the handler. */
379 handler
= Ffind_file_name_handler (str
, Qload
);
381 return call5 (handler
, Qload
, str
, noerror
, nomessage
, nosuffix
);
383 /* Do this after the handler to avoid
384 the need to gcpro noerror, nomessage and nosuffix.
385 (Below here, we care only whether they are nil or not.) */
386 str
= Fsubstitute_in_file_name (str
);
388 /* Avoid weird lossage with null string as arg,
389 since it would try to load a directory as a Lisp file */
390 if (XSTRING (str
)->size
> 0)
393 fd
= openp (Vload_path
, str
, !NILP (nosuffix
) ? "" : ".elc:.el:",
402 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
408 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
417 stat ((char *)XSTRING (found
)->data
, &s1
);
418 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
419 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
420 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
422 message ("Source file `%s' newer than byte-compiled file",
423 XSTRING (found
)->data
);
424 /* Don't immediately overwrite this message. */
428 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
433 stream
= fopen ((char *) XSTRING (found
)->data
, dosmode
);
434 #else /* not DOS_NT */
435 stream
= fdopen (fd
, "r");
436 #endif /* not DOS_NT */
440 error ("Failure to create stdio stream for %s", XSTRING (str
)->data
);
443 if (NILP (nomessage
) && !nomessage1
)
444 message ("Loading %s...", XSTRING (str
)->data
);
447 lispstream
= Fcons (Qnil
, Qnil
);
448 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
449 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
450 record_unwind_protect (load_unwind
, lispstream
);
451 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
452 specbind (Qload_file_name
, found
);
454 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
456 readevalloop (Qget_file_char
, stream
, str
, Feval
, 0);
457 unbind_to (count
, Qnil
);
459 /* Run any load-hooks for this file. */
460 temp
= Fassoc (str
, Vafter_load_alist
);
462 Fprogn (Fcdr (temp
));
465 if (!noninteractive
&& NILP (nomessage
))
466 message ("Loading %s...done", XSTRING (str
)->data
);
471 load_unwind (stream
) /* used as unwind-protect function in load */
474 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
475 | XFASTINT (XCONS (stream
)->cdr
)));
476 if (--load_in_progress
< 0) load_in_progress
= 0;
481 load_descriptor_unwind (oldlist
)
484 load_descriptor_list
= oldlist
;
488 /* Close all descriptors in use for Floads.
489 This is used when starting a subprocess. */
495 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
496 close (XFASTINT (XCONS (tail
)->car
));
500 complete_filename_p (pathname
)
501 Lisp_Object pathname
;
503 register unsigned char *s
= XSTRING (pathname
)->data
;
504 return (IS_DIRECTORY_SEP (s
[0])
505 || (XSTRING (pathname
)->size
> 2
506 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
516 /* Search for a file whose name is STR, looking in directories
517 in the Lisp list PATH, and trying suffixes from SUFFIX.
518 SUFFIX is a string containing possible suffixes separated by colons.
519 On success, returns a file descriptor. On failure, returns -1.
521 EXEC_ONLY nonzero means don't open the files,
522 just look for one that is executable. In this case,
523 returns 1 on success.
525 If STOREPTR is nonzero, it points to a slot where the name of
526 the file actually found should be stored as a Lisp string.
527 Nil is stored there on failure. */
530 openp (path
, str
, suffix
, storeptr
, exec_only
)
531 Lisp_Object path
, str
;
533 Lisp_Object
*storeptr
;
539 register char *fn
= buf
;
542 register Lisp_Object filename
;
550 if (complete_filename_p (str
))
553 for (; !NILP (path
); path
= Fcdr (path
))
557 filename
= Fexpand_file_name (str
, Fcar (path
));
558 if (!complete_filename_p (filename
))
559 /* If there are non-absolute elts in PATH (eg ".") */
560 /* Of course, this could conceivably lose if luser sets
561 default-directory to be something non-absolute... */
563 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
564 if (!complete_filename_p (filename
))
565 /* Give up on this path element! */
569 /* Calculate maximum size of any filename made from
570 this path element/specified file name and any possible suffix. */
571 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
572 if (fn_size
< want_size
)
573 fn
= (char *) alloca (fn_size
= 100 + want_size
);
577 /* Loop over suffixes. */
580 char *esuffix
= (char *) index (nsuffix
, ':');
581 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
583 /* Concatenate path element/specified name with the suffix. */
584 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
585 fn
[XSTRING (filename
)->size
] = 0;
586 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
587 strncat (fn
, nsuffix
, lsuffix
);
589 /* Ignore file if it's a directory. */
590 if (stat (fn
, &st
) >= 0
591 && (st
.st_mode
& S_IFMT
) != S_IFDIR
)
593 /* Check that we can access or open it. */
595 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
597 fd
= open (fn
, O_RDONLY
, 0);
601 /* We succeeded; return this descriptor and filename. */
603 *storeptr
= build_string (fn
);
609 /* Advance to next suffix. */
612 nsuffix
+= lsuffix
+ 1;
623 /* Merge the list we've accumulated of globals from the current input source
624 into the load_history variable. The details depend on whether
625 the source has an associated file name or not. */
628 build_load_history (stream
, source
)
632 register Lisp_Object tail
, prev
, newelt
;
633 register Lisp_Object tem
, tem2
;
634 register int foundit
, loading
;
636 /* Don't bother recording anything for preloaded files. */
637 if (!NILP (Vpurify_flag
))
640 loading
= stream
|| !NARROWED
;
642 tail
= Vload_history
;
649 /* Find the feature's previous assoc list... */
650 if (!NILP (Fequal (source
, Fcar (tem
))))
654 /* If we're loading, remove it. */
658 Vload_history
= Fcdr (tail
);
660 Fsetcdr (prev
, Fcdr (tail
));
663 /* Otherwise, cons on new symbols that are not already members. */
666 tem2
= Vcurrent_load_list
;
670 newelt
= Fcar (tem2
);
672 if (NILP (Fmemq (newelt
, tem
)))
673 Fsetcar (tail
, Fcons (Fcar (tem
),
674 Fcons (newelt
, Fcdr (tem
))));
687 /* If we're loading, cons the new assoc onto the front of load-history,
688 the most-recently-loaded position. Also do this if we didn't find
689 an existing member for the current source. */
690 if (loading
|| !foundit
)
691 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
696 unreadpure () /* Used as unwind-protect function in readevalloop */
703 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
)
704 Lisp_Object readcharfun
;
706 Lisp_Object sourcename
;
707 Lisp_Object (*evalfun
) ();
711 register Lisp_Object val
;
712 int count
= specpdl_ptr
- specpdl
;
714 struct buffer
*b
= 0;
716 if (BUFFERP (readcharfun
))
717 b
= XBUFFER (readcharfun
);
718 else if (MARKERP (readcharfun
))
719 b
= XMARKER (readcharfun
)->buffer
;
721 specbind (Qstandard_input
, readcharfun
);
722 specbind (Qcurrent_load_list
, Qnil
);
726 LOADHIST_ATTACH (sourcename
);
730 if (b
!= 0 && NILP (b
->name
))
731 error ("Reading from killed buffer");
737 while ((c
= READCHAR
) != '\n' && c
!= -1);
742 /* Ignore whitespace here, so we can detect eof. */
743 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
746 if (!NILP (Vpurify_flag
) && c
== '(')
748 int count1
= specpdl_ptr
- specpdl
;
749 record_unwind_protect (unreadpure
, Qnil
);
750 val
= read_list (-1, readcharfun
);
751 unbind_to (count1
, Qnil
);
756 if (NILP (Vload_read_function
))
757 val
= read0 (readcharfun
);
759 val
= call1 (Vload_read_function
, readcharfun
);
762 val
= (*evalfun
) (val
);
765 Vvalues
= Fcons (val
, Vvalues
);
766 if (EQ (Vstandard_output
, Qt
))
773 build_load_history (stream
, sourcename
);
776 unbind_to (count
, Qnil
);
781 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
782 "Execute the current buffer as Lisp code.\n\
783 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
784 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
785 PRINTFLAG controls printing of output:\n\
786 nil means discard it; anything else is stream for print.\n\
788 If there is no error, point does not move. If there is an error,\n\
789 point remains at the end of the last character read from the buffer.")
791 Lisp_Object bufname
, printflag
;
793 int count
= specpdl_ptr
- specpdl
;
794 Lisp_Object tem
, buf
;
797 buf
= Fcurrent_buffer ();
799 buf
= Fget_buffer (bufname
);
801 error ("No such buffer.");
803 if (NILP (printflag
))
807 specbind (Qstandard_output
, tem
);
808 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
809 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
810 readevalloop (buf
, 0, XBUFFER (buf
)->filename
, Feval
, !NILP (printflag
));
811 unbind_to (count
, Qnil
);
817 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
818 "Execute the current buffer as Lisp code.\n\
819 Programs can pass argument PRINTFLAG which controls printing of output:\n\
820 nil means discard it; anything else is stream for print.\n\
822 If there is no error, point does not move. If there is an error,\n\
823 point remains at the end of the last character read from the buffer.")
825 Lisp_Object printflag
;
827 int count
= specpdl_ptr
- specpdl
;
828 Lisp_Object tem
, cbuf
;
830 cbuf
= Fcurrent_buffer ()
832 if (NILP (printflag
))
836 specbind (Qstandard_output
, tem
);
837 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
839 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
840 return unbind_to (count
, Qnil
);
844 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
845 "Execute the region as Lisp code.\n\
846 When called from programs, expects two arguments,\n\
847 giving starting and ending indices in the current buffer\n\
848 of the text to be executed.\n\
849 Programs can pass third argument PRINTFLAG which controls output:\n\
850 nil means discard it; anything else is stream for printing it.\n\
852 If there is no error, point does not move. If there is an error,\n\
853 point remains at the end of the last character read from the buffer.")
855 Lisp_Object b
, e
, printflag
;
857 int count
= specpdl_ptr
- specpdl
;
858 Lisp_Object tem
, cbuf
;
860 cbuf
= Fcurrent_buffer ();
862 if (NILP (printflag
))
866 specbind (Qstandard_output
, tem
);
868 if (NILP (printflag
))
869 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
870 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
872 /* This both uses b and checks its type. */
874 Fnarrow_to_region (make_number (BEGV
), e
);
875 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
877 return unbind_to (count
, Qnil
);
880 #endif /* standalone */
882 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
883 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
884 If STREAM is nil, use the value of `standard-input' (which see).\n\
885 STREAM or the value of `standard-input' may be:\n\
886 a buffer (read from point and advance it)\n\
887 a marker (read from where it points and advance it)\n\
888 a function (call it with no arguments for each character,\n\
889 call it with a char as argument to push a char back)\n\
890 a string (takes text from string, starting at the beginning)\n\
891 t (read text line using minibuffer and use it).")
895 extern Lisp_Object
Fread_minibuffer ();
898 stream
= Vstandard_input
;
902 new_backquote_flag
= 0;
905 if (EQ (stream
, Qread_char
))
906 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
909 if (STRINGP (stream
))
910 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
912 return read0 (stream
);
915 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
916 "Read one Lisp expression which is represented as text by STRING.\n\
917 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
918 START and END optionally delimit a substring of STRING from which to read;\n\
919 they default to 0 and (length STRING) respectively.")
921 Lisp_Object string
, start
, end
;
923 int startval
, endval
;
926 CHECK_STRING (string
,0);
929 endval
= XSTRING (string
)->size
;
931 { CHECK_NUMBER (end
,2);
933 if (endval
< 0 || endval
> XSTRING (string
)->size
)
934 args_out_of_range (string
, end
);
940 { CHECK_NUMBER (start
,1);
941 startval
= XINT (start
);
942 if (startval
< 0 || startval
> endval
)
943 args_out_of_range (string
, start
);
946 read_from_string_index
= startval
;
947 read_from_string_limit
= endval
;
949 new_backquote_flag
= 0;
951 tem
= read0 (string
);
952 return Fcons (tem
, make_number (read_from_string_index
));
955 /* Use this for recursive reads, in contexts where internal tokens
959 Lisp_Object readcharfun
;
961 register Lisp_Object val
;
964 val
= read1 (readcharfun
, &c
, 0);
966 Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
971 static int read_buffer_size
;
972 static char *read_buffer
;
975 read_escape (readcharfun
)
976 Lisp_Object readcharfun
;
978 register int c
= READCHAR
;
1005 error ("Invalid escape character syntax");
1008 c
= read_escape (readcharfun
);
1009 return c
| meta_modifier
;
1014 error ("Invalid escape character syntax");
1017 c
= read_escape (readcharfun
);
1018 return c
| shift_modifier
;
1023 error ("Invalid escape character syntax");
1026 c
= read_escape (readcharfun
);
1027 return c
| hyper_modifier
;
1032 error ("Invalid escape character syntax");
1035 c
= read_escape (readcharfun
);
1036 return c
| alt_modifier
;
1041 error ("Invalid escape character syntax");
1044 c
= read_escape (readcharfun
);
1045 return c
| super_modifier
;
1050 error ("Invalid escape character syntax");
1054 c
= read_escape (readcharfun
);
1055 if ((c
& 0177) == '?')
1057 /* ASCII control chars are made from letters (both cases),
1058 as well as the non-letters within 0100...0137. */
1059 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1060 return (c
& (037 | ~0177));
1061 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1062 return (c
& (037 | ~0177));
1064 return c
| ctrl_modifier
;
1074 /* An octal escape, as in ANSI C. */
1076 register int i
= c
- '0';
1077 register int count
= 0;
1080 if ((c
= READCHAR
) >= '0' && c
<= '7')
1095 /* A hex escape, as in ANSI C. */
1101 if (c
>= '0' && c
<= '9')
1106 else if ((c
>= 'a' && c
<= 'f')
1107 || (c
>= 'A' && c
<= 'F'))
1110 if (c
>= 'a' && c
<= 'f')
1129 /* If the next token is ')' or ']' or '.', we store that character
1130 in *PCH and the return value is not interesting. Else, we store
1131 zero in *PCH and we read and return one lisp object.
1133 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1136 read1 (readcharfun
, pch
, first_in_list
)
1137 register Lisp_Object readcharfun
;
1147 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1152 return read_list (0, readcharfun
);
1155 return read_vector (readcharfun
);
1168 /* Accept compiled functions at read-time so that we don't have to
1169 build them using function calls. */
1171 tmp
= read_vector (readcharfun
);
1172 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1173 XVECTOR (tmp
)->contents
);
1175 #ifdef USE_TEXT_PROPERTIES
1179 struct gcpro gcpro1
;
1182 /* Read the string itself. */
1183 tmp
= read1 (readcharfun
, &ch
, 0);
1184 if (ch
!= 0 || !STRINGP (tmp
))
1185 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1187 /* Read the intervals and their properties. */
1190 Lisp_Object beg
, end
, plist
;
1192 beg
= read1 (readcharfun
, &ch
, 0);
1196 end
= read1 (readcharfun
, &ch
, 0);
1198 plist
= read1 (readcharfun
, &ch
, 0);
1200 Fsignal (Qinvalid_read_syntax
,
1201 Fcons (build_string ("invalid string property list"),
1203 Fset_text_properties (beg
, end
, plist
, tmp
);
1209 /* #@NUMBER is used to skip NUMBER following characters.
1210 That's used in .elc files to skip over doc strings
1211 and function definitions. */
1216 /* Read a decimal integer. */
1217 while ((c
= READCHAR
) >= 0
1218 && c
>= '0' && c
<= '9')
1226 /* Skip that many characters. */
1227 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1232 return Vload_file_name
;
1235 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1238 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1243 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1253 new_backquote_flag
= 1;
1254 value
= read0 (readcharfun
);
1255 new_backquote_flag
= 0;
1257 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1261 if (new_backquote_flag
)
1263 Lisp_Object comma_type
= Qnil
;
1268 comma_type
= Qcomma_at
;
1270 comma_type
= Qcomma_dot
;
1273 if (ch
>= 0) UNREAD (ch
);
1274 comma_type
= Qcomma
;
1277 new_backquote_flag
= 0;
1278 value
= read0 (readcharfun
);
1279 new_backquote_flag
= 1;
1280 return Fcons (comma_type
, Fcons (value
, Qnil
));
1287 register Lisp_Object val
;
1290 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1293 XSETINT (val
, read_escape (readcharfun
));
1302 register char *p
= read_buffer
;
1303 register char *end
= read_buffer
+ read_buffer_size
;
1307 while ((c
= READCHAR
) >= 0
1312 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1313 p
+= new - read_buffer
;
1314 read_buffer
+= new - read_buffer
;
1315 end
= read_buffer
+ read_buffer_size
;
1318 c
= read_escape (readcharfun
);
1319 /* c is -1 if \ newline has just been seen */
1322 if (p
== read_buffer
)
1327 /* Allow `\C- ' and `\C-?'. */
1328 if (c
== (CHAR_CTL
| ' '))
1330 else if (c
== (CHAR_CTL
| '?'))
1334 /* Move the meta bit to the right place for a string. */
1335 c
= (c
& ~CHAR_META
) | 0x80;
1337 error ("Invalid modifier in string");
1341 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1343 /* If purifying, and string starts with \ newline,
1344 return zero instead. This is for doc strings
1345 that we are really going to find in etc/DOC.nn.nn */
1346 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1347 return make_number (0);
1350 return make_pure_string (read_buffer
, p
- read_buffer
);
1352 return make_string (read_buffer
, p
- read_buffer
);
1357 #ifdef LISP_FLOAT_TYPE
1358 /* If a period is followed by a number, then we should read it
1359 as a floating point number. Otherwise, it denotes a dotted
1361 int next_char
= READCHAR
;
1364 if (! (next_char
>= '0' && next_char
<= '9'))
1371 /* Otherwise, we fall through! Note that the atom-reading loop
1372 below will now loop at least once, assuring that we will not
1373 try to UNREAD two characters in a row. */
1377 if (c
<= 040) goto retry
;
1379 register char *p
= read_buffer
;
1383 register char *end
= read_buffer
+ read_buffer_size
;
1386 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1387 || c
== '(' || c
== ')'
1388 #ifndef LISP_FLOAT_TYPE
1389 /* If we have floating-point support, then we need
1390 to allow <digits><dot><digits>. */
1392 #endif /* not LISP_FLOAT_TYPE */
1393 || c
== '[' || c
== ']' || c
== '#'
1398 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1399 p
+= new - read_buffer
;
1400 read_buffer
+= new - read_buffer
;
1401 end
= read_buffer
+ read_buffer_size
;
1414 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1415 p
+= new - read_buffer
;
1416 read_buffer
+= new - read_buffer
;
1417 /* end = read_buffer + read_buffer_size; */
1427 register Lisp_Object val
;
1429 if (*p1
== '+' || *p1
== '-') p1
++;
1430 /* Is it an integer? */
1433 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1434 #ifdef LISP_FLOAT_TYPE
1435 /* Integers can have trailing decimal points. */
1436 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
1439 /* It is an integer. */
1441 #ifdef LISP_FLOAT_TYPE
1445 if (sizeof (int) == sizeof (EMACS_INT
))
1446 XSETINT (val
, atoi (read_buffer
));
1447 else if (sizeof (long) == sizeof (EMACS_INT
))
1448 XSETINT (val
, atol (read_buffer
));
1454 #ifdef LISP_FLOAT_TYPE
1455 if (isfloat_string (read_buffer
))
1456 return make_float (atof (read_buffer
));
1460 return intern (read_buffer
);
1465 #ifdef LISP_FLOAT_TYPE
1480 if (*cp
== '+' || *cp
== '-')
1483 if (*cp
>= '0' && *cp
<= '9')
1486 while (*cp
>= '0' && *cp
<= '9')
1494 if (*cp
>= '0' && *cp
<= '9')
1497 while (*cp
>= '0' && *cp
<= '9')
1504 if (*cp
== '+' || *cp
== '-')
1508 if (*cp
>= '0' && *cp
<= '9')
1511 while (*cp
>= '0' && *cp
<= '9')
1514 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
1515 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1516 || state
== (DOT_CHAR
|TRAIL_INT
)
1517 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1518 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1519 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1521 #endif /* LISP_FLOAT_TYPE */
1524 read_vector (readcharfun
)
1525 Lisp_Object readcharfun
;
1529 register Lisp_Object
*ptr
;
1530 register Lisp_Object tem
, vector
;
1531 register struct Lisp_Cons
*otem
;
1534 tem
= read_list (1, readcharfun
);
1535 len
= Flength (tem
);
1536 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1539 size
= XVECTOR (vector
)->size
;
1540 ptr
= XVECTOR (vector
)->contents
;
1541 for (i
= 0; i
< size
; i
++)
1543 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1551 /* flag = 1 means check for ] to terminate rather than ) and .
1552 flag = -1 means check for starting with defun
1553 and make structure pure. */
1556 read_list (flag
, readcharfun
)
1558 register Lisp_Object readcharfun
;
1560 /* -1 means check next element for defun,
1561 0 means don't check,
1562 1 means already checked and found defun. */
1563 int defunflag
= flag
< 0 ? -1 : 0;
1564 Lisp_Object val
, tail
;
1565 register Lisp_Object elt
, tem
;
1566 struct gcpro gcpro1
, gcpro2
;
1569 /* Initialize this to 1 if we are reading a list. */
1570 int first_in_list
= flag
<= 0;
1579 elt
= read1 (readcharfun
, &ch
, first_in_list
);
1584 /* If purifying, and the list starts with #$,
1585 return 0 instead. This is a doc string reference
1586 and it will be replaced anyway by Snarf-documentation,
1587 so don't waste pure space with it. */
1588 if (EQ (elt
, Vload_file_name
)
1589 && !NILP (Vpurify_flag
) && NILP (Vdoc_file_name
))
1598 Fsignal (Qinvalid_read_syntax
, Fcons (make_string (") or . in a vector", 18), Qnil
));
1606 XCONS (tail
)->cdr
= read0 (readcharfun
);
1608 val
= read0 (readcharfun
);
1609 read1 (readcharfun
, &ch
, 0);
1612 return (cancel
? make_number (0) : val
);
1613 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1615 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1617 tem
= (read_pure
&& flag
<= 0
1618 ? pure_cons (elt
, Qnil
)
1619 : Fcons (elt
, Qnil
));
1621 XCONS (tail
)->cdr
= tem
;
1626 defunflag
= EQ (elt
, Qdefun
);
1627 else if (defunflag
> 0)
1632 Lisp_Object Vobarray
;
1633 Lisp_Object initial_obarray
;
1635 /* oblookup stores the bucket number here, for the sake of Funintern. */
1637 int oblookup_last_bucket_number
;
1639 static int hash_string ();
1640 Lisp_Object
oblookup ();
1642 /* Get an error if OBARRAY is not an obarray.
1643 If it is one, return it. */
1646 check_obarray (obarray
)
1647 Lisp_Object obarray
;
1649 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
1651 /* If Vobarray is now invalid, force it to be valid. */
1652 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
1654 obarray
= wrong_type_argument (Qvectorp
, obarray
);
1659 /* Intern the C string STR: return a symbol with that name,
1660 interned in the current obarray. */
1667 int len
= strlen (str
);
1668 Lisp_Object obarray
;
1671 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
1672 obarray
= check_obarray (obarray
);
1673 tem
= oblookup (obarray
, str
, len
);
1676 return Fintern ((!NILP (Vpurify_flag
)
1677 ? make_pure_string (str
, len
)
1678 : make_string (str
, len
)),
1682 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
1683 "Return the canonical symbol whose name is STRING.\n\
1684 If there is none, one is created by this function and returned.\n\
1685 A second optional argument specifies the obarray to use;\n\
1686 it defaults to the value of `obarray'.")
1688 Lisp_Object str
, obarray
;
1690 register Lisp_Object tem
, sym
, *ptr
;
1692 if (NILP (obarray
)) obarray
= Vobarray
;
1693 obarray
= check_obarray (obarray
);
1695 CHECK_STRING (str
, 0);
1697 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1698 if (!INTEGERP (tem
))
1701 if (!NILP (Vpurify_flag
))
1702 str
= Fpurecopy (str
);
1703 sym
= Fmake_symbol (str
);
1705 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
1707 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
1709 XSYMBOL (sym
)->next
= 0;
1714 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
1715 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
1716 A second optional argument specifies the obarray to use;\n\
1717 it defaults to the value of `obarray'.")
1719 Lisp_Object str
, obarray
;
1721 register Lisp_Object tem
;
1723 if (NILP (obarray
)) obarray
= Vobarray
;
1724 obarray
= check_obarray (obarray
);
1726 CHECK_STRING (str
, 0);
1728 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1729 if (!INTEGERP (tem
))
1734 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
1735 "Delete the symbol named NAME, if any, from OBARRAY.\n\
1736 The value is t if a symbol was found and deleted, nil otherwise.\n\
1737 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
1738 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
1739 OBARRAY defaults to the value of the variable `obarray'.")
1741 Lisp_Object name
, obarray
;
1743 register Lisp_Object string
, tem
;
1746 if (NILP (obarray
)) obarray
= Vobarray
;
1747 obarray
= check_obarray (obarray
);
1750 XSETSTRING (string
, XSYMBOL (name
)->name
);
1753 CHECK_STRING (name
, 0);
1757 tem
= oblookup (obarray
, XSTRING (string
)->data
, XSTRING (string
)->size
);
1760 /* If arg was a symbol, don't delete anything but that symbol itself. */
1761 if (SYMBOLP (name
) && !EQ (name
, tem
))
1764 hash
= oblookup_last_bucket_number
;
1766 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
1767 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
1770 Lisp_Object tail
, following
;
1772 for (tail
= XVECTOR (obarray
)->contents
[hash
];
1773 XSYMBOL (tail
)->next
;
1776 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
1777 if (EQ (following
, tem
))
1779 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
1788 /* Return the symbol in OBARRAY whose names matches the string
1789 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
1792 Also store the bucket number in oblookup_last_bucket_number. */
1795 oblookup (obarray
, ptr
, size
)
1796 Lisp_Object obarray
;
1802 register Lisp_Object tail
;
1803 Lisp_Object bucket
, tem
;
1805 if (!VECTORP (obarray
)
1806 || (obsize
= XVECTOR (obarray
)->size
) == 0)
1808 obarray
= check_obarray (obarray
);
1809 obsize
= XVECTOR (obarray
)->size
;
1811 /* Combining next two lines breaks VMS C 2.3. */
1812 hash
= hash_string (ptr
, size
);
1814 bucket
= XVECTOR (obarray
)->contents
[hash
];
1815 oblookup_last_bucket_number
= hash
;
1816 if (XFASTINT (bucket
) == 0)
1818 else if (!SYMBOLP (bucket
))
1819 error ("Bad data in guts of obarray"); /* Like CADR error message */
1821 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
1823 if (XSYMBOL (tail
)->name
->size
== size
1824 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
1826 else if (XSYMBOL (tail
)->next
== 0)
1829 XSETINT (tem
, hash
);
1834 hash_string (ptr
, len
)
1838 register unsigned char *p
= ptr
;
1839 register unsigned char *end
= p
+ len
;
1840 register unsigned char c
;
1841 register int hash
= 0;
1846 if (c
>= 0140) c
-= 40;
1847 hash
= ((hash
<<3) + (hash
>>28) + c
);
1849 return hash
& 07777777777;
1853 map_obarray (obarray
, fn
, arg
)
1854 Lisp_Object obarray
;
1859 register Lisp_Object tail
;
1860 CHECK_VECTOR (obarray
, 1);
1861 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
1863 tail
= XVECTOR (obarray
)->contents
[i
];
1864 if (XFASTINT (tail
) != 0)
1868 if (XSYMBOL (tail
)->next
== 0)
1870 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
1875 mapatoms_1 (sym
, function
)
1876 Lisp_Object sym
, function
;
1878 call1 (function
, sym
);
1881 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
1882 "Call FUNCTION on every symbol in OBARRAY.\n\
1883 OBARRAY defaults to the value of `obarray'.")
1885 Lisp_Object function
, obarray
;
1889 if (NILP (obarray
)) obarray
= Vobarray
;
1890 obarray
= check_obarray (obarray
);
1892 map_obarray (obarray
, mapatoms_1
, function
);
1896 #define OBARRAY_SIZE 1511
1901 Lisp_Object oblength
;
1905 XSETFASTINT (oblength
, OBARRAY_SIZE
);
1907 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
1908 Vobarray
= Fmake_vector (oblength
, make_number (0));
1909 initial_obarray
= Vobarray
;
1910 staticpro (&initial_obarray
);
1911 /* Intern nil in the obarray */
1912 /* These locals are to kludge around a pyramid compiler bug. */
1913 hash
= hash_string ("nil", 3);
1914 /* Separate statement here to avoid VAXC bug. */
1915 hash
%= OBARRAY_SIZE
;
1916 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
1919 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
1920 XSYMBOL (Qnil
)->function
= Qunbound
;
1921 XSYMBOL (Qunbound
)->value
= Qunbound
;
1922 XSYMBOL (Qunbound
)->function
= Qunbound
;
1925 XSYMBOL (Qnil
)->value
= Qnil
;
1926 XSYMBOL (Qnil
)->plist
= Qnil
;
1927 XSYMBOL (Qt
)->value
= Qt
;
1929 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
1932 Qvariable_documentation
= intern ("variable-documentation");
1934 read_buffer_size
= 100;
1935 read_buffer
= (char *) malloc (read_buffer_size
);
1940 struct Lisp_Subr
*sname
;
1943 sym
= intern (sname
->symbol_name
);
1944 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
1947 #ifdef NOTDEF /* use fset in subr.el now */
1949 defalias (sname
, string
)
1950 struct Lisp_Subr
*sname
;
1954 sym
= intern (string
);
1955 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
1959 /* Define an "integer variable"; a symbol whose value is forwarded
1960 to a C variable of type int. Sample call: */
1961 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
1963 defvar_int (namestring
, address
)
1967 Lisp_Object sym
, val
;
1968 sym
= intern (namestring
);
1969 val
= allocate_misc ();
1970 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
1971 XINTFWD (val
)->intvar
= address
;
1972 XSYMBOL (sym
)->value
= val
;
1975 /* Similar but define a variable whose value is T if address contains 1,
1976 NIL if address contains 0 */
1978 defvar_bool (namestring
, address
)
1982 Lisp_Object sym
, val
;
1983 sym
= intern (namestring
);
1984 val
= allocate_misc ();
1985 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
1986 XBOOLFWD (val
)->boolvar
= address
;
1987 XSYMBOL (sym
)->value
= val
;
1990 /* Similar but define a variable whose value is the Lisp Object stored
1991 at address. Two versions: with and without gc-marking of the C
1992 variable. The nopro version is used when that variable will be
1993 gc-marked for some other reason, since marking the same slot twice
1994 can cause trouble with strings. */
1996 defvar_lisp_nopro (namestring
, address
)
1998 Lisp_Object
*address
;
2000 Lisp_Object sym
, val
;
2001 sym
= intern (namestring
);
2002 val
= allocate_misc ();
2003 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2004 XOBJFWD (val
)->objvar
= address
;
2005 XSYMBOL (sym
)->value
= val
;
2009 defvar_lisp (namestring
, address
)
2011 Lisp_Object
*address
;
2013 defvar_lisp_nopro (namestring
, address
);
2014 staticpro (address
);
2019 /* Similar but define a variable whose value is the Lisp Object stored in
2020 the current buffer. address is the address of the slot in the buffer
2021 that is current now. */
2024 defvar_per_buffer (namestring
, address
, type
, doc
)
2026 Lisp_Object
*address
;
2030 Lisp_Object sym
, val
;
2032 extern struct buffer buffer_local_symbols
;
2034 sym
= intern (namestring
);
2035 val
= allocate_misc ();
2036 offset
= (char *)address
- (char *)current_buffer
;
2038 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2039 XBUFFER_OBJFWD (val
)->offset
= offset
;
2040 XSYMBOL (sym
)->value
= val
;
2041 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2042 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2043 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2044 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2045 slot of buffer_local_flags */
2049 #endif /* standalone */
2051 /* Similar but define a variable whose value is the Lisp Object stored
2052 at a particular offset in the current kboard object. */
2055 defvar_kboard (namestring
, offset
)
2059 Lisp_Object sym
, val
;
2060 sym
= intern (namestring
);
2061 val
= allocate_misc ();
2062 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2063 XKBOARD_OBJFWD (val
)->offset
= offset
;
2064 XSYMBOL (sym
)->value
= val
;
2070 int turn_off_warning
= 0;
2072 /* Compute the default load-path. */
2074 normal
= PATH_LOADSEARCH
;
2075 Vload_path
= decode_env_path (0, normal
);
2077 if (NILP (Vpurify_flag
))
2078 normal
= PATH_LOADSEARCH
;
2080 normal
= PATH_DUMPLOADSEARCH
;
2082 /* In a dumped Emacs, we normally have to reset the value of
2083 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2084 uses ../lisp, instead of the path of the installed elisp
2085 libraries. However, if it appears that Vload_path was changed
2086 from the default before dumping, don't override that value. */
2089 Lisp_Object dump_path
;
2091 dump_path
= decode_env_path (0, PATH_DUMPLOADSEARCH
);
2092 if (! NILP (Fequal (dump_path
, Vload_path
)))
2094 Vload_path
= decode_env_path (0, normal
);
2095 if (!NILP (Vinstallation_directory
))
2097 /* Add to the path the lisp subdir of the
2098 installation dir, if it exists. */
2099 Lisp_Object tem
, tem1
;
2100 tem
= Fexpand_file_name (build_string ("lisp"),
2101 Vinstallation_directory
);
2102 tem1
= Ffile_exists_p (tem
);
2105 if (NILP (Fmember (tem
, Vload_path
)))
2107 turn_off_warning
= 1;
2108 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2112 /* That dir doesn't exist, so add the build-time
2113 Lisp dirs instead. */
2114 Vload_path
= nconc2 (Vload_path
, dump_path
);
2116 /* Add site-list under the installation dir, if it exists. */
2117 tem
= Fexpand_file_name (build_string ("site-lisp"),
2118 Vinstallation_directory
);
2119 tem1
= Ffile_exists_p (tem
);
2122 if (NILP (Fmember (tem
, Vload_path
)))
2123 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2129 Vload_path
= decode_env_path (0, normal
);
2133 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
2134 almost never correct, thereby causing a warning to be printed out that
2135 confuses users. Since PATH_LOADSEARCH is always overriden by the
2136 EMACSLOADPATH environment variable below, disable the warning on NT. */
2138 /* Warn if dirs in the *standard* path don't exist. */
2139 if (!turn_off_warning
)
2141 Lisp_Object path_tail
;
2143 for (path_tail
= Vload_path
;
2145 path_tail
= XCONS (path_tail
)->cdr
)
2147 Lisp_Object dirfile
;
2148 dirfile
= Fcar (path_tail
);
2149 if (STRINGP (dirfile
))
2151 dirfile
= Fdirectory_file_name (dirfile
);
2152 if (access (XSTRING (dirfile
)->data
, 0) < 0)
2154 "Warning: Lisp directory `%s' does not exist.\n",
2155 XSTRING (Fcar (path_tail
))->data
);
2159 #endif /* WINDOWSNT */
2161 /* If the EMACSLOADPATH environment variable is set, use its value.
2162 This doesn't apply if we're dumping. */
2164 if (NILP (Vpurify_flag
)
2165 && egetenv ("EMACSLOADPATH"))
2167 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
2171 load_in_progress
= 0;
2173 load_descriptor_list
= Qnil
;
2180 defsubr (&Sread_from_string
);
2182 defsubr (&Sintern_soft
);
2183 defsubr (&Sunintern
);
2185 defsubr (&Seval_buffer
);
2186 defsubr (&Seval_region
);
2187 defsubr (&Sread_char
);
2188 defsubr (&Sread_char_exclusive
);
2189 defsubr (&Sread_event
);
2190 defsubr (&Sget_file_char
);
2191 defsubr (&Smapatoms
);
2193 DEFVAR_LISP ("obarray", &Vobarray
,
2194 "Symbol table for use by `intern' and `read'.\n\
2195 It is a vector whose length ought to be prime for best results.\n\
2196 The vector's contents don't make sense if examined from Lisp programs;\n\
2197 to find all the symbols in an obarray, use `mapatoms'.");
2199 DEFVAR_LISP ("values", &Vvalues
,
2200 "List of values of all expressions which were read, evaluated and printed.\n\
2201 Order is reverse chronological.");
2203 DEFVAR_LISP ("standard-input", &Vstandard_input
,
2204 "Stream for read to get input from.\n\
2205 See documentation of `read' for possible values.");
2206 Vstandard_input
= Qt
;
2208 DEFVAR_LISP ("load-path", &Vload_path
,
2209 "*List of directories to search for files to load.\n\
2210 Each element is a string (directory name) or nil (try default directory).\n\
2211 Initialized based on EMACSLOADPATH environment variable, if any,\n\
2212 otherwise to default specified by file `paths.h' when Emacs was built.");
2214 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
2215 "Non-nil iff inside of `load'.");
2217 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
2218 "An alist of expressions to be evalled when particular files are loaded.\n\
2219 Each element looks like (FILENAME FORMS...).\n\
2220 When `load' is run and the file-name argument is FILENAME,\n\
2221 the FORMS in the corresponding element are executed at the end of loading.\n\n\
2222 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
2223 with no directory specified, since that is how `load' is normally called.\n\
2224 An error in FORMS does not undo the load,\n\
2225 but does prevent execution of the rest of the FORMS.");
2226 Vafter_load_alist
= Qnil
;
2228 DEFVAR_LISP ("load-history", &Vload_history
,
2229 "Alist mapping source file names to symbols and features.\n\
2230 Each alist element is a list that starts with a file name,\n\
2231 except for one element (optional) that starts with nil and describes\n\
2232 definitions evaluated from buffers not visiting files.\n\
2233 The remaining elements of each list are symbols defined as functions\n\
2234 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2235 Vload_history
= Qnil
;
2237 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
2238 "Full name of file being loaded by `load'.");
2239 Vload_file_name
= Qnil
;
2241 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
2242 "Used for internal purposes by `load'.");
2243 Vcurrent_load_list
= Qnil
;
2245 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
2246 "Function used by `load' and `eval-region' for reading expressions.\n\
2247 The default is nil, which means use the function `read'.");
2248 Vload_read_function
= Qnil
;
2250 load_descriptor_list
= Qnil
;
2251 staticpro (&load_descriptor_list
);
2253 Qcurrent_load_list
= intern ("current-load-list");
2254 staticpro (&Qcurrent_load_list
);
2256 Qstandard_input
= intern ("standard-input");
2257 staticpro (&Qstandard_input
);
2259 Qread_char
= intern ("read-char");
2260 staticpro (&Qread_char
);
2262 Qget_file_char
= intern ("get-file-char");
2263 staticpro (&Qget_file_char
);
2265 Qbackquote
= intern ("`");
2266 staticpro (&Qbackquote
);
2267 Qcomma
= intern (",");
2268 staticpro (&Qcomma
);
2269 Qcomma_at
= intern (",@");
2270 staticpro (&Qcomma_at
);
2271 Qcomma_dot
= intern (",.");
2272 staticpro (&Qcomma_dot
);
2274 Qascii_character
= intern ("ascii-character");
2275 staticpro (&Qascii_character
);
2277 Qload
= intern ("load");
2280 Qload_file_name
= intern ("load-file-name");
2281 staticpro (&Qload_file_name
);