HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Sync to HEAD
[bpt/emacs.git] / src / lread.c
CommitLineData
078e7b4a 1/* Lisp parsing and input streams.
6b61353c 2 Copyright (C) 1985,86,87,88,89,93,94,95,97,98,99,2000,01,03,2004
33046fc9 3 Free Software Foundation, Inc.
078e7b4a
JB		 4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
46947372 9the Free Software Foundation; either version 2, or (at your option)
078e7b4a
JB		 10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN		 19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
078e7b4a
JB		 21
22
98280b76 23#include <config.h>
078e7b4a
JB		 24#include <stdio.h>
25#include <sys/types.h>
26#include <sys/stat.h>
27#include <sys/file.h>
2c1b5dbe 28#include <errno.h>
078e7b4a 29#include "lisp.h"
95384e1e 30#include "intervals.h"
078e7b4a 31#include "buffer.h"
1571601b 32#include "character.h"
fe0e03f3 33#include "charset.h"
8792be66 34#include "coding.h"
57bda87a 35#include <epaths.h>
078e7b4a 36#include "commands.h"
e37c0805 37#include "keyboard.h"
7bd279cd 38#include "termhooks.h"
eb191db2 39#include "coding.h"
078e7b4a
JB		 40
41#ifdef lint
42#include <sys/inode.h>
43#endif /* lint */
44
79051982
RS		 45#ifdef MSDOS
46#if __DJGPP__ < 2
47#include <unistd.h> /* to get X_OK */
48#endif
49#include "msdos.h"
50#endif
51
c1a2f60a
AS		 52#ifdef HAVE_UNISTD_H
53#include <unistd.h>
54#endif
55
078e7b4a
JB		 56#ifndef X_OK
57#define X_OK 01
58#endif
59
078e7b4a 60#include <math.h>
078e7b4a 61
c011e9a5
RS		 62#ifdef HAVE_SETLOCALE
63#include <locale.h>
64#endif /* HAVE_SETLOCALE */
65
bcdec28b
DL		 66#ifdef HAVE_FCNTL_H
67#include <fcntl.h>
68#endif
f7d279f0
RS		 69#ifndef O_RDONLY
70#define O_RDONLY 0
71#endif
72
79cf851c 73#ifdef HAVE_FSEEKO
68c45bf0
PE		 74#define file_offset off_t
75#define file_tell ftello
76#else
77#define file_offset long
78#define file_tell ftell
79#endif
80
03695ace 81#ifndef USE_CRT_DLL
2c1b5dbe 82extern int errno;
03695ace 83#endif
2c1b5dbe 84
8a1f1537 85Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
078e7b4a 86Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
20ea2964 87Lisp_Object Qascii_character, Qload, Qload_file_name;
2b6cae0c 88Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
74549846 89Lisp_Object Qinhibit_file_name_operation;
7bd279cd 90
8792be66
KH		 91/* Used instead of Qget_file_char while loading *.elc files compiled
92 by Emacs 21 or older. */
93static Lisp_Object Qget_emacs_mule_file_char;
94
95static Lisp_Object Qload_force_doc_strings;
96
7bd279cd 97extern Lisp_Object Qevent_symbol_element_mask;
74549846 98extern Lisp_Object Qfile_exists_p;
078e7b4a
JB		 99
100/* non-zero if inside `load' */
101int load_in_progress;
102
1521a8fa
RS		 103/* Directory in which the sources were found. */
104Lisp_Object Vsource_directory;
105
e61b9b87
SM		 106/* Search path and suffixes for files to be loaded. */
107Lisp_Object Vload_path, Vload_suffixes, default_suffixes;
078e7b4a 108
4116ab9f
KH		 109/* File name of user's init file. */
110Lisp_Object Vuser_init_file;
111
ae321d28
RS		 112/* This is the user-visible association list that maps features to
113 lists of defs in their load files. */
114Lisp_Object Vload_history;
115
20ea2964 116/* This is used to build the load history. */
ae321d28
RS		 117Lisp_Object Vcurrent_load_list;
118
4b104c41
RS		 119/* List of files that were preloaded. */
120Lisp_Object Vpreloaded_file_list;
121
20ea2964
RS		 122/* Name of file actually being read by `load'. */
123Lisp_Object Vload_file_name;
124
84a15045
RS		 125/* Function to use for reading, in `load' and friends. */
126Lisp_Object Vload_read_function;
127
4ad679f9
EN		 128/* The association list of objects read with the #n=object form.
129 Each member of the list has the form (n . object), and is used to
130 look up the object for the corresponding #n# construct.
131 It must be set to nil before all top-level calls to read0. */
132Lisp_Object read_objects;
133
b2a30870
RS		 134/* Nonzero means load should forcibly load all dynamic doc strings. */
135static int load_force_doc_strings;
136
94e554db
RS		 137/* Nonzero means read should convert strings to unibyte. */
138static int load_convert_to_unibyte;
139
8792be66
KH		 140/* Nonzero means READCHAR should read bytes one by one (not character)
141 when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
142 This is set to 1 by read1 temporarily while handling #@NUMBER. */
143static int load_each_byte;
144
fe0e03f3
KH		 145/* Function to use for loading an Emacs lisp source file (not
146 compiled) instead of readevalloop. */
147Lisp_Object Vload_source_file_function;
148
1ffcc3b1
DL		 149/* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
150Lisp_Object Vbyte_boolean_vars;
151
abb13b09
CW		 152/* Whether or not to add a `read-positions' property to symbols
153 read. */
154Lisp_Object Vread_with_symbol_positions;
155
156/* List of (SYMBOL . POSITION) accumulated so far. */
157Lisp_Object Vread_symbol_positions_list;
158
d2c6be7f
RS		 159/* List of descriptors now open for Fload. */
160static Lisp_Object load_descriptor_list;
161
b2a30870 162/* File for get_file_char to read from. Use by load. */
078e7b4a
JB		 163static FILE *instream;
164
165/* When nonzero, read conses in pure space */
166static int read_pure;
167
b2a30870 168/* For use within read-from-string (this reader is non-reentrant!!) */
078e7b4a 169static int read_from_string_index;
bed23cb2 170static int read_from_string_index_byte;
078e7b4a 171static int read_from_string_limit;
17634846 172
abb13b09
CW		 173/* Number of characters read in the current call to Fread or
174 Fread_from_string. */
175static int readchar_count;
6f7f43d5 176
c15cfd1f 177/* This contains the last string skipped with #@. */
b2a30870
RS		 178static char *saved_doc_string;
179/* Length of buffer allocated in saved_doc_string. */
180static int saved_doc_string_size;
181/* Length of actual data in saved_doc_string. */
182static int saved_doc_string_length;
183/* This is the file position that string came from. */
68c45bf0 184static file_offset saved_doc_string_position;
b2a30870 185
c15cfd1f
RS		 186/* This contains the previous string skipped with #@.
187 We copy it from saved_doc_string when a new string
188 is put in saved_doc_string. */
189static char *prev_saved_doc_string;
190/* Length of buffer allocated in prev_saved_doc_string. */
191static int prev_saved_doc_string_size;
192/* Length of actual data in prev_saved_doc_string. */
193static int prev_saved_doc_string_length;
194/* This is the file position that string came from. */
68c45bf0 195static file_offset prev_saved_doc_string_position;
c15cfd1f 196
17634846
RS		 197/* Nonzero means inside a new-style backquote
198 with no surrounding parentheses.
199 Fread initializes this to zero, so we need not specbind it
200 or worry about what happens to it when there is an error. */
201static int new_backquote_flag;
7ee3bd7b
GM		 202
203/* A list of file names for files being loaded in Fload. Used to
204 check for recursive loads. */
205
206static Lisp_Object Vloads_in_progress;
207
550a625e
GM		 208/* Non-zero means load dangerous compiled Lisp files. */
209
210int load_dangerous_libraries;
211
212/* A regular expression used to detect files compiled with Emacs. */
213
214static Lisp_Object Vbytecomp_version_regexp;
215
8792be66
KH		 216static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
217 Lisp_Object));
218
11d89e5d 219static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
550a625e
GM		 220 Lisp_Object (*) (), int,
221 Lisp_Object, Lisp_Object));
222static Lisp_Object load_unwind P_ ((Lisp_Object));
223static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
224
078e7b4a 225\f
8792be66
KH		 226/* Functions that read one byte from the current source READCHARFUN
227 or unreads one byte. If the integer argument C is -1, it returns
228 one read byte, or -1 when there's no more byte in the source. If C
229 is 0 or positive, it unreads C, and the return value is not
230 interesting. */
231
232static int readbyte_for_lambda P_ ((int, Lisp_Object));
233static int readbyte_from_file P_ ((int, Lisp_Object));
234static int readbyte_from_string P_ ((int, Lisp_Object));
235
078e7b4a
JB		 236/* Handle unreading and rereading of characters.
237 Write READCHAR to read a character,
fe0e03f3
KH		 238 UNREAD(c) to unread c to be read again.
239
8792be66 240 These macros correctly read/unread multibyte characters. */
078e7b4a
JB		 241
242#define READCHAR readchar (readcharfun)
243#define UNREAD(c) unreadchar (readcharfun, c)
244
8792be66 245/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
8f924df7
KH		 246 Qlambda, or a cons, we use this to keep an unread character because
247 a file stream can't handle multibyte-char unreading. The value -1
8792be66
KH		 248 means that there's no unread character. */
249static int unread_char;
250
078e7b4a
JB		 251static int
252readchar (readcharfun)
253 Lisp_Object readcharfun;
254{
255 Lisp_Object tem;
95384e1e 256 register int c;
8792be66
KH		 257 int (*readbyte) P_ ((int, Lisp_Object));
258 unsigned char buf[MAX_MULTIBYTE_LENGTH];
259 int i, len;
260 int emacs_mule_encoding = 0;
078e7b4a 261
abb13b09 262 readchar_count++;
177c0ea7 263
cfff016d 264 if (BUFFERP (readcharfun))
078e7b4a 265 {
bed23cb2 266 register struct buffer *inbuffer = XBUFFER (readcharfun);
078e7b4a 267
bed23cb2 268 int pt_byte = BUF_PT_BYTE (inbuffer);
00a9a935 269
bed23cb2
RS		 270 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
271 return -1;
078e7b4a 272
bed23cb2
RS		 273 if (! NILP (inbuffer->enable_multibyte_characters))
274 {
00a9a935 275 /* Fetch the character code from the buffer. */
bed23cb2
RS		 276 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
277 BUF_INC_POS (inbuffer, pt_byte);
278 c = STRING_CHAR (p, pt_byte - orig_pt_byte);
279 }
280 else
281 {
282 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
8792be66
KH		 283 if (! ASCII_BYTE_P (c))
284 c = BYTE8_TO_CHAR (c);
bed23cb2 285 pt_byte++;
6f7f43d5 286 }
bed23cb2 287 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
6f7f43d5 288
bed23cb2 289 return c;
078e7b4a 290 }
cfff016d 291 if (MARKERP (readcharfun))
078e7b4a 292 {
bed23cb2 293 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
078e7b4a 294
bed23cb2 295 int bytepos = marker_byte_position (readcharfun);
00a9a935 296
bed23cb2
RS		 297 if (bytepos >= BUF_ZV_BYTE (inbuffer))
298 return -1;
6f7f43d5 299
bed23cb2
RS		 300 if (! NILP (inbuffer->enable_multibyte_characters))
301 {
00a9a935 302 /* Fetch the character code from the buffer. */
bed23cb2
RS		 303 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
304 BUF_INC_POS (inbuffer, bytepos);
305 c = STRING_CHAR (p, bytepos - orig_bytepos);
306 }
307 else
308 {
309 c = BUF_FETCH_BYTE (inbuffer, bytepos);
8792be66
KH		 310 if (! ASCII_BYTE_P (c))
311 c = BYTE8_TO_CHAR (c);
bed23cb2 312 bytepos++;
6f7f43d5
RS		 313 }
314
bed23cb2
RS		 315 XMARKER (readcharfun)->bytepos = bytepos;
316 XMARKER (readcharfun)->charpos++;
317
318 return c;
078e7b4a 319 }
ad0153e4
RS		 320
321 if (EQ (readcharfun, Qlambda))
8792be66
KH		 322 {
323 readbyte = readbyte_for_lambda;
324 goto read_multibyte;
325 }
ad0153e4 326
078e7b4a 327 if (EQ (readcharfun, Qget_file_char))
2c1b5dbe 328 {
8792be66
KH		 329 readbyte = readbyte_from_file;
330 goto read_multibyte;
2c1b5dbe 331 }
078e7b4a 332
cfff016d 333 if (STRINGP (readcharfun))
078e7b4a 334 {
bed23cb2 335 if (read_from_string_index >= read_from_string_limit)
078e7b4a 336 c = -1;
f0354c03 337 else
bed23cb2
RS		 338 FETCH_STRING_CHAR_ADVANCE (c, readcharfun,
339 read_from_string_index,
340 read_from_string_index_byte);
6f7f43d5 341
078e7b4a
JB		 342 return c;
343 }
344
8792be66
KH		 345 if (CONSP (readcharfun))
346 {
347 /* This is the case that read_vector is reading from a unibyte
348 string that contains a byte sequence previously skipped
349 because of #@NUMBER. The car part of readcharfun is that
350 string, and the cdr part is a value of readcharfun given to
351 read_vector. */
352 readbyte = readbyte_from_string;
353 if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
354 emacs_mule_encoding = 1;
355 goto read_multibyte;
356 }
8f924df7 357
8792be66
KH		 358 if (EQ (readcharfun, Qget_emacs_mule_file_char))
359 {
360 readbyte = readbyte_from_file;
361 emacs_mule_encoding = 1;
362 goto read_multibyte;
363 }
078e7b4a
JB		 364
365 tem = call0 (readcharfun);
366
265a9e55 367 if (NILP (tem))
078e7b4a
JB		 368 return -1;
369 return XINT (tem);
8792be66
KH		 370
371 read_multibyte:
372 if (unread_char >= 0)
373 {
374 c = unread_char;
375 unread_char = -1;
376 return c;
377 }
378 c = (*readbyte) (-1, readcharfun);
379 if (c < 0 || ASCII_BYTE_P (c) || load_each_byte)
380 return c;
381 if (emacs_mule_encoding)
382 return read_emacs_mule_char (c, readbyte, readcharfun);
383 i = 0;
384 buf[i++] = c;
385 len = BYTES_BY_CHAR_HEAD (c);
386 while (i < len)
387 {
388 c = (*readbyte) (-1, readcharfun);
389 if (c < 0 || ! TRAILING_CODE_P (c))
390 {
391 while (--i > 1)
392 (*readbyte) (buf[i], readcharfun);
393 return BYTE8_TO_CHAR (buf[0]);
394 }
395 buf[i++] = c;
396 }
397 return STRING_CHAR (buf, i);
078e7b4a
JB		 398}
399
400/* Unread the character C in the way appropriate for the stream READCHARFUN.
401 If the stream is a user function, call it with the char as argument. */
402
403static void
404unreadchar (readcharfun, c)
405 Lisp_Object readcharfun;
406 int c;
407{
abb13b09 408 readchar_count--;
92fddec9
KH		 409 if (c == -1)
410 /* Don't back up the pointer if we're unreading the end-of-input mark,
411 since readchar didn't advance it when we read it. */
412 ;
cfff016d 413 else if (BUFFERP (readcharfun))
d7760ca9 414 {
bed23cb2
RS		 415 struct buffer *b = XBUFFER (readcharfun);
416 int bytepos = BUF_PT_BYTE (b);
d7760ca9 417
8792be66
KH		 418 BUF_PT (b)--;
419 if (! NILP (b->enable_multibyte_characters))
420 BUF_DEC_POS (b, bytepos);
bed23cb2 421 else
8792be66 422 bytepos--;
d7760ca9 423
8792be66 424 BUF_PT_BYTE (b) = bytepos;
d7760ca9 425 }
cfff016d 426 else if (MARKERP (readcharfun))
d7760ca9 427 {
bed23cb2
RS		 428 struct buffer *b = XMARKER (readcharfun)->buffer;
429 int bytepos = XMARKER (readcharfun)->bytepos;
d7760ca9 430
8792be66
KH		 431 XMARKER (readcharfun)->charpos--;
432 if (! NILP (b->enable_multibyte_characters))
433 BUF_DEC_POS (b, bytepos);
bed23cb2 434 else
8792be66 435 bytepos--;
d7760ca9 436
8792be66 437 XMARKER (readcharfun)->bytepos = bytepos;
d7760ca9 438 }
cfff016d 439 else if (STRINGP (readcharfun))
bed23cb2
RS		 440 {
441 read_from_string_index--;
442 read_from_string_index_byte
443 = string_char_to_byte (readcharfun, read_from_string_index);
444 }
8792be66
KH		 445 else if (CONSP (readcharfun))
446 {
447 unread_char = c;
448 }
ad0153e4 449 else if (EQ (readcharfun, Qlambda))
8792be66
KH		 450 {
451 unread_char = c;
452 }
453 else if (EQ (readcharfun, Qget_file_char)
454 || EQ (readcharfun, Qget_emacs_mule_file_char))
455 {
456 if (load_each_byte)
457 ungetc (c, instream);
458 else
459 unread_char = c;
460 }
078e7b4a
JB		 461 else
462 call1 (readcharfun, make_number (c));
463}
464
8792be66
KH		 465static int
466readbyte_for_lambda (c, readcharfun)
467 int c;
468 Lisp_Object readcharfun;
469{
470 return read_bytecode_char (c >= 0);
471}
472
473
474static int
475readbyte_from_file (c, readcharfun)
476 int c;
477 Lisp_Object readcharfun;
478{
479 if (c >= 0)
480 {
481 ungetc (c, instream);
482 return 0;
483 }
484
485 c = getc (instream);
486#ifdef EINTR
487 /* Interrupted reads have been observed while reading over the network */
488 while (c == EOF && ferror (instream) && errno == EINTR)
489 {
490 clearerr (instream);
491 c = getc (instream);
492 }
493#endif
494 return (c == EOF ? -1 : c);
495}
496
497static int
498readbyte_from_string (c, readcharfun)
499 int c;
500 Lisp_Object readcharfun;
501{
502 Lisp_Object string = XCAR (readcharfun);
503
504 if (c >= 0)
505 {
506 read_from_string_index--;
507 read_from_string_index_byte
508 = string_char_to_byte (string, read_from_string_index);
509 }
8f924df7 510
8792be66
KH		 511 if (read_from_string_index >= read_from_string_limit)
512 c = -1;
513 else
514 FETCH_STRING_CHAR_ADVANCE (c, string,
515 read_from_string_index,
516 read_from_string_index_byte);
517 return c;
518}
519
520
521/* Read one non-ASCII character from INSTREAM. The character is
522 encoded in `emacs-mule' and the first byte is already read in
523 C. */
524
525extern char emacs_mule_bytes[256];
526
527static int
528read_emacs_mule_char (c, readbyte, readcharfun)
529 int c;
530 int (*readbyte) P_ ((int, Lisp_Object));
531 Lisp_Object readcharfun;
532{
533 /* Emacs-mule coding uses at most 4-byte for one character. */
534 unsigned char buf[4];
535 int len = emacs_mule_bytes[c];
536 struct charset *charset;
537 int i;
538 unsigned code;
539
540 if (len == 1)
541 /* C is not a valid leading-code of `emacs-mule'. */
542 return BYTE8_TO_CHAR (c);
543
544 i = 0;
545 buf[i++] = c;
546 while (i < len)
547 {
548 c = (*readbyte) (-1, readcharfun);
549 if (c < 0xA0)
550 {
551 while (--i > 1)
552 (*readbyte) (buf[i], readcharfun);
553 return BYTE8_TO_CHAR (buf[0]);
554 }
555 buf[i++] = c;
556 }
557
558 if (len == 2)
559 {
da6b532c 560 charset = emacs_mule_charset[buf[0]];
8792be66
KH		 561 code = buf[1] & 0x7F;
562 }
563 else if (len == 3)
564 {
565 if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
566 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
567 {
568 charset = emacs_mule_charset[buf[1]];
569 code = buf[2] & 0x7F;
570 }
571 else
572 {
573 charset = emacs_mule_charset[buf[0]];
574 code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
575 }
576 }
577 else
578 {
579 charset = emacs_mule_charset[buf[1]];
8f924df7 580 code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
8792be66
KH		 581 }
582 c = DECODE_CHAR (charset, code);
583 if (c < 0)
584 Fsignal (Qinvalid_read_syntax,
585 Fcons (build_string ("invalid multibyte form"), Qnil));
586 return c;
587}
588
589
abb13b09
CW		 590static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
591 Lisp_Object));
592static Lisp_Object read0 P_ ((Lisp_Object));
177c0ea7 593static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
abb13b09
CW		 594
595static Lisp_Object read_list P_ ((int, Lisp_Object));
596static Lisp_Object read_vector P_ ((Lisp_Object, int));
abb13b09
CW		 597
598static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
599 Lisp_Object));
600static void substitute_object_in_subtree P_ ((Lisp_Object,
601 Lisp_Object));
602static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
9e062b6c 603
078e7b4a 604\f
bed23cb2 605/* Get a character from the tty. */
078e7b4a 606
3d9b22be
JB		 607extern Lisp_Object read_char ();
608
f42be754
JB		 609/* Read input events until we get one that's acceptable for our purposes.
610
611 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
612 until we get a character we like, and then stuffed into
613 unread_switch_frame.
614
615 If ASCII_REQUIRED is non-zero, we check function key events to see
616 if the unmodified version of the symbol has a Qascii_character
617 property, and use that character, if present.
618
619 If ERROR_NONASCII is non-zero, we signal an error if the input we
620 get isn't an ASCII character with modifiers. If it's zero but
621 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
bb49a192
RS		 622 character.
623
624 If INPUT_METHOD is nonzero, we invoke the current input method
625 if the character warrants that. */
cc39bc38 626
f42be754 627Lisp_Object
bb49a192
RS		 628read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
629 input_method)
630 int no_switch_frame, ascii_required, error_nonascii, input_method;
f42be754 631{
153a17b7
KH		 632 register Lisp_Object val, delayed_switch_frame;
633
5dbf89bc 634#ifdef HAVE_WINDOW_SYSTEM
df6c90d8
GM		 635 if (display_hourglass_p)
636 cancel_hourglass ();
5dbf89bc 637#endif
177c0ea7 638
153a17b7 639 delayed_switch_frame = Qnil;
f42be754
JB		 640
641 /* Read until we get an acceptable event. */
642 retry:
bb49a192
RS		 643 val = read_char (0, 0, 0,
644 (input_method ? Qnil : Qt),
645 0);
f42be754 646
cfff016d 647 if (BUFFERP (val))
6c82d689
KH		 648 goto retry;
649
f42be754 650 /* switch-frame events are put off until after the next ASCII
8e6208c5 651 character. This is better than signaling an error just because
f42be754
JB		 652 the last characters were typed to a separate minibuffer frame,
653 for example. Eventually, some code which can deal with
654 switch-frame events will read it and process it. */
655 if (no_switch_frame
656 && EVENT_HAS_PARAMETERS (val)
657 && EQ (EVENT_HEAD (val), Qswitch_frame))
658 {
659 delayed_switch_frame = val;
660 goto retry;
661 }
662
663 if (ascii_required)
664 {
665 /* Convert certain symbols to their ASCII equivalents. */
cfff016d 666 if (SYMBOLP (val))
f42be754 667 {
95384e1e 668 Lisp_Object tem, tem1;
f42be754
JB		 669 tem = Fget (val, Qevent_symbol_element_mask);
670 if (!NILP (tem))
671 {
672 tem1 = Fget (Fcar (tem), Qascii_character);
673 /* Merge this symbol's modifier bits
674 with the ASCII equivalent of its basic code. */
675 if (!NILP (tem1))
baf69866 676 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
f42be754
JB		 677 }
678 }
177c0ea7 679
f42be754 680 /* If we don't have a character now, deal with it appropriately. */
cfff016d 681 if (!INTEGERP (val))
f42be754
JB		 682 {
683 if (error_nonascii)
684 {
1ec84625 685 Vunread_command_events = Fcons (val, Qnil);
f42be754
JB		 686 error ("Non-character input-event");
687 }
688 else
689 goto retry;
690 }
691 }
692
693 if (! NILP (delayed_switch_frame))
694 unread_switch_frame = delayed_switch_frame;
695
67868d27
PJ		 696#if 0
697
5dbf89bc 698#ifdef HAVE_WINDOW_SYSTEM
df6c90d8
GM		 699 if (display_hourglass_p)
700 start_hourglass ();
5dbf89bc 701#endif
67868d27
PJ		 702
703#endif
704
f42be754 705 return val;
f42be754
JB		 706}
707
bb49a192 708DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0,
5de38842
PJ		 709 doc: /* Read a character from the command input (keyboard or macro).
710It is returned as a number.
711If the user generates an event which is not a character (i.e. a mouse
712click or function key event), `read-char' signals an error. As an
713exception, switch-frame events are put off until non-ASCII events can
714be read.
715If you want to read non-character events, or ignore them, call
716`read-event' or `read-char-exclusive' instead.
717
718If the optional argument PROMPT is non-nil, display that as a prompt.
719If the optional argument INHERIT-INPUT-METHOD is non-nil and some
720input method is turned on in the current buffer, that input method
721is used for reading a character. */)
722 (prompt, inherit_input_method)
fc351d2f 723 Lisp_Object prompt, inherit_input_method;
078e7b4a 724{
bb49a192
RS		 725 if (! NILP (prompt))
726 message_with_string ("%s", prompt, 0);
fc351d2f 727 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method));
078e7b4a
JB		 728}
729
bb49a192 730DEFUN ("read-event", Fread_event, Sread_event, 0, 2, 0,
5de38842
PJ		 731 doc: /* Read an event object from the input stream.
732If the optional argument PROMPT is non-nil, display that as a prompt.
733If the optional argument INHERIT-INPUT-METHOD is non-nil and some
734input method is turned on in the current buffer, that input method
735is used for reading a character. */)
736 (prompt, inherit_input_method)
fc351d2f 737 Lisp_Object prompt, inherit_input_method;
078e7b4a 738{
bb49a192
RS		 739 if (! NILP (prompt))
740 message_with_string ("%s", prompt, 0);
fc351d2f 741 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method));
078e7b4a
JB		 742}
743
bb49a192 744DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 2, 0,
5de38842
PJ		 745 doc: /* Read a character from the command input (keyboard or macro).
746It is returned as a number. Non-character events are ignored.
747
748If the optional argument PROMPT is non-nil, display that as a prompt.
749If the optional argument INHERIT-INPUT-METHOD is non-nil and some
750input method is turned on in the current buffer, that input method
751is used for reading a character. */)
752 (prompt, inherit_input_method)
fc351d2f 753 Lisp_Object prompt, inherit_input_method;
078e7b4a 754{
bb49a192
RS		 755 if (! NILP (prompt))
756 message_with_string ("%s", prompt, 0);
fc351d2f 757 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method));
078e7b4a 758}
078e7b4a
JB		 759
760DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
5de38842
PJ		 761 doc: /* Don't use this yourself. */)
762 ()
078e7b4a
JB		 763{
764 register Lisp_Object val;
1805de4f 765 XSETINT (val, getc (instream));
078e7b4a
JB		 766 return val;
767}
da84f340
GM		 768
769
550a625e 770\f
8792be66 771/* Value is a version number of byte compiled code if the file
8f924df7 772 asswociated with file descriptor FD is a compiled Lisp file that's
8792be66
KH		 773 safe to load. Only files compiled with Emacs are safe to load.
774 Files compiled with XEmacs can lead to a crash in Fbyte_code
775 because of an incompatible change in the byte compiler. */
da84f340
GM		 776
777static int
778safe_to_load_p (fd)
779 int fd;
780{
781 char buf[512];
782 int nbytes, i;
783 int safe_p = 1;
8f924df7 784 int version = 1;
da84f340
GM		 785
786 /* Read the first few bytes from the file, and look for a line
787 specifying the byte compiler version used. */
788 nbytes = emacs_read (fd, buf, sizeof buf - 1);
789 if (nbytes > 0)
790 {
791 buf[nbytes] = '\0';
792
793 /* Skip to the next newline, skipping over the initial `ELC'
1da3b9e4 794 with NUL bytes following it, but note the version. */
da84f340 795 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
1da3b9e4 796 if (i == 4)
8792be66 797 version = buf[i];
da84f340 798
927f12da
KH		 799 if (i == nbytes
800 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
da84f340
GM		 801 buf + i) < 0)
802 safe_p = 0;
803 }
1da3b9e4
DL		 804 if (safe_p)
805 safe_p = version;
da84f340
GM		 806
807 lseek (fd, 0, SEEK_SET);
808 return safe_p;
809}
810
811
7ee3bd7b
GM		 812/* Callback for record_unwind_protect. Restore the old load list OLD,
813 after loading a file successfully. */
814
815static Lisp_Object
816record_load_unwind (old)
817 Lisp_Object old;
818{
819 return Vloads_in_progress = old;
820}
821
164c8bfe
RS		 822/* This handler function is used via internal_condition_case_1. */
823
824static Lisp_Object
825load_error_handler (data)
826 Lisp_Object data;
827{
828 return Qnil;
829}
7ee3bd7b 830
f0a50954 831DEFUN ("load", Fload, Sload, 1, 5, 0,
5de38842
PJ		 832 doc: /* Execute a file of Lisp code named FILE.
833First try FILE with `.elc' appended, then try with `.el',
d77b70e5
MR		 834 then try FILE unmodified (the exact suffixes are determined by
835`load-suffixes'). Environment variable references in FILE
5de38842
PJ		 836 are replaced with their values by calling `substitute-in-file-name'.
837This function searches the directories in `load-path'.
838If optional second arg NOERROR is non-nil,
839 report no error if FILE doesn't exist.
840Print messages at start and end of loading unless
841 optional third arg NOMESSAGE is non-nil.
842If optional fourth arg NOSUFFIX is non-nil, don't try adding
843 suffixes `.elc' or `.el' to the specified name FILE.
844If optional fifth arg MUST-SUFFIX is non-nil, insist on
845 the suffix `.elc' or `.el'; don't accept just FILE unless
846 it ends in one of those suffixes or includes a directory name.
847Return t if file exists. */)
848 (file, noerror, nomessage, nosuffix, must_suffix)
f0a50954 849 Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
078e7b4a
JB		 850{
851 register FILE *stream;
852 register int fd = -1;
853 register Lisp_Object lispstream;
aed13378 854 int count = SPECPDL_INDEX ();
078e7b4a
JB		 855 Lisp_Object temp;
856 struct gcpro gcpro1;
eb191db2 857 Lisp_Object found, efound;
04fc68e7
RS		 858 /* 1 means we printed the ".el is newer" message. */
859 int newer = 0;
860 /* 1 means we are loading a compiled file. */
861 int compiled = 0;
c2225d00 862 Lisp_Object handler;
456c67a4 863 int safe_p = 1;
229ba775 864 char *fmode = "r";
8792be66
KH		 865 int version;
866
317073d5 867#ifdef DOS_NT
229ba775 868 fmode = "rt";
317073d5 869#endif /* DOS_NT */
078e7b4a 870
b7826503 871 CHECK_STRING (file);
078e7b4a 872
c2225d00 873 /* If file name is magic, call the handler. */
e61b9b87
SM		 874 /* This shouldn't be necessary any more now that `openp' handles it right.
875 handler = Ffind_file_name_handler (file, Qload);
876 if (!NILP (handler))
877 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
c2225d00 878
07a0bda3
RS		 879 /* Do this after the handler to avoid
880 the need to gcpro noerror, nomessage and nosuffix.
e61b9b87
SM		 881 (Below here, we care only whether they are nil or not.)
882 The presence of this call is the result of a historical accident:
883 it used to be in every file-operations and when it got removed
884 everywhere, it accidentally stayed here. Since then, enough people
885 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
886 that it seemed risky to remove. */
164c8bfe
RS		 887 if (! NILP (noerror))
888 {
889 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
890 Qt, load_error_handler);
891 if (NILP (file))
892 return Qnil;
893 }
894 else
895 file = Fsubstitute_in_file_name (file);
177c0ea7 896
07a0bda3 897
078e7b4a
JB		 898 /* Avoid weird lossage with null string as arg,
899 since it would try to load a directory as a Lisp file */
d5db4077 900 if (SCHARS (file) > 0)
078e7b4a 901 {
d5db4077 902 int size = SBYTES (file);
e61b9b87 903 Lisp_Object tmp[2];
211f7dcd 904
0745dce9 905 GCPRO1 (file);
211f7dcd
RS		 906
907 if (! NILP (must_suffix))
908 {
909 /* Don't insist on adding a suffix if FILE already ends with one. */
910 if (size > 3
d5db4077 911 && !strcmp (SDATA (file) + size - 3, ".el"))
211f7dcd
RS		 912 must_suffix = Qnil;
913 else if (size > 4
d5db4077 914 && !strcmp (SDATA (file) + size - 4, ".elc"))
211f7dcd
RS		 915 must_suffix = Qnil;
916 /* Don't insist on adding a suffix
917 if the argument includes a directory name. */
918 else if (! NILP (Ffile_name_directory (file)))
919 must_suffix = Qnil;
920 }
921
f0a50954 922 fd = openp (Vload_path, file,
e61b9b87
SM		 923 (!NILP (nosuffix) ? Qnil
924 : !NILP (must_suffix) ? Vload_suffixes
925 : Fappend (2, (tmp[0] = Vload_suffixes,
926 tmp[1] = default_suffixes,
927 tmp))),
86d00812 928 &found, Qnil);
5a6e5452 929 UNGCPRO;
078e7b4a
JB		 930 }
931
96dc0f4e 932 if (fd == -1)
078e7b4a 933 {
265a9e55 934 if (NILP (noerror))
164c8bfe
RS		 935 Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
936 Fcons (file, Qnil)));
078e7b4a
JB		 937 else
938 return Qnil;
939 }
940
ba0d1195 941 /* Tell startup.el whether or not we found the user's init file. */
4116ab9f
KH		 942 if (EQ (Qt, Vuser_init_file))
943 Vuser_init_file = found;
944
96dc0f4e
MB		 945 /* If FD is -2, that means openp found a magic file. */
946 if (fd == -2)
74549846 947 {
5e24a1f7
KH		 948 if (NILP (Fequal (found, file)))
949 /* If FOUND is a different file name from FILE,
950 find its handler even if we have already inhibited
951 the `load' operation on FILE. */
952 handler = Ffind_file_name_handler (found, Qt);
953 else
954 handler = Ffind_file_name_handler (found, Qload);
955 if (! NILP (handler))
956 return call5 (handler, Qload, found, noerror, nomessage, Qt);
74549846
RS		 957 }
958
550a625e
GM		 959 /* Check if we're stuck in a recursive load cycle.
960
961 2000-09-21: It's not possible to just check for the file loaded
962 being a member of Vloads_in_progress. This fails because of the
963 way the byte compiler currently works; `provide's are not
964 evaluted, see font-lock.el/jit-lock.el as an example. This
965 leads to a certain amount of ``normal'' recursion.
966
967 Also, just loading a file recursively is not always an error in
968 the general case; the second load may do something different. */
3ba6fd9a
RS		 969 {
970 int count = 0;
971 Lisp_Object tem;
972 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
973 if (!NILP (Fequal (found, XCAR (tem))))
974 count++;
975 if (count > 3)
976 Fsignal (Qerror, Fcons (build_string ("Recursive load"),
977 Fcons (found, Vloads_in_progress)));
978 record_unwind_protect (record_load_unwind, Vloads_in_progress);
979 Vloads_in_progress = Fcons (found, Vloads_in_progress);
980 }
7ee3bd7b 981
8792be66 982 version = -1;
a1c89c0a 983 if (!bcmp (SDATA (found) + SBYTES (found) - 4,
8792be66
KH		 984 ".elc", 4)
985 || (version = safe_to_load_p (fd)) > 0)
96dc0f4e
MB		 986 /* Load .elc files directly, but not when they are
987 remote and have no handler! */
078e7b4a 988 {
96dc0f4e 989 if (fd != -2)
da84f340 990 {
96dc0f4e
MB		 991 struct stat s1, s2;
992 int result;
da84f340 993
8792be66
KH		 994 if (version < 0
995 && ! (version = safe_to_load_p (fd)))
96dc0f4e
MB		 996 {
997 safe_p = 0;
998 if (!load_dangerous_libraries)
e63304b7
DL		 999 {
1000 if (fd >= 0)
1001 emacs_close (fd);
1002 error ("File `%s' was not compiled in Emacs",
1003 SDATA (found));
1004 }
96dc0f4e
MB		 1005 else if (!NILP (nomessage))
1006 message_with_string ("File `%s' not compiled in Emacs", found, 1);
1007 }
04fc68e7 1008
96dc0f4e
MB		 1009 compiled = 1;
1010
eb191db2
EZ		 1011 GCPRO1 (efound);
1012 efound = ENCODE_FILE (found);
1013
26fbf20b 1014#ifdef DOS_NT
96dc0f4e 1015 fmode = "rb";
26fbf20b 1016#endif /* DOS_NT */
d5db4077 1017 stat ((char *)SDATA (efound), &s1);
a1c89c0a 1018 SSET (efound, SBYTES (efound) - 1, 0);
d5db4077 1019 result = stat ((char *)SDATA (efound), &s2);
a1c89c0a 1020 SSET (efound, SBYTES (efound) - 1, 'c');
eb191db2
EZ		 1021 UNGCPRO;
1022
96dc0f4e
MB		 1023 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1024 {
1025 /* Make the progress messages mention that source is newer. */
1026 newer = 1;
04fc68e7 1027
96dc0f4e 1028 /* If we won't print another message, mention this anyway. */
714d8c39
GM		 1029 if (!NILP (nomessage))
1030 {
1031 Lisp_Object file;
1032 file = Fsubstring (found, make_number (0), make_number (-1));
1033 message_with_string ("Source file `%s' newer than byte-compiled file",
c33ef7c4 1034 file, 1);
714d8c39 1035 }
96dc0f4e 1036 }
51ac6f83 1037 }
078e7b4a 1038 }
fe0e03f3
KH		 1039 else
1040 {
1041 /* We are loading a source file (*.el). */
1042 if (!NILP (Vload_source_file_function))
1043 {
7ee3bd7b 1044 Lisp_Object val;
96dc0f4e
MB		 1045
1046 if (fd >= 0)
68c45bf0 1047 emacs_close (fd);
7ee3bd7b
GM		 1048 val = call4 (Vload_source_file_function, found, file,
1049 NILP (noerror) ? Qnil : Qt,
1050 NILP (nomessage) ? Qnil : Qt);
1051 return unbind_to (count, val);
fe0e03f3
KH		 1052 }
1053 }
078e7b4a 1054
229ba775 1055#ifdef WINDOWSNT
68c45bf0 1056 emacs_close (fd);
eb191db2
EZ		 1057 GCPRO1 (efound);
1058 efound = ENCODE_FILE (found);
d5db4077 1059 stream = fopen ((char *) SDATA (efound), fmode);
eb191db2 1060 UNGCPRO;
229ba775
EZ		 1061#else /* not WINDOWSNT */
1062 stream = fdopen (fd, fmode);
1063#endif /* not WINDOWSNT */
078e7b4a
JB		 1064 if (stream == 0)
1065 {
68c45bf0 1066 emacs_close (fd);
d5db4077 1067 error ("Failure to create stdio stream for %s", SDATA (file));
078e7b4a
JB		 1068 }
1069
4b104c41
RS		 1070 if (! NILP (Vpurify_flag))
1071 Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
1072
04fc68e7
RS		 1073 if (NILP (nomessage))
1074 {
da84f340
GM		 1075 if (!safe_p)
1076 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1077 file, 1);
1078 else if (!compiled)
e28552a4 1079 message_with_string ("Loading %s (source)...", file, 1);
db5cae4b 1080 else if (newer)
e28552a4
RS		 1081 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1082 file, 1);
db5cae4b 1083 else /* The typical case; compiled file newer than source file. */
e28552a4 1084 message_with_string ("Loading %s...", file, 1);
04fc68e7 1085 }
078e7b4a 1086
0745dce9 1087 GCPRO1 (file);
838abf56 1088 lispstream = Fcons (Qnil, Qnil);
f5df591a
KR		 1089 XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16);
1090 XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff);
078e7b4a 1091 record_unwind_protect (load_unwind, lispstream);
d2c6be7f 1092 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
20ea2964 1093 specbind (Qload_file_name, found);
74549846 1094 specbind (Qinhibit_file_name_operation, Qnil);
d2c6be7f
RS		 1095 load_descriptor_list
1096 = Fcons (make_number (fileno (stream)), load_descriptor_list);
078e7b4a 1097 load_in_progress++;
ab2a47e1 1098 if (! version || version >= 22)
8792be66
KH		 1099 readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil);
1100 else
1101 {
1102 /* We can't handle a file which was compiled with
1103 byte-compile-dynamic by older version of Emacs. */
1104 specbind (Qload_force_doc_strings, Qt);
1105 readevalloop (Qget_emacs_mule_file_char, stream, file, Feval, 0,
1106 Qnil, Qnil);
1107 }
078e7b4a
JB		 1108 unbind_to (count, Qnil);
1109
1110 /* Run any load-hooks for this file. */
0745dce9 1111 temp = Fassoc (file, Vafter_load_alist);
265a9e55 1112 if (!NILP (temp))
078e7b4a
JB		 1113 Fprogn (Fcdr (temp));
1114 UNGCPRO;
1115
b2a30870
RS		 1116 if (saved_doc_string)
1117 free (saved_doc_string);
1118 saved_doc_string = 0;
1119 saved_doc_string_size = 0;
1120
c15cfd1f 1121 if (prev_saved_doc_string)
3cb65b0e 1122 xfree (prev_saved_doc_string);
c15cfd1f
RS		 1123 prev_saved_doc_string = 0;
1124 prev_saved_doc_string_size = 0;
1125
265a9e55 1126 if (!noninteractive && NILP (nomessage))
04fc68e7 1127 {
da84f340
GM		 1128 if (!safe_p)
1129 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1130 file, 1);
1131 else if (!compiled)
e28552a4 1132 message_with_string ("Loading %s (source)...done", file, 1);
db5cae4b 1133 else if (newer)
e28552a4
RS		 1134 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1135 file, 1);
db5cae4b 1136 else /* The typical case; compiled file newer than source file. */
e28552a4 1137 message_with_string ("Loading %s...done", file, 1);
04fc68e7 1138 }
7ee3bd7b 1139
11810d78
SM		 1140 if (!NILP (Fequal (build_string ("obsolete"),
1141 Ffile_name_nondirectory
1142 (Fdirectory_file_name (Ffile_name_directory (found))))))
1143 message_with_string ("Package %s is obsolete", file, 1);
1144
078e7b4a
JB		 1145 return Qt;
1146}
1147
1148static Lisp_Object
1149load_unwind (stream) /* used as unwind-protect function in load */
1150 Lisp_Object stream;
1151{
c1d497be
KR		 1152 fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
1153 | XFASTINT (XCDR (stream))));
078e7b4a
JB		 1154 if (--load_in_progress < 0) load_in_progress = 0;
1155 return Qnil;
1156}
1157
d2c6be7f
RS		 1158static Lisp_Object
1159load_descriptor_unwind (oldlist)
1160 Lisp_Object oldlist;
1161{
1162 load_descriptor_list = oldlist;
838abf56 1163 return Qnil;
d2c6be7f
RS		 1164}
1165
1166/* Close all descriptors in use for Floads.
1167 This is used when starting a subprocess. */
1168
1169void
1170close_load_descs ()
1171{
f3849f25 1172#ifndef WINDOWSNT
d2c6be7f 1173 Lisp_Object tail;
c1d497be 1174 for (tail = load_descriptor_list; !NILP (tail); tail = XCDR (tail))
68c45bf0 1175 emacs_close (XFASTINT (XCAR (tail)));
f3849f25 1176#endif
d2c6be7f 1177}
078e7b4a
JB		 1178\f
1179static int
1180complete_filename_p (pathname)
1181 Lisp_Object pathname;
1182{
4b2dd274 1183 register const unsigned char *s = SDATA (pathname);
317073d5 1184 return (IS_DIRECTORY_SEP (s[0])
d5db4077 1185 || (SCHARS (pathname) > 2
317073d5 1186 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
078e7b4a
JB		 1187#ifdef ALTOS
1188 || *s == '@'
1189#endif
1190#ifdef VMS
1191 || index (s, ':')
1192#endif /* VMS */
1193 );
1194}
1195
86d00812
SM		 1196DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1197 doc: /* Search for FILENAME through PATH.
1198If SUFFIXES is non-nil, it should be a list of suffixes to append to
1199file name when searching.
1200If non-nil, PREDICATE is used instead of `file-readable-p'.
1201PREDICATE can also be an integer to pass to the access(2) function,
1202in which case file-name-handlers are ignored. */)
1203 (filename, path, suffixes, predicate)
1204 Lisp_Object filename, path, suffixes, predicate;
1205{
1206 Lisp_Object file;
1207 int fd = openp (path, filename, suffixes, &file, predicate);
1208 if (NILP (predicate) && fd > 0)
1209 close (fd);
1210 return file;
1211}
1212
1213
078e7b4a
JB		 1214/* Search for a file whose name is STR, looking in directories
1215 in the Lisp list PATH, and trying suffixes from SUFFIX.
078e7b4a
JB		 1216 On success, returns a file descriptor. On failure, returns -1.
1217
e61b9b87
SM		 1218 SUFFIXES is a list of strings containing possible suffixes.
1219 The empty suffix is automatically added iff the list is empty.
1220
86d00812
SM		 1221 PREDICATE non-nil means don't open the files,
1222 just look for one that satisfies the predicate. In this case,
1223 returns 1 on success. The predicate can be a lisp function or
1224 an integer to pass to `access' (in which case file-name-handlers
1225 are ignored).
078e7b4a
JB		 1226
1227 If STOREPTR is nonzero, it points to a slot where the name of
1228 the file actually found should be stored as a Lisp string.
74549846
RS		 1229 nil is stored there on failure.
1230
96dc0f4e 1231 If the file we find is remote, return -2
86d00812 1232 but store the found remote file name in *STOREPTR. */
078e7b4a
JB		 1233
1234int
86d00812 1235openp (path, str, suffixes, storeptr, predicate)
078e7b4a 1236 Lisp_Object path, str;
e61b9b87 1237 Lisp_Object suffixes;
078e7b4a 1238 Lisp_Object *storeptr;
86d00812 1239 Lisp_Object predicate;
078e7b4a
JB		 1240{
1241 register int fd;
1242 int fn_size = 100;
1243 char buf[100];
1244 register char *fn = buf;
1245 int absolute = 0;
1246 int want_size;
74549846 1247 Lisp_Object filename;
078e7b4a 1248 struct stat st;
eb191db2
EZ		 1249 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1250 Lisp_Object string, tail, encoded_fn;
e61b9b87
SM		 1251 int max_suffix_len = 0;
1252
6f8eafd1
SM		 1253 CHECK_STRING (str);
1254
e61b9b87
SM		 1255 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1256 {
f5df591a 1257 CHECK_STRING_CAR (tail);
e61b9b87 1258 max_suffix_len = max (max_suffix_len,
d5db4077 1259 SBYTES (XCAR (tail)));
e61b9b87 1260 }
078e7b4a 1261
990ff03c 1262 string = filename = Qnil;
eb191db2
EZ		 1263 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1264
078e7b4a
JB		 1265 if (storeptr)
1266 *storeptr = Qnil;
1267
1268 if (complete_filename_p (str))
1269 absolute = 1;
1270
e61b9b87 1271 for (; CONSP (path); path = XCDR (path))
078e7b4a 1272 {
e61b9b87 1273 filename = Fexpand_file_name (str, XCAR (path));
078e7b4a
JB		 1274 if (!complete_filename_p (filename))
1275 /* If there are non-absolute elts in PATH (eg ".") */
1276 /* Of course, this could conceivably lose if luser sets
1277 default-directory to be something non-absolute... */
1278 {
1279 filename = Fexpand_file_name (filename, current_buffer->directory);
1280 if (!complete_filename_p (filename))
1281 /* Give up on this path element! */
1282 continue;
1283 }
1284
1285 /* Calculate maximum size of any filename made from
1286 this path element/specified file name and any possible suffix. */
d5db4077 1287 want_size = max_suffix_len + SBYTES (filename) + 1;
078e7b4a
JB		 1288 if (fn_size < want_size)
1289 fn = (char *) alloca (fn_size = 100 + want_size);
1290
078e7b4a 1291 /* Loop over suffixes. */
e61b9b87
SM		 1292 for (tail = NILP (suffixes) ? default_suffixes : suffixes;
1293 CONSP (tail); tail = XCDR (tail))
078e7b4a 1294 {
d5db4077 1295 int lsuffix = SBYTES (XCAR (tail));
74549846 1296 Lisp_Object handler;
eb191db2 1297 int exists;
078e7b4a 1298
c49afcd7
RS		 1299 /* Concatenate path element/specified name with the suffix.
1300 If the directory starts with /:, remove that. */
d5db4077
KR		 1301 if (SCHARS (filename) > 2
1302 && SREF (filename, 0) == '/'
1303 && SREF (filename, 1) == ':')
c49afcd7 1304 {
d5db4077
KR		 1305 strncpy (fn, SDATA (filename) + 2,
1306 SBYTES (filename) - 2);
1307 fn[SBYTES (filename) - 2] = 0;
c49afcd7
RS		 1308 }
1309 else
1310 {
d5db4077
KR		 1311 strncpy (fn, SDATA (filename),
1312 SBYTES (filename));
1313 fn[SBYTES (filename)] = 0;
c49afcd7
RS		 1314 }
1315
078e7b4a 1316 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
d5db4077 1317 strncat (fn, SDATA (XCAR (tail)), lsuffix);
eb191db2 1318
74549846 1319 /* Check that the file exists and is not a directory. */
e61b9b87
SM		 1320 /* We used to only check for handlers on non-absolute file names:
1321 if (absolute)
1322 handler = Qnil;
1323 else
1324 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1325 It's not clear why that was the case and it breaks things like
1326 (load "/bar.el") where the file is actually "/bar.el.gz". */
eb191db2 1327 string = build_string (fn);
4773b8ca 1328 handler = Ffind_file_name_handler (string, Qfile_exists_p);
86d00812
SM		 1329 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1330 {
1331 if (NILP (predicate))
1332 exists = !NILP (Ffile_readable_p (string));
1333 else
1334 exists = !NILP (call1 (predicate, string));
eb191db2 1335 if (exists && !NILP (Ffile_directory_p (string)))
74549846
RS		 1336 exists = 0;
1337
1338 if (exists)
078e7b4a
JB		 1339 {
1340 /* We succeeded; return this descriptor and filename. */
1341 if (storeptr)
eb191db2 1342 *storeptr = string;
5ef2a3c0 1343 UNGCPRO;
96dc0f4e 1344 return -2;
74549846
RS		 1345 }
1346 }
1347 else
1348 {
4b2dd274 1349 const char *pfn;
eb191db2
EZ		 1350
1351 encoded_fn = ENCODE_FILE (string);
d5db4077 1352 pfn = SDATA (encoded_fn);
eb191db2
EZ		 1353 exists = (stat (pfn, &st) >= 0
1354 && (st.st_mode & S_IFMT) != S_IFDIR);
74549846
RS		 1355 if (exists)
1356 {
1357 /* Check that we can access or open it. */
86d00812
SM		 1358 if (NATNUMP (predicate))
1359 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
74549846 1360 else
eb191db2 1361 fd = emacs_open (pfn, O_RDONLY, 0);
74549846
RS		 1362
1363 if (fd >= 0)
1364 {
1365 /* We succeeded; return this descriptor and filename. */
1366 if (storeptr)
eb191db2 1367 *storeptr = string;
74549846
RS		 1368 UNGCPRO;
1369 return fd;
1370 }
078e7b4a
JB		 1371 }
1372 }
078e7b4a 1373 }
5a6e5452 1374 if (absolute)
5ef2a3c0 1375 break;
078e7b4a
JB		 1376 }
1377
5ef2a3c0
KH		 1378 UNGCPRO;
1379 return -1;
078e7b4a
JB		 1380}
1381
1382\f
ae321d28
RS		 1383/* Merge the list we've accumulated of globals from the current input source
1384 into the load_history variable. The details depend on whether
1385 the source has an associated file name or not. */
1386
1387static void
1388build_load_history (stream, source)
1389 FILE *stream;
1390 Lisp_Object source;
1391{
1392 register Lisp_Object tail, prev, newelt;
1393 register Lisp_Object tem, tem2;
1394 register int foundit, loading;
1395
1396 loading = stream || !NARROWED;
1397
1398 tail = Vload_history;
1399 prev = Qnil;
1400 foundit = 0;
86d00812 1401 while (CONSP (tail))
ae321d28 1402 {
86d00812 1403 tem = XCAR (tail);
ae321d28
RS		 1404
1405 /* Find the feature's previous assoc list... */
1406 if (!NILP (Fequal (source, Fcar (tem))))
1407 {
1408 foundit = 1;
1409
1410 /* If we're loading, remove it. */
1411 if (loading)
86d00812 1412 {
ae321d28 1413 if (NILP (prev))
86d00812 1414 Vload_history = XCDR (tail);
ae321d28 1415 else
86d00812 1416 Fsetcdr (prev, XCDR (tail));
ae321d28
RS		 1417 }
1418
1419 /* Otherwise, cons on new symbols that are not already members. */
1420 else
1421 {
1422 tem2 = Vcurrent_load_list;
1423
1424 while (CONSP (tem2))
1425 {
86d00812 1426 newelt = XCAR (tem2);
ae321d28 1427
d642e4f9 1428 if (NILP (Fmember (newelt, tem)))
86d00812
SM		 1429 Fsetcar (tail, Fcons (XCAR (tem),
1430 Fcons (newelt, XCDR (tem))));
ae321d28 1431
86d00812 1432 tem2 = XCDR (tem2);
ae321d28
RS		 1433 QUIT;
1434 }
1435 }
1436 }
1437 else
1438 prev = tail;
86d00812 1439 tail = XCDR (tail);
ae321d28
RS		 1440 QUIT;
1441 }
1442
8a1f1537
RS		 1443 /* If we're loading, cons the new assoc onto the front of load-history,
1444 the most-recently-loaded position. Also do this if we didn't find
1445 an existing member for the current source. */
1446 if (loading || !foundit)
1447 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1448 Vload_history);
ae321d28
RS		 1449}
1450
078e7b4a 1451Lisp_Object
232ccf27
DL		 1452unreadpure (junk) /* Used as unwind-protect function in readevalloop */
1453 Lisp_Object junk;
078e7b4a
JB		 1454{
1455 read_pure = 0;
1456 return Qnil;
1457}
1458
94e554db
RS		 1459static Lisp_Object
1460readevalloop_1 (old)
1461 Lisp_Object old;
1462{
1463 load_convert_to_unibyte = ! NILP (old);
1464 return Qnil;
1465}
1466
9c97398c
GM		 1467/* Signal an `end-of-file' error, if possible with file name
1468 information. */
1469
1470static void
1471end_of_file_error ()
1472{
1473 Lisp_Object data;
1474
1475 if (STRINGP (Vload_file_name))
1476 data = Fcons (Vload_file_name, Qnil);
1477 else
1478 data = Qnil;
1479
1480 Fsignal (Qend_of_file, data);
1481}
1482
94e554db 1483/* UNIBYTE specifies how to set load_convert_to_unibyte
976350af
RS		 1484 for this invocation.
1485 READFUN, if non-nil, is used instead of `read'. */
94e554db 1486
078e7b4a 1487static void
976350af 1488readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, readfun)
078e7b4a 1489 Lisp_Object readcharfun;
ae321d28
RS		 1490 FILE *stream;
1491 Lisp_Object sourcename;
078e7b4a
JB		 1492 Lisp_Object (*evalfun) ();
1493 int printflag;
976350af 1494 Lisp_Object unibyte, readfun;
078e7b4a
JB		 1495{
1496 register int c;
1497 register Lisp_Object val;
aed13378 1498 int count = SPECPDL_INDEX ();
8a1f1537 1499 struct gcpro gcpro1;
49cf7ff4 1500 struct buffer *b = 0;
f38952fe 1501 int continue_reading_p;
49cf7ff4
RS		 1502
1503 if (BUFFERP (readcharfun))
1504 b = XBUFFER (readcharfun);
1505 else if (MARKERP (readcharfun))
1506 b = XMARKER (readcharfun)->buffer;
078e7b4a
JB		 1507
1508 specbind (Qstandard_input, readcharfun);
8a1f1537 1509 specbind (Qcurrent_load_list, Qnil);
94e554db
RS		 1510 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1511 load_convert_to_unibyte = !NILP (unibyte);
078e7b4a 1512
8a1f1537 1513 GCPRO1 (sourcename);
ae321d28 1514
ae321d28
RS		 1515 LOADHIST_ATTACH (sourcename);
1516
f38952fe
GM		 1517 continue_reading_p = 1;
1518 while (continue_reading_p)
078e7b4a 1519 {
49cf7ff4
RS		 1520 if (b != 0 && NILP (b->name))
1521 error ("Reading from killed buffer");
1522
078e7b4a
JB		 1523 instream = stream;
1524 c = READCHAR;
1525 if (c == ';')
1526 {
1527 while ((c = READCHAR) != '\n' && c != -1);
1528 continue;
1529 }
1530 if (c < 0) break;
6069d957
RS		 1531
1532 /* Ignore whitespace here, so we can detect eof. */
1533 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1534 continue;
078e7b4a 1535
265a9e55 1536 if (!NILP (Vpurify_flag) && c == '(')
078e7b4a 1537 {
aed13378 1538 int count1 = SPECPDL_INDEX ();
078e7b4a
JB		 1539 record_unwind_protect (unreadpure, Qnil);
1540 val = read_list (-1, readcharfun);
0e326373 1541 unbind_to (count1, Qnil);
078e7b4a
JB		 1542 }
1543 else
1544 {
1545 UNREAD (c);
4ad679f9 1546 read_objects = Qnil;
f38952fe
GM		 1547 if (!NILP (readfun))
1548 {
1549 val = call1 (readfun, readcharfun);
1550
1551 /* If READCHARFUN has set point to ZV, we should
1552 stop reading, even if the form read sets point
1553 to a different value when evaluated. */
1554 if (BUFFERP (readcharfun))
1555 {
1556 struct buffer *b = XBUFFER (readcharfun);
1557 if (BUF_PT (b) == BUF_ZV (b))
1558 continue_reading_p = 0;
1559 }
1560 }
976350af 1561 else if (! NILP (Vload_read_function))
84a15045 1562 val = call1 (Vload_read_function, readcharfun);
976350af 1563 else
abb13b09 1564 val = read_internal_start (readcharfun, Qnil, Qnil);
078e7b4a
JB		 1565 }
1566
1567 val = (*evalfun) (val);
f38952fe 1568
078e7b4a
JB		 1569 if (printflag)
1570 {
1571 Vvalues = Fcons (val, Vvalues);
1572 if (EQ (Vstandard_output, Qt))
1573 Fprin1 (val, Qnil);
1574 else
1575 Fprint (val, Qnil);
1576 }
1577 }
1578
ae321d28 1579 build_load_history (stream, sourcename);
ae321d28
RS		 1580 UNGCPRO;
1581
078e7b4a
JB		 1582 unbind_to (count, Qnil);
1583}
1584
1076254d 1585DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
5de38842
PJ		 1586 doc: /* Execute the current buffer as Lisp code.
1587Programs can pass two arguments, BUFFER and PRINTFLAG.
1588BUFFER is the buffer to evaluate (nil means use current buffer).
1589PRINTFLAG controls printing of output:
1590nil means discard it; anything else is stream for print.
1591
1592If the optional third argument FILENAME is non-nil,
1593it specifies the file name to use for `load-history'.
1594The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1595for this invocation.
1596
3f9ab804 1597The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
5de38842
PJ		 1598`print' and related functions should work normally even if PRINTFLAG is nil.
1599
1600This function preserves the position of point. */)
1601 (buffer, printflag, filename, unibyte, do_allow_print)
1076254d 1602 Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
228d4b1c 1603{
aed13378 1604 int count = SPECPDL_INDEX ();
228d4b1c
JA		 1605 Lisp_Object tem, buf;
1606
9391b698 1607 if (NILP (buffer))
228d4b1c
JA		 1608 buf = Fcurrent_buffer ();
1609 else
9391b698 1610 buf = Fget_buffer (buffer);
dfdb645c 1611 if (NILP (buf))
13febd85 1612 error ("No such buffer");
228d4b1c 1613
1076254d 1614 if (NILP (printflag) && NILP (do_allow_print))
228d4b1c
JA		 1615 tem = Qsymbolp;
1616 else
1617 tem = printflag;
13febd85
RS		 1618
1619 if (NILP (filename))
1620 filename = XBUFFER (buf)->filename;
1621
228d4b1c
JA		 1622 specbind (Qstandard_output, tem);
1623 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1624 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
976350af 1625 readevalloop (buf, 0, filename, Feval, !NILP (printflag), unibyte, Qnil);
cb09ab7a 1626 unbind_to (count, Qnil);
228d4b1c
JA		 1627
1628 return Qnil;
1629}
1630
976350af 1631DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
5de38842
PJ		 1632 doc: /* Execute the region as Lisp code.
1633When called from programs, expects two arguments,
1634giving starting and ending indices in the current buffer
1635of the text to be executed.
1636Programs can pass third argument PRINTFLAG which controls output:
1637nil means discard it; anything else is stream for printing it.
1638Also the fourth argument READ-FUNCTION, if non-nil, is used
1639instead of `read' to read each expression. It gets one argument
1640which is the input stream for reading characters.
1641
1642This function does not move point. */)
1643 (start, end, printflag, read_function)
976350af 1644 Lisp_Object start, end, printflag, read_function;
078e7b4a 1645{
aed13378 1646 int count = SPECPDL_INDEX ();
ae321d28
RS		 1647 Lisp_Object tem, cbuf;
1648
1649 cbuf = Fcurrent_buffer ();
078e7b4a 1650
265a9e55 1651 if (NILP (printflag))
078e7b4a
JB		 1652 tem = Qsymbolp;
1653 else
1654 tem = printflag;
1655 specbind (Qstandard_output, tem);
1656
265a9e55 1657 if (NILP (printflag))
078e7b4a
JB		 1658 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1659 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1660
9391b698
EN		 1661 /* This both uses start and checks its type. */
1662 Fgoto_char (start);
1663 Fnarrow_to_region (make_number (BEGV), end);
94e554db 1664 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
976350af 1665 !NILP (printflag), Qnil, read_function);
078e7b4a
JB		 1666
1667 return unbind_to (count, Qnil);
1668}
1669
078e7b4a
JB		 1670\f
1671DEFUN ("read", Fread, Sread, 0, 1, 0,
5de38842
PJ		 1672 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1673If STREAM is nil, use the value of `standard-input' (which see).
1674STREAM or the value of `standard-input' may be:
1675 a buffer (read from point and advance it)
1676 a marker (read from where it points and advance it)
1677 a function (call it with no arguments for each character,
1678 call it with a char as argument to push a char back)
1679 a string (takes text from string, starting at the beginning)
1680 t (read text line using minibuffer and use it, or read from
1681 standard input in batch mode). */)
1682 (stream)
5be02dff 1683 Lisp_Object stream;
078e7b4a 1684{
5be02dff
KH		 1685 if (NILP (stream))
1686 stream = Vstandard_input;
1687 if (EQ (stream, Qt))
1688 stream = Qread_char;
5be02dff 1689 if (EQ (stream, Qread_char))
078e7b4a 1690 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
078e7b4a 1691
abb13b09 1692 return read_internal_start (stream, Qnil, Qnil);
078e7b4a
JB		 1693}
1694
1695DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
5de38842
PJ		 1696 doc: /* Read one Lisp expression which is represented as text by STRING.
1697Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1698START and END optionally delimit a substring of STRING from which to read;
1699 they default to 0 and (length STRING) respectively. */)
1700 (string, start, end)
078e7b4a
JB		 1701 Lisp_Object string, start, end;
1702{
2530ceaf 1703 Lisp_Object ret;
b7826503 1704 CHECK_STRING (string);
2530ceaf
CW		 1705 /* read_internal_start sets read_from_string_index. */
1706 ret = read_internal_start (string, start, end);
5135ab39 1707 return Fcons (ret, make_number (read_from_string_index));
abb13b09 1708}
078e7b4a 1709
abb13b09
CW		 1710/* Function to set up the global context we need in toplevel read
1711 calls. */
1712static Lisp_Object
1713read_internal_start (stream, start, end)
1714 Lisp_Object stream;
1715 Lisp_Object start; /* Only used when stream is a string. */
1716 Lisp_Object end; /* Only used when stream is a string. */
1717{
1718 Lisp_Object retval;
078e7b4a 1719
abb13b09 1720 readchar_count = 0;
17634846 1721 new_backquote_flag = 0;
4ad679f9 1722 read_objects = Qnil;
abb13b09
CW		 1723 if (EQ (Vread_with_symbol_positions, Qt)
1724 || EQ (Vread_with_symbol_positions, stream))
1725 Vread_symbol_positions_list = Qnil;
1726
8f924df7
KH		 1727 if (STRINGP (stream)
1728 || ((CONSP (stream) && STRINGP (XCAR (stream)))))
abb13b09
CW		 1729 {
1730 int startval, endval;
8f924df7 1731 Lisp_Object string;
078e7b4a 1732
8f924df7
KH		 1733 if (STRINGP (stream))
1734 string = stream;
1735 else
1736 string = XCAR (stream);
078e7b4a 1737
abb13b09 1738 if (NILP (end))
8f924df7 1739 endval = SCHARS (string);
abb13b09
CW		 1740 else
1741 {
1742 CHECK_NUMBER (end);
1743 endval = XINT (end);
8f924df7
KH		 1744 if (endval < 0 || endval > SCHARS (string))
1745 args_out_of_range (string, end);
abb13b09 1746 }
17634846 1747
abb13b09
CW		 1748 if (NILP (start))
1749 startval = 0;
1750 else
1751 {
1752 CHECK_NUMBER (start);
1753 startval = XINT (start);
1754 if (startval < 0 || startval > endval)
8f924df7 1755 args_out_of_range (string, start);
abb13b09
CW		 1756 }
1757 read_from_string_index = startval;
8f924df7 1758 read_from_string_index_byte = string_char_to_byte (string, startval);
abb13b09
CW		 1759 read_from_string_limit = endval;
1760 }
177c0ea7 1761
abb13b09
CW		 1762 retval = read0 (stream);
1763 if (EQ (Vread_with_symbol_positions, Qt)
1764 || EQ (Vread_with_symbol_positions, stream))
1765 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
1766 return retval;
078e7b4a
JB		 1767}
1768\f
6428369f
KH		 1769/* Use this for recursive reads, in contexts where internal tokens
1770 are not allowed. */
e28552a4 1771
078e7b4a
JB		 1772static Lisp_Object
1773read0 (readcharfun)
1774 Lisp_Object readcharfun;
1775{
1776 register Lisp_Object val;
e28552a4 1777 int c;
078e7b4a 1778
17634846 1779 val = read1 (readcharfun, &c, 0);
6428369f 1780 if (c)
93d75e4c
RS		 1781 Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1),
1782 make_number (c)),
e28552a4 1783 Qnil));
078e7b4a
JB		 1784
1785 return val;
1786}
1787\f
1788static int read_buffer_size;
1789static char *read_buffer;
1790
f6f79b37 1791/* Read a \-escape sequence, assuming we already read the `\'.
8f924df7 1792 If the escape sequence forces unibyte, return eight-bit char. */
6f7f43d5 1793
078e7b4a 1794static int
8792be66 1795read_escape (readcharfun, stringp)
078e7b4a 1796 Lisp_Object readcharfun;
e7fc914b 1797 int stringp;
078e7b4a
JB		 1798{
1799 register int c = READCHAR;
f6f79b37 1800
078e7b4a
JB		 1801 switch (c)
1802 {
f3849f25 1803 case -1:
da3b886d 1804 end_of_file_error ();
f3849f25 1805
078e7b4a 1806 case 'a':
265a9e55 1807 return '\007';
078e7b4a
JB		 1808 case 'b':
1809 return '\b';
f405a585
RS		 1810 case 'd':
1811 return 0177;
078e7b4a
JB		 1812 case 'e':
1813 return 033;
1814 case 'f':
1815 return '\f';
1816 case 'n':
1817 return '\n';
1818 case 'r':
1819 return '\r';
1820 case 't':
1821 return '\t';
1822 case 'v':
1823 return '\v';
1824 case '\n':
1825 return -1;
e28552a4 1826 case ' ':
e7fc914b
KH		 1827 if (stringp)
1828 return -1;
1829 return ' ';
078e7b4a
JB		 1830
1831 case 'M':
1832 c = READCHAR;
1833 if (c != '-')
1834 error ("Invalid escape character syntax");
1835 c = READCHAR;
1836 if (c == '\\')
8792be66 1837 c = read_escape (readcharfun, 0);
7bd279cd 1838 return c | meta_modifier;
f405a585
RS		 1839
1840 case 'S':
1841 c = READCHAR;
1842 if (c != '-')
1843 error ("Invalid escape character syntax");
1844 c = READCHAR;
1845 if (c == '\\')
8792be66 1846 c = read_escape (readcharfun, 0);
7bd279cd
RS		 1847 return c | shift_modifier;
1848
1849 case 'H':
1850 c = READCHAR;
1851 if (c != '-')
1852 error ("Invalid escape character syntax");
1853 c = READCHAR;
1854 if (c == '\\')
8792be66 1855 c = read_escape (readcharfun, 0);
7bd279cd
RS		 1856 return c | hyper_modifier;
1857
1858 case 'A':
1859 c = READCHAR;
1860 if (c != '-')
1861 error ("Invalid escape character syntax");
1862 c = READCHAR;
1863 if (c == '\\')
8792be66 1864 c = read_escape (readcharfun, 0);
7bd279cd
RS		 1865 return c | alt_modifier;
1866
1867 case 's':
37cd4238
KS		 1868 if (stringp)
1869 return ' ';
7bd279cd 1870 c = READCHAR;
37cd4238
KS		 1871 if (c != '-') {
1872 UNREAD (c);
1873 return ' ';
1874 }
7bd279cd
RS		 1875 c = READCHAR;
1876 if (c == '\\')
8792be66 1877 c = read_escape (readcharfun, 0);
7bd279cd 1878 return c | super_modifier;
078e7b4a
JB		 1879
1880 case 'C':
1881 c = READCHAR;
1882 if (c != '-')
1883 error ("Invalid escape character syntax");
1884 case '^':
1885 c = READCHAR;
1886 if (c == '\\')
8792be66 1887 c = read_escape (readcharfun, 0);
164d590d
KH		 1888 if ((c & ~CHAR_MODIFIER_MASK) == '?')
1889 return 0177 | (c & CHAR_MODIFIER_MASK);
1890 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
1891 return c | ctrl_modifier;
f405a585
RS		 1892 /* ASCII control chars are made from letters (both cases),
1893 as well as the non-letters within 0100...0137. */
1894 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
1895 return (c & (037 | ~0177));
1896 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
1897 return (c & (037 | ~0177));
078e7b4a 1898 else
7bd279cd 1899 return c | ctrl_modifier;
078e7b4a
JB		 1900
1901 case '0':
1902 case '1':
1903 case '2':
1904 case '3':
1905 case '4':
1906 case '5':
1907 case '6':
1908 case '7':
1909 /* An octal escape, as in ANSI C. */
1910 {
1911 register int i = c - '0';
1912 register int count = 0;
1913 while (++count < 3)
1914 {
1915 if ((c = READCHAR) >= '0' && c <= '7')
1916 {
1917 i *= 8;
1918 i += c - '0';
1919 }
1920 else
1921 {
1922 UNREAD (c);
1923 break;
1924 }
1925 }
177c0ea7 1926
8f924df7 1927 if (i >= 0x80 && i < 0x100)
8792be66 1928 i = BYTE8_TO_CHAR (i);
078e7b4a
JB		 1929 return i;
1930 }
1931
1932 case 'x':
1933 /* A hex escape, as in ANSI C. */
1934 {
1935 int i = 0;
1571601b 1936 int count = 0;
078e7b4a
JB		 1937 while (1)
1938 {
1939 c = READCHAR;
1940 if (c >= '0' && c <= '9')
1941 {
1942 i *= 16;
1943 i += c - '0';
1944 }
1945 else if ((c >= 'a' && c <= 'f')
1946 || (c >= 'A' && c <= 'F'))
1947 {
1948 i *= 16;
1949 if (c >= 'a' && c <= 'f')
1950 i += c - 'a' + 10;
1951 else
1952 i += c - 'A' + 10;
1953 }
1954 else
1955 {
1956 UNREAD (c);
1957 break;
1958 }
1571601b 1959 count++;
078e7b4a 1960 }
f6f79b37 1961
1571601b 1962 if (count < 3 && i >= 0x80)
8792be66 1963 return BYTE8_TO_CHAR (i);
078e7b4a
JB		 1964 return i;
1965 }
1966
1967 default:
1968 return c;
1969 }
1970}
1971
bf5d1a17
GM		 1972
1973/* Read an integer in radix RADIX using READCHARFUN to read
1974 characters. RADIX must be in the interval [2..36]; if it isn't, a
1975 read error is signaled . Value is the integer read. Signals an
1976 error if encountering invalid read syntax or if RADIX is out of
1977 range. */
1978
1979static Lisp_Object
1980read_integer (readcharfun, radix)
1981 Lisp_Object readcharfun;
1982 int radix;
1983{
5e37dc22
GM		 1984 int ndigits = 0, invalid_p, c, sign = 0;
1985 EMACS_INT number = 0;
bf5d1a17
GM		 1986
1987 if (radix < 2 || radix > 36)
1988 invalid_p = 1;
1989 else
1990 {
1991 number = ndigits = invalid_p = 0;
1992 sign = 1;
1993
1994 c = READCHAR;
1995 if (c == '-')
1996 {
1997 c = READCHAR;
1998 sign = -1;
1999 }
2000 else if (c == '+')
2001 c = READCHAR;
177c0ea7 2002
bf5d1a17
GM		 2003 while (c >= 0)
2004 {
2005 int digit;
177c0ea7 2006
bf5d1a17
GM		 2007 if (c >= '0' && c <= '9')
2008 digit = c - '0';
2009 else if (c >= 'a' && c <= 'z')
2010 digit = c - 'a' + 10;
2011 else if (c >= 'A' && c <= 'Z')
2012 digit = c - 'A' + 10;
2013 else
b632fa48
GM		 2014 {
2015 UNREAD (c);
2016 break;
2017 }
bf5d1a17
GM		 2018
2019 if (digit < 0 || digit >= radix)
2020 invalid_p = 1;
2021
2022 number = radix * number + digit;
2023 ++ndigits;
2024 c = READCHAR;
2025 }
2026 }
2027
2028 if (ndigits == 0 || invalid_p)
2029 {
2030 char buf[50];
2031 sprintf (buf, "integer, radix %d", radix);
2032 Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil));
2033 }
2034
2035 return make_number (sign * number);
2036}
2037
2038
6428369f
KH		 2039/* If the next token is ')' or ']' or '.', we store that character
2040 in *PCH and the return value is not interesting. Else, we store
17634846
RS		 2041 zero in *PCH and we read and return one lisp object.
2042
2043 FIRST_IN_LIST is nonzero if this is the first element of a list. */
2044
078e7b4a 2045static Lisp_Object
17634846 2046read1 (readcharfun, pch, first_in_list)
078e7b4a 2047 register Lisp_Object readcharfun;
e28552a4 2048 int *pch;
17634846 2049 int first_in_list;
078e7b4a
JB		 2050{
2051 register int c;
4ad679f9
EN		 2052 int uninterned_symbol = 0;
2053
6428369f 2054 *pch = 0;
8792be66 2055 load_each_byte = 0;
078e7b4a
JB		 2056
2057 retry:
2058
2059 c = READCHAR;
9c97398c
GM		 2060 if (c < 0)
2061 end_of_file_error ();
078e7b4a
JB		 2062
2063 switch (c)
2064 {
2065 case '(':
2066 return read_list (0, readcharfun);
2067
2068 case '[':
c15cfd1f 2069 return read_vector (readcharfun, 0);
078e7b4a
JB		 2070
2071 case ')':
2072 case ']':
078e7b4a 2073 {
6428369f
KH		 2074 *pch = c;
2075 return Qnil;
078e7b4a
JB		 2076 }
2077
2078 case '#':
200f684e 2079 c = READCHAR;
c2390933
RS		 2080 if (c == '^')
2081 {
2082 c = READCHAR;
2083 if (c == '[')
2084 {
2085 Lisp_Object tmp;
c15cfd1f 2086 tmp = read_vector (readcharfun, 0);
1571601b 2087 if (XVECTOR (tmp)->size != VECSIZE (struct Lisp_Char_Table))
c2390933
RS		 2088 error ("Invalid size char-table");
2089 XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
2090 return tmp;
2091 }
3701b5de
KH		 2092 else if (c == '^')
2093 {
2094 c = READCHAR;
2095 if (c == '[')
2096 {
2097 Lisp_Object tmp;
1571601b 2098 int depth, size;
8f924df7 2099
c15cfd1f 2100 tmp = read_vector (readcharfun, 0);
1571601b
KH		 2101 if (!INTEGERP (AREF (tmp, 0)))
2102 error ("Invalid depth in char-table");
2103 depth = XINT (AREF (tmp, 0));
2104 if (depth < 1 || depth > 3)
2105 error ("Invalid depth in char-table");
2106 size = XVECTOR (tmp)->size + 2;
2107 if (chartab_size [depth] != size)
3701b5de 2108 error ("Invalid size char-table");
1571601b 2109 XSETSUB_CHAR_TABLE (tmp, XSUB_CHAR_TABLE (tmp));
3701b5de
KH		 2110 return tmp;
2111 }
2112 Fsignal (Qinvalid_read_syntax,
2113 Fcons (make_string ("#^^", 3), Qnil));
2114 }
c2390933
RS		 2115 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil));
2116 }
2117 if (c == '&')
2118 {
2119 Lisp_Object length;
2120 length = read1 (readcharfun, pch, first_in_list);
2121 c = READCHAR;
2122 if (c == '"')
2123 {
2124 Lisp_Object tmp, val;
90ed3ec5 2125 int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1)
68be917d 2126 / BITS_PER_CHAR);
c2390933
RS		 2127
2128 UNREAD (c);
2129 tmp = read1 (readcharfun, pch, first_in_list);
8792be66 2130 if (STRING_MULTIBYTE (tmp)
8f924df7 2131 || (size_in_chars != SCHARS (tmp)
8792be66
KH		 2132 /* We used to print 1 char too many
2133 when the number of bits was a multiple of 8.
2134 Accept such input in case it came from an old
2135 version. */
2136 && ! (XFASTINT (length)
8f924df7 2137 == (SCHARS (tmp) - 1) * BITS_PER_CHAR)))
c2390933 2138 Fsignal (Qinvalid_read_syntax,
ec3bbd7d 2139 Fcons (make_string ("#&...", 5), Qnil));
177c0ea7 2140
c2390933 2141 val = Fmake_bool_vector (length, Qnil);
d5db4077 2142 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
c2390933 2143 size_in_chars);
67d3b149
EZ		 2144 /* Clear the extraneous bits in the last byte. */
2145 if (XINT (length) != size_in_chars * BITS_PER_CHAR)
2146 XBOOL_VECTOR (val)->data[size_in_chars - 1]
2147 &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1;
c2390933
RS		 2148 return val;
2149 }
ec3bbd7d 2150 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5),
039dc30b 2151 Qnil));
c2390933 2152 }
200f684e
RS		 2153 if (c == '[')
2154 {
2155 /* Accept compiled functions at read-time so that we don't have to
2156 build them using function calls. */
748ef62f 2157 Lisp_Object tmp;
c15cfd1f 2158 tmp = read_vector (readcharfun, 1);
748ef62f
RS		 2159 return Fmake_byte_code (XVECTOR (tmp)->size,
2160 XVECTOR (tmp)->contents);
200f684e 2161 }
748ef62f
RS		 2162 if (c == '(')
2163 {
2164 Lisp_Object tmp;
2165 struct gcpro gcpro1;
e28552a4 2166 int ch;
748ef62f
RS		 2167
2168 /* Read the string itself. */
17634846 2169 tmp = read1 (readcharfun, &ch, 0);
6428369f 2170 if (ch != 0 || !STRINGP (tmp))
748ef62f
RS		 2171 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
2172 GCPRO1 (tmp);
2173 /* Read the intervals and their properties. */
2174 while (1)
2175 {
2176 Lisp_Object beg, end, plist;
2177
17634846 2178 beg = read1 (readcharfun, &ch, 0);
7ee3bd7b 2179 end = plist = Qnil;
6428369f
KH		 2180 if (ch == ')')
2181 break;
2182 if (ch == 0)
17634846 2183 end = read1 (readcharfun, &ch, 0);
6428369f 2184 if (ch == 0)
17634846 2185 plist = read1 (readcharfun, &ch, 0);
6428369f 2186 if (ch)
748ef62f 2187 Fsignal (Qinvalid_read_syntax,
6428369f
KH		 2188 Fcons (build_string ("invalid string property list"),
2189 Qnil));
748ef62f
RS		 2190 Fset_text_properties (beg, end, plist, tmp);
2191 }
2192 UNGCPRO;
2193 return tmp;
2194 }
177c0ea7 2195
20ea2964
RS		 2196 /* #@NUMBER is used to skip NUMBER following characters.
2197 That's used in .elc files to skip over doc strings
2198 and function definitions. */
2199 if (c == '@')
2200 {
2201 int i, nskip = 0;
2202
8792be66 2203 load_each_byte = 1;
20ea2964
RS		 2204 /* Read a decimal integer. */
2205 while ((c = READCHAR) >= 0
2206 && c >= '0' && c <= '9')
2207 {
2208 nskip *= 10;
2209 nskip += c - '0';
2210 }
2211 if (c >= 0)
2212 UNREAD (c);
177c0ea7 2213
8792be66
KH		 2214 if (load_force_doc_strings
2215 && (EQ (readcharfun, Qget_file_char)
2216 || EQ (readcharfun, Qget_emacs_mule_file_char)))
b2a30870
RS		 2217 {
2218 /* If we are supposed to force doc strings into core right now,
2219 record the last string that we skipped,
2220 and record where in the file it comes from. */
c15cfd1f
RS		 2221
2222 /* But first exchange saved_doc_string
2223 with prev_saved_doc_string, so we save two strings. */
2224 {
2225 char *temp = saved_doc_string;
2226 int temp_size = saved_doc_string_size;
68c45bf0 2227 file_offset temp_pos = saved_doc_string_position;
c15cfd1f
RS		 2228 int temp_len = saved_doc_string_length;
2229
2230 saved_doc_string = prev_saved_doc_string;
2231 saved_doc_string_size = prev_saved_doc_string_size;
2232 saved_doc_string_position = prev_saved_doc_string_position;
2233 saved_doc_string_length = prev_saved_doc_string_length;
2234
2235 prev_saved_doc_string = temp;
2236 prev_saved_doc_string_size = temp_size;
2237 prev_saved_doc_string_position = temp_pos;
2238 prev_saved_doc_string_length = temp_len;
2239 }
2240
b2a30870
RS		 2241 if (saved_doc_string_size == 0)
2242 {
2243 saved_doc_string_size = nskip + 100;
11938f10 2244 saved_doc_string = (char *) xmalloc (saved_doc_string_size);
b2a30870
RS		 2245 }
2246 if (nskip > saved_doc_string_size)
2247 {
2248 saved_doc_string_size = nskip + 100;
11938f10
KH		 2249 saved_doc_string = (char *) xrealloc (saved_doc_string,
2250 saved_doc_string_size);
b2a30870
RS		 2251 }
2252
68c45bf0 2253 saved_doc_string_position = file_tell (instream);
b2a30870
RS		 2254
2255 /* Copy that many characters into saved_doc_string. */
2256 for (i = 0; i < nskip && c >= 0; i++)
2257 saved_doc_string[i] = c = READCHAR;
2258
2259 saved_doc_string_length = i;
2260 }
2261 else
b2a30870
RS		 2262 {
2263 /* Skip that many characters. */
2264 for (i = 0; i < nskip && c >= 0; i++)
2265 c = READCHAR;
2266 }
d49f0c1a 2267
8792be66 2268 load_each_byte = 0;
20ea2964
RS		 2269 goto retry;
2270 }
e2518d02
RS		 2271 if (c == '!')
2272 {
2273 /* #! appears at the beginning of an executable file.
2274 Skip the first line. */
225c7a07 2275 while (c != '\n' && c >= 0)
e2518d02
RS		 2276 c = READCHAR;
2277 goto retry;
2278 }
20ea2964
RS		 2279 if (c == '$')
2280 return Vload_file_name;
2b6cae0c
RS		 2281 if (c == '\'')
2282 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
4ad679f9
EN		 2283 /* #:foo is the uninterned symbol named foo. */
2284 if (c == ':')
2285 {
2286 uninterned_symbol = 1;
2287 c = READCHAR;
2288 goto default_label;
2289 }
2290 /* Reader forms that can reuse previously read objects. */
2291 if (c >= '0' && c <= '9')
2292 {
2293 int n = 0;
2294 Lisp_Object tem;
2b6cae0c 2295
4ad679f9
EN		 2296 /* Read a non-negative integer. */
2297 while (c >= '0' && c <= '9')
2298 {
2299 n *= 10;
2300 n += c - '0';
2301 c = READCHAR;
2302 }
2303 /* #n=object returns object, but associates it with n for #n#. */
2304 if (c == '=')
2305 {
9e062b6c
RS		 2306 /* Make a placeholder for #n# to use temporarily */
2307 Lisp_Object placeholder;
2308 Lisp_Object cell;
2309
2310 placeholder = Fcons(Qnil, Qnil);
2311 cell = Fcons (make_number (n), placeholder);
2312 read_objects = Fcons (cell, read_objects);
2313
2314 /* Read the object itself. */
4ad679f9 2315 tem = read0 (readcharfun);
9e062b6c
RS		 2316
2317 /* Now put it everywhere the placeholder was... */
2318 substitute_object_in_subtree (tem, placeholder);
2319
2320 /* ...and #n# will use the real value from now on. */
2321 Fsetcdr (cell, tem);
177c0ea7 2322
4ad679f9
EN		 2323 return tem;
2324 }
2325 /* #n# returns a previously read object. */
2326 if (c == '#')
2327 {
2328 tem = Fassq (make_number (n), read_objects);
2329 if (CONSP (tem))
2330 return XCDR (tem);
2331 /* Fall through to error message. */
2332 }
bf5d1a17
GM		 2333 else if (c == 'r' || c == 'R')
2334 return read_integer (readcharfun, n);
177c0ea7 2335
4ad679f9
EN		 2336 /* Fall through to error message. */
2337 }
bf5d1a17
GM		 2338 else if (c == 'x' || c == 'X')
2339 return read_integer (readcharfun, 16);
2340 else if (c == 'o' || c == 'O')
2341 return read_integer (readcharfun, 8);
2342 else if (c == 'b' || c == 'B')
2343 return read_integer (readcharfun, 2);
20ea2964 2344
200f684e 2345 UNREAD (c);
748ef62f 2346 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
078e7b4a
JB		 2347
2348 case ';':
2349 while ((c = READCHAR) >= 0 && c != '\n');
2350 goto retry;
2351
2352 case '\'':
2353 {
2354 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2355 }
2356
17634846
RS		 2357 case '`':
2358 if (first_in_list)
2359 goto default_label;
2360 else
2361 {
2362 Lisp_Object value;
2363
0ffbbdeb 2364 new_backquote_flag++;
17634846 2365 value = read0 (readcharfun);
0ffbbdeb 2366 new_backquote_flag--;
17634846
RS		 2367
2368 return Fcons (Qbackquote, Fcons (value, Qnil));
2369 }
2370
2371 case ',':
2372 if (new_backquote_flag)
2373 {
2374 Lisp_Object comma_type = Qnil;
2375 Lisp_Object value;
2376 int ch = READCHAR;
2377
2378 if (ch == '@')
2379 comma_type = Qcomma_at;
2380 else if (ch == '.')
2381 comma_type = Qcomma_dot;
2382 else
2383 {
2384 if (ch >= 0) UNREAD (ch);
2385 comma_type = Qcomma;
2386 }
2387
0ffbbdeb 2388 new_backquote_flag--;
17634846 2389 value = read0 (readcharfun);
0ffbbdeb 2390 new_backquote_flag++;
17634846
RS		 2391 return Fcons (comma_type, Fcons (value, Qnil));
2392 }
2393 else
2394 goto default_label;
2395
078e7b4a
JB		 2396 case '?':
2397 {
8792be66 2398 int modifiers;
df9c2be7
KS		 2399 int next_char;
2400 int ok;
f6f79b37 2401
078e7b4a 2402 c = READCHAR;
9c97398c
GM		 2403 if (c < 0)
2404 end_of_file_error ();
078e7b4a 2405
b9284371
KS		 2406 /* Accept `single space' syntax like (list ? x) where the
2407 whitespace character is SPC or TAB.
2408 Other literal whitespace like NL, CR, and FF are not accepted,
2409 as there are well-established escape sequences for these. */
2410 if (c == ' ' || c == '\t')
2411 return make_number (c);
2412
078e7b4a 2413 if (c == '\\')
8792be66
KH		 2414 c = read_escape (readcharfun, 0);
2415 modifiers = c & CHAR_MODIFIER_MASK;
2416 c &= ~CHAR_MODIFIER_MASK;
2417 if (CHAR_BYTE8_P (c))
2418 c = CHAR_TO_BYTE8 (c);
2419 c |= modifiers;
078e7b4a 2420
df9c2be7
KS		 2421 next_char = READCHAR;
2422 if (next_char == '.')
2423 {
2424 /* Only a dotted-pair dot is valid after a char constant. */
2425 int next_next_char = READCHAR;
2426 UNREAD (next_next_char);
2427
2428 ok = (next_next_char <= 040
e613ea97
KH		 2429 || (next_next_char < 0200
2430 && (index ("\"';([#?", next_next_char)
2431 || (!first_in_list && next_next_char == '`')
2432 || (new_backquote_flag && next_next_char == ','))));
df9c2be7
KS		 2433 }
2434 else
2435 {
2436 ok = (next_char <= 040
e613ea97
KH		 2437 || (next_char < 0200
2438 && (index ("\"';()[]#?", next_char)
2439 || (!first_in_list && next_char == '`')
2440 || (new_backquote_flag && next_char == ','))));
df9c2be7
KS		 2441 }
2442 UNREAD (next_char);
2443 if (!ok)
37cd4238
KS		 2444 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil));
2445
6f7f43d5 2446 return make_number (c);
078e7b4a
JB		 2447 }
2448
00a9a935 2449 case '"':
078e7b4a 2450 {
a742d646
GM		 2451 char *p = read_buffer;
2452 char *end = read_buffer + read_buffer_size;
078e7b4a 2453 register int c;
1571601b
KH		 2454 /* Nonzero if we saw an escape sequence specifying
2455 a multibyte character. */
e7fc914b 2456 int force_multibyte = 0;
1571601b 2457 /* Nonzero if we saw an escape sequence specifying
e7fc914b
KH		 2458 a single-byte character. */
2459 int force_singlebyte = 0;
078e7b4a 2460 int cancel = 0;
5150eeec 2461 int nchars = 0;
078e7b4a
JB		 2462
2463 while ((c = READCHAR) >= 0
2464 && c != '\"')
2465 {
449fea39 2466 if (end - p < MAX_MULTIBYTE_LENGTH)
078e7b4a 2467 {
5d65df0d
GM		 2468 int offset = p - read_buffer;
2469 read_buffer = (char *) xrealloc (read_buffer,
2470 read_buffer_size *= 2);
2471 p = read_buffer + offset;
078e7b4a
JB		 2472 end = read_buffer + read_buffer_size;
2473 }
bed23cb2 2474
078e7b4a 2475 if (c == '\\')
03e88613 2476 {
1571601b 2477 int modifiers;
f6f79b37 2478
8792be66 2479 c = read_escape (readcharfun, 1);
bed23cb2
RS		 2480
2481 /* C is -1 if \ newline has just been seen */
2482 if (c == -1)
03e88613 2483 {
bed23cb2
RS		 2484 if (p == read_buffer)
2485 cancel = 1;
03e88613
RS		 2486 continue;
2487 }
bed23cb2 2488
1571601b
KH		 2489 modifiers = c & CHAR_MODIFIER_MASK;
2490 c = c & ~CHAR_MODIFIER_MASK;
2491
8792be66 2492 if (CHAR_BYTE8_P (c))
e7fc914b 2493 force_singlebyte = 1;
8792be66 2494 else if (! ASCII_CHAR_P (c))
f6f79b37 2495 force_multibyte = 1;
8792be66 2496 else /* i.e. ASCII_CHAR_P (c) */
1571601b
KH		 2497 {
2498 /* Allow `\C- ' and `\C-?'. */
2499 if (modifiers == CHAR_CTL)
2500 {
2501 if (c == ' ')
2502 c = 0, modifiers = 0;
2503 else if (c == '?')
2504 c = 127, modifiers = 0;
2505 }
2506 if (modifiers & CHAR_SHIFT)
2507 {
2508 /* Shift modifier is valid only with [A-Za-z]. */
2509 if (c >= 'A' && c <= 'Z')
2510 modifiers &= ~CHAR_SHIFT;
2511 else if (c >= 'a' && c <= 'z')
2512 c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
2513 }
2514
2515 if (modifiers & CHAR_META)
2516 {
2517 /* Move the meta bit to the right place for a
2518 string. */
2519 modifiers &= ~CHAR_META;
2520 c = BYTE8_TO_CHAR (c | 0x80);
2521 force_singlebyte = 1;
2522 }
2523 }
5150eeec 2524
1571601b
KH		 2525 /* Any modifiers remaining are invalid. */
2526 if (modifiers)
2527 error ("Invalid modifier in string");
2528 p += CHAR_STRING (c, (unsigned char *) p);
078e7b4a 2529 }
8792be66 2530 else
5150eeec 2531 {
1571601b 2532 p += CHAR_STRING (c, (unsigned char *) p);
988f7a0c
KH		 2533 if (CHAR_BYTE8_P (c))
2534 force_singlebyte = 1;
2535 else if (! ASCII_CHAR_P (c))
2536 force_multibyte = 1;
f943104a 2537 }
5150eeec 2538 nchars++;
078e7b4a 2539 }
5150eeec 2540
6f7f43d5 2541 if (c < 0)
9c97398c 2542 end_of_file_error ();
078e7b4a
JB		 2543
2544 /* If purifying, and string starts with \ newline,
2545 return zero instead. This is for doc strings
08564963 2546 that we are really going to find in etc/DOC.nn.nn */
265a9e55 2547 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
078e7b4a
JB		 2548 return make_number (0);
2549
1571601b
KH		 2550 if (force_multibyte)
2551 /* READ_BUFFER already contains valid multibyte forms. */
5150eeec 2552 ;
1571601b 2553 else if (force_singlebyte)
a742d646 2554 {
1571601b
KH		 2555 nchars = str_as_unibyte (read_buffer, p - read_buffer);
2556 p = read_buffer + nchars;
a742d646 2557 }
e28552a4 2558 else
1571601b 2559 /* Otherwise, READ_BUFFER contains only ASCII. */
5150eeec 2560 ;
e7fc914b 2561
abb13b09
CW		 2562 /* We want readchar_count to be the number of characters, not
2563 bytes. Hence we adjust for multibyte characters in the
2564 string. ... But it doesn't seem to be necessary, because
2565 READCHAR *does* read multibyte characters from buffers. */
2566 /* readchar_count -= (p - read_buffer) - nchars; */
e7fc914b 2567 if (read_pure)
491f16a2 2568 return make_pure_string (read_buffer, nchars, p - read_buffer,
1571601b
KH		 2569 (force_multibyte
2570 || (p - read_buffer != nchars)));
491f16a2 2571 return make_specified_string (read_buffer, nchars, p - read_buffer,
1571601b
KH		 2572 (force_multibyte
2573 || (p - read_buffer != nchars)));
078e7b4a
JB		 2574 }
2575
109d300c
JB		 2576 case '.':
2577 {
109d300c
JB		 2578 int next_char = READCHAR;
2579 UNREAD (next_char);
2580
035eec48 2581 if (next_char <= 040
e613ea97
KH		 2582 || (next_char < 0200
2583 && index ("\"';([#?", next_char)
2584 || (!first_in_list && next_char == '`')
2585 || (new_backquote_flag && next_char == ',')))
109d300c 2586 {
6428369f
KH		 2587 *pch = c;
2588 return Qnil;
109d300c
JB		 2589 }
2590
2591 /* Otherwise, we fall through! Note that the atom-reading loop
2592 below will now loop at least once, assuring that we will not
2593 try to UNREAD two characters in a row. */
2594 }
078e7b4a 2595 default:
17634846 2596 default_label:
078e7b4a
JB		 2597 if (c <= 040) goto retry;
2598 {
38404229 2599 char *p = read_buffer;
481c6336 2600 int quoted = 0;
078e7b4a
JB		 2601
2602 {
38404229 2603 char *end = read_buffer + read_buffer_size;
078e7b4a 2604
6f7f43d5 2605 while (c > 040
e613ea97
KH		 2606 && (c >= 0200
2607 || (!index ("\"';()[]#", c)
2608 && !(!first_in_list && c == '`')
2609 && !(new_backquote_flag && c == ','))))
078e7b4a 2610 {
449fea39 2611 if (end - p < MAX_MULTIBYTE_LENGTH)
078e7b4a 2612 {
5d65df0d
GM		 2613 int offset = p - read_buffer;
2614 read_buffer = (char *) xrealloc (read_buffer,
2615 read_buffer_size *= 2);
2616 p = read_buffer + offset;
078e7b4a
JB		 2617 end = read_buffer + read_buffer_size;
2618 }
177c0ea7 2619
078e7b4a 2620 if (c == '\\')
481c6336
RS		 2621 {
2622 c = READCHAR;
4ab11c09
GM		 2623 if (c == -1)
2624 end_of_file_error ();
481c6336
RS		 2625 quoted = 1;
2626 }
6f7f43d5 2627
8792be66 2628 p += CHAR_STRING (c, p);
078e7b4a
JB		 2629 c = READCHAR;
2630 }
2631
2632 if (p == end)
2633 {
5d65df0d
GM		 2634 int offset = p - read_buffer;
2635 read_buffer = (char *) xrealloc (read_buffer,
2636 read_buffer_size *= 2);
2637 p = read_buffer + offset;
2638 end = read_buffer + read_buffer_size;
078e7b4a
JB		 2639 }
2640 *p = 0;
2641 if (c >= 0)
2642 UNREAD (c);
2643 }
2644
4ad679f9 2645 if (!quoted && !uninterned_symbol)
481c6336
RS		 2646 {
2647 register char *p1;
2648 register Lisp_Object val;
2649 p1 = read_buffer;
2650 if (*p1 == '+' || *p1 == '-') p1++;
2651 /* Is it an integer? */
2652 if (p1 != p)
2653 {
2654 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
481c6336
RS		 2655 /* Integers can have trailing decimal points. */
2656 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
481c6336
RS		 2657 if (p1 == p)
2658 /* It is an integer. */
2659 {
481c6336
RS		 2660 if (p1[-1] == '.')
2661 p1[-1] = '\0';
74214d16
DL		 2662 /* Fixme: if we have strtol, use that, and check
2663 for overflow. */
faca07fb
RS		 2664 if (sizeof (int) == sizeof (EMACS_INT))
2665 XSETINT (val, atoi (read_buffer));
2666 else if (sizeof (long) == sizeof (EMACS_INT))
2667 XSETINT (val, atol (read_buffer));
2668 else
2669 abort ();
481c6336
RS		 2670 return val;
2671 }
2672 }
481c6336 2673 if (isfloat_string (read_buffer))
eb659c41 2674 {
a8972052
PE		 2675 /* Compute NaN and infinities using 0.0 in a variable,
2676 to cope with compilers that think they are smarter
5e24a1f7 2677 than we are. */
3c329963 2678 double zero = 0.0;
a8972052
PE		 2679
2680 double value;
2681
2682 /* Negate the value ourselves. This treats 0, NaNs,
2683 and infinity properly on IEEE floating point hosts,
2684 and works around a common bug where atof ("-0.0")
2685 drops the sign. */
2686 int negative = read_buffer[0] == '-';
2687
2688 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
eb659c41 2689 returns 1, is if the input ends in e+INF or e+NaN. */
a8972052 2690 switch (p[-1])
eb659c41 2691 {
a8972052
PE		 2692 case 'F':
2693 value = 1.0 / zero;
2694 break;
2695 case 'N':
2696 value = zero / zero;
2697 break;
2698 default:
2699 value = atof (read_buffer + negative);
2700 break;
eb659c41 2701 }
a8972052
PE		 2702
2703 return make_float (negative ? - value : value);
eb659c41 2704 }
481c6336 2705 }
abb13b09
CW		 2706 {
2707 Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
2708 : intern (read_buffer);
2709 if (EQ (Vread_with_symbol_positions, Qt)
2710 || EQ (Vread_with_symbol_positions, readcharfun))
177c0ea7 2711 Vread_symbol_positions_list =
abb13b09
CW		 2712 /* Kind of a hack; this will probably fail if characters
2713 in the symbol name were escaped. Not really a big
2714 deal, though. */
f74db720
SM		 2715 Fcons (Fcons (result,
2716 make_number (readchar_count
2717 - XFASTINT (Flength (Fsymbol_name (result))))),
abb13b09
CW		 2718 Vread_symbol_positions_list);
2719 return result;
2720 }
078e7b4a
JB		 2721 }
2722 }
2723}
2724\f
9e062b6c
RS		 2725
2726/* List of nodes we've seen during substitute_object_in_subtree. */
2727static Lisp_Object seen_list;
2728
2729static void
2730substitute_object_in_subtree (object, placeholder)
2731 Lisp_Object object;
2732 Lisp_Object placeholder;
2733{
2734 Lisp_Object check_object;
2735
2736 /* We haven't seen any objects when we start. */
2737 seen_list = Qnil;
2738
2739 /* Make all the substitutions. */
2740 check_object
2741 = substitute_object_recurse (object, placeholder, object);
177c0ea7 2742
9e062b6c
RS		 2743 /* Clear seen_list because we're done with it. */
2744 seen_list = Qnil;
2745
2746 /* The returned object here is expected to always eq the
2747 original. */
2748 if (!EQ (check_object, object))
2749 error ("Unexpected mutation error in reader");
2750}
2751
2752/* Feval doesn't get called from here, so no gc protection is needed. */
2753#define SUBSTITUTE(get_val, set_val) \
2754{ \
2755 Lisp_Object old_value = get_val; \
2756 Lisp_Object true_value \
2757 = substitute_object_recurse (object, placeholder,\
2758 old_value); \
2759 \
2760 if (!EQ (old_value, true_value)) \
2761 { \
2762 set_val; \
2763 } \
2764}
2765
2766static Lisp_Object
2767substitute_object_recurse (object, placeholder, subtree)
2768 Lisp_Object object;
2769 Lisp_Object placeholder;
2770 Lisp_Object subtree;
2771{
2772 /* If we find the placeholder, return the target object. */
2773 if (EQ (placeholder, subtree))
2774 return object;
2775
2776 /* If we've been to this node before, don't explore it again. */
2777 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
2778 return subtree;
2779
2780 /* If this node can be the entry point to a cycle, remember that
2781 we've seen it. It can only be such an entry point if it was made
2782 by #n=, which means that we can find it as a value in
2783 read_objects. */
2784 if (!EQ (Qnil, Frassq (subtree, read_objects)))
2785 seen_list = Fcons (subtree, seen_list);
177c0ea7 2786
9e062b6c
RS		 2787 /* Recurse according to subtree's type.
2788 Every branch must return a Lisp_Object. */
2789 switch (XTYPE (subtree))
2790 {
2791 case Lisp_Vectorlike:
2792 {
2793 int i;
7c752c80 2794 int length = XINT (Flength(subtree));
9e062b6c
RS		 2795 for (i = 0; i < length; i++)
2796 {
2797 Lisp_Object idx = make_number (i);
2798 SUBSTITUTE (Faref (subtree, idx),
177c0ea7 2799 Faset (subtree, idx, true_value));
9e062b6c
RS		 2800 }
2801 return subtree;
2802 }
2803
2804 case Lisp_Cons:
2805 {
2806 SUBSTITUTE (Fcar_safe (subtree),
e61b9b87 2807 Fsetcar (subtree, true_value));
9e062b6c 2808 SUBSTITUTE (Fcdr_safe (subtree),
e61b9b87 2809 Fsetcdr (subtree, true_value));
9e062b6c
RS		 2810 return subtree;
2811 }
2812
9e062b6c
RS		 2813 case Lisp_String:
2814 {
2815 /* Check for text properties in each interval.
e61b9b87 2816 substitute_in_interval contains part of the logic. */
9e062b6c 2817
d5db4077 2818 INTERVAL root_interval = STRING_INTERVALS (subtree);
9e062b6c 2819 Lisp_Object arg = Fcons (object, placeholder);
177c0ea7 2820
0d74b006
SM		 2821 traverse_intervals_noorder (root_interval,
2822 &substitute_in_interval, arg);
9e062b6c
RS		 2823
2824 return subtree;
2825 }
9e062b6c
RS		 2826
2827 /* Other types don't recurse any further. */
2828 default:
2829 return subtree;
2830 }
2831}
2832
2833/* Helper function for substitute_object_recurse. */
2834static void
2835substitute_in_interval (interval, arg)
2836 INTERVAL interval;
2837 Lisp_Object arg;
2838{
2839 Lisp_Object object = Fcar (arg);
2840 Lisp_Object placeholder = Fcdr (arg);
2841
2842 SUBSTITUTE(interval->plist, interval->plist = true_value);
2843}
2844
2845\f
078e7b4a
JB		 2846#define LEAD_INT 1
2847#define DOT_CHAR 2
2848#define TRAIL_INT 4
2849#define E_CHAR 8
2850#define EXP_INT 16
2851
2852int
2853isfloat_string (cp)
2854 register char *cp;
2855{
c1a2f60a 2856 register int state;
177c0ea7 2857
d8578e58
RS		 2858 char *start = cp;
2859
078e7b4a
JB		 2860 state = 0;
2861 if (*cp == '+' || *cp == '-')
2862 cp++;
2863
075027b1 2864 if (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 2865 {
2866 state |= LEAD_INT;
075027b1
RS		 2867 while (*cp >= '0' && *cp <= '9')
2868 cp++;
078e7b4a
JB		 2869 }
2870 if (*cp == '.')
2871 {
2872 state |= DOT_CHAR;
2873 cp++;
2874 }
075027b1 2875 if (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 2876 {
2877 state |= TRAIL_INT;
075027b1 2878 while (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 2879 cp++;
2880 }
a35f88bf 2881 if (*cp == 'e' || *cp == 'E')
078e7b4a
JB		 2882 {
2883 state |= E_CHAR;
2884 cp++;
e73997a1
RS		 2885 if (*cp == '+' || *cp == '-')
2886 cp++;
078e7b4a 2887 }
078e7b4a 2888
075027b1 2889 if (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 2890 {
2891 state |= EXP_INT;
075027b1 2892 while (*cp >= '0' && *cp <= '9')
078e7b4a
JB		 2893 cp++;
2894 }
d8578e58
RS		 2895 else if (cp == start)
2896 ;
eb659c41
RS		 2897 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
2898 {
2899 state |= EXP_INT;
2900 cp += 3;
2901 }
2902 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
2903 {
2904 state |= EXP_INT;
2905 cp += 3;
2906 }
2907
37579d7c 2908 return (((*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
078e7b4a 2909 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
151bdc83 2910 || state == (DOT_CHAR|TRAIL_INT)
078e7b4a 2911 || state == (LEAD_INT|E_CHAR|EXP_INT)
151bdc83
JB		 2912 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2913 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
078e7b4a 2914}
cc94f3b2 2915
078e7b4a
JB		 2916\f
2917static Lisp_Object
c15cfd1f 2918read_vector (readcharfun, bytecodeflag)
078e7b4a 2919 Lisp_Object readcharfun;
c15cfd1f 2920 int bytecodeflag;
078e7b4a
JB		 2921{
2922 register int i;
2923 register int size;
2924 register Lisp_Object *ptr;
c15cfd1f 2925 register Lisp_Object tem, item, vector;
078e7b4a
JB		 2926 register struct Lisp_Cons *otem;
2927 Lisp_Object len;
2928
2929 tem = read_list (1, readcharfun);
2930 len = Flength (tem);
2931 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
2932
078e7b4a
JB		 2933 size = XVECTOR (vector)->size;
2934 ptr = XVECTOR (vector)->contents;
2935 for (i = 0; i < size; i++)
2936 {
c15cfd1f
RS		 2937 item = Fcar (tem);
2938 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2939 bytecode object, the docstring containing the bytecode and
2940 constants values must be treated as unibyte and passed to
2941 Fread, to get the actual bytecode string and constants vector. */
2942 if (bytecodeflag && load_force_doc_strings)
2943 {
2944 if (i == COMPILED_BYTECODE)
2945 {
2946 if (!STRINGP (item))
2947 error ("invalid byte code");
2948
2949 /* Delay handling the bytecode slot until we know whether
2950 it is lazily-loaded (we can tell by whether the
2951 constants slot is nil). */
2952 ptr[COMPILED_CONSTANTS] = item;
2953 item = Qnil;
2954 }
2955 else if (i == COMPILED_CONSTANTS)
2956 {
2957 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
2958
2959 if (NILP (item))
2960 {
2961 /* Coerce string to unibyte (like string-as-unibyte,
2962 but without generating extra garbage and
2963 guaranteeing no change in the contents). */
bee91904 2964 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
d5db4077 2965 STRING_SET_UNIBYTE (bytestr);
c15cfd1f 2966
8792be66 2967 item = Fread (Fcons (bytestr, readcharfun));
c15cfd1f
RS		 2968 if (!CONSP (item))
2969 error ("invalid byte code");
2970
2971 otem = XCONS (item);
c1d497be
KR		 2972 bytestr = XCAR (item);
2973 item = XCDR (item);
c15cfd1f
RS		 2974 free_cons (otem);
2975 }
2976
2977 /* Now handle the bytecode slot. */
2978 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
2979 }
8792be66
KH		 2980 else if (i == COMPILED_DOC_STRING
2981 && STRINGP (item)
2982 && ! STRING_MULTIBYTE (item))
2983 {
2984 if (EQ (readcharfun, Qget_emacs_mule_file_char))
2985 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
2986 else
2987 item = Fstring_as_multibyte (item);
2988 }
c15cfd1f
RS		 2989 }
2990 ptr[i] = read_pure ? Fpurecopy (item) : item;
078e7b4a
JB		 2991 otem = XCONS (tem);
2992 tem = Fcdr (tem);
2993 free_cons (otem);
2994 }
2995 return vector;
2996}
177c0ea7 2997
6f7f43d5
RS		 2998/* FLAG = 1 means check for ] to terminate rather than ) and .
2999 FLAG = -1 means check for starting with defun
078e7b4a
JB		 3000 and make structure pure. */
3001
3002static Lisp_Object
3003read_list (flag, readcharfun)
3004 int flag;
3005 register Lisp_Object readcharfun;
3006{
3007 /* -1 means check next element for defun,
3008 0 means don't check,
3009 1 means already checked and found defun. */
3010 int defunflag = flag < 0 ? -1 : 0;
3011 Lisp_Object val, tail;
3012 register Lisp_Object elt, tem;
3013 struct gcpro gcpro1, gcpro2;
821d417e 3014 /* 0 is the normal case.
b2a30870 3015 1 means this list is a doc reference; replace it with the number 0.
177c0ea7 3016 2 means this list is a doc reference; replace it with the doc string. */
821d417e 3017 int doc_reference = 0;
078e7b4a 3018
17634846
RS		 3019 /* Initialize this to 1 if we are reading a list. */
3020 int first_in_list = flag <= 0;
3021
078e7b4a
JB		 3022 val = Qnil;
3023 tail = Qnil;
3024
3025 while (1)
3026 {
e28552a4 3027 int ch;
078e7b4a 3028 GCPRO2 (val, tail);
17634846 3029 elt = read1 (readcharfun, &ch, first_in_list);
078e7b4a 3030 UNGCPRO;
20ea2964 3031
17634846
RS		 3032 first_in_list = 0;
3033
821d417e 3034 /* While building, if the list starts with #$, treat it specially. */
20ea2964 3035 if (EQ (elt, Vload_file_name)
d49f0c1a 3036 && ! NILP (elt)
821d417e
RS		 3037 && !NILP (Vpurify_flag))
3038 {
3039 if (NILP (Vdoc_file_name))
3040 /* We have not yet called Snarf-documentation, so assume
3041 this file is described in the DOC-MM.NN file
3042 and Snarf-documentation will fill in the right value later.
3043 For now, replace the whole list with 0. */
3044 doc_reference = 1;
3045 else
3046 /* We have already called Snarf-documentation, so make a relative
3047 file name for this file, so it can be found properly
3048 in the installed Lisp directory.
3049 We don't use Fexpand_file_name because that would make
3050 the directory absolute now. */
3051 elt = concat2 (build_string ("../lisp/"),
3052 Ffile_name_nondirectory (elt));
3053 }
b2a30870 3054 else if (EQ (elt, Vload_file_name)
d49f0c1a 3055 && ! NILP (elt)
b2a30870
RS		 3056 && load_force_doc_strings)
3057 doc_reference = 2;
20ea2964 3058
6428369f 3059 if (ch)
078e7b4a
JB		 3060 {
3061 if (flag > 0)
3062 {
6428369f 3063 if (ch == ']')
078e7b4a 3064 return val;
821d417e
RS		 3065 Fsignal (Qinvalid_read_syntax,
3066 Fcons (make_string (") or . in a vector", 18), Qnil));
078e7b4a 3067 }
6428369f 3068 if (ch == ')')
078e7b4a 3069 return val;
6428369f 3070 if (ch == '.')
078e7b4a
JB		 3071 {
3072 GCPRO2 (val, tail);
265a9e55 3073 if (!NILP (tail))
f5df591a 3074 XSETCDR (tail, read0 (readcharfun));
078e7b4a
JB		 3075 else
3076 val = read0 (readcharfun);
17634846 3077 read1 (readcharfun, &ch, 0);
078e7b4a 3078 UNGCPRO;
6428369f 3079 if (ch == ')')
821d417e
RS		 3080 {
3081 if (doc_reference == 1)
3082 return make_number (0);
b2a30870
RS		 3083 if (doc_reference == 2)
3084 {
3085 /* Get a doc string from the file we are loading.
8792be66
KH		 3086 If it's in saved_doc_string, get it from there.
3087
3088 Here, we don't know if the string is a
3089 bytecode string or a doc string. As a
3090 bytecode string must be unibyte, we always
3091 return a unibyte string. If it is actually a
3092 doc string, caller must make it
3093 multibyte. */
8f924df7 3094
c1d497be 3095 int pos = XINT (XCDR (val));
c15cfd1f
RS		 3096 /* Position is negative for user variables. */
3097 if (pos < 0) pos = -pos;
b2a30870
RS		 3098 if (pos >= saved_doc_string_position
3099 && pos < (saved_doc_string_position
3100 + saved_doc_string_length))
3101 {
3102 int start = pos - saved_doc_string_position;
3103 int from, to;
3104
3105 /* Process quoting with ^A,
3106 and find the end of the string,
3107 which is marked with ^_ (037). */
3108 for (from = start, to = start;
3109 saved_doc_string[from] != 037;)
3110 {
3111 int c = saved_doc_string[from++];
3112 if (c == 1)
3113 {
3114 c = saved_doc_string[from++];
3115 if (c == 1)
3116 saved_doc_string[to++] = c;
3117 else if (c == '0')
3118 saved_doc_string[to++] = 0;
3119 else if (c == '_')
3120 saved_doc_string[to++] = 037;
3121 }
3122 else
3123 saved_doc_string[to++] = c;
3124 }
3125
8792be66
KH		 3126 return make_unibyte_string (saved_doc_string + start,
3127 to - start);
b2a30870 3128 }
c15cfd1f
RS		 3129 /* Look in prev_saved_doc_string the same way. */
3130 else if (pos >= prev_saved_doc_string_position
3131 && pos < (prev_saved_doc_string_position
3132 + prev_saved_doc_string_length))
3133 {
3134 int start = pos - prev_saved_doc_string_position;
3135 int from, to;
3136
3137 /* Process quoting with ^A,
3138 and find the end of the string,
3139 which is marked with ^_ (037). */
3140 for (from = start, to = start;
3141 prev_saved_doc_string[from] != 037;)
3142 {
3143 int c = prev_saved_doc_string[from++];
3144 if (c == 1)
3145 {
3146 c = prev_saved_doc_string[from++];
3147 if (c == 1)
3148 prev_saved_doc_string[to++] = c;
3149 else if (c == '0')
3150 prev_saved_doc_string[to++] = 0;
3151 else if (c == '_')
3152 prev_saved_doc_string[to++] = 037;
3153 }
3154 else
3155 prev_saved_doc_string[to++] = c;
3156 }
3157
8792be66
KH		 3158 return make_unibyte_string (prev_saved_doc_string
3159 + start,
3160 to - start);
c15cfd1f 3161 }
b2a30870 3162 else
8792be66 3163 return get_doc_string (val, 1, 0);
b2a30870
RS		 3164 }
3165
821d417e
RS		 3166 return val;
3167 }
078e7b4a
JB		 3168 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
3169 }
3170 return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
3171 }
3172 tem = (read_pure && flag <= 0
3173 ? pure_cons (elt, Qnil)
3174 : Fcons (elt, Qnil));
265a9e55 3175 if (!NILP (tail))
f5df591a 3176 XSETCDR (tail, tem);
078e7b4a
JB		 3177 else
3178 val = tem;
3179 tail = tem;
3180 if (defunflag < 0)
3181 defunflag = EQ (elt, Qdefun);
3182 else if (defunflag > 0)
3183 read_pure = 1;
3184 }
3185}
3186\f
3187Lisp_Object Vobarray;
3188Lisp_Object initial_obarray;
3189
d007f5c8
RS		 3190/* oblookup stores the bucket number here, for the sake of Funintern. */
3191
3192int oblookup_last_bucket_number;
3193
3194static int hash_string ();
d007f5c8
RS		 3195
3196/* Get an error if OBARRAY is not an obarray.
3197 If it is one, return it. */
3198
078e7b4a
JB		 3199Lisp_Object
3200check_obarray (obarray)
3201 Lisp_Object obarray;
3202{
cfff016d 3203 while (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
078e7b4a
JB		 3204 {
3205 /* If Vobarray is now invalid, force it to be valid. */
3206 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
3207
3208 obarray = wrong_type_argument (Qvectorp, obarray);
3209 }
3210 return obarray;
3211}
3212
d007f5c8
RS		 3213/* Intern the C string STR: return a symbol with that name,
3214 interned in the current obarray. */
078e7b4a
JB		 3215
3216Lisp_Object
3217intern (str)
4b2dd274 3218 const char *str;
078e7b4a
JB		 3219{
3220 Lisp_Object tem;
3221 int len = strlen (str);
153a17b7 3222 Lisp_Object obarray;
078e7b4a 3223
153a17b7 3224 obarray = Vobarray;
cfff016d 3225 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
078e7b4a 3226 obarray = check_obarray (obarray);
e28552a4 3227 tem = oblookup (obarray, str, len, len);
cfff016d 3228 if (SYMBOLP (tem))
078e7b4a 3229 return tem;
87631ef7 3230 return Fintern (make_string (str, len), obarray);
078e7b4a 3231}
4ad679f9
EN		 3232
3233/* Create an uninterned symbol with name STR. */
3234
3235Lisp_Object
3236make_symbol (str)
3237 char *str;
3238{
3239 int len = strlen (str);
3240
3241 return Fmake_symbol ((!NILP (Vpurify_flag)
491f16a2 3242 ? make_pure_string (str, len, len, 0)
4ad679f9
EN		 3243 : make_string (str, len)));
3244}
d007f5c8 3245\f
078e7b4a 3246DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
5de38842
PJ		 3247 doc: /* Return the canonical symbol whose name is STRING.
3248If there is none, one is created by this function and returned.
3249A second optional argument specifies the obarray to use;
3250it defaults to the value of `obarray'. */)
3251 (string, obarray)
9391b698 3252 Lisp_Object string, obarray;
078e7b4a
JB		 3253{
3254 register Lisp_Object tem, sym, *ptr;
3255
265a9e55 3256 if (NILP (obarray)) obarray = Vobarray;
078e7b4a
JB		 3257 obarray = check_obarray (obarray);
3258
b7826503 3259 CHECK_STRING (string);
078e7b4a 3260
d5db4077
KR		 3261 tem = oblookup (obarray, SDATA (string),
3262 SCHARS (string),
3263 SBYTES (string));
cfff016d 3264 if (!INTEGERP (tem))
078e7b4a
JB		 3265 return tem;
3266
265a9e55 3267 if (!NILP (Vpurify_flag))
9391b698
EN		 3268 string = Fpurecopy (string);
3269 sym = Fmake_symbol (string);
44c6c019
GM		 3270
3271 if (EQ (obarray, initial_obarray))
3272 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3273 else
3274 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
078e7b4a 3275
d5db4077 3276 if ((SREF (string, 0) == ':')
a458d45d 3277 && EQ (obarray, initial_obarray))
44c6c019
GM		 3278 {
3279 XSYMBOL (sym)->constant = 1;
3280 XSYMBOL (sym)->value = sym;
3281 }
a0549832 3282
078e7b4a 3283 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
cfff016d 3284 if (SYMBOLP (*ptr))
078e7b4a
JB		 3285 XSYMBOL (sym)->next = XSYMBOL (*ptr);
3286 else
3287 XSYMBOL (sym)->next = 0;
3288 *ptr = sym;
3289 return sym;
3290}
3291
3292DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
5de38842
PJ		 3293 doc: /* Return the canonical symbol named NAME, or nil if none exists.
3294NAME may be a string or a symbol. If it is a symbol, that exact
3295symbol is searched for.
3296A second optional argument specifies the obarray to use;
3297it defaults to the value of `obarray'. */)
3298 (name, obarray)
b55048d4 3299 Lisp_Object name, obarray;
078e7b4a 3300{
c2d47f4b 3301 register Lisp_Object tem, string;
078e7b4a 3302
265a9e55 3303 if (NILP (obarray)) obarray = Vobarray;
078e7b4a
JB		 3304 obarray = check_obarray (obarray);
3305
b55048d4
GM		 3306 if (!SYMBOLP (name))
3307 {
b7826503 3308 CHECK_STRING (name);
c2d47f4b 3309 string = name;
b55048d4
GM		 3310 }
3311 else
c2d47f4b 3312 string = SYMBOL_NAME (name);
078e7b4a 3313
c2d47f4b 3314 tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
b55048d4
GM		 3315 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3316 return Qnil;
3317 else
078e7b4a 3318 return tem;
078e7b4a 3319}
d007f5c8
RS		 3320\f
3321DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
5de38842
PJ		 3322 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
3323The value is t if a symbol was found and deleted, nil otherwise.
3324NAME may be a string or a symbol. If it is a symbol, that symbol
3325is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3326OBARRAY defaults to the value of the variable `obarray'. */)
3327 (name, obarray)
d007f5c8
RS		 3328 Lisp_Object name, obarray;
3329{
3330 register Lisp_Object string, tem;
3331 int hash;
3332
3333 if (NILP (obarray)) obarray = Vobarray;
3334 obarray = check_obarray (obarray);
3335
3336 if (SYMBOLP (name))
d4c83cae 3337 string = SYMBOL_NAME (name);
d007f5c8
RS		 3338 else
3339 {
b7826503 3340 CHECK_STRING (name);
d007f5c8
RS		 3341 string = name;
3342 }
3343
d5db4077
KR		 3344 tem = oblookup (obarray, SDATA (string),
3345 SCHARS (string),
3346 SBYTES (string));
d007f5c8
RS		 3347 if (INTEGERP (tem))
3348 return Qnil;
3349 /* If arg was a symbol, don't delete anything but that symbol itself. */
3350 if (SYMBOLP (name) && !EQ (name, tem))
3351 return Qnil;
3352
44c6c019
GM		 3353 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3354 XSYMBOL (tem)->constant = 0;
3355 XSYMBOL (tem)->indirect_variable = 0;
ca69c42f 3356
d007f5c8
RS		 3357 hash = oblookup_last_bucket_number;
3358
3359 if (EQ (XVECTOR (obarray)->contents[hash], tem))
b2a30870
RS		 3360 {
3361 if (XSYMBOL (tem)->next)
3362 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3363 else
3364 XSETINT (XVECTOR (obarray)->contents[hash], 0);
3365 }
d007f5c8
RS		 3366 else
3367 {
3368 Lisp_Object tail, following;
3369
3370 for (tail = XVECTOR (obarray)->contents[hash];
3371 XSYMBOL (tail)->next;
3372 tail = following)
3373 {
3374 XSETSYMBOL (following, XSYMBOL (tail)->next);
3375 if (EQ (following, tem))
3376 {
3377 XSYMBOL (tail)->next = XSYMBOL (following)->next;
3378 break;
3379 }
3380 }
3381 }
3382
3383 return Qt;
3384}
3385\f
3386/* Return the symbol in OBARRAY whose names matches the string
e28552a4
RS		 3387 of SIZE characters (SIZE_BYTE bytes) at PTR.
3388 If there is no such symbol in OBARRAY, return nil.
d007f5c8
RS		 3389
3390 Also store the bucket number in oblookup_last_bucket_number. */
078e7b4a
JB		 3391
3392Lisp_Object
e28552a4 3393oblookup (obarray, ptr, size, size_byte)
078e7b4a 3394 Lisp_Object obarray;
4b2dd274 3395 register const char *ptr;
e28552a4 3396 int size, size_byte;
078e7b4a 3397{
7a70b397
RS		 3398 int hash;
3399 int obsize;
078e7b4a
JB		 3400 register Lisp_Object tail;
3401 Lisp_Object bucket, tem;
3402
cfff016d 3403 if (!VECTORP (obarray)
7c79a684 3404 || (obsize = XVECTOR (obarray)->size) == 0)
078e7b4a
JB		 3405 {
3406 obarray = check_obarray (obarray);
3407 obsize = XVECTOR (obarray)->size;
3408 }
519418b3
RS		 3409 /* This is sometimes needed in the middle of GC. */
3410 obsize &= ~ARRAY_MARK_FLAG;
078e7b4a 3411 /* Combining next two lines breaks VMS C 2.3. */
e28552a4 3412 hash = hash_string (ptr, size_byte);
078e7b4a
JB		 3413 hash %= obsize;
3414 bucket = XVECTOR (obarray)->contents[hash];
d007f5c8 3415 oblookup_last_bucket_number = hash;
078e7b4a
JB		 3416 if (XFASTINT (bucket) == 0)
3417 ;
cfff016d 3418 else if (!SYMBOLP (bucket))
078e7b4a 3419 error ("Bad data in guts of obarray"); /* Like CADR error message */
d007f5c8
RS		 3420 else
3421 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
078e7b4a 3422 {
d5db4077
KR		 3423 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3424 && SCHARS (SYMBOL_NAME (tail)) == size
3425 && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
078e7b4a
JB		 3426 return tail;
3427 else if (XSYMBOL (tail)->next == 0)
3428 break;
3429 }
1805de4f 3430 XSETINT (tem, hash);
078e7b4a
JB		 3431 return tem;
3432}
3433
3434static int
3435hash_string (ptr, len)
4b2dd274 3436 const unsigned char *ptr;
078e7b4a
JB		 3437 int len;
3438{
4b2dd274
KR		 3439 register const unsigned char *p = ptr;
3440 register const unsigned char *end = p + len;
078e7b4a
JB		 3441 register unsigned char c;
3442 register int hash = 0;
3443
3444 while (p != end)
3445 {
3446 c = *p++;
3447 if (c >= 0140) c -= 40;
3448 hash = ((hash<<3) + (hash>>28) + c);
3449 }
3450 return hash & 07777777777;
3451}
d007f5c8 3452\f
078e7b4a
JB		 3453void
3454map_obarray (obarray, fn, arg)
3455 Lisp_Object obarray;
d5b28a9d 3456 void (*fn) P_ ((Lisp_Object, Lisp_Object));
078e7b4a
JB		 3457 Lisp_Object arg;
3458{
3459 register int i;
3460 register Lisp_Object tail;
b7826503 3461 CHECK_VECTOR (obarray);
078e7b4a
JB		 3462 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
3463 {
3464 tail = XVECTOR (obarray)->contents[i];
4f5c4403 3465 if (SYMBOLP (tail))
078e7b4a
JB		 3466 while (1)
3467 {
3468 (*fn) (tail, arg);
3469 if (XSYMBOL (tail)->next == 0)
3470 break;
1805de4f 3471 XSETSYMBOL (tail, XSYMBOL (tail)->next);
078e7b4a
JB		 3472 }
3473 }
3474}
3475
d5b28a9d 3476void
078e7b4a
JB		 3477mapatoms_1 (sym, function)
3478 Lisp_Object sym, function;
3479{
3480 call1 (function, sym);
3481}
3482
3483DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
5de38842
PJ		 3484 doc: /* Call FUNCTION on every symbol in OBARRAY.
3485OBARRAY defaults to the value of `obarray'. */)
3486 (function, obarray)
078e7b4a
JB		 3487 Lisp_Object function, obarray;
3488{
265a9e55 3489 if (NILP (obarray)) obarray = Vobarray;
078e7b4a
JB		 3490 obarray = check_obarray (obarray);
3491
3492 map_obarray (obarray, mapatoms_1, function);
3493 return Qnil;
3494}
3495
5e88a39e 3496#define OBARRAY_SIZE 1511
078e7b4a
JB		 3497
3498void
3499init_obarray ()
3500{
3501 Lisp_Object oblength;
3502 int hash;
3503 Lisp_Object *tem;
3504
baf69866 3505 XSETFASTINT (oblength, OBARRAY_SIZE);
078e7b4a 3506
491f16a2 3507 Qnil = Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
078e7b4a
JB		 3508 Vobarray = Fmake_vector (oblength, make_number (0));
3509 initial_obarray = Vobarray;
3510 staticpro (&initial_obarray);
3511 /* Intern nil in the obarray */
44c6c019
GM		 3512 XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3513 XSYMBOL (Qnil)->constant = 1;
177c0ea7 3514
078e7b4a
JB		 3515 /* These locals are to kludge around a pyramid compiler bug. */
3516 hash = hash_string ("nil", 3);
3517 /* Separate statement here to avoid VAXC bug. */
3518 hash %= OBARRAY_SIZE;
3519 tem = &XVECTOR (Vobarray)->contents[hash];
3520 *tem = Qnil;
3521
491f16a2 3522 Qunbound = Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
078e7b4a
JB		 3523 XSYMBOL (Qnil)->function = Qunbound;
3524 XSYMBOL (Qunbound)->value = Qunbound;
3525 XSYMBOL (Qunbound)->function = Qunbound;
3526
3527 Qt = intern ("t");
3528 XSYMBOL (Qnil)->value = Qnil;
3529 XSYMBOL (Qnil)->plist = Qnil;
3530 XSYMBOL (Qt)->value = Qt;
44c6c019 3531 XSYMBOL (Qt)->constant = 1;
078e7b4a
JB		 3532
3533 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3534 Vpurify_flag = Qt;
3535
3536 Qvariable_documentation = intern ("variable-documentation");
0f73bb1c 3537 staticpro (&Qvariable_documentation);
078e7b4a 3538
449fea39 3539 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
3cb65b0e 3540 read_buffer = (char *) xmalloc (read_buffer_size);
078e7b4a
JB		 3541}
3542\f
3543void
3544defsubr (sname)
3545 struct Lisp_Subr *sname;
3546{
3547 Lisp_Object sym;
3548 sym = intern (sname->symbol_name);
1805de4f 3549 XSETSUBR (XSYMBOL (sym)->function, sname);
078e7b4a
JB		 3550}
3551
3552#ifdef NOTDEF /* use fset in subr.el now */
3553void
3554defalias (sname, string)
3555 struct Lisp_Subr *sname;
3556 char *string;
3557{
3558 Lisp_Object sym;
3559 sym = intern (string);
1805de4f 3560 XSETSUBR (XSYMBOL (sym)->function, sname);
078e7b4a
JB		 3561}
3562#endif /* NOTDEF */
3563
078e7b4a 3564/* Define an "integer variable"; a symbol whose value is forwarded
1a0f90f7 3565 to a C variable of type int. Sample call: */
5de38842 3566 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
078e7b4a 3567void
e9e00ff2 3568defvar_int (namestring, address)
078e7b4a 3569 char *namestring;
31ade731 3570 EMACS_INT *address;
078e7b4a 3571{
1a0f90f7 3572 Lisp_Object sym, val;
078e7b4a 3573 sym = intern (namestring);
1a0f90f7 3574 val = allocate_misc ();
47e28b2c 3575 XMISCTYPE (val) = Lisp_Misc_Intfwd;
fc1e7df5 3576 XINTFWD (val)->intvar = address;
44c6c019 3577 SET_SYMBOL_VALUE (sym, val);
078e7b4a
JB		 3578}
3579
f0529b5b
PJ		 3580/* Similar but define a variable whose value is t if address contains 1,
3581 nil if address contains 0 */
078e7b4a 3582void
e9e00ff2 3583defvar_bool (namestring, address)
078e7b4a
JB		 3584 char *namestring;
3585 int *address;
078e7b4a 3586{
1a0f90f7 3587 Lisp_Object sym, val;
078e7b4a 3588 sym = intern (namestring);
1a0f90f7 3589 val = allocate_misc ();
47e28b2c 3590 XMISCTYPE (val) = Lisp_Misc_Boolfwd;
fc1e7df5 3591 XBOOLFWD (val)->boolvar = address;
44c6c019 3592 SET_SYMBOL_VALUE (sym, val);
1ffcc3b1 3593 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
078e7b4a
JB		 3594}
3595
1a0f90f7
KH		 3596/* Similar but define a variable whose value is the Lisp Object stored
3597 at address. Two versions: with and without gc-marking of the C
3598 variable. The nopro version is used when that variable will be
3599 gc-marked for some other reason, since marking the same slot twice
3600 can cause trouble with strings. */
078e7b4a 3601void
1a0f90f7 3602defvar_lisp_nopro (namestring, address)
078e7b4a
JB		 3603 char *namestring;
3604 Lisp_Object *address;
078e7b4a 3605{
1a0f90f7 3606 Lisp_Object sym, val;
078e7b4a 3607 sym = intern (namestring);
1a0f90f7 3608 val = allocate_misc ();
47e28b2c 3609 XMISCTYPE (val) = Lisp_Misc_Objfwd;
fc1e7df5 3610 XOBJFWD (val)->objvar = address;
44c6c019 3611 SET_SYMBOL_VALUE (sym, val);
078e7b4a
JB		 3612}
3613
078e7b4a 3614void
1a0f90f7 3615defvar_lisp (namestring, address)
078e7b4a
JB		 3616 char *namestring;
3617 Lisp_Object *address;
078e7b4a 3618{
1a0f90f7
KH		 3619 defvar_lisp_nopro (namestring, address);
3620 staticpro (address);
078e7b4a
JB		 3621}
3622
078e7b4a 3623/* Similar but define a variable whose value is the Lisp Object stored in
2836d9a4
KH		 3624 the current buffer. address is the address of the slot in the buffer
3625 that is current now. */
078e7b4a
JB		 3626
3627void
4360b0c6 3628defvar_per_buffer (namestring, address, type, doc)
078e7b4a
JB		 3629 char *namestring;
3630 Lisp_Object *address;
4360b0c6 3631 Lisp_Object type;
078e7b4a
JB		 3632 char *doc;
3633{
1a0f90f7 3634 Lisp_Object sym, val;
078e7b4a 3635 int offset;
078e7b4a
JB		 3636
3637 sym = intern (namestring);
1a0f90f7 3638 val = allocate_misc ();
078e7b4a
JB		 3639 offset = (char *)address - (char *)current_buffer;
3640
47e28b2c 3641 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
fc1e7df5 3642 XBUFFER_OBJFWD (val)->offset = offset;
44c6c019 3643 SET_SYMBOL_VALUE (sym, val);
11fd416e
GM		 3644 PER_BUFFER_SYMBOL (offset) = sym;
3645 PER_BUFFER_TYPE (offset) = type;
177c0ea7 3646
11fd416e 3647 if (PER_BUFFER_IDX (offset) == 0)
078e7b4a
JB		 3648 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3649 slot of buffer_local_flags */
3650 abort ();
3651}
3652
950c215d
KH		 3653
3654/* Similar but define a variable whose value is the Lisp Object stored
4ac38690 3655 at a particular offset in the current kboard object. */
950c215d
KH		 3656
3657void
4ac38690 3658defvar_kboard (namestring, offset)
950c215d
KH		 3659 char *namestring;
3660 int offset;
3661{
3662 Lisp_Object sym, val;
3663 sym = intern (namestring);
3664 val = allocate_misc ();
47e28b2c 3665 XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd;
4ac38690 3666 XKBOARD_OBJFWD (val)->offset = offset;
44c6c019 3667 SET_SYMBOL_VALUE (sym, val);
950c215d 3668}
078e7b4a 3669\f
11938f10
KH		 3670/* Record the value of load-path used at the start of dumping
3671 so we can see if the site changed it later during dumping. */
3672static Lisp_Object dump_path;
3673
d5b28a9d 3674void
279499f0 3675init_lread ()
078e7b4a 3676{
46947372 3677 char *normal;
e73997a1 3678 int turn_off_warning = 0;
078e7b4a 3679
279499f0 3680 /* Compute the default load-path. */
46947372
JB		 3681#ifdef CANNOT_DUMP
3682 normal = PATH_LOADSEARCH;
e065a56e 3683 Vload_path = decode_env_path (0, normal);
46947372
JB		 3684#else
3685 if (NILP (Vpurify_flag))
3686 normal = PATH_LOADSEARCH;
279499f0 3687 else
46947372 3688 normal = PATH_DUMPLOADSEARCH;
279499f0 3689
46947372
JB		 3690 /* In a dumped Emacs, we normally have to reset the value of
3691 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3692 uses ../lisp, instead of the path of the installed elisp
3693 libraries. However, if it appears that Vload_path was changed
3694 from the default before dumping, don't override that value. */
4746118a
JB		 3695 if (initialized)
3696 {
4746118a 3697 if (! NILP (Fequal (dump_path, Vload_path)))
80667d53
RS		 3698 {
3699 Vload_path = decode_env_path (0, normal);
74180aa4 3700 if (!NILP (Vinstallation_directory))
80667d53 3701 {
3ddff138
RS		 3702 Lisp_Object tem, tem1, sitelisp;
3703
3704 /* Remove site-lisp dirs from path temporarily and store
3705 them in sitelisp, then conc them on at the end so
3706 they're always first in path. */
3707 sitelisp = Qnil;
3708 while (1)
3709 {
3710 tem = Fcar (Vload_path);
3711 tem1 = Fstring_match (build_string ("site-lisp"),
3712 tem, Qnil);
3713 if (!NILP (tem1))
3714 {
3715 Vload_path = Fcdr (Vload_path);
3716 sitelisp = Fcons (tem, sitelisp);
3717 }
3718 else
3719 break;
3720 }
3721
74180aa4 3722 /* Add to the path the lisp subdir of the
3a3056e5 3723 installation dir, if it exists. */
74180aa4
RS		 3724 tem = Fexpand_file_name (build_string ("lisp"),
3725 Vinstallation_directory);
3a3056e5
RS		 3726 tem1 = Ffile_exists_p (tem);
3727 if (!NILP (tem1))
3728 {
3729 if (NILP (Fmember (tem, Vload_path)))
e73997a1
RS		 3730 {
3731 turn_off_warning = 1;
3ddff138 3732 Vload_path = Fcons (tem, Vload_path);
e73997a1 3733 }
3a3056e5
RS		 3734 }
3735 else
3736 /* That dir doesn't exist, so add the build-time
3737 Lisp dirs instead. */
3738 Vload_path = nconc2 (Vload_path, dump_path);
c478f98c 3739
9fbc0116
RS		 3740 /* Add leim under the installation dir, if it exists. */
3741 tem = Fexpand_file_name (build_string ("leim"),
3742 Vinstallation_directory);
3743 tem1 = Ffile_exists_p (tem);
3744 if (!NILP (tem1))
3745 {
3746 if (NILP (Fmember (tem, Vload_path)))
3ddff138 3747 Vload_path = Fcons (tem, Vload_path);
9fbc0116
RS		 3748 }
3749
c478f98c
RS		 3750 /* Add site-list under the installation dir, if it exists. */
3751 tem = Fexpand_file_name (build_string ("site-lisp"),
3752 Vinstallation_directory);
3753 tem1 = Ffile_exists_p (tem);
3754 if (!NILP (tem1))
3755 {
3756 if (NILP (Fmember (tem, Vload_path)))
3ddff138 3757 Vload_path = Fcons (tem, Vload_path);
c478f98c 3758 }
0f337465
RS		 3759
3760 /* If Emacs was not built in the source directory,
9fbc0116
RS		 3761 and it is run from where it was built, add to load-path
3762 the lisp, leim and site-lisp dirs under that directory. */
0f337465
RS		 3763
3764 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
3765 {
33046fc9
RS		 3766 Lisp_Object tem2;
3767
0f337465
RS		 3768 tem = Fexpand_file_name (build_string ("src/Makefile"),
3769 Vinstallation_directory);
3770 tem1 = Ffile_exists_p (tem);
33046fc9
RS		 3771
3772 /* Don't be fooled if they moved the entire source tree
3773 AFTER dumping Emacs. If the build directory is indeed
3774 different from the source dir, src/Makefile.in and
3775 src/Makefile will not be found together. */
3776 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
3777 Vinstallation_directory);
3778 tem2 = Ffile_exists_p (tem);
3779 if (!NILP (tem1) && NILP (tem2))
0f337465
RS		 3780 {
3781 tem = Fexpand_file_name (build_string ("lisp"),
3782 Vsource_directory);
3783
3784 if (NILP (Fmember (tem, Vload_path)))
3ddff138 3785 Vload_path = Fcons (tem, Vload_path);
0f337465 3786
9fbc0116
RS		 3787 tem = Fexpand_file_name (build_string ("leim"),
3788 Vsource_directory);
3789
3790 if (NILP (Fmember (tem, Vload_path)))
3ddff138 3791 Vload_path = Fcons (tem, Vload_path);
9fbc0116 3792
0f337465
RS		 3793 tem = Fexpand_file_name (build_string ("site-lisp"),
3794 Vsource_directory);
3795
3796 if (NILP (Fmember (tem, Vload_path)))
3ddff138 3797 Vload_path = Fcons (tem, Vload_path);
0f337465
RS		 3798 }
3799 }
3ddff138
RS		 3800 if (!NILP (sitelisp))
3801 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
80667d53
RS		 3802 }
3803 }
4746118a
JB		 3804 }
3805 else
11938f10 3806 {
7b396c6c
RS		 3807 /* NORMAL refers to the lisp dir in the source directory. */
3808 /* We used to add ../lisp at the front here, but
3809 that caused trouble because it was copied from dump_path
3810 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3811 It should be unnecessary. */
3812 Vload_path = decode_env_path (0, normal);
11938f10
KH		 3813 dump_path = Vload_path;
3814 }
46947372 3815#endif
279499f0 3816
317073d5 3817#ifndef WINDOWSNT
177c0ea7
JB		 3818 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3819 almost never correct, thereby causing a warning to be printed out that
8e6208c5 3820 confuses users. Since PATH_LOADSEARCH is always overridden by the
317073d5
RS		 3821 EMACSLOADPATH environment variable below, disable the warning on NT. */
3822
078e7b4a 3823 /* Warn if dirs in the *standard* path don't exist. */
e73997a1
RS		 3824 if (!turn_off_warning)
3825 {
3826 Lisp_Object path_tail;
078e7b4a 3827
e73997a1
RS		 3828 for (path_tail = Vload_path;
3829 !NILP (path_tail);
c1d497be 3830 path_tail = XCDR (path_tail))
e73997a1
RS		 3831 {
3832 Lisp_Object dirfile;
3833 dirfile = Fcar (path_tail);
3834 if (STRINGP (dirfile))
3835 {
3836 dirfile = Fdirectory_file_name (dirfile);
d5db4077 3837 if (access (SDATA (dirfile), 0) < 0)
85496b8c 3838 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
c1d497be 3839 XCAR (path_tail));
e73997a1
RS		 3840 }
3841 }
3842 }
317073d5 3843#endif /* WINDOWSNT */
46947372
JB		 3844
3845 /* If the EMACSLOADPATH environment variable is set, use its value.
3846 This doesn't apply if we're dumping. */
ffd9c2a1 3847#ifndef CANNOT_DUMP
46947372
JB		 3848 if (NILP (Vpurify_flag)
3849 && egetenv ("EMACSLOADPATH"))
ffd9c2a1 3850#endif
279499f0 3851 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
279499f0
JB		 3852
3853 Vvalues = Qnil;
3854
078e7b4a 3855 load_in_progress = 0;
4e53f562 3856 Vload_file_name = Qnil;
d2c6be7f
RS		 3857
3858 load_descriptor_list = Qnil;
8f6b0411
RS		 3859
3860 Vstandard_input = Qt;
f74b0705 3861 Vloads_in_progress = Qnil;
078e7b4a
JB		 3862}
3863
85496b8c
RS		 3864/* Print a warning, using format string FORMAT, that directory DIRNAME
3865 does not exist. Print it on stderr and put it in *Message*. */
3866
d5b28a9d 3867void
85496b8c
RS		 3868dir_warning (format, dirname)
3869 char *format;
3870 Lisp_Object dirname;
3871{
3872 char *buffer
d5db4077 3873 = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
85496b8c 3874
d5db4077
KR		 3875 fprintf (stderr, format, SDATA (dirname));
3876 sprintf (buffer, format, SDATA (dirname));
9b69357e
GV		 3877 /* Don't log the warning before we've initialized!! */
3878 if (initialized)
3879 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
85496b8c
RS		 3880}
3881
078e7b4a 3882void
279499f0 3883syms_of_lread ()
078e7b4a
JB		 3884{
3885 defsubr (&Sread);
3886 defsubr (&Sread_from_string);
3887 defsubr (&Sintern);
3888 defsubr (&Sintern_soft);
d007f5c8 3889 defsubr (&Sunintern);
078e7b4a 3890 defsubr (&Sload);
228d4b1c 3891 defsubr (&Seval_buffer);
078e7b4a
JB		 3892 defsubr (&Seval_region);
3893 defsubr (&Sread_char);
3894 defsubr (&Sread_char_exclusive);
078e7b4a 3895 defsubr (&Sread_event);
078e7b4a
JB		 3896 defsubr (&Sget_file_char);
3897 defsubr (&Smapatoms);
86d00812 3898 defsubr (&Slocate_file_internal);
078e7b4a
JB		 3899
3900 DEFVAR_LISP ("obarray", &Vobarray,
5de38842
PJ		 3901 doc: /* Symbol table for use by `intern' and `read'.
3902It is a vector whose length ought to be prime for best results.
3903The vector's contents don't make sense if examined from Lisp programs;
3904to find all the symbols in an obarray, use `mapatoms'. */);
078e7b4a
JB		 3905
3906 DEFVAR_LISP ("values", &Vvalues,
5de38842
PJ		 3907 doc: /* List of values of all expressions which were read, evaluated and printed.
3908Order is reverse chronological. */);
078e7b4a
JB		 3909
3910 DEFVAR_LISP ("standard-input", &Vstandard_input,
5de38842
PJ		 3911 doc: /* Stream for read to get input from.
3912See documentation of `read' for possible values. */);
078e7b4a
JB		 3913 Vstandard_input = Qt;
3914
abb13b09
CW		 3915 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
3916 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3917
3918If this variable is a buffer, then only forms read from that buffer
3919will be added to `read-symbol-positions-list'.
3920If this variable is t, then all read forms will be added.
3921The effect of all other values other than nil are not currently
3922defined, although they may be in the future.
3923
3924The positions are relative to the last call to `read' or
3925`read-from-string'. It is probably a bad idea to set this variable at
3926the toplevel; bind it instead. */);
3927 Vread_with_symbol_positions = Qnil;
3928
3929 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
d6567030 3930 doc: /* A list mapping read symbols to their positions.
abb13b09
CW		 3931This variable is modified during calls to `read' or
3932`read-from-string', but only when `read-with-symbol-positions' is
3933non-nil.
3934
3935Each element of the list looks like (SYMBOL . CHAR-POSITION), where
d6567030 3936CHAR-POSITION is an integer giving the offset of that occurrence of the
abb13b09
CW		 3937symbol from the position where `read' or `read-from-string' started.
3938
3939Note that a symbol will appear multiple times in this list, if it was
3940read multiple times. The list is in the same order as the symbols
3941were read in. */);
177c0ea7 3942 Vread_symbol_positions_list = Qnil;
abb13b09 3943
078e7b4a 3944 DEFVAR_LISP ("load-path", &Vload_path,
5de38842
PJ		 3945 doc: /* *List of directories to search for files to load.
3946Each element is a string (directory name) or nil (try default directory).
3947Initialized based on EMACSLOADPATH environment variable, if any,
3948otherwise to default specified by file `epaths.h' when Emacs was built. */);
078e7b4a 3949
e61b9b87 3950 DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
5de38842
PJ		 3951 doc: /* *List of suffixes to try for files to load.
3952This list should not include the empty string. */);
e61b9b87
SM		 3953 Vload_suffixes = Fcons (build_string (".elc"),
3954 Fcons (build_string (".el"), Qnil));
ddb716ef
SM		 3955 /* We don't use empty_string because it's not initialized yet. */
3956 default_suffixes = Fcons (build_string (""), Qnil);
e61b9b87
SM		 3957 staticpro (&default_suffixes);
3958
078e7b4a 3959 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
5de38842 3960 doc: /* Non-nil iff inside of `load'. */);
078e7b4a
JB		 3961
3962 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
5de38842
PJ		 3963 doc: /* An alist of expressions to be evalled when particular files are loaded.
3964Each element looks like (FILENAME FORMS...).
3965When `load' is run and the file-name argument is FILENAME,
3966the FORMS in the corresponding element are executed at the end of loading.
3967
3968FILENAME must match exactly! Normally FILENAME is the name of a library,
3969with no directory specified, since that is how `load' is normally called.
3970An error in FORMS does not undo the load,
3971but does prevent execution of the rest of the FORMS.
3972FILENAME can also be a symbol (a feature) and FORMS are then executed
3973when the corresponding call to `provide' is made. */);
078e7b4a
JB		 3974 Vafter_load_alist = Qnil;
3975
ae321d28 3976 DEFVAR_LISP ("load-history", &Vload_history,
5de38842
PJ		 3977 doc: /* Alist mapping source file names to symbols and features.
3978Each alist element is a list that starts with a file name,
3979except for one element (optional) that starts with nil and describes
3980definitions evaluated from buffers not visiting files.
d642e4f9
RS		 3981The remaining elements of each list are symbols defined as functions,
3982and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
6042a06e
RS		 3983`(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'.
3984An element `(t . SYMBOL)' precedes an entry that is just SYMBOL,
3985and means that SYMBOL was an autoload before this file redefined it
3986as a function. */);
ae321d28
RS		 3987 Vload_history = Qnil;
3988
20ea2964 3989 DEFVAR_LISP ("load-file-name", &Vload_file_name,
5de38842 3990 doc: /* Full name of file being loaded by `load'. */);
20ea2964
RS		 3991 Vload_file_name = Qnil;
3992
4116ab9f 3993 DEFVAR_LISP ("user-init-file", &Vuser_init_file,
5de38842
PJ		 3994 doc: /* File name, including directory, of user's initialization file.
3995If the file loaded had extension `.elc' and there was a corresponding `.el'
3996file, this variable contains the name of the .el file, suitable for use
3997by functions like `custom-save-all' which edit the init file. */);
4116ab9f
KH		 3998 Vuser_init_file = Qnil;
3999
8a1f1537 4000 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
5de38842 4001 doc: /* Used for internal purposes by `load'. */);
ae321d28
RS		 4002 Vcurrent_load_list = Qnil;
4003
84a15045 4004 DEFVAR_LISP ("load-read-function", &Vload_read_function,
5de38842
PJ		 4005 doc: /* Function used by `load' and `eval-region' for reading expressions.
4006The default is nil, which means use the function `read'. */);
84a15045
RS		 4007 Vload_read_function = Qnil;
4008
fe0e03f3 4009 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
5de38842
PJ		 4010 doc: /* Function called in `load' for loading an Emacs lisp source file.
4011This function is for doing code conversion before reading the source file.
4012If nil, loading is done without any code conversion.
4013Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4014 FULLNAME is the full name of FILE.
4015See `load' for the meaning of the remaining arguments. */);
fe0e03f3
KH		 4016 Vload_source_file_function = Qnil;
4017
b2a30870 4018 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
5de38842
PJ		 4019 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
4020This is useful when the file being loaded is a temporary copy. */);
b2a30870
RS		 4021 load_force_doc_strings = 0;
4022
94e554db 4023 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
5de38842
PJ		 4024 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
4025This is normally bound by `load' and `eval-buffer' to control `read',
4026and is not meant for users to change. */);
94e554db
RS		 4027 load_convert_to_unibyte = 0;
4028
1521a8fa 4029 DEFVAR_LISP ("source-directory", &Vsource_directory,
5de38842
PJ		 4030 doc: /* Directory in which Emacs sources were found when Emacs was built.
4031You cannot count on them to still be there! */);
a90ba1e2
KH		 4032 Vsource_directory
4033 = Fexpand_file_name (build_string ("../"),
4034 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
4035
4b104c41 4036 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
5de38842 4037 doc: /* List of files that were preloaded (when dumping Emacs). */);
4b104c41
RS		 4038 Vpreloaded_file_list = Qnil;
4039
1ffcc3b1 4040 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
5de38842 4041 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
1ffcc3b1
DL		 4042 Vbyte_boolean_vars = Qnil;
4043
da84f340 4044 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
5de38842
PJ		 4045 doc: /* Non-nil means load dangerous compiled Lisp files.
4046Some versions of XEmacs use different byte codes than Emacs. These
4047incompatible byte codes can make Emacs crash when it tries to execute
4048them. */);
da84f340
GM		 4049 load_dangerous_libraries = 0;
4050
bb970e67 4051 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
5de38842
PJ		 4052 doc: /* Regular expression matching safe to load compiled Lisp files.
4053When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4054from the file, and matches them against this regular expression.
4055When the regular expression matches, the file is considered to be safe
4056to load. See also `load-dangerous-libraries'. */);
bb970e67 4057 Vbytecomp_version_regexp
f2e7d5eb 4058 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
da84f340 4059
a90ba1e2
KH		 4060 /* Vsource_directory was initialized in init_lread. */
4061
d2c6be7f
RS		 4062 load_descriptor_list = Qnil;
4063 staticpro (&load_descriptor_list);
4064
8a1f1537
RS		 4065 Qcurrent_load_list = intern ("current-load-list");
4066 staticpro (&Qcurrent_load_list);
4067
078e7b4a
JB		 4068 Qstandard_input = intern ("standard-input");
4069 staticpro (&Qstandard_input);
4070
4071 Qread_char = intern ("read-char");
4072 staticpro (&Qread_char);
4073
4074 Qget_file_char = intern ("get-file-char");
4075 staticpro (&Qget_file_char);
7bd279cd 4076
8792be66
KH		 4077 Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char");
4078 staticpro (&Qget_emacs_mule_file_char);
4079
4080 Qload_force_doc_strings = intern ("load-force-doc-strings");
4081 staticpro (&Qload_force_doc_strings);
4082
17634846
RS		 4083 Qbackquote = intern ("`");
4084 staticpro (&Qbackquote);
4085 Qcomma = intern (",");
4086 staticpro (&Qcomma);
4087 Qcomma_at = intern (",@");
4088 staticpro (&Qcomma_at);
4089 Qcomma_dot = intern (",.");
4090 staticpro (&Qcomma_dot);
4091
74549846
RS		 4092 Qinhibit_file_name_operation = intern ("inhibit-file-name-operation");
4093 staticpro (&Qinhibit_file_name_operation);
4094
7bd279cd
RS		 4095 Qascii_character = intern ("ascii-character");
4096 staticpro (&Qascii_character);
c2225d00 4097
2b6cae0c
RS		 4098 Qfunction = intern ("function");
4099 staticpro (&Qfunction);
4100
c2225d00
RS		 4101 Qload = intern ("load");
4102 staticpro (&Qload);
20ea2964
RS		 4103
4104 Qload_file_name = intern ("load-file-name");
4105 staticpro (&Qload_file_name);
11938f10
KH		 4106
4107 staticpro (&dump_path);
4ad679f9
EN		 4108
4109 staticpro (&read_objects);
4110 read_objects = Qnil;
9e062b6c 4111 staticpro (&seen_list);
177c0ea7 4112
7ee3bd7b
GM		 4113 Vloads_in_progress = Qnil;
4114 staticpro (&Vloads_in_progress);
078e7b4a 4115}
6b61353c
KH		 4116
4117/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4118 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.