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.\n\
164 If the user generates an event which is not a character (i.e. a mouse\n\
165 click or function key event), `read-char' signals an error. If you\n\
166 want to read non-character events, or ignore them, call `read-event'\n\
167 or `read-char-exclusive' instead.")
170 register Lisp_Object val
;
174 if (XTYPE (val
) != Lisp_Int
)
176 unread_command_char
= val
;
177 error ("Object read was not a character");
186 DEFUN ("read-event", Fread_event
, Sread_event
, 0, 0, 0,
187 "Read an event object from the input stream.")
190 register Lisp_Object val
;
196 DEFUN ("read-char-exclusive", Fread_char_exclusive
, Sread_char_exclusive
, 0, 0, 0,
197 "Read a character from the command input (keyboard or macro).\n\
198 It is returned as a number. Non character events are ignored.")
201 register Lisp_Object val
;
208 while (XTYPE (val
) != Lisp_Int
);
216 DEFUN ("get-file-char", Fget_file_char
, Sget_file_char
, 0, 0, 0,
217 "Don't use this yourself.")
220 register Lisp_Object val
;
221 XSET (val
, Lisp_Int
, getc (instream
));
225 static void readevalloop ();
226 static Lisp_Object
load_unwind ();
228 DEFUN ("load", Fload
, Sload
, 1, 4, 0,
229 "Execute a file of Lisp code named FILE.\n\
230 First try FILE with `.elc' appended, then try with `.el',\n\
231 then try FILE unmodified.\n\
232 This function searches the directories in `load-path'.\n\
233 If optional second arg NOERROR is non-nil,\n\
234 report no error if FILE doesn't exist.\n\
235 Print messages at start and end of loading unless\n\
236 optional third arg NOMESSAGE is non-nil.\n\
237 If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\
238 suffixes `.elc' or `.el' to the specified name FILE.\n\
239 Return t if file exists.")
240 (str
, noerror
, nomessage
, nosuffix
)
241 Lisp_Object str
, noerror
, nomessage
, nosuffix
;
243 register FILE *stream
;
244 register int fd
= -1;
245 register Lisp_Object lispstream
;
247 int count
= specpdl_ptr
- specpdl
;
252 CHECK_STRING (str
, 0);
253 str
= Fsubstitute_in_file_name (str
);
255 /* Avoid weird lossage with null string as arg,
256 since it would try to load a directory as a Lisp file */
257 if (XSTRING (str
)->size
> 0)
259 fd
= openp (Vload_path
, str
, !NILP (nosuffix
) ? "" : ".elc:.el:",
267 Fsignal (Qfile_error
, Fcons (build_string ("Cannot open load file"),
273 if (!bcmp (&(XSTRING (found
)->data
[XSTRING (found
)->size
- 4]),
279 stat (XSTRING (found
)->data
, &s1
);
280 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 0;
281 result
= stat (XSTRING (found
)->data
, &s2
);
282 if (result
>= 0 && (unsigned) s1
.st_mtime
< (unsigned) s2
.st_mtime
)
283 message ("Source file `%s' newer than byte-compiled file",
284 XSTRING (found
)->data
);
285 XSTRING (found
)->data
[XSTRING (found
)->size
- 1] = 'c';
288 stream
= fdopen (fd
, "r");
292 error ("Failure to create stdio stream for %s", XSTRING (str
)->data
);
295 if (NILP (nomessage
))
296 message ("Loading %s...", XSTRING (str
)->data
);
299 /* We may not be able to store STREAM itself as a Lisp_Object pointer
300 since that is guaranteed to work only for data that has been malloc'd.
301 So malloc a full-size pointer, and record the address of that pointer. */
302 ptr
= (FILE **) xmalloc (sizeof (FILE *));
304 XSET (lispstream
, Lisp_Internal_Stream
, (int) ptr
);
305 record_unwind_protect (load_unwind
, lispstream
);
307 readevalloop (Qget_file_char
, stream
, Feval
, 0);
308 unbind_to (count
, Qnil
);
310 /* Run any load-hooks for this file. */
311 temp
= Fassoc (str
, Vafter_load_alist
);
313 Fprogn (Fcdr (temp
));
316 if (!noninteractive
&& NILP (nomessage
))
317 message ("Loading %s...done", XSTRING (str
)->data
);
322 load_unwind (stream
) /* used as unwind-protect function in load */
325 fclose (*(FILE **) XSTRING (stream
));
326 free (XPNTR (stream
));
327 if (--load_in_progress
< 0) load_in_progress
= 0;
333 complete_filename_p (pathname
)
334 Lisp_Object pathname
;
336 register unsigned char *s
= XSTRING (pathname
)->data
;
347 /* Search for a file whose name is STR, looking in directories
348 in the Lisp list PATH, and trying suffixes from SUFFIX.
349 SUFFIX is a string containing possible suffixes separated by colons.
350 On success, returns a file descriptor. On failure, returns -1.
352 EXEC_ONLY nonzero means don't open the files,
353 just look for one that is executable. In this case,
354 returns 1 on success.
356 If STOREPTR is nonzero, it points to a slot where the name of
357 the file actually found should be stored as a Lisp string.
358 Nil is stored there on failure. */
361 openp (path
, str
, suffix
, storeptr
, exec_only
)
362 Lisp_Object path
, str
;
364 Lisp_Object
*storeptr
;
370 register char *fn
= buf
;
373 register Lisp_Object filename
;
379 if (complete_filename_p (str
))
382 for (; !NILP (path
); path
= Fcdr (path
))
386 filename
= Fexpand_file_name (str
, Fcar (path
));
387 if (!complete_filename_p (filename
))
388 /* If there are non-absolute elts in PATH (eg ".") */
389 /* Of course, this could conceivably lose if luser sets
390 default-directory to be something non-absolute... */
392 filename
= Fexpand_file_name (filename
, current_buffer
->directory
);
393 if (!complete_filename_p (filename
))
394 /* Give up on this path element! */
398 /* Calculate maximum size of any filename made from
399 this path element/specified file name and any possible suffix. */
400 want_size
= strlen (suffix
) + XSTRING (filename
)->size
+ 1;
401 if (fn_size
< want_size
)
402 fn
= (char *) alloca (fn_size
= 100 + want_size
);
406 /* Loop over suffixes. */
409 char *esuffix
= (char *) index (nsuffix
, ':');
410 int lsuffix
= esuffix
? esuffix
- nsuffix
: strlen (nsuffix
);
412 /* Concatenate path element/specified name with the suffix. */
413 strncpy (fn
, XSTRING (filename
)->data
, XSTRING (filename
)->size
);
414 fn
[XSTRING (filename
)->size
] = 0;
415 if (lsuffix
!= 0) /* Bug happens on CCI if lsuffix is 0. */
416 strncat (fn
, nsuffix
, lsuffix
);
418 /* Ignore file if it's a directory. */
419 if (stat (fn
, &st
) >= 0
420 && (st
.st_mode
& S_IFMT
) != S_IFDIR
)
422 /* Check that we can access or open it. */
424 fd
= (access (fn
, X_OK
) == 0) ? 1 : -1;
426 fd
= open (fn
, 0, 0);
430 /* We succeeded; return this descriptor and filename. */
432 *storeptr
= build_string (fn
);
437 /* Advance to next suffix. */
440 nsuffix
+= lsuffix
+ 1;
442 if (absolute
) return -1;
450 unreadpure () /* Used as unwind-protect function in readevalloop */
457 readevalloop (readcharfun
, stream
, evalfun
, printflag
)
458 Lisp_Object readcharfun
;
460 Lisp_Object (*evalfun
) ();
464 register Lisp_Object val
;
465 int count
= specpdl_ptr
- specpdl
;
467 specbind (Qstandard_input
, readcharfun
);
475 while ((c
= READCHAR
) != '\n' && c
!= -1);
479 if (c
== ' ' || c
== '\t' || c
== '\n' || c
== '\f') continue;
481 if (!NILP (Vpurify_flag
) && c
== '(')
483 record_unwind_protect (unreadpure
, Qnil
);
484 val
= read_list (-1, readcharfun
);
485 unbind_to (count
+ 1, Qnil
);
490 val
= read0 (readcharfun
);
493 val
= (*evalfun
) (val
);
496 Vvalues
= Fcons (val
, Vvalues
);
497 if (EQ (Vstandard_output
, Qt
))
504 unbind_to (count
, Qnil
);
509 DEFUN ("eval-buffer", Feval_buffer
, Seval_buffer
, 0, 2, "",
510 "Execute the current buffer as Lisp code.\n\
511 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
512 BUFFER is the buffer to evaluate (nil means use current buffer).\n\
513 PRINTFLAG controls printing of output:\n\
514 nil means discard it; anything else is stream for print.\n\
516 If there is no error, point does not move. If there is an error,\n\
517 point remains at the end of the last character read from the buffer.")
519 Lisp_Object bufname
, printflag
;
521 int count
= specpdl_ptr
- specpdl
;
522 Lisp_Object tem
, buf
;
525 buf
= Fcurrent_buffer ();
527 buf
= Fget_buffer (bufname
);
529 error ("No such buffer.");
531 if (NILP (printflag
))
535 specbind (Qstandard_output
, tem
);
536 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
537 BUF_SET_PT (XBUFFER (buf
), BUF_BEGV (XBUFFER (buf
)));
538 readevalloop (buf
, 0, Feval
, !NILP (printflag
));
545 DEFUN ("eval-current-buffer", Feval_current_buffer
, Seval_current_buffer
, 0, 1, "",
546 "Execute the current buffer as Lisp code.\n\
547 Programs can pass argument PRINTFLAG which controls printing of output:\n\
548 nil means discard it; anything else is stream for print.\n\
550 If there is no error, point does not move. If there is an error,\n\
551 point remains at the end of the last character read from the buffer.")
553 Lisp_Object printflag
;
555 int count
= specpdl_ptr
- specpdl
;
558 if (NILP (printflag
))
562 specbind (Qstandard_output
, tem
);
563 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
565 readevalloop (Fcurrent_buffer (), 0, Feval
, !NILP (printflag
));
566 return unbind_to (count
, Qnil
);
570 DEFUN ("eval-region", Feval_region
, Seval_region
, 2, 3, "r",
571 "Execute the region as Lisp code.\n\
572 When called from programs, expects two arguments,\n\
573 giving starting and ending indices in the current buffer\n\
574 of the text to be executed.\n\
575 Programs can pass third argument PRINTFLAG which controls output:\n\
576 nil means discard it; anything else is stream for printing it.\n\
578 If there is no error, point does not move. If there is an error,\n\
579 point remains at the end of the last character read from the buffer.")
581 Lisp_Object b
, e
, printflag
;
583 int count
= specpdl_ptr
- specpdl
;
586 if (NILP (printflag
))
590 specbind (Qstandard_output
, tem
);
592 if (NILP (printflag
))
593 record_unwind_protect (save_excursion_restore
, save_excursion_save ());
594 record_unwind_protect (save_restriction_restore
, save_restriction_save ());
596 /* This both uses b and checks its type. */
598 Fnarrow_to_region (make_number (BEGV
), e
);
599 readevalloop (Fcurrent_buffer (), 0, Feval
, !NILP (printflag
));
601 return unbind_to (count
, Qnil
);
604 #endif /* standalone */
606 DEFUN ("read", Fread
, Sread
, 0, 1, 0,
607 "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
608 If STREAM is nil, use the value of `standard-input' (which see).\n\
609 STREAM or the value of `standard-input' may be:\n\
610 a buffer (read from point and advance it)\n\
611 a marker (read from where it points and advance it)\n\
612 a function (call it with no arguments for each character,\n\
613 call it with a char as argument to push a char back)\n\
614 a string (takes text from string, starting at the beginning)\n\
615 t (read text line using minibuffer and use it).")
617 Lisp_Object readcharfun
;
619 extern Lisp_Object
Fread_minibuffer ();
621 if (NILP (readcharfun
))
622 readcharfun
= Vstandard_input
;
623 if (EQ (readcharfun
, Qt
))
624 readcharfun
= Qread_char
;
627 if (EQ (readcharfun
, Qread_char
))
628 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil
);
631 if (XTYPE (readcharfun
) == Lisp_String
)
632 return Fcar (Fread_from_string (readcharfun
, Qnil
, Qnil
));
634 return read0 (readcharfun
);
637 DEFUN ("read-from-string", Fread_from_string
, Sread_from_string
, 1, 3, 0,
638 "Read one Lisp expression which is represented as text by STRING.\n\
639 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\
640 START and END optionally delimit a substring of STRING from which to read;\n\
641 they default to 0 and (length STRING) respectively.")
643 Lisp_Object string
, start
, end
;
645 int startval
, endval
;
648 CHECK_STRING (string
,0);
651 endval
= XSTRING (string
)->size
;
653 { CHECK_NUMBER (end
,2);
655 if (endval
< 0 || endval
> XSTRING (string
)->size
)
656 args_out_of_range (string
, end
);
662 { CHECK_NUMBER (start
,1);
663 startval
= XINT (start
);
664 if (startval
< 0 || startval
> endval
)
665 args_out_of_range (string
, start
);
668 read_from_string_index
= startval
;
669 read_from_string_limit
= endval
;
671 tem
= read0 (string
);
672 return Fcons (tem
, make_number (read_from_string_index
));
675 /* Use this for recursive reads, in contexts where internal tokens are not allowed. */
679 Lisp_Object readcharfun
;
681 register Lisp_Object val
;
684 val
= read1 (readcharfun
);
685 if (XTYPE (val
) == Lisp_Internal
)
688 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (&c
, 1), Qnil
));
694 static int read_buffer_size
;
695 static char *read_buffer
;
698 read_escape (readcharfun
)
699 Lisp_Object readcharfun
;
701 register int c
= READCHAR
;
726 error ("Invalid escape character syntax");
729 c
= read_escape (readcharfun
);
735 error ("Invalid escape character syntax");
739 c
= read_escape (readcharfun
);
743 return (c
& (0200 | 037));
753 /* An octal escape, as in ANSI C. */
755 register int i
= c
- '0';
756 register int count
= 0;
759 if ((c
= READCHAR
) >= '0' && c
<= '7')
774 /* A hex escape, as in ANSI C. */
780 if (c
>= '0' && c
<= '9')
785 else if ((c
>= 'a' && c
<= 'f')
786 || (c
>= 'A' && c
<= 'F'))
789 if (c
>= 'a' && c
<= 'f')
810 register Lisp_Object readcharfun
;
817 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
822 return read_list (0, readcharfun
);
825 return read_vector (readcharfun
);
830 register Lisp_Object val
;
831 XSET (val
, Lisp_Internal
, c
);
839 /* Accept compiled functions at read-time so that we don't have to
840 build them using function calls. */
841 Lisp_Object tmp
= read_vector (readcharfun
);
842 return Fmake_byte_code (XVECTOR(tmp
)->size
, XVECTOR (tmp
)->contents
);
845 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("#", 1), Qnil
));
848 while ((c
= READCHAR
) >= 0 && c
!= '\n');
853 return Fcons (Qquote
, Fcons (read0 (readcharfun
), Qnil
));
858 register Lisp_Object val
;
861 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
864 XSET (val
, Lisp_Int
, read_escape (readcharfun
));
866 XSET (val
, Lisp_Int
, c
);
873 register char *p
= read_buffer
;
874 register char *end
= read_buffer
+ read_buffer_size
;
878 while ((c
= READCHAR
) >= 0
883 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
884 p
+= new - read_buffer
;
885 read_buffer
+= new - read_buffer
;
886 end
= read_buffer
+ read_buffer_size
;
889 c
= read_escape (readcharfun
);
890 /* c is -1 if \ newline has just been seen */
893 if (p
== read_buffer
)
899 if (c
< 0) return Fsignal (Qend_of_file
, Qnil
);
901 /* If purifying, and string starts with \ newline,
902 return zero instead. This is for doc strings
903 that we are really going to find in etc/DOC.nn.nn */
904 if (!NILP (Vpurify_flag
) && NILP (Vdoc_file_name
) && cancel
)
905 return make_number (0);
908 return make_pure_string (read_buffer
, p
- read_buffer
);
910 return make_string (read_buffer
, p
- read_buffer
);
915 #ifdef LISP_FLOAT_TYPE
916 /* If a period is followed by a number, then we should read it
917 as a floating point number. Otherwise, it denotes a dotted
919 int next_char
= READCHAR
;
922 if (! isdigit (next_char
))
925 register Lisp_Object val
;
926 XSET (val
, Lisp_Internal
, c
);
930 /* Otherwise, we fall through! Note that the atom-reading loop
931 below will now loop at least once, assuring that we will not
932 try to UNREAD two characters in a row. */
935 if (c
<= 040) goto retry
;
937 register char *p
= read_buffer
;
940 register char *end
= read_buffer
+ read_buffer_size
;
943 !(c
== '\"' || c
== '\'' || c
== ';' || c
== '?'
944 || c
== '(' || c
== ')'
945 #ifndef LISP_FLOAT_TYPE
946 /* If we have floating-point support, then we need
947 to allow <digits><dot><digits>. */
949 #endif /* not LISP_FLOAT_TYPE */
950 || c
== '[' || c
== ']' || c
== '#'
955 register char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
956 p
+= new - read_buffer
;
957 read_buffer
+= new - read_buffer
;
958 end
= read_buffer
+ read_buffer_size
;
968 char *new = (char *) xrealloc (read_buffer
, read_buffer_size
*= 2);
969 p
+= new - read_buffer
;
970 read_buffer
+= new - read_buffer
;
971 /* end = read_buffer + read_buffer_size; */
978 /* Is it an integer? */
981 register Lisp_Object val
;
983 if (*p1
== '+' || *p1
== '-') p1
++;
986 while (p1
!= p
&& (c
= *p1
) >= '0' && c
<= '9') p1
++;
990 XSET (val
, Lisp_Int
, atoi (read_buffer
));
994 #ifdef LISP_FLOAT_TYPE
995 if (isfloat_string (read_buffer
))
996 return make_float (atof (read_buffer
));
1000 return intern (read_buffer
);
1005 #ifdef LISP_FLOAT_TYPE
1020 if (*cp
== '+' || *cp
== '-')
1026 while (isdigit (*cp
))
1037 while (isdigit (*cp
))
1045 if ((*cp
== '+') || (*cp
== '-'))
1051 while (isdigit (*cp
))
1055 && (state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
)
1056 || state
== (DOT_CHAR
|TRAIL_INT
)
1057 || state
== (LEAD_INT
|E_CHAR
|EXP_INT
)
1058 || state
== (LEAD_INT
|DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)
1059 || state
== (DOT_CHAR
|TRAIL_INT
|E_CHAR
|EXP_INT
)));
1061 #endif /* LISP_FLOAT_TYPE */
1064 read_vector (readcharfun
)
1065 Lisp_Object readcharfun
;
1069 register Lisp_Object
*ptr
;
1070 register Lisp_Object tem
, vector
;
1071 register struct Lisp_Cons
*otem
;
1074 tem
= read_list (1, readcharfun
);
1075 len
= Flength (tem
);
1076 vector
= (read_pure
? make_pure_vector (XINT (len
)) : Fmake_vector (len
, Qnil
));
1079 size
= XVECTOR (vector
)->size
;
1080 ptr
= XVECTOR (vector
)->contents
;
1081 for (i
= 0; i
< size
; i
++)
1083 ptr
[i
] = read_pure
? Fpurecopy (Fcar (tem
)) : Fcar (tem
);
1091 /* flag = 1 means check for ] to terminate rather than ) and .
1092 flag = -1 means check for starting with defun
1093 and make structure pure. */
1096 read_list (flag
, readcharfun
)
1098 register Lisp_Object readcharfun
;
1100 /* -1 means check next element for defun,
1101 0 means don't check,
1102 1 means already checked and found defun. */
1103 int defunflag
= flag
< 0 ? -1 : 0;
1104 Lisp_Object val
, tail
;
1105 register Lisp_Object elt
, tem
;
1106 struct gcpro gcpro1
, gcpro2
;
1114 elt
= read1 (readcharfun
);
1116 if (XTYPE (elt
) == Lisp_Internal
)
1120 if (XINT (elt
) == ']')
1122 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (") or . in a vector", 18), Qnil
));
1124 if (XINT (elt
) == ')')
1126 if (XINT (elt
) == '.')
1130 XCONS (tail
)->cdr
= read0 (readcharfun
);
1132 val
= read0 (readcharfun
);
1133 elt
= read1 (readcharfun
);
1135 if (XTYPE (elt
) == Lisp_Internal
&& XINT (elt
) == ')')
1137 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string (". in wrong context", 18), Qnil
));
1139 return Fsignal (Qinvalid_read_syntax
, Fcons (make_string ("] in a list", 11), Qnil
));
1141 tem
= (read_pure
&& flag
<= 0
1142 ? pure_cons (elt
, Qnil
)
1143 : Fcons (elt
, Qnil
));
1145 XCONS (tail
)->cdr
= tem
;
1150 defunflag
= EQ (elt
, Qdefun
);
1151 else if (defunflag
> 0)
1156 Lisp_Object Vobarray
;
1157 Lisp_Object initial_obarray
;
1160 check_obarray (obarray
)
1161 Lisp_Object obarray
;
1163 while (XTYPE (obarray
) != Lisp_Vector
|| XVECTOR (obarray
)->size
== 0)
1165 /* If Vobarray is now invalid, force it to be valid. */
1166 if (EQ (Vobarray
, obarray
)) Vobarray
= initial_obarray
;
1168 obarray
= wrong_type_argument (Qvectorp
, obarray
);
1173 static int hash_string ();
1174 Lisp_Object
oblookup ();
1181 int len
= strlen (str
);
1182 Lisp_Object obarray
= Vobarray
;
1184 if (XTYPE (obarray
) != Lisp_Vector
|| XVECTOR (obarray
)->size
== 0)
1185 obarray
= check_obarray (obarray
);
1186 tem
= oblookup (obarray
, str
, len
);
1187 if (XTYPE (tem
) == Lisp_Symbol
)
1189 return Fintern ((!NILP (Vpurify_flag
)
1190 ? make_pure_string (str
, len
)
1191 : make_string (str
, len
)),
1195 DEFUN ("intern", Fintern
, Sintern
, 1, 2, 0,
1196 "Return the canonical symbol whose name is STRING.\n\
1197 If there is none, one is created by this function and returned.\n\
1198 A second optional argument specifies the obarray to use;\n\
1199 it defaults to the value of `obarray'.")
1201 Lisp_Object str
, obarray
;
1203 register Lisp_Object tem
, sym
, *ptr
;
1205 if (NILP (obarray
)) obarray
= Vobarray
;
1206 obarray
= check_obarray (obarray
);
1208 CHECK_STRING (str
, 0);
1210 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1211 if (XTYPE (tem
) != Lisp_Int
)
1214 if (!NILP (Vpurify_flag
))
1215 str
= Fpurecopy (str
);
1216 sym
= Fmake_symbol (str
);
1218 ptr
= &XVECTOR (obarray
)->contents
[XINT (tem
)];
1219 if (XTYPE (*ptr
) == Lisp_Symbol
)
1220 XSYMBOL (sym
)->next
= XSYMBOL (*ptr
);
1222 XSYMBOL (sym
)->next
= 0;
1227 DEFUN ("intern-soft", Fintern_soft
, Sintern_soft
, 1, 2, 0,
1228 "Return the canonical symbol whose name is STRING, or nil if none exists.\n\
1229 A second optional argument specifies the obarray to use;\n\
1230 it defaults to the value of `obarray'.")
1232 Lisp_Object str
, obarray
;
1234 register Lisp_Object tem
;
1236 if (NILP (obarray
)) obarray
= Vobarray
;
1237 obarray
= check_obarray (obarray
);
1239 CHECK_STRING (str
, 0);
1241 tem
= oblookup (obarray
, XSTRING (str
)->data
, XSTRING (str
)->size
);
1242 if (XTYPE (tem
) != Lisp_Int
)
1248 oblookup (obarray
, ptr
, size
)
1249 Lisp_Object obarray
;
1254 register Lisp_Object tail
;
1255 Lisp_Object bucket
, tem
;
1257 if (XTYPE (obarray
) != Lisp_Vector
||
1258 (obsize
= XVECTOR (obarray
)->size
) == 0)
1260 obarray
= check_obarray (obarray
);
1261 obsize
= XVECTOR (obarray
)->size
;
1263 /* Combining next two lines breaks VMS C 2.3. */
1264 hash
= hash_string (ptr
, size
);
1266 bucket
= XVECTOR (obarray
)->contents
[hash
];
1267 if (XFASTINT (bucket
) == 0)
1269 else if (XTYPE (bucket
) != Lisp_Symbol
)
1270 error ("Bad data in guts of obarray"); /* Like CADR error message */
1271 else for (tail
= bucket
; ; XSET (tail
, Lisp_Symbol
, XSYMBOL (tail
)->next
))
1273 if (XSYMBOL (tail
)->name
->size
== size
&&
1274 !bcmp (XSYMBOL (tail
)->name
->data
, ptr
, size
))
1276 else if (XSYMBOL (tail
)->next
== 0)
1279 XSET (tem
, Lisp_Int
, hash
);
1284 hash_string (ptr
, len
)
1288 register unsigned char *p
= ptr
;
1289 register unsigned char *end
= p
+ len
;
1290 register unsigned char c
;
1291 register int hash
= 0;
1296 if (c
>= 0140) c
-= 40;
1297 hash
= ((hash
<<3) + (hash
>>28) + c
);
1299 return hash
& 07777777777;
1303 map_obarray (obarray
, fn
, arg
)
1304 Lisp_Object obarray
;
1309 register Lisp_Object tail
;
1310 CHECK_VECTOR (obarray
, 1);
1311 for (i
= XVECTOR (obarray
)->size
- 1; i
>= 0; i
--)
1313 tail
= XVECTOR (obarray
)->contents
[i
];
1314 if (XFASTINT (tail
) != 0)
1318 if (XSYMBOL (tail
)->next
== 0)
1320 XSET (tail
, Lisp_Symbol
, XSYMBOL (tail
)->next
);
1325 mapatoms_1 (sym
, function
)
1326 Lisp_Object sym
, function
;
1328 call1 (function
, sym
);
1331 DEFUN ("mapatoms", Fmapatoms
, Smapatoms
, 1, 2, 0,
1332 "Call FUNCTION on every symbol in OBARRAY.\n\
1333 OBARRAY defaults to the value of `obarray'.")
1335 Lisp_Object function
, obarray
;
1339 if (NILP (obarray
)) obarray
= Vobarray
;
1340 obarray
= check_obarray (obarray
);
1342 map_obarray (obarray
, mapatoms_1
, function
);
1346 #define OBARRAY_SIZE 509
1351 Lisp_Object oblength
;
1355 XFASTINT (oblength
) = OBARRAY_SIZE
;
1357 Qnil
= Fmake_symbol (make_pure_string ("nil", 3));
1358 Vobarray
= Fmake_vector (oblength
, make_number (0));
1359 initial_obarray
= Vobarray
;
1360 staticpro (&initial_obarray
);
1361 /* Intern nil in the obarray */
1362 /* These locals are to kludge around a pyramid compiler bug. */
1363 hash
= hash_string ("nil", 3);
1364 /* Separate statement here to avoid VAXC bug. */
1365 hash
%= OBARRAY_SIZE
;
1366 tem
= &XVECTOR (Vobarray
)->contents
[hash
];
1369 Qunbound
= Fmake_symbol (make_pure_string ("unbound", 7));
1370 XSYMBOL (Qnil
)->function
= Qunbound
;
1371 XSYMBOL (Qunbound
)->value
= Qunbound
;
1372 XSYMBOL (Qunbound
)->function
= Qunbound
;
1375 XSYMBOL (Qnil
)->value
= Qnil
;
1376 XSYMBOL (Qnil
)->plist
= Qnil
;
1377 XSYMBOL (Qt
)->value
= Qt
;
1379 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
1382 Qvariable_documentation
= intern ("variable-documentation");
1384 read_buffer_size
= 100;
1385 read_buffer
= (char *) malloc (read_buffer_size
);
1390 struct Lisp_Subr
*sname
;
1393 sym
= intern (sname
->symbol_name
);
1394 XSET (XSYMBOL (sym
)->function
, Lisp_Subr
, sname
);
1397 #ifdef NOTDEF /* use fset in subr.el now */
1399 defalias (sname
, string
)
1400 struct Lisp_Subr
*sname
;
1404 sym
= intern (string
);
1405 XSET (XSYMBOL (sym
)->function
, Lisp_Subr
, sname
);
1409 /* New replacement for DefIntVar; it ignores the doc string argument
1410 on the assumption that make-docfile will handle that. */
1411 /* Define an "integer variable"; a symbol whose value is forwarded
1412 to a C variable of type int. Sample call: */
1413 /* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
1416 defvar_int (namestring
, address
, doc
)
1422 sym
= intern (namestring
);
1423 XSET (XSYMBOL (sym
)->value
, Lisp_Intfwd
, address
);
1426 /* Similar but define a variable whose value is T if address contains 1,
1427 NIL if address contains 0 */
1430 defvar_bool (namestring
, address
, doc
)
1436 sym
= intern (namestring
);
1437 XSET (XSYMBOL (sym
)->value
, Lisp_Boolfwd
, address
);
1440 /* Similar but define a variable whose value is the Lisp Object stored at address. */
1443 defvar_lisp (namestring
, address
, doc
)
1445 Lisp_Object
*address
;
1449 sym
= intern (namestring
);
1450 XSET (XSYMBOL (sym
)->value
, Lisp_Objfwd
, address
);
1451 staticpro (address
);
1454 /* Similar but don't request gc-marking of the C variable.
1455 Used when that variable will be gc-marked for some other reason,
1456 since marking the same slot twice can cause trouble with strings. */
1459 defvar_lisp_nopro (namestring
, address
, doc
)
1461 Lisp_Object
*address
;
1465 sym
= intern (namestring
);
1466 XSET (XSYMBOL (sym
)->value
, Lisp_Objfwd
, address
);
1471 /* Similar but define a variable whose value is the Lisp Object stored in
1472 the current buffer. address is the address of the slot in the buffer that is current now. */
1475 defvar_per_buffer (namestring
, address
, doc
)
1477 Lisp_Object
*address
;
1482 extern struct buffer buffer_local_symbols
;
1484 sym
= intern (namestring
);
1485 offset
= (char *)address
- (char *)current_buffer
;
1487 XSET (XSYMBOL (sym
)->value
, Lisp_Buffer_Objfwd
,
1488 (Lisp_Object
*) offset
);
1489 *(Lisp_Object
*)(offset
+ (char *)&buffer_local_symbols
) = sym
;
1490 if (*(int *)(offset
+ (char *)&buffer_local_flags
) == 0)
1491 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
1492 slot of buffer_local_flags */
1496 #endif /* standalone */
1502 /* Compute the default load-path. */
1504 normal
= PATH_LOADSEARCH
;
1505 Vload_path
= decode_env_path (0, normal
);
1507 if (NILP (Vpurify_flag
))
1508 normal
= PATH_LOADSEARCH
;
1510 normal
= PATH_DUMPLOADSEARCH
;
1512 /* In a dumped Emacs, we normally have to reset the value of
1513 Vload_path from PATH_LOADSEARCH, since the value that was dumped
1514 uses ../lisp, instead of the path of the installed elisp
1515 libraries. However, if it appears that Vload_path was changed
1516 from the default before dumping, don't override that value. */
1519 Lisp_Object dump_path
;
1521 dump_path
= decode_env_path (0, PATH_DUMPLOADSEARCH
);
1522 if (! NILP (Fequal (dump_path
, Vload_path
)))
1523 Vload_path
= decode_env_path (0, normal
);
1526 Vload_path
= decode_env_path (0, normal
);
1529 /* Warn if dirs in the *standard* path don't exist. */
1531 Lisp_Object path_tail
;
1533 for (path_tail
= Vload_path
;
1535 path_tail
= XCONS (path_tail
)->cdr
)
1537 Lisp_Object dirfile
;
1538 dirfile
= Fcar (path_tail
);
1539 if (XTYPE (dirfile
) == Lisp_String
)
1541 dirfile
= Fdirectory_file_name (dirfile
);
1542 if (access (XSTRING (dirfile
)->data
, 0) < 0)
1543 printf ("Warning: lisp library (%s) does not exist.\n",
1544 XSTRING (Fcar (path_tail
))->data
);
1549 /* If the EMACSLOADPATH environment variable is set, use its value.
1550 This doesn't apply if we're dumping. */
1551 if (NILP (Vpurify_flag
)
1552 && egetenv ("EMACSLOADPATH"))
1553 Vload_path
= decode_env_path ("EMACSLOADPATH", normal
);
1557 load_in_progress
= 0;
1564 defsubr (&Sread_from_string
);
1566 defsubr (&Sintern_soft
);
1568 defsubr (&Seval_buffer
);
1569 defsubr (&Seval_region
);
1570 defsubr (&Sread_char
);
1571 defsubr (&Sread_char_exclusive
);
1572 defsubr (&Sread_event
);
1573 defsubr (&Sget_file_char
);
1574 defsubr (&Smapatoms
);
1576 DEFVAR_LISP ("obarray", &Vobarray
,
1577 "Symbol table for use by `intern' and `read'.\n\
1578 It is a vector whose length ought to be prime for best results.\n\
1579 The vector's contents don't make sense if examined from Lisp programs;\n\
1580 to find all the symbols in an obarray, use `mapatoms'.");
1582 DEFVAR_LISP ("values", &Vvalues
,
1583 "List of values of all expressions which were read, evaluated and printed.\n\
1584 Order is reverse chronological.");
1586 DEFVAR_LISP ("standard-input", &Vstandard_input
,
1587 "Stream for read to get input from.\n\
1588 See documentation of `read' for possible values.");
1589 Vstandard_input
= Qt
;
1591 DEFVAR_LISP ("load-path", &Vload_path
,
1592 "*List of directories to search for files to load.\n\
1593 Each element is a string (directory name) or nil (try default directory).\n\
1594 Initialized based on EMACSLOADPATH environment variable, if any,\n\
1595 otherwise to default specified in by file `paths.h' when Emacs was built.");
1597 DEFVAR_BOOL ("load-in-progress", &load_in_progress
,
1598 "Non-nil iff inside of `load'.");
1600 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist
,
1601 "An alist of expressions to be evalled when particular files are loaded.\n\
1602 Each element looks like (FILENAME FORMS...).\n\
1603 When `load' is run and the file-name argument is FILENAME,\n\
1604 the FORMS in the corresponding element are executed at the end of loading.\n\n\
1605 FILENAME must match exactly! Normally FILENAME is the name of a library,\n\
1606 with no directory specified, since that is how `load' is normally called.\n\
1607 An error in FORMS does not undo the load,\n\
1608 but does prevent execution of the rest of the FORMS.");
1609 Vafter_load_alist
= Qnil
;
1611 Qstandard_input
= intern ("standard-input");
1612 staticpro (&Qstandard_input
);
1614 Qread_char
= intern ("read-char");
1615 staticpro (&Qread_char
);
1617 Qget_file_char
= intern ("get-file-char");
1618 staticpro (&Qget_file_char
);