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, 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 */
55 #ifdef LISP_FLOAT_TYPE
61 #endif /* LISP_FLOAT_TYPE */
65 #endif /* HAVE_SETLOCALE */
73 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
, Qcurrent_load_list
;
74 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
75 Lisp_Object Qascii_character
, Qload
, Qload_file_name
;
76 Lisp_Object Qbackquote
, Qcomma
, Qcomma_at
, Qcomma_dot
, Qfunction
;
77 Lisp_Object Qinhibit_file_name_operation
;
79 extern Lisp_Object Qevent_symbol_element_mask
;
80 extern Lisp_Object Qfile_exists_p
;
82 /* non-zero if inside `load' */
85 /* Directory in which the sources were found. */
86 Lisp_Object Vsource_directory
;
88 /* Search path for files to be loaded. */
89 Lisp_Object Vload_path
;
91 /* This is the user-visible association list that maps features to
92 lists of defs in their load files. */
93 Lisp_Object Vload_history
;
95 /* This is used to build the load history. */
96 Lisp_Object Vcurrent_load_list
;
98 /* Name of file actually being read by `load'. */
99 Lisp_Object Vload_file_name
;
101 /* Function to use for reading, in `load' and friends. */
102 Lisp_Object Vload_read_function
;
104 /* The association list of objects read with the #n=object form.
105 Each member of the list has the form (n . object), and is used to
106 look up the object for the corresponding #n# construct.
107 It must be set to nil before all top-level calls to read0. */
108 Lisp_Object read_objects
;
110 /* Nonzero means load should forcibly load all dynamic doc strings. */
111 static int load_force_doc_strings
;
113 /* Function to use for loading an Emacs lisp source file (not
114 compiled) instead of readevalloop. */
115 Lisp_Object Vload_source_file_function
;
117 /* List of descriptors now open for Fload. */
118 static Lisp_Object load_descriptor_list
;
120 /* File for get_file_char to read from. Use by load. */
121 static FILE *instream
;
123 /* When nonzero, read conses in pure space */
124 static int read_pure
;
126 /* For use within read-from-string (this reader is non-reentrant!!) */
127 static int read_from_string_index
;
128 static int read_from_string_limit
;
130 /* This contains the last string skipped with #@. */
131 static char *saved_doc_string
;
132 /* Length of buffer allocated in saved_doc_string. */
133 static int saved_doc_string_size
;
134 /* Length of actual data in saved_doc_string. */
135 static int saved_doc_string_length
;
136 /* This is the file position that string came from. */
137 static int saved_doc_string_position
;
139 /* Nonzero means inside a new-style backquote
140 with no surrounding parentheses.
141 Fread initializes this to zero, so we need not specbind it
142 or worry about what happens to it when there is an error. */
143 static int new_backquote_flag
;
145 /* Handle unreading and rereading of characters.
146 Write READCHAR to read a character,
147 UNREAD(c) to unread c to be read again.
149 These macros actually read/unread a byte code, multibyte characters
150 are not handled here. The caller should manage them if necessary.
153 #define READCHAR readchar (readcharfun)
154 #define UNREAD(c) unreadchar (readcharfun, c)
157 readchar (readcharfun
)
158 Lisp_Object readcharfun
;
161 register struct buffer
*inbuffer
;
162 register int c
, mpos
;
164 if (BUFFERP (readcharfun
))
166 inbuffer
= XBUFFER (readcharfun
);
168 if (BUF_PT (inbuffer
) >= BUF_ZV (inbuffer
))
170 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, BUF_PT (inbuffer
));
171 SET_BUF_PT (inbuffer
, BUF_PT (inbuffer
) + 1);
175 if (MARKERP (readcharfun
))
177 inbuffer
= XMARKER (readcharfun
)->buffer
;
179 mpos
= marker_position (readcharfun
);
181 if (mpos
> BUF_ZV (inbuffer
) - 1)
183 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, mpos
);
184 if (mpos
!= BUF_GPT (inbuffer
))
185 XMARKER (readcharfun
)->bufpos
++;
187 Fset_marker (readcharfun
, make_number (mpos
+ 1),
188 Fmarker_buffer (readcharfun
));
191 if (EQ (readcharfun
, Qget_file_char
))
195 /* Interrupted reads have been observed while reading over the network */
196 while (c
== EOF
&& ferror (instream
) && errno
== EINTR
)
205 if (STRINGP (readcharfun
))
208 /* This used to be return of a conditional expression,
209 but that truncated -1 to a char on VMS. */
210 if (read_from_string_index
< read_from_string_limit
)
211 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
217 tem
= call0 (readcharfun
);
224 /* Unread the character C in the way appropriate for the stream READCHARFUN.
225 If the stream is a user function, call it with the char as argument. */
228 unreadchar (readcharfun
, c
)
229 Lisp_Object readcharfun
;
233 /* Don't back up the pointer if we're unreading the end-of-input mark,
234 since readchar didn't advance it when we read it. */
236 else if (BUFFERP (readcharfun
))
238 if (XBUFFER (readcharfun
) == current_buffer
)
241 SET_BUF_PT (XBUFFER (readcharfun
), BUF_PT (XBUFFER (readcharfun
)) - 1);
243 else if (MARKERP (readcharfun
))
244 XMARKER (readcharfun
)->bufpos
--;
245 else if (STRINGP (readcharfun
))
246 read_from_string_index
--;
247 else if (EQ (readcharfun
, Qget_file_char
))
248 ungetc (c
, instream
);
250 call1 (readcharfun
, make_number (c
));
253 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
255 /* get a character from the tty */
257 extern Lisp_Object
read_char ();
259 /* Read input events until we get one that's acceptable for our purposes.
261 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
262 until we get a character we like, and then stuffed into
265 If ASCII_REQUIRED is non-zero, we check function key events to see
266 if the unmodified version of the symbol has a Qascii_character
267 property, and use that character, if present.
269 If ERROR_NONASCII is non-zero, we signal an error if the input we
270 get isn't an ASCII character with modifiers. If it's zero but
271 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
275 read_filtered_event (no_switch_frame
, ascii_required
, error_nonascii
)
276 int no_switch_frame
, ascii_required
, error_nonascii
;
279 return make_number (getchar ());
281 register Lisp_Object val
, delayed_switch_frame
;
283 delayed_switch_frame
= Qnil
;
285 /* Read until we get an acceptable event. */
287 val
= read_char (0, 0, 0, Qnil
, 0);
292 /* switch-frame events are put off until after the next ASCII
293 character. This is better than signaling an error just because
294 the last characters were typed to a separate minibuffer frame,
295 for example. Eventually, some code which can deal with
296 switch-frame events will read it and process it. */
298 && EVENT_HAS_PARAMETERS (val
)
299 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
301 delayed_switch_frame
= val
;
307 /* Convert certain symbols to their ASCII equivalents. */
310 Lisp_Object tem
, tem1
, tem2
;
311 tem
= Fget (val
, Qevent_symbol_element_mask
);
314 tem1
= Fget (Fcar (tem
), Qascii_character
);
315 /* Merge this symbol's modifier bits
316 with the ASCII equivalent of its basic code. */
318 XSETFASTINT (val
, XINT (tem1
) | XINT (Fcar (Fcdr (tem
))));
322 /* If we don't have a character now, deal with it appropriately. */
327 Vunread_command_events
= Fcons (val
, Qnil
);
328 error ("Non-character input-event");
335 if (! NILP (delayed_switch_frame
))
336 unread_switch_frame
= delayed_switch_frame
;
342 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
343 "Read a character from the command input (keyboard or macro).\n\
344 It is returned as a number.\n\
345 If the user generates an event which is not a character (i.e. a mouse\n\
346 click or function key event), `read-char' signals an error. As an\n\
347 exception, switch-frame events are put off until non-ASCII events can\n\
349 If you want to read non-character events, or ignore them, call\n\
350 `read-event' or `read-char-exclusive' instead.")
353 return read_filtered_event (1, 1, 1);
356 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
357 "Read an event object from the input stream.")
360 return read_filtered_event (0, 0, 0);
363 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
364 "Read a character from the command input (keyboard or macro).\n\
365 It is returned as a number. Non-character events are ignored.")
368 return read_filtered_event (1, 1, 0);
371 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
372 "Don't use this yourself.")
375 register Lisp_Object val
;
376 XSETINT (val
, getc (instream
));
380 static void readevalloop ();
381 static Lisp_Object
load_unwind ();
382 static Lisp_Object
load_descriptor_unwind ();
384 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
385 "Execute a file of Lisp code named FILE.\n\
386 First try FILE with `.elc' appended, then try with `.el',\n\
387 then try FILE unmodified.\n\
388 This function searches the directories in `load-path'.\n\
389 If optional second arg NOERROR is non-nil,\n\
390 report no error if FILE doesn't exist.\n\
391 Print messages at start and end of loading unless\n\
392 optional third arg NOMESSAGE is non-nil.\n\
393 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
394 suffixes `.elc' or `.el' to the specified name FILE.\n\
395 Return t if file exists.")
396 (file
, noerror
, nomessage
, nosuffix
)
397 Lisp_Object file
, noerror
, nomessage
, nosuffix
;
399 register FILE *stream
;
400 register int fd
= -1;
401 register Lisp_Object lispstream
;
402 int count
= specpdl_ptr
- specpdl
;
406 /* 1 means we printed the ".el is newer" message. */
408 /* 1 means we are loading a compiled file. */
412 char *dosmode
= "rt";
415 CHECK_STRING (file
, 0);
417 /* If file name is magic, call the handler. */
418 handler
= Ffind_file_name_handler (file
, Qload
);
420 return call5 (handler
, Qload
, file
, noerror
, nomessage
, nosuffix
);
422 /* Do this after the handler to avoid
423 the need to gcpro noerror, nomessage and nosuffix.
424 (Below here, we care only whether they are nil or not.) */
425 file
= Fsubstitute_in_file_name (file
);
427 /* Avoid weird lossage with null string as arg,
428 since it would try to load a directory as a Lisp file */
429 if (XSTRING (file
)->size
> 0)
432 fd
= openp (Vload_path
, file
, !NILP (nosuffix
) ? "" : ".elc:.el:",
441 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
442 Fcons (file
, Qnil
)));
447 /* If FD is 0, that means openp found a remote file. */
450 handler
= Ffind_file_name_handler (found
, Qload
);
451 return call5 (handler
, Qload
, found
, noerror
, nomessage
, Qt
);
454 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
465 stat ((char *)XSTRING (found
)->data
, &s1
);
466 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
467 result
= stat ((char *)XSTRING (found
)->data
, &s2
);
468 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
470 /* Make the progress messages mention that source is newer. */
473 /* If we won't print another message, mention this anyway. */
474 if (! NILP (nomessage
))
475 message ("Source file `%s' newer than byte-compiled file",
476 XSTRING (found
)->data
);
478 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
482 /* We are loading a source file (*.el). */
483 if (!NILP (Vload_source_file_function
))
486 return call3 (Vload_source_file_function
, found
, file
,
487 NILP (noerror
) ? Qnil
: Qt
,
488 NILP (nomessage
) ? Qnil
: Qt
);
494 stream
= fopen ((char *) XSTRING (found
)->data
, dosmode
);
495 #else /* not DOS_NT */
496 stream
= fdopen (fd
, "r");
497 #endif /* not DOS_NT */
501 error ("Failure to create stdio stream for %s", XSTRING (file
)->data
);
504 if (NILP (nomessage
))
507 message ("Loading %s (compiled; note, source file is newer)...",
508 XSTRING (file
)->data
);
510 message ("Loading %s (compiled)...", XSTRING (file
)->data
);
512 message ("Loading %s...", XSTRING (file
)->data
);
516 lispstream
= Fcons (Qnil
, Qnil
);
517 XSETFASTINT (XCONS (lispstream
)->car
, (EMACS_UINT
)stream
>> 16);
518 XSETFASTINT (XCONS (lispstream
)->cdr
, (EMACS_UINT
)stream
& 0xffff);
519 record_unwind_protect (load_unwind
, lispstream
);
520 record_unwind_protect (load_descriptor_unwind
, load_descriptor_list
);
521 specbind (Qload_file_name
, found
);
522 specbind (Qinhibit_file_name_operation
, Qnil
);
524 = Fcons (make_number (fileno (stream
)), load_descriptor_list
);
526 readevalloop (Qget_file_char
, stream
, file
, Feval
, 0);
527 unbind_to (count
, Qnil
);
529 /* Run any load-hooks for this file. */
530 temp
= Fassoc (file
, Vafter_load_alist
);
532 Fprogn (Fcdr (temp
));
535 if (saved_doc_string
)
536 free (saved_doc_string
);
537 saved_doc_string
= 0;
538 saved_doc_string_size
= 0;
540 if (!noninteractive
&& NILP (nomessage
))
543 message ("Loading %s (compiled; note, source file is newer)...done",
544 XSTRING (file
)->data
);
546 message ("Loading %s (compiled)...done", XSTRING (file
)->data
);
548 message ("Loading %s...done", XSTRING (file
)->data
);
554 load_unwind (stream
) /* used as unwind-protect function in load */
557 fclose ((FILE *) (XFASTINT (XCONS (stream
)->car
) << 16
558 | XFASTINT (XCONS (stream
)->cdr
)));
559 if (--load_in_progress
< 0) load_in_progress
= 0;
564 load_descriptor_unwind (oldlist
)
567 load_descriptor_list
= oldlist
;
571 /* Close all descriptors in use for Floads.
572 This is used when starting a subprocess. */
579 for (tail
= load_descriptor_list
; !NILP (tail
); tail
= XCONS (tail
)->cdr
)
580 close (XFASTINT (XCONS (tail
)->car
));
585 complete_filename_p (pathname
)
586 Lisp_Object pathname
;
588 register unsigned char *s
= XSTRING (pathname
)->data
;
589 return (IS_DIRECTORY_SEP (s
[0])
590 || (XSTRING (pathname
)->size
> 2
591 && IS_DEVICE_SEP (s
[1]) && IS_DIRECTORY_SEP (s
[2]))
601 /* Search for a file whose name is STR, looking in directories
602 in the Lisp list PATH, and trying suffixes from SUFFIX.
603 SUFFIX is a string containing possible suffixes separated by colons.
604 On success, returns a file descriptor. On failure, returns -1.
606 EXEC_ONLY nonzero means don't open the files,
607 just look for one that is executable. In this case,
608 returns 1 on success.
610 If STOREPTR is nonzero, it points to a slot where the name of
611 the file actually found should be stored as a Lisp string.
612 nil is stored there on failure.
614 If the file we find is remote, return 0
615 but store the found remote file name in *STOREPTR.
616 We do not check for remote files if EXEC_ONLY is nonzero. */
619 openp (path
, str
, suffix
, storeptr
, exec_only
)
620 Lisp_Object path
, str
;
622 Lisp_Object
*storeptr
;
628 register char *fn
= buf
;
631 Lisp_Object filename
;
639 if (complete_filename_p (str
))
642 for (; !NILP (path
); path
= Fcdr (path
))
646 filename
= Fexpand_file_name (str
, Fcar (path
));
647 if (!complete_filename_p (filename
))
648 /* If there are non-absolute elts in PATH (eg ".") */
649 /* Of course, this could conceivably lose if luser sets
650 default-directory to be something non-absolute... */
652 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
653 if (!complete_filename_p (filename
))
654 /* Give up on this path element! */
658 /* Calculate maximum size of any filename made from
659 this path element/specified file name and any possible suffix. */
660 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
661 if (fn_size
< want_size
)
662 fn
= (char *) alloca (fn_size
= 100 + want_size
);
666 /* Loop over suffixes. */
669 char *esuffix
= (char *) index (nsuffix
, ':');
670 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
673 /* Concatenate path element/specified name with the suffix.
674 If the directory starts with /:, remove that. */
675 if (XSTRING (filename
)->size
> 2
676 && XSTRING (filename
)->data
[0] == '/'
677 && XSTRING (filename
)->data
[1] == ':')
679 strncpy (fn
, XSTRING (filename
)->data
+ 2,
680 XSTRING (filename
)->size
- 2);
681 fn
[XSTRING (filename
)->size
- 2] = 0;
685 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
686 fn
[XSTRING (filename
)->size
] = 0;
689 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
690 strncat (fn
, nsuffix
, lsuffix
);
692 /* Check that the file exists and is not a directory. */
696 handler
= Ffind_file_name_handler (filename
, Qfile_exists_p
);
697 if (! NILP (handler
) && ! exec_only
)
702 string
= build_string (fn
);
703 exists
= ! NILP (exec_only
? Ffile_executable_p (string
)
704 : Ffile_readable_p (string
));
706 && ! NILP (Ffile_directory_p (build_string (fn
))))
711 /* We succeeded; return this descriptor and filename. */
713 *storeptr
= build_string (fn
);
720 int exists
= (stat (fn
, &st
) >= 0
721 && (st
.st_mode
& S_IFMT
) != S_IFDIR
);
724 /* Check that we can access or open it. */
726 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
728 fd
= open (fn
, O_RDONLY
, 0);
732 /* We succeeded; return this descriptor and filename. */
734 *storeptr
= build_string (fn
);
741 /* Advance to next suffix. */
744 nsuffix
+= lsuffix
+ 1;
755 /* Merge the list we've accumulated of globals from the current input source
756 into the load_history variable. The details depend on whether
757 the source has an associated file name or not. */
760 build_load_history (stream
, source
)
764 register Lisp_Object tail
, prev
, newelt
;
765 register Lisp_Object tem
, tem2
;
766 register int foundit
, loading
;
768 /* Don't bother recording anything for preloaded files. */
769 if (!NILP (Vpurify_flag
))
772 loading
= stream
|| !NARROWED
;
774 tail
= Vload_history
;
781 /* Find the feature's previous assoc list... */
782 if (!NILP (Fequal (source
, Fcar (tem
))))
786 /* If we're loading, remove it. */
790 Vload_history
= Fcdr (tail
);
792 Fsetcdr (prev
, Fcdr (tail
));
795 /* Otherwise, cons on new symbols that are not already members. */
798 tem2
= Vcurrent_load_list
;
802 newelt
= Fcar (tem2
);
804 if (NILP (Fmemq (newelt
, tem
)))
805 Fsetcar (tail
, Fcons (Fcar (tem
),
806 Fcons (newelt
, Fcdr (tem
))));
819 /* If we're loading, cons the new assoc onto the front of load-history,
820 the most-recently-loaded position. Also do this if we didn't find
821 an existing member for the current source. */
822 if (loading
|| !foundit
)
823 Vload_history
= Fcons (Fnreverse (Vcurrent_load_list
),
828 unreadpure () /* Used as unwind-protect function in readevalloop */
835 readevalloop (readcharfun
, stream
, sourcename
, evalfun
, printflag
)
836 Lisp_Object readcharfun
;
838 Lisp_Object sourcename
;
839 Lisp_Object (*evalfun
) ();
843 register Lisp_Object val
;
844 int count
= specpdl_ptr
- specpdl
;
846 struct buffer
*b
= 0;
848 if (BUFFERP (readcharfun
))
849 b
= XBUFFER (readcharfun
);
850 else if (MARKERP (readcharfun
))
851 b
= XMARKER (readcharfun
)->buffer
;
853 specbind (Qstandard_input
, readcharfun
);
854 specbind (Qcurrent_load_list
, Qnil
);
858 LOADHIST_ATTACH (sourcename
);
862 if (b
!= 0 && NILP (b
->name
))
863 error ("Reading from killed buffer");
869 while ((c
= READCHAR
) != '\n' && c
!= -1);
874 /* Ignore whitespace here, so we can detect eof. */
875 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f' || c
== '\r')
878 if (!NILP (Vpurify_flag
) && c
== '(')
880 int count1
= specpdl_ptr
- specpdl
;
881 record_unwind_protect (unreadpure
, Qnil
);
882 val
= read_list (-1, readcharfun
);
883 unbind_to (count1
, Qnil
);
889 if (NILP (Vload_read_function
))
890 val
= read0 (readcharfun
);
892 val
= call1 (Vload_read_function
, readcharfun
);
895 val
= (*evalfun
) (val
);
898 Vvalues
= Fcons (val
, Vvalues
);
899 if (EQ (Vstandard_output
, Qt
))
906 build_load_history (stream
, sourcename
);
909 unbind_to (count
, Qnil
);
914 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
915 "Execute the current buffer as Lisp code.\n\
916 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
917 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
918 PRINTFLAG controls printing of output:\n\
919 nil means discard it; anything else is stream for print.\n\
921 This function preserves the position of point.")
923 Lisp_Object buffer
, printflag
;
925 int count
= specpdl_ptr
- specpdl
;
926 Lisp_Object tem
, buf
;
929 buf
= Fcurrent_buffer ();
931 buf
= Fget_buffer (buffer
);
933 error ("No such buffer.");
935 if (NILP (printflag
))
939 specbind (Qstandard_output
, tem
);
940 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
941 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
942 readevalloop (buf
, 0, XBUFFER (buf
)->filename
, Feval
, !NILP (printflag
));
943 unbind_to (count
, Qnil
);
949 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
950 "Execute the current buffer as Lisp code.\n\
951 Programs can pass argument PRINTFLAG which controls printing of output:\n\
952 nil means discard it; anything else is stream for print.\n\
954 If there is no error, point does not move. If there is an error,\n\
955 point remains at the end of the last character read from the buffer.")
957 Lisp_Object printflag
;
959 int count
= specpdl_ptr
- specpdl
;
960 Lisp_Object tem
, cbuf
;
962 cbuf
= Fcurrent_buffer ()
964 if (NILP (printflag
))
968 specbind (Qstandard_output
, tem
);
969 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
971 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
972 return unbind_to (count
, Qnil
);
976 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
977 "Execute the region as Lisp code.\n\
978 When called from programs, expects two arguments,\n\
979 giving starting and ending indices in the current buffer\n\
980 of the text to be executed.\n\
981 Programs can pass third argument PRINTFLAG which controls output:\n\
982 nil means discard it; anything else is stream for printing it.\n\
984 If there is no error, point does not move. If there is an error,\n\
985 point remains at the end of the last character read from the buffer.")
986 (start
, end
, printflag
)
987 Lisp_Object start
, end
, printflag
;
989 int count
= specpdl_ptr
- specpdl
;
990 Lisp_Object tem
, cbuf
;
992 cbuf
= Fcurrent_buffer ();
994 if (NILP (printflag
))
998 specbind (Qstandard_output
, tem
);
1000 if (NILP (printflag
))
1001 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
1002 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
1004 /* This both uses start and checks its type. */
1006 Fnarrow_to_region (make_number (BEGV
), end
);
1007 readevalloop (cbuf
, 0, XBUFFER (cbuf
)->filename
, Feval
, !NILP (printflag
));
1009 return unbind_to (count
, Qnil
);
1012 #endif /* standalone */
1014 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
1015 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
1016 If STREAM is nil, use the value of `standard-input' (which see).\n\
1017 STREAM or the value of `standard-input' may be:\n\
1018 a buffer (read from point and advance it)\n\
1019 a marker (read from where it points and advance it)\n\
1020 a function (call it with no arguments for each character,\n\
1021 call it with a char as argument to push a char back)\n\
1022 a string (takes text from string, starting at the beginning)\n\
1023 t (read text line using minibuffer and use it).")
1027 extern Lisp_Object
Fread_minibuffer ();
1030 stream
= Vstandard_input
;
1031 if (EQ (stream
, Qt
))
1032 stream
= Qread_char
;
1034 new_backquote_flag
= 0;
1035 read_objects
= Qnil
;
1038 if (EQ (stream
, Qread_char
))
1039 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
1042 if (STRINGP (stream
))
1043 return Fcar (Fread_from_string (stream
, Qnil
, Qnil
));
1045 return read0 (stream
);
1048 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
1049 "Read one Lisp expression which is represented as text by STRING.\n\
1050 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
1051 START and END optionally delimit a substring of STRING from which to read;\n\
1052 they default to 0 and (length STRING) respectively.")
1053 (string
, start
, end
)
1054 Lisp_Object string
, start
, end
;
1056 int startval
, endval
;
1059 CHECK_STRING (string
,0);
1062 endval
= XSTRING (string
)->size
;
1064 { CHECK_NUMBER (end
,2);
1065 endval
= XINT (end
);
1066 if (endval
< 0 || endval
> XSTRING (string
)->size
)
1067 args_out_of_range (string
, end
);
1073 { CHECK_NUMBER (start
,1);
1074 startval
= XINT (start
);
1075 if (startval
< 0 || startval
> endval
)
1076 args_out_of_range (string
, start
);
1079 read_from_string_index
= startval
;
1080 read_from_string_limit
= endval
;
1082 new_backquote_flag
= 0;
1083 read_objects
= Qnil
;
1085 tem
= read0 (string
);
1086 return Fcons (tem
, make_number (read_from_string_index
));
1089 /* Use this for recursive reads, in contexts where internal tokens
1093 Lisp_Object readcharfun
;
1095 register Lisp_Object val
;
1098 val
= read1 (readcharfun
, &c
, 0);
1100 Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
1105 static int read_buffer_size
;
1106 static char *read_buffer
;
1108 /* Read multibyte form and return it as a character. C is a first
1109 byte of multibyte form, and rest of them are read from
1112 read_multibyte (c
, readcharfun
)
1114 Lisp_Object readcharfun
;
1116 /* We need the actual character code of this multibyte
1118 unsigned char str
[MAX_LENGTH_OF_MULTI_BYTE_FORM
];
1122 while ((c
= READCHAR
) >= 0xA0
1123 && len
< MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1126 return STRING_CHAR (str
, len
);
1130 read_escape (readcharfun
)
1131 Lisp_Object readcharfun
;
1133 register int c
= READCHAR
;
1137 error ("End of file");
1163 error ("Invalid escape character syntax");
1166 c
= read_escape (readcharfun
);
1167 return c
| meta_modifier
;
1172 error ("Invalid escape character syntax");
1175 c
= read_escape (readcharfun
);
1176 return c
| shift_modifier
;
1181 error ("Invalid escape character syntax");
1184 c
= read_escape (readcharfun
);
1185 return c
| hyper_modifier
;
1190 error ("Invalid escape character syntax");
1193 c
= read_escape (readcharfun
);
1194 return c
| alt_modifier
;
1199 error ("Invalid escape character syntax");
1202 c
= read_escape (readcharfun
);
1203 return c
| super_modifier
;
1208 error ("Invalid escape character syntax");
1212 c
= read_escape (readcharfun
);
1213 if ((c
& 0177) == '?')
1215 /* ASCII control chars are made from letters (both cases),
1216 as well as the non-letters within 0100...0137. */
1217 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
1218 return (c
& (037 | ~0177));
1219 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
1220 return (c
& (037 | ~0177));
1222 return c
| ctrl_modifier
;
1232 /* An octal escape, as in ANSI C. */
1234 register int i
= c
- '0';
1235 register int count
= 0;
1238 if ((c
= READCHAR
) >= '0' && c
<= '7')
1253 /* A hex escape, as in ANSI C. */
1259 if (c
>= '0' && c
<= '9')
1264 else if ((c
>= 'a' && c
<= 'f')
1265 || (c
>= 'A' && c
<= 'F'))
1268 if (c
>= 'a' && c
<= 'f')
1283 if (BASE_LEADING_CODE_P (c
))
1284 c
= read_multibyte (c
, readcharfun
);
1289 /* If the next token is ')' or ']' or '.', we store that character
1290 in *PCH and the return value is not interesting. Else, we store
1291 zero in *PCH and we read and return one lisp object.
1293 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1296 read1 (readcharfun
, pch
, first_in_list
)
1297 register Lisp_Object readcharfun
;
1302 int uninterned_symbol
= 0;
1309 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1314 return read_list (0, readcharfun
);
1317 return read_vector (readcharfun
);
1334 tmp
= read_vector (readcharfun
);
1335 if (XVECTOR (tmp
)->size
< CHAR_TABLE_STANDARD_SLOTS
1336 || XVECTOR (tmp
)->size
> CHAR_TABLE_STANDARD_SLOTS
+ 10)
1337 error ("Invalid size char-table");
1338 XSETCHAR_TABLE (tmp
, XCHAR_TABLE (tmp
));
1341 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#^", 2), Qnil
));
1346 length
= read1 (readcharfun
, pch
, first_in_list
);
1350 Lisp_Object tmp
, val
;
1351 int size_in_chars
= ((XFASTINT (length
) + BITS_PER_CHAR
- 1)
1355 tmp
= read1 (readcharfun
, pch
, first_in_list
);
1356 if (size_in_chars
!= XSTRING (tmp
)->size
1357 /* We used to print 1 char too many
1358 when the number of bits was a multiple of 8.
1359 Accept such input in case it came from an old version. */
1360 && ! (XFASTINT (length
)
1361 == (XSTRING (tmp
)->size
- 1) * BITS_PER_CHAR
))
1362 Fsignal (Qinvalid_read_syntax
,
1363 Fcons (make_string ("#&...", 5), Qnil
));
1365 val
= Fmake_bool_vector (length
, Qnil
);
1366 bcopy (XSTRING (tmp
)->data
, XBOOL_VECTOR (val
)->data
,
1370 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#&...", 5),
1375 /* Accept compiled functions at read-time so that we don't have to
1376 build them using function calls. */
1378 tmp
= read_vector (readcharfun
);
1379 return Fmake_byte_code (XVECTOR (tmp
)->size
,
1380 XVECTOR (tmp
)->contents
);
1382 #ifdef USE_TEXT_PROPERTIES
1386 struct gcpro gcpro1
;
1389 /* Read the string itself. */
1390 tmp
= read1 (readcharfun
, &ch
, 0);
1391 if (ch
!= 0 || !STRINGP (tmp
))
1392 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1394 /* Read the intervals and their properties. */
1397 Lisp_Object beg
, end
, plist
;
1399 beg
= read1 (readcharfun
, &ch
, 0);
1403 end
= read1 (readcharfun
, &ch
, 0);
1405 plist
= read1 (readcharfun
, &ch
, 0);
1407 Fsignal (Qinvalid_read_syntax
,
1408 Fcons (build_string ("invalid string property list"),
1410 Fset_text_properties (beg
, end
, plist
, tmp
);
1416 /* #@NUMBER is used to skip NUMBER following characters.
1417 That's used in .elc files to skip over doc strings
1418 and function definitions. */
1423 /* Read a decimal integer. */
1424 while ((c
= READCHAR
) >= 0
1425 && c
>= '0' && c
<= '9')
1433 #ifndef DOS_NT /* I don't know if filepos works right on MSDOS and Windoze. */
1434 if (load_force_doc_strings
&& EQ (readcharfun
, Qget_file_char
))
1436 /* If we are supposed to force doc strings into core right now,
1437 record the last string that we skipped,
1438 and record where in the file it comes from. */
1439 if (saved_doc_string_size
== 0)
1441 saved_doc_string_size
= nskip
+ 100;
1442 saved_doc_string
= (char *) xmalloc (saved_doc_string_size
);
1444 if (nskip
> saved_doc_string_size
)
1446 saved_doc_string_size
= nskip
+ 100;
1447 saved_doc_string
= (char *) xrealloc (saved_doc_string
,
1448 saved_doc_string_size
);
1451 saved_doc_string_position
= ftell (instream
);
1453 /* Copy that many characters into saved_doc_string. */
1454 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1455 saved_doc_string
[i
] = c
= READCHAR
;
1457 saved_doc_string_length
= i
;
1460 #endif /* not DOS_NT */
1462 /* Skip that many characters. */
1463 for (i
= 0; i
< nskip
&& c
>= 0; i
++)
1469 return Vload_file_name
;
1471 return Fcons (Qfunction
, Fcons (read0 (readcharfun
), Qnil
));
1472 /* #:foo is the uninterned symbol named foo. */
1475 uninterned_symbol
= 1;
1479 /* Reader forms that can reuse previously read objects. */
1480 if (c
>= '0' && c
<= '9')
1485 /* Read a non-negative integer. */
1486 while (c
>= '0' && c
<= '9')
1492 /* #n=object returns object, but associates it with n for #n#. */
1495 tem
= read0 (readcharfun
);
1496 read_objects
= Fcons (Fcons (make_number (n
), tem
), read_objects
);
1499 /* #n# returns a previously read object. */
1502 tem
= Fassq (make_number (n
), read_objects
);
1505 /* Fall through to error message. */
1507 /* Fall through to error message. */
1511 Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
1514 while ((c
= READCHAR
) >= 0 && c
!= '\n');
1519 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
1529 new_backquote_flag
= 1;
1530 value
= read0 (readcharfun
);
1531 new_backquote_flag
= 0;
1533 return Fcons (Qbackquote
, Fcons (value
, Qnil
));
1537 if (new_backquote_flag
)
1539 Lisp_Object comma_type
= Qnil
;
1544 comma_type
= Qcomma_at
;
1546 comma_type
= Qcomma_dot
;
1549 if (ch
>= 0) UNREAD (ch
);
1550 comma_type
= Qcomma
;
1553 new_backquote_flag
= 0;
1554 value
= read0 (readcharfun
);
1555 new_backquote_flag
= 1;
1556 return Fcons (comma_type
, Fcons (value
, Qnil
));
1563 register Lisp_Object val
;
1566 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1569 c
= read_escape (readcharfun
);
1570 else if (BASE_LEADING_CODE_P (c
))
1571 c
= read_multibyte (c
, readcharfun
);
1579 register char *p
= read_buffer
;
1580 register char *end
= read_buffer
+ read_buffer_size
;
1584 while ((c
= READCHAR
) >= 0
1589 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1590 p
+= new - read_buffer
;
1591 read_buffer
+= new - read_buffer
;
1592 end
= read_buffer
+ read_buffer_size
;
1595 c
= read_escape (readcharfun
);
1596 /* c is -1 if \ newline has just been seen */
1599 if (p
== read_buffer
)
1604 /* Allow `\C- ' and `\C-?'. */
1605 if (c
== (CHAR_CTL
| ' '))
1607 else if (c
== (CHAR_CTL
| '?'))
1611 /* Move the meta bit to the right place for a string. */
1612 c
= (c
& ~CHAR_META
) | 0x80;
1614 error ("Invalid modifier in string");
1618 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
1620 /* If purifying, and string starts with \ newline,
1621 return zero instead. This is for doc strings
1622 that we are really going to find in etc/DOC.nn.nn */
1623 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
1624 return make_number (0);
1627 return make_pure_string (read_buffer
, p
- read_buffer
);
1629 return make_string (read_buffer
, p
- read_buffer
);
1634 #ifdef LISP_FLOAT_TYPE
1635 /* If a period is followed by a number, then we should read it
1636 as a floating point number. Otherwise, it denotes a dotted
1638 int next_char
= READCHAR
;
1641 if (! (next_char
>= '0' && next_char
<= '9'))
1648 /* Otherwise, we fall through! Note that the atom-reading loop
1649 below will now loop at least once, assuring that we will not
1650 try to UNREAD two characters in a row. */
1654 if (c
<= 040) goto retry
;
1656 register char *p
= read_buffer
;
1660 register char *end
= read_buffer
+ read_buffer_size
;
1663 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1664 || c
== '(' || c
== ')'
1665 #ifndef LISP_FLOAT_TYPE
1666 /* If we have floating-point support, then we need
1667 to allow <digits><dot><digits>. */
1669 #endif /* not LISP_FLOAT_TYPE */
1670 || c
== '[' || c
== ']' || c
== '#'
1675 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1676 p
+= new - read_buffer
;
1677 read_buffer
+= new - read_buffer
;
1678 end
= read_buffer
+ read_buffer_size
;
1691 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1692 p
+= new - read_buffer
;
1693 read_buffer
+= new - read_buffer
;
1694 /* end = read_buffer + read_buffer_size; */
1701 if (!quoted
&& !uninterned_symbol
)
1704 register Lisp_Object val
;
1706 if (*p1
== '+' || *p1
== '-') p1
++;
1707 /* Is it an integer? */
1710 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1711 #ifdef LISP_FLOAT_TYPE
1712 /* Integers can have trailing decimal points. */
1713 if (p1
> read_buffer
&& p1
< p
&& *p1
== '.') p1
++;
1716 /* It is an integer. */
1718 #ifdef LISP_FLOAT_TYPE
1722 if (sizeof (int) == sizeof (EMACS_INT
))
1723 XSETINT (val
, atoi (read_buffer
));
1724 else if (sizeof (long) == sizeof (EMACS_INT
))
1725 XSETINT (val
, atol (read_buffer
));
1731 #ifdef LISP_FLOAT_TYPE
1732 if (isfloat_string (read_buffer
))
1733 return make_float (atof (read_buffer
));
1737 if (uninterned_symbol
)
1738 return make_symbol (read_buffer
);
1740 return intern (read_buffer
);
1745 #ifdef LISP_FLOAT_TYPE
1760 if (*cp
== '+' || *cp
== '-')
1763 if (*cp
>= '0' && *cp
<= '9')
1766 while (*cp
>= '0' && *cp
<= '9')
1774 if (*cp
>= '0' && *cp
<= '9')
1777 while (*cp
>= '0' && *cp
<= '9')
1780 if (*cp
== 'e' || *cp
== 'E')
1784 if (*cp
== '+' || *cp
== '-')
1788 if (*cp
>= '0' && *cp
<= '9')
1791 while (*cp
>= '0' && *cp
<= '9')
1794 return (((*cp
== 0) || (*cp
== ' ') || (*cp
== '\t') || (*cp
== '\n') || (*cp
== '\r') || (*cp
== '\f'))
1795 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1796 || state
== (DOT_CHAR
|TRAIL_INT
)
1797 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1798 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1799 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1801 #endif /* LISP_FLOAT_TYPE */
1804 read_vector (readcharfun
)
1805 Lisp_Object readcharfun
;
1809 register Lisp_Object
*ptr
;
1810 register Lisp_Object tem
, vector
;
1811 register struct Lisp_Cons
*otem
;
1814 tem
= read_list (1, readcharfun
);
1815 len
= Flength (tem
);
1816 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1819 size
= XVECTOR (vector
)->size
;
1820 ptr
= XVECTOR (vector
)->contents
;
1821 for (i
= 0; i
< size
; i
++)
1823 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1831 /* flag = 1 means check for ] to terminate rather than ) and .
1832 flag = -1 means check for starting with defun
1833 and make structure pure. */
1836 read_list (flag
, readcharfun
)
1838 register Lisp_Object readcharfun
;
1840 /* -1 means check next element for defun,
1841 0 means don't check,
1842 1 means already checked and found defun. */
1843 int defunflag
= flag
< 0 ? -1 : 0;
1844 Lisp_Object val
, tail
;
1845 register Lisp_Object elt
, tem
;
1846 struct gcpro gcpro1
, gcpro2
;
1847 /* 0 is the normal case.
1848 1 means this list is a doc reference; replace it with the number 0.
1849 2 means this list is a doc reference; replace it with the doc string. */
1850 int doc_reference
= 0;
1852 /* Initialize this to 1 if we are reading a list. */
1853 int first_in_list
= flag
<= 0;
1862 elt
= read1 (readcharfun
, &ch
, first_in_list
);
1867 /* While building, if the list starts with #$, treat it specially. */
1868 if (EQ (elt
, Vload_file_name
)
1869 && !NILP (Vpurify_flag
))
1871 if (NILP (Vdoc_file_name
))
1872 /* We have not yet called Snarf-documentation, so assume
1873 this file is described in the DOC-MM.NN file
1874 and Snarf-documentation will fill in the right value later.
1875 For now, replace the whole list with 0. */
1878 /* We have already called Snarf-documentation, so make a relative
1879 file name for this file, so it can be found properly
1880 in the installed Lisp directory.
1881 We don't use Fexpand_file_name because that would make
1882 the directory absolute now. */
1883 elt
= concat2 (build_string ("../lisp/"),
1884 Ffile_name_nondirectory (elt
));
1886 else if (EQ (elt
, Vload_file_name
)
1887 && load_force_doc_strings
)
1896 Fsignal (Qinvalid_read_syntax
,
1897 Fcons (make_string (") or . in a vector", 18), Qnil
));
1905 XCONS (tail
)->cdr
= read0 (readcharfun
);
1907 val
= read0 (readcharfun
);
1908 read1 (readcharfun
, &ch
, 0);
1912 if (doc_reference
== 1)
1913 return make_number (0);
1914 if (doc_reference
== 2)
1916 /* Get a doc string from the file we are loading.
1917 If it's in saved_doc_string, get it from there. */
1918 int pos
= XINT (XCONS (val
)->cdr
);
1919 if (pos
>= saved_doc_string_position
1920 && pos
< (saved_doc_string_position
1921 + saved_doc_string_length
))
1923 int start
= pos
- saved_doc_string_position
;
1926 /* Process quoting with ^A,
1927 and find the end of the string,
1928 which is marked with ^_ (037). */
1929 for (from
= start
, to
= start
;
1930 saved_doc_string
[from
] != 037;)
1932 int c
= saved_doc_string
[from
++];
1935 c
= saved_doc_string
[from
++];
1937 saved_doc_string
[to
++] = c
;
1939 saved_doc_string
[to
++] = 0;
1941 saved_doc_string
[to
++] = 037;
1944 saved_doc_string
[to
++] = c
;
1947 return make_string (saved_doc_string
+ start
,
1951 return read_doc_string (val
);
1956 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1958 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1960 tem
= (read_pure
&& flag
<= 0
1961 ? pure_cons (elt
, Qnil
)
1962 : Fcons (elt
, Qnil
));
1964 XCONS (tail
)->cdr
= tem
;
1969 defunflag
= EQ (elt
, Qdefun
);
1970 else if (defunflag
> 0)
1975 Lisp_Object Vobarray
;
1976 Lisp_Object initial_obarray
;
1978 /* oblookup stores the bucket number here, for the sake of Funintern. */
1980 int oblookup_last_bucket_number
;
1982 static int hash_string ();
1983 Lisp_Object
oblookup ();
1985 /* Get an error if OBARRAY is not an obarray.
1986 If it is one, return it. */
1989 check_obarray (obarray
)
1990 Lisp_Object obarray
;
1992 while (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
1994 /* If Vobarray is now invalid, force it to be valid. */
1995 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
1997 obarray
= wrong_type_argument (Qvectorp
, obarray
);
2002 /* Intern the C string STR: return a symbol with that name,
2003 interned in the current obarray. */
2010 int len
= strlen (str
);
2011 Lisp_Object obarray
;
2014 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
2015 obarray
= check_obarray (obarray
);
2016 tem
= oblookup (obarray
, str
, len
);
2019 return Fintern ((!NILP (Vpurify_flag
)
2020 ? make_pure_string (str
, len
)
2021 : make_string (str
, len
)),
2025 /* Create an uninterned symbol with name STR. */
2031 int len
= strlen (str
);
2033 return Fmake_symbol ((!NILP (Vpurify_flag
)
2034 ? make_pure_string (str
, len
)
2035 : make_string (str
, len
)));
2038 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
2039 "Return the canonical symbol whose name is STRING.\n\
2040 If there is none, one is created by this function and returned.\n\
2041 A second optional argument specifies the obarray to use;\n\
2042 it defaults to the value of `obarray'.")
2044 Lisp_Object string
, obarray
;
2046 register Lisp_Object tem
, sym
, *ptr
;
2048 if (NILP (obarray
)) obarray
= Vobarray
;
2049 obarray
= check_obarray (obarray
);
2051 CHECK_STRING (string
, 0);
2053 tem
= oblookup (obarray
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2054 if (!INTEGERP (tem
))
2057 if (!NILP (Vpurify_flag
))
2058 string
= Fpurecopy (string
);
2059 sym
= Fmake_symbol (string
);
2060 XSYMBOL (sym
)->obarray
= obarray
;
2062 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
2064 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
2066 XSYMBOL (sym
)->next
= 0;
2071 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
2072 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
2073 A second optional argument specifies the obarray to use;\n\
2074 it defaults to the value of `obarray'.")
2076 Lisp_Object string
, obarray
;
2078 register Lisp_Object tem
;
2080 if (NILP (obarray
)) obarray
= Vobarray
;
2081 obarray
= check_obarray (obarray
);
2083 CHECK_STRING (string
, 0);
2085 tem
= oblookup (obarray
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2086 if (!INTEGERP (tem
))
2091 DEFUN ("unintern", Funintern
, Sunintern
, 1, 2, 0,
2092 "Delete the symbol named NAME, if any, from OBARRAY.\n\
2093 The value is t if a symbol was found and deleted, nil otherwise.\n\
2094 NAME may be a string or a symbol. If it is a symbol, that symbol\n\
2095 is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\
2096 OBARRAY defaults to the value of the variable `obarray'.")
2098 Lisp_Object name
, obarray
;
2100 register Lisp_Object string
, tem
;
2103 if (NILP (obarray
)) obarray
= Vobarray
;
2104 obarray
= check_obarray (obarray
);
2107 XSETSTRING (string
, XSYMBOL (name
)->name
);
2110 CHECK_STRING (name
, 0);
2114 tem
= oblookup (obarray
, XSTRING (string
)->data
, XSTRING (string
)->size
);
2117 /* If arg was a symbol, don't delete anything but that symbol itself. */
2118 if (SYMBOLP (name
) && !EQ (name
, tem
))
2121 hash
= oblookup_last_bucket_number
;
2123 if (EQ (XVECTOR (obarray
)->contents
[hash
], tem
))
2125 if (XSYMBOL (tem
)->next
)
2126 XSETSYMBOL (XVECTOR (obarray
)->contents
[hash
], XSYMBOL (tem
)->next
);
2128 XSETINT (XVECTOR (obarray
)->contents
[hash
], 0);
2132 Lisp_Object tail
, following
;
2134 for (tail
= XVECTOR (obarray
)->contents
[hash
];
2135 XSYMBOL (tail
)->next
;
2138 XSETSYMBOL (following
, XSYMBOL (tail
)->next
);
2139 if (EQ (following
, tem
))
2141 XSYMBOL (tail
)->next
= XSYMBOL (following
)->next
;
2150 /* Return the symbol in OBARRAY whose names matches the string
2151 of SIZE characters at PTR. If there is no such symbol in OBARRAY,
2154 Also store the bucket number in oblookup_last_bucket_number. */
2157 oblookup (obarray
, ptr
, size
)
2158 Lisp_Object obarray
;
2164 register Lisp_Object tail
;
2165 Lisp_Object bucket
, tem
;
2167 if (!VECTORP (obarray
)
2168 || (obsize
= XVECTOR (obarray
)->size
) == 0)
2170 obarray
= check_obarray (obarray
);
2171 obsize
= XVECTOR (obarray
)->size
;
2173 /* This is sometimes needed in the middle of GC. */
2174 obsize
&= ~ARRAY_MARK_FLAG
;
2175 /* Combining next two lines breaks VMS C 2.3. */
2176 hash
= hash_string (ptr
, size
);
2178 bucket
= XVECTOR (obarray
)->contents
[hash
];
2179 oblookup_last_bucket_number
= hash
;
2180 if (XFASTINT (bucket
) == 0)
2182 else if (!SYMBOLP (bucket
))
2183 error ("Bad data in guts of obarray"); /* Like CADR error message */
2185 for (tail
= bucket
; ; XSETSYMBOL (tail
, XSYMBOL (tail
)->next
))
2187 if (XSYMBOL (tail
)->name
->size
== size
2188 && !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
2190 else if (XSYMBOL (tail
)->next
== 0)
2193 XSETINT (tem
, hash
);
2198 hash_string (ptr
, len
)
2202 register unsigned char *p
= ptr
;
2203 register unsigned char *end
= p
+ len
;
2204 register unsigned char c
;
2205 register int hash
= 0;
2210 if (c
>= 0140) c
-= 40;
2211 hash
= ((hash
<<3) + (hash
>>28) + c
);
2213 return hash
& 07777777777;
2217 map_obarray (obarray
, fn
, arg
)
2218 Lisp_Object obarray
;
2223 register Lisp_Object tail
;
2224 CHECK_VECTOR (obarray
, 1);
2225 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
2227 tail
= XVECTOR (obarray
)->contents
[i
];
2228 if (XFASTINT (tail
) != 0)
2232 if (XSYMBOL (tail
)->next
== 0)
2234 XSETSYMBOL (tail
, XSYMBOL (tail
)->next
);
2239 mapatoms_1 (sym
, function
)
2240 Lisp_Object sym
, function
;
2242 call1 (function
, sym
);
2245 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
2246 "Call FUNCTION on every symbol in OBARRAY.\n\
2247 OBARRAY defaults to the value of `obarray'.")
2249 Lisp_Object function
, obarray
;
2253 if (NILP (obarray
)) obarray
= Vobarray
;
2254 obarray
= check_obarray (obarray
);
2256 map_obarray (obarray
, mapatoms_1
, function
);
2260 #define OBARRAY_SIZE 1511
2265 Lisp_Object oblength
;
2269 XSETFASTINT (oblength
, OBARRAY_SIZE
);
2271 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
2272 Vobarray
= Fmake_vector (oblength
, make_number (0));
2273 initial_obarray
= Vobarray
;
2274 staticpro (&initial_obarray
);
2275 /* Intern nil in the obarray */
2276 XSYMBOL (Qnil
)->obarray
= Vobarray
;
2277 /* These locals are to kludge around a pyramid compiler bug. */
2278 hash
= hash_string ("nil", 3);
2279 /* Separate statement here to avoid VAXC bug. */
2280 hash
%= OBARRAY_SIZE
;
2281 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
2284 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
2285 XSYMBOL (Qnil
)->function
= Qunbound
;
2286 XSYMBOL (Qunbound
)->value
= Qunbound
;
2287 XSYMBOL (Qunbound
)->function
= Qunbound
;
2290 XSYMBOL (Qnil
)->value
= Qnil
;
2291 XSYMBOL (Qnil
)->plist
= Qnil
;
2292 XSYMBOL (Qt
)->value
= Qt
;
2294 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
2297 Qvariable_documentation
= intern ("variable-documentation");
2298 staticpro (&Qvariable_documentation
);
2300 read_buffer_size
= 100;
2301 read_buffer
= (char *) malloc (read_buffer_size
);
2306 struct Lisp_Subr
*sname
;
2309 sym
= intern (sname
->symbol_name
);
2310 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2313 #ifdef NOTDEF /* use fset in subr.el now */
2315 defalias (sname
, string
)
2316 struct Lisp_Subr
*sname
;
2320 sym
= intern (string
);
2321 XSETSUBR (XSYMBOL (sym
)->function
, sname
);
2325 /* Define an "integer variable"; a symbol whose value is forwarded
2326 to a C variable of type int. Sample call: */
2327 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
2329 defvar_int (namestring
, address
)
2333 Lisp_Object sym
, val
;
2334 sym
= intern (namestring
);
2335 val
= allocate_misc ();
2336 XMISCTYPE (val
) = Lisp_Misc_Intfwd
;
2337 XINTFWD (val
)->intvar
= address
;
2338 XSYMBOL (sym
)->value
= val
;
2341 /* Similar but define a variable whose value is T if address contains 1,
2342 NIL if address contains 0 */
2344 defvar_bool (namestring
, address
)
2348 Lisp_Object sym
, val
;
2349 sym
= intern (namestring
);
2350 val
= allocate_misc ();
2351 XMISCTYPE (val
) = Lisp_Misc_Boolfwd
;
2352 XBOOLFWD (val
)->boolvar
= address
;
2353 XSYMBOL (sym
)->value
= val
;
2356 /* Similar but define a variable whose value is the Lisp Object stored
2357 at address. Two versions: with and without gc-marking of the C
2358 variable. The nopro version is used when that variable will be
2359 gc-marked for some other reason, since marking the same slot twice
2360 can cause trouble with strings. */
2362 defvar_lisp_nopro (namestring
, address
)
2364 Lisp_Object
*address
;
2366 Lisp_Object sym
, val
;
2367 sym
= intern (namestring
);
2368 val
= allocate_misc ();
2369 XMISCTYPE (val
) = Lisp_Misc_Objfwd
;
2370 XOBJFWD (val
)->objvar
= address
;
2371 XSYMBOL (sym
)->value
= val
;
2375 defvar_lisp (namestring
, address
)
2377 Lisp_Object
*address
;
2379 defvar_lisp_nopro (namestring
, address
);
2380 staticpro (address
);
2385 /* Similar but define a variable whose value is the Lisp Object stored in
2386 the current buffer. address is the address of the slot in the buffer
2387 that is current now. */
2390 defvar_per_buffer (namestring
, address
, type
, doc
)
2392 Lisp_Object
*address
;
2396 Lisp_Object sym
, val
;
2398 extern struct buffer buffer_local_symbols
;
2400 sym
= intern (namestring
);
2401 val
= allocate_misc ();
2402 offset
= (char *)address
- (char *)current_buffer
;
2404 XMISCTYPE (val
) = Lisp_Misc_Buffer_Objfwd
;
2405 XBUFFER_OBJFWD (val
)->offset
= offset
;
2406 XSYMBOL (sym
)->value
= val
;
2407 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
2408 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
2409 if (XINT (*(Lisp_Object
*)(offset
+ (char *)&buffer_local_flags
)) == 0)
2410 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
2411 slot of buffer_local_flags */
2415 #endif /* standalone */
2417 /* Similar but define a variable whose value is the Lisp Object stored
2418 at a particular offset in the current kboard object. */
2421 defvar_kboard (namestring
, offset
)
2425 Lisp_Object sym
, val
;
2426 sym
= intern (namestring
);
2427 val
= allocate_misc ();
2428 XMISCTYPE (val
) = Lisp_Misc_Kboard_Objfwd
;
2429 XKBOARD_OBJFWD (val
)->offset
= offset
;
2430 XSYMBOL (sym
)->value
= val
;
2433 /* Record the value of load-path used at the start of dumping
2434 so we can see if the site changed it later during dumping. */
2435 static Lisp_Object dump_path
;
2440 int turn_off_warning
= 0;
2442 #ifdef HAVE_SETLOCALE
2443 /* Make sure numbers are parsed as we expect. */
2444 setlocale (LC_NUMERIC
, "C");
2445 #endif /* HAVE_SETLOCALE */
2447 /* Compute the default load-path. */
2449 normal
= PATH_LOADSEARCH
;
2450 Vload_path
= decode_env_path (0, normal
);
2452 if (NILP (Vpurify_flag
))
2453 normal
= PATH_LOADSEARCH
;
2455 normal
= PATH_DUMPLOADSEARCH
;
2457 /* In a dumped Emacs, we normally have to reset the value of
2458 Vload_path from PATH_LOADSEARCH, since the value that was dumped
2459 uses ../lisp, instead of the path of the installed elisp
2460 libraries. However, if it appears that Vload_path was changed
2461 from the default before dumping, don't override that value. */
2464 if (! NILP (Fequal (dump_path
, Vload_path
)))
2466 Vload_path
= decode_env_path (0, normal
);
2467 if (!NILP (Vinstallation_directory
))
2469 /* Add to the path the lisp subdir of the
2470 installation dir, if it exists. */
2471 Lisp_Object tem
, tem1
;
2472 tem
= Fexpand_file_name (build_string ("lisp"),
2473 Vinstallation_directory
);
2474 tem1
= Ffile_exists_p (tem
);
2477 if (NILP (Fmember (tem
, Vload_path
)))
2479 turn_off_warning
= 1;
2480 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2484 /* That dir doesn't exist, so add the build-time
2485 Lisp dirs instead. */
2486 Vload_path
= nconc2 (Vload_path
, dump_path
);
2488 /* Add site-list under the installation dir, if it exists. */
2489 tem
= Fexpand_file_name (build_string ("site-lisp"),
2490 Vinstallation_directory
);
2491 tem1
= Ffile_exists_p (tem
);
2494 if (NILP (Fmember (tem
, Vload_path
)))
2495 Vload_path
= nconc2 (Vload_path
, Fcons (tem
, Qnil
));
2502 /* ../lisp refers to the build directory.
2503 NORMAL refers to the lisp dir in the source directory. */
2504 Vload_path
= Fcons (build_string ("../lisp"),
2505 decode_env_path (0, normal
));
2506 dump_path
= Vload_path
;
2511 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
2512 almost never correct, thereby causing a warning to be printed out that
2513 confuses users. Since PATH_LOADSEARCH is always overridden by the
2514 EMACSLOADPATH environment variable below, disable the warning on NT. */
2516 /* Warn if dirs in the *standard* path don't exist. */
2517 if (!turn_off_warning
)
2519 Lisp_Object path_tail
;
2521 for (path_tail
= Vload_path
;
2523 path_tail
= XCONS (path_tail
)->cdr
)
2525 Lisp_Object dirfile
;
2526 dirfile
= Fcar (path_tail
);
2527 if (STRINGP (dirfile
))
2529 dirfile
= Fdirectory_file_name (dirfile
);
2530 if (access (XSTRING (dirfile
)->data
, 0) < 0)
2531 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
2532 XCONS (path_tail
)->car
);
2536 #endif /* WINDOWSNT */
2538 /* If the EMACSLOADPATH environment variable is set, use its value.
2539 This doesn't apply if we're dumping. */
2541 if (NILP (Vpurify_flag
)
2542 && egetenv ("EMACSLOADPATH"))
2544 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
2548 load_in_progress
= 0;
2549 Vload_file_name
= Qnil
;
2551 load_descriptor_list
= Qnil
;
2554 /* Print a warning, using format string FORMAT, that directory DIRNAME
2555 does not exist. Print it on stderr and put it in *Message*. */
2557 dir_warning (format
, dirname
)
2559 Lisp_Object dirname
;
2562 = (char *) alloca (XSTRING (dirname
)->size
+ strlen (format
) + 5);
2564 fprintf (stderr
, format
, XSTRING (dirname
)->data
);
2565 sprintf (buffer
, format
, XSTRING (dirname
)->data
);
2566 message_dolog (buffer
, strlen (buffer
), 0);
2573 defsubr (&Sread_from_string
);
2575 defsubr (&Sintern_soft
);
2576 defsubr (&Sunintern
);
2578 defsubr (&Seval_buffer
);
2579 defsubr (&Seval_region
);
2580 defsubr (&Sread_char
);
2581 defsubr (&Sread_char_exclusive
);
2582 defsubr (&Sread_event
);
2583 defsubr (&Sget_file_char
);
2584 defsubr (&Smapatoms
);
2586 DEFVAR_LISP ("obarray", &Vobarray
,
2587 "Symbol table for use by `intern' and `read'.\n\
2588 It is a vector whose length ought to be prime for best results.\n\
2589 The vector's contents don't make sense if examined from Lisp programs;\n\
2590 to find all the symbols in an obarray, use `mapatoms'.");
2592 DEFVAR_LISP ("values", &Vvalues
,
2593 "List of values of all expressions which were read, evaluated and printed.\n\
2594 Order is reverse chronological.");
2596 DEFVAR_LISP ("standard-input", &Vstandard_input
,
2597 "Stream for read to get input from.\n\
2598 See documentation of `read' for possible values.");
2599 Vstandard_input
= Qt
;
2601 DEFVAR_LISP ("load-path", &Vload_path
,
2602 "*List of directories to search for files to load.\n\
2603 Each element is a string (directory name) or nil (try default directory).\n\
2604 Initialized based on EMACSLOADPATH environment variable, if any,\n\
2605 otherwise to default specified by file `paths.h' when Emacs was built.");
2607 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
2608 "Non-nil iff inside of `load'.");
2610 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
2611 "An alist of expressions to be evalled when particular files are loaded.\n\
2612 Each element looks like (FILENAME FORMS...).\n\
2613 When `load' is run and the file-name argument is FILENAME,\n\
2614 the FORMS in the corresponding element are executed at the end of loading.\n\n\
2615 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
2616 with no directory specified, since that is how `load' is normally called.\n\
2617 An error in FORMS does not undo the load,\n\
2618 but does prevent execution of the rest of the FORMS.");
2619 Vafter_load_alist
= Qnil
;
2621 DEFVAR_LISP ("load-history", &Vload_history
,
2622 "Alist mapping source file names to symbols and features.\n\
2623 Each alist element is a list that starts with a file name,\n\
2624 except for one element (optional) that starts with nil and describes\n\
2625 definitions evaluated from buffers not visiting files.\n\
2626 The remaining elements of each list are symbols defined as functions\n\
2627 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2628 Vload_history
= Qnil
;
2630 DEFVAR_LISP ("load-file-name", &Vload_file_name
,
2631 "Full name of file being loaded by `load'.");
2632 Vload_file_name
= Qnil
;
2634 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list
,
2635 "Used for internal purposes by `load'.");
2636 Vcurrent_load_list
= Qnil
;
2638 DEFVAR_LISP ("load-read-function", &Vload_read_function
,
2639 "Function used by `load' and `eval-region' for reading expressions.\n\
2640 The default is nil, which means use the function `read'.");
2641 Vload_read_function
= Qnil
;
2643 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function
,
2644 "Function called in `load' for loading an Emacs lisp source file.\n\
2645 This function is for doing code conversion before reading the source file.\n\
2646 If nil, loading is done without any code conversion.\n\
2647 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\
2648 FULLNAME is the full name of FILE.\n\
2649 See `load' for the meaning of the remaining arguments.");
2650 Vload_source_file_function
= Qnil
;
2652 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings
,
2653 "Non-nil means `load' should force-load all dynamic doc strings.\n\
2654 This is useful when the file being loaded is a temporary copy.");
2655 load_force_doc_strings
= 0;
2657 DEFVAR_LISP ("source-directory", &Vsource_directory
,
2658 "Directory in which Emacs sources were found when Emacs was built.\n\
2659 You cannot count on them to still be there!");
2661 = Fexpand_file_name (build_string ("../"),
2662 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH
)));
2664 /* Vsource_directory was initialized in init_lread. */
2666 load_descriptor_list
= Qnil
;
2667 staticpro (&load_descriptor_list
);
2669 Qcurrent_load_list
= intern ("current-load-list");
2670 staticpro (&Qcurrent_load_list
);
2672 Qstandard_input
= intern ("standard-input");
2673 staticpro (&Qstandard_input
);
2675 Qread_char
= intern ("read-char");
2676 staticpro (&Qread_char
);
2678 Qget_file_char
= intern ("get-file-char");
2679 staticpro (&Qget_file_char
);
2681 Qbackquote
= intern ("`");
2682 staticpro (&Qbackquote
);
2683 Qcomma
= intern (",");
2684 staticpro (&Qcomma
);
2685 Qcomma_at
= intern (",@");
2686 staticpro (&Qcomma_at
);
2687 Qcomma_dot
= intern (",.");
2688 staticpro (&Qcomma_dot
);
2690 Qinhibit_file_name_operation
= intern ("inhibit-file-name-operation");
2691 staticpro (&Qinhibit_file_name_operation
);
2693 Qascii_character
= intern ("ascii-character");
2694 staticpro (&Qascii_character
);
2696 Qfunction
= intern ("function");
2697 staticpro (&Qfunction
);
2699 Qload
= intern ("load");
2702 Qload_file_name
= intern ("load-file-name");
2703 staticpro (&Qload_file_name
);
2705 staticpro (&dump_path
);
2707 staticpro (&read_objects
);
2708 read_objects
= Qnil
;