1 /* Lisp parsing and input streams.
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems.
4 Copyright (C) 1996 Ben Wing.
6 This file is part of XEmacs.
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 /* Synched up with: Mule 2.0, FSF 19.30. */
25 /* This file has been Mule-ized. */
36 #include "file-coding.h"
41 #ifdef LISP_FLOAT_TYPE
42 #define THIS_FILENAME lread
44 #endif /* LISP_FLOAT_TYPE */
46 Lisp_Object Qread_char, Qstandard_input;
47 Lisp_Object Qvariable_documentation;
48 #define LISP_BACKQUOTES
49 #ifdef LISP_BACKQUOTES
51 Nonzero means inside a new-style backquote
52 with no surrounding parentheses.
53 Fread initializes this to zero, so we need not specbind it
54 or worry about what happens to it when there is an error.
57 Nested backquotes are perfectly legal and fail utterly with
59 static int new_backquote_flag, old_backquote_flag;
60 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
62 Lisp_Object Qvariable_domain; /* I18N3 */
63 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
64 Lisp_Object Qcurrent_load_list;
65 Lisp_Object Qload, Qload_file_name;
68 /* Hash-table that maps directory names to hashes of their contents. */
69 static Lisp_Object Vlocate_file_hash_table;
71 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
73 /* See read_escape() for an explanation of this. */
75 int fail_on_bucky_bit_character_escapes;
78 /* This symbol is also used in fns.c */
79 #define FEATUREP_SYNTAX
81 #ifdef FEATUREP_SYNTAX
82 Lisp_Object Qfeaturep;
85 /* non-zero if inside `load' */
88 /* Whether Fload_internal() should check whether the .el is newer
90 int load_warn_when_source_newer;
91 /* Whether Fload_internal() should check whether the .elc doesn't exist */
92 int load_warn_when_source_only;
93 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
94 int load_ignore_elc_files;
96 /* Search path for files to be loaded. */
97 Lisp_Object Vload_path;
99 /* Search path for files when dumping. */
100 /* Lisp_Object Vdump_load_path; */
102 /* This is the user-visible association list that maps features to
103 lists of defs in their load files. */
104 Lisp_Object Vload_history;
106 /* This is used to build the load history. */
107 Lisp_Object Vcurrent_load_list;
109 /* Name of file actually being read by `load'. */
110 Lisp_Object Vload_file_name;
112 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
113 our #$ checks are reliable. */
114 Lisp_Object Vload_file_name_internal;
116 Lisp_Object Vload_file_name_internal_the_purecopy;
118 /* Function to use for reading, in `load' and friends. */
119 Lisp_Object Vload_read_function;
121 /* The association list of objects read with the #n=object form.
122 Each member of the list has the form (n . object), and is used to
123 look up the object for the corresponding #n# construct.
124 It must be set to nil before all top-level calls to read0. */
125 Lisp_Object Vread_objects;
127 /* Nonzero means load should forcibly load all dynamic doc strings. */
128 /* Note that this always happens (with some special behavior) when
129 purify_flag is set. */
130 static int load_force_doc_strings;
132 /* List of descriptors now open for Fload_internal. */
133 static Lisp_Object Vload_descriptor_list;
135 /* In order to implement "load_force_doc_strings", we keep
136 a list of all the compiled-function objects and such
137 that we have created in the process of loading this file.
140 We specbind this just like Vload_file_name, so there's no
141 problems with recursive loading. */
142 static Lisp_Object Vload_force_doc_string_list;
144 /* A resizing-buffer stream used to temporarily hold data while reading */
145 static Lisp_Object Vread_buffer_stream;
147 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
148 Lisp_Object Vcurrent_compiled_function_annotation;
151 static int load_byte_code_version;
153 /* An array describing all known built-in structure types */
154 static structure_type_dynarr *the_structure_type_dynarr;
156 #if 0 /* FSF defun hack */
157 /* When nonzero, read conses in pure space */
158 static int read_pure;
161 #if 0 /* FSF stuff */
162 /* For use within read-from-string (this reader is non-reentrant!!) */
163 static int read_from_string_index;
164 static int read_from_string_limit;
167 #if 0 /* More FSF implementation kludges. */
168 /* In order to implement load-force-doc-string, FSF saves the
169 #@-quoted string when it's seen, and goes back and retrieves
172 This approach is not only kludgy, but it in general won't work
173 correctly because there's no stack of remembered #@-quoted-strings
174 and those strings don't generally appear in the file in the same
175 order as their #$ references. (Yes, that is amazingly stupid too.
177 It would be trivially easy to always encode the #@ string
178 [which is a comment, anyway] in the middle of the (#$ . INT) cons
179 reference. That way, it would be really easy to implement
180 load-force-doc-string in a non-kludgy way by just retrieving the
181 string immediately, because it's delivered on a silver platter.)
183 And finally, this stupid approach doesn't work under Mule, or
184 under MS-DOS or Windows NT, or under VMS, or any other place
185 where you either can't do an ftell() or don't get back a byte
188 Oh, and one more lossage in this approach: If you attempt to
189 dump any ELC files that were compiled with `byte-compile-dynamic'
190 (as opposed to just `byte-compile-dynamic-docstring'), you
191 get hosed. FMH! (as the illustrious JWZ was prone to utter)
193 The approach we use is clean, solves all of these problems, and is
194 probably easier to implement anyway. We just save a list of all
195 the containing objects that have (#$ . INT) conses in them (this
196 will only be compiled-function objects and lists), and when the
197 file is finished loading, we go through and fill in all the
198 doc strings at once. */
200 /* This contains the last string skipped with #@. */
201 static char *saved_doc_string;
202 /* Length of buffer allocated in saved_doc_string. */
203 static int saved_doc_string_size;
204 /* Length of actual data in saved_doc_string. */
205 static int saved_doc_string_length;
206 /* This is the file position that string came from. */
207 static int saved_doc_string_position;
210 EXFUN (Fread_from_string, 3);
212 /* When errors are signaled, the actual readcharfun should not be used
213 as an argument if it is an lstream, so that lstreams don't escape
214 to the Lisp level. */
215 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
216 ? (build_string ("internal input stream")) \
221 read_syntax_error (const char *string)
223 signal_error (Qinvalid_read_syntax,
224 list1 (build_translated_string (string)));
228 continuable_read_syntax_error (const char *string)
230 return Fsignal (Qinvalid_read_syntax,
231 list1 (build_translated_string (string)));
235 /* Handle unreading and rereading of characters. */
237 readchar (Lisp_Object readcharfun)
239 /* This function can GC */
241 if (BUFFERP (readcharfun))
244 struct buffer *b = XBUFFER (readcharfun);
246 if (!BUFFER_LIVE_P (b))
247 error ("Reading from killed buffer");
249 if (BUF_PT (b) >= BUF_ZV (b))
251 c = BUF_FETCH_CHAR (b, BUF_PT (b));
252 BUF_SET_PT (b, BUF_PT (b) + 1);
256 else if (LSTREAMP (readcharfun))
258 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
259 #ifdef DEBUG_XEMACS /* testing Mule */
260 static int testing_mule = 0; /* Change via debugger */
263 if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
264 else if (c == '\n') stderr_out ("\\n\n");
265 else stderr_out ("\\%o ", c);
267 #endif /* testing Mule */
270 else if (MARKERP (readcharfun))
273 Bufpos mpos = marker_position (readcharfun);
274 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
276 if (mpos >= BUF_ZV (inbuffer))
278 c = BUF_FETCH_CHAR (inbuffer, mpos);
279 set_marker_position (readcharfun, mpos + 1);
284 Lisp_Object tem = call0 (readcharfun);
286 if (!CHAR_OR_CHAR_INTP (tem))
288 return XCHAR_OR_CHAR_INT (tem);
292 /* Unread the character C in the way appropriate for the stream READCHARFUN.
293 If the stream is a user function, call it with the char as argument. */
296 unreadchar (Lisp_Object readcharfun, Emchar c)
299 /* Don't back up the pointer if we're unreading the end-of-input mark,
300 since readchar didn't advance it when we read it. */
302 else if (BUFFERP (readcharfun))
303 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
304 else if (LSTREAMP (readcharfun))
306 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
307 #ifdef DEBUG_XEMACS /* testing Mule */
309 static int testing_mule = 0; /* Set this using debugger */
312 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
313 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
317 else if (MARKERP (readcharfun))
318 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
320 call1 (readcharfun, make_char (c));
323 static Lisp_Object read0 (Lisp_Object readcharfun);
324 static Lisp_Object read1 (Lisp_Object readcharfun);
325 /* allow_dotted_lists means that something like (foo bar . baz)
326 is acceptable. If -1, means check for starting with defun
327 and make structure pure. (not implemented, probably for very
331 If check_for_doc_references, look for (#$ . INT) doc references
332 in the list and record if load_force_doc_strings is non-zero.
333 (Such doc references will be destroyed during the loadup phase
334 by replacing with Qzero, because Snarf-documentation will fill
337 WARNING: If you set this, you sure as hell better not call
338 free_list() on the returned list here. */
340 static Lisp_Object read_list (Lisp_Object readcharfun,
342 int allow_dotted_lists,
343 int check_for_doc_references);
345 static void readevalloop (Lisp_Object readcharfun,
346 Lisp_Object sourcefile,
347 Lisp_Object (*evalfun) (Lisp_Object),
351 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
353 Lstream_close (XLSTREAM (stream));
354 if (--load_in_progress < 0)
355 load_in_progress = 0;
360 load_descriptor_unwind (Lisp_Object oldlist)
362 Vload_descriptor_list = oldlist;
367 load_file_name_internal_unwind (Lisp_Object oldval)
369 Vload_file_name_internal = oldval;
374 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
376 Vload_file_name_internal_the_purecopy = oldval;
381 load_byte_code_version_unwind (Lisp_Object oldval)
383 load_byte_code_version = XINT (oldval);
387 /* The plague is coming.
389 Ring around the rosy, pocket full of posy,
390 Ashes ashes, they all fall down.
393 ebolify_bytecode_constants (Lisp_Object vector)
395 int len = XVECTOR_LENGTH (vector);
398 for (i = 0; i < len; i++)
400 Lisp_Object el = XVECTOR_DATA (vector)[i];
402 /* We don't check for `eq', `equal', and the others that have
403 bytecode opcodes. This might lose if someone passes #'eq or
404 something to `funcall', but who would really do that? As
405 they say in law, we've made a "good-faith effort" to
406 unfuckify ourselves. And doing it this way avoids screwing
407 up args to `make-hash-table' and such. As it is, we have to
408 add an extra Ebola check in decode_weak_list_type(). --ben */
409 if (EQ (el, Qassoc)) el = Qold_assoc;
410 else if (EQ (el, Qdelq)) el = Qold_delq;
412 /* I think this is a bad idea because it will probably mess
414 else if (EQ (el, Qdelete)) el = Qold_delete;
416 else if (EQ (el, Qrassq)) el = Qold_rassq;
417 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
419 XVECTOR_DATA (vector)[i] = el;
424 pas_de_lache_ici (int fd, Lisp_Object victim)
429 if (!INTP (XCDR (victim)))
430 signal_simple_error ("Bogus doc string reference", victim);
431 pos = XINT (XCDR (victim));
433 pos = -pos; /* kludge to mark a user variable */
434 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
436 signal_error (Qerror, tem);
441 load_force_doc_string_unwind (Lisp_Object oldlist)
444 Lisp_Object list = Vload_force_doc_string_list;
446 int fd = XINT (XCAR (Vload_descriptor_list));
449 /* restore the old value first just in case an error occurs. */
450 Vload_force_doc_string_list = oldlist;
452 LIST_LOOP (tail, list)
454 Lisp_Object john = Fcar (tail);
457 assert (CONSP (XCAR (john)));
458 assert (!purify_flag); /* should have been handled in read_list() */
459 XCAR (john) = pas_de_lache_ici (fd, XCAR (john));
465 assert (COMPILED_FUNCTIONP (john));
466 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
468 struct gcpro ngcpro1;
469 Lisp_Object juan = (pas_de_lache_ici
470 (fd, XCOMPILED_FUNCTION (john)->instructions));
476 signal_simple_error ("invalid lazy-loaded byte code", ivan);
477 XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
478 /* v18 or v19 bytecode file. Need to Ebolify. */
479 if (XCOMPILED_FUNCTION (john)->flags.ebolified
480 && VECTORP (XCDR (ivan)))
481 ebolify_bytecode_constants (XCDR (ivan));
482 XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
485 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
488 assert (!purify_flag); /* should have been handled in
489 read_compiled_function() */
490 doc = pas_de_lache_ici (fd, doc);
491 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
504 /* Close all descriptors in use for Fload_internal.
505 This is used when starting a subprocess. */
508 close_load_descs (void)
511 LIST_LOOP (tail, Vload_descriptor_list)
512 close (XINT (XCAR (tail)));
516 Lisp_Object Vfile_domain;
519 restore_file_domain (Lisp_Object val)
526 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
527 Execute a file of Lisp code named FILE; no coding-system frobbing.
528 This function is identical to `load' except for the handling of the
529 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
530 support is not present, both functions are identical and ignore the
531 CODESYS and USED-CODESYS arguments.)
533 If support for Mule exists in this Emacs, the file is decoded
534 according to CODESYS; if omitted, no conversion happens. If
535 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
536 system that was used for the decoding is stored into it. It will in
537 general be different from CODESYS if CODESYS specifies automatic
538 encoding detection or end-of-line detection.
540 (file, noerror, nomessage, nosuffix, codesys, used_codesys))
542 /* This function can GC */
544 int speccount = specpdl_depth ();
546 Lisp_Object newer = Qnil;
547 Lisp_Object handler = Qnil;
548 Lisp_Object found = Qnil;
549 struct gcpro gcpro1, gcpro2, gcpro3;
551 int message_p = NILP (nomessage);
552 /*#ifdef DEBUG_XEMACS*/
553 static Lisp_Object last_file_loaded;
556 GCPRO3 (file, newer, found);
560 /*#ifdef DEBUG_XEMACS*/
561 if (purify_flag && noninteractive)
564 last_file_loaded = file;
566 /*#endif / * DEBUG_XEMACS */
568 /* If file name is magic, call the handler. */
569 handler = Ffind_file_name_handler (file, Qload);
571 RETURN_UNGCPRO (call5 (handler, Qload, file, noerror,
572 nomessage, nosuffix));
574 /* Do this after the handler to avoid
575 the need to gcpro noerror, nomessage and nosuffix.
576 (Below here, we care only whether they are nil or not.) */
577 file = Fsubstitute_in_file_name (file);
579 if (!NILP (used_codesys))
580 CHECK_SYMBOL (used_codesys);
583 /* Avoid weird lossage with null string as arg,
584 since it would try to load a directory as a Lisp file.
586 if (XSTRING_LENGTH (file) > 0)
591 fd = locate_file (Vload_path, file,
592 ((!NILP (nosuffix)) ? Qnil :
593 build_string (load_ignore_elc_files ? ".el:" :
601 signal_file_error ("Cannot open load file", file);
609 foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
610 strcpy (foundstr, (char *) XSTRING_DATA (found));
611 foundlen = strlen (foundstr);
613 /* The omniscient JWZ thinks this is worthless, but I beg to
615 if (load_ignore_elc_files)
617 newer = Ffile_name_nondirectory (found);
619 else if (load_warn_when_source_newer &&
620 !memcmp (".elc", foundstr + foundlen - 4, 4))
622 if (! fstat (fd, &s1)) /* can't fail, right? */
625 /* temporarily hack the 'c' off the end of the filename */
626 foundstr[foundlen - 1] = '\0';
627 result = xemacs_stat (foundstr, &s2);
629 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
631 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
633 struct gcpro nngcpro1;
634 NNGCPRO1 (newer_name);
635 newer = Ffile_name_nondirectory (newer_name);
638 /* put the 'c' back on (kludge-o-rama) */
639 foundstr[foundlen - 1] = 'c';
642 else if (load_warn_when_source_only &&
643 /* `found' ends in ".el" */
644 !memcmp (".el", foundstr + foundlen - 3, 3) &&
645 /* `file' does not end in ".el" */
647 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
653 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
657 #define PRINT_LOADING_MESSAGE(done) do { \
658 if (load_ignore_elc_files) \
661 message ("Loading %s..." done, XSTRING_DATA (newer)); \
663 else if (!NILP (newer)) \
664 message ("Loading %s..." done " (file %s is newer)", \
665 XSTRING_DATA (file), \
666 XSTRING_DATA (newer)); \
667 else if (source_only) \
668 message ("Loading %s..." done " (file %s.elc does not exist)", \
669 XSTRING_DATA (file), \
670 XSTRING_DATA (Ffile_name_nondirectory (file))); \
671 else if (message_p) \
672 message ("Loading %s..." done, XSTRING_DATA (file)); \
675 PRINT_LOADING_MESSAGE ("");
678 /* Lisp_Object's must be malloc'ed, not stack-allocated */
679 Lisp_Object lispstream = Qnil;
680 const int block_size = 8192;
681 struct gcpro ngcpro1;
683 NGCPRO1 (lispstream);
684 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
685 /* 64K is used for normal files; 8K should be OK here because Lisp
686 files aren't really all that big. */
687 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
690 lispstream = make_decoding_input_stream
691 (XLSTREAM (lispstream), Fget_coding_system (codesys));
692 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
695 /* NOTE: Order of these is very important. Don't rearrange them. */
696 record_unwind_protect (load_unwind, lispstream);
697 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
698 record_unwind_protect (load_file_name_internal_unwind,
699 Vload_file_name_internal);
700 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
701 Vload_file_name_internal_the_purecopy);
702 record_unwind_protect (load_force_doc_string_unwind,
703 Vload_force_doc_string_list);
704 Vload_file_name_internal = found;
705 Vload_file_name_internal_the_purecopy = Qnil;
706 specbind (Qload_file_name, found);
707 Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
708 Vload_force_doc_string_list = Qnil;
710 record_unwind_protect (restore_file_domain, Vfile_domain);
711 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
715 /* Now determine what sort of ELC file we're reading in. */
716 record_unwind_protect (load_byte_code_version_unwind,
717 make_int (load_byte_code_version));
723 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
725 || strncmp (elc_header, ";ELC", 4))
727 /* Huh? Probably not a valid ELC file. */
728 load_byte_code_version = 100; /* no Ebolification needed */
729 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
732 load_byte_code_version = elc_header[4];
735 load_byte_code_version = 100; /* no Ebolification needed */
737 readevalloop (lispstream, file, Feval, 0);
739 if (!NILP (used_codesys))
742 (decoding_stream_coding_system (XLSTREAM (lispstream))));
744 unbind_to (speccount, Qnil);
751 /* #### Disgusting kludge */
752 /* Run any load-hooks for this file. */
753 /* #### An even more disgusting kludge. There is horrible code */
754 /* that is relying on the fact that dumped lisp files are found */
755 /* via `load-path' search. */
756 Lisp_Object name = file;
758 if (!NILP(Ffile_name_absolute_p(file)))
760 name = Ffile_name_nondirectory(file);
764 struct gcpro ngcpro1;
767 tem = Fassoc (name, Vafter_load_alist);
772 struct gcpro ngcpro1;
775 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
776 tem = Fcons (Qprogn, Fcdr (tem));
782 /*#ifdef DEBUG_XEMACS*/
783 if (purify_flag && noninteractive)
785 if (!EQ (last_file_loaded, file))
786 message ("Loading %s ...done", XSTRING_DATA (file));
788 /*#endif / * DEBUG_XEMACS */
791 PRINT_LOADING_MESSAGE ("done");
798 /* ------------------------------- */
800 /* ------------------------------- */
803 decode_mode_1 (Lisp_Object mode)
805 if (EQ (mode, Qexists))
807 else if (EQ (mode, Qexecutable))
809 else if (EQ (mode, Qwritable))
811 else if (EQ (mode, Qreadable))
813 else if (INTP (mode))
815 check_int_range (XINT (mode), 0, 7);
819 signal_simple_error ("Invalid value", mode);
820 return 0; /* unreached */
824 decode_mode (Lisp_Object mode)
828 else if (CONSP (mode))
832 EXTERNAL_LIST_LOOP (tail, mode)
833 mask |= decode_mode_1 (XCAR (tail));
837 return decode_mode_1 (mode);
840 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
841 Search for FILENAME through PATH-LIST.
843 If SUFFIXES is non-nil, it should be a list of suffixes to append to
844 file name when searching.
846 If MODE is non-nil, it should be a symbol or a list of symbol representing
847 requirements. Allowed symbols are `exists', `executable', `writable', and
848 `readable'. If MODE is nil, it defaults to `readable'.
850 `locate-file' keeps hash tables of the directories it searches through,
851 in order to speed things up. It tries valiantly to not get confused in
852 the face of a changing and unpredictable environment, but can occasionally
853 get tripped up. In this case, you will have to call
854 `locate-file-clear-hashing' to get it back on track. See that function
857 (filename, path_list, suffixes, mode))
859 /* This function can GC */
862 CHECK_STRING (filename);
864 if (LISTP (suffixes))
867 EXTERNAL_LIST_LOOP (tail, suffixes)
868 CHECK_STRING (XCAR (tail));
871 CHECK_STRING (suffixes);
873 locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
877 /* Recalculate the hash table for the given string. DIRECTORY should
878 better have been through Fexpand_file_name() by now. */
881 locate_file_refresh_hashing (Lisp_Object directory)
884 make_directory_hash_table ((char *) XSTRING_DATA (directory));
887 Fputhash (directory, hash, Vlocate_file_hash_table);
891 /* find the hash table for the given directory, recalculating if necessary */
894 locate_file_find_directory_hash_table (Lisp_Object directory)
896 Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
898 return locate_file_refresh_hashing (directory);
903 /* The SUFFIXES argument in any of the locate_file* functions can be
904 nil, a list, or a string (for backward compatibility), with the
907 a) nil - no suffix, just search for file name intact
908 (semantically different from "empty suffix list", which
909 would be meaningless.)
910 b) list - list of suffixes to append to file name. Each of these
912 c) string - colon-separated suffixes to append to file name (backward
915 All of this got hairy, so I decided to use a mapper. Calling a
916 function for each suffix shouldn't slow things down, since
917 locate_file is rarely called with enough suffixes for funcalls to
918 make any difference. */
920 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
921 char * containing the current file name, and ARG. Mapping stops when
922 FUN returns non-zero. */
924 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
925 int (*fun) (char *, void *),
928 /* This function can GC */
932 /* Calculate maximum size of any filename made from
933 this path element/specified file name and any possible suffix. */
934 if (CONSP (suffixes))
936 /* We must traverse the list, so why not do it right. */
939 LIST_LOOP (tail, suffixes)
941 if (XSTRING_LENGTH (XCAR (tail)) > max)
942 max = XSTRING_LENGTH (XCAR (tail));
945 else if (NILP (suffixes))
948 /* Just take the easy way out */
949 max = XSTRING_LENGTH (suffixes);
951 fn_len = XSTRING_LENGTH (filename);
952 fn = (char *) alloca (max + fn_len + 1);
953 memcpy (fn, (char *) XSTRING_DATA (filename), fn_len);
955 /* Loop over suffixes. */
956 if (!STRINGP (suffixes))
960 /* Case a) discussed in the comment above. */
962 if ((*fun) (fn, arg))
969 LIST_LOOP (tail, suffixes)
971 memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
972 XSTRING_LENGTH (XCAR (tail)));
973 fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
974 if ((*fun) (fn, arg))
982 const char *nsuffix = (const char *) XSTRING_DATA (suffixes);
986 char *esuffix = (char *) strchr (nsuffix, ':');
987 int lsuffix = esuffix ? esuffix - nsuffix : (int) strlen (nsuffix);
989 /* Concatenate path element/specified name with the suffix. */
990 strncpy (fn + fn_len, nsuffix, lsuffix);
991 fn[fn_len + lsuffix] = 0;
993 if ((*fun) (fn, arg))
996 /* Advance to next suffix. */
999 nsuffix += lsuffix + 1;
1004 struct locate_file_in_directory_mapper_closure {
1006 Lisp_Object *storeptr;
1011 locate_file_in_directory_mapper (char *fn, void *arg)
1013 struct locate_file_in_directory_mapper_closure *closure =
1014 (struct locate_file_in_directory_mapper_closure *)arg;
1017 /* Ignore file if it's a directory. */
1018 if (xemacs_stat (fn, &st) >= 0
1019 && (st.st_mode & S_IFMT) != S_IFDIR)
1021 /* Check that we can access or open it. */
1022 if (closure->mode >= 0)
1023 closure->fd = access (fn, closure->mode);
1025 closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
1027 if (closure->fd >= 0)
1029 /* We succeeded; return this descriptor and filename. */
1030 if (closure->storeptr)
1031 *closure->storeptr = build_string (fn);
1033 #ifndef WIN32_NATIVE
1034 /* If we actually opened the file, set close-on-exec flag
1035 on the new descriptor so that subprocesses can't whack
1037 if (closure->mode < 0)
1038 (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
1049 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
1050 not have been expanded. */
1053 locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
1054 Lisp_Object suffixes, Lisp_Object *storeptr,
1057 /* This function can GC */
1058 struct locate_file_in_directory_mapper_closure closure;
1059 Lisp_Object filename = Qnil;
1060 struct gcpro gcpro1, gcpro2, gcpro3;
1062 GCPRO3 (directory, str, filename);
1064 filename = Fexpand_file_name (str, directory);
1065 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
1066 /* If there are non-absolute elts in PATH (eg ".") */
1067 /* Of course, this could conceivably lose if luser sets
1068 default-directory to be something non-absolute ... */
1070 if (NILP (filename))
1071 /* NIL means current directory */
1072 filename = current_buffer->directory;
1074 filename = Fexpand_file_name (filename,
1075 current_buffer->directory);
1076 if (NILP (Ffile_name_absolute_p (filename)))
1078 /* Give up on this directory! */
1085 closure.storeptr = storeptr;
1086 closure.mode = mode;
1088 locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
1095 /* do the same as locate_file() but don't use any hash tables. */
1098 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
1099 Lisp_Object suffixes, Lisp_Object *storeptr,
1102 /* This function can GC */
1103 int absolute = !NILP (Ffile_name_absolute_p (str));
1105 EXTERNAL_LIST_LOOP (path, path)
1107 int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
1118 locate_file_construct_suffixed_files_mapper (char *fn, void *arg)
1120 Lisp_Object *tail = (Lisp_Object *)arg;
1121 *tail = Fcons (build_string (fn), *tail);
1125 /* Construct a list of all files to search for.
1126 It makes sense to have this despite locate_file_map_suffixes()
1127 because we need Lisp strings to access the hash-table, and it would
1128 be inefficient to create them on the fly, again and again for each
1129 path component. See locate_file(). */
1132 locate_file_construct_suffixed_files (Lisp_Object filename,
1133 Lisp_Object suffixes)
1135 Lisp_Object tail = Qnil;
1136 struct gcpro gcpro1;
1139 locate_file_map_suffixes (filename, suffixes,
1140 locate_file_construct_suffixed_files_mapper,
1144 return Fnreverse (tail);
1147 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1148 Clear the hash records for the specified list of directories.
1149 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1150 track the following environmental changes:
1152 -- changes of any sort to the list of directories to be searched.
1153 -- addition and deletion of non-shadowing files (see below) from the
1154 directories in the list.
1155 -- byte-compilation of a .el file into a .elc file.
1157 `locate-file' will primarily get confused if you add a file that shadows
1158 \(i.e. has the same name as) another file further down in the directory list.
1159 In this case, you must call `locate-file-clear-hashing'.
1161 If PATH is t, it means to fully clear all the accumulated hashes. This
1162 can be used if the internal tables grow too large, or when dumping.
1167 Fclrhash (Vlocate_file_hash_table);
1170 Lisp_Object pathtail;
1171 EXTERNAL_LIST_LOOP (pathtail, path)
1173 Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
1174 Fremhash (pathel, Vlocate_file_hash_table);
1180 /* Search for a file whose name is STR, looking in directories
1181 in the Lisp list PATH, and trying suffixes from SUFFIXES.
1182 SUFFIXES is a list of possible suffixes, or (for backward
1183 compatibility) a string containing possible suffixes separated by
1185 On success, returns a file descriptor. On failure, returns -1.
1187 MODE nonnegative means don't open the files,
1188 just look for one for which access(file,MODE) succeeds. In this case,
1189 returns a nonnegative value on success. On failure, returns -1.
1191 If STOREPTR is nonzero, it points to a slot where the name of
1192 the file actually found should be stored as a Lisp string.
1193 Nil is stored there on failure.
1195 Called openp() in FSFmacs. */
1198 locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1199 Lisp_Object *storeptr, int mode)
1201 /* This function can GC */
1202 Lisp_Object suffixtab = Qnil;
1203 Lisp_Object pathtail, pathel_expanded;
1205 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1210 /* Is it really necessary to gcpro path and str? It shouldn't be
1211 unless some caller has fucked up. There are known instances that
1212 call us with build_string("foo:bar") as SUFFIXES, though. */
1213 GCPRO4 (path, str, suffixes, suffixtab);
1215 /* if this filename has directory components, it's too complicated
1216 to try and use the hash tables. */
1217 if (!NILP (Ffile_name_directory (str)))
1219 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
1224 suffixtab = locate_file_construct_suffixed_files (str, suffixes);
1226 EXTERNAL_LIST_LOOP (pathtail, path)
1228 Lisp_Object pathel = XCAR (pathtail);
1229 Lisp_Object hash_table;
1233 /* If this path element is relative, we have to look by hand. */
1234 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
1236 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
1246 pathel_expanded = Fexpand_file_name (pathel, Qnil);
1247 hash_table = locate_file_find_directory_hash_table (pathel_expanded);
1249 if (!NILP (hash_table))
1251 /* Loop over suffixes. */
1252 LIST_LOOP (tail, suffixtab)
1253 if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
1262 /* This is a likely candidate. Look by hand in this directory
1263 so we don't get thrown off if someone byte-compiles a file. */
1264 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
1272 /* Hmm ... the file isn't actually there. (Or possibly it's
1273 a directory ...) So refresh our hashing. */
1274 locate_file_refresh_hashing (pathel_expanded);
1278 /* File is probably not there, but check the hard way just in case. */
1279 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
1282 /* Sneaky user added a file without telling us. */
1283 Flocate_file_clear_hashing (path);
1293 /* Merge the list we've accumulated of globals from the current input source
1294 into the load_history variable. The details depend on whether
1295 the source has an associated file name or not. */
1298 build_load_history (int loading, Lisp_Object source)
1300 REGISTER Lisp_Object tail, prev, newelt;
1301 REGISTER Lisp_Object tem, tem2;
1304 #if !defined(LOADHIST_DUMPED)
1305 /* Don't bother recording anything for preloaded files. */
1310 tail = Vload_history;
1313 while (!NILP (tail))
1317 /* Find the feature's previous assoc list... */
1318 if (internal_equal (source, Fcar (tem), 0))
1322 /* If we're loading, remove it. */
1326 Vload_history = Fcdr (tail);
1328 Fsetcdr (prev, Fcdr (tail));
1331 /* Otherwise, cons on new symbols that are not already members. */
1334 tem2 = Vcurrent_load_list;
1336 while (CONSP (tem2))
1338 newelt = XCAR (tem2);
1340 if (NILP (Fmemq (newelt, tem)))
1341 Fsetcar (tail, Fcons (Fcar (tem),
1342 Fcons (newelt, Fcdr (tem))));
1355 /* If we're loading, cons the new assoc onto the front of load-history,
1356 the most-recently-loaded position. Also do this if we didn't find
1357 an existing member for the current source. */
1358 if (loading || !foundit)
1359 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1363 #else /* !LOADHIST */
1364 #define build_load_history(x,y)
1365 #endif /* !LOADHIST */
1368 #if 0 /* FSFmacs defun hack */
1370 unreadpure (void) /* Used as unwind-protect function in readevalloop */
1378 readevalloop (Lisp_Object readcharfun,
1379 Lisp_Object sourcename,
1380 Lisp_Object (*evalfun) (Lisp_Object),
1383 /* This function can GC */
1385 REGISTER Lisp_Object val = Qnil;
1386 int speccount = specpdl_depth ();
1387 struct gcpro gcpro1, gcpro2;
1388 struct buffer *b = 0;
1390 if (BUFFERP (readcharfun))
1391 b = XBUFFER (readcharfun);
1392 else if (MARKERP (readcharfun))
1393 b = XMARKER (readcharfun)->buffer;
1395 /* Don't do this. It is not necessary, and it needlessly exposes
1396 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1397 /*specbind (Qstandard_input, readcharfun);*/
1399 specbind (Qcurrent_load_list, Qnil);
1401 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1402 Vcurrent_compiled_function_annotation = Qnil;
1404 GCPRO2 (val, sourcename);
1406 LOADHIST_ATTACH (sourcename);
1412 if (b != 0 && !BUFFER_LIVE_P (b))
1413 error ("Reading from killed buffer");
1415 c = readchar (readcharfun);
1419 while ((c = readchar (readcharfun)) != '\n' && c != -1)
1426 /* Ignore whitespace here, so we can detect eof. */
1427 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1430 #if 0 /* FSFmacs defun hack */
1431 if (purify_flag && c == '(')
1433 int count1 = specpdl_depth ();
1434 record_unwind_protect (unreadpure, Qnil);
1435 val = read_list (readcharfun, ')', -1, 1);
1436 unbind_to (count1, Qnil);
1439 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1441 unreadchar (readcharfun, c);
1442 Vread_objects = Qnil;
1443 if (NILP (Vload_read_function))
1444 val = read0 (readcharfun);
1446 val = call1 (Vload_read_function, readcharfun);
1449 val = (*evalfun) (val);
1452 Vvalues = Fcons (val, Vvalues);
1453 if (EQ (Vstandard_output, Qt))
1460 build_load_history (LSTREAMP (readcharfun) ||
1461 /* This looks weird, but it's what's in FSFmacs */
1462 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
1466 unbind_to (speccount, Qnil);
1469 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1470 Execute BUFFER as Lisp code.
1471 Programs can pass two arguments, BUFFER and PRINTFLAG.
1472 BUFFER is the buffer to evaluate (nil means use current buffer).
1473 PRINTFLAG controls printing of output:
1474 nil means discard it; anything else is a stream for printing.
1476 If there is no error, point does not move. If there is an error,
1477 point remains at the end of the last character read from the buffer.
1479 (buffer, printflag))
1481 /* This function can GC */
1482 int speccount = specpdl_depth ();
1483 Lisp_Object tem, buf;
1486 buf = Fcurrent_buffer ();
1488 buf = Fget_buffer (buffer);
1490 error ("No such buffer.");
1492 if (NILP (printflag))
1493 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1496 specbind (Qstandard_output, tem);
1497 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1498 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1499 readevalloop (buf, XBUFFER (buf)->filename, Feval,
1502 return unbind_to (speccount, Qnil);
1506 xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1507 Execute the current buffer as Lisp code.
1508 Programs can pass argument PRINTFLAG which controls printing of output:
1509 nil means discard it; anything else is stream for print.
1511 If there is no error, point does not move. If there is an error,
1512 point remains at the end of the last character read from the buffer.
1520 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
1521 Execute the region as Lisp code.
1522 When called from programs, expects two arguments START and END
1523 giving starting and ending indices in the current buffer
1524 of the text to be executed.
1525 Programs can pass third optional argument STREAM which controls output:
1526 nil means discard it; anything else is stream for printing it.
1528 If there is no error, point does not move. If there is an error,
1529 point remains at the end of the last character read from the buffer.
1531 Note: Before evaling the region, this function narrows the buffer to it.
1532 If the code being eval'd should happen to trigger a redisplay you may
1533 see some text temporarily disappear because of this.
1535 (start, end, stream))
1537 /* This function can GC */
1538 int speccount = specpdl_depth ();
1540 Lisp_Object cbuf = Fcurrent_buffer ();
1543 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1546 specbind (Qstandard_output, tem);
1549 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1550 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1552 /* This both uses start and checks its type. */
1553 Fgoto_char (start, cbuf);
1554 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
1555 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
1558 return unbind_to (speccount, Qnil);
1561 DEFUN ("read", Fread, 0, 1, 0, /*
1562 Read one Lisp expression as text from STREAM, return as Lisp object.
1563 If STREAM is nil, use the value of `standard-input' (which see).
1564 STREAM or the value of `standard-input' may be:
1565 a buffer (read from point and advance it)
1566 a marker (read from where it points and advance it)
1567 a function (call it with no arguments for each character,
1568 call it with a char as argument to push a char back)
1569 a string (takes text from string, starting at the beginning)
1570 t (read text line using minibuffer and use it).
1575 stream = Vstandard_input;
1576 if (EQ (stream, Qt))
1577 stream = Qread_char;
1579 Vread_objects = Qnil;
1581 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1582 Vcurrent_compiled_function_annotation = Qnil;
1584 if (EQ (stream, Qread_char))
1586 Lisp_Object val = call1 (Qread_from_minibuffer,
1587 build_translated_string ("Lisp expression: "));
1588 return Fcar (Fread_from_string (val, Qnil, Qnil));
1591 if (STRINGP (stream))
1592 return Fcar (Fread_from_string (stream, Qnil, Qnil));
1594 return read0 (stream);
1597 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
1598 Read one Lisp expression which is represented as text by STRING.
1599 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1600 START and END optionally delimit a substring of STRING from which to read;
1601 they default to 0 and (length STRING) respectively.
1603 (string, start, end))
1605 Bytecount startval, endval;
1607 Lisp_Object lispstream = Qnil;
1608 struct gcpro gcpro1;
1610 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1611 Vcurrent_compiled_function_annotation = Qnil;
1613 GCPRO1 (lispstream);
1614 CHECK_STRING (string);
1615 get_string_range_byte (string, start, end, &startval, &endval,
1616 GB_HISTORICAL_STRING_BEHAVIOR);
1617 lispstream = make_lisp_string_input_stream (string, startval,
1620 Vread_objects = Qnil;
1622 tem = read0 (lispstream);
1623 /* Yeah, it's ugly. Gonna make something of it?
1624 At least our reader is reentrant ... */
1626 (Fcons (tem, make_int
1627 (bytecount_to_charcount
1628 (XSTRING_DATA (string),
1629 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
1630 Lstream_delete (XLSTREAM (lispstream));
1636 read_from_c_string (const unsigned char* str, size_t size)
1639 Lisp_Object lispstream = Qnil;
1640 struct gcpro gcpro1;
1642 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1643 Vcurrent_compiled_function_annotation = Qnil;
1645 GCPRO1 (lispstream);
1646 lispstream = make_fixed_buffer_input_stream (str, size);
1648 Vread_objects = Qnil;
1650 tem = read0 (lispstream);
1651 Lstream_delete (XLSTREAM (lispstream));
1656 #ifdef LISP_BACKQUOTES
1659 backquote_unwind (Lisp_Object ptr)
1660 { /* used as unwind-protect function in read0() */
1661 int *counter = (int *) get_opaque_ptr (ptr);
1664 free_opaque_ptr (ptr);
1670 /* Use this for recursive reads, in contexts where internal tokens
1671 are not allowed. See also read1(). */
1673 read0 (Lisp_Object readcharfun)
1675 Lisp_Object val = read1 (readcharfun);
1677 if (CONSP (val) && UNBOUNDP (XCAR (val)))
1679 Emchar c = XCHAR (XCDR (val));
1680 free_cons (XCONS (val));
1681 return Fsignal (Qinvalid_read_syntax,
1682 list1 (Fchar_to_string (make_char (c))));
1689 read_escape (Lisp_Object readcharfun)
1691 /* This function can GC */
1692 Emchar c = readchar (readcharfun);
1695 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1699 case 'a': return '\007';
1700 case 'b': return '\b';
1701 case 'd': return 0177;
1702 case 'e': return 033;
1703 case 'f': return '\f';
1704 case 'n': return '\n';
1705 case 'r': return '\r';
1706 case 't': return '\t';
1707 case 'v': return '\v';
1708 case '\n': return -1;
1711 c = readchar (readcharfun);
1713 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1715 error ("Invalid escape character syntax");
1716 c = readchar (readcharfun);
1718 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1720 c = read_escape (readcharfun);
1723 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1724 compatibility by defining character "modifiers" alt, super,
1725 hyper and shift to infest the characters (i.e. integers).
1727 However, this doesn't cut it for XEmacs 20, which
1728 distinguishes characters from integers. Without Mule, ?\H-a
1729 simply returns ?a because every character is clipped into
1730 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1731 produces an illegal character, and moves us to crash-land.
1733 For these reasons, FSF_KEYS hack is useless and without hope
1734 of ever working under XEmacs 20. */
1738 #define alt_modifier (0x040000)
1739 #define super_modifier (0x080000)
1740 #define hyper_modifier (0x100000)
1741 #define shift_modifier (0x200000)
1742 /* fsf uses a different modifiers for meta and control. Possibly
1743 byte_compiled code will still work fsfmacs, though... --Stig
1745 #define ctl_modifier (0x400000)
1746 #define meta_modifier (0x800000)
1748 #define FSF_LOSSAGE(mask) \
1749 if (fail_on_bucky_bit_character_escapes || \
1750 ((c = readchar (readcharfun)) != '-')) \
1751 error ("Invalid escape character syntax"); \
1752 c = readchar (readcharfun); \
1754 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1756 c = read_escape (readcharfun); \
1759 case 'S': FSF_LOSSAGE (shift_modifier);
1760 case 'H': FSF_LOSSAGE (hyper_modifier);
1761 case 'A': FSF_LOSSAGE (alt_modifier);
1762 case 's': FSF_LOSSAGE (super_modifier);
1764 #undef super_modifier
1765 #undef hyper_modifier
1766 #undef shift_modifier
1769 #endif /* FSF_KEYS */
1772 c = readchar (readcharfun);
1774 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1776 error ("Invalid escape character syntax");
1778 c = readchar (readcharfun);
1780 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1782 c = read_escape (readcharfun);
1783 /* FSFmacs junk for non-ASCII controls.
1788 return c & (0200 | 037);
1798 /* An octal escape, as in ANSI C. */
1800 REGISTER Emchar i = c - '0';
1801 REGISTER int count = 0;
1804 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
1805 i = (i << 3) + (c - '0');
1808 unreadchar (readcharfun, c);
1816 /* A hex escape, as in ANSI C, except that we only allow latin-1
1817 characters to be read this way. What is "\x4e03" supposed to
1818 mean, anyways, if the internal representation is hidden?
1819 This is also consistent with the treatment of octal escapes. */
1821 REGISTER Emchar i = 0;
1822 REGISTER int count = 0;
1823 while (++count <= 2)
1825 c = readchar (readcharfun);
1826 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1827 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1828 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1829 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1832 unreadchar (readcharfun, c);
1840 REGISTER Emchar i = 0;
1841 REGISTER int count = 0;
1842 while (++count <= 6)
1844 c = readchar (readcharfun);
1845 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1846 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1847 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1848 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1851 unreadchar (readcharfun, c);
1859 /* #### need some way of reading an extended character with
1860 an escape sequence. */
1870 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1872 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1874 /* This function can GC */
1875 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
1876 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
1878 *saw_a_backslash = 0;
1880 while (c > 040 /* #### - comma should be here as should backquote */
1881 && !(c == '\"' || c == '\'' || c == ';'
1882 || c == '(' || c == ')'
1883 #ifndef LISP_FLOAT_TYPE
1884 /* If we have floating-point support, then we need
1885 to allow <digits><dot><digits>. */
1887 #endif /* not LISP_FLOAT_TYPE */
1888 || c == '[' || c == ']' || c == '#'
1893 c = readchar (readcharfun);
1895 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1896 *saw_a_backslash = 1;
1898 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
1900 c = readchar (readcharfun);
1904 unreadchar (readcharfun, c);
1905 /* blasted terminating 0 */
1906 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
1907 Lstream_flush (XLSTREAM (Vread_buffer_stream));
1909 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
1912 static Lisp_Object parse_integer (const Bufbyte *buf, Bytecount len, int base);
1915 read_atom (Lisp_Object readcharfun,
1917 int uninterned_symbol)
1919 /* This function can GC */
1920 int saw_a_backslash;
1921 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
1922 char *read_ptr = (char *)
1923 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
1925 /* Is it an integer? */
1926 if (! (saw_a_backslash || uninterned_symbol))
1928 /* If a token had any backslashes in it, it is disqualified from
1929 being an integer or a float. This means that 123\456 is a
1930 symbol, as is \123 (which is the way (intern "123") prints).
1931 Also, if token was preceded by #:, it's always a symbol.
1933 char *p = read_ptr + len;
1934 char *p1 = read_ptr;
1936 if (*p1 == '+' || *p1 == '-') p1++;
1941 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1943 #ifdef LISP_FLOAT_TYPE
1944 /* Integers can have trailing decimal points. */
1945 if (p1 > read_ptr && p1 < p && *p1 == '.')
1950 /* It is an integer. */
1951 #ifdef LISP_FLOAT_TYPE
1958 if (sizeof (int) == sizeof (EMACS_INT))
1959 number = atoi (read_buffer);
1960 else if (sizeof (long) == sizeof (EMACS_INT))
1961 number = atol (read_buffer);
1964 return make_int (number);
1967 return parse_integer ((Bufbyte *) read_ptr, len, 10);
1971 #ifdef LISP_FLOAT_TYPE
1972 if (isfloat_string (read_ptr))
1973 return make_float (atof (read_ptr));
1979 if (uninterned_symbol)
1980 sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
1983 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
1984 sym = Fintern (name, Qnil);
1992 parse_integer (const Bufbyte *buf, Bytecount len, int base)
1994 const Bufbyte *lim = buf + len;
1995 const Bufbyte *p = buf;
1997 int negativland = 0;
2012 for (; (p < lim) && (*p != '\0'); p++)
2019 else if (isupper (c))
2021 else if (islower (c))
2026 if (c < 0 || c >= base)
2030 num = num * base + c;
2036 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
2037 Lisp_Object result = make_int (int_result);
2038 if (num && ((XINT (result) < 0) != negativland))
2040 if (XINT (result) != int_result)
2045 return Fsignal (Qinvalid_read_syntax,
2046 list3 (build_translated_string
2047 ("Integer constant overflow in reader"),
2048 make_string (buf, len),
2051 return Fsignal (Qinvalid_read_syntax,
2052 list3 (build_translated_string
2053 ("Invalid integer constant in reader"),
2054 make_string (buf, len),
2060 read_integer (Lisp_Object readcharfun, int base)
2062 /* This function can GC */
2063 int saw_a_backslash;
2064 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
2065 return (parse_integer
2066 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2068 ? 0 /* make parse_integer signal error */
2074 read_bit_vector (Lisp_Object readcharfun)
2076 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
2082 Emchar c = readchar (readcharfun);
2090 unreadchar (readcharfun, c);
2093 Dynarr_add (dyn, bit);
2096 val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
2097 Dynarr_length (dyn));
2107 struct structure_type *
2108 define_structure_type (Lisp_Object type,
2109 int (*validate) (Lisp_Object data,
2110 Error_behavior errb),
2111 Lisp_Object (*instantiate) (Lisp_Object data))
2113 struct structure_type st;
2116 st.keywords = Dynarr_new (structure_keyword_entry);
2117 st.validate = validate;
2118 st.instantiate = instantiate;
2119 Dynarr_add (the_structure_type_dynarr, st);
2121 return Dynarr_atp (the_structure_type_dynarr,
2122 Dynarr_length (the_structure_type_dynarr) - 1);
2126 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
2127 int (*validate) (Lisp_Object keyword,
2129 Error_behavior errb))
2131 struct structure_keyword_entry en;
2133 en.keyword = keyword;
2134 en.validate = validate;
2135 Dynarr_add (st->keywords, en);
2138 static struct structure_type *
2139 recognized_structure_type (Lisp_Object type)
2143 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
2145 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
2146 if (EQ (st->type, type))
2154 read_structure (Lisp_Object readcharfun)
2156 Emchar c = readchar (readcharfun);
2157 Lisp_Object list = Qnil;
2158 Lisp_Object orig_list = Qnil;
2159 Lisp_Object already_seen = Qnil;
2161 struct structure_type *st;
2162 struct gcpro gcpro1, gcpro2;
2164 GCPRO2 (orig_list, already_seen);
2166 RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
2167 list = read_list (readcharfun, ')', 0, 0);
2170 int len = XINT (Flength (list));
2172 RETURN_UNGCPRO (continuable_read_syntax_error
2173 ("structure type not specified"));
2176 (continuable_read_syntax_error
2177 ("structures must have alternating keyword/value pairs"));
2180 st = recognized_structure_type (XCAR (list));
2182 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2183 list2 (build_translated_string
2184 ("unrecognized structure type"),
2188 keyword_count = Dynarr_length (st->keywords);
2189 while (!NILP (list))
2191 Lisp_Object keyword, value;
2193 struct structure_keyword_entry *en = NULL;
2195 keyword = Fcar (list);
2197 value = Fcar (list);
2200 if (!NILP (memq_no_quit (keyword, already_seen)))
2201 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2202 list2 (build_translated_string
2203 ("structure keyword already seen"),
2206 for (i = 0; i < keyword_count; i++)
2208 en = Dynarr_atp (st->keywords, i);
2209 if (EQ (keyword, en->keyword))
2213 if (i == keyword_count)
2214 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2215 list2 (build_translated_string
2216 ("unrecognized structure keyword"),
2219 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
2221 (Fsignal (Qinvalid_read_syntax,
2222 list3 (build_translated_string
2223 ("invalid value for structure keyword"),
2226 already_seen = Fcons (keyword, already_seen);
2229 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
2230 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2231 list2 (build_translated_string
2232 ("invalid structure initializer"),
2235 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
2239 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
2241 static Lisp_Object read_vector (Lisp_Object readcharfun, Emchar terminator);
2243 /* Get the next character; filter out whitespace and comments */
2246 reader_nextchar (Lisp_Object readcharfun)
2248 /* This function can GC */
2253 c = readchar (readcharfun);
2255 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2261 /* Ignore whitespace and control characters */
2270 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
2279 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
2281 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
2285 /* Read the next Lisp object from the stream READCHARFUN and return it.
2286 If the return value is a cons whose car is Qunbound, then read1()
2287 encountered a misplaced token (e.g. a right bracket, right paren,
2288 or dot followed by a non-number). To filter this stuff out,
2292 read1 (Lisp_Object readcharfun)
2297 c = reader_nextchar (readcharfun);
2303 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2304 /* if this is disabled, then other code in eval.c must be enabled */
2305 Emchar ch = reader_nextchar (readcharfun);
2311 int speccount = specpdl_depth ();
2312 ++old_backquote_flag;
2313 record_unwind_protect (backquote_unwind,
2314 make_opaque_ptr (&old_backquote_flag));
2315 tem = read0 (readcharfun);
2316 unbind_to (speccount, Qnil);
2317 ch = reader_nextchar (readcharfun);
2320 unreadchar (readcharfun, ch);
2321 return Fsignal (Qinvalid_read_syntax,
2323 ("Weird old-backquote syntax")));
2325 return list2 (Qbacktick, tem);
2329 if (old_backquote_flag)
2331 Lisp_Object tem, comma_type;
2332 ch = readchar (readcharfun);
2334 comma_type = Qcomma_at;
2338 unreadchar (readcharfun, ch);
2339 comma_type = Qcomma;
2341 tem = read0 (readcharfun);
2342 ch = reader_nextchar (readcharfun);
2345 unreadchar (readcharfun, ch);
2346 return Fsignal (Qinvalid_read_syntax,
2348 ("Weird old-backquote syntax")));
2350 return list2 (comma_type, tem);
2354 unreadchar (readcharfun, ch);
2356 return Fsignal (Qinvalid_read_syntax,
2357 list1 (build_string ("Comma outside of backquote")));
2359 /* #### - yuck....but this is reverse compatible. */
2360 /* mostly this is required by edebug, which does its own
2361 annotated reading. We need to have an annotated_read
2362 function that records (with markers) the buffer
2363 positions of the elements that make up lists, then that
2364 can be used in edebug and bytecomp and the check above
2365 can go back in. --Stig */
2371 unreadchar (readcharfun, ch);
2373 #endif /* old backquote crap... */
2374 return read_list (readcharfun, ')', 1, 1);
2377 return read_vector (readcharfun, ']');
2381 /* #### - huh? these don't do what they seem... */
2382 return noseeum_cons (Qunbound, make_char (c));
2385 #ifdef LISP_FLOAT_TYPE
2386 /* If a period is followed by a number, then we should read it
2387 as a floating point number. Otherwise, it denotes a dotted
2390 c = readchar (readcharfun);
2391 unreadchar (readcharfun, c);
2393 /* Can't use isdigit on Emchars */
2394 if (c < '0' || c > '9')
2395 return noseeum_cons (Qunbound, make_char ('.'));
2397 /* Note that read_atom will loop
2398 at least once, assuring that we will not try to UNREAD
2399 two characters in a row.
2400 (I think this doesn't matter anymore because there should
2401 be no more danger in unreading multiple characters) */
2402 return read_atom (readcharfun, '.', 0);
2404 #else /* ! LISP_FLOAT_TYPE */
2405 return noseeum_cons (Qunbound, make_char ('.'));
2406 #endif /* ! LISP_FLOAT_TYPE */
2411 c = readchar (readcharfun);
2414 #if 0 /* FSFmacs silly char-table syntax */
2417 #if 0 /* FSFmacs silly bool-vector syntax */
2420 /* "#["-- byte-code constant syntax */
2421 /* purecons #[...] syntax */
2422 case '[': return read_compiled_function (readcharfun, ']'
2423 /*, purify_flag */ );
2424 /* "#:"-- gensym syntax */
2425 case ':': return read_atom (readcharfun, -1, 1);
2426 /* #'x => (function x) */
2427 case '\'': return list2 (Qfunction, read0 (readcharfun));
2429 /* RMS uses this syntax for fat-strings.
2430 If we use it for vectors, then obscure bugs happen.
2432 /* "#(" -- Scheme/CL vector syntax */
2433 case '(': return read_vector (readcharfun, ')');
2439 struct gcpro gcpro1;
2441 /* Read the string itself. */
2442 tmp = read1 (readcharfun);
2445 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
2446 free_cons (XCONS (tmp));
2447 return Fsignal (Qinvalid_read_syntax,
2448 list1 (build_string ("#")));
2451 /* Read the intervals and their properties. */
2454 Lisp_Object beg, end, plist;
2458 beg = read1 (readcharfun);
2459 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
2461 ch = XCHAR (XCDR (beg));
2462 free_cons (XCONS (beg));
2470 end = read1 (readcharfun);
2471 if (CONSP (end) && UNBOUNDP (XCAR (end)))
2473 free_cons (XCONS (end));
2479 plist = read1 (readcharfun);
2480 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
2482 free_cons (XCONS (plist));
2488 (Fsignal (Qinvalid_read_syntax,
2490 (build_string ("invalid string property list"),
2492 Fset_text_properties (beg, end, plist, tmp);
2500 /* #@NUMBER is used to skip NUMBER following characters.
2501 That's used in .elc files to skip over doc strings
2502 and function definitions. */
2505 /* Read a decimal integer. */
2506 while ((c = readchar (readcharfun)) >= 0
2507 && c >= '0' && c <= '9')
2508 nskip = (10 * nskip) + (c - '0');
2510 unreadchar (readcharfun, c);
2512 /* FSF has code here that maybe caches the skipped
2513 string. See above for why this is totally
2514 losing. We handle this differently. */
2516 /* Skip that many characters. */
2517 for (i = 0; i < nskip && c >= 0; i++)
2518 c = readchar (readcharfun);
2522 case '$': return Vload_file_name_internal;
2524 case '*': return read_bit_vector (readcharfun);
2525 /* #o10 => 8 -- octal constant syntax */
2526 case 'o': return read_integer (readcharfun, 8);
2527 /* #xdead => 57005 -- hex constant syntax */
2528 case 'x': return read_integer (readcharfun, 16);
2529 /* #b010 => 2 -- binary constant syntax */
2530 case 'b': return read_integer (readcharfun, 2);
2531 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
2532 case 's': return read_structure (readcharfun);
2535 unreadchar (readcharfun, c);
2536 return Fsignal (Qinvalid_read_syntax,
2537 list1 (build_string ("Cannot read unreadable object")));
2539 #ifdef FEATUREP_SYNTAX
2543 Lisp_Object feature_exp, obj, tem;
2544 struct gcpro gcpro1, gcpro2;
2546 feature_exp = read0(readcharfun);
2547 obj = read0(readcharfun);
2549 /* the call to `featurep' may GC. */
2550 GCPRO2 (feature_exp, obj);
2551 tem = call1 (Qfeaturep, feature_exp);
2554 if (c == '+' && NILP(tem)) goto retry;
2555 if (c == '-' && !NILP(tem)) goto retry;
2559 case '0': case '1': case '2': case '3': case '4':
2560 case '5': case '6': case '7': case '8': case '9':
2561 /* Reader forms that can reuse previously read objects. */
2566 /* Using read_integer() here is impossible, because it
2567 chokes on `='. Using parse_integer() is too hard.
2568 So we simply read it in, and ignore overflows, which
2570 while (c >= '0' && c <= '9')
2574 c = readchar (readcharfun);
2576 found = assq_no_quit (make_int (n), Vread_objects);
2579 /* #n=object returns object, but associates it with
2583 return Fsignal (Qinvalid_read_syntax,
2584 list2 (build_translated_string
2585 ("Multiply defined symbol label"),
2587 obj = read0 (readcharfun);
2588 Vread_objects = Fcons (Fcons (make_int (n), obj),
2594 /* #n# returns a previously read object. */
2596 return XCDR (found);
2598 return Fsignal (Qinvalid_read_syntax,
2599 list2 (build_translated_string
2600 ("Undefined symbol label"),
2603 return Fsignal (Qinvalid_read_syntax,
2604 list1 (build_string ("#")));
2608 unreadchar (readcharfun, c);
2609 return Fsignal (Qinvalid_read_syntax,
2610 list1 (build_string ("#")));
2616 case '\'': return list2 (Qquote, read0 (readcharfun));
2618 #ifdef LISP_BACKQUOTES
2622 int speccount = specpdl_depth ();
2623 ++new_backquote_flag;
2624 record_unwind_protect (backquote_unwind,
2625 make_opaque_ptr (&new_backquote_flag));
2626 tem = read0 (readcharfun);
2627 unbind_to (speccount, Qnil);
2628 return list2 (Qbackquote, tem);
2633 if (new_backquote_flag)
2635 Lisp_Object comma_type = Qnil;
2636 int ch = readchar (readcharfun);
2639 comma_type = Qcomma_at;
2641 comma_type = Qcomma_dot;
2645 unreadchar (readcharfun, ch);
2646 comma_type = Qcomma;
2648 return list2 (comma_type, read0 (readcharfun));
2652 /* YUCK. 99.999% backwards compatibility. The Right
2653 Thing(tm) is to signal an error here, because it's
2654 really invalid read syntax. Instead, this permits
2655 commas to begin symbols (unless they're inside
2656 backquotes). If an error is signalled here in the
2657 future, then commas should be invalid read syntax
2658 outside of backquotes anywhere they're found (i.e.
2659 they must be quoted in symbols) -- Stig */
2660 return read_atom (readcharfun, c, 0);
2667 /* Evil GNU Emacs "character" (ie integer) syntax */
2668 c = readchar (readcharfun);
2670 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2673 c = read_escape (readcharfun);
2674 return make_char (c);
2681 /* #### If the input stream is translating, then the string
2682 should be marked as translatable by setting its
2683 `string-translatable' property to t. .el and .elc files
2684 normally are translating input streams. See Fgettext()
2685 and print_internal(). */
2689 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
2690 while ((c = readchar (readcharfun)) >= 0
2694 c = read_escape (readcharfun);
2695 /* c is -1 if \ newline has just been seen */
2698 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
2702 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
2706 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2708 /* If purifying, and string starts with \ newline,
2709 return zero instead. This is for doc strings
2710 that we are really going to find in lib-src/DOC.nn.nn */
2711 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
2714 Lstream_flush (XLSTREAM (Vread_buffer_stream));
2717 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2718 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2723 /* Ignore whitespace and control characters */
2726 return read_atom (readcharfun, c, 0);
2733 #ifdef LISP_FLOAT_TYPE
2742 isfloat_string (const char *cp)
2745 const Bufbyte *ucp = (const Bufbyte *) cp;
2747 if (*ucp == '+' || *ucp == '-')
2750 if (*ucp >= '0' && *ucp <= '9')
2753 while (*ucp >= '0' && *ucp <= '9')
2761 if (*ucp >= '0' && *ucp <= '9')
2764 while (*ucp >= '0' && *ucp <= '9')
2767 if (*ucp == 'e' || *ucp == 'E')
2771 if ((*ucp == '+') || (*ucp == '-'))
2775 if (*ucp >= '0' && *ucp <= '9')
2778 while (*ucp >= '0' && *ucp <= '9')
2781 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
2782 || (*ucp == '\r') || (*ucp == '\f'))
2783 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
2784 || state == (DOT_CHAR|TRAIL_INT)
2785 || state == (LEAD_INT|E_CHAR|EXP_INT)
2786 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2787 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
2789 #endif /* LISP_FLOAT_TYPE */
2792 sequence_reader (Lisp_Object readcharfun,
2795 void * (*conser) (Lisp_Object readcharfun,
2796 void *state, Charcount len))
2800 for (len = 0; ; len++)
2805 ch = reader_nextchar (readcharfun);
2807 if (ch == terminator)
2810 unreadchar (readcharfun, ch);
2811 #ifdef FEATUREP_SYNTAX
2813 read_syntax_error ("\"]\" in a list");
2815 read_syntax_error ("\")\" in a vector");
2817 state = ((conser) (readcharfun, state, len));
2822 struct read_list_state
2827 int allow_dotted_lists;
2832 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
2834 struct read_list_state *s = (struct read_list_state *) state;
2837 elt = read1 (readcharfun);
2839 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2841 Lisp_Object tem = elt;
2845 free_cons (XCONS (tem));
2848 #ifdef FEATUREP_SYNTAX
2849 if (ch == s->terminator) /* deal with #+, #- reader macros */
2851 unreadchar (readcharfun, s->terminator);
2855 read_syntax_error ("']' in a list");
2857 read_syntax_error ("')' in a vector");
2861 signal_simple_error ("BUG! Internal reader error", elt);
2862 else if (!s->allow_dotted_lists)
2863 read_syntax_error ("\".\" in a vector");
2866 if (!NILP (s->tail))
2867 XCDR (s->tail) = read0 (readcharfun);
2869 s->head = read0 (readcharfun);
2870 elt = read1 (readcharfun);
2871 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2873 ch = XCHAR (XCDR (elt));
2874 free_cons (XCONS (elt));
2875 if (ch == s->terminator)
2877 unreadchar (readcharfun, s->terminator);
2881 read_syntax_error (". in wrong context");
2885 #if 0 /* FSFmacs defun hack, or something ... */
2886 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
2888 record_unwind_protect (unreadpure, Qzero);
2893 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2894 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
2896 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
2897 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
2899 Vcurrent_compiled_function_annotation = elt;
2903 elt = Fcons (elt, Qnil);
2904 if (!NILP (s->tail))
2905 XCDR (s->tail) = elt;
2915 #if 0 /* FSFmacs defun hack */
2916 /* -1 for allow_dotted_lists means allow_dotted_lists and check
2917 for starting with defun and make structure pure. */
2921 read_list (Lisp_Object readcharfun,
2923 int allow_dotted_lists,
2924 int check_for_doc_references)
2926 struct read_list_state s;
2927 struct gcpro gcpro1, gcpro2;
2928 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2929 Lisp_Object old_compiled_function_annotation =
2930 Vcurrent_compiled_function_annotation;
2936 s.allow_dotted_lists = allow_dotted_lists;
2937 s.terminator = terminator;
2938 GCPRO2 (s.head, s.tail);
2940 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2941 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2942 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
2945 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
2947 /* check now for any doc string references and record them
2951 /* We might be dealing with an imperfect list so don't
2953 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
2955 Lisp_Object holding_cons = Qnil;
2958 Lisp_Object elem = XCAR (tail);
2959 /* elem might be (#$ . INT) ... */
2960 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2961 holding_cons = tail;
2962 /* or it might be (quote (#$ . INT)) i.e.
2963 (quote . ((#$ . INT) . nil)) in the case of
2964 `autoload' (autoload evaluates its arguments, while
2965 `defvar', `defun', etc. don't). */
2966 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
2967 && CONSP (XCDR (elem)))
2969 elem = XCAR (XCDR (elem));
2970 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2971 holding_cons = XCDR (XCAR (tail));
2975 if (CONSP (holding_cons))
2979 if (NILP (Vinternal_doc_file_name))
2980 /* We have not yet called Snarf-documentation, so
2981 assume this file is described in the DOC file
2982 and Snarf-documentation will fill in the right
2983 value later. For now, replace the whole list
2985 XCAR (holding_cons) = Qzero;
2987 /* We have already called Snarf-documentation, so
2988 make a relative file name for this file, so it
2989 can be found properly in the installed Lisp
2990 directory. We don't use Fexpand_file_name
2991 because that would make the directory absolute
2993 XCAR (XCAR (holding_cons)) =
2994 concat2 (build_string ("../lisp/"),
2995 Ffile_name_nondirectory
2996 (Vload_file_name_internal));
2999 /* Not pure. Just add to Vload_force_doc_string_list,
3000 and the string will be filled in properly in
3001 load_force_doc_string_unwind(). */
3002 Vload_force_doc_string_list =
3003 /* We pass the cons that holds the (#$ . INT) so we
3004 can modify it in-place. */
3005 Fcons (holding_cons, Vload_force_doc_string_list);
3015 read_vector (Lisp_Object readcharfun,
3022 struct read_list_state s;
3023 struct gcpro gcpro1, gcpro2;
3028 s.allow_dotted_lists = 0;
3029 GCPRO2 (s.head, s.tail);
3031 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3035 len = XINT (Flength (tem));
3037 #if 0 /* FSFmacs defun hack */
3039 s.head = make_pure_vector (len, Qnil);
3042 s.head = make_vector (len, Qnil);
3044 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
3048 Lisp_Cons *otem = XCONS (tem);
3058 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
3060 /* Accept compiled functions at read-time so that we don't
3061 have to build them at load-time. */
3063 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3064 struct gcpro gcpro1;
3067 int saw_a_doc_ref = 0;
3069 /* Note: we tell read_list not to search for doc references
3070 because we need to handle the "doc reference" for the
3071 instructions and constants differently. */
3072 stuff = read_list (readcharfun, terminator, 0, 0);
3073 len = XINT (Flength (stuff));
3074 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3076 continuable_read_syntax_error ("#[...] used with wrong number of elements");
3078 for (iii = 0; CONSP (stuff); iii++)
3080 Lisp_Cons *victim = XCONS (stuff);
3081 make_byte_code_args[iii] = Fcar (stuff);
3082 if ((purify_flag || load_force_doc_strings)
3083 && CONSP (make_byte_code_args[iii])
3084 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
3086 if (purify_flag && iii == COMPILED_DOC_STRING)
3088 /* same as in read_list(). */
3089 if (NILP (Vinternal_doc_file_name))
3090 make_byte_code_args[iii] = Qzero;
3092 XCAR (make_byte_code_args[iii]) =
3093 concat2 (build_string ("../lisp/"),
3094 Ffile_name_nondirectory
3095 (Vload_file_name_internal));
3100 stuff = Fcdr (stuff);
3103 GCPRO1 (make_byte_code_args[0]);
3106 /* v18 or v19 bytecode file. Need to Ebolify. */
3107 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
3108 ebolify_bytecode_constants (make_byte_code_args[2]);
3110 /* make-byte-code looks at purify_flag, which should have the same
3111 * value as our "read-pure" argument */
3112 stuff = Fmake_byte_code (len, make_byte_code_args);
3113 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
3115 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
3127 load_in_progress = 0;
3129 Vload_descriptor_list = Qnil;
3131 /* kludge: locate-file does not work for a null load-path, even if
3132 the file name is absolute. */
3134 Vload_path = Fcons (build_string (""), Qnil);
3136 /* This used to get initialized in init_lread because all streams
3137 got closed when dumping occurs. This is no longer true --
3138 Vread_buffer_stream is a resizing output stream, and there is no
3139 reason to close it at dump-time.
3141 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3142 will initialize it only once, at dump-time. */
3143 if (NILP (Vread_buffer_stream))
3144 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3146 Vload_force_doc_string_list = Qnil;
3150 syms_of_lread (void)
3153 DEFSUBR (Fread_from_string);
3154 DEFSUBR (Fload_internal);
3155 DEFSUBR (Flocate_file);
3156 DEFSUBR (Flocate_file_clear_hashing);
3157 DEFSUBR (Feval_buffer);
3158 DEFSUBR (Feval_region);
3160 defsymbol (&Qstandard_input, "standard-input");
3161 defsymbol (&Qread_char, "read-char");
3162 defsymbol (&Qcurrent_load_list, "current-load-list");
3163 defsymbol (&Qload, "load");
3164 defsymbol (&Qload_file_name, "load-file-name");
3165 defsymbol (&Qfset, "fset");
3167 #ifdef LISP_BACKQUOTES
3168 defsymbol (&Qbackquote, "backquote");
3169 defsymbol (&Qbacktick, "`");
3170 defsymbol (&Qcomma, ",");
3171 defsymbol (&Qcomma_at, ",@");
3172 defsymbol (&Qcomma_dot, ",.");
3175 defsymbol (&Qexists, "exists");
3176 defsymbol (&Qreadable, "readable");
3177 defsymbol (&Qwritable, "writable");
3178 defsymbol (&Qexecutable, "executable");
3182 structure_type_create (void)
3184 the_structure_type_dynarr = Dynarr_new (structure_type);
3188 reinit_vars_of_lread (void)
3190 Vread_buffer_stream = Qnil;
3191 staticpro_nodump (&Vread_buffer_stream);
3195 vars_of_lread (void)
3197 reinit_vars_of_lread ();
3199 DEFVAR_LISP ("values", &Vvalues /*
3200 List of values of all expressions which were read, evaluated and printed.
3201 Order is reverse chronological.
3204 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3205 Stream for read to get input from.
3206 See documentation of `read' for possible values.
3208 Vstandard_input = Qt;
3210 DEFVAR_LISP ("load-path", &Vload_path /*
3211 *List of directories to search for files to load.
3212 Each element is a string (directory name) or nil (try default directory).
3214 Note that the elements of this list *may not* begin with "~", so you must
3215 call `expand-file-name' on them before adding them to this list.
3217 Initialized based on EMACSLOADPATH environment variable, if any,
3218 otherwise to default specified in by file `paths.h' when XEmacs was built.
3219 If there were no paths specified in `paths.h', then XEmacs chooses a default
3220 value for this variable by looking around in the file-system near the
3221 directory in which the XEmacs executable resides.
3225 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3226 "*Location of lisp files to be used when dumping ONLY."); */
3228 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3229 Non-nil iff inside of `load'.
3232 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3233 An alist of expressions to be evalled when particular files are loaded.
3234 Each element looks like (FILENAME FORMS...).
3235 When `load' is run and the file-name argument is FILENAME,
3236 the FORMS in the corresponding element are executed at the end of loading.
3238 FILENAME must match exactly! Normally FILENAME is the name of a library,
3239 with no directory specified, since that is how `load' is normally called.
3240 An error in FORMS does not undo the load,
3241 but does prevent execution of the rest of the FORMS.
3243 Vafter_load_alist = Qnil;
3245 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3246 *Whether `load' should check whether the source is newer than the binary.
3247 If this variable is true, then when a `.elc' file is being loaded and the
3248 corresponding `.el' is newer, a warning message will be printed.
3250 load_warn_when_source_newer = 0;
3252 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3253 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3254 If this variable is true, then when `load' is called with a filename without
3255 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3256 then a message will be printed. If an explicit extension is passed to `load',
3257 no warning will be printed.
3259 load_warn_when_source_only = 0;
3261 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3262 *Whether `load' should ignore `.elc' files when a suffix is not given.
3263 This is normally used only to bootstrap the `.elc' files when building XEmacs.
3265 load_ignore_elc_files = 0;
3268 DEFVAR_LISP ("load-history", &Vload_history /*
3269 Alist mapping source file names to symbols and features.
3270 Each alist element is a list that starts with a file name,
3271 except for one element (optional) that starts with nil and describes
3272 definitions evaluated from buffers not visiting files.
3273 The remaining elements of each list are symbols defined as functions
3274 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3276 Vload_history = Qnil;
3278 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3279 Used for internal purposes by `load'.
3281 Vcurrent_load_list = Qnil;
3284 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3285 Full name of file being loaded by `load'.
3287 Vload_file_name = Qnil;
3289 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3290 Function used by `load' and `eval-region' for reading expressions.
3291 The default is nil, which means use the function `read'.
3293 Vload_read_function = Qnil;
3295 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3296 Non-nil means `load' should force-load all dynamic doc strings.
3297 This is useful when the file being loaded is a temporary copy.
3299 load_force_doc_strings = 0;
3301 /* See read_escape(). */
3303 /* Used to be named `puke-on-fsf-keys' */
3304 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3305 &fail_on_bucky_bit_character_escapes /*
3306 Whether `read' should signal an error when it encounters unsupported
3307 character escape syntaxes or just read them incorrectly.
3309 fail_on_bucky_bit_character_escapes = 0;
3312 /* This must be initialized in init_lread otherwise it may start out
3313 with values saved when the image is dumped. */
3314 staticpro (&Vload_descriptor_list);
3316 /* Initialized in init_lread. */
3317 staticpro (&Vload_force_doc_string_list);
3319 Vload_file_name_internal = Qnil;
3320 staticpro (&Vload_file_name_internal);
3322 Vload_file_name_internal_the_purecopy = Qnil;
3323 staticpro (&Vload_file_name_internal_the_purecopy);
3325 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3326 Vcurrent_compiled_function_annotation = Qnil;
3327 staticpro (&Vcurrent_compiled_function_annotation);
3330 /* So that early-early stuff will work */
3331 Ffset (Qload, intern ("load-internal"));
3333 #ifdef FEATUREP_SYNTAX
3334 defsymbol (&Qfeaturep, "featurep");
3335 Fprovide(intern("xemacs"));
3337 Fprovide(intern("infodock"));
3338 #endif /* INFODOCK */
3339 #endif /* FEATUREP_SYNTAX */
3341 #ifdef LISP_BACKQUOTES
3342 old_backquote_flag = new_backquote_flag = 0;
3346 Vfile_domain = Qnil;
3349 Vread_objects = Qnil;
3350 staticpro (&Vread_objects);
3352 Vlocate_file_hash_table = make_lisp_hash_table (200,
3353 HASH_TABLE_NON_WEAK,
3355 staticpro (&Vlocate_file_hash_table);
3357 symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
3358 = Vlocate_file_hash_table;