1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989,
3 1992 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. */
23 #include <sys/types.h>
39 #include <sys/inode.h>
46 #ifdef LISP_FLOAT_TYPE
48 #endif /* LISP_FLOAT_TYPE */
50 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
;
51 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
53 /* non-zero if inside `load' */
56 /* Search path for files to be loaded. */
57 Lisp_Object Vload_path
;
59 /* File for get_file_char to read from. Use by load */
60 static FILE *instream
;
62 /* When nonzero, read conses in pure space */
65 /* For use within read-from-string (this reader is non-reentrant!!) */
66 static int read_from_string_index
;
67 static int read_from_string_limit
;
69 /* Handle unreading and rereading of characters.
70 Write READCHAR to read a character,
71 UNREAD(c) to unread c to be read again. */
73 #define READCHAR readchar (readcharfun)
74 #define UNREAD(c) unreadchar (readcharfun, c)
77 readchar (readcharfun
)
78 Lisp_Object readcharfun
;
81 register struct buffer
*inbuffer
;
84 if (XTYPE (readcharfun
) == Lisp_Buffer
)
86 inbuffer
= XBUFFER (readcharfun
);
88 if (BUF_PT (inbuffer
) >= BUF_ZV (inbuffer
))
90 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, BUF_PT (inbuffer
));
91 SET_BUF_PT (inbuffer
, BUF_PT (inbuffer
) + 1);
95 if (XTYPE (readcharfun
) == Lisp_Marker
)
97 inbuffer
= XMARKER (readcharfun
)->buffer
;
99 mpos
= marker_position (readcharfun
);
101 if (mpos
> BUF_ZV (inbuffer
) - 1)
103 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, mpos
);
104 if (mpos
!= BUF_GPT (inbuffer
))
105 XMARKER (readcharfun
)->bufpos
++;
107 Fset_marker (readcharfun
, make_number (mpos
+ 1),
108 Fmarker_buffer (readcharfun
));
111 if (EQ (readcharfun
, Qget_file_char
))
112 return getc (instream
);
114 if (XTYPE (readcharfun
) == Lisp_String
)
117 /* This used to be return of a conditional expression,
118 but that truncated -1 to a char on VMS. */
119 if (read_from_string_index
< read_from_string_limit
)
120 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
126 tem
= call0 (readcharfun
);
133 /* Unread the character C in the way appropriate for the stream READCHARFUN.
134 If the stream is a user function, call it with the char as argument. */
137 unreadchar (readcharfun
, c
)
138 Lisp_Object readcharfun
;
141 if (XTYPE (readcharfun
) == Lisp_Buffer
)
143 if (XBUFFER (readcharfun
) == current_buffer
)
146 SET_BUF_PT (XBUFFER (readcharfun
), BUF_PT (XBUFFER (readcharfun
)) - 1);
148 else if (XTYPE (readcharfun
) == Lisp_Marker
)
149 XMARKER (readcharfun
)->bufpos
--;
150 else if (XTYPE (readcharfun
) == Lisp_String
)
151 read_from_string_index
--;
152 else if (EQ (readcharfun
, Qget_file_char
))
153 ungetc (c
, instream
);
155 call1 (readcharfun
, make_number (c
));
158 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
160 /* get a character from the tty */
162 extern Lisp_Object
read_char ();
164 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
165 "Read a character from the command input (keyboard or macro).\n\
166 It is returned as a number.\n\
167 If the user generates an event which is not a character (i.e. a mouse\n\
168 click or function key event), `read-char' signals an error. As an\n\
169 exception, switch-frame events are put off until non-ASCII events can\n\
171 If you want to read non-character events, or ignore them, call\n\
172 `read-event' or `read-char-exclusive' instead.")
175 register Lisp_Object val
;
179 register Lisp_Object delayed_switch_frame
;
181 delayed_switch_frame
= Qnil
;
185 val
= read_char (0, 0, 0, Qnil
, 0);
187 /* switch-frame events are put off until after the next ASCII
188 character. This is better than signalling an error just
189 because the last characters were typed to a separate
190 minibuffer frame, for example. Eventually, some code which
191 can deal with switch-frame events will read it and process
193 if (EVENT_HAS_PARAMETERS (val
)
194 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
195 delayed_switch_frame
= val
;
200 if (! NILP (delayed_switch_frame
))
201 unread_switch_frame
= delayed_switch_frame
;
203 /* Only ASCII characters are acceptable. */
204 if (XTYPE (val
) != Lisp_Int
)
206 unread_command_events
= Fcons (val
, Qnil
);
207 error ("Object read was not a character");
217 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
218 "Read an event object from the input stream.")
221 register Lisp_Object val
;
223 val
= read_char (0, 0, 0, Qnil
, 0);
227 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
228 "Read a character from the command input (keyboard or macro).\n\
229 It is returned as a number. Non character events are ignored.")
232 register Lisp_Object val
;
236 Lisp_Object delayed_switch_frame
;
238 delayed_switch_frame
= Qnil
;
242 val
= read_char (0, 0, 0, Qnil
, 0);
244 if (XTYPE (val
) == Lisp_Int
)
247 /* switch-frame events are put off until after the next ASCII
248 character. This is better than signalling an error just
249 because the last characters were typed to a separate
250 minibuffer frame, for example. Eventually, some code which
251 can deal with switch-frame events will read it and process
253 else if (EVENT_HAS_PARAMETERS (val
)
254 && EQ (EVENT_HEAD (val
), Qswitch_frame
))
255 delayed_switch_frame
= val
;
257 /* Drop everything else. */
260 if (! NILP (delayed_switch_frame
))
261 unread_switch_frame
= delayed_switch_frame
;
270 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
271 "Don't use this yourself.")
274 register Lisp_Object val
;
275 XSET (val
, Lisp_Int
, getc (instream
));
279 static void readevalloop ();
280 static Lisp_Object
load_unwind ();
282 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
283 "Execute a file of Lisp code named FILE.\n\
284 First try FILE with `.elc' appended, then try with `.el',\n\
285 then try FILE unmodified.\n\
286 This function searches the directories in `load-path'.\n\
287 If optional second arg NOERROR is non-nil,\n\
288 report no error if FILE doesn't exist.\n\
289 Print messages at start and end of loading unless\n\
290 optional third arg NOMESSAGE is non-nil.\n\
291 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
292 suffixes `.elc' or `.el' to the specified name FILE.\n\
293 Return t if file exists.")
294 (str
, noerror
, nomessage
, nosuffix
)
295 Lisp_Object str
, noerror
, nomessage
, nosuffix
;
297 register FILE *stream
;
298 register int fd
= -1;
299 register Lisp_Object lispstream
;
301 int count
= specpdl_ptr
- specpdl
;
305 /* 1 means inhibit the message at the beginning. */
308 CHECK_STRING (str
, 0);
309 str
= Fsubstitute_in_file_name (str
);
311 /* Avoid weird lossage with null string as arg,
312 since it would try to load a directory as a Lisp file */
313 if (XSTRING (str
)->size
> 0)
315 fd
= openp (Vload_path
, str
, !NILP (nosuffix
) ? "" : ".elc:.el:",
323 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
329 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
335 stat (XSTRING (found
)->data
, &s1
);
336 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
337 result
= stat (XSTRING (found
)->data
, &s2
);
338 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
340 message ("Source file `%s' newer than byte-compiled file",
341 XSTRING (found
)->data
);
342 /* Don't immediately overwrite this message. */
346 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
349 stream
= fdopen (fd
, "r");
353 error ("Failure to create stdio stream for %s", XSTRING (str
)->data
);
356 if (NILP (nomessage
) && !nomessage1
)
357 message ("Loading %s...", XSTRING (str
)->data
);
360 /* We may not be able to store STREAM itself as a Lisp_Object pointer
361 since that is guaranteed to work only for data that has been malloc'd.
362 So malloc a full-size pointer, and record the address of that pointer. */
363 ptr
= (FILE **) xmalloc (sizeof (FILE *));
365 XSET (lispstream
, Lisp_Internal_Stream
, (int) ptr
);
366 record_unwind_protect (load_unwind
, lispstream
);
368 readevalloop (Qget_file_char
, stream
, Feval
, 0);
369 unbind_to (count
, Qnil
);
371 /* Run any load-hooks for this file. */
372 temp
= Fassoc (str
, Vafter_load_alist
);
374 Fprogn (Fcdr (temp
));
377 if (!noninteractive
&& NILP (nomessage
))
378 message ("Loading %s...done", XSTRING (str
)->data
);
383 load_unwind (stream
) /* used as unwind-protect function in load */
386 fclose (*(FILE **) XSTRING (stream
));
387 free (XPNTR (stream
));
388 if (--load_in_progress
< 0) load_in_progress
= 0;
394 complete_filename_p (pathname
)
395 Lisp_Object pathname
;
397 register unsigned char *s
= XSTRING (pathname
)->data
;
408 /* Search for a file whose name is STR, looking in directories
409 in the Lisp list PATH, and trying suffixes from SUFFIX.
410 SUFFIX is a string containing possible suffixes separated by colons.
411 On success, returns a file descriptor. On failure, returns -1.
413 EXEC_ONLY nonzero means don't open the files,
414 just look for one that is executable. In this case,
415 returns 1 on success.
417 If STOREPTR is nonzero, it points to a slot where the name of
418 the file actually found should be stored as a Lisp string.
419 Nil is stored there on failure. */
422 openp (path
, str
, suffix
, storeptr
, exec_only
)
423 Lisp_Object path
, str
;
425 Lisp_Object
*storeptr
;
431 register char *fn
= buf
;
434 register Lisp_Object filename
;
440 if (complete_filename_p (str
))
443 for (; !NILP (path
); path
= Fcdr (path
))
447 filename
= Fexpand_file_name (str
, Fcar (path
));
448 if (!complete_filename_p (filename
))
449 /* If there are non-absolute elts in PATH (eg ".") */
450 /* Of course, this could conceivably lose if luser sets
451 default-directory to be something non-absolute... */
453 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
454 if (!complete_filename_p (filename
))
455 /* Give up on this path element! */
459 /* Calculate maximum size of any filename made from
460 this path element/specified file name and any possible suffix. */
461 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
462 if (fn_size
< want_size
)
463 fn
= (char *) alloca (fn_size
= 100 + want_size
);
467 /* Loop over suffixes. */
470 char *esuffix
= (char *) index (nsuffix
, ':');
471 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
473 /* Concatenate path element/specified name with the suffix. */
474 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
475 fn
[XSTRING (filename
)->size
] = 0;
476 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
477 strncat (fn
, nsuffix
, lsuffix
);
479 /* Ignore file if it's a directory. */
480 if (stat (fn
, &st
) >= 0
481 && (st
.st_mode
& S_IFMT
) != S_IFDIR
)
483 /* Check that we can access or open it. */
485 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
487 fd
= open (fn
, 0, 0);
491 /* We succeeded; return this descriptor and filename. */
493 *storeptr
= build_string (fn
);
498 /* Advance to next suffix. */
501 nsuffix
+= lsuffix
+ 1;
503 if (absolute
) return -1;
511 unreadpure () /* Used as unwind-protect function in readevalloop */
518 readevalloop (readcharfun
, stream
, evalfun
, printflag
)
519 Lisp_Object readcharfun
;
521 Lisp_Object (*evalfun
) ();
525 register Lisp_Object val
;
526 int count
= specpdl_ptr
- specpdl
;
528 specbind (Qstandard_input
, readcharfun
);
536 while ((c
= READCHAR
) != '\n' && c
!= -1);
540 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f') continue;
542 if (!NILP (Vpurify_flag
) && c
== '(')
544 record_unwind_protect (unreadpure
, Qnil
);
545 val
= read_list (-1, readcharfun
);
546 unbind_to (count
+ 1, Qnil
);
551 val
= read0 (readcharfun
);
554 val
= (*evalfun
) (val
);
557 Vvalues
= Fcons (val
, Vvalues
);
558 if (EQ (Vstandard_output
, Qt
))
565 unbind_to (count
, Qnil
);
570 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
571 "Execute the current buffer as Lisp code.\n\
572 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
573 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
574 PRINTFLAG controls printing of output:\n\
575 nil means discard it; anything else is stream for print.\n\
577 If there is no error, point does not move. If there is an error,\n\
578 point remains at the end of the last character read from the buffer.")
580 Lisp_Object bufname
, printflag
;
582 int count
= specpdl_ptr
- specpdl
;
583 Lisp_Object tem
, buf
;
586 buf
= Fcurrent_buffer ();
588 buf
= Fget_buffer (bufname
);
590 error ("No such buffer.");
592 if (NILP (printflag
))
596 specbind (Qstandard_output
, tem
);
597 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
598 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
599 readevalloop (buf
, 0, Feval
, !NILP (printflag
));
606 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
607 "Execute the current buffer as Lisp code.\n\
608 Programs can pass argument PRINTFLAG which controls printing of output:\n\
609 nil means discard it; anything else is stream for print.\n\
611 If there is no error, point does not move. If there is an error,\n\
612 point remains at the end of the last character read from the buffer.")
614 Lisp_Object printflag
;
616 int count
= specpdl_ptr
- specpdl
;
619 if (NILP (printflag
))
623 specbind (Qstandard_output
, tem
);
624 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
626 readevalloop (Fcurrent_buffer (), 0, Feval
, !NILP (printflag
));
627 return unbind_to (count
, Qnil
);
631 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
632 "Execute the region as Lisp code.\n\
633 When called from programs, expects two arguments,\n\
634 giving starting and ending indices in the current buffer\n\
635 of the text to be executed.\n\
636 Programs can pass third argument PRINTFLAG which controls output:\n\
637 nil means discard it; anything else is stream for printing it.\n\
639 If there is no error, point does not move. If there is an error,\n\
640 point remains at the end of the last character read from the buffer.")
642 Lisp_Object b
, e
, printflag
;
644 int count
= specpdl_ptr
- specpdl
;
647 if (NILP (printflag
))
651 specbind (Qstandard_output
, tem
);
653 if (NILP (printflag
))
654 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
655 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
657 /* This both uses b and checks its type. */
659 Fnarrow_to_region (make_number (BEGV
), e
);
660 readevalloop (Fcurrent_buffer (), 0, Feval
, !NILP (printflag
));
662 return unbind_to (count
, Qnil
);
665 #endif /* standalone */
667 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
668 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
669 If STREAM is nil, use the value of `standard-input' (which see).\n\
670 STREAM or the value of `standard-input' may be:\n\
671 a buffer (read from point and advance it)\n\
672 a marker (read from where it points and advance it)\n\
673 a function (call it with no arguments for each character,\n\
674 call it with a char as argument to push a char back)\n\
675 a string (takes text from string, starting at the beginning)\n\
676 t (read text line using minibuffer and use it).")
678 Lisp_Object readcharfun
;
680 extern Lisp_Object
Fread_minibuffer ();
682 if (NILP (readcharfun
))
683 readcharfun
= Vstandard_input
;
684 if (EQ (readcharfun
, Qt
))
685 readcharfun
= Qread_char
;
688 if (EQ (readcharfun
, Qread_char
))
689 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
692 if (XTYPE (readcharfun
) == Lisp_String
)
693 return Fcar (Fread_from_string (readcharfun
, Qnil
, Qnil
));
695 return read0 (readcharfun
);
698 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
699 "Read one Lisp expression which is represented as text by STRING.\n\
700 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
701 START and END optionally delimit a substring of STRING from which to read;\n\
702 they default to 0 and (length STRING) respectively.")
704 Lisp_Object string
, start
, end
;
706 int startval
, endval
;
709 CHECK_STRING (string
,0);
712 endval
= XSTRING (string
)->size
;
714 { CHECK_NUMBER (end
,2);
716 if (endval
< 0 || endval
> XSTRING (string
)->size
)
717 args_out_of_range (string
, end
);
723 { CHECK_NUMBER (start
,1);
724 startval
= XINT (start
);
725 if (startval
< 0 || startval
> endval
)
726 args_out_of_range (string
, start
);
729 read_from_string_index
= startval
;
730 read_from_string_limit
= endval
;
732 tem
= read0 (string
);
733 return Fcons (tem
, make_number (read_from_string_index
));
736 /* Use this for recursive reads, in contexts where internal tokens are not allowed. */
740 Lisp_Object readcharfun
;
742 register Lisp_Object val
;
745 val
= read1 (readcharfun
);
746 if (XTYPE (val
) == Lisp_Internal
)
749 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
755 static int read_buffer_size
;
756 static char *read_buffer
;
759 read_escape (readcharfun
)
760 Lisp_Object readcharfun
;
762 register int c
= READCHAR
;
787 error ("Invalid escape character syntax");
790 c
= read_escape (readcharfun
);
796 error ("Invalid escape character syntax");
800 c
= read_escape (readcharfun
);
804 return (c
& (0200 | 037));
814 /* An octal escape, as in ANSI C. */
816 register int i
= c
- '0';
817 register int count
= 0;
820 if ((c
= READCHAR
) >= '0' && c
<= '7')
835 /* A hex escape, as in ANSI C. */
841 if (c
>= '0' && c
<= '9')
846 else if ((c
>= 'a' && c
<= 'f')
847 || (c
>= 'A' && c
<= 'F'))
850 if (c
>= 'a' && c
<= 'f')
871 register Lisp_Object readcharfun
;
878 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
883 return read_list (0, readcharfun
);
886 return read_vector (readcharfun
);
891 register Lisp_Object val
;
892 XSET (val
, Lisp_Internal
, c
);
900 /* Accept compiled functions at read-time so that we don't have to
901 build them using function calls. */
902 Lisp_Object tmp
= read_vector (readcharfun
);
903 return Fmake_byte_code (XVECTOR(tmp
)->size
, XVECTOR (tmp
)->contents
);
906 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
909 while ((c
= READCHAR
) >= 0 && c
!= '\n');
914 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
919 register Lisp_Object val
;
922 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
925 XSET (val
, Lisp_Int
, read_escape (readcharfun
));
927 XSET (val
, Lisp_Int
, c
);
934 register char *p
= read_buffer
;
935 register char *end
= read_buffer
+ read_buffer_size
;
939 while ((c
= READCHAR
) >= 0
944 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
945 p
+= new - read_buffer
;
946 read_buffer
+= new - read_buffer
;
947 end
= read_buffer
+ read_buffer_size
;
950 c
= read_escape (readcharfun
);
951 /* c is -1 if \ newline has just been seen */
954 if (p
== read_buffer
)
960 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
962 /* If purifying, and string starts with \ newline,
963 return zero instead. This is for doc strings
964 that we are really going to find in etc/DOC.nn.nn */
965 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
966 return make_number (0);
969 return make_pure_string (read_buffer
, p
- read_buffer
);
971 return make_string (read_buffer
, p
- read_buffer
);
976 #ifdef LISP_FLOAT_TYPE
977 /* If a period is followed by a number, then we should read it
978 as a floating point number. Otherwise, it denotes a dotted
980 int next_char
= READCHAR
;
983 if (! isdigit (next_char
))
986 register Lisp_Object val
;
987 XSET (val
, Lisp_Internal
, c
);
991 /* Otherwise, we fall through! Note that the atom-reading loop
992 below will now loop at least once, assuring that we will not
993 try to UNREAD two characters in a row. */
996 if (c
<= 040) goto retry
;
998 register char *p
= read_buffer
;
1001 register char *end
= read_buffer
+ read_buffer_size
;
1004 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
1005 || c
== '(' || c
== ')'
1006 #ifndef LISP_FLOAT_TYPE
1007 /* If we have floating-point support, then we need
1008 to allow <digits><dot><digits>. */
1010 #endif /* not LISP_FLOAT_TYPE */
1011 || c
== '[' || c
== ']' || c
== '#'
1016 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1017 p
+= new - read_buffer
;
1018 read_buffer
+= new - read_buffer
;
1019 end
= read_buffer
+ read_buffer_size
;
1029 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
1030 p
+= new - read_buffer
;
1031 read_buffer
+= new - read_buffer
;
1032 /* end = read_buffer + read_buffer_size; */
1039 /* Is it an integer? */
1042 register Lisp_Object val
;
1044 if (*p1
== '+' || *p1
== '-') p1
++;
1047 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
1048 #ifdef LISP_FLOAT_TYPE
1049 /* Integers can have trailing decimal points. */
1050 if (p1
< p
&& *p1
== '.') p1
++;
1053 /* It is an integer. */
1055 #ifdef LISP_FLOAT_TYPE
1059 XSET (val
, Lisp_Int
, atoi (read_buffer
));
1063 #ifdef LISP_FLOAT_TYPE
1064 if (isfloat_string (read_buffer
))
1065 return make_float (atof (read_buffer
));
1069 return intern (read_buffer
);
1074 #ifdef LISP_FLOAT_TYPE
1089 if (*cp
== '+' || *cp
== '-')
1095 while (isdigit (*cp
))
1106 while (isdigit (*cp
))
1114 if ((*cp
== '+') || (*cp
== '-'))
1120 while (isdigit (*cp
))
1124 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1125 || state
== (DOT_CHAR
|TRAIL_INT
)
1126 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1127 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1128 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1130 #endif /* LISP_FLOAT_TYPE */
1133 read_vector (readcharfun
)
1134 Lisp_Object readcharfun
;
1138 register Lisp_Object
*ptr
;
1139 register Lisp_Object tem
, vector
;
1140 register struct Lisp_Cons
*otem
;
1143 tem
= read_list (1, readcharfun
);
1144 len
= Flength (tem
);
1145 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1148 size
= XVECTOR (vector
)->size
;
1149 ptr
= XVECTOR (vector
)->contents
;
1150 for (i
= 0; i
< size
; i
++)
1152 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1160 /* flag = 1 means check for ] to terminate rather than ) and .
1161 flag = -1 means check for starting with defun
1162 and make structure pure. */
1165 read_list (flag
, readcharfun
)
1167 register Lisp_Object readcharfun
;
1169 /* -1 means check next element for defun,
1170 0 means don't check,
1171 1 means already checked and found defun. */
1172 int defunflag
= flag
< 0 ? -1 : 0;
1173 Lisp_Object val
, tail
;
1174 register Lisp_Object elt
, tem
;
1175 struct gcpro gcpro1
, gcpro2
;
1183 elt
= read1 (readcharfun
);
1185 if (XTYPE (elt
) == Lisp_Internal
)
1189 if (XINT (elt
) == ']')
1191 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (") or . in a vector", 18), Qnil
));
1193 if (XINT (elt
) == ')')
1195 if (XINT (elt
) == '.')
1199 XCONS (tail
)->cdr
= read0 (readcharfun
);
1201 val
= read0 (readcharfun
);
1202 elt
= read1 (readcharfun
);
1204 if (XTYPE (elt
) == Lisp_Internal
&& XINT (elt
) == ')')
1206 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1208 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1210 tem
= (read_pure
&& flag
<= 0
1211 ? pure_cons (elt
, Qnil
)
1212 : Fcons (elt
, Qnil
));
1214 XCONS (tail
)->cdr
= tem
;
1219 defunflag
= EQ (elt
, Qdefun
);
1220 else if (defunflag
> 0)
1225 Lisp_Object Vobarray
;
1226 Lisp_Object initial_obarray
;
1229 check_obarray (obarray
)
1230 Lisp_Object obarray
;
1232 while (XTYPE (obarray
) != Lisp_Vector
|| XVECTOR (obarray
)->size
== 0)
1234 /* If Vobarray is now invalid, force it to be valid. */
1235 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
1237 obarray
= wrong_type_argument (Qvectorp
, obarray
);
1242 static int hash_string ();
1243 Lisp_Object
oblookup ();
1250 int len
= strlen (str
);
1251 Lisp_Object obarray
= Vobarray
;
1253 if (XTYPE (obarray
) != Lisp_Vector
|| XVECTOR (obarray
)->size
== 0)
1254 obarray
= check_obarray (obarray
);
1255 tem
= oblookup (obarray
, str
, len
);
1256 if (XTYPE (tem
) == Lisp_Symbol
)
1258 return Fintern ((!NILP (Vpurify_flag
)
1259 ? make_pure_string (str
, len
)
1260 : make_string (str
, len
)),
1264 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
1265 "Return the canonical symbol whose name is STRING.\n\
1266 If there is none, one is created by this function and returned.\n\
1267 A second optional argument specifies the obarray to use;\n\
1268 it defaults to the value of `obarray'.")
1270 Lisp_Object str
, obarray
;
1272 register Lisp_Object tem
, sym
, *ptr
;
1274 if (NILP (obarray
)) obarray
= Vobarray
;
1275 obarray
= check_obarray (obarray
);
1277 CHECK_STRING (str
, 0);
1279 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1280 if (XTYPE (tem
) != Lisp_Int
)
1283 if (!NILP (Vpurify_flag
))
1284 str
= Fpurecopy (str
);
1285 sym
= Fmake_symbol (str
);
1287 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
1288 if (XTYPE (*ptr
) == Lisp_Symbol
)
1289 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
1291 XSYMBOL (sym
)->next
= 0;
1296 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
1297 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
1298 A second optional argument specifies the obarray to use;\n\
1299 it defaults to the value of `obarray'.")
1301 Lisp_Object str
, obarray
;
1303 register Lisp_Object tem
;
1305 if (NILP (obarray
)) obarray
= Vobarray
;
1306 obarray
= check_obarray (obarray
);
1308 CHECK_STRING (str
, 0);
1310 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1311 if (XTYPE (tem
) != Lisp_Int
)
1317 oblookup (obarray
, ptr
, size
)
1318 Lisp_Object obarray
;
1323 register Lisp_Object tail
;
1324 Lisp_Object bucket
, tem
;
1326 if (XTYPE (obarray
) != Lisp_Vector
||
1327 (obsize
= XVECTOR (obarray
)->size
) == 0)
1329 obarray
= check_obarray (obarray
);
1330 obsize
= XVECTOR (obarray
)->size
;
1332 /* Combining next two lines breaks VMS C 2.3. */
1333 hash
= hash_string (ptr
, size
);
1335 bucket
= XVECTOR (obarray
)->contents
[hash
];
1336 if (XFASTINT (bucket
) == 0)
1338 else if (XTYPE (bucket
) != Lisp_Symbol
)
1339 error ("Bad data in guts of obarray"); /* Like CADR error message */
1340 else for (tail
= bucket
; ; XSET (tail
, Lisp_Symbol
, XSYMBOL (tail
)->next
))
1342 if (XSYMBOL (tail
)->name
->size
== size
&&
1343 !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
1345 else if (XSYMBOL (tail
)->next
== 0)
1348 XSET (tem
, Lisp_Int
, hash
);
1353 hash_string (ptr
, len
)
1357 register unsigned char *p
= ptr
;
1358 register unsigned char *end
= p
+ len
;
1359 register unsigned char c
;
1360 register int hash
= 0;
1365 if (c
>= 0140) c
-= 40;
1366 hash
= ((hash
<<3) + (hash
>>28) + c
);
1368 return hash
& 07777777777;
1372 map_obarray (obarray
, fn
, arg
)
1373 Lisp_Object obarray
;
1378 register Lisp_Object tail
;
1379 CHECK_VECTOR (obarray
, 1);
1380 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
1382 tail
= XVECTOR (obarray
)->contents
[i
];
1383 if (XFASTINT (tail
) != 0)
1387 if (XSYMBOL (tail
)->next
== 0)
1389 XSET (tail
, Lisp_Symbol
, XSYMBOL (tail
)->next
);
1394 mapatoms_1 (sym
, function
)
1395 Lisp_Object sym
, function
;
1397 call1 (function
, sym
);
1400 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
1401 "Call FUNCTION on every symbol in OBARRAY.\n\
1402 OBARRAY defaults to the value of `obarray'.")
1404 Lisp_Object function
, obarray
;
1408 if (NILP (obarray
)) obarray
= Vobarray
;
1409 obarray
= check_obarray (obarray
);
1411 map_obarray (obarray
, mapatoms_1
, function
);
1415 #define OBARRAY_SIZE 509
1420 Lisp_Object oblength
;
1424 XFASTINT (oblength
) = OBARRAY_SIZE
;
1426 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
1427 Vobarray
= Fmake_vector (oblength
, make_number (0));
1428 initial_obarray
= Vobarray
;
1429 staticpro (&initial_obarray
);
1430 /* Intern nil in the obarray */
1431 /* These locals are to kludge around a pyramid compiler bug. */
1432 hash
= hash_string ("nil", 3);
1433 /* Separate statement here to avoid VAXC bug. */
1434 hash
%= OBARRAY_SIZE
;
1435 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
1438 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
1439 XSYMBOL (Qnil
)->function
= Qunbound
;
1440 XSYMBOL (Qunbound
)->value
= Qunbound
;
1441 XSYMBOL (Qunbound
)->function
= Qunbound
;
1444 XSYMBOL (Qnil
)->value
= Qnil
;
1445 XSYMBOL (Qnil
)->plist
= Qnil
;
1446 XSYMBOL (Qt
)->value
= Qt
;
1448 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
1451 Qvariable_documentation
= intern ("variable-documentation");
1453 read_buffer_size
= 100;
1454 read_buffer
= (char *) malloc (read_buffer_size
);
1459 struct Lisp_Subr
*sname
;
1462 sym
= intern (sname
->symbol_name
);
1463 XSET (XSYMBOL (sym
)->function
, Lisp_Subr
, sname
);
1466 #ifdef NOTDEF /* use fset in subr.el now */
1468 defalias (sname
, string
)
1469 struct Lisp_Subr
*sname
;
1473 sym
= intern (string
);
1474 XSET (XSYMBOL (sym
)->function
, Lisp_Subr
, sname
);
1478 /* New replacement for DefIntVar; it ignores the doc string argument
1479 on the assumption that make-docfile will handle that. */
1480 /* Define an "integer variable"; a symbol whose value is forwarded
1481 to a C variable of type int. Sample call: */
1482 /* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
1485 defvar_int (namestring
, address
, doc
)
1491 sym
= intern (namestring
);
1492 XSET (XSYMBOL (sym
)->value
, Lisp_Intfwd
, address
);
1495 /* Similar but define a variable whose value is T if address contains 1,
1496 NIL if address contains 0 */
1499 defvar_bool (namestring
, address
, doc
)
1505 sym
= intern (namestring
);
1506 XSET (XSYMBOL (sym
)->value
, Lisp_Boolfwd
, address
);
1509 /* Similar but define a variable whose value is the Lisp Object stored at address. */
1512 defvar_lisp (namestring
, address
, doc
)
1514 Lisp_Object
*address
;
1518 sym
= intern (namestring
);
1519 XSET (XSYMBOL (sym
)->value
, Lisp_Objfwd
, address
);
1520 staticpro (address
);
1523 /* Similar but don't request gc-marking of the C variable.
1524 Used when that variable will be gc-marked for some other reason,
1525 since marking the same slot twice can cause trouble with strings. */
1528 defvar_lisp_nopro (namestring
, address
, doc
)
1530 Lisp_Object
*address
;
1534 sym
= intern (namestring
);
1535 XSET (XSYMBOL (sym
)->value
, Lisp_Objfwd
, address
);
1540 /* Similar but define a variable whose value is the Lisp Object stored in
1541 the current buffer. address is the address of the slot in the buffer that is current now. */
1544 defvar_per_buffer (namestring
, address
, type
, doc
)
1546 Lisp_Object
*address
;
1552 extern struct buffer buffer_local_symbols
;
1554 sym
= intern (namestring
);
1555 offset
= (char *)address
- (char *)current_buffer
;
1557 XSET (XSYMBOL (sym
)->value
, Lisp_Buffer_Objfwd
,
1558 (Lisp_Object
*) offset
);
1559 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
1560 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_types
) = type
;
1561 if (*(int *)(offset
+ (char *)&buffer_local_flags
) == 0)
1562 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
1563 slot of buffer_local_flags */
1567 #endif /* standalone */
1573 /* Compute the default load-path. */
1575 normal
= PATH_LOADSEARCH
;
1576 Vload_path
= decode_env_path (0, normal
);
1578 if (NILP (Vpurify_flag
))
1579 normal
= PATH_LOADSEARCH
;
1581 normal
= PATH_DUMPLOADSEARCH
;
1583 /* In a dumped Emacs, we normally have to reset the value of
1584 Vload_path from PATH_LOADSEARCH, since the value that was dumped
1585 uses ../lisp, instead of the path of the installed elisp
1586 libraries. However, if it appears that Vload_path was changed
1587 from the default before dumping, don't override that value. */
1590 Lisp_Object dump_path
;
1592 dump_path
= decode_env_path (0, PATH_DUMPLOADSEARCH
);
1593 if (! NILP (Fequal (dump_path
, Vload_path
)))
1594 Vload_path
= decode_env_path (0, normal
);
1597 Vload_path
= decode_env_path (0, normal
);
1600 /* Warn if dirs in the *standard* path don't exist. */
1602 Lisp_Object path_tail
;
1604 for (path_tail
= Vload_path
;
1606 path_tail
= XCONS (path_tail
)->cdr
)
1608 Lisp_Object dirfile
;
1609 dirfile
= Fcar (path_tail
);
1610 if (XTYPE (dirfile
) == Lisp_String
)
1612 dirfile
= Fdirectory_file_name (dirfile
);
1613 if (access (XSTRING (dirfile
)->data
, 0) < 0)
1614 printf ("Warning: lisp library (%s) does not exist.\n",
1615 XSTRING (Fcar (path_tail
))->data
);
1620 /* If the EMACSLOADPATH environment variable is set, use its value.
1621 This doesn't apply if we're dumping. */
1622 if (NILP (Vpurify_flag
)
1623 && egetenv ("EMACSLOADPATH"))
1624 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
1628 load_in_progress
= 0;
1635 defsubr (&Sread_from_string
);
1637 defsubr (&Sintern_soft
);
1639 defsubr (&Seval_buffer
);
1640 defsubr (&Seval_region
);
1641 defsubr (&Sread_char
);
1642 defsubr (&Sread_char_exclusive
);
1643 defsubr (&Sread_event
);
1644 defsubr (&Sget_file_char
);
1645 defsubr (&Smapatoms
);
1647 DEFVAR_LISP ("obarray", &Vobarray
,
1648 "Symbol table for use by `intern' and `read'.\n\
1649 It is a vector whose length ought to be prime for best results.\n\
1650 The vector's contents don't make sense if examined from Lisp programs;\n\
1651 to find all the symbols in an obarray, use `mapatoms'.");
1653 DEFVAR_LISP ("values", &Vvalues
,
1654 "List of values of all expressions which were read, evaluated and printed.\n\
1655 Order is reverse chronological.");
1657 DEFVAR_LISP ("standard-input", &Vstandard_input
,
1658 "Stream for read to get input from.\n\
1659 See documentation of `read' for possible values.");
1660 Vstandard_input
= Qt
;
1662 DEFVAR_LISP ("load-path", &Vload_path
,
1663 "*List of directories to search for files to load.\n\
1664 Each element is a string (directory name) or nil (try default directory).\n\
1665 Initialized based on EMACSLOADPATH environment variable, if any,\n\
1666 otherwise to default specified in by file `paths.h' when Emacs was built.");
1668 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
1669 "Non-nil iff inside of `load'.");
1671 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
1672 "An alist of expressions to be evalled when particular files are loaded.\n\
1673 Each element looks like (FILENAME FORMS...).\n\
1674 When `load' is run and the file-name argument is FILENAME,\n\
1675 the FORMS in the corresponding element are executed at the end of loading.\n\n\
1676 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
1677 with no directory specified, since that is how `load' is normally called.\n\
1678 An error in FORMS does not undo the load,\n\
1679 but does prevent execution of the rest of the FORMS.");
1680 Vafter_load_alist
= Qnil
;
1682 Qstandard_input
= intern ("standard-input");
1683 staticpro (&Qstandard_input
);
1685 Qread_char
= intern ("read-char");
1686 staticpro (&Qread_char
);
1688 Qget_file_char
= intern ("get-file-char");
1689 staticpro (&Qget_file_char
);