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>
38 #include <sys/inode.h>
45 #ifdef LISP_FLOAT_TYPE
47 #endif /* LISP_FLOAT_TYPE */
49 Lisp_Object Qread_char
, Qget_file_char
, Qstandard_input
;
50 Lisp_Object Qvariable_documentation
, Vvalues
, Vstandard_input
, Vafter_load_alist
;
52 /* non-zero if inside `load' */
55 /* Search path for files to be loaded. */
56 Lisp_Object Vload_path
;
58 /* File for get_file_char to read from. Use by load */
59 static FILE *instream
;
61 /* When nonzero, read conses in pure space */
64 /* For use within read-from-string (this reader is non-reentrant!!) */
65 static int read_from_string_index
;
66 static int read_from_string_limit
;
68 /* Handle unreading and rereading of characters.
69 Write READCHAR to read a character,
70 UNREAD(c) to unread c to be read again. */
72 #define READCHAR readchar (readcharfun)
73 #define UNREAD(c) unreadchar (readcharfun, c)
76 readchar (readcharfun
)
77 Lisp_Object readcharfun
;
80 register struct buffer
*inbuffer
;
83 if (XTYPE (readcharfun
) == Lisp_Buffer
)
85 inbuffer
= XBUFFER (readcharfun
);
87 if (BUF_PT (inbuffer
) >= BUF_ZV (inbuffer
))
89 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, BUF_PT (inbuffer
));
90 SET_BUF_PT (inbuffer
, BUF_PT (inbuffer
) + 1);
94 if (XTYPE (readcharfun
) == Lisp_Marker
)
96 inbuffer
= XMARKER (readcharfun
)->buffer
;
98 mpos
= marker_position (readcharfun
);
100 if (mpos
> BUF_ZV (inbuffer
) - 1)
102 c
= *(unsigned char *) BUF_CHAR_ADDRESS (inbuffer
, mpos
);
103 if (mpos
!= BUF_GPT (inbuffer
))
104 XMARKER (readcharfun
)->bufpos
++;
106 Fset_marker (readcharfun
, make_number (mpos
+ 1),
107 Fmarker_buffer (readcharfun
));
110 if (EQ (readcharfun
, Qget_file_char
))
111 return getc (instream
);
113 if (XTYPE (readcharfun
) == Lisp_String
)
116 /* This used to be return of a conditional expression,
117 but that truncated -1 to a char on VMS. */
118 if (read_from_string_index
< read_from_string_limit
)
119 c
= XSTRING (readcharfun
)->data
[read_from_string_index
++];
125 tem
= call0 (readcharfun
);
132 /* Unread the character C in the way appropriate for the stream READCHARFUN.
133 If the stream is a user function, call it with the char as argument. */
136 unreadchar (readcharfun
, c
)
137 Lisp_Object readcharfun
;
140 if (XTYPE (readcharfun
) == Lisp_Buffer
)
142 if (XBUFFER (readcharfun
) == current_buffer
)
145 SET_BUF_PT (XBUFFER (readcharfun
), BUF_PT (XBUFFER (readcharfun
)) - 1);
147 else if (XTYPE (readcharfun
) == Lisp_Marker
)
148 XMARKER (readcharfun
)->bufpos
--;
149 else if (XTYPE (readcharfun
) == Lisp_String
)
150 read_from_string_index
--;
151 else if (EQ (readcharfun
, Qget_file_char
))
152 ungetc (c
, instream
);
154 call1 (readcharfun
, make_number (c
));
157 static Lisp_Object
read0 (), read1 (), read_list (), read_vector ();
159 /* get a character from the tty */
161 DEFUN ("read-char", Fread_char
, Sread_char
, 0, 0, 0,
162 "Read a character from the command input (keyboard or macro).\n\
163 It is returned as a number.")
166 register Lisp_Object val
;
170 if (XTYPE (val
) != Lisp_Int
)
172 unread_command_char
= val
;
173 error ("Object read was not a character");
182 #ifdef HAVE_X_WINDOWS
183 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
184 "Read an event object from the input stream.")
187 register Lisp_Object val
;
194 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
195 "Read a character from the command input (keyboard or macro).\n\
196 It is returned as a number. Non character events are ignored.")
199 register Lisp_Object val
;
203 while (XTYPE (val
) != Lisp_Int
)
212 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
213 "Don't use this yourself.")
216 register Lisp_Object val
;
217 XSET (val
, Lisp_Int
, getc (instream
));
221 static void readevalloop ();
222 static Lisp_Object
load_unwind ();
224 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
225 "Execute a file of Lisp code named FILE.\n\
226 First try FILE with `.elc' appended, then try with `.el',\n\
227 then try FILE unmodified.\n\
228 This function searches the directories in `load-path'.\n\
229 If optional second arg NOERROR is non-nil,\n\
230 report no error if FILE doesn't exist.\n\
231 Print messages at start and end of loading unless\n\
232 optional third arg NOMESSAGE is non-nil.\n\
233 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
234 suffixes `.elc' or `.el' to the specified name FILE.\n\
235 Return t if file exists.")
236 (str
, noerror
, nomessage
, nosuffix
)
237 Lisp_Object str
, noerror
, nomessage
, nosuffix
;
239 register FILE *stream
;
240 register int fd
= -1;
241 register Lisp_Object lispstream
;
243 int count
= specpdl_ptr
- specpdl
;
248 CHECK_STRING (str
, 0);
249 str
= Fsubstitute_in_file_name (str
);
251 /* Avoid weird lossage with null string as arg,
252 since it would try to load a directory as a Lisp file */
253 if (XSTRING (str
)->size
> 0)
255 fd
= openp (Vload_path
, str
, !NILP (nosuffix
) ? "" : ".elc:.el:",
263 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
269 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
275 stat (XSTRING (found
)->data
, &s1
);
276 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
277 result
= stat (XSTRING (found
)->data
, &s2
);
278 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
279 message ("Source file `%s' newer than byte-compiled file",
280 XSTRING (found
)->data
);
281 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
284 stream
= fdopen (fd
, "r");
288 error ("Failure to create stdio stream for %s", XSTRING (str
)->data
);
291 if (NILP (nomessage
))
292 message ("Loading %s...", XSTRING (str
)->data
);
295 /* We may not be able to store STREAM itself as a Lisp_Object pointer
296 since that is guaranteed to work only for data that has been malloc'd.
297 So malloc a full-size pointer, and record the address of that pointer. */
298 ptr
= (FILE **) xmalloc (sizeof (FILE *));
300 XSET (lispstream
, Lisp_Internal_Stream
, (int) ptr
);
301 record_unwind_protect (load_unwind
, lispstream
);
303 readevalloop (Qget_file_char
, stream
, Feval
, 0);
304 unbind_to (count
, Qnil
);
306 /* Run any load-hooks for this file. */
307 temp
= Fassoc (str
, Vafter_load_alist
);
309 Fprogn (Fcdr (temp
));
312 if (!noninteractive
&& NILP (nomessage
))
313 message ("Loading %s...done", XSTRING (str
)->data
);
318 load_unwind (stream
) /* used as unwind-protect function in load */
321 fclose (*(FILE **) XSTRING (stream
));
322 free (XPNTR (stream
));
323 if (--load_in_progress
< 0) load_in_progress
= 0;
329 complete_filename_p (pathname
)
330 Lisp_Object pathname
;
332 register unsigned char *s
= XSTRING (pathname
)->data
;
343 /* Search for a file whose name is STR, looking in directories
344 in the Lisp list PATH, and trying suffixes from SUFFIX.
345 SUFFIX is a string containing possible suffixes separated by colons.
346 On success, returns a file descriptor. On failure, returns -1.
348 EXEC_ONLY nonzero means don't open the files,
349 just look for one that is executable. In this case,
350 returns 1 on success.
352 If STOREPTR is nonzero, it points to a slot where the name of
353 the file actually found should be stored as a Lisp string.
354 Nil is stored there on failure. */
357 openp (path
, str
, suffix
, storeptr
, exec_only
)
358 Lisp_Object path
, str
;
360 Lisp_Object
*storeptr
;
366 register char *fn
= buf
;
369 register Lisp_Object filename
;
375 if (complete_filename_p (str
))
378 for (; !NILP (path
); path
= Fcdr (path
))
382 filename
= Fexpand_file_name (str
, Fcar (path
));
383 if (!complete_filename_p (filename
))
384 /* If there are non-absolute elts in PATH (eg ".") */
385 /* Of course, this could conceivably lose if luser sets
386 default-directory to be something non-absolute... */
388 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
389 if (!complete_filename_p (filename
))
390 /* Give up on this path element! */
394 /* Calculate maximum size of any filename made from
395 this path element/specified file name and any possible suffix. */
396 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
397 if (fn_size
< want_size
)
398 fn
= (char *) alloca (fn_size
= 100 + want_size
);
402 /* Loop over suffixes. */
405 char *esuffix
= (char *) index (nsuffix
, ':');
406 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
408 /* Concatenate path element/specified name with the suffix. */
409 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
410 fn
[XSTRING (filename
)->size
] = 0;
411 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
412 strncat (fn
, nsuffix
, lsuffix
);
414 /* Ignore file if it's a directory. */
415 if (stat (fn
, &st
) >= 0
416 && (st
.st_mode
& S_IFMT
) != S_IFDIR
)
418 /* Check that we can access or open it. */
420 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
422 fd
= open (fn
, 0, 0);
426 /* We succeeded; return this descriptor and filename. */
428 *storeptr
= build_string (fn
);
433 /* Advance to next suffix. */
436 nsuffix
+= lsuffix
+ 1;
438 if (absolute
) return -1;
446 unreadpure () /* Used as unwind-protect function in readevalloop */
453 readevalloop (readcharfun
, stream
, evalfun
, printflag
)
454 Lisp_Object readcharfun
;
456 Lisp_Object (*evalfun
) ();
460 register Lisp_Object val
;
461 int count
= specpdl_ptr
- specpdl
;
463 specbind (Qstandard_input
, readcharfun
);
471 while ((c
= READCHAR
) != '\n' && c
!= -1);
475 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f') continue;
477 if (!NILP (Vpurify_flag
) && c
== '(')
479 record_unwind_protect (unreadpure
, Qnil
);
480 val
= read_list (-1, readcharfun
);
481 unbind_to (count
+ 1, Qnil
);
486 val
= read0 (readcharfun
);
489 val
= (*evalfun
) (val
);
492 Vvalues
= Fcons (val
, Vvalues
);
493 if (EQ (Vstandard_output
, Qt
))
500 unbind_to (count
, Qnil
);
505 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
506 "Execute the current buffer as Lisp code.\n\
507 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
508 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
509 PRINTFLAG controls printing of output:\n\
510 nil means discard it; anything else is stream for print.\n\
512 If there is no error, point does not move. If there is an error,\n\
513 point remains at the end of the last character read from the buffer.")
515 Lisp_Object bufname
, printflag
;
517 int count
= specpdl_ptr
- specpdl
;
518 Lisp_Object tem
, buf
;
521 buf
= Fcurrent_buffer ();
523 buf
= Fget_buffer (bufname
);
525 error ("No such buffer.");
527 if (NILP (printflag
))
531 specbind (Qstandard_output
, tem
);
532 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
533 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
534 readevalloop (buf
, 0, Feval
, !NILP (printflag
));
541 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
542 "Execute the current buffer as Lisp code.\n\
543 Programs can pass argument PRINTFLAG which controls printing of output:\n\
544 nil means discard it; anything else is stream for print.\n\
546 If there is no error, point does not move. If there is an error,\n\
547 point remains at the end of the last character read from the buffer.")
549 Lisp_Object printflag
;
551 int count
= specpdl_ptr
- specpdl
;
554 if (NILP (printflag
))
558 specbind (Qstandard_output
, tem
);
559 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
561 readevalloop (Fcurrent_buffer (), 0, Feval
, !NILP (printflag
));
562 return unbind_to (count
, Qnil
);
566 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
567 "Execute the region as Lisp code.\n\
568 When called from programs, expects two arguments,\n\
569 giving starting and ending indices in the current buffer\n\
570 of the text to be executed.\n\
571 Programs can pass third argument PRINTFLAG which controls output:\n\
572 nil means discard it; anything else is stream for printing it.\n\
574 If there is no error, point does not move. If there is an error,\n\
575 point remains at the end of the last character read from the buffer.")
577 Lisp_Object b
, e
, printflag
;
579 int count
= specpdl_ptr
- specpdl
;
582 if (NILP (printflag
))
586 specbind (Qstandard_output
, tem
);
588 if (NILP (printflag
))
589 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
590 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
592 /* This both uses b and checks its type. */
594 Fnarrow_to_region (make_number (BEGV
), e
);
595 readevalloop (Fcurrent_buffer (), 0, Feval
, !NILP (printflag
));
597 return unbind_to (count
, Qnil
);
600 #endif /* standalone */
602 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
603 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
604 If STREAM is nil, use the value of `standard-input' (which see).\n\
605 STREAM or the value of `standard-input' may be:\n\
606 a buffer (read from point and advance it)\n\
607 a marker (read from where it points and advance it)\n\
608 a function (call it with no arguments for each character,\n\
609 call it with a char as argument to push a char back)\n\
610 a string (takes text from string, starting at the beginning)\n\
611 t (read text line using minibuffer and use it).")
613 Lisp_Object readcharfun
;
615 extern Lisp_Object
Fread_minibuffer ();
617 if (NILP (readcharfun
))
618 readcharfun
= Vstandard_input
;
619 if (EQ (readcharfun
, Qt
))
620 readcharfun
= Qread_char
;
623 if (EQ (readcharfun
, Qread_char
))
624 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
627 if (XTYPE (readcharfun
) == Lisp_String
)
628 return Fcar (Fread_from_string (readcharfun
, Qnil
, Qnil
));
630 return read0 (readcharfun
);
633 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
634 "Read one Lisp expression which is represented as text by STRING.\n\
635 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
636 START and END optionally delimit a substring of STRING from which to read;\n\
637 they default to 0 and (length STRING) respectively.")
639 Lisp_Object string
, start
, end
;
641 int startval
, endval
;
644 CHECK_STRING (string
,0);
647 endval
= XSTRING (string
)->size
;
649 { CHECK_NUMBER (end
,2);
651 if (endval
< 0 || endval
> XSTRING (string
)->size
)
652 args_out_of_range (string
, end
);
658 { CHECK_NUMBER (start
,1);
659 startval
= XINT (start
);
660 if (startval
< 0 || startval
> endval
)
661 args_out_of_range (string
, start
);
664 read_from_string_index
= startval
;
665 read_from_string_limit
= endval
;
667 tem
= read0 (string
);
668 return Fcons (tem
, make_number (read_from_string_index
));
671 /* Use this for recursive reads, in contexts where internal tokens are not allowed. */
675 Lisp_Object readcharfun
;
677 register Lisp_Object val
;
680 val
= read1 (readcharfun
);
681 if (XTYPE (val
) == Lisp_Internal
)
684 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
690 static int read_buffer_size
;
691 static char *read_buffer
;
694 read_escape (readcharfun
)
695 Lisp_Object readcharfun
;
697 register int c
= READCHAR
;
722 error ("Invalid escape character syntax");
725 c
= read_escape (readcharfun
);
731 error ("Invalid escape character syntax");
735 c
= read_escape (readcharfun
);
739 return (c
& (0200 | 037));
749 /* An octal escape, as in ANSI C. */
751 register int i
= c
- '0';
752 register int count
= 0;
755 if ((c
= READCHAR
) >= '0' && c
<= '7')
770 /* A hex escape, as in ANSI C. */
776 if (c
>= '0' && c
<= '9')
781 else if ((c
>= 'a' && c
<= 'f')
782 || (c
>= 'A' && c
<= 'F'))
785 if (c
>= 'a' && c
<= 'f')
806 register Lisp_Object readcharfun
;
813 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
818 return read_list (0, readcharfun
);
821 return read_vector (readcharfun
);
826 register Lisp_Object val
;
827 XSET (val
, Lisp_Internal
, c
);
835 /* Accept compiled functions at read-time so that we don't have to
836 build them using function calls. */
837 Lisp_Object tmp
= read_vector (readcharfun
);
838 return Fmake_byte_code (XVECTOR(tmp
)->size
, XVECTOR (tmp
)->contents
);
841 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
844 while ((c
= READCHAR
) >= 0 && c
!= '\n');
849 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
854 register Lisp_Object val
;
857 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
860 XSET (val
, Lisp_Int
, read_escape (readcharfun
));
862 XSET (val
, Lisp_Int
, c
);
869 register char *p
= read_buffer
;
870 register char *end
= read_buffer
+ read_buffer_size
;
874 while ((c
= READCHAR
) >= 0
879 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
880 p
+= new - read_buffer
;
881 read_buffer
+= new - read_buffer
;
882 end
= read_buffer
+ read_buffer_size
;
885 c
= read_escape (readcharfun
);
886 /* c is -1 if \ newline has just been seen */
889 if (p
== read_buffer
)
895 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
897 /* If purifying, and string starts with \ newline,
898 return zero instead. This is for doc strings
899 that we are really going to find in etc/DOC.nn.nn */
900 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
901 return make_number (0);
904 return make_pure_string (read_buffer
, p
- read_buffer
);
906 return make_string (read_buffer
, p
- read_buffer
);
911 #ifdef LISP_FLOAT_TYPE
912 /* If a period is followed by a number, then we should read it
913 as a floating point number. Otherwise, it denotes a dotted
915 int next_char
= READCHAR
;
918 if (! isdigit (next_char
))
921 register Lisp_Object val
;
922 XSET (val
, Lisp_Internal
, c
);
926 /* Otherwise, we fall through! Note that the atom-reading loop
927 below will now loop at least once, assuring that we will not
928 try to UNREAD two characters in a row. */
931 if (c
<= 040) goto retry
;
933 register char *p
= read_buffer
;
936 register char *end
= read_buffer
+ read_buffer_size
;
939 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
940 || c
== '(' || c
== ')'
941 #ifndef LISP_FLOAT_TYPE
942 /* If we have floating-point support, then we need
943 to allow <digits><dot><digits>. */
945 #endif /* not LISP_FLOAT_TYPE */
946 || c
== '[' || c
== ']' || c
== '#'
951 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
952 p
+= new - read_buffer
;
953 read_buffer
+= new - read_buffer
;
954 end
= read_buffer
+ read_buffer_size
;
964 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
965 p
+= new - read_buffer
;
966 read_buffer
+= new - read_buffer
;
967 /* end = read_buffer + read_buffer_size; */
974 /* Is it an integer? */
977 register Lisp_Object val
;
979 if (*p1
== '+' || *p1
== '-') p1
++;
982 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
986 XSET (val
, Lisp_Int
, atoi (read_buffer
));
990 #ifdef LISP_FLOAT_TYPE
991 if (isfloat_string (read_buffer
))
992 return make_float (atof (read_buffer
));
996 return intern (read_buffer
);
1001 #ifdef LISP_FLOAT_TYPE
1016 if (*cp
== '+' || *cp
== '-')
1022 while (isdigit (*cp
))
1033 while (isdigit (*cp
))
1041 if ((*cp
== '+') || (*cp
== '-'))
1047 while (isdigit (*cp
))
1051 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1052 || state
== (DOT_CHAR
|TRAIL_INT
)
1053 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1054 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1055 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1057 #endif /* LISP_FLOAT_TYPE */
1060 read_vector (readcharfun
)
1061 Lisp_Object readcharfun
;
1065 register Lisp_Object
*ptr
;
1066 register Lisp_Object tem
, vector
;
1067 register struct Lisp_Cons
*otem
;
1070 tem
= read_list (1, readcharfun
);
1071 len
= Flength (tem
);
1072 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1075 size
= XVECTOR (vector
)->size
;
1076 ptr
= XVECTOR (vector
)->contents
;
1077 for (i
= 0; i
< size
; i
++)
1079 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1087 /* flag = 1 means check for ] to terminate rather than ) and .
1088 flag = -1 means check for starting with defun
1089 and make structure pure. */
1092 read_list (flag
, readcharfun
)
1094 register Lisp_Object readcharfun
;
1096 /* -1 means check next element for defun,
1097 0 means don't check,
1098 1 means already checked and found defun. */
1099 int defunflag
= flag
< 0 ? -1 : 0;
1100 Lisp_Object val
, tail
;
1101 register Lisp_Object elt
, tem
;
1102 struct gcpro gcpro1
, gcpro2
;
1110 elt
= read1 (readcharfun
);
1112 if (XTYPE (elt
) == Lisp_Internal
)
1116 if (XINT (elt
) == ']')
1118 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (") or . in a vector", 18), Qnil
));
1120 if (XINT (elt
) == ')')
1122 if (XINT (elt
) == '.')
1126 XCONS (tail
)->cdr
= read0 (readcharfun
);
1128 val
= read0 (readcharfun
);
1129 elt
= read1 (readcharfun
);
1131 if (XTYPE (elt
) == Lisp_Internal
&& XINT (elt
) == ')')
1133 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1135 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1137 tem
= (read_pure
&& flag
<= 0
1138 ? pure_cons (elt
, Qnil
)
1139 : Fcons (elt
, Qnil
));
1141 XCONS (tail
)->cdr
= tem
;
1146 defunflag
= EQ (elt
, Qdefun
);
1147 else if (defunflag
> 0)
1152 Lisp_Object Vobarray
;
1153 Lisp_Object initial_obarray
;
1156 check_obarray (obarray
)
1157 Lisp_Object obarray
;
1159 while (XTYPE (obarray
) != Lisp_Vector
|| XVECTOR (obarray
)->size
== 0)
1161 /* If Vobarray is now invalid, force it to be valid. */
1162 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
1164 obarray
= wrong_type_argument (Qvectorp
, obarray
);
1169 static int hash_string ();
1170 Lisp_Object
oblookup ();
1177 int len
= strlen (str
);
1178 Lisp_Object obarray
= Vobarray
;
1180 if (XTYPE (obarray
) != Lisp_Vector
|| XVECTOR (obarray
)->size
== 0)
1181 obarray
= check_obarray (obarray
);
1182 tem
= oblookup (obarray
, str
, len
);
1183 if (XTYPE (tem
) == Lisp_Symbol
)
1185 return Fintern ((!NILP (Vpurify_flag
)
1186 ? make_pure_string (str
, len
)
1187 : make_string (str
, len
)),
1191 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
1192 "Return the canonical symbol whose name is STRING.\n\
1193 If there is none, one is created by this function and returned.\n\
1194 A second optional argument specifies the obarray to use;\n\
1195 it defaults to the value of `obarray'.")
1197 Lisp_Object str
, obarray
;
1199 register Lisp_Object tem
, sym
, *ptr
;
1201 if (NILP (obarray
)) obarray
= Vobarray
;
1202 obarray
= check_obarray (obarray
);
1204 CHECK_STRING (str
, 0);
1206 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1207 if (XTYPE (tem
) != Lisp_Int
)
1210 if (!NILP (Vpurify_flag
))
1211 str
= Fpurecopy (str
);
1212 sym
= Fmake_symbol (str
);
1214 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
1215 if (XTYPE (*ptr
) == Lisp_Symbol
)
1216 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
1218 XSYMBOL (sym
)->next
= 0;
1223 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
1224 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
1225 A second optional argument specifies the obarray to use;\n\
1226 it defaults to the value of `obarray'.")
1228 Lisp_Object str
, obarray
;
1230 register Lisp_Object tem
;
1232 if (NILP (obarray
)) obarray
= Vobarray
;
1233 obarray
= check_obarray (obarray
);
1235 CHECK_STRING (str
, 0);
1237 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1238 if (XTYPE (tem
) != Lisp_Int
)
1244 oblookup (obarray
, ptr
, size
)
1245 Lisp_Object obarray
;
1250 register Lisp_Object tail
;
1251 Lisp_Object bucket
, tem
;
1253 if (XTYPE (obarray
) != Lisp_Vector
||
1254 (obsize
= XVECTOR (obarray
)->size
) == 0)
1256 obarray
= check_obarray (obarray
);
1257 obsize
= XVECTOR (obarray
)->size
;
1259 /* Combining next two lines breaks VMS C 2.3. */
1260 hash
= hash_string (ptr
, size
);
1262 bucket
= XVECTOR (obarray
)->contents
[hash
];
1263 if (XFASTINT (bucket
) == 0)
1265 else if (XTYPE (bucket
) != Lisp_Symbol
)
1266 error ("Bad data in guts of obarray"); /* Like CADR error message */
1267 else for (tail
= bucket
; ; XSET (tail
, Lisp_Symbol
, XSYMBOL (tail
)->next
))
1269 if (XSYMBOL (tail
)->name
->size
== size
&&
1270 !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
1272 else if (XSYMBOL (tail
)->next
== 0)
1275 XSET (tem
, Lisp_Int
, hash
);
1280 hash_string (ptr
, len
)
1284 register unsigned char *p
= ptr
;
1285 register unsigned char *end
= p
+ len
;
1286 register unsigned char c
;
1287 register int hash
= 0;
1292 if (c
>= 0140) c
-= 40;
1293 hash
= ((hash
<<3) + (hash
>>28) + c
);
1295 return hash
& 07777777777;
1299 map_obarray (obarray
, fn
, arg
)
1300 Lisp_Object obarray
;
1305 register Lisp_Object tail
;
1306 CHECK_VECTOR (obarray
, 1);
1307 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
1309 tail
= XVECTOR (obarray
)->contents
[i
];
1310 if (XFASTINT (tail
) != 0)
1314 if (XSYMBOL (tail
)->next
== 0)
1316 XSET (tail
, Lisp_Symbol
, XSYMBOL (tail
)->next
);
1321 mapatoms_1 (sym
, function
)
1322 Lisp_Object sym
, function
;
1324 call1 (function
, sym
);
1327 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
1328 "Call FUNCTION on every symbol in OBARRAY.\n\
1329 OBARRAY defaults to the value of `obarray'.")
1331 Lisp_Object function
, obarray
;
1335 if (NILP (obarray
)) obarray
= Vobarray
;
1336 obarray
= check_obarray (obarray
);
1338 map_obarray (obarray
, mapatoms_1
, function
);
1342 #define OBARRAY_SIZE 509
1347 Lisp_Object oblength
;
1351 XFASTINT (oblength
) = OBARRAY_SIZE
;
1353 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
1354 Vobarray
= Fmake_vector (oblength
, make_number (0));
1355 initial_obarray
= Vobarray
;
1356 staticpro (&initial_obarray
);
1357 /* Intern nil in the obarray */
1358 /* These locals are to kludge around a pyramid compiler bug. */
1359 hash
= hash_string ("nil", 3);
1360 /* Separate statement here to avoid VAXC bug. */
1361 hash
%= OBARRAY_SIZE
;
1362 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
1365 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
1366 XSYMBOL (Qnil
)->function
= Qunbound
;
1367 XSYMBOL (Qunbound
)->value
= Qunbound
;
1368 XSYMBOL (Qunbound
)->function
= Qunbound
;
1371 XSYMBOL (Qnil
)->value
= Qnil
;
1372 XSYMBOL (Qnil
)->plist
= Qnil
;
1373 XSYMBOL (Qt
)->value
= Qt
;
1375 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
1378 Qvariable_documentation
= intern ("variable-documentation");
1380 read_buffer_size
= 100;
1381 read_buffer
= (char *) malloc (read_buffer_size
);
1386 struct Lisp_Subr
*sname
;
1389 sym
= intern (sname
->symbol_name
);
1390 XSET (XSYMBOL (sym
)->function
, Lisp_Subr
, sname
);
1393 #ifdef NOTDEF /* use fset in subr.el now */
1395 defalias (sname
, string
)
1396 struct Lisp_Subr
*sname
;
1400 sym
= intern (string
);
1401 XSET (XSYMBOL (sym
)->function
, Lisp_Subr
, sname
);
1405 /* New replacement for DefIntVar; it ignores the doc string argument
1406 on the assumption that make-docfile will handle that. */
1407 /* Define an "integer variable"; a symbol whose value is forwarded
1408 to a C variable of type int. Sample call: */
1409 /* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
1412 defvar_int (namestring
, address
, doc
)
1418 sym
= intern (namestring
);
1419 XSET (XSYMBOL (sym
)->value
, Lisp_Intfwd
, address
);
1422 /* Similar but define a variable whose value is T if address contains 1,
1423 NIL if address contains 0 */
1426 defvar_bool (namestring
, address
, doc
)
1432 sym
= intern (namestring
);
1433 XSET (XSYMBOL (sym
)->value
, Lisp_Boolfwd
, address
);
1436 /* Similar but define a variable whose value is the Lisp Object stored at address. */
1439 defvar_lisp (namestring
, address
, doc
)
1441 Lisp_Object
*address
;
1445 sym
= intern (namestring
);
1446 XSET (XSYMBOL (sym
)->value
, Lisp_Objfwd
, address
);
1447 staticpro (address
);
1450 /* Similar but don't request gc-marking of the C variable.
1451 Used when that variable will be gc-marked for some other reason,
1452 since marking the same slot twice can cause trouble with strings. */
1455 defvar_lisp_nopro (namestring
, address
, doc
)
1457 Lisp_Object
*address
;
1461 sym
= intern (namestring
);
1462 XSET (XSYMBOL (sym
)->value
, Lisp_Objfwd
, address
);
1467 /* Similar but define a variable whose value is the Lisp Object stored in
1468 the current buffer. address is the address of the slot in the buffer that is current now. */
1471 defvar_per_buffer (namestring
, address
, doc
)
1473 Lisp_Object
*address
;
1478 extern struct buffer buffer_local_symbols
;
1480 sym
= intern (namestring
);
1481 offset
= (char *)address
- (char *)current_buffer
;
1483 XSET (XSYMBOL (sym
)->value
, Lisp_Buffer_Objfwd
,
1484 (Lisp_Object
*) offset
);
1485 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
1486 if (*(int *)(offset
+ (char *)&buffer_local_flags
) == 0)
1487 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
1488 slot of buffer_local_flags */
1492 #endif /* standalone */
1498 /* Compute the default load-path. */
1500 normal
= PATH_LOADSEARCH
;
1501 Vload_path
= decode_env_path (0, normal
);
1503 if (NILP (Vpurify_flag
))
1504 normal
= PATH_LOADSEARCH
;
1506 normal
= PATH_DUMPLOADSEARCH
;
1508 /* In a dumped Emacs, we normally have to reset the value of
1509 Vload_path from PATH_LOADSEARCH, since the value that was dumped
1510 uses ../lisp, instead of the path of the installed elisp
1511 libraries. However, if it appears that Vload_path was changed
1512 from the default before dumping, don't override that value. */
1515 Lisp_Object dump_path
;
1517 dump_path
= decode_env_path (0, PATH_DUMPLOADSEARCH
);
1518 if (! NILP (Fequal (dump_path
, Vload_path
)))
1519 Vload_path
= decode_env_path (0, normal
);
1522 Vload_path
= decode_env_path (0, normal
);
1525 /* Warn if dirs in the *standard* path don't exist. */
1527 Lisp_Object path_tail
;
1529 for (path_tail
= Vload_path
;
1531 path_tail
= XCONS (path_tail
)->cdr
)
1533 Lisp_Object dirfile
;
1534 dirfile
= Fcar (path_tail
);
1535 if (XTYPE (dirfile
) == Lisp_String
)
1537 dirfile
= Fdirectory_file_name (dirfile
);
1538 if (access (XSTRING (dirfile
)->data
, 0) < 0)
1539 printf ("Warning: lisp library (%s) does not exist.\n",
1540 XSTRING (Fcar (path_tail
))->data
);
1545 /* If the EMACSLOADPATH environment variable is set, use its value.
1546 This doesn't apply if we're dumping. */
1547 if (NILP (Vpurify_flag
)
1548 && egetenv ("EMACSLOADPATH"))
1549 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
1553 load_in_progress
= 0;
1560 defsubr (&Sread_from_string
);
1562 defsubr (&Sintern_soft
);
1564 defsubr (&Seval_buffer
);
1565 defsubr (&Seval_region
);
1566 defsubr (&Sread_char
);
1567 defsubr (&Sread_char_exclusive
);
1568 #ifdef HAVE_X_WINDOWS
1569 defsubr (&Sread_event
);
1570 #endif /* HAVE_X_WINDOWS */
1571 defsubr (&Sget_file_char
);
1572 defsubr (&Smapatoms
);
1574 DEFVAR_LISP ("obarray", &Vobarray
,
1575 "Symbol table for use by `intern' and `read'.\n\
1576 It is a vector whose length ought to be prime for best results.\n\
1577 The vector's contents don't make sense if examined from Lisp programs;\n\
1578 to find all the symbols in an obarray, use `mapatoms'.");
1580 DEFVAR_LISP ("values", &Vvalues
,
1581 "List of values of all expressions which were read, evaluated and printed.\n\
1582 Order is reverse chronological.");
1584 DEFVAR_LISP ("standard-input", &Vstandard_input
,
1585 "Stream for read to get input from.\n\
1586 See documentation of `read' for possible values.");
1587 Vstandard_input
= Qt
;
1589 DEFVAR_LISP ("load-path", &Vload_path
,
1590 "*List of directories to search for files to load.\n\
1591 Each element is a string (directory name) or nil (try default directory).\n\
1592 Initialized based on EMACSLOADPATH environment variable, if any,\n\
1593 otherwise to default specified in by file `paths.h' when Emacs was built.");
1595 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
1596 "Non-nil iff inside of `load'.");
1598 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
1599 "An alist of expressions to be evalled when particular files are loaded.\n\
1600 Each element looks like (FILENAME FORMS...).\n\
1601 When `load' is run and the file-name argument is FILENAME,\n\
1602 the FORMS in the corresponding element are executed at the end of loading.\n\n\
1603 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
1604 with no directory specified, since that is how `load' is normally called.\n\
1605 An error in FORMS does not undo the load,\n\
1606 but does prevent execution of the rest of the FORMS.");
1607 Vafter_load_alist
= Qnil
;
1609 Qstandard_input
= intern ("standard-input");
1610 staticpro (&Qstandard_input
);
1612 Qread_char
= intern ("read-char");
1613 staticpro (&Qread_char
);
1615 Qget_file_char
= intern ("get-file-char");
1616 staticpro (&Qget_file_char
);