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.
5 Copyright (C) 2004 Steve Youngs.
7 This file is part of SXEmacs
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. */
23 /* Synched up with: Mule 2.0, FSF 19.30. */
25 /* This file has been Mule-ized. */
36 #include "mule/file-coding.h"
41 Lisp_Object Qread_char, Qstandard_input;
42 Lisp_Object Qvariable_documentation;
43 #define LISP_BACKQUOTES
44 #ifdef LISP_BACKQUOTES
46 Nonzero means inside a new-style backquote
47 with no surrounding parentheses.
48 Fread initializes this to zero, so we need not specbind it
49 or worry about what happens to it when there is an error.
52 Nested backquotes are perfectly legal and fail utterly with
54 static int new_backquote_flag, old_backquote_flag;
55 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
57 Lisp_Object Qvariable_domain; /* I18N3 */
58 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
59 Lisp_Object Qcurrent_load_list;
60 Lisp_Object Qload, Qload_file_name;
62 Lisp_Object Vload_suppress_alist;
64 /* Hash-table that maps directory names to hashes of their contents. */
65 static Lisp_Object Vlocate_file_hash_table;
67 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
69 Lisp_Object Vureaders;
71 /* See read_escape() for an explanation of this. */
73 int fail_on_bucky_bit_character_escapes;
76 /* This symbol is also used in fns.c */
77 #define FEATUREP_SYNTAX
79 #ifdef FEATUREP_SYNTAX
80 Lisp_Object Qfeaturep;
83 /* non-zero if inside `load' */
86 /* Whether Fload_internal() should check whether the .el is newer
88 int load_warn_when_source_newer;
89 /* Whether Fload_internal() should check whether the .elc doesn't exist */
90 int load_warn_when_source_only;
91 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
92 int load_ignore_elc_files;
94 /* Search path for files to be loaded. */
95 Lisp_Object Vload_path;
97 /* Search path for files when dumping. */
98 /* Lisp_Object Vdump_load_path; */
100 /* This is the user-visible association list that maps features to
101 lists of defs in their load files. */
102 Lisp_Object Vload_history;
104 /* This is used to build the load history. */
105 Lisp_Object Vcurrent_load_list;
107 /* Name of file actually being read by `load'. */
108 Lisp_Object Vload_file_name;
110 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
111 our #$ checks are reliable. */
112 Lisp_Object Vload_file_name_internal;
114 Lisp_Object Vload_file_name_internal_the_purecopy;
116 /* Function to use for reading, in `load' and friends. */
117 Lisp_Object Vload_read_function;
119 /* The association list of objects read with the #n=object form.
120 Each member of the list has the form (n . object), and is used to
121 look up the object for the corresponding #n# construct.
122 It must be set to nil before all top-level calls to read0. */
123 Lisp_Object Vread_objects;
125 /* Nonzero means load should forcibly load all dynamic doc strings. */
126 /* Note that this always happens (with some special behavior) when
127 purify_flag is set. */
128 static int load_force_doc_strings;
130 /* List of descriptors now open for Fload_internal. */
131 static Lisp_Object Vload_descriptor_list;
133 /* In order to implement "load_force_doc_strings", we keep
134 a list of all the compiled-function objects and such
135 that we have created in the process of loading this file.
138 We specbind this just like Vload_file_name, so there's no
139 problems with recursive loading. */
140 static Lisp_Object Vload_force_doc_string_list;
142 /* A resizing-buffer stream used to temporarily hold data while reading */
143 static Lisp_Object Vread_buffer_stream;
145 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
146 Lisp_Object Vcurrent_compiled_function_annotation;
149 static int load_byte_code_version;
151 /* An array describing all known built-in structure types */
152 static structure_type_dynarr *the_structure_type_dynarr;
154 #if 0 /* FSF defun hack */
155 /* When nonzero, read conses in pure space */
156 static int read_pure;
159 #if 0 /* FSF stuff */
160 /* For use within read-from-string (this reader is non-reentrant!!) */
161 static int read_from_string_index;
162 static int read_from_string_limit;
165 /* parser hook for resclass objects */
166 int(*ase_resc_rng_pred_f)(const char *cp) = NULL;
167 int(*ase_resc_elm_pred_f)(const char *cp) = NULL;
168 Lisp_Object(*ase_resc_rng_f)(char *cp) = NULL;
169 Lisp_Object(*ase_resc_elm_f)(char *cp) = NULL;
170 /* parser hook for perms */
171 Lisp_Object(*ase_permutation_f)(Lisp_Object);
174 #if 0 /* More FSF implementation kludges. */
175 /* In order to implement load-force-doc-string, FSF saves the
176 #@-quoted string when it's seen, and goes back and retrieves
179 This approach is not only kludgy, but it in general won't work
180 correctly because there's no stack of remembered #@-quoted-strings
181 and those strings don't generally appear in the file in the same
182 order as their #$ references. (Yes, that is amazingly stupid too.
184 It would be trivially easy to always encode the #@ string
185 [which is a comment, anyway] in the middle of the (#$ . INT) cons
186 reference. That way, it would be really easy to implement
187 load-force-doc-string in a non-kludgy way by just retrieving the
188 string immediately, because it's delivered on a silver platter.)
190 And finally, this stupid approach doesn't work under Mule, or
191 under MS-DOS or Windows NT, or under VMS, or any other place
192 where you either can't do an ftell() or don't get back a byte
195 Oh, and one more lossage in this approach: If you attempt to
196 dump any ELC files that were compiled with `byte-compile-dynamic'
197 (as opposed to just `byte-compile-dynamic-docstring'), you
198 get hosed. FMH! (as the illustrious JWZ was prone to utter)
200 The approach we use is clean, solves all of these problems, and is
201 probably easier to implement anyway. We just save a list of all
202 the containing objects that have (#$ . INT) conses in them (this
203 will only be compiled-function objects and lists), and when the
204 file is finished loading, we go through and fill in all the
205 doc strings at once. */
207 /* This contains the last string skipped with #@. */
208 static char *saved_doc_string;
209 /* Length of buffer allocated in saved_doc_string. */
210 static int saved_doc_string_size;
211 /* Length of actual data in saved_doc_string. */
212 static int saved_doc_string_length;
213 /* This is the file position that string came from. */
214 static int saved_doc_string_position;
217 EXFUN(Fread_from_string, 3);
219 /* When errors are signaled, the actual readcharfun should not be used
220 as an argument if it is an lstream, so that lstreams don't escape
221 to the Lisp level. */
222 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
223 ? (build_string ("internal input stream")) \
226 static DOESNT_RETURN read_syntax_error(const char *string)
228 signal_error(Qinvalid_read_syntax,
229 list1(build_translated_string(string)));
232 static Lisp_Object continuable_read_syntax_error(const char *string)
234 return Fsignal(Qinvalid_read_syntax,
235 list1(build_translated_string(string)));
238 /* Handle unreading and rereading of characters. */
239 static Emchar readchar(Lisp_Object readcharfun)
241 /* This function can GC */
243 if (BUFFERP(readcharfun)) {
245 struct buffer *b = XBUFFER(readcharfun);
247 if (!BUFFER_LIVE_P(b))
248 error("Reading from killed buffer");
250 if (BUF_PT(b) >= BUF_ZV(b))
252 c = BUF_FETCH_CHAR(b, BUF_PT(b));
253 BUF_SET_PT(b, BUF_PT(b) + 1);
256 } else if (LSTREAMP(readcharfun)) {
257 Emchar c = Lstream_get_emchar(XLSTREAM(readcharfun));
258 #ifdef DEBUG_SXEMACS /* testing Mule */
259 static int testing_mule = 0; /* Change via debugger */
261 if (c >= 0x20 && c <= 0x7E)
266 stderr_out("\\%o ", c);
268 #endif /* testing Mule */
270 } 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);
281 Lisp_Object tem = call0(readcharfun);
283 if (!CHAR_OR_CHAR_INTP(tem))
285 return XCHAR_OR_CHAR_INT(tem);
289 /* Unread the character C in the way appropriate for the stream READCHARFUN.
290 If the stream is a user function, call it with the char as argument. */
292 static void unreadchar(Lisp_Object readcharfun, Emchar c)
295 /* Don't back up the pointer if we're unreading the end-of-input mark,
296 since readchar didn't advance it when we read it. */
298 else if (BUFFERP(readcharfun))
299 BUF_SET_PT(XBUFFER(readcharfun),
300 BUF_PT(XBUFFER(readcharfun)) - 1);
301 else if (LSTREAMP(readcharfun)) {
302 Lstream_unget_emchar(XLSTREAM(readcharfun), c);
303 #ifdef DEBUG_SXEMACS /* testing Mule */
305 static int testing_mule = 0; /* Set this using debugger */
308 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
309 ((c == '\n') ? "UU\\n\n" : "UU\\%o"),
313 } else if (MARKERP(readcharfun))
314 set_marker_position(readcharfun,
315 marker_position(readcharfun) - 1);
317 call1(readcharfun, make_char(c));
320 static Lisp_Object read0(Lisp_Object readcharfun);
321 static Lisp_Object read1(Lisp_Object readcharfun);
322 /* allow_dotted_lists means that something like (foo bar . baz)
323 is acceptable. If -1, means check for starting with defun
324 and make structure pure. (not implemented, probably for very
328 If check_for_doc_references, look for (#$ . INT) doc references
329 in the list and record if load_force_doc_strings is non-zero.
330 (Such doc references will be destroyed during the loadup phase
331 by replacing with Qzero, because Snarf-documentation will fill
334 WARNING: If you set this, you sure as hell better not call
335 free_list() on the returned list here. */
337 static Lisp_Object read_list(Lisp_Object readcharfun,
339 int allow_dotted_lists,
340 int check_for_doc_references);
342 static void readevalloop(Lisp_Object readcharfun,
343 Lisp_Object sourcefile,
344 Lisp_Object(*evalfun) (Lisp_Object), int printflag);
346 static Lisp_Object load_unwind(Lisp_Object stream)
347 { /* used as unwind-protect function in load */
348 Lstream_close(XLSTREAM(stream));
349 if (--load_in_progress < 0)
350 load_in_progress = 0;
354 static Lisp_Object load_descriptor_unwind(Lisp_Object oldlist)
356 Vload_descriptor_list = oldlist;
360 static Lisp_Object load_file_name_internal_unwind(Lisp_Object oldval)
362 Vload_file_name_internal = oldval;
367 load_file_name_internal_the_purecopy_unwind(Lisp_Object oldval)
369 Vload_file_name_internal_the_purecopy = oldval;
373 static Lisp_Object load_byte_code_version_unwind(Lisp_Object oldval)
375 load_byte_code_version = XINT(oldval);
380 suppressedp_loop(int len, char *nonreloc, Lisp_Object reloc)
382 EXTERNAL_LIST_LOOP_2(_acons_, Vload_suppress_alist) {
383 if (CONSP(acons) && STRINGP(XCAR(_acons_))) {
384 Lisp_Object name = XCAR(_acons_);
385 if (XSTRING_LENGTH(name) == len &&
386 !memcmp(XSTRING_DATA(name), nonreloc, len)) {
391 val = Feval(XCDR(_acons_));
403 suppressedp(char *nonreloc, Lisp_Object reloc)
405 /* Check if NONRELOC/RELOC (an absolute filename) is suppressed according
406 to load-suppress-alist. */
410 nonreloc = (char*)XSTRING_DATA(reloc);
411 len = XSTRING_LENGTH(reloc);
413 len = strlen(nonreloc);
415 if (len >= 4 && !strcmp(nonreloc + len - 4, ".elc"))
417 else if (len >= 3 && !strcmp(nonreloc + len - 3, ".el"))
420 return suppressedp_loop(len, nonreloc, reloc);
423 /* The plague is coming.
425 Ring around the rosy, pocket full of posy,
426 Ashes ashes, they all fall down.
428 void ebolify_bytecode_constants(Lisp_Object vector)
430 int len = XVECTOR_LENGTH(vector);
433 for (i = 0; i < len; i++) {
434 Lisp_Object el = XVECTOR_DATA(vector)[i];
436 /* We don't check for `eq', `equal', and the others that have
437 bytecode opcodes. This might lose if someone passes #'eq or
438 something to `funcall', but who would really do that? As
439 they say in law, we've made a "good-faith effort" to
440 unfuckify ourselves. And doing it this way avoids screwing
441 up args to `make-hash-table' and such. As it is, we have to
442 add an extra Ebola check in decode_weak_list_type(). --ben */
445 else if (EQ(el, Qdelq))
448 /* I think this is a bad idea because it will probably mess
450 else if (EQ(el, Qdelete))
453 else if (EQ(el, Qrassq))
455 else if (EQ(el, Qrassoc))
458 XVECTOR_DATA(vector)[i] = el;
462 static Lisp_Object pas_de_lache_ici(int fd, Lisp_Object victim)
467 if (!INTP(XCDR(victim)))
468 signal_simple_error("Bogus doc string reference", victim);
469 pos = XINT(XCDR(victim));
471 pos = -pos; /* kludge to mark a user variable */
472 tem = unparesseuxify_doc_string(fd, pos, 0, Vload_file_name_internal);
474 signal_error(Qerror, tem);
478 static Lisp_Object load_force_doc_string_unwind(Lisp_Object oldlist)
481 Lisp_Object list = Vload_force_doc_string_list;
483 int fd = XINT(XCAR(Vload_descriptor_list));
486 /* restore the old value first just in case an error occurs. */
487 Vload_force_doc_string_list = oldlist;
489 LIST_LOOP(tail, list) {
490 Lisp_Object john = Fcar(tail);
492 assert(CONSP(XCAR(john)));
493 assert(!purify_flag); /* should have been handled in read_list() */
494 XCAR(john) = pas_de_lache_ici(fd, XCAR(john));
498 assert(COMPILED_FUNCTIONP(john));
499 if (CONSP(XCOMPILED_FUNCTION(john)->instructions)) {
500 struct gcpro ngcpro1;
501 Lisp_Object juan = (pas_de_lache_ici
503 XCOMPILED_FUNCTION(john)->
511 ("invalid lazy-loaded byte code",
513 XCOMPILED_FUNCTION(john)->instructions =
515 /* v18 or v19 bytecode file. Need to Ebolify. */
516 if (XCOMPILED_FUNCTION(john)->flags.ebolified
517 && VECTORP(XCDR(ivan)))
518 ebolify_bytecode_constants(XCDR(ivan));
519 XCOMPILED_FUNCTION(john)->constants =
524 compiled_function_documentation(XCOMPILED_FUNCTION
527 assert(!purify_flag); /* should have been handled in
528 read_compiled_function() */
529 doc = pas_de_lache_ici(fd, doc);
530 set_compiled_function_documentation
531 (XCOMPILED_FUNCTION(john), doc);
543 /* Close all descriptors in use for Fload_internal.
544 This is used when starting a subprocess. */
546 void close_load_descs(void)
549 LIST_LOOP(tail, Vload_descriptor_list)
550 close(XINT(XCAR(tail)));
554 Lisp_Object Vfile_domain;
556 Lisp_Object restore_file_domain(Lisp_Object val)
563 DEFUN("load-internal", Fload_internal, 1, 6, 0, /*
564 Execute a file of Lisp code named FILE; no coding-system frobbing.
565 This function is identical to `load' except for the handling of the
566 CODESYS and USED-CODESYS arguments under SXEmacs/Mule. (When Mule
567 support is not present, both functions are identical and ignore the
568 CODESYS and USED-CODESYS arguments.)
570 If support for Mule exists in this Emacs, the file is decoded
571 according to CODESYS; if omitted, no conversion happens. If
572 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
573 system that was used for the decoding is stored into it. It will in
574 general be different from CODESYS if CODESYS specifies automatic
575 encoding detection or end-of-line detection.
577 (file, noerror, nomessage, nosuffix, codesys, used_codesys))
579 /* This function can GC */
581 int speccount = specpdl_depth();
583 Lisp_Object newer = Qnil;
584 Lisp_Object handler = Qnil;
585 Lisp_Object found = Qnil;
586 struct gcpro gcpro1, gcpro2, gcpro3;
588 int message_p = NILP(nomessage);
589 /*#ifdef DEBUG_SXEMACS*/
590 static Lisp_Object last_file_loaded;
593 GCPRO3(file, newer, found);
597 /*#ifdef DEBUG_SXEMACS*/
598 if (purify_flag && noninteractive) {
600 last_file_loaded = file;
602 /*#endif / * DEBUG_SXEMACS */
604 /* If file name is magic, call the handler. */
605 handler = Ffind_file_name_handler(file, Qload);
607 RETURN_UNGCPRO(call5(handler, Qload, file, noerror,
608 nomessage, nosuffix));
610 /* Do this after the handler to avoid
611 the need to gcpro noerror, nomessage and nosuffix.
612 (Below here, we care only whether they are nil or not.) */
613 file = Fsubstitute_in_file_name(file);
615 if (!NILP(used_codesys))
616 CHECK_SYMBOL(used_codesys);
619 /* Avoid weird lossage with null string as arg,
620 since it would try to load a directory as a Lisp file.
622 if (XSTRING_LENGTH(file) > 0) {
626 fd = locate_file(Vload_path, file,
629 : build_string(load_ignore_elc_files
631 : ".elc:.el:")), &found, -1);
635 signal_file_error("Cannot open load file",
643 foundstr = (char *)alloca(XSTRING_LENGTH(found) + 1);
644 strcpy(foundstr, (char *)XSTRING_DATA(found));
645 foundlen = strlen(foundstr);
647 /* The omniscient JWZ thinks this is worthless, but I beg to
649 if (load_ignore_elc_files) {
650 newer = Ffile_name_nondirectory(found);
651 } else if (load_warn_when_source_newer &&
652 !memcmp(".elc", foundstr + foundlen - 4, 4)) {
653 if (!fstat(fd, &s1)) { /* can't fail, right? */
655 /* temporarily hack the 'c' off the end of the
657 foundstr[foundlen - 1] = '\0';
658 result = sxemacs_stat(foundstr, &s2);
660 (unsigned)s1.st_mtime <
661 (unsigned)s2.st_mtime) {
662 Lisp_Object newer_name =
663 make_string((Bufbyte*)foundstr,
665 struct gcpro nngcpro1;
666 NNGCPRO1(newer_name);
667 newer = Ffile_name_nondirectory(
671 /* put the 'c' back on (kludge-o-rama) */
672 foundstr[foundlen - 1] = 'c';
674 } else if (load_warn_when_source_only &&
675 /* `found' ends in ".el" */
676 !memcmp(".el", foundstr + foundlen - 3, 3) &&
677 /* `file' does not end in ".el" */
679 XSTRING_DATA(file) + XSTRING_LENGTH(file) - 3,
684 if (!memcmp(".elc", foundstr + foundlen - 4, 4))
687 #define PRINT_LOADING_MESSAGE(done) \
689 if (load_ignore_elc_files) { \
691 message("Loading %s..." done, \
692 XSTRING_DATA(newer)); \
694 } else if (!NILP(newer)) { \
695 message("Loading %s..." done " (file %s is newer)", \
696 XSTRING_DATA(file), \
697 XSTRING_DATA(newer)); \
698 } else if (source_only) { \
699 Lisp_Object tmp = Ffile_name_nondirectory(file); \
700 message("Loading %s..." done \
701 " (file %s.elc does not exist)", \
702 XSTRING_DATA(file), \
703 XSTRING_DATA(tmp)); \
704 } else if (message_p) { \
705 message("Loading %s..." done, \
706 XSTRING_DATA(file)); \
710 PRINT_LOADING_MESSAGE("");
713 /* Lisp_Object's must be malloc'ed, not stack-allocated */
714 Lisp_Object lstrm = Qnil;
715 const int block_size = 8192;
716 struct gcpro ngcpro1;
720 signal_file_error("Cannot open load file", file);
722 lstrm = make_filedesc_input_stream(fd, 0, -1, LSTR_CLOSING);
723 /* 64K is used for normal files; 8K should be OK here because
724 * Lisp files aren't really all that big. */
725 Lstream_set_buffering(XLSTREAM(lstrm),
726 LSTREAM_BLOCKN_BUFFERED, block_size);
728 lstrm = make_decoding_input_stream(
729 XLSTREAM(lstrm), Fget_coding_system(codesys));
730 Lstream_set_buffering(XLSTREAM(lstrm),
731 LSTREAM_BLOCKN_BUFFERED, block_size);
733 /* NOTE: Order of these is very important.
734 * Don't rearrange them. */
735 record_unwind_protect(load_unwind, lstrm);
736 record_unwind_protect(load_descriptor_unwind,
737 Vload_descriptor_list);
738 record_unwind_protect(load_file_name_internal_unwind,
739 Vload_file_name_internal);
740 record_unwind_protect(
741 load_file_name_internal_the_purecopy_unwind,
742 Vload_file_name_internal_the_purecopy);
743 record_unwind_protect(load_force_doc_string_unwind,
744 Vload_force_doc_string_list);
745 Vload_file_name_internal = found;
746 Vload_file_name_internal_the_purecopy = Qnil;
747 specbind(Qload_file_name, found);
748 Vload_descriptor_list =
749 Fcons(make_int(fd), Vload_descriptor_list);
750 Vload_force_doc_string_list = Qnil;
752 record_unwind_protect(restore_file_domain, Vfile_domain);
753 /* set it to nil; a call to #'domain will set it. */
758 /* Now determine what sort of ELC file we're reading in. */
759 record_unwind_protect(load_byte_code_version_unwind,
760 make_int(load_byte_code_version));
765 num_read = Lstream_read(XLSTREAM(lstrm), elc_header, 8);
766 if (num_read < 8 || strncmp(elc_header, ";ELC", 4)) {
767 /* Huh? Probably not a valid ELC file. */
768 /* no Ebolification needed */
769 load_byte_code_version = 100;
770 Lstream_unread(XLSTREAM(lstrm), elc_header,
773 load_byte_code_version = elc_header[4];
776 /* no Ebolification needed */
777 load_byte_code_version = 100;
780 readevalloop(lstrm, file, Feval, 0);
782 if (!NILP(used_codesys)) {
784 decoding_stream_coding_system(XLSTREAM(lstrm));
785 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
788 unbind_to(speccount, Qnil);
795 /* #### Disgusting kludge */
796 /* Run any load-hooks for this file. */
797 /* #### An even more disgusting kludge. There is horrible code */
798 /* that is relying on the fact that dumped lisp files are found */
799 /* via `load-path' search. */
800 Lisp_Object name = file;
802 if (!NILP(Ffile_name_absolute_p(file))) {
803 name = Ffile_name_nondirectory(file);
807 struct gcpro ngcpro1;
810 tem = Fassoc(name, Vafter_load_alist);
814 struct gcpro ngcpro1;
817 /* Use eval so that errors give a semi-meaningful
818 * backtrace. --Stig */
819 tem = Fcons(Qprogn, Fcdr(tem));
825 /*#ifdef DEBUG_SXEMACS*/
826 if (purify_flag && noninteractive) {
827 if (!EQ(last_file_loaded, file)) {
828 message("Loading %s ...done", XSTRING_DATA(file));
831 /*#endif / * DEBUG_SXEMACS */
833 if (!noninteractive) {
834 PRINT_LOADING_MESSAGE("done");
840 /* ------------------------------- */
842 /* ------------------------------- */
844 static int decode_mode_1(Lisp_Object mode)
846 if (EQ(mode, Qexists))
848 else if (EQ(mode, Qexecutable))
850 else if (EQ(mode, Qwritable))
852 else if (EQ(mode, Qreadable))
854 else if (INTP(mode)) {
855 check_int_range(XINT(mode), 0, 7);
858 signal_simple_error("Invalid value", mode);
859 return 0; /* unreached */
862 static int decode_mode(Lisp_Object mode)
866 else if (CONSP(mode)) {
869 EXTERNAL_LIST_LOOP(tail, mode)
870 mask |= decode_mode_1(XCAR(tail));
873 return decode_mode_1(mode);
876 DEFUN("locate-file", Flocate_file, 2, 4, 0, /*
877 Search for FILENAME through PATH-LIST.
878 If SUFFIXES is non-nil, it should be a list of suffixes to append to
879 file name when searching.
881 If MODE is non-nil, it should be a symbol or a list of symbol representing
882 requirements. Allowed symbols are `exists', `executable', `writable', and
883 `readable'. If MODE is nil, it defaults to `readable'.
885 Filenames are checked against `load-suppress-alist' to determine if they
888 `locate-file' keeps hash tables of the directories it searches through,
889 in order to speed things up. It tries valiantly to not get confused in
890 the face of a changing and unpredictable environment, but can occasionally
891 get tripped up. In this case, you will have to call
892 `locate-file-clear-hashing' to get it back on track. See that function
895 (filename, path_list, suffixes, mode))
897 /* This function can GC */
900 CHECK_STRING(filename);
902 if (LISTP(suffixes)) {
904 EXTERNAL_LIST_LOOP(tail, suffixes)
905 CHECK_STRING(XCAR(tail));
907 CHECK_STRING(suffixes);
909 locate_file(path_list, filename, suffixes, &tp, decode_mode(mode));
913 /* Recalculate the hash table for the given string. DIRECTORY should
914 better have been through Fexpand_file_name() by now. */
916 static Lisp_Object locate_file_refresh_hashing(Lisp_Object directory)
919 make_directory_hash_table((char *)XSTRING_DATA(directory));
922 Fputhash(directory, hash, Vlocate_file_hash_table);
926 /* find the hash table for the given directory, recalculating if necessary */
928 static Lisp_Object locate_file_find_directory_hash_table(Lisp_Object directory)
930 Lisp_Object hash = Fgethash(directory, Vlocate_file_hash_table, Qnil);
932 return locate_file_refresh_hashing(directory);
937 /* The SUFFIXES argument in any of the locate_file* functions can be
938 nil, a list, or a string (for backward compatibility), with the
941 a) nil - no suffix, just search for file name intact
942 (semantically different from "empty suffix list", which
943 would be meaningless.)
944 b) list - list of suffixes to append to file name. Each of these
946 c) string - colon-separated suffixes to append to file name (backward
949 All of this got hairy, so I decided to use a mapper. Calling a
950 function for each suffix shouldn't slow things down, since
951 locate_file is rarely called with enough suffixes for funcalls to
952 make any difference. */
954 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
955 char * containing the current file name, and ARG. Mapping stops when
956 FUN returns non-zero. */
958 locate_file_map_suffixes(Lisp_Object filename, Lisp_Object suffixes,
959 int (*fun) (char *, void *), void *arg)
961 /* This function can GC */
965 /* Calculate maximum size of any filename made from
966 this path element/specified file name and any possible suffix. */
967 if (CONSP(suffixes)) {
968 /* We must traverse the list, so why not do it right. */
971 LIST_LOOP(tail, suffixes) {
972 if (XSTRING_LENGTH(XCAR(tail)) > max)
973 max = XSTRING_LENGTH(XCAR(tail));
975 } else if (NILP(suffixes))
978 /* Just take the easy way out */
979 max = XSTRING_LENGTH(suffixes);
981 fn_len = XSTRING_LENGTH(filename);
982 fn = (char *)alloca(max + fn_len + 1);
983 memcpy(fn, (char *)XSTRING_DATA(filename), fn_len);
985 /* Loop over suffixes. */
986 if (!STRINGP(suffixes)) {
987 if (NILP(suffixes)) {
988 /* Case a) discussed in the comment above. */
990 if ((*fun) (fn, arg))
995 LIST_LOOP(tail, suffixes) {
996 memcpy(fn + fn_len, XSTRING_DATA(XCAR(tail)),
997 XSTRING_LENGTH(XCAR(tail)));
998 fn[fn_len + XSTRING_LENGTH(XCAR(tail))] = 0;
999 if ((*fun) (fn, arg))
1005 const char *nsuffix = (const char *)XSTRING_DATA(suffixes);
1008 char *esuffix = (char *)strchr(nsuffix, ':');
1010 esuffix ? esuffix - nsuffix : (int)strlen(nsuffix);
1012 /* Concatenate path element/specified name with the suffix. */
1013 strncpy(fn + fn_len, nsuffix, lsuffix);
1014 fn[fn_len + lsuffix] = '\0';
1016 if ((*fun) (fn, arg))
1019 /* Advance to next suffix. */
1022 nsuffix += lsuffix + 1;
1027 struct locate_file_in_directory_mapper_closure {
1029 Lisp_Object *storeptr;
1033 static int locate_file_in_directory_mapper(char *fn, void *arg)
1035 struct locate_file_in_directory_mapper_closure *closure =
1036 (struct locate_file_in_directory_mapper_closure *)arg;
1039 /* Ignore file if it's a directory. */
1040 if (sxemacs_stat(fn, &st) >= 0 && (st.st_mode & S_IFMT) != S_IFDIR) {
1041 /* Check that we can access or open it. */
1042 if (closure->mode >= 0)
1043 closure->fd = access(fn, closure->mode);
1045 closure->fd = open(fn, O_RDONLY | OPEN_BINARY, 0);
1047 if (closure->fd >= 0) {
1048 if (!suppressedp(fn, Qnil)) {
1049 /* We succeeded; return this descriptor and
1051 if (closure->storeptr)
1052 *closure->storeptr = build_string(fn);
1054 /* If we actually opened the file, set
1055 close-on-exec flag on the new descriptor so
1056 that subprocesses can't whack at it. */
1057 if (closure->mode < 0)
1058 (void)fcntl(closure->fd,
1059 F_SETFD, FD_CLOEXEC);
1069 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
1070 not have been expanded. */
1073 locate_file_in_directory(Lisp_Object directory, Lisp_Object str,
1074 Lisp_Object suffixes, Lisp_Object * storeptr, int mode)
1076 /* This function can GC */
1077 struct locate_file_in_directory_mapper_closure closure;
1078 Lisp_Object filename = Qnil;
1079 struct gcpro gcpro1, gcpro2, gcpro3;
1081 GCPRO3(directory, str, filename);
1083 filename = Fexpand_file_name(str, directory);
1084 if (NILP(filename) || NILP(Ffile_name_absolute_p(filename)))
1085 /* If there are non-absolute elts in PATH (eg ".") */
1086 /* Of course, this could conceivably lose if luser sets
1087 default-directory to be something non-absolute ... */
1090 /* NIL means current directory */
1091 filename = current_buffer->directory;
1093 filename = Fexpand_file_name(filename,
1094 current_buffer->directory);
1095 if (NILP(Ffile_name_absolute_p(filename))) {
1096 /* Give up on this directory! */
1103 closure.storeptr = storeptr;
1104 closure.mode = mode;
1106 locate_file_map_suffixes(filename, suffixes,
1107 locate_file_in_directory_mapper, &closure);
1113 /* do the same as locate_file() but don't use any hash tables. */
1116 locate_file_without_hash(Lisp_Object path, Lisp_Object str,
1117 Lisp_Object suffixes, Lisp_Object * storeptr, int mode)
1119 /* This function can GC */
1120 int absolute = !NILP(Ffile_name_absolute_p(str));
1122 EXTERNAL_LIST_LOOP(path, path) {
1124 locate_file_in_directory(XCAR(path), str, suffixes,
1135 static int locate_file_construct_suffixed_files_mapper(char *fn, void *arg)
1137 Lisp_Object *tail = (Lisp_Object *) arg;
1138 *tail = Fcons(build_string(fn), *tail);
1142 /* Construct a list of all files to search for.
1143 It makes sense to have this despite locate_file_map_suffixes()
1144 because we need Lisp strings to access the hash-table, and it would
1145 be inefficient to create them on the fly, again and again for each
1146 path component. See locate_file(). */
1149 locate_file_construct_suffixed_files(Lisp_Object filename, Lisp_Object suffixes)
1151 Lisp_Object tail = Qnil;
1152 struct gcpro gcpro1;
1155 locate_file_map_suffixes(filename, suffixes,
1156 locate_file_construct_suffixed_files_mapper,
1160 return Fnreverse(tail);
1163 DEFUN("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1164 Clear the hash records for the specified list of directories.
1165 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1166 track the following environmental changes:
1168 -- changes of any sort to the list of directories to be searched.
1169 -- addition and deletion of non-shadowing files (see below) from the
1170 directories in the list.
1171 -- byte-compilation of a .el file into a .elc file.
1173 `locate-file' will primarily get confused if you add a file that shadows
1174 \(i.e. has the same name as) another file further down in the directory list.
1175 In this case, you must call `locate-file-clear-hashing'.
1177 If PATH is t, it means to fully clear all the accumulated hashes. This
1178 can be used if the internal tables grow too large, or when dumping.
1183 Fclrhash(Vlocate_file_hash_table);
1185 Lisp_Object pathtail;
1186 EXTERNAL_LIST_LOOP(pathtail, path) {
1187 Lisp_Object pathel =
1188 Fexpand_file_name(XCAR(pathtail), Qnil);
1189 Fremhash(pathel, Vlocate_file_hash_table);
1195 /* Search for a file whose name is STR, looking in directories
1196 in the Lisp list PATH, and trying suffixes from SUFFIXES.
1197 SUFFIXES is a list of possible suffixes, or (for backward
1198 compatibility) a string containing possible suffixes separated by
1200 On success, returns a file descriptor. On failure, returns -1.
1202 MODE nonnegative means don't open the files,
1203 just look for one for which access(file,MODE) succeeds. In this case,
1204 returns a nonnegative value on success. On failure, returns -1.
1206 If STOREPTR is nonzero, it points to a slot where the name of
1207 the file actually found should be stored as a Lisp string.
1208 Nil is stored there on failure.
1210 Called openp() in FSFmacs. */
1213 locate_file(Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1214 Lisp_Object * storeptr, int mode)
1216 /* This function can GC */
1217 Lisp_Object suffixtab = Qnil;
1218 Lisp_Object pathtail, pathel_expanded;
1220 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1225 /* Is it really necessary to gcpro path and str? It shouldn't be
1226 unless some caller has fucked up. There are known instances that
1227 call us with build_string("foo:bar") as SUFFIXES, though. */
1228 GCPRO4(path, str, suffixes, suffixtab);
1230 /* if this filename has directory components, it's too complicated
1231 to try and use the hash tables. */
1232 if (!NILP(Ffile_name_directory(str))) {
1234 locate_file_without_hash(path, str, suffixes, storeptr,
1240 suffixtab = locate_file_construct_suffixed_files(str, suffixes);
1242 EXTERNAL_LIST_LOOP(pathtail, path) {
1243 Lisp_Object pathel = XCAR(pathtail);
1244 Lisp_Object hash_table;
1248 /* If this path element is relative, we have to look by hand. */
1249 if (NILP(pathel) || NILP(Ffile_name_absolute_p(pathel))) {
1251 locate_file_in_directory(pathel, str, suffixes,
1260 pathel_expanded = Fexpand_file_name(pathel, Qnil);
1262 locate_file_find_directory_hash_table(pathel_expanded);
1264 if (!NILP(hash_table)) {
1265 /* Loop over suffixes. */
1266 LIST_LOOP(tail, suffixtab)
1267 if (!NILP(Fgethash(XCAR(tail), hash_table, Qnil))) {
1274 /* This is a likely candidate. Look by hand in this directory
1275 so we don't get thrown off if someone byte-compiles a file. */
1277 locate_file_in_directory(pathel, str, suffixes,
1284 /* Hmm ... the file isn't actually there. (Or possibly it's
1285 a directory ...) So refresh our hashing. */
1286 locate_file_refresh_hashing(pathel_expanded);
1290 /* File is probably not there, but check the hard way just in case. */
1291 val = locate_file_without_hash(path, str, suffixes, storeptr, mode);
1293 /* Sneaky user added a file without telling us. */
1294 Flocate_file_clear_hashing(path);
1303 /* Merge the list we've accumulated of globals from the current input source
1304 into the load_history variable. The details depend on whether
1305 the source has an associated file name or not. */
1307 static void build_load_history(int loading, Lisp_Object source)
1309 REGISTER Lisp_Object tail, prev, newelt;
1310 REGISTER Lisp_Object tem, tem2;
1313 #if !defined(LOADHIST_DUMPED)
1314 /* Don't bother recording anything for preloaded files. */
1319 tail = Vload_history;
1322 while (!NILP(tail)) {
1325 /* Find the feature's previous assoc list... */
1326 if (internal_equal(source, Fcar(tem), 0)) {
1329 /* If we're loading, remove it. */
1332 Vload_history = Fcdr(tail);
1334 Fsetcdr(prev, Fcdr(tail));
1337 /* Otherwise, cons on new symbols that are not already members. */
1339 tem2 = Vcurrent_load_list;
1341 while (CONSP(tem2)) {
1342 newelt = XCAR(tem2);
1344 if (NILP(Fmemq(newelt, tem)))
1345 Fsetcar(tail, Fcons(Fcar(tem),
1361 /* If we're loading, cons the new assoc onto the front of load-history,
1362 the most-recently-loaded position. Also do this if we didn't find
1363 an existing member for the current source. */
1364 if (loading || !foundit)
1365 Vload_history = Fcons(Fnreverse(Vcurrent_load_list),
1369 #else /* !LOADHIST */
1370 #define build_load_history(x,y)
1371 #endif /* !LOADHIST */
1373 #if 0 /* FSFmacs defun hack */
1374 Lisp_Object unreadpure(void)
1375 { /* Used as unwind-protect function in readevalloop */
1382 readevalloop(Lisp_Object readcharfun,
1383 Lisp_Object sourcename,
1384 Lisp_Object(*evalfun) (Lisp_Object), int printflag)
1386 /* This function can GC */
1388 REGISTER Lisp_Object val = Qnil;
1389 int speccount = specpdl_depth();
1390 struct gcpro gcpro1, gcpro2;
1391 struct buffer *b = 0;
1393 if (BUFFERP(readcharfun))
1394 b = XBUFFER(readcharfun);
1395 else if (MARKERP(readcharfun))
1396 b = XMARKER(readcharfun)->buffer;
1398 /* Don't do this. It is not necessary, and it needlessly exposes
1399 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1400 /*specbind (Qstandard_input, readcharfun); */
1402 specbind(Qcurrent_load_list, Qnil);
1404 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1405 Vcurrent_compiled_function_annotation = Qnil;
1407 GCPRO2(val, sourcename);
1409 LOADHIST_ATTACH(sourcename);
1414 if (b != 0 && !BUFFER_LIVE_P(b))
1415 error("Reading from killed buffer");
1417 c = readchar(readcharfun);
1420 while ((c = readchar(readcharfun)) != '\n' && c != -1)
1427 /* Ignore whitespace here, so we can detect eof. */
1428 if (c == ' ' || c == '\t' || c == '\n' || c == '\f'
1432 #if 0 /* FSFmacs defun hack */
1433 if (purify_flag && c == '(') {
1434 int count1 = specpdl_depth();
1435 record_unwind_protect(unreadpure, Qnil);
1436 val = read_list(readcharfun, ')', -1, 1);
1437 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);
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 a stream for printing.
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.
1478 (buffer, printflag))
1480 /* This function can GC */
1481 int speccount = specpdl_depth();
1482 Lisp_Object tem, buf;
1485 buf = Fcurrent_buffer();
1487 buf = Fget_buffer(buffer);
1489 error("No such buffer.");
1491 if (NILP(printflag))
1492 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1495 specbind(Qstandard_output, tem);
1496 record_unwind_protect(save_excursion_restore, save_excursion_save());
1497 BUF_SET_PT(XBUFFER(buf), BUF_BEGV(XBUFFER(buf)));
1498 readevalloop(buf, XBUFFER(buf)->filename, Feval, !NILP(printflag));
1500 return unbind_to(speccount, Qnil);
1504 xxDEFUN("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1505 Execute the current buffer as Lisp code.
1506 Programs can pass argument PRINTFLAG which controls printing of output:
1507 nil means discard it; anything else is stream for print.
1509 If there is no error, point does not move. If there is an error,
1510 point remains at the end of the last character read from the buffer.
1517 DEFUN("eval-region", Feval_region, 2, 3, "r", /*
1518 Execute the region as Lisp code.
1519 When called from programs, expects two arguments START and END
1520 giving starting and ending indices in the current buffer
1521 of the text to be executed.
1522 Programs can pass third optional argument STREAM which controls output:
1523 nil means discard it; anything else is stream for printing it.
1525 If there is no error, point does not move. If there is an error,
1526 point remains at the end of the last character read from the buffer.
1528 Note: Before evaling the region, this function narrows the buffer to it.
1529 If the code being eval'd should happen to trigger a redisplay you may
1530 see some text temporarily disappear because of this.
1532 (start, end, stream))
1534 /* This function can GC */
1535 int speccount = specpdl_depth();
1537 Lisp_Object cbuf = Fcurrent_buffer();
1540 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1543 specbind(Qstandard_output, tem);
1546 record_unwind_protect(save_excursion_restore,
1547 save_excursion_save());
1548 record_unwind_protect(save_restriction_restore,
1549 save_restriction_save());
1551 /* This both uses start and checks its type. */
1552 Fgoto_char(start, cbuf);
1553 Fnarrow_to_region(make_int(BUF_BEGV(current_buffer)), end, cbuf);
1554 readevalloop(cbuf, XBUFFER(cbuf)->filename, Feval, !NILP(stream));
1556 return unbind_to(speccount, Qnil);
1559 DEFUN("read", Fread, 0, 1, 0, /*
1560 Read one Lisp expression as text from STREAM, return as Lisp object.
1561 If STREAM is nil, use the value of `standard-input' (which see).
1562 STREAM or the value of `standard-input' may be:
1563 a buffer (read from point and advance it)
1564 a marker (read from where it points and advance it)
1565 a function (call it with no arguments for each character,
1566 call it with a char as argument to push a char back)
1567 a string (takes text from string, starting at the beginning)
1568 t (read text line using minibuffer and use it).
1573 stream = Vstandard_input;
1575 stream = Qread_char;
1577 Vread_objects = Qnil;
1579 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1580 Vcurrent_compiled_function_annotation = Qnil;
1582 if (EQ(stream, Qread_char)) {
1583 Lisp_Object val = call1(Qread_from_minibuffer,
1584 build_translated_string
1585 ("Lisp expression: "));
1586 return Fcar(Fread_from_string(val, Qnil, Qnil));
1589 if (STRINGP(stream))
1590 return Fcar(Fread_from_string(stream, Qnil, Qnil));
1592 return read0(stream);
1595 DEFUN("read-from-string", Fread_from_string, 1, 3, 0, /*
1596 Read one Lisp expression which is represented as text by STRING.
1597 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1598 START and END optionally delimit a substring of STRING from which to read;
1599 they default to 0 and (length STRING) respectively.
1601 (string, start, end))
1603 Bytecount startval, endval;
1605 Lisp_Object lispstream = Qnil;
1606 struct gcpro gcpro1;
1608 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1609 Vcurrent_compiled_function_annotation = Qnil;
1612 CHECK_STRING(string);
1613 get_string_range_byte(string, start, end, &startval, &endval,
1614 GB_HISTORICAL_STRING_BEHAVIOR);
1615 lispstream = make_lisp_string_input_stream(string, startval,
1618 Vread_objects = Qnil;
1620 tem = read0(lispstream);
1621 /* Yeah, it's ugly. Gonna make something of it?
1622 At least our reader is reentrant ... */
1624 (Fcons(tem, make_int
1625 (bytecount_to_charcount
1626 (XSTRING_DATA(string),
1627 startval + Lstream_byte_count(XLSTREAM(lispstream))))));
1628 Lstream_delete(XLSTREAM(lispstream));
1634 ureader_find(Lisp_Object name)
1636 return Fcdr(Fassoc(name, Vureaders));
1641 * ureader_read() assumes that input starts with < character and
1642 * should finish on matching > character.
1645 ureader_read(Lisp_Object ureader_fun, Lisp_Object readcharfun)
1648 unsigned int oparens = 0;
1649 struct gcpro gcpro1;
1652 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
1653 while ((c = readchar(readcharfun)) >= 0) {
1656 else if (c == '>') {
1658 /* We got final closing paren */
1663 Lstream_put_emchar(XLSTREAM (Vread_buffer_stream), c);
1667 return Fsignal(Qend_of_file,
1668 list1(READCHARFUN_MAYBE(readcharfun)));
1670 Lstream_flush(XLSTREAM(Vread_buffer_stream));
1672 instr = make_string(resizing_buffer_stream_ptr
1673 (XLSTREAM(Vread_buffer_stream)),
1674 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
1676 RETURN_UNGCPRO(call1(ureader_fun, instr));
1680 #ifdef LISP_BACKQUOTES
1682 static Lisp_Object backquote_unwind(Lisp_Object ptr)
1683 { /* used as unwind-protect function in read0() */
1684 int *counter = (int *)get_opaque_ptr(ptr);
1687 free_opaque_ptr(ptr);
1693 /* Use this for recursive reads, in contexts where internal tokens
1694 are not allowed. See also read1(). */
1695 static Lisp_Object read0(Lisp_Object readcharfun)
1697 Lisp_Object val = read1(readcharfun);
1699 if (CONSP(val) && UNBOUNDP(XCAR(val))) {
1700 Emchar c = XCHAR(XCDR(val));
1701 free_cons(XCONS(val));
1702 return Fsignal(Qinvalid_read_syntax,
1703 list1(Fchar_to_string(make_char(c))));
1709 static Emchar read_escape(Lisp_Object readcharfun)
1711 /* This function can GC */
1712 Emchar c = readchar(readcharfun);
1715 signal_error(Qend_of_file,
1716 list1(READCHARFUN_MAYBE(readcharfun)));
1741 c = readchar(readcharfun);
1743 signal_error(Qend_of_file,
1744 list1(READCHARFUN_MAYBE(readcharfun)));
1746 error("Invalid escape character syntax");
1747 c = readchar(readcharfun);
1749 signal_error(Qend_of_file,
1750 list1(READCHARFUN_MAYBE(readcharfun)));
1752 c = read_escape(readcharfun);
1755 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1756 compatibility by defining character "modifiers" alt, super,
1757 hyper and shift to infest the characters (i.e. integers).
1759 However, this doesn't cut it for XEmacs 20, which
1760 distinguishes characters from integers. Without Mule, ?\H-a
1761 simply returns ?a because every character is clipped into
1762 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1763 produces an illegal character, and moves us to crash-land.
1765 For these reasons, FSF_KEYS hack is useless and without hope
1766 of ever working under XEmacs 20. */
1770 #define alt_modifier (0x040000)
1771 #define super_modifier (0x080000)
1772 #define hyper_modifier (0x100000)
1773 #define shift_modifier (0x200000)
1774 /* fsf uses a different modifiers for meta and control. Possibly
1775 byte_compiled code will still work fsfmacs, though... --Stig
1777 #define ctl_modifier (0x400000)
1778 #define meta_modifier (0x800000)
1780 #define FSF_LOSSAGE(mask) \
1781 if (fail_on_bucky_bit_character_escapes || \
1782 ((c = readchar (readcharfun)) != '-')) \
1783 error ("Invalid escape character syntax"); \
1784 c = readchar (readcharfun); \
1786 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1788 c = read_escape (readcharfun); \
1792 FSF_LOSSAGE(shift_modifier);
1794 FSF_LOSSAGE(hyper_modifier);
1796 FSF_LOSSAGE(alt_modifier);
1798 FSF_LOSSAGE(super_modifier);
1800 #undef super_modifier
1801 #undef hyper_modifier
1802 #undef shift_modifier
1805 #endif /* FSF_KEYS */
1808 c = readchar(readcharfun);
1810 signal_error(Qend_of_file,
1811 list1(READCHARFUN_MAYBE(readcharfun)));
1813 error("Invalid escape character syntax");
1815 c = readchar(readcharfun);
1817 signal_error(Qend_of_file,
1818 list1(READCHARFUN_MAYBE(readcharfun)));
1820 c = read_escape(readcharfun);
1821 /* FSFmacs junk for non-ASCII controls.
1826 return c & (0200 | 037);
1836 /* An octal escape, as in ANSI C. */
1838 REGISTER Emchar i = c - '0';
1839 REGISTER int count = 0;
1840 while (++count < 3) {
1841 if ((c = readchar(readcharfun)) >= '0'
1843 i = (i << 3) + (c - '0');
1845 unreadchar(readcharfun, c);
1853 /* A hex escape, as in ANSI C, except that we only allow latin-1
1854 characters to be read this way. What is "\x4e03" supposed to
1855 mean, anyways, if the internal representation is hidden?
1856 This is also consistent with the treatment of octal escapes. */
1858 REGISTER Emchar i = 0;
1859 REGISTER int count = 0;
1860 while (++count <= 2) {
1861 c = readchar(readcharfun);
1862 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1863 if (c >= '0' && c <= '9')
1864 i = (i << 4) + (c - '0');
1865 else if (c >= 'a' && c <= 'f')
1866 i = (i << 4) + (c - 'a') + 10;
1867 else if (c >= 'A' && c <= 'F')
1868 i = (i << 4) + (c - 'A') + 10;
1870 unreadchar(readcharfun, c);
1878 /* #### need some way of reading an extended character with
1879 an escape sequence. */
1887 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1889 read_atom_0(Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1891 /* This function can GC */
1892 Emchar c = ((firstchar) >= 0 ? firstchar : readchar(readcharfun));
1893 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
1895 *saw_a_backslash = 0;
1897 while (c > 040 /* #### - comma should be here as should backquote */
1898 && !(c == '\"' || c == '\'' || c == ';' || c == '(' || c == ')'
1899 #ifndef HAVE_FPFLOAT
1900 /* If we have floating-point support, then we need
1901 to allow <digits><dot><digits>. */
1903 #endif /* not HAVE_FPFLOAT */
1904 || c == '[' || c == ']' || c == '#')) {
1906 c = readchar(readcharfun);
1908 signal_error(Qend_of_file,
1909 list1(READCHARFUN_MAYBE
1911 *saw_a_backslash = 1;
1913 Lstream_put_emchar(XLSTREAM(Vread_buffer_stream), c);
1915 c = readchar(readcharfun);
1919 unreadchar(readcharfun, c);
1920 /* blasted terminating 0 */
1921 Lstream_put_emchar(XLSTREAM(Vread_buffer_stream), 0);
1922 Lstream_flush(XLSTREAM(Vread_buffer_stream));
1924 return Lstream_byte_count(XLSTREAM(Vread_buffer_stream)) - 1;
1927 static Lisp_Object parse_integer(const Bufbyte * buf, Bytecount len, int base);
1930 read_atom(Lisp_Object readcharfun, Emchar firstchar, int uninterned_symbol)
1932 /* This function can GC */
1933 int saw_a_backslash;
1934 Bytecount len = read_atom_0(readcharfun, firstchar, &saw_a_backslash);
1935 char *read_ptr = (char *)
1936 resizing_buffer_stream_ptr(XLSTREAM(Vread_buffer_stream));
1938 /* Is it an integer? */
1939 if (!(saw_a_backslash || uninterned_symbol)) {
1940 /* If a token had any backslashes in it, it is disqualified from
1941 being an integer or a float. This means that 123\456 is a
1942 symbol, as is \123 (which is the way (intern "123") prints).
1943 Also, if token was preceded by #:, it's always a symbol.
1945 char *p = read_ptr + len;
1946 char *p1 = read_ptr;
1948 if (*p1 == '+' || *p1 == '-')
1953 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1956 /* Integers can have trailing decimal points. */
1957 if (p1 > read_ptr && p1 < p && *p1 == '.')
1961 /* It is an integer. */
1966 return parse_integer((Bufbyte*)read_ptr, len,
1970 #if defined HAVE_MPQ && defined WITH_GMP
1971 if (isbigq_string(read_ptr))
1972 return read_bigq_string(read_ptr);
1974 #if defined HAVE_MPFR && defined WITH_MPFR
1975 if (isfloat_string(read_ptr) && (Vread_real_as == Qbigfr))
1976 return read_bigfr_string(read_ptr);
1977 #endif /* HAVE_MPFR */
1978 #if defined HAVE_MPF && defined WITH_GMP
1979 if (isfloat_string(read_ptr) && (Vread_real_as == Qbigf))
1980 return read_bigf_string(read_ptr);
1982 #endif /* HAVE_MPF */
1984 if (isfloat_string(read_ptr)) {
1985 return make_float(str_to_fpfloat(read_ptr));
1988 #if defined HAVE_PSEUG && defined WITH_PSEUG
1989 if (isgaussian_string(read_ptr))
1990 return read_bigg_string(read_ptr);
1992 #if defined HAVE_MPC && defined WITH_MPC || \
1993 defined HAVE_PSEUC && defined WITH_PSEUC
1994 if (isbigc_string(read_ptr))
1995 return read_bigc_string(read_ptr);
1996 #endif /* HAVE_MPC */
1997 #if defined HAVE_QUATERN && defined WITH_QUATERN
1998 if (isquatern_string(read_ptr))
1999 return read_quatern_string(read_ptr);
2003 /* check for resclass syntax */
2004 if (ase_resc_rng_pred_f && ase_resc_rng_f &&
2005 ase_resc_rng_pred_f(read_ptr))
2006 return ase_resc_rng_f(read_ptr);
2007 if (ase_resc_elm_pred_f && ase_resc_elm_f &&
2008 ase_resc_elm_pred_f(read_ptr))
2009 return ase_resc_elm_f(read_ptr);
2013 if (uninterned_symbol)
2015 Fmake_symbol(make_string
2016 ((Bufbyte *) read_ptr, len));
2019 make_string((Bufbyte *) read_ptr, len);
2020 sym = Fintern(name, Qnil);
2027 parse_integer(const Bufbyte * buf, Bytecount len, int base)
2029 const Bufbyte *lim = buf + len;
2030 const Bufbyte *p = buf;
2032 int negativland = 0;
2037 } else if (*p == '+') {
2044 for (; (p < lim) && (*p != '\0'); p++) {
2050 else if (isupper(c))
2052 else if (islower(c))
2057 if (c < 0 || c >= base)
2061 num = num * base + c;
2067 EMACS_INT int_result =
2068 negativland ? -(EMACS_INT) num : (EMACS_INT) num;
2069 Lisp_Object result = make_int(int_result);
2070 if (num && ((XINT(result) < 0) != negativland))
2072 if (XINT(result) != int_result)
2077 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_BSDMP)
2078 return read_bigz_string((const char*)buf, base);
2080 /* This is going to kill us!
2081 * Big integers cannot be used anywhere if the reader rewards
2082 * their occurence that harshly
2084 return Fsignal(Qinvalid_read_syntax,
2085 list3(build_translated_string
2086 ("Integer constant overflow in reader"),
2087 make_string(buf, len), make_int(base)));
2089 warn_when_safe(Qinvalid_read_syntax, Qwarning,
2090 "Integer constant overflow in reader: %s,"
2091 " proceeding nervously with 0.",
2094 #endif /* HAVE_MPZ && WITH_GMP||WITH_BSDMP */
2096 return Fsignal(Qinvalid_read_syntax,
2097 list3(build_translated_string
2098 ("Invalid integer constant in reader"),
2099 make_string(buf, len), make_int(base)));
2103 read_integer(Lisp_Object readcharfun, int base)
2105 /* This function can GC */
2106 int saw_a_backslash;
2107 Bytecount len = read_atom_0(readcharfun, -1, &saw_a_backslash);
2108 return (parse_integer
2109 (resizing_buffer_stream_ptr(XLSTREAM(Vread_buffer_stream)),
2111 ? 0 /* make parse_integer signal error */
2116 read_bit_vector(Lisp_Object readcharfun)
2118 unsigned_char_dynarr *dyn = Dynarr_new(unsigned_char);
2123 Emchar c = readchar(readcharfun);
2130 unreadchar(readcharfun, c);
2133 Dynarr_add(dyn, bit);
2136 val = make_bit_vector_from_byte_vector(Dynarr_atp(dyn, 0),
2137 Dynarr_length(dyn));
2145 struct structure_type*
2146 define_structure_type(Lisp_Object type,
2147 int(*validate)(Lisp_Object data, Error_behavior errb),
2148 Lisp_Object(*instantiate)(Lisp_Object data))
2150 struct structure_type st;
2153 st.keywords = Dynarr_new(structure_keyword_entry);
2154 st.validate = validate;
2155 st.instantiate = instantiate;
2156 Dynarr_add(the_structure_type_dynarr, st);
2158 return Dynarr_atp(the_structure_type_dynarr,
2159 Dynarr_length(the_structure_type_dynarr) - 1);
2163 define_structure_type_keyword(struct structure_type *st, Lisp_Object keyword,
2164 int (*validate) (Lisp_Object keyword,
2166 Error_behavior errb))
2168 struct structure_keyword_entry en;
2170 en.keyword = keyword;
2171 en.validate = validate;
2172 Dynarr_add(st->keywords, en);
2175 static struct structure_type*
2176 recognized_structure_type(Lisp_Object type)
2180 for (i = 0; i < Dynarr_length(the_structure_type_dynarr); i++) {
2181 struct structure_type *st =
2182 Dynarr_atp(the_structure_type_dynarr, i);
2183 if (EQ(st->type, type))
2191 read_structure(Lisp_Object readcharfun)
2193 Emchar c = readchar(readcharfun);
2194 Lisp_Object list = Qnil;
2195 Lisp_Object orig_list = Qnil;
2196 Lisp_Object already_seen = Qnil;
2198 struct structure_type *st;
2199 struct gcpro gcpro1, gcpro2;
2201 GCPRO2(orig_list, already_seen);
2203 RETURN_UNGCPRO(continuable_read_syntax_error
2204 ("#s not followed by paren"));
2205 list = read_list(readcharfun, ')', 0, 0);
2208 int len = XINT(Flength(list));
2210 RETURN_UNGCPRO(continuable_read_syntax_error
2211 ("structure type not specified"));
2214 (continuable_read_syntax_error
2215 ("structures must have alternating keyword/value pairs"));
2218 st = recognized_structure_type(XCAR(list));
2220 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2221 list2(build_translated_string
2222 ("unrecognized structure type"),
2226 keyword_count = Dynarr_length(st->keywords);
2227 while (!NILP(list)) {
2228 Lisp_Object keyword, value;
2230 struct structure_keyword_entry *en = NULL;
2232 keyword = Fcar(list);
2237 if (!NILP(memq_no_quit(keyword, already_seen)))
2238 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2239 list2(build_translated_string
2240 ("structure keyword already seen"),
2243 for (i = 0; i < keyword_count; i++) {
2244 en = Dynarr_atp(st->keywords, i);
2245 if (EQ(keyword, en->keyword))
2249 if (i == keyword_count)
2250 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2251 list2(build_translated_string
2252 ("unrecognized structure keyword"),
2255 if (en->validate && !(en->validate) (keyword, value, ERROR_ME))
2257 (Fsignal(Qinvalid_read_syntax,
2258 list3(build_translated_string
2259 ("invalid value for structure keyword"),
2262 already_seen = Fcons(keyword, already_seen);
2265 if (st->validate && !(st->validate) (orig_list, ERROR_ME))
2266 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2267 list2(build_translated_string
2268 ("invalid structure initializer"),
2271 RETURN_UNGCPRO((st->instantiate) (XCDR(orig_list)));
2274 static Lisp_Object read_compiled_function(Lisp_Object readcharfun, int);
2275 static Lisp_Object read_vector(Lisp_Object readcharfun, int terminator);
2277 /* Get the next character; filter out whitespace and comments */
2280 reader_nextchar(Lisp_Object readcharfun)
2282 /* This function can GC */
2287 c = readchar(readcharfun);
2289 signal_error(Qend_of_file,
2290 list1(READCHARFUN_MAYBE(readcharfun)));
2295 /* Ignore whitespace and control characters */
2304 while ((c = readchar(readcharfun)) >= 0 && c != '\n')
2312 static Lisp_Object list2_pure(int pure, Lisp_Object a, Lisp_Object b)
2314 return pure ? pure_cons(a, pure_cons(b, Qnil)) : list2(a, b);
2318 /* Read the next Lisp object from the stream READCHARFUN and return it.
2319 If the return value is a cons whose car is Qunbound, then read1()
2320 encountered a misplaced token (e.g. a right bracket, right paren,
2321 or dot followed by a non-number). To filter this stuff out,
2325 read_string(Lisp_Object readcharfun, Emchar delim, int raw)
2328 /* #### If the input stream is translating, then the string
2329 should be marked as translatable by setting its
2330 `string-translatable' property to t. .el and .elc files
2331 normally are translating input streams. See Fgettext()
2332 and print_internal(). */
2337 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
2338 while ((c = readchar(readcharfun)) >= 0 && c != delim) {
2341 /* For raw strings, insert the
2342 backslash and the next char, */
2344 XLSTREAM(Vread_buffer_stream), c);
2345 c = readchar(readcharfun);
2347 /* otherwise, backslash escapes the next char */
2348 c = read_escape(readcharfun);
2351 /* c is -1 if \ newline has just been seen */
2353 if (!Lstream_byte_count(XLSTREAM(Vread_buffer_stream))) {
2357 Lstream_put_emchar(XLSTREAM
2358 (Vread_buffer_stream),
2364 return Fsignal(Qend_of_file,
2365 list1(READCHARFUN_MAYBE(readcharfun)));
2368 /* If purifying, and string starts with \ newline,
2369 return zero instead. This is for doc strings
2370 that we are really going to find in lib-src/DOC.nn.nn */
2371 if (purify_flag && NILP(Vinternal_doc_file_name) && cancel) {
2375 Lstream_flush(XLSTREAM(Vread_buffer_stream));
2376 return make_string(resizing_buffer_stream_ptr
2377 (XLSTREAM(Vread_buffer_stream)),
2378 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
2382 read_raw_string(Lisp_Object readcharfun)
2385 c = reader_nextchar(readcharfun);
2387 /* #r:engine"my sexy raw string" -- raw string w/ flags*/
2389 /* #r"my raw string" -- raw string */
2391 return read_string(readcharfun, '\"', 1);
2392 /* invalid syntax */
2394 unreadchar(readcharfun, c);
2395 return Fsignal(Qinvalid_read_syntax,
2397 ("unrecognized raw string syntax")));
2403 read1(Lisp_Object readcharfun)
2408 c = reader_nextchar(readcharfun);
2412 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2413 /* if this is disabled, then other code in eval.c must be
2415 Emchar ch = reader_nextchar(readcharfun);
2419 int speccount = specpdl_depth();
2420 ++old_backquote_flag;
2421 record_unwind_protect(backquote_unwind,
2423 (&old_backquote_flag));
2424 tem = read0(readcharfun);
2425 unbind_to(speccount, Qnil);
2426 ch = reader_nextchar(readcharfun);
2428 unreadchar(readcharfun, ch);
2431 (Qinvalid_read_syntax,
2433 ("Weird old-backquote syntax")));
2435 return list2(Qbacktick, tem);
2438 if (old_backquote_flag) {
2439 Lisp_Object tem, comma_type;
2440 ch = readchar(readcharfun);
2442 comma_type = Qcomma_at;
2448 comma_type = Qcomma;
2450 tem = read0(readcharfun);
2451 ch = reader_nextchar
2454 unreadchar(readcharfun,
2457 Qinvalid_read_syntax,
2459 ("Weird old-backquote "
2462 return list2(comma_type, tem);
2464 unreadchar(readcharfun, ch);
2468 (Qinvalid_read_syntax,
2470 ("Comma outside of backquote")));
2472 /* #### - yuck....but this is reverse
2474 /* mostly this is required by edebug, which does
2475 its own annotated reading. We need to have
2476 an annotated_read function that records (with
2477 markers) the buffer positions of the elements
2478 that make up lists, then that can be used in
2479 edebug and bytecomp and the check above can
2480 go back in. --Stig */
2486 unreadchar(readcharfun, ch);
2488 #endif /* old backquote crap... */
2489 return read_list(readcharfun, ')', 1, 1);
2492 return read_vector(readcharfun, ']');
2496 /* #### - huh? these don't do what they seem... */
2497 return noseeum_cons(Qunbound, make_char(c));
2500 /* If a period is followed by a number, then we should read it
2501 as a floating point number. Otherwise, it denotes a dotted
2504 c = readchar(readcharfun);
2505 unreadchar(readcharfun, c);
2507 /* Can't use isdigit on Emchars */
2508 if (c < '0' || c > '9')
2509 return noseeum_cons(Qunbound, make_char('.'));
2511 /* Note that read_atom will loop
2512 at least once, assuring that we will not try to UNREAD
2513 two characters in a row.
2514 (I think this doesn't matter anymore because there should
2515 be no more danger in unreading multiple characters) */
2516 return read_atom(readcharfun, '.', 0);
2518 #else /* ! HAVE_FPFLOAT */
2519 return noseeum_cons(Qunbound, make_char('.'));
2520 #endif /* ! HAVE_FPFLOAT */
2524 c = readchar(readcharfun);
2526 #if 0 /* FSFmacs silly char-table syntax */
2529 #if 0 /* FSFmacs silly bool-vector syntax */
2532 /* "#["-- byte-code constant syntax */
2533 /* purecons #[...] syntax */
2535 return read_compiled_function(readcharfun, ']'
2538 /* "#:"-- gensym syntax */
2540 return read_atom(readcharfun, -1, 1);
2541 /* #'x => (function x) */
2543 return list2(Qfunction, read0(readcharfun));
2545 /* RMS uses this syntax for fat-strings.
2546 If we use it for vectors, then obscure bugs happen.
2548 /* "#(" -- Scheme/CL vector syntax */
2550 return read_vector(readcharfun, ')');
2553 /* When are we going to drop this crap??? -hroptatyr */
2556 struct gcpro gcpro1;
2558 /* Read the string itself. */
2559 tmp = read1(readcharfun);
2560 if (!STRINGP(tmp)) {
2562 && UNBOUNDP(XCAR(tmp)))
2563 free_cons(XCONS(tmp));
2566 (Qinvalid_read_syntax,
2567 list1(build_string("#")));
2570 /* Read the intervals and their properties. */
2572 Lisp_Object beg, end, plist;
2576 beg = read1(readcharfun);
2577 if (CONSP(beg) && UNBOUNDP(XCAR(beg))) {
2578 ch = XCHAR(XCDR(beg));
2579 free_cons(XCONS(beg));
2590 UNBOUNDP(XCAR(end)))
2612 (Qinvalid_read_syntax,
2618 Fset_text_properties(beg, end, plist, tmp);
2625 /* #@NUMBER is used to skip NUMBER following characters.
2626 That's used in .elc files to skip over doc strings
2627 and function definitions. */
2630 /* Read a decimal integer. */
2631 while ((c = readchar(readcharfun)) >= 0
2632 && c >= '0' && c <= '9')
2634 (10 * nskip) + (c - '0');
2636 unreadchar(readcharfun, c);
2638 /* FSF has code here that maybe caches the skipped
2639 string. See above for why this is totally
2640 losing. We handle this differently. */
2642 /* Skip that many characters. */
2643 for (i = 0; i < nskip && c >= 0; i++)
2644 c = readchar(readcharfun);
2649 return Vload_file_name_internal;
2652 return read_bit_vector(readcharfun);
2653 /* #o10 => 8 -- octal constant syntax */
2655 return read_integer(readcharfun, 8);
2656 /* #xdead => 57005 -- hex constant syntax */
2658 return read_integer(readcharfun, 16);
2659 /* #b010 => 2 -- binary constant syntax */
2661 return read_integer(readcharfun, 2);
2664 Emchar _c_ = reader_nextchar(readcharfun);
2665 /* check for permutation syntax */
2668 read_vector(readcharfun, ']');
2669 if (ase_permutation_f) {
2670 return ase_permutation_f(perm);
2675 unreadchar(readcharfun, _c_);
2677 "unrecognised permutation syntax");
2679 Qinvalid_read_syntax, list1(err));
2684 /* #r"raw\stringt" -- raw string syntax */
2685 return read_raw_string(readcharfun);
2688 /* #s(foobar key1 val1 key2 val2) --
2689 * structure syntax */
2690 return read_structure(readcharfun);
2692 /* Check user readers */
2693 Lisp_Object uoname = read_string(readcharfun, ' ', 0);
2694 Lisp_Object ureader = ureader_find(uoname);
2696 return ureader_read(ureader, readcharfun);
2698 unreadchar(readcharfun, c);
2699 return Fsignal(Qinvalid_read_syntax,
2701 ("No ureader for"), uoname));
2703 #ifdef FEATUREP_SYNTAX
2706 Lisp_Object feature_exp, obj, tem;
2707 struct gcpro gcpro1, gcpro2;
2709 feature_exp = read0(readcharfun);
2710 obj = read0(readcharfun);
2712 /* the call to `featurep' may GC. */
2713 GCPRO2(feature_exp, obj);
2714 tem = call1(Qfeaturep, feature_exp);
2717 if (c == '+' && NILP(tem))
2719 if (c == '-' && !NILP(tem))
2734 /* Reader forms that can reuse previously read
2739 /* Using read_integer() here is impossible, because it
2740 chokes on `='. Using parse_integer() is too hard.
2741 So we simply read it in, and ignore overflows, which
2743 while (c >= '0' && c <= '9') {
2746 c = readchar(readcharfun);
2748 found = assq_no_quit(make_int(n), Vread_objects);
2750 /* #n=object returns object, but associates it
2757 (Qinvalid_read_syntax,
2759 (build_translated_string
2760 ("Multiply defined symbol label"),
2762 obj = read0(readcharfun);
2768 } else if (c == '#') {
2769 /* #n# returns a previously read object. */
2775 (Qinvalid_read_syntax,
2777 (build_translated_string
2778 ("Undefined symbol label"),
2781 return Fsignal(Qinvalid_read_syntax,
2786 unreadchar(readcharfun, c);
2787 return Fsignal(Qinvalid_read_syntax,
2796 return list2(Qquote, read0(readcharfun));
2798 #ifdef LISP_BACKQUOTES
2801 int speccount = specpdl_depth();
2802 ++new_backquote_flag;
2803 record_unwind_protect(backquote_unwind,
2805 (&new_backquote_flag));
2806 tem = read0(readcharfun);
2807 unbind_to(speccount, Qnil);
2808 return list2(Qbackquote, tem);
2812 if (new_backquote_flag) {
2813 Lisp_Object comma_type = Qnil;
2814 int ch = readchar(readcharfun);
2817 comma_type = Qcomma_at;
2819 comma_type = Qcomma_dot;
2822 unreadchar(readcharfun, ch);
2823 comma_type = Qcomma;
2825 return list2(comma_type, read0(readcharfun));
2827 /* YUCK. 99.999% backwards compatibility. The Right
2828 Thing(tm) is to signal an error here, because it's
2829 really invalid read syntax. Instead, this permits
2830 commas to begin symbols (unless they're inside
2831 backquotes). If an error is signalled here in the
2832 future, then commas should be invalid read syntax
2833 outside of backquotes anywhere they're found (i.e.
2834 they must be quoted in symbols) -- Stig */
2835 return read_atom(readcharfun, c, 0);
2841 /* Evil GNU Emacs "character" (ie integer) syntax */
2842 c = readchar(readcharfun);
2844 return Fsignal(Qend_of_file,
2845 list1(READCHARFUN_MAYBE
2849 c = read_escape(readcharfun);
2850 return make_char(c);
2855 return read_string(readcharfun, '\"', 0);
2858 /* Ignore whitespace and control characters */
2861 return read_atom(readcharfun, c, 0);
2873 /* for complex numbers */
2874 #define INTERMEDIATE_UNARY_SYMBOL 32
2875 #define LEAD_INT2 64
2876 #define DOT_CHAR2 128
2877 #define TRAIL_INT2 256
2879 #define EXP_INT2 1024
2885 isfloat_string(const char *cp)
2888 const Bufbyte *ucp = (const Bufbyte *)cp;
2890 if (*ucp == '+' || *ucp == '-')
2893 if (*ucp >= '0' && *ucp <= '9') {
2895 while (*ucp >= '0' && *ucp <= '9')
2902 if (*ucp >= '0' && *ucp <= '9') {
2904 while (*ucp >= '0' && *ucp <= '9')
2907 if (*ucp == 'e' || *ucp == 'E') {
2910 if ((*ucp == '+') || (*ucp == '-'))
2914 if (*ucp >= '0' && *ucp <= '9') {
2916 while (*ucp >= '0' && *ucp <= '9')
2919 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t')
2921 || (*ucp == '\r') || (*ucp == '\f'))
2922 && (state == (LEAD_INT | DOT_CHAR | TRAIL_INT)
2923 || state == (DOT_CHAR | TRAIL_INT)
2924 || state == (LEAD_INT | E_CHAR | EXP_INT)
2926 (LEAD_INT | DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)
2927 || state == (DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)));
2929 #endif /* HAVE_FPFLOAT */
2930 #if defined HAVE_MPC && defined WITH_MPC || \
2931 defined HAVE_PSEUC && defined WITH_PSEUC
2933 isbigc_string (const char *cp)
2936 const Bufbyte *ucp = (const Bufbyte *)cp;
2939 /* parse the real part */
2941 if (*ucp == '+' || *ucp == '-')
2944 if (*ucp >= '0' && *ucp <= '9') {
2946 while (*ucp >= '0' && *ucp <= '9')
2953 if (*ucp >= '0' && *ucp <= '9') {
2955 while (*ucp >= '0' && *ucp <= '9')
2958 if (*ucp == 'e' || *ucp == 'E') {
2961 if ((*ucp == '+') || (*ucp == '-'))
2965 if (*ucp >= '0' && *ucp <= '9') {
2967 while (*ucp >= '0' && *ucp <= '9')
2971 /* check if we had a real number until here */
2972 if (!(state == (LEAD_INT | DOT_CHAR | TRAIL_INT) ||
2973 state == (DOT_CHAR | TRAIL_INT) ||
2974 state == (LEAD_INT | E_CHAR | EXP_INT) ||
2975 state == (LEAD_INT | DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT) ||
2976 state == (DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)))
2979 /* now parse imaginary part */
2981 if (*ucp == '+' || *ucp == '-') {
2982 state |= INTERMEDIATE_UNARY_SYMBOL;
2986 if (*ucp >= '0' && *ucp <= '9') {
2988 while (*ucp >= '0' && *ucp <= '9')
2995 if (*ucp >= '0' && *ucp <= '9') {
2996 state |= TRAIL_INT2;
2997 while (*ucp >= '0' && *ucp <= '9')
3000 if (*ucp == 'e' || *ucp == 'E') {
3003 if ((*ucp == '+') || (*ucp == '-'))
3007 if (*ucp >= '0' && *ucp <= '9') {
3009 while (*ucp >= '0' && *ucp <= '9')
3012 if (*ucp == 'i' || *ucp == 'I') {
3016 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
3017 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
3018 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | DOT_CHAR2 |
3019 TRAIL_INT2 | I_CHAR) ||
3020 state == (INTERMEDIATE_UNARY_SYMBOL | DOT_CHAR2 |
3021 TRAIL_INT2 | I_CHAR) ||
3022 state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 |
3023 E_CHAR2 | EXP_INT2 | I_CHAR) ||
3024 state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | DOT_CHAR2 |
3025 TRAIL_INT2 | E_CHAR2 | EXP_INT2 | I_CHAR) ||
3026 state == (INTERMEDIATE_UNARY_SYMBOL | DOT_CHAR2 | TRAIL_INT2 |
3027 E_CHAR2 | EXP_INT2 | I_CHAR) ||
3028 state == (INTERMEDIATE_UNARY_SYMBOL | I_CHAR)));
3030 #endif /* HAVE_MPC */
3031 #if defined WITH_PSEUG && defined HAVE_PSEUG
3033 isgaussian_string (const char *cp)
3036 const Bufbyte *ucp = (const Bufbyte *)cp;
3039 /* parse the real part */
3041 if (*ucp == '+' || *ucp == '-')
3044 if (*ucp >= '0' && *ucp <= '9') {
3046 while (*ucp >= '0' && *ucp <= '9')
3050 /* check if we had a int number until here */
3051 if (!(state == (LEAD_INT)))
3054 /* now parse imaginary part */
3056 if (*ucp == '+' || *ucp == '-') {
3057 state |= INTERMEDIATE_UNARY_SYMBOL;
3061 if (*ucp >= '0' && *ucp <= '9') {
3063 while (*ucp >= '0' && *ucp <= '9')
3066 if (*ucp == 'i' || *ucp == 'I') {
3070 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
3071 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
3072 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | I_CHAR) ||
3073 state == (INTERMEDIATE_UNARY_SYMBOL | I_CHAR)));
3075 #endif /* HAVE_PSEUG */
3076 #if defined HAVE_MPQ && defined WITH_GMP
3078 isbigq_string (const char *cp)
3080 /* Possible minus/plus sign */
3081 if (*cp == '-' || *cp == '+')
3085 if (*cp < '0' || *cp > '9')
3090 } while (*cp >= '0' && *cp <= '9');
3097 if (*cp < '0' || *cp > '9')
3102 } while (*cp >= '0' && *cp <= '9');
3104 return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' ||
3105 *cp == '\r' || *cp == '\f';
3107 #endif /* HAVE_MPQ */
3111 sequence_reader(Lisp_Object readcharfun,
3114 void*(*conser)(Lisp_Object, void*, Charcount))
3118 for (len = 0;; len++) {
3122 ch = reader_nextchar(readcharfun);
3124 if (ch == terminator)
3127 unreadchar(readcharfun, ch);
3128 #ifdef FEATUREP_SYNTAX
3130 read_syntax_error("\"]\" in a list");
3132 read_syntax_error("\")\" in a vector");
3134 state = ((conser) (readcharfun, state, len));
3138 struct read_list_state {
3142 int allow_dotted_lists;
3147 read_list_conser(Lisp_Object readcharfun, void *state, Charcount len)
3149 struct read_list_state *s = (struct read_list_state *)state;
3152 elt = read1(readcharfun);
3154 if (CONSP(elt) && UNBOUNDP(XCAR(elt))) {
3155 Lisp_Object tem = elt;
3159 free_cons(XCONS(tem));
3162 #ifdef FEATUREP_SYNTAX
3163 if (ch == s->terminator) {
3164 /* deal with #+, #- reader macros */
3165 unreadchar(readcharfun, s->terminator);
3167 } else if (ch == ']')
3168 read_syntax_error("']' in a list");
3170 read_syntax_error("')' in a vector");
3174 signal_simple_error("BUG! Internal reader error", elt);
3175 else if (!s->allow_dotted_lists)
3176 read_syntax_error("\".\" in a vector");
3179 XCDR(s->tail) = read0(readcharfun);
3181 s->head = read0(readcharfun);
3182 elt = read1(readcharfun);
3183 if (CONSP(elt) && UNBOUNDP(XCAR(elt))) {
3184 ch = XCHAR(XCDR(elt));
3185 free_cons(XCONS(elt));
3186 if (ch == s->terminator) {
3187 unreadchar(readcharfun, s->terminator);
3191 read_syntax_error(". in wrong context");
3194 #if 0 /* FSFmacs defun hack, or something ... */
3195 if (NILP(tail) && defun_hack && EQ(elt, Qdefun) && !read_pure) {
3196 record_unwind_protect(unreadpure, Qzero);
3201 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3202 if (s->length == 1 && s->allow_dotted_lists && EQ(XCAR(s->head), Qfset)) {
3203 if (CONSP(elt) && EQ(XCAR(elt), Qquote) && CONSP(XCDR(elt)))
3204 Vcurrent_compiled_function_annotation = XCAR(XCDR(elt));
3206 Vcurrent_compiled_function_annotation = elt;
3210 elt = Fcons(elt, Qnil);
3212 XCDR(s->tail) = elt;
3221 #if 0 /* FSFmacs defun hack */
3222 /* -1 for allow_dotted_lists means allow_dotted_lists and check
3223 for starting with defun and make structure pure. */
3227 read_list(Lisp_Object readcharfun,
3229 int allow_dotted_lists, int check_for_doc_references)
3231 struct read_list_state s;
3232 struct gcpro gcpro1, gcpro2;
3233 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3234 Lisp_Object old_compiled_function_annotation =
3235 Vcurrent_compiled_function_annotation;
3241 s.allow_dotted_lists = allow_dotted_lists;
3242 s.terminator = terminator;
3243 GCPRO2(s.head, s.tail);
3245 sequence_reader(readcharfun, terminator, &s, read_list_conser);
3246 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3247 Vcurrent_compiled_function_annotation =
3248 old_compiled_function_annotation;
3251 if ((purify_flag || load_force_doc_strings) && check_for_doc_references) {
3252 /* check now for any doc string references and record them
3256 /* We might be dealing with an imperfect list so don't
3258 for (tail = s.head; CONSP(tail); tail = XCDR(tail)) {
3259 Lisp_Object holding_cons = Qnil;
3262 Lisp_Object elem = XCAR(tail);
3263 /* elem might be (#$ . INT) ... */
3265 && EQ(XCAR(elem), Vload_file_name_internal))
3266 holding_cons = tail;
3267 /* or it might be (quote (#$ . INT)) i.e.
3268 (quote . ((#$ . INT) . nil)) in the case of
3269 `autoload' (autoload evaluates its arguments, while
3270 `defvar', `defun', etc. don't). */
3271 if (CONSP(elem) && EQ(XCAR(elem), Qquote)
3272 && CONSP(XCDR(elem))) {
3273 elem = XCAR(XCDR(elem));
3276 Vload_file_name_internal))
3277 holding_cons = XCDR(XCAR(tail));
3281 if (CONSP(holding_cons)) {
3283 if (NILP(Vinternal_doc_file_name))
3284 /* We have not yet called
3285 Snarf-documentation, so
3286 assume this file is described
3288 Snarf-documentation will fill
3289 in the right value later.
3290 For now, replace the whole
3292 XCAR(holding_cons) = Qzero;
3294 /* We have already called
3295 Snarf-documentation, so make
3296 a relative file name for this
3297 file, so it can be found
3298 properly in the installed
3299 Lisp directory. We don't use
3300 Fexpand_file_name because
3301 that would make the directory
3303 XCAR(XCAR(holding_cons)) =
3304 concat2(build_string
3306 Ffile_name_nondirectory
3307 (Vload_file_name_internal));
3309 /* Not pure. Just add to
3310 Vload_force_doc_string_list, and the
3311 string will be filled in properly in
3312 load_force_doc_string_unwind(). */
3313 Vload_force_doc_string_list =
3314 /* We pass the cons that holds the
3315 (#$ . INT) so we can modify it
3318 Vload_force_doc_string_list);
3328 read_vector(Lisp_Object readcharfun, Emchar terminator)
3334 struct read_list_state s;
3335 struct gcpro gcpro1, gcpro2;
3340 s.allow_dotted_lists = 0;
3341 GCPRO2(s.head, s.tail);
3343 sequence_reader(readcharfun, terminator, &s, read_list_conser);
3347 len = XINT(Flength(tem));
3349 #if 0 /* FSFmacs defun hack */
3351 s.head = make_pure_vector(len, Qnil);
3354 s.head = make_vector(len, Qnil);
3356 for (i = 0, p = &(XVECTOR_DATA(s.head)[0]); i < len; i++, p++) {
3357 Lisp_Cons *otem = XCONS(tem);
3367 read_compiled_function(Lisp_Object readcharfun, Emchar terminator)
3369 /* Accept compiled functions at read-time so that we don't
3370 have to build them at load-time. */
3372 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3373 struct gcpro gcpro1;
3376 int saw_a_doc_ref = 0;
3378 /* Note: we tell read_list not to search for doc references
3379 because we need to handle the "doc reference" for the
3380 instructions and constants differently. */
3381 stuff = read_list(readcharfun, terminator, 0, 0);
3382 len = XINT(Flength(stuff));
3383 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3385 continuable_read_syntax_error
3386 ("#[...] used with wrong number of elements");
3388 for (iii = 0; CONSP(stuff); iii++) {
3389 Lisp_Cons *victim = XCONS(stuff);
3390 make_byte_code_args[iii] = Fcar(stuff);
3391 if ((purify_flag || load_force_doc_strings)
3392 && CONSP(make_byte_code_args[iii])
3393 && EQ(XCAR(make_byte_code_args[iii]),
3394 Vload_file_name_internal)) {
3395 if (purify_flag && iii == COMPILED_DOC_STRING) {
3396 /* same as in read_list(). */
3397 if (NILP(Vinternal_doc_file_name))
3398 make_byte_code_args[iii] = Qzero;
3400 XCAR(make_byte_code_args[iii]) =
3401 concat2(build_string("../lisp/"),
3402 Ffile_name_nondirectory
3403 (Vload_file_name_internal));
3407 stuff = Fcdr(stuff);
3410 GCPROn(make_byte_code_args, len);
3412 /* v18 or v19 bytecode file. Need to Ebolify. */
3413 if (load_byte_code_version < 20 && VECTORP(make_byte_code_args[2]))
3414 ebolify_bytecode_constants(make_byte_code_args[2]);
3416 /* make-byte-code looks at purify_flag, which should have the same
3417 * value as our "read-pure" argument */
3418 stuff = Fmake_byte_code(len, make_byte_code_args);
3419 XCOMPILED_FUNCTION(stuff)->flags.ebolified =
3420 (load_byte_code_version < 20);
3422 Vload_force_doc_string_list =
3423 Fcons(stuff, Vload_force_doc_string_list);
3428 void init_lread(void)
3430 char *stroot = NULL, *btroot = NULL;
3433 load_in_progress = 0;
3435 Vload_descriptor_list = Qnil;
3437 /* kludge: locate-file does not work for a null load-path, even if
3438 the file name is absolute. */
3440 Vload_path = Fcons(build_string(""), Qnil);
3441 /* The following is intended for the build chain only */
3442 if ((stroot = getenv("SOURCE_TREE_ROOT")) && strlen(stroot)) {
3443 Lisp_Object lispsubdir = build_string("lisp");
3444 Lisp_Object strootdir = build_string(stroot);
3445 Lisp_Object stlispdir =
3446 Fexpand_file_name(lispsubdir, strootdir);
3447 Vload_path = Fcons(stlispdir, Vload_path);
3449 if ((btroot = getenv("BUILD_TREE_ROOT")) && strlen(btroot)) {
3450 Lisp_Object lispsubdir = build_string("lisp");
3451 Lisp_Object btrootdir = build_string(btroot);
3452 Lisp_Object btlispdir =
3453 Fexpand_file_name(lispsubdir, btrootdir);
3454 Vload_path = Fcons(btlispdir, Vload_path);
3457 /* This used to get initialized in init_lread because all streams
3458 got closed when dumping occurs. This is no longer true --
3459 Vread_buffer_stream is a resizing output stream, and there is no
3460 reason to close it at dump-time.
3462 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3463 will initialize it only once, at dump-time. */
3464 if (NILP(Vread_buffer_stream))
3465 Vread_buffer_stream = make_resizing_buffer_output_stream();
3467 Vload_force_doc_string_list = Qnil;
3470 void syms_of_lread(void)
3473 DEFSUBR(Fread_from_string);
3474 DEFSUBR(Fload_internal);
3475 DEFSUBR(Flocate_file);
3476 DEFSUBR(Flocate_file_clear_hashing);
3477 DEFSUBR(Feval_buffer);
3478 DEFSUBR(Feval_region);
3480 defsymbol(&Qstandard_input, "standard-input");
3481 defsymbol(&Qread_char, "read-char");
3482 defsymbol(&Qcurrent_load_list, "current-load-list");
3483 defsymbol(&Qload, "load");
3484 defsymbol(&Qload_file_name, "load-file-name");
3485 defsymbol(&Qfset, "fset");
3487 #ifdef LISP_BACKQUOTES
3488 defsymbol(&Qbackquote, "backquote");
3489 defsymbol(&Qbacktick, "`");
3490 defsymbol(&Qcomma, ",");
3491 defsymbol(&Qcomma_at, ",@");
3492 defsymbol(&Qcomma_dot, ",.");
3495 defsymbol(&Qexists, "exists");
3496 defsymbol(&Qreadable, "readable");
3497 defsymbol(&Qwritable, "writable");
3498 defsymbol(&Qexecutable, "executable");
3501 void structure_type_create(void)
3503 the_structure_type_dynarr = Dynarr_new(structure_type);
3506 void reinit_vars_of_lread(void)
3508 Vread_buffer_stream = Qnil;
3509 staticpro_nodump(&Vread_buffer_stream);
3512 void vars_of_lread(void)
3514 reinit_vars_of_lread();
3516 DEFVAR_LISP("values", &Vvalues /*
3517 List of values of all expressions which were read, evaluated and printed.
3518 Order is reverse chronological.
3521 DEFVAR_LISP("standard-input", &Vstandard_input /*
3522 Stream for read to get input from.
3523 See documentation of `read' for possible values.
3525 Vstandard_input = Qt;
3527 DEFVAR_LISP("load-path", &Vload_path /*
3528 *List of directories to search for files to load.
3529 Each element is a string (directory name) or nil (try default directory).
3531 Note that the elements of this list *may not* begin with "~", so you must
3532 call `expand-file-name' on them before adding them to this list.
3534 Initialized based on EMACSLOADPATH environment variable, if any,
3535 otherwise to default specified in by file `paths.h' when SXEmacs was built.
3536 If there were no paths specified in `paths.h', then SXEmacs chooses a default
3537 value for this variable by looking around in the file-system near the
3538 directory in which the SXEmacs executable resides.
3542 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3543 "*Location of lisp files to be used when dumping ONLY."); */
3545 DEFVAR_BOOL("load-in-progress", &load_in_progress /*
3546 Non-nil iff inside of `load'.
3548 DEFVAR_LISP ("load-suppress-alist", &Vload_suppress_alist /*
3549 An alist of expressions controlling whether particular files can be loaded.
3550 Each element looks like (FILENAME EXPR).
3551 FILENAME should be a full pathname, but without the .el suffix.
3552 When `load' is run and is about to load the specified file, it evaluates
3553 the form to determine if the file can be loaded.
3554 This variable is normally initialized automatically.
3556 Vload_suppress_alist = Qnil;
3558 DEFVAR_LISP("after-load-alist", &Vafter_load_alist /*
3559 An alist of expressions to be evalled when particular files are loaded.
3560 Each element looks like (FILENAME FORMS...).
3561 When `load' is run and the file-name argument is FILENAME,
3562 the FORMS in the corresponding element are executed at the end of loading.
3564 FILENAME must match exactly! Normally FILENAME is the name of a library,
3565 with no directory specified, since that is how `load' is normally called.
3566 An error in FORMS does not undo the load,
3567 but does prevent execution of the rest of the FORMS.
3569 Vafter_load_alist = Qnil;
3571 DEFVAR_BOOL("load-warn-when-source-newer", &load_warn_when_source_newer /*
3572 *Whether `load' should check whether the source is newer than the binary.
3573 If this variable is true, then when a `.elc' file is being loaded and the
3574 corresponding `.el' is newer, a warning message will be printed.
3576 load_warn_when_source_newer = 0;
3578 DEFVAR_BOOL("load-warn-when-source-only", &load_warn_when_source_only /*
3579 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3580 If this variable is true, then when `load' is called with a filename without
3581 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3582 then a message will be printed. If an explicit extension is passed to `load',
3583 no warning will be printed.
3585 load_warn_when_source_only = 0;
3587 DEFVAR_BOOL("load-ignore-elc-files", &load_ignore_elc_files /*
3588 *Whether `load' should ignore `.elc' files when a suffix is not given.
3589 This is normally used only to bootstrap the `.elc' files when building SXEmacs.
3591 load_ignore_elc_files = 0;
3594 DEFVAR_LISP("load-history", &Vload_history /*
3595 Alist mapping source file names to symbols and features.
3596 Each alist element is a list that starts with a file name,
3597 except for one element (optional) that starts with nil and describes
3598 definitions evaluated from buffers not visiting files.
3599 The remaining elements of each list are symbols defined as functions
3600 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3602 Vload_history = Qnil;
3604 DEFVAR_LISP("current-load-list", &Vcurrent_load_list /*
3605 Used for internal purposes by `load'.
3607 Vcurrent_load_list = Qnil;
3610 DEFVAR_LISP("load-file-name", &Vload_file_name /*
3611 Full name of file being loaded by `load'.
3613 Vload_file_name = Qnil;
3615 DEFVAR_LISP("load-read-function", &Vload_read_function /*
3616 Function used by `load' and `eval-region' for reading expressions.
3617 The default is nil, which means use the function `read'.
3619 Vload_read_function = Qnil;
3621 DEFVAR_BOOL("load-force-doc-strings", &load_force_doc_strings /*
3622 Non-nil means `load' should force-load all dynamic doc strings.
3623 This is useful when the file being loaded is a temporary copy.
3625 load_force_doc_strings = 0;
3627 /* See read_escape(). */
3629 /* Used to be named `puke-on-fsf-keys' */
3630 DEFVAR_BOOL("fail-on-bucky-bit-character-escapes", &fail_on_bucky_bit_character_escapes /*
3631 Whether `read' should signal an error when it encounters unsupported
3632 character escape syntaxes or just read them incorrectly.
3634 fail_on_bucky_bit_character_escapes = 0;
3637 /* This must be initialized in init_lread otherwise it may start out
3638 with values saved when the image is dumped. */
3639 staticpro(&Vload_descriptor_list);
3641 /* Initialized in init_lread. */
3642 staticpro(&Vload_force_doc_string_list);
3644 Vload_file_name_internal = Qnil;
3645 staticpro(&Vload_file_name_internal);
3647 Vload_file_name_internal_the_purecopy = Qnil;
3648 staticpro(&Vload_file_name_internal_the_purecopy);
3650 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3651 Vcurrent_compiled_function_annotation = Qnil;
3652 staticpro(&Vcurrent_compiled_function_annotation);
3655 /* So that early-early stuff will work */
3656 Ffset(Qload, intern("load-internal"));
3658 #ifdef FEATUREP_SYNTAX
3659 defsymbol(&Qfeaturep, "featurep");
3660 Fprovide(intern("xemacs"));
3661 Fprovide(intern("sxemacs"));
3662 Fprovide(intern("raw-strings"));
3664 Fprovide(intern("infodock"));
3665 #endif /* INFODOCK */
3666 #endif /* FEATUREP_SYNTAX */
3668 #ifdef LISP_BACKQUOTES
3669 old_backquote_flag = new_backquote_flag = 0;
3673 Vfile_domain = Qnil;
3676 Vread_objects = Qnil;
3677 staticpro(&Vread_objects);
3679 Vlocate_file_hash_table = make_lisp_hash_table(200,
3680 HASH_TABLE_NON_WEAK,
3682 staticpro(&Vlocate_file_hash_table);
3683 #ifdef DEBUG_SXEMACS
3685 Lisp_Object tmp = intern("Vlocate-file-hash-table");
3686 symbol_value(XSYMBOL(tmp)) = Vlocate_file_hash_table;
3690 /* User defined readers */
3691 DEFVAR_LISP("ureaders", &Vureaders /*
3692 Alist of user defined readers.
3693 Car is ureader NAME, represented by string to match against when reading
3695 Cdr is user function called with one arg - string.
3696 Function must return lisp object or signal error.
3701 /* lread.c ends here */