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 syntax_error (CONST char *string)
223 signal_error (Qinvalid_read_syntax,
224 list1 (build_translated_string (string)));
228 continuable_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 */
262 if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
263 else if (c == '\n') fprintf (stderr, "\\n\n");
264 else fprintf (stderr, "\\%o ", c);
269 else if (MARKERP (readcharfun))
272 Bufpos mpos = marker_position (readcharfun);
273 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
275 if (mpos >= BUF_ZV (inbuffer))
277 c = BUF_FETCH_CHAR (inbuffer, mpos);
278 set_marker_position (readcharfun, mpos + 1);
283 Lisp_Object tem = call0 (readcharfun);
285 if (!CHAR_OR_CHAR_INTP (tem))
287 return XCHAR_OR_CHAR_INT (tem);
291 /* Unread the character C in the way appropriate for the stream READCHARFUN.
292 If the stream is a user function, call it with the char as argument. */
295 unreadchar (Lisp_Object readcharfun, Emchar c)
298 /* Don't back up the pointer if we're unreading the end-of-input mark,
299 since readchar didn't advance it when we read it. */
301 else if (BUFFERP (readcharfun))
302 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
303 else if (LSTREAMP (readcharfun))
305 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
306 #ifdef DEBUG_XEMACS /* testing Mule */
308 static int testing_mule = 0; /* Set this using debugger */
311 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
312 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
316 else if (MARKERP (readcharfun))
317 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
319 call1 (readcharfun, make_char (c));
322 static Lisp_Object read0 (Lisp_Object readcharfun);
323 static Lisp_Object read1 (Lisp_Object readcharfun);
324 /* allow_dotted_lists means that something like (foo bar . baz)
325 is acceptable. If -1, means check for starting with defun
326 and make structure pure. (not implemented, probably for very
330 If check_for_doc_references, look for (#$ . INT) doc references
331 in the list and record if load_force_doc_strings is non-zero.
332 (Such doc references will be destroyed during the loadup phase
333 by replacing with Qzero, because Snarf-documentation will fill
336 WARNING: If you set this, you sure as hell better not call
337 free_list() on the returned list here. */
339 static Lisp_Object read_list (Lisp_Object readcharfun,
341 int allow_dotted_lists,
342 int check_for_doc_references);
344 static void readevalloop (Lisp_Object readcharfun,
345 Lisp_Object sourcefile,
346 Lisp_Object (*evalfun) (Lisp_Object),
350 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
352 Lstream_close (XLSTREAM (stream));
353 if (--load_in_progress < 0)
354 load_in_progress = 0;
359 load_descriptor_unwind (Lisp_Object oldlist)
361 Vload_descriptor_list = oldlist;
366 load_file_name_internal_unwind (Lisp_Object oldval)
368 Vload_file_name_internal = oldval;
373 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
375 Vload_file_name_internal_the_purecopy = oldval;
380 load_byte_code_version_unwind (Lisp_Object oldval)
382 load_byte_code_version = XINT (oldval);
386 /* The plague is coming.
388 Ring around the rosy, pocket full of posy,
389 Ashes ashes, they all fall down.
392 ebolify_bytecode_constants (Lisp_Object vector)
394 int len = XVECTOR_LENGTH (vector);
397 for (i = 0; i < len; i++)
399 Lisp_Object el = XVECTOR_DATA (vector)[i];
401 /* We don't check for `eq', `equal', and the others that have
402 bytecode opcodes. This might lose if someone passes #'eq or
403 something to `funcall', but who would really do that? As
404 they say in law, we've made a "good-faith effort" to
405 unfuckify ourselves. And doing it this way avoids screwing
406 up args to `make-hash-table' and such. As it is, we have to
407 add an extra Ebola check in decode_weak_list_type(). --ben */
408 if (EQ (el, Qassoc)) el = Qold_assoc;
409 else if (EQ (el, Qdelq)) el = Qold_delq;
411 /* I think this is a bad idea because it will probably mess
413 else if (EQ (el, Qdelete)) el = Qold_delete;
415 else if (EQ (el, Qrassq)) el = Qold_rassq;
416 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
418 XVECTOR_DATA (vector)[i] = el;
423 pas_de_lache_ici (int fd, Lisp_Object victim)
428 if (!INTP (XCDR (victim)))
429 signal_simple_error ("Bogus doc string reference", victim);
430 pos = XINT (XCDR (victim));
432 pos = -pos; /* kludge to mark a user variable */
433 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
435 signal_error (Qerror, tem);
440 load_force_doc_string_unwind (Lisp_Object oldlist)
443 Lisp_Object list = Vload_force_doc_string_list;
445 int fd = XINT (XCAR (Vload_descriptor_list));
448 /* restore the old value first just in case an error occurs. */
449 Vload_force_doc_string_list = oldlist;
451 LIST_LOOP (tail, list)
453 Lisp_Object john = Fcar (tail);
456 assert (CONSP (XCAR (john)));
457 assert (!purify_flag); /* should have been handled in read_list() */
458 XCAR (john) = pas_de_lache_ici (fd, XCAR (john));
464 assert (COMPILED_FUNCTIONP (john));
465 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
467 struct gcpro ngcpro1;
468 Lisp_Object juan = (pas_de_lache_ici
469 (fd, XCOMPILED_FUNCTION (john)->instructions));
475 signal_simple_error ("invalid lazy-loaded byte code", ivan);
476 XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
477 /* v18 or v19 bytecode file. Need to Ebolify. */
478 if (XCOMPILED_FUNCTION (john)->flags.ebolified
479 && VECTORP (XCDR (ivan)))
480 ebolify_bytecode_constants (XCDR (ivan));
481 XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
484 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
487 assert (!purify_flag); /* should have been handled in
488 read_compiled_function() */
489 doc = pas_de_lache_ici (fd, doc);
490 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
503 /* Close all descriptors in use for Fload_internal.
504 This is used when starting a subprocess. */
507 close_load_descs (void)
510 LIST_LOOP (tail, Vload_descriptor_list)
511 close (XINT (XCAR (tail)));
515 Lisp_Object Vfile_domain;
518 restore_file_domain (Lisp_Object val)
525 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
526 Execute a file of Lisp code named FILE; no coding-system frobbing.
527 This function is identical to `load' except for the handling of the
528 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
529 support is not present, both functions are identical and ignore the
530 CODESYS and USED-CODESYS arguments.)
532 If support for Mule exists in this Emacs, the file is decoded
533 according to CODESYS; if omitted, no conversion happens. If
534 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
535 system that was used for the decoding is stored into it. It will in
536 general be different from CODESYS if CODESYS specifies automatic
537 encoding detection or end-of-line detection.
539 (file, no_error, nomessage, nosuffix, codesys, used_codesys))
541 /* This function can GC */
543 int speccount = specpdl_depth ();
545 Lisp_Object newer = Qnil;
546 Lisp_Object handler = Qnil;
547 Lisp_Object found = Qnil;
548 struct gcpro gcpro1, gcpro2, gcpro3;
550 int message_p = NILP (nomessage);
551 /*#ifdef DEBUG_XEMACS*/
552 static Lisp_Object last_file_loaded;
555 GCPRO3 (file, newer, found);
559 /*#ifdef DEBUG_XEMACS*/
560 if (purify_flag && noninteractive)
563 last_file_loaded = file;
565 /*#endif / * DEBUG_XEMACS */
567 /* If file name is magic, call the handler. */
568 handler = Ffind_file_name_handler (file, Qload);
570 RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
571 nomessage, nosuffix));
573 /* Do this after the handler to avoid
574 the need to gcpro noerror, nomessage and nosuffix.
575 (Below here, we care only whether they are nil or not.) */
576 file = Fsubstitute_in_file_name (file);
578 if (!NILP (used_codesys))
579 CHECK_SYMBOL (used_codesys);
582 /* Avoid weird lossage with null string as arg,
583 since it would try to load a directory as a Lisp file.
585 if (XSTRING_LENGTH (file) > 0)
590 fd = locate_file (Vload_path, file,
591 ((!NILP (nosuffix)) ? Qnil :
592 build_string (load_ignore_elc_files ? ".el:" :
600 signal_file_error ("Cannot open load file", file);
608 foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
609 strcpy (foundstr, (char *) XSTRING_DATA (found));
610 foundlen = strlen (foundstr);
612 /* The omniscient JWZ thinks this is worthless, but I beg to
614 if (load_ignore_elc_files)
616 newer = Ffile_name_nondirectory (found);
618 else if (load_warn_when_source_newer &&
619 !memcmp (".elc", foundstr + foundlen - 4, 4))
621 if (! fstat (fd, &s1)) /* can't fail, right? */
624 /* temporarily hack the 'c' off the end of the filename */
625 foundstr[foundlen - 1] = '\0';
626 result = stat (foundstr, &s2);
628 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
630 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
632 struct gcpro nngcpro1;
633 NNGCPRO1 (newer_name);
634 newer = Ffile_name_nondirectory (newer_name);
637 /* put the 'c' back on (kludge-o-rama) */
638 foundstr[foundlen - 1] = 'c';
641 else if (load_warn_when_source_only &&
642 /* `found' ends in ".el" */
643 !memcmp (".el", foundstr + foundlen - 3, 3) &&
644 /* `file' does not end in ".el" */
646 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
652 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
656 #define PRINT_LOADING_MESSAGE(done) do { \
657 if (load_ignore_elc_files) \
660 message ("Loading %s..." done, XSTRING_DATA (newer)); \
662 else if (!NILP (newer)) \
663 message ("Loading %s..." done " (file %s is newer)", \
664 XSTRING_DATA (file), \
665 XSTRING_DATA (newer)); \
666 else if (source_only) \
667 message ("Loading %s..." done " (file %s.elc does not exist)", \
668 XSTRING_DATA (file), \
669 XSTRING_DATA (Ffile_name_nondirectory (file))); \
670 else if (message_p) \
671 message ("Loading %s..." done, XSTRING_DATA (file)); \
674 PRINT_LOADING_MESSAGE ("");
677 /* Lisp_Object's must be malloc'ed, not stack-allocated */
678 Lisp_Object lispstream = Qnil;
679 CONST int block_size = 8192;
680 struct gcpro ngcpro1;
682 NGCPRO1 (lispstream);
683 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
684 /* 64K is used for normal files; 8K should be OK here because Lisp
685 files aren't really all that big. */
686 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
689 lispstream = make_decoding_input_stream
690 (XLSTREAM (lispstream), Fget_coding_system (codesys));
691 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
694 /* NOTE: Order of these is very important. Don't rearrange them. */
695 record_unwind_protect (load_unwind, lispstream);
696 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
697 record_unwind_protect (load_file_name_internal_unwind,
698 Vload_file_name_internal);
699 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
700 Vload_file_name_internal_the_purecopy);
701 record_unwind_protect (load_force_doc_string_unwind,
702 Vload_force_doc_string_list);
703 Vload_file_name_internal = found;
704 Vload_file_name_internal_the_purecopy = Qnil;
705 specbind (Qload_file_name, found);
706 Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
707 Vload_force_doc_string_list = Qnil;
709 record_unwind_protect (restore_file_domain, Vfile_domain);
710 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
714 /* Now determine what sort of ELC file we're reading in. */
715 record_unwind_protect (load_byte_code_version_unwind,
716 make_int (load_byte_code_version));
722 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
724 || strncmp (elc_header, ";ELC", 4))
726 /* Huh? Probably not a valid ELC file. */
727 load_byte_code_version = 100; /* no Ebolification needed */
728 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
731 load_byte_code_version = elc_header[4];
734 load_byte_code_version = 100; /* no Ebolification needed */
736 readevalloop (lispstream, file, Feval, 0);
738 if (!NILP (used_codesys))
741 (decoding_stream_coding_system (XLSTREAM (lispstream))));
743 unbind_to (speccount, Qnil);
750 /* #### Disgusting kludge */
751 /* Run any load-hooks for this file. */
752 /* #### An even more disgusting kludge. There is horrible code */
753 /* that is relying on the fact that dumped lisp files are found */
754 /* via `load-path' search. */
755 Lisp_Object name = file;
757 if (!NILP(Ffile_name_absolute_p(file)))
759 name = Ffile_name_nondirectory(file);
763 struct gcpro ngcpro1;
766 tem = Fassoc (name, Vafter_load_alist);
771 struct gcpro ngcpro1;
774 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
775 tem = Fcons (Qprogn, Fcdr (tem));
781 /*#ifdef DEBUG_XEMACS*/
782 if (purify_flag && noninteractive)
784 if (!EQ (last_file_loaded, file))
785 message ("Loading %s ...done", XSTRING_DATA (file));
787 /*#endif / * DEBUG_XEMACS */
790 PRINT_LOADING_MESSAGE ("done");
797 /* ------------------------------- */
799 /* ------------------------------- */
802 decode_mode_1 (Lisp_Object mode)
804 if (EQ (mode, Qexists))
806 else if (EQ (mode, Qexecutable))
808 else if (EQ (mode, Qwritable))
810 else if (EQ (mode, Qreadable))
812 else if (INTP (mode))
814 check_int_range (XINT (mode), 0, 7);
818 signal_simple_error ("Invalid value", mode);
819 return 0; /* unreached */
823 decode_mode (Lisp_Object mode)
827 else if (CONSP (mode))
831 EXTERNAL_LIST_LOOP (tail, mode)
832 mask |= decode_mode_1 (XCAR (tail));
836 return decode_mode_1 (mode);
839 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
840 Search for FILENAME through PATH-LIST.
842 If SUFFIXES is non-nil, it should be a list of suffixes to append to
843 file name when searching.
845 If MODE is non-nil, it should be a symbol or a list of symbol representing
846 requirements. Allowed symbols are `exists', `executable', `writable', and
847 `readable'. If MODE is nil, it defaults to `readable'.
849 `locate-file' keeps hash tables of the directories it searches through,
850 in order to speed things up. It tries valiantly to not get confused in
851 the face of a changing and unpredictable environment, but can occasionally
852 get tripped up. In this case, you will have to call
853 `locate-file-clear-hashing' to get it back on track. See that function
856 (filename, path_list, suffixes, mode))
858 /* This function can GC */
861 CHECK_STRING (filename);
863 if (LISTP (suffixes))
866 EXTERNAL_LIST_LOOP (tail, suffixes)
867 CHECK_STRING (XCAR (tail));
870 CHECK_STRING (suffixes);
872 locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
876 /* Recalculate the hash table for the given string. DIRECTORY should
877 better have been through Fexpand_file_name() by now. */
880 locate_file_refresh_hashing (Lisp_Object directory)
883 make_directory_hash_table ((char *) XSTRING_DATA (directory));
886 Fputhash (directory, hash, Vlocate_file_hash_table);
890 /* find the hash table for the given directory, recalculating if necessary */
893 locate_file_find_directory_hash_table (Lisp_Object directory)
895 Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
897 return locate_file_refresh_hashing (directory);
902 /* The SUFFIXES argument in any of the locate_file* functions can be
903 nil, a list, or a string (for backward compatibility), with the
906 a) nil - no suffix, just search for file name intact
907 (semantically different from "empty suffix list", which
908 would be meaningless.)
909 b) list - list of suffixes to append to file name. Each of these
911 c) string - colon-separated suffixes to append to file name (backward
914 All of this got hairy, so I decided to use a mapper. Calling a
915 function for each suffix shouldn't slow things down, since
916 locate_file is rarely called with enough suffixes for funcalls to
917 make any difference. */
919 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
920 char * containing the current file name, and ARG. Mapping stops when
921 FUN returns non-zero. */
923 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
924 int (*fun) (char *, void *),
927 /* This function can GC */
931 /* Calculate maximum size of any filename made from
932 this path element/specified file name and any possible suffix. */
933 if (CONSP (suffixes))
935 /* We must traverse the list, so why not do it right. */
938 LIST_LOOP (tail, suffixes)
940 if (XSTRING_LENGTH (XCAR (tail)) > max)
941 max = XSTRING_LENGTH (XCAR (tail));
944 else if (NILP (suffixes))
947 /* Just take the easy way out */
948 max = XSTRING_LENGTH (suffixes);
950 fn_len = XSTRING_LENGTH (filename);
951 fn = (char *) alloca (max + fn_len + 1);
952 memcpy (fn, (char *) XSTRING_DATA (filename), fn_len);
954 /* Loop over suffixes. */
955 if (!STRINGP (suffixes))
959 /* Case a) discussed in the comment above. */
961 if ((*fun) (fn, arg))
968 LIST_LOOP (tail, suffixes)
970 memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
971 XSTRING_LENGTH (XCAR (tail)));
972 fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
973 if ((*fun) (fn, arg))
981 CONST char *nsuffix = (CONST char *) XSTRING_DATA (suffixes);
985 char *esuffix = (char *) strchr (nsuffix, ':');
986 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
988 /* Concatenate path element/specified name with the suffix. */
989 strncpy (fn + fn_len, nsuffix, lsuffix);
990 fn[fn_len + lsuffix] = 0;
992 if ((*fun) (fn, arg))
995 /* Advance to next suffix. */
998 nsuffix += lsuffix + 1;
1003 struct locate_file_in_directory_mapper_closure {
1005 Lisp_Object *storeptr;
1010 locate_file_in_directory_mapper (char *fn, void *arg)
1012 struct locate_file_in_directory_mapper_closure *closure =
1013 (struct locate_file_in_directory_mapper_closure *)arg;
1016 /* Ignore file if it's a directory. */
1017 if (stat (fn, &st) >= 0
1018 && (st.st_mode & S_IFMT) != S_IFDIR)
1020 /* Check that we can access or open it. */
1021 if (closure->mode >= 0)
1022 closure->fd = access (fn, closure->mode);
1024 closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
1026 if (closure->fd >= 0)
1028 /* We succeeded; return this descriptor and filename. */
1029 if (closure->storeptr)
1030 *closure->storeptr = build_string (fn);
1033 /* If we actually opened the file, set close-on-exec flag
1034 on the new descriptor so that subprocesses can't whack
1036 if (closure->mode < 0)
1037 (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
1048 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
1049 not have been expanded. */
1052 locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
1053 Lisp_Object suffixes, Lisp_Object *storeptr,
1056 /* This function can GC */
1057 struct locate_file_in_directory_mapper_closure closure;
1058 Lisp_Object filename = Qnil;
1059 struct gcpro gcpro1, gcpro2, gcpro3;
1061 GCPRO3 (directory, str, filename);
1063 filename = Fexpand_file_name (str, directory);
1064 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
1065 /* If there are non-absolute elts in PATH (eg ".") */
1066 /* Of course, this could conceivably lose if luser sets
1067 default-directory to be something non-absolute ... */
1069 if (NILP (filename))
1070 /* NIL means current directory */
1071 filename = current_buffer->directory;
1073 filename = Fexpand_file_name (filename,
1074 current_buffer->directory);
1075 if (NILP (Ffile_name_absolute_p (filename)))
1077 /* Give up on this directory! */
1084 closure.storeptr = storeptr;
1085 closure.mode = mode;
1087 locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
1094 /* do the same as locate_file() but don't use any hash tables. */
1097 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
1098 Lisp_Object suffixes, Lisp_Object *storeptr,
1101 /* This function can GC */
1102 int absolute = !NILP (Ffile_name_absolute_p (str));
1104 EXTERNAL_LIST_LOOP (path, path)
1106 int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
1117 locate_file_construct_suffixed_files_mapper (char *fn, void *arg)
1119 Lisp_Object *tail = (Lisp_Object *)arg;
1120 *tail = Fcons (build_string (fn), *tail);
1124 /* Construct a list of all files to search for.
1125 It makes sense to have this despite locate_file_map_suffixes()
1126 because we need Lisp strings to access the hash-table, and it would
1127 be inefficient to create them on the fly, again and again for each
1128 path component. See locate_file(). */
1131 locate_file_construct_suffixed_files (Lisp_Object filename,
1132 Lisp_Object suffixes)
1134 Lisp_Object tail = Qnil;
1135 struct gcpro gcpro1;
1138 locate_file_map_suffixes (filename, suffixes,
1139 locate_file_construct_suffixed_files_mapper,
1143 return Fnreverse (tail);
1146 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1147 Clear the hash records for the specified list of directories.
1148 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1149 track the following environmental changes:
1151 -- changes of any sort to the list of directories to be searched.
1152 -- addition and deletion of non-shadowing files (see below) from the
1153 directories in the list.
1154 -- byte-compilation of a .el file into a .elc file.
1156 `locate-file' will primarily get confused if you add a file that shadows
1157 \(i.e. has the same name as) another file further down in the directory list.
1158 In this case, you must call `locate-file-clear-hashing'.
1160 If PATH is t, it means to fully clear all the accumulated hashes. This
1161 can be used if the internal tables grow too large, or when dumping.
1166 Fclrhash (Vlocate_file_hash_table);
1169 Lisp_Object pathtail;
1170 EXTERNAL_LIST_LOOP (pathtail, path)
1172 Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
1173 Fremhash (pathel, Vlocate_file_hash_table);
1179 /* Search for a file whose name is STR, looking in directories
1180 in the Lisp list PATH, and trying suffixes from SUFFIXES.
1181 SUFFIXES is a list of possible suffixes, or (for backward
1182 compatibility) a string containing possible suffixes separated by
1184 On success, returns a file descriptor. On failure, returns -1.
1186 MODE nonnegative means don't open the files,
1187 just look for one for which access(file,MODE) succeeds. In this case,
1188 returns 1 on success.
1190 If STOREPTR is nonzero, it points to a slot where the name of
1191 the file actually found should be stored as a Lisp string.
1192 Nil is stored there on failure.
1194 Called openp() in FSFmacs. */
1197 locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1198 Lisp_Object *storeptr, int mode)
1200 /* This function can GC */
1201 Lisp_Object suffixtab = Qnil;
1202 Lisp_Object pathtail, pathel_expanded;
1204 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1209 /* Is it really necessary to gcpro path and str? It shouldn't be
1210 unless some caller has fucked up. There are known instances that
1211 call us with build_string("foo:bar") as SUFFIXES, though. */
1212 GCPRO4 (path, str, suffixes, suffixtab);
1214 /* if this filename has directory components, it's too complicated
1215 to try and use the hash tables. */
1216 if (!NILP (Ffile_name_directory (str)))
1218 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
1223 suffixtab = locate_file_construct_suffixed_files (str, suffixes);
1225 EXTERNAL_LIST_LOOP (pathtail, path)
1227 Lisp_Object pathel = XCAR (pathtail);
1228 Lisp_Object hash_table;
1232 /* If this path element is relative, we have to look by hand. */
1233 if (NILP (Ffile_name_absolute_p (pathel)))
1235 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
1245 pathel_expanded = Fexpand_file_name (pathel, Qnil);
1246 hash_table = locate_file_find_directory_hash_table (pathel_expanded);
1248 if (!NILP (hash_table))
1250 /* Loop over suffixes. */
1251 LIST_LOOP (tail, suffixtab)
1252 if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
1261 /* This is a likely candidate. Look by hand in this directory
1262 so we don't get thrown off if someone byte-compiles a file. */
1263 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
1271 /* Hmm ... the file isn't actually there. (Or possibly it's
1272 a directory ...) So refresh our hashing. */
1273 locate_file_refresh_hashing (pathel_expanded);
1277 /* File is probably not there, but check the hard way just in case. */
1278 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
1281 /* Sneaky user added a file without telling us. */
1282 Flocate_file_clear_hashing (path);
1292 /* Merge the list we've accumulated of globals from the current input source
1293 into the load_history variable. The details depend on whether
1294 the source has an associated file name or not. */
1297 build_load_history (int loading, Lisp_Object source)
1299 REGISTER Lisp_Object tail, prev, newelt;
1300 REGISTER Lisp_Object tem, tem2;
1303 #if !defined(LOADHIST_DUMPED)
1304 /* Don't bother recording anything for preloaded files. */
1309 tail = Vload_history;
1312 while (!NILP (tail))
1316 /* Find the feature's previous assoc list... */
1317 if (internal_equal (source, Fcar (tem), 0))
1321 /* If we're loading, remove it. */
1325 Vload_history = Fcdr (tail);
1327 Fsetcdr (prev, Fcdr (tail));
1330 /* Otherwise, cons on new symbols that are not already members. */
1333 tem2 = Vcurrent_load_list;
1335 while (CONSP (tem2))
1337 newelt = XCAR (tem2);
1339 if (NILP (Fmemq (newelt, tem)))
1340 Fsetcar (tail, Fcons (Fcar (tem),
1341 Fcons (newelt, Fcdr (tem))));
1354 /* If we're loading, cons the new assoc onto the front of load-history,
1355 the most-recently-loaded position. Also do this if we didn't find
1356 an existing member for the current source. */
1357 if (loading || !foundit)
1358 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1362 #else /* !LOADHIST */
1363 #define build_load_history(x,y)
1364 #endif /* !LOADHIST */
1367 #if 0 /* FSFmacs defun hack */
1369 unreadpure (void) /* Used as unwind-protect function in readevalloop */
1377 readevalloop (Lisp_Object readcharfun,
1378 Lisp_Object sourcename,
1379 Lisp_Object (*evalfun) (Lisp_Object),
1382 /* This function can GC */
1384 REGISTER Lisp_Object val = Qnil;
1385 int speccount = specpdl_depth ();
1386 struct gcpro gcpro1, gcpro2;
1387 struct buffer *b = 0;
1389 if (BUFFERP (readcharfun))
1390 b = XBUFFER (readcharfun);
1391 else if (MARKERP (readcharfun))
1392 b = XMARKER (readcharfun)->buffer;
1394 /* Don't do this. It is not necessary, and it needlessly exposes
1395 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1396 /*specbind (Qstandard_input, readcharfun);*/
1398 specbind (Qcurrent_load_list, Qnil);
1400 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1401 Vcurrent_compiled_function_annotation = Qnil;
1403 GCPRO2 (val, sourcename);
1405 LOADHIST_ATTACH (sourcename);
1411 if (b != 0 && !BUFFER_LIVE_P (b))
1412 error ("Reading from killed buffer");
1414 c = readchar (readcharfun);
1418 while ((c = readchar (readcharfun)) != '\n' && c != -1)
1425 /* Ignore whitespace here, so we can detect eof. */
1426 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1429 #if 0 /* FSFmacs defun hack */
1430 if (purify_flag && c == '(')
1432 int count1 = specpdl_depth ();
1433 record_unwind_protect (unreadpure, Qnil);
1434 val = read_list (readcharfun, ')', -1, 1);
1435 unbind_to (count1, Qnil);
1438 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1440 unreadchar (readcharfun, c);
1441 Vread_objects = Qnil;
1442 if (NILP (Vload_read_function))
1443 val = read0 (readcharfun);
1445 val = call1 (Vload_read_function, readcharfun);
1448 val = (*evalfun) (val);
1451 Vvalues = Fcons (val, Vvalues);
1452 if (EQ (Vstandard_output, Qt))
1459 build_load_history (LSTREAMP (readcharfun) ||
1460 /* This looks weird, but it's what's in FSFmacs */
1461 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
1465 unbind_to (speccount, Qnil);
1468 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1469 Execute BUFFER as Lisp code.
1470 Programs can pass two arguments, BUFFER and PRINTFLAG.
1471 BUFFER is the buffer to evaluate (nil means use current buffer).
1472 PRINTFLAG controls printing of output:
1473 nil means discard it; anything else is stream for print.
1475 If there is no error, point does not move. If there is an error,
1476 point remains at the end of the last character read from the buffer.
1477 Execute BUFFER as Lisp code.
1479 (bufname, printflag))
1481 /* This function can GC */
1482 int speccount = specpdl_depth ();
1483 Lisp_Object tem, buf;
1486 buf = Fcurrent_buffer ();
1488 buf = Fget_buffer (bufname);
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,
1523 giving starting and ending indices in the current buffer
1524 of the text to be executed.
1525 Programs can pass third argument PRINTFLAG 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.
1537 /* This function can GC */
1538 int speccount = specpdl_depth ();
1540 Lisp_Object cbuf = Fcurrent_buffer ();
1542 if (NILP (printflag))
1543 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1546 specbind (Qstandard_output, tem);
1548 if (NILP (printflag))
1549 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1550 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1552 /* This both uses b and checks its type. */
1553 Fgoto_char (b, cbuf);
1554 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, 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 #ifdef LISP_BACKQUOTES
1639 backquote_unwind (Lisp_Object ptr)
1640 { /* used as unwind-protect function in read0() */
1641 int *counter = (int *) get_opaque_ptr (ptr);
1644 free_opaque_ptr (ptr);
1650 /* Use this for recursive reads, in contexts where internal tokens
1651 are not allowed. See also read1(). */
1653 read0 (Lisp_Object readcharfun)
1655 Lisp_Object val = read1 (readcharfun);
1657 if (CONSP (val) && UNBOUNDP (XCAR (val)))
1659 Emchar c = XCHAR (XCDR (val));
1660 free_cons (XCONS (val));
1661 return Fsignal (Qinvalid_read_syntax,
1662 list1 (Fchar_to_string (make_char (c))));
1669 read_escape (Lisp_Object readcharfun)
1671 /* This function can GC */
1672 Emchar c = readchar (readcharfun);
1675 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1679 case 'a': return '\007';
1680 case 'b': return '\b';
1681 case 'd': return 0177;
1682 case 'e': return 033;
1683 case 'f': return '\f';
1684 case 'n': return '\n';
1685 case 'r': return '\r';
1686 case 't': return '\t';
1687 case 'v': return '\v';
1688 case '\n': return -1;
1691 c = readchar (readcharfun);
1693 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1695 error ("Invalid escape character syntax");
1696 c = readchar (readcharfun);
1698 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1700 c = read_escape (readcharfun);
1703 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1704 compatibility by defining character "modifiers" alt, super,
1705 hyper and shift to infest the characters (i.e. integers).
1707 However, this doesn't cut it for XEmacs 20, which
1708 distinguishes characters from integers. Without Mule, ?\H-a
1709 simply returns ?a because every character is clipped into
1710 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1711 produces an illegal character, and moves us to crash-land.
1713 For these reasons, FSF_KEYS hack is useless and without hope
1714 of ever working under XEmacs 20. */
1718 #define alt_modifier (0x040000)
1719 #define super_modifier (0x080000)
1720 #define hyper_modifier (0x100000)
1721 #define shift_modifier (0x200000)
1722 /* fsf uses a different modifiers for meta and control. Possibly
1723 byte_compiled code will still work fsfmacs, though... --Stig
1725 #define ctl_modifier (0x400000)
1726 #define meta_modifier (0x800000)
1728 #define FSF_LOSSAGE(mask) \
1729 if (fail_on_bucky_bit_character_escapes || \
1730 ((c = readchar (readcharfun)) != '-')) \
1731 error ("Invalid escape character syntax"); \
1732 c = readchar (readcharfun); \
1734 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1736 c = read_escape (readcharfun); \
1739 case 'S': FSF_LOSSAGE (shift_modifier);
1740 case 'H': FSF_LOSSAGE (hyper_modifier);
1741 case 'A': FSF_LOSSAGE (alt_modifier);
1742 case 's': FSF_LOSSAGE (super_modifier);
1744 #undef super_modifier
1745 #undef hyper_modifier
1746 #undef shift_modifier
1749 #endif /* FSF_KEYS */
1752 c = readchar (readcharfun);
1754 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1756 error ("Invalid escape character syntax");
1758 c = readchar (readcharfun);
1760 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1762 c = read_escape (readcharfun);
1763 /* FSFmacs junk for non-ASCII controls.
1768 return c & (0200 | 037);
1778 /* An octal escape, as in ANSI C. */
1780 REGISTER Emchar i = c - '0';
1781 REGISTER int count = 0;
1784 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
1785 i = (i << 3) + (c - '0');
1788 unreadchar (readcharfun, c);
1796 /* A hex escape, as in ANSI C, except that we only allow latin-1
1797 characters to be read this way. What is "\x4e03" supposed to
1798 mean, anyways, if the internal representation is hidden?
1799 This is also consistent with the treatment of octal escapes. */
1801 REGISTER Emchar i = 0;
1802 REGISTER int count = 0;
1803 while (++count <= 2)
1805 c = readchar (readcharfun);
1806 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1807 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1808 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1809 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1812 unreadchar (readcharfun, c);
1820 REGISTER Emchar i = 0;
1821 REGISTER int count = 0;
1822 while (++count <= 6)
1824 c = readchar (readcharfun);
1825 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1826 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1827 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1828 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1831 unreadchar (readcharfun, c);
1839 /* #### need some way of reading an extended character with
1840 an escape sequence. */
1850 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1852 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1854 /* This function can GC */
1855 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
1856 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
1858 *saw_a_backslash = 0;
1860 while (c > 040 /* #### - comma should be here as should backquote */
1861 && !(c == '\"' || c == '\'' || c == ';'
1862 || c == '(' || c == ')'
1863 #ifndef LISP_FLOAT_TYPE
1864 /* If we have floating-point support, then we need
1865 to allow <digits><dot><digits>. */
1867 #endif /* not LISP_FLOAT_TYPE */
1868 || c == '[' || c == ']' || c == '#'
1873 c = readchar (readcharfun);
1875 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1876 *saw_a_backslash = 1;
1878 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
1880 c = readchar (readcharfun);
1884 unreadchar (readcharfun, c);
1885 /* blasted terminating 0 */
1886 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
1887 Lstream_flush (XLSTREAM (Vread_buffer_stream));
1889 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
1892 static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
1895 read_atom (Lisp_Object readcharfun,
1897 int uninterned_symbol)
1899 /* This function can GC */
1900 int saw_a_backslash;
1901 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
1902 char *read_ptr = (char *)
1903 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
1905 /* Is it an integer? */
1906 if (! (saw_a_backslash || uninterned_symbol))
1908 /* If a token had any backslashes in it, it is disqualified from
1909 being an integer or a float. This means that 123\456 is a
1910 symbol, as is \123 (which is the way (intern "123") prints).
1911 Also, if token was preceded by #:, it's always a symbol.
1913 char *p = read_ptr + len;
1914 char *p1 = read_ptr;
1916 if (*p1 == '+' || *p1 == '-') p1++;
1921 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1923 #ifdef LISP_FLOAT_TYPE
1924 /* Integers can have trailing decimal points. */
1925 if (p1 > read_ptr && p1 < p && *p1 == '.')
1930 /* It is an integer. */
1931 #ifdef LISP_FLOAT_TYPE
1938 if (sizeof (int) == sizeof (EMACS_INT))
1939 number = atoi (read_buffer);
1940 else if (sizeof (long) == sizeof (EMACS_INT))
1941 number = atol (read_buffer);
1944 return make_int (number);
1947 return parse_integer ((Bufbyte *) read_ptr, len, 10);
1951 #ifdef LISP_FLOAT_TYPE
1952 if (isfloat_string (read_ptr))
1953 return make_float (atof (read_ptr));
1959 if (uninterned_symbol)
1960 sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
1963 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
1964 sym = Fintern (name, Qnil);
1972 parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
1974 CONST Bufbyte *lim = buf + len;
1975 CONST Bufbyte *p = buf;
1977 int negativland = 0;
1992 for (; (p < lim) && (*p != '\0'); p++)
1999 else if (isupper (c))
2001 else if (islower (c))
2006 if (c < 0 || c >= base)
2010 num = num * base + c;
2016 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
2017 Lisp_Object result = make_int (int_result);
2018 if (num && ((XINT (result) < 0) != negativland))
2020 if (XINT (result) != int_result)
2025 return Fsignal (Qinvalid_read_syntax,
2026 list3 (build_translated_string
2027 ("Integer constant overflow in reader"),
2028 make_string (buf, len),
2031 return Fsignal (Qinvalid_read_syntax,
2032 list3 (build_translated_string
2033 ("Invalid integer constant in reader"),
2034 make_string (buf, len),
2040 read_integer (Lisp_Object readcharfun, int base)
2042 /* This function can GC */
2043 int saw_a_backslash;
2044 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
2045 return (parse_integer
2046 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2048 ? 0 /* make parse_integer signal error */
2054 read_bit_vector (Lisp_Object readcharfun)
2056 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
2061 c = readchar (readcharfun);
2062 if (c != '0' && c != '1')
2064 Dynarr_add (dyn, (unsigned char) (c - '0'));
2068 unreadchar (readcharfun, c);
2070 return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
2071 Dynarr_length (dyn));
2078 struct structure_type *
2079 define_structure_type (Lisp_Object type,
2080 int (*validate) (Lisp_Object data,
2081 Error_behavior errb),
2082 Lisp_Object (*instantiate) (Lisp_Object data))
2084 struct structure_type st;
2087 st.keywords = Dynarr_new (structure_keyword_entry);
2088 st.validate = validate;
2089 st.instantiate = instantiate;
2090 Dynarr_add (the_structure_type_dynarr, st);
2092 return Dynarr_atp (the_structure_type_dynarr,
2093 Dynarr_length (the_structure_type_dynarr) - 1);
2097 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
2098 int (*validate) (Lisp_Object keyword,
2100 Error_behavior errb))
2102 struct structure_keyword_entry en;
2104 en.keyword = keyword;
2105 en.validate = validate;
2106 Dynarr_add (st->keywords, en);
2109 static struct structure_type *
2110 recognized_structure_type (Lisp_Object type)
2114 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
2116 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
2117 if (EQ (st->type, type))
2125 read_structure (Lisp_Object readcharfun)
2127 Emchar c = readchar (readcharfun);
2128 Lisp_Object list = Qnil;
2129 Lisp_Object orig_list = Qnil;
2130 Lisp_Object already_seen = Qnil;
2132 struct structure_type *st;
2133 struct gcpro gcpro1, gcpro2;
2135 GCPRO2 (orig_list, already_seen);
2137 RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
2138 list = read_list (readcharfun, ')', 0, 0);
2141 int len = XINT (Flength (list));
2143 RETURN_UNGCPRO (continuable_syntax_error
2144 ("structure type not specified"));
2147 (continuable_syntax_error
2148 ("structures must have alternating keyword/value pairs"));
2151 st = recognized_structure_type (XCAR (list));
2153 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2154 list2 (build_translated_string
2155 ("unrecognized structure type"),
2159 keyword_count = Dynarr_length (st->keywords);
2160 while (!NILP (list))
2162 Lisp_Object keyword, value;
2164 struct structure_keyword_entry *en = NULL;
2166 keyword = Fcar (list);
2168 value = Fcar (list);
2171 if (!NILP (memq_no_quit (keyword, already_seen)))
2172 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2173 list2 (build_translated_string
2174 ("structure keyword already seen"),
2177 for (i = 0; i < keyword_count; i++)
2179 en = Dynarr_atp (st->keywords, i);
2180 if (EQ (keyword, en->keyword))
2184 if (i == keyword_count)
2185 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2186 list2 (build_translated_string
2187 ("unrecognized structure keyword"),
2190 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
2192 (Fsignal (Qinvalid_read_syntax,
2193 list3 (build_translated_string
2194 ("invalid value for structure keyword"),
2197 already_seen = Fcons (keyword, already_seen);
2200 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
2201 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2202 list2 (build_translated_string
2203 ("invalid structure initializer"),
2206 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
2210 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
2212 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
2214 /* Get the next character; filter out whitespace and comments */
2217 reader_nextchar (Lisp_Object readcharfun)
2219 /* This function can GC */
2224 c = readchar (readcharfun);
2226 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2232 /* Ignore whitespace and control characters */
2241 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
2250 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
2252 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
2256 /* Read the next Lisp object from the stream READCHARFUN and return it.
2257 If the return value is a cons whose car is Qunbound, then read1()
2258 encountered a misplaced token (e.g. a right bracket, right paren,
2259 or dot followed by a non-number). To filter this stuff out,
2263 read1 (Lisp_Object readcharfun)
2268 c = reader_nextchar (readcharfun);
2274 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2275 /* if this is disabled, then other code in eval.c must be enabled */
2276 Emchar ch = reader_nextchar (readcharfun);
2282 int speccount = specpdl_depth ();
2283 ++old_backquote_flag;
2284 record_unwind_protect (backquote_unwind,
2285 make_opaque_ptr (&old_backquote_flag));
2286 tem = read0 (readcharfun);
2287 unbind_to (speccount, Qnil);
2288 ch = reader_nextchar (readcharfun);
2291 unreadchar (readcharfun, ch);
2292 return Fsignal (Qinvalid_read_syntax,
2294 ("Weird old-backquote syntax")));
2296 return list2 (Qbacktick, tem);
2300 if (old_backquote_flag)
2302 Lisp_Object tem, comma_type;
2303 ch = readchar (readcharfun);
2305 comma_type = Qcomma_at;
2309 unreadchar (readcharfun, ch);
2310 comma_type = Qcomma;
2312 tem = read0 (readcharfun);
2313 ch = reader_nextchar (readcharfun);
2316 unreadchar (readcharfun, ch);
2317 return Fsignal (Qinvalid_read_syntax,
2319 ("Weird old-backquote syntax")));
2321 return list2 (comma_type, tem);
2325 unreadchar (readcharfun, ch);
2327 return Fsignal (Qinvalid_read_syntax,
2328 list1 (build_string ("Comma outside of backquote")));
2330 /* #### - yuck....but this is reverse compatible. */
2331 /* mostly this is required by edebug, which does its own
2332 annotated reading. We need to have an annotated_read
2333 function that records (with markers) the buffer
2334 positions of the elements that make up lists, then that
2335 can be used in edebug and bytecomp and the check above
2336 can go back in. --Stig */
2342 unreadchar (readcharfun, ch);
2344 #endif /* old backquote crap... */
2345 return read_list (readcharfun, ')', 1, 1);
2348 return read_vector (readcharfun, ']');
2352 /* #### - huh? these don't do what they seem... */
2353 return noseeum_cons (Qunbound, make_char (c));
2356 #ifdef LISP_FLOAT_TYPE
2357 /* If a period is followed by a number, then we should read it
2358 as a floating point number. Otherwise, it denotes a dotted
2361 c = readchar (readcharfun);
2362 unreadchar (readcharfun, c);
2364 /* Can't use isdigit on Emchars */
2365 if (c < '0' || c > '9')
2366 return noseeum_cons (Qunbound, make_char ('.'));
2368 /* Note that read_atom will loop
2369 at least once, assuring that we will not try to UNREAD
2370 two characters in a row.
2371 (I think this doesn't matter anymore because there should
2372 be no more danger in unreading multiple characters) */
2373 return read_atom (readcharfun, '.', 0);
2375 #else /* ! LISP_FLOAT_TYPE */
2376 return noseeum_cons (Qunbound, make_char ('.'));
2377 #endif /* ! LISP_FLOAT_TYPE */
2382 c = readchar (readcharfun);
2385 #if 0 /* FSFmacs silly char-table syntax */
2388 #if 0 /* FSFmacs silly bool-vector syntax */
2391 /* "#["-- byte-code constant syntax */
2392 /* purecons #[...] syntax */
2393 case '[': return read_compiled_function (readcharfun, ']'
2394 /*, purify_flag */ );
2395 /* "#:"-- gensym syntax */
2396 case ':': return read_atom (readcharfun, -1, 1);
2397 /* #'x => (function x) */
2398 case '\'': return list2 (Qfunction, read0 (readcharfun));
2400 /* RMS uses this syntax for fat-strings.
2401 If we use it for vectors, then obscure bugs happen.
2403 /* "#(" -- Scheme/CL vector syntax */
2404 case '(': return read_vector (readcharfun, ')');
2410 struct gcpro gcpro1;
2412 /* Read the string itself. */
2413 tmp = read1 (readcharfun);
2416 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
2417 free_cons (XCONS (tmp));
2418 return Fsignal (Qinvalid_read_syntax,
2419 list1 (build_string ("#")));
2422 /* Read the intervals and their properties. */
2425 Lisp_Object beg, end, plist;
2429 beg = read1 (readcharfun);
2430 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
2432 ch = XCHAR (XCDR (beg));
2433 free_cons (XCONS (beg));
2441 end = read1 (readcharfun);
2442 if (CONSP (end) && UNBOUNDP (XCAR (end)))
2444 free_cons (XCONS (end));
2450 plist = read1 (readcharfun);
2451 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
2453 free_cons (XCONS (plist));
2459 (Fsignal (Qinvalid_read_syntax,
2461 (build_string ("invalid string property list"),
2463 Fset_text_properties (beg, end, plist, tmp);
2471 /* #@NUMBER is used to skip NUMBER following characters.
2472 That's used in .elc files to skip over doc strings
2473 and function definitions. */
2476 /* Read a decimal integer. */
2477 while ((c = readchar (readcharfun)) >= 0
2478 && c >= '0' && c <= '9')
2479 nskip = (10 * nskip) + (c - '0');
2481 unreadchar (readcharfun, c);
2483 /* FSF has code here that maybe caches the skipped
2484 string. See above for why this is totally
2485 losing. We handle this differently. */
2487 /* Skip that many characters. */
2488 for (i = 0; i < nskip && c >= 0; i++)
2489 c = readchar (readcharfun);
2493 case '$': return Vload_file_name_internal;
2495 case '*': return read_bit_vector (readcharfun);
2496 /* #o10 => 8 -- octal constant syntax */
2497 case 'o': return read_integer (readcharfun, 8);
2498 /* #xdead => 57005 -- hex constant syntax */
2499 case 'x': return read_integer (readcharfun, 16);
2500 /* #b010 => 2 -- binary constant syntax */
2501 case 'b': return read_integer (readcharfun, 2);
2502 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
2503 case 's': return read_structure (readcharfun);
2506 unreadchar (readcharfun, c);
2507 return Fsignal (Qinvalid_read_syntax,
2508 list1 (build_string ("Cannot read unreadable object")));
2510 #ifdef FEATUREP_SYNTAX
2514 Lisp_Object fexp, obj, tem;
2515 struct gcpro gcpro1, gcpro2;
2517 fexp = read0(readcharfun);
2518 obj = read0(readcharfun);
2520 /* the call to `featurep' may GC. */
2522 tem = call1 (Qfeaturep, fexp);
2525 if (c == '+' && NILP(tem)) goto retry;
2526 if (c == '-' && !NILP(tem)) goto retry;
2530 case '0': case '1': case '2': case '3': case '4':
2531 case '5': case '6': case '7': case '8': case '9':
2532 /* Reader forms that can reuse previously read objects. */
2537 /* Using read_integer() here is impossible, because it
2538 chokes on `='. Using parse_integer() is too hard.
2539 So we simply read it in, and ignore overflows, which
2541 while (c >= '0' && c <= '9')
2545 c = readchar (readcharfun);
2547 found = assq_no_quit (make_int (n), Vread_objects);
2550 /* #n=object returns object, but associates it with
2554 return Fsignal (Qinvalid_read_syntax,
2555 list2 (build_translated_string
2556 ("Multiply defined symbol label"),
2558 obj = read0 (readcharfun);
2559 Vread_objects = Fcons (Fcons (make_int (n), obj),
2565 /* #n# returns a previously read object. */
2567 return XCDR (found);
2569 return Fsignal (Qinvalid_read_syntax,
2570 list2 (build_translated_string
2571 ("Undefined symbol label"),
2574 return Fsignal (Qinvalid_read_syntax,
2575 list1 (build_string ("#")));
2579 unreadchar (readcharfun, c);
2580 return Fsignal (Qinvalid_read_syntax,
2581 list1 (build_string ("#")));
2587 case '\'': return list2 (Qquote, read0 (readcharfun));
2589 #ifdef LISP_BACKQUOTES
2593 int speccount = specpdl_depth ();
2594 ++new_backquote_flag;
2595 record_unwind_protect (backquote_unwind,
2596 make_opaque_ptr (&new_backquote_flag));
2597 tem = read0 (readcharfun);
2598 unbind_to (speccount, Qnil);
2599 return list2 (Qbackquote, tem);
2604 if (new_backquote_flag)
2606 Lisp_Object comma_type = Qnil;
2607 int ch = readchar (readcharfun);
2610 comma_type = Qcomma_at;
2612 comma_type = Qcomma_dot;
2616 unreadchar (readcharfun, ch);
2617 comma_type = Qcomma;
2619 return list2 (comma_type, read0 (readcharfun));
2623 /* YUCK. 99.999% backwards compatibility. The Right
2624 Thing(tm) is to signal an error here, because it's
2625 really invalid read syntax. Instead, this permits
2626 commas to begin symbols (unless they're inside
2627 backquotes). If an error is signalled here in the
2628 future, then commas should be invalid read syntax
2629 outside of backquotes anywhere they're found (i.e.
2630 they must be quoted in symbols) -- Stig */
2631 return read_atom (readcharfun, c, 0);
2638 /* Evil GNU Emacs "character" (ie integer) syntax */
2639 c = readchar (readcharfun);
2641 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2644 c = read_escape (readcharfun);
2645 return make_char (c);
2652 /* #### If the input stream is translating, then the string
2653 should be marked as translatable by setting its
2654 `string-translatable' property to t. .el and .elc files
2655 normally are translating input streams. See Fgettext()
2656 and print_internal(). */
2660 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
2661 while ((c = readchar (readcharfun)) >= 0
2665 c = read_escape (readcharfun);
2666 /* c is -1 if \ newline has just been seen */
2669 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
2673 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
2677 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2679 /* If purifying, and string starts with \ newline,
2680 return zero instead. This is for doc strings
2681 that we are really going to find in lib-src/DOC.nn.nn */
2682 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
2685 Lstream_flush (XLSTREAM (Vread_buffer_stream));
2688 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2689 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2694 /* Ignore whitespace and control characters */
2697 return read_atom (readcharfun, c, 0);
2704 #ifdef LISP_FLOAT_TYPE
2713 isfloat_string (CONST char *cp)
2716 CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
2718 if (*ucp == '+' || *ucp == '-')
2721 if (*ucp >= '0' && *ucp <= '9')
2724 while (*ucp >= '0' && *ucp <= '9')
2732 if (*ucp >= '0' && *ucp <= '9')
2735 while (*ucp >= '0' && *ucp <= '9')
2738 if (*ucp == 'e' || *ucp == 'E')
2742 if ((*ucp == '+') || (*ucp == '-'))
2746 if (*ucp >= '0' && *ucp <= '9')
2749 while (*ucp >= '0' && *ucp <= '9')
2752 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
2753 || (*ucp == '\r') || (*ucp == '\f'))
2754 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
2755 || state == (DOT_CHAR|TRAIL_INT)
2756 || state == (LEAD_INT|E_CHAR|EXP_INT)
2757 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2758 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
2760 #endif /* LISP_FLOAT_TYPE */
2763 sequence_reader (Lisp_Object readcharfun,
2766 void * (*conser) (Lisp_Object readcharfun,
2767 void *state, Charcount len))
2771 for (len = 0; ; len++)
2776 ch = reader_nextchar (readcharfun);
2778 if (ch == terminator)
2781 unreadchar (readcharfun, ch);
2782 #ifdef FEATUREP_SYNTAX
2784 syntax_error ("\"]\" in a list");
2786 syntax_error ("\")\" in a vector");
2788 state = ((conser) (readcharfun, state, len));
2793 struct read_list_state
2798 int allow_dotted_lists;
2803 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
2805 struct read_list_state *s = (struct read_list_state *) state;
2808 elt = read1 (readcharfun);
2810 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2812 Lisp_Object tem = elt;
2816 free_cons (XCONS (tem));
2819 #ifdef FEATUREP_SYNTAX
2820 if (ch == s->terminator) /* deal with #+, #- reader macros */
2822 unreadchar (readcharfun, s->terminator);
2826 syntax_error ("']' in a list");
2828 syntax_error ("')' in a vector");
2832 signal_simple_error ("BUG! Internal reader error", elt);
2833 else if (!s->allow_dotted_lists)
2834 syntax_error ("\".\" in a vector");
2837 if (!NILP (s->tail))
2838 XCDR (s->tail) = read0 (readcharfun);
2840 s->head = read0 (readcharfun);
2841 elt = read1 (readcharfun);
2842 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2844 ch = XCHAR (XCDR (elt));
2845 free_cons (XCONS (elt));
2846 if (ch == s->terminator)
2848 unreadchar (readcharfun, s->terminator);
2852 syntax_error (". in wrong context");
2856 #if 0 /* FSFmacs defun hack, or something ... */
2857 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
2859 record_unwind_protect (unreadpure, Qzero);
2864 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2865 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
2867 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
2868 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
2870 Vcurrent_compiled_function_annotation = elt;
2874 elt = Fcons (elt, Qnil);
2875 if (!NILP (s->tail))
2876 XCDR (s->tail) = elt;
2886 #if 0 /* FSFmacs defun hack */
2887 /* -1 for allow_dotted_lists means allow_dotted_lists and check
2888 for starting with defun and make structure pure. */
2892 read_list (Lisp_Object readcharfun,
2894 int allow_dotted_lists,
2895 int check_for_doc_references)
2897 struct read_list_state s;
2898 struct gcpro gcpro1, gcpro2;
2899 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2900 Lisp_Object old_compiled_function_annotation =
2901 Vcurrent_compiled_function_annotation;
2907 s.allow_dotted_lists = allow_dotted_lists;
2908 s.terminator = terminator;
2909 GCPRO2 (s.head, s.tail);
2911 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2912 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2913 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
2916 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
2918 /* check now for any doc string references and record them
2922 /* We might be dealing with an imperfect list so don't
2924 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
2926 Lisp_Object holding_cons = Qnil;
2929 Lisp_Object elem = XCAR (tail);
2930 /* elem might be (#$ . INT) ... */
2931 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2932 holding_cons = tail;
2933 /* or it might be (quote (#$ . INT)) i.e.
2934 (quote . ((#$ . INT) . nil)) in the case of
2935 `autoload' (autoload evaluates its arguments, while
2936 `defvar', `defun', etc. don't). */
2937 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
2938 && CONSP (XCDR (elem)))
2940 elem = XCAR (XCDR (elem));
2941 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2942 holding_cons = XCDR (XCAR (tail));
2946 if (CONSP (holding_cons))
2950 if (NILP (Vinternal_doc_file_name))
2951 /* We have not yet called Snarf-documentation, so
2952 assume this file is described in the DOC file
2953 and Snarf-documentation will fill in the right
2954 value later. For now, replace the whole list
2956 XCAR (holding_cons) = Qzero;
2958 /* We have already called Snarf-documentation, so
2959 make a relative file name for this file, so it
2960 can be found properly in the installed Lisp
2961 directory. We don't use Fexpand_file_name
2962 because that would make the directory absolute
2964 XCAR (XCAR (holding_cons)) =
2965 concat2 (build_string ("../lisp/"),
2966 Ffile_name_nondirectory
2967 (Vload_file_name_internal));
2970 /* Not pure. Just add to Vload_force_doc_string_list,
2971 and the string will be filled in properly in
2972 load_force_doc_string_unwind(). */
2973 Vload_force_doc_string_list =
2974 /* We pass the cons that holds the (#$ . INT) so we
2975 can modify it in-place. */
2976 Fcons (holding_cons, Vload_force_doc_string_list);
2986 read_vector (Lisp_Object readcharfun,
2993 struct read_list_state s;
2994 struct gcpro gcpro1, gcpro2;
2999 s.allow_dotted_lists = 0;
3000 GCPRO2 (s.head, s.tail);
3002 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3006 len = XINT (Flength (tem));
3008 #if 0 /* FSFmacs defun hack */
3010 s.head = make_pure_vector (len, Qnil);
3013 s.head = make_vector (len, Qnil);
3015 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
3019 struct Lisp_Cons *otem = XCONS (tem);
3029 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
3031 /* Accept compiled functions at read-time so that we don't
3032 have to build them at load-time. */
3034 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3035 struct gcpro gcpro1;
3038 int saw_a_doc_ref = 0;
3040 /* Note: we tell read_list not to search for doc references
3041 because we need to handle the "doc reference" for the
3042 instructions and constants differently. */
3043 stuff = read_list (readcharfun, terminator, 0, 0);
3044 len = XINT (Flength (stuff));
3045 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3047 continuable_syntax_error ("#[...] used with wrong number of elements");
3049 for (iii = 0; CONSP (stuff); iii++)
3051 struct Lisp_Cons *victim = XCONS (stuff);
3052 make_byte_code_args[iii] = Fcar (stuff);
3053 if ((purify_flag || load_force_doc_strings)
3054 && CONSP (make_byte_code_args[iii])
3055 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
3057 if (purify_flag && iii == COMPILED_DOC_STRING)
3059 /* same as in read_list(). */
3060 if (NILP (Vinternal_doc_file_name))
3061 make_byte_code_args[iii] = Qzero;
3063 XCAR (make_byte_code_args[iii]) =
3064 concat2 (build_string ("../lisp/"),
3065 Ffile_name_nondirectory
3066 (Vload_file_name_internal));
3071 stuff = Fcdr (stuff);
3074 GCPRO1 (make_byte_code_args[0]);
3077 /* v18 or v19 bytecode file. Need to Ebolify. */
3078 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
3079 ebolify_bytecode_constants (make_byte_code_args[2]);
3081 /* make-byte-code looks at purify_flag, which should have the same
3082 * value as our "read-pure" argument */
3083 stuff = Fmake_byte_code (len, make_byte_code_args);
3084 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
3086 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
3098 load_in_progress = 0;
3100 Vload_descriptor_list = Qnil;
3102 /* kludge: locate-file does not work for a null load-path, even if
3103 the file name is absolute. */
3105 Vload_path = Fcons (build_string (""), Qnil);
3107 /* This used to get initialized in init_lread because all streams
3108 got closed when dumping occurs. This is no longer true --
3109 Vread_buffer_stream is a resizing output stream, and there is no
3110 reason to close it at dump-time.
3112 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3113 will initialize it only once, at dump-time. */
3114 if (NILP (Vread_buffer_stream))
3115 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3117 Vload_force_doc_string_list = Qnil;
3121 syms_of_lread (void)
3124 DEFSUBR (Fread_from_string);
3125 DEFSUBR (Fload_internal);
3126 DEFSUBR (Flocate_file);
3127 DEFSUBR (Flocate_file_clear_hashing);
3128 DEFSUBR (Feval_buffer);
3129 DEFSUBR (Feval_region);
3131 defsymbol (&Qstandard_input, "standard-input");
3132 defsymbol (&Qread_char, "read-char");
3133 defsymbol (&Qcurrent_load_list, "current-load-list");
3134 defsymbol (&Qload, "load");
3135 defsymbol (&Qload_file_name, "load-file-name");
3136 defsymbol (&Qfset, "fset");
3138 #ifdef LISP_BACKQUOTES
3139 defsymbol (&Qbackquote, "backquote");
3140 defsymbol (&Qbacktick, "`");
3141 defsymbol (&Qcomma, ",");
3142 defsymbol (&Qcomma_at, ",@");
3143 defsymbol (&Qcomma_dot, ",.");
3146 defsymbol (&Qexists, "exists");
3147 defsymbol (&Qreadable, "readable");
3148 defsymbol (&Qwritable, "writable");
3149 defsymbol (&Qexecutable, "executable");
3153 structure_type_create (void)
3155 the_structure_type_dynarr = Dynarr_new (structure_type);
3159 reinit_vars_of_lread (void)
3161 Vread_buffer_stream = Qnil;
3162 staticpro_nodump (&Vread_buffer_stream);
3166 vars_of_lread (void)
3168 reinit_vars_of_lread ();
3170 DEFVAR_LISP ("values", &Vvalues /*
3171 List of values of all expressions which were read, evaluated and printed.
3172 Order is reverse chronological.
3175 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3176 Stream for read to get input from.
3177 See documentation of `read' for possible values.
3179 Vstandard_input = Qt;
3181 DEFVAR_LISP ("load-path", &Vload_path /*
3182 *List of directories to search for files to load.
3183 Each element is a string (directory name) or nil (try default directory).
3185 Note that the elements of this list *may not* begin with "~", so you must
3186 call `expand-file-name' on them before adding them to this list.
3188 Initialized based on EMACSLOADPATH environment variable, if any,
3189 otherwise to default specified in by file `paths.h' when XEmacs was built.
3190 If there were no paths specified in `paths.h', then XEmacs chooses a default
3191 value for this variable by looking around in the file-system near the
3192 directory in which the XEmacs executable resides.
3196 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3197 "*Location of lisp files to be used when dumping ONLY."); */
3199 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3200 Non-nil iff inside of `load'.
3203 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3204 An alist of expressions to be evalled when particular files are loaded.
3205 Each element looks like (FILENAME FORMS...).
3206 When `load' is run and the file-name argument is FILENAME,
3207 the FORMS in the corresponding element are executed at the end of loading.
3209 FILENAME must match exactly! Normally FILENAME is the name of a library,
3210 with no directory specified, since that is how `load' is normally called.
3211 An error in FORMS does not undo the load,
3212 but does prevent execution of the rest of the FORMS.
3214 Vafter_load_alist = Qnil;
3216 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3217 *Whether `load' should check whether the source is newer than the binary.
3218 If this variable is true, then when a `.elc' file is being loaded and the
3219 corresponding `.el' is newer, a warning message will be printed.
3221 load_warn_when_source_newer = 0;
3223 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3224 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3225 If this variable is true, then when `load' is called with a filename without
3226 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3227 then a message will be printed. If an explicit extension is passed to `load',
3228 no warning will be printed.
3230 load_warn_when_source_only = 0;
3232 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3233 *Whether `load' should ignore `.elc' files when a suffix is not given.
3234 This is normally used only to bootstrap the `.elc' files when building XEmacs.
3236 load_ignore_elc_files = 0;
3239 DEFVAR_LISP ("load-history", &Vload_history /*
3240 Alist mapping source file names to symbols and features.
3241 Each alist element is a list that starts with a file name,
3242 except for one element (optional) that starts with nil and describes
3243 definitions evaluated from buffers not visiting files.
3244 The remaining elements of each list are symbols defined as functions
3245 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3247 Vload_history = Qnil;
3249 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3250 Used for internal purposes by `load'.
3252 Vcurrent_load_list = Qnil;
3255 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3256 Full name of file being loaded by `load'.
3258 Vload_file_name = Qnil;
3260 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3261 Function used by `load' and `eval-region' for reading expressions.
3262 The default is nil, which means use the function `read'.
3264 Vload_read_function = Qnil;
3266 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3267 Non-nil means `load' should force-load all dynamic doc strings.
3268 This is useful when the file being loaded is a temporary copy.
3270 load_force_doc_strings = 0;
3272 /* See read_escape(). */
3274 /* Used to be named `puke-on-fsf-keys' */
3275 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3276 &fail_on_bucky_bit_character_escapes /*
3277 Whether `read' should signal an error when it encounters unsupported
3278 character escape syntaxes or just read them incorrectly.
3280 fail_on_bucky_bit_character_escapes = 0;
3283 /* This must be initialized in init_lread otherwise it may start out
3284 with values saved when the image is dumped. */
3285 staticpro (&Vload_descriptor_list);
3287 /* Initialized in init_lread. */
3288 staticpro (&Vload_force_doc_string_list);
3290 Vload_file_name_internal = Qnil;
3291 staticpro (&Vload_file_name_internal);
3293 Vload_file_name_internal_the_purecopy = Qnil;
3294 staticpro (&Vload_file_name_internal_the_purecopy);
3296 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3297 Vcurrent_compiled_function_annotation = Qnil;
3298 staticpro (&Vcurrent_compiled_function_annotation);
3301 /* So that early-early stuff will work */
3302 Ffset (Qload, intern ("load-internal"));
3304 #ifdef FEATUREP_SYNTAX
3305 defsymbol (&Qfeaturep, "featurep");
3306 Fprovide(intern("xemacs"));
3308 Fprovide(intern("infodock"));
3309 #endif /* INFODOCK */
3310 #endif /* FEATUREP_SYNTAX */
3312 #ifdef LISP_BACKQUOTES
3313 old_backquote_flag = new_backquote_flag = 0;
3317 Vfile_domain = Qnil;
3320 Vread_objects = Qnil;
3321 staticpro (&Vread_objects);
3323 Vlocate_file_hash_table = make_lisp_hash_table (200,
3324 HASH_TABLE_NON_WEAK,
3326 staticpro (&Vlocate_file_hash_table);
3328 symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
3329 = Vlocate_file_hash_table;