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 foundlen = XSTRING_LENGTH(found);
644 foundstr = (char *)alloca( foundlen+ 1);
645 strncpy(foundstr, (char *)XSTRING_DATA(found), foundlen+1);
648 /* The omniscient JWZ thinks this is worthless, but I beg to
650 if (load_ignore_elc_files) {
651 newer = Ffile_name_nondirectory(found);
652 } else if (load_warn_when_source_newer &&
653 !memcmp(".elc", foundstr + foundlen - 4, 4)) {
654 if (!fstat(fd, &s1)) { /* can't fail, right? */
656 /* temporarily hack the 'c' off the end of the
658 foundstr[foundlen - 1] = '\0';
659 result = sxemacs_stat(foundstr, &s2);
661 (unsigned)s1.st_mtime <
662 (unsigned)s2.st_mtime) {
663 Lisp_Object newer_name =
664 make_string((Bufbyte*)foundstr,
666 struct gcpro nngcpro1;
667 NNGCPRO1(newer_name);
668 newer = Ffile_name_nondirectory(
672 /* put the 'c' back on (kludge-o-rama) */
673 foundstr[foundlen - 1] = 'c';
675 } else if (load_warn_when_source_only &&
676 /* `found' ends in ".el" */
677 !memcmp(".el", foundstr + foundlen - 3, 3) &&
678 /* `file' does not end in ".el" */
680 XSTRING_DATA(file) + XSTRING_LENGTH(file) - 3,
685 if (!memcmp(".elc", foundstr + foundlen - 4, 4))
688 #define PRINT_LOADING_MESSAGE(done) \
690 if (load_ignore_elc_files) { \
692 message("Loading %s..." done, \
693 XSTRING_DATA(newer)); \
695 } else if (!NILP(newer)) { \
696 message("Loading %s..." done " (file %s is newer)", \
697 XSTRING_DATA(file), \
698 XSTRING_DATA(newer)); \
699 } else if (source_only) { \
700 Lisp_Object tmp = Ffile_name_nondirectory(file); \
701 message("Loading %s..." done \
702 " (file %s.elc does not exist)", \
703 XSTRING_DATA(file), \
704 XSTRING_DATA(tmp)); \
705 } else if (message_p) { \
706 message("Loading %s..." done, \
707 XSTRING_DATA(file)); \
711 PRINT_LOADING_MESSAGE("");
714 /* Lisp_Object's must be malloc'ed, not stack-allocated */
715 Lisp_Object lstrm = Qnil;
716 const int block_size = 8192;
717 struct gcpro ngcpro1;
721 signal_file_error("Cannot open load file", file);
723 lstrm = make_filedesc_input_stream(fd, 0, -1, LSTR_CLOSING);
724 /* 64K is used for normal files; 8K should be OK here because
725 * Lisp files aren't really all that big. */
726 Lstream_set_buffering(XLSTREAM(lstrm),
727 LSTREAM_BLOCKN_BUFFERED, block_size);
729 lstrm = make_decoding_input_stream(
730 XLSTREAM(lstrm), Fget_coding_system(codesys));
731 Lstream_set_buffering(XLSTREAM(lstrm),
732 LSTREAM_BLOCKN_BUFFERED, block_size);
734 /* NOTE: Order of these is very important.
735 * Don't rearrange them. */
736 record_unwind_protect(load_unwind, lstrm);
737 record_unwind_protect(load_descriptor_unwind,
738 Vload_descriptor_list);
739 record_unwind_protect(load_file_name_internal_unwind,
740 Vload_file_name_internal);
741 record_unwind_protect(
742 load_file_name_internal_the_purecopy_unwind,
743 Vload_file_name_internal_the_purecopy);
744 record_unwind_protect(load_force_doc_string_unwind,
745 Vload_force_doc_string_list);
746 Vload_file_name_internal = found;
747 Vload_file_name_internal_the_purecopy = Qnil;
748 specbind(Qload_file_name, found);
749 Vload_descriptor_list =
750 Fcons(make_int(fd), Vload_descriptor_list);
751 Vload_force_doc_string_list = Qnil;
753 record_unwind_protect(restore_file_domain, Vfile_domain);
754 /* set it to nil; a call to #'domain will set it. */
759 /* Now determine what sort of ELC file we're reading in. */
760 record_unwind_protect(load_byte_code_version_unwind,
761 make_int(load_byte_code_version));
766 num_read = Lstream_read(XLSTREAM(lstrm), elc_header, 8);
767 if (num_read < 8 || strncmp(elc_header, ";ELC", 4)) {
768 /* Huh? Probably not a valid ELC file. */
769 /* no Ebolification needed */
770 load_byte_code_version = 100;
771 Lstream_unread(XLSTREAM(lstrm), elc_header,
774 load_byte_code_version = elc_header[4];
777 /* no Ebolification needed */
778 load_byte_code_version = 100;
781 readevalloop(lstrm, file, Feval, 0);
783 if (!NILP(used_codesys)) {
785 decoding_stream_coding_system(XLSTREAM(lstrm));
786 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
789 unbind_to(speccount, Qnil);
796 /* #### Disgusting kludge */
797 /* Run any load-hooks for this file. */
798 /* #### An even more disgusting kludge. There is horrible code */
799 /* that is relying on the fact that dumped lisp files are found */
800 /* via `load-path' search. */
801 Lisp_Object name = file;
803 if (!NILP(Ffile_name_absolute_p(file))) {
804 name = Ffile_name_nondirectory(file);
808 struct gcpro ngcpro1;
811 tem = Fassoc(name, Vafter_load_alist);
815 struct gcpro ngcpro1;
818 /* Use eval so that errors give a semi-meaningful
819 * backtrace. --Stig */
820 tem = Fcons(Qprogn, Fcdr(tem));
826 /*#ifdef DEBUG_SXEMACS*/
827 if (purify_flag && noninteractive) {
828 if (!EQ(last_file_loaded, file)) {
829 message("Loading %s ...done", XSTRING_DATA(file));
832 /*#endif / * DEBUG_SXEMACS */
834 if (!noninteractive) {
835 PRINT_LOADING_MESSAGE("done");
841 /* ------------------------------- */
843 /* ------------------------------- */
845 static int decode_mode_1(Lisp_Object mode)
847 if (EQ(mode, Qexists))
849 else if (EQ(mode, Qexecutable))
851 else if (EQ(mode, Qwritable))
853 else if (EQ(mode, Qreadable))
855 else if (INTP(mode)) {
856 check_int_range(XINT(mode), 0, 7);
859 signal_simple_error("Invalid value", mode);
860 return 0; /* unreached */
863 static int decode_mode(Lisp_Object mode)
867 else if (CONSP(mode)) {
870 EXTERNAL_LIST_LOOP(tail, mode)
871 mask |= decode_mode_1(XCAR(tail));
874 return decode_mode_1(mode);
877 DEFUN("locate-file", Flocate_file, 2, 4, 0, /*
878 Search for FILENAME through PATH-LIST.
879 If SUFFIXES is non-nil, it should be a list of suffixes to append to
880 file name when searching.
882 If MODE is non-nil, it should be a symbol or a list of symbol representing
883 requirements. Allowed symbols are `exists', `executable', `writable', and
884 `readable'. If MODE is nil, it defaults to `readable'.
886 Filenames are checked against `load-suppress-alist' to determine if they
889 `locate-file' keeps hash tables of the directories it searches through,
890 in order to speed things up. It tries valiantly to not get confused in
891 the face of a changing and unpredictable environment, but can occasionally
892 get tripped up. In this case, you will have to call
893 `locate-file-clear-hashing' to get it back on track. See that function
896 (filename, path_list, suffixes, mode))
898 /* This function can GC */
901 CHECK_STRING(filename);
903 if (LISTP(suffixes)) {
905 EXTERNAL_LIST_LOOP(tail, suffixes)
906 CHECK_STRING(XCAR(tail));
908 CHECK_STRING(suffixes);
910 locate_file(path_list, filename, suffixes, &tp, decode_mode(mode));
914 /* Recalculate the hash table for the given string. DIRECTORY should
915 better have been through Fexpand_file_name() by now. */
917 static Lisp_Object locate_file_refresh_hashing(Lisp_Object directory)
920 make_directory_hash_table((char *)XSTRING_DATA(directory));
923 Fputhash(directory, hash, Vlocate_file_hash_table);
927 /* find the hash table for the given directory, recalculating if necessary */
929 static Lisp_Object locate_file_find_directory_hash_table(Lisp_Object directory)
931 Lisp_Object hash = Fgethash(directory, Vlocate_file_hash_table, Qnil);
933 return locate_file_refresh_hashing(directory);
938 /* The SUFFIXES argument in any of the locate_file* functions can be
939 nil, a list, or a string (for backward compatibility), with the
942 a) nil - no suffix, just search for file name intact
943 (semantically different from "empty suffix list", which
944 would be meaningless.)
945 b) list - list of suffixes to append to file name. Each of these
947 c) string - colon-separated suffixes to append to file name (backward
950 All of this got hairy, so I decided to use a mapper. Calling a
951 function for each suffix shouldn't slow things down, since
952 locate_file is rarely called with enough suffixes for funcalls to
953 make any difference. */
955 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
956 char * containing the current file name, and ARG. Mapping stops when
957 FUN returns non-zero. */
959 locate_file_map_suffixes(Lisp_Object filename, Lisp_Object suffixes,
960 int (*fun) (char *, void *), void *arg)
962 /* This function can GC */
966 /* Calculate maximum size of any filename made from
967 this path element/specified file name and any possible suffix. */
968 if (CONSP(suffixes)) {
969 /* We must traverse the list, so why not do it right. */
972 LIST_LOOP(tail, suffixes) {
973 if (XSTRING_LENGTH(XCAR(tail)) > max)
974 max = XSTRING_LENGTH(XCAR(tail));
976 } else if (NILP(suffixes))
979 /* Just take the easy way out */
980 max = XSTRING_LENGTH(suffixes);
982 fn_len = XSTRING_LENGTH(filename);
983 fn = (char *)alloca(max + fn_len + 1);
984 memcpy(fn, (char *)XSTRING_DATA(filename), fn_len);
986 /* Loop over suffixes. */
987 if (!STRINGP(suffixes)) {
988 if (NILP(suffixes)) {
989 /* Case a) discussed in the comment above. */
991 if ((*fun) (fn, arg))
996 LIST_LOOP(tail, suffixes) {
997 memcpy(fn + fn_len, XSTRING_DATA(XCAR(tail)),
998 XSTRING_LENGTH(XCAR(tail)));
999 fn[fn_len + XSTRING_LENGTH(XCAR(tail))] = 0;
1000 if ((*fun) (fn, arg))
1006 const char *nsuffix = (const char *)XSTRING_DATA(suffixes);
1009 char *esuffix = (char *)strchr(nsuffix, ':');
1011 esuffix ? esuffix - nsuffix : (int)strlen(nsuffix);
1013 /* Concatenate path element/specified name with the suffix. */
1014 strncpy(fn + fn_len, nsuffix, lsuffix);
1015 fn[fn_len + lsuffix] = '\0';
1017 if ((*fun) (fn, arg))
1020 /* Advance to next suffix. */
1023 nsuffix += lsuffix + 1;
1028 struct locate_file_in_directory_mapper_closure {
1030 Lisp_Object *storeptr;
1034 static int locate_file_in_directory_mapper(char *fn, void *arg)
1036 struct locate_file_in_directory_mapper_closure *closure =
1037 (struct locate_file_in_directory_mapper_closure *)arg;
1040 /* Ignore file if it's a directory. */
1041 if (sxemacs_stat(fn, &st) >= 0 && (st.st_mode & S_IFMT) != S_IFDIR) {
1042 /* Check that we can access or open it. */
1043 if (closure->mode >= 0)
1044 closure->fd = access(fn, closure->mode);
1046 closure->fd = open(fn, O_RDONLY | OPEN_BINARY, 0);
1048 if (closure->fd >= 0) {
1049 if (!suppressedp(fn, Qnil)) {
1050 /* We succeeded; return this descriptor and
1052 if (closure->storeptr)
1053 *closure->storeptr = build_string(fn);
1055 /* If we actually opened the file, set
1056 close-on-exec flag on the new descriptor so
1057 that subprocesses can't whack at it. */
1058 if (closure->mode < 0)
1059 (void)fcntl(closure->fd,
1060 F_SETFD, FD_CLOEXEC);
1070 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
1071 not have been expanded. */
1074 locate_file_in_directory(Lisp_Object directory, Lisp_Object str,
1075 Lisp_Object suffixes, Lisp_Object * storeptr, int mode)
1077 /* This function can GC */
1078 struct locate_file_in_directory_mapper_closure closure;
1079 Lisp_Object filename = Qnil;
1080 struct gcpro gcpro1, gcpro2, gcpro3;
1082 GCPRO3(directory, str, filename);
1084 filename = Fexpand_file_name(str, directory);
1085 if (NILP(filename) || NILP(Ffile_name_absolute_p(filename)))
1086 /* If there are non-absolute elts in PATH (eg ".") */
1087 /* Of course, this could conceivably lose if luser sets
1088 default-directory to be something non-absolute ... */
1091 /* NIL means current directory */
1092 filename = current_buffer->directory;
1094 filename = Fexpand_file_name(filename,
1095 current_buffer->directory);
1096 if (NILP(Ffile_name_absolute_p(filename))) {
1097 /* Give up on this directory! */
1104 closure.storeptr = storeptr;
1105 closure.mode = mode;
1107 locate_file_map_suffixes(filename, suffixes,
1108 locate_file_in_directory_mapper, &closure);
1114 /* do the same as locate_file() but don't use any hash tables. */
1117 locate_file_without_hash(Lisp_Object path, Lisp_Object str,
1118 Lisp_Object suffixes, Lisp_Object * storeptr, int mode)
1120 /* This function can GC */
1121 int absolute = !NILP(Ffile_name_absolute_p(str));
1123 EXTERNAL_LIST_LOOP(path, path) {
1125 locate_file_in_directory(XCAR(path), str, suffixes,
1136 static int locate_file_construct_suffixed_files_mapper(char *fn, void *arg)
1138 Lisp_Object *tail = (Lisp_Object *) arg;
1139 *tail = Fcons(build_string(fn), *tail);
1143 /* Construct a list of all files to search for.
1144 It makes sense to have this despite locate_file_map_suffixes()
1145 because we need Lisp strings to access the hash-table, and it would
1146 be inefficient to create them on the fly, again and again for each
1147 path component. See locate_file(). */
1150 locate_file_construct_suffixed_files(Lisp_Object filename, Lisp_Object suffixes)
1152 Lisp_Object tail = Qnil;
1153 struct gcpro gcpro1;
1156 locate_file_map_suffixes(filename, suffixes,
1157 locate_file_construct_suffixed_files_mapper,
1161 return Fnreverse(tail);
1164 DEFUN("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1165 Clear the hash records for the specified list of directories.
1166 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1167 track the following environmental changes:
1169 -- changes of any sort to the list of directories to be searched.
1170 -- addition and deletion of non-shadowing files (see below) from the
1171 directories in the list.
1172 -- byte-compilation of a .el file into a .elc file.
1174 `locate-file' will primarily get confused if you add a file that shadows
1175 \(i.e. has the same name as) another file further down in the directory list.
1176 In this case, you must call `locate-file-clear-hashing'.
1178 If PATH is t, it means to fully clear all the accumulated hashes. This
1179 can be used if the internal tables grow too large, or when dumping.
1184 Fclrhash(Vlocate_file_hash_table);
1186 Lisp_Object pathtail;
1187 EXTERNAL_LIST_LOOP(pathtail, path) {
1188 Lisp_Object pathel =
1189 Fexpand_file_name(XCAR(pathtail), Qnil);
1190 Fremhash(pathel, Vlocate_file_hash_table);
1196 /* Search for a file whose name is STR, looking in directories
1197 in the Lisp list PATH, and trying suffixes from SUFFIXES.
1198 SUFFIXES is a list of possible suffixes, or (for backward
1199 compatibility) a string containing possible suffixes separated by
1201 On success, returns a file descriptor. On failure, returns -1.
1203 MODE nonnegative means don't open the files,
1204 just look for one for which access(file,MODE) succeeds. In this case,
1205 returns a nonnegative value on success. On failure, returns -1.
1207 If STOREPTR is nonzero, it points to a slot where the name of
1208 the file actually found should be stored as a Lisp string.
1209 Nil is stored there on failure.
1211 Called openp() in FSFmacs. */
1214 locate_file(Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1215 Lisp_Object * storeptr, int mode)
1217 /* This function can GC */
1218 Lisp_Object suffixtab = Qnil;
1219 Lisp_Object pathtail, pathel_expanded;
1221 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1226 /* Is it really necessary to gcpro path and str? It shouldn't be
1227 unless some caller has fucked up. There are known instances that
1228 call us with build_string("foo:bar") as SUFFIXES, though. */
1229 GCPRO4(path, str, suffixes, suffixtab);
1231 /* if this filename has directory components, it's too complicated
1232 to try and use the hash tables. */
1233 if (!NILP(Ffile_name_directory(str))) {
1235 locate_file_without_hash(path, str, suffixes, storeptr,
1241 suffixtab = locate_file_construct_suffixed_files(str, suffixes);
1243 EXTERNAL_LIST_LOOP(pathtail, path) {
1244 Lisp_Object pathel = XCAR(pathtail);
1245 Lisp_Object hash_table;
1249 /* If this path element is relative, we have to look by hand. */
1250 if (NILP(pathel) || NILP(Ffile_name_absolute_p(pathel))) {
1252 locate_file_in_directory(pathel, str, suffixes,
1261 pathel_expanded = Fexpand_file_name(pathel, Qnil);
1263 locate_file_find_directory_hash_table(pathel_expanded);
1265 if (!NILP(hash_table)) {
1266 /* Loop over suffixes. */
1267 LIST_LOOP(tail, suffixtab)
1268 if (!NILP(Fgethash(XCAR(tail), hash_table, Qnil))) {
1275 /* This is a likely candidate. Look by hand in this directory
1276 so we don't get thrown off if someone byte-compiles a file. */
1278 locate_file_in_directory(pathel, str, suffixes,
1285 /* Hmm ... the file isn't actually there. (Or possibly it's
1286 a directory ...) So refresh our hashing. */
1287 locate_file_refresh_hashing(pathel_expanded);
1291 /* File is probably not there, but check the hard way just in case. */
1292 val = locate_file_without_hash(path, str, suffixes, storeptr, mode);
1294 /* Sneaky user added a file without telling us. */
1295 Flocate_file_clear_hashing(path);
1304 /* Merge the list we've accumulated of globals from the current input source
1305 into the load_history variable. The details depend on whether
1306 the source has an associated file name or not. */
1308 static void build_load_history(int loading, Lisp_Object source)
1310 REGISTER Lisp_Object tail, prev, newelt;
1311 REGISTER Lisp_Object tem, tem2;
1314 #if !defined(LOADHIST_DUMPED)
1315 /* Don't bother recording anything for preloaded files. */
1320 tail = Vload_history;
1323 while (!NILP(tail)) {
1326 /* Find the feature's previous assoc list... */
1327 if (internal_equal(source, Fcar(tem), 0)) {
1330 /* If we're loading, remove it. */
1333 Vload_history = Fcdr(tail);
1335 Fsetcdr(prev, Fcdr(tail));
1338 /* Otherwise, cons on new symbols that are not already members. */
1340 tem2 = Vcurrent_load_list;
1342 while (CONSP(tem2)) {
1343 newelt = XCAR(tem2);
1345 if (NILP(Fmemq(newelt, tem)))
1346 Fsetcar(tail, Fcons(Fcar(tem),
1362 /* If we're loading, cons the new assoc onto the front of load-history,
1363 the most-recently-loaded position. Also do this if we didn't find
1364 an existing member for the current source. */
1365 if (loading || !foundit)
1366 Vload_history = Fcons(Fnreverse(Vcurrent_load_list),
1370 #else /* !LOADHIST */
1371 #define build_load_history(x,y)
1372 #endif /* !LOADHIST */
1374 #if 0 /* FSFmacs defun hack */
1375 Lisp_Object unreadpure(void)
1376 { /* Used as unwind-protect function in readevalloop */
1383 readevalloop(Lisp_Object readcharfun,
1384 Lisp_Object sourcename,
1385 Lisp_Object(*evalfun) (Lisp_Object), int printflag)
1387 /* This function can GC */
1389 REGISTER Lisp_Object val = Qnil;
1390 int speccount = specpdl_depth();
1391 struct gcpro gcpro1, gcpro2;
1392 struct buffer *b = 0;
1394 if (BUFFERP(readcharfun))
1395 b = XBUFFER(readcharfun);
1396 else if (MARKERP(readcharfun))
1397 b = XMARKER(readcharfun)->buffer;
1399 /* Don't do this. It is not necessary, and it needlessly exposes
1400 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1401 /*specbind (Qstandard_input, readcharfun); */
1403 specbind(Qcurrent_load_list, Qnil);
1405 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1406 Vcurrent_compiled_function_annotation = Qnil;
1408 GCPRO2(val, sourcename);
1410 LOADHIST_ATTACH(sourcename);
1415 if (b != 0 && !BUFFER_LIVE_P(b))
1416 error("Reading from killed buffer");
1418 c = readchar(readcharfun);
1421 while ((c = readchar(readcharfun)) != '\n' && c != -1)
1428 /* Ignore whitespace here, so we can detect eof. */
1429 if (c == ' ' || c == '\t' || c == '\n' || c == '\f'
1433 #if 0 /* FSFmacs defun hack */
1434 if (purify_flag && c == '(') {
1435 int count1 = specpdl_depth();
1436 record_unwind_protect(unreadpure, Qnil);
1437 val = read_list(readcharfun, ')', -1, 1);
1438 unbind_to(count1, Qnil);
1440 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1442 unreadchar(readcharfun, c);
1443 Vread_objects = Qnil;
1444 if (NILP(Vload_read_function))
1445 val = read0(readcharfun);
1447 val = call1(Vload_read_function, readcharfun);
1450 val = (*evalfun) (val);
1452 Vvalues = Fcons(val, Vvalues);
1453 if (EQ(Vstandard_output, Qt))
1460 build_load_history(LSTREAMP(readcharfun) ||
1461 /* This looks weird, but it's what's in FSFmacs */
1462 (b ? BUF_NARROWED(b) : BUF_NARROWED(current_buffer)),
1466 unbind_to(speccount, Qnil);
1469 DEFUN("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1470 Execute BUFFER as Lisp code.
1471 Programs can pass two arguments, BUFFER and PRINTFLAG.
1472 BUFFER is the buffer to evaluate (nil means use current buffer).
1473 PRINTFLAG controls printing of output:
1474 nil means discard it; anything else is a stream for printing.
1476 If there is no error, point does not move. If there is an error,
1477 point remains at the end of the last character read from the buffer.
1479 (buffer, printflag))
1481 /* This function can GC */
1482 int speccount = specpdl_depth();
1483 Lisp_Object tem, buf;
1486 buf = Fcurrent_buffer();
1488 buf = Fget_buffer(buffer);
1490 error("No such buffer.");
1492 if (NILP(printflag))
1493 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1496 specbind(Qstandard_output, tem);
1497 record_unwind_protect(save_excursion_restore, save_excursion_save());
1498 BUF_SET_PT(XBUFFER(buf), BUF_BEGV(XBUFFER(buf)));
1499 readevalloop(buf, XBUFFER(buf)->filename, Feval, !NILP(printflag));
1501 return unbind_to(speccount, Qnil);
1505 xxDEFUN("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1506 Execute the current buffer as Lisp code.
1507 Programs can pass argument PRINTFLAG which controls printing of output:
1508 nil means discard it; anything else is stream for print.
1510 If there is no error, point does not move. If there is an error,
1511 point remains at the end of the last character read from the buffer.
1518 DEFUN("eval-region", Feval_region, 2, 3, "r", /*
1519 Execute the region as Lisp code.
1520 When called from programs, expects two arguments START and END
1521 giving starting and ending indices in the current buffer
1522 of the text to be executed.
1523 Programs can pass third optional argument STREAM which controls output:
1524 nil means discard it; anything else is stream for printing it.
1526 If there is no error, point does not move. If there is an error,
1527 point remains at the end of the last character read from the buffer.
1529 Note: Before evaling the region, this function narrows the buffer to it.
1530 If the code being eval'd should happen to trigger a redisplay you may
1531 see some text temporarily disappear because of this.
1533 (start, end, stream))
1535 /* This function can GC */
1536 int speccount = specpdl_depth();
1538 Lisp_Object cbuf = Fcurrent_buffer();
1541 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1544 specbind(Qstandard_output, tem);
1547 record_unwind_protect(save_excursion_restore,
1548 save_excursion_save());
1549 record_unwind_protect(save_restriction_restore,
1550 save_restriction_save());
1552 /* This both uses start and checks its type. */
1553 Fgoto_char(start, cbuf);
1554 Fnarrow_to_region(make_int(BUF_BEGV(current_buffer)), end, cbuf);
1555 readevalloop(cbuf, XBUFFER(cbuf)->filename, Feval, !NILP(stream));
1557 return unbind_to(speccount, Qnil);
1560 DEFUN("read", Fread, 0, 1, 0, /*
1561 Read one Lisp expression as text from STREAM, return as Lisp object.
1562 If STREAM is nil, use the value of `standard-input' (which see).
1563 STREAM or the value of `standard-input' may be:
1564 a buffer (read from point and advance it)
1565 a marker (read from where it points and advance it)
1566 a function (call it with no arguments for each character,
1567 call it with a char as argument to push a char back)
1568 a string (takes text from string, starting at the beginning)
1569 t (read text line using minibuffer and use it).
1574 stream = Vstandard_input;
1576 stream = Qread_char;
1578 Vread_objects = Qnil;
1580 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1581 Vcurrent_compiled_function_annotation = Qnil;
1583 if (EQ(stream, Qread_char)) {
1584 Lisp_Object val = call1(Qread_from_minibuffer,
1585 build_translated_string
1586 ("Lisp expression: "));
1587 return Fcar(Fread_from_string(val, Qnil, Qnil));
1590 if (STRINGP(stream))
1591 return Fcar(Fread_from_string(stream, Qnil, Qnil));
1593 return read0(stream);
1596 DEFUN("read-from-string", Fread_from_string, 1, 3, 0, /*
1597 Read one Lisp expression which is represented as text by STRING.
1598 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1599 START and END optionally delimit a substring of STRING from which to read;
1600 they default to 0 and (length STRING) respectively.
1602 (string, start, end))
1604 Bytecount startval, endval;
1606 Lisp_Object lispstream = Qnil;
1607 struct gcpro gcpro1;
1609 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1610 Vcurrent_compiled_function_annotation = Qnil;
1613 CHECK_STRING(string);
1614 get_string_range_byte(string, start, end, &startval, &endval,
1615 GB_HISTORICAL_STRING_BEHAVIOR);
1616 lispstream = make_lisp_string_input_stream(string, startval,
1619 Vread_objects = Qnil;
1621 tem = read0(lispstream);
1622 /* Yeah, it's ugly. Gonna make something of it?
1623 At least our reader is reentrant ... */
1625 (Fcons(tem, make_int
1626 (bytecount_to_charcount
1627 (XSTRING_DATA(string),
1628 startval + Lstream_byte_count(XLSTREAM(lispstream))))));
1629 Lstream_delete(XLSTREAM(lispstream));
1635 ureader_find(Lisp_Object name)
1637 return Fcdr(Fassoc(name, Vureaders));
1642 * ureader_read() assumes that input starts with < character and
1643 * should finish on matching > character.
1646 ureader_read(Lisp_Object ureader_fun, Lisp_Object readcharfun)
1649 unsigned int oparens = 0;
1650 struct gcpro gcpro1;
1653 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
1654 while ((c = readchar(readcharfun)) >= 0) {
1657 else if (c == '>') {
1659 /* We got final closing paren */
1664 Lstream_put_emchar(XLSTREAM (Vread_buffer_stream), c);
1668 return Fsignal(Qend_of_file,
1669 list1(READCHARFUN_MAYBE(readcharfun)));
1671 Lstream_flush(XLSTREAM(Vread_buffer_stream));
1673 instr = make_string(resizing_buffer_stream_ptr
1674 (XLSTREAM(Vread_buffer_stream)),
1675 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
1677 RETURN_UNGCPRO(call1(ureader_fun, instr));
1681 #ifdef LISP_BACKQUOTES
1683 static Lisp_Object backquote_unwind(Lisp_Object ptr)
1684 { /* used as unwind-protect function in read0() */
1685 int *counter = (int *)get_opaque_ptr(ptr);
1688 free_opaque_ptr(ptr);
1694 /* Use this for recursive reads, in contexts where internal tokens
1695 are not allowed. See also read1(). */
1696 static Lisp_Object read0(Lisp_Object readcharfun)
1698 Lisp_Object val = read1(readcharfun);
1700 if (CONSP(val) && UNBOUNDP(XCAR(val))) {
1701 Emchar c = XCHAR(XCDR(val));
1702 free_cons(XCONS(val));
1703 return Fsignal(Qinvalid_read_syntax,
1704 list1(Fchar_to_string(make_char(c))));
1710 static Emchar read_escape(Lisp_Object readcharfun)
1712 /* This function can GC */
1713 Emchar c = readchar(readcharfun);
1716 signal_error(Qend_of_file,
1717 list1(READCHARFUN_MAYBE(readcharfun)));
1742 c = readchar(readcharfun);
1744 signal_error(Qend_of_file,
1745 list1(READCHARFUN_MAYBE(readcharfun)));
1747 error("Invalid escape character syntax");
1748 c = readchar(readcharfun);
1750 signal_error(Qend_of_file,
1751 list1(READCHARFUN_MAYBE(readcharfun)));
1753 c = read_escape(readcharfun);
1756 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1757 compatibility by defining character "modifiers" alt, super,
1758 hyper and shift to infest the characters (i.e. integers).
1760 However, this doesn't cut it for XEmacs 20, which
1761 distinguishes characters from integers. Without Mule, ?\H-a
1762 simply returns ?a because every character is clipped into
1763 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1764 produces an illegal character, and moves us to crash-land.
1766 For these reasons, FSF_KEYS hack is useless and without hope
1767 of ever working under XEmacs 20. */
1771 #define alt_modifier (0x040000)
1772 #define super_modifier (0x080000)
1773 #define hyper_modifier (0x100000)
1774 #define shift_modifier (0x200000)
1775 /* fsf uses a different modifiers for meta and control. Possibly
1776 byte_compiled code will still work fsfmacs, though... --Stig
1778 #define ctl_modifier (0x400000)
1779 #define meta_modifier (0x800000)
1781 #define FSF_LOSSAGE(mask) \
1782 if (fail_on_bucky_bit_character_escapes || \
1783 ((c = readchar (readcharfun)) != '-')) \
1784 error ("Invalid escape character syntax"); \
1785 c = readchar (readcharfun); \
1787 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1789 c = read_escape (readcharfun); \
1793 FSF_LOSSAGE(shift_modifier);
1795 FSF_LOSSAGE(hyper_modifier);
1797 FSF_LOSSAGE(alt_modifier);
1799 FSF_LOSSAGE(super_modifier);
1801 #undef super_modifier
1802 #undef hyper_modifier
1803 #undef shift_modifier
1806 #endif /* FSF_KEYS */
1809 c = readchar(readcharfun);
1811 signal_error(Qend_of_file,
1812 list1(READCHARFUN_MAYBE(readcharfun)));
1814 error("Invalid escape character syntax");
1816 c = readchar(readcharfun);
1818 signal_error(Qend_of_file,
1819 list1(READCHARFUN_MAYBE(readcharfun)));
1821 c = read_escape(readcharfun);
1822 /* FSFmacs junk for non-ASCII controls.
1827 return c & (0200 | 037);
1837 /* An octal escape, as in ANSI C. */
1839 REGISTER Emchar i = c - '0';
1840 REGISTER int count = 0;
1841 while (++count < 3) {
1842 if ((c = readchar(readcharfun)) >= '0'
1844 i = (i << 3) + (c - '0');
1846 unreadchar(readcharfun, c);
1854 /* A hex escape, as in ANSI C, except that we only allow latin-1
1855 characters to be read this way. What is "\x4e03" supposed to
1856 mean, anyways, if the internal representation is hidden?
1857 This is also consistent with the treatment of octal escapes. */
1859 REGISTER Emchar i = 0;
1860 REGISTER int count = 0;
1861 while (++count <= 2) {
1862 c = readchar(readcharfun);
1863 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1864 if (c >= '0' && c <= '9')
1865 i = (i << 4) + (c - '0');
1866 else if (c >= 'a' && c <= 'f')
1867 i = (i << 4) + (c - 'a') + 10;
1868 else if (c >= 'A' && c <= 'F')
1869 i = (i << 4) + (c - 'A') + 10;
1871 unreadchar(readcharfun, c);
1879 /* #### need some way of reading an extended character with
1880 an escape sequence. */
1888 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1890 read_atom_0(Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1892 /* This function can GC */
1893 Emchar c = ((firstchar) >= 0 ? firstchar : readchar(readcharfun));
1894 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
1896 *saw_a_backslash = 0;
1898 while (c > 040 /* #### - comma should be here as should backquote */
1899 && !(c == '\"' || c == '\'' || c == ';' || c == '(' || c == ')'
1900 #ifndef HAVE_FPFLOAT
1901 /* If we have floating-point support, then we need
1902 to allow <digits><dot><digits>. */
1904 #endif /* not HAVE_FPFLOAT */
1905 || c == '[' || c == ']' || c == '#')) {
1907 c = readchar(readcharfun);
1909 signal_error(Qend_of_file,
1910 list1(READCHARFUN_MAYBE
1912 *saw_a_backslash = 1;
1914 Lstream_put_emchar(XLSTREAM(Vread_buffer_stream), c);
1916 c = readchar(readcharfun);
1920 unreadchar(readcharfun, c);
1921 /* blasted terminating 0 */
1922 Lstream_put_emchar(XLSTREAM(Vread_buffer_stream), 0);
1923 Lstream_flush(XLSTREAM(Vread_buffer_stream));
1925 return Lstream_byte_count(XLSTREAM(Vread_buffer_stream)) - 1;
1928 static Lisp_Object parse_integer(const Bufbyte * buf, Bytecount len, int base);
1931 read_atom(Lisp_Object readcharfun, Emchar firstchar, int uninterned_symbol)
1933 /* This function can GC */
1934 int saw_a_backslash;
1935 Bytecount len = read_atom_0(readcharfun, firstchar, &saw_a_backslash);
1936 char *read_ptr = (char *)
1937 resizing_buffer_stream_ptr(XLSTREAM(Vread_buffer_stream));
1939 /* Is it an integer? */
1940 if (!(saw_a_backslash || uninterned_symbol)) {
1941 /* If a token had any backslashes in it, it is disqualified from
1942 being an integer or a float. This means that 123\456 is a
1943 symbol, as is \123 (which is the way (intern "123") prints).
1944 Also, if token was preceded by #:, it's always a symbol.
1946 char *p = read_ptr + len;
1947 char *p1 = read_ptr;
1949 if (*p1 == '+' || *p1 == '-')
1954 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1957 /* Integers can have trailing decimal points. */
1958 if (p1 > read_ptr && p1 < p && *p1 == '.')
1962 /* It is an integer. */
1967 return parse_integer((Bufbyte*)read_ptr, len,
1971 #if defined HAVE_MPQ && defined WITH_GMP
1972 if (isbigq_string(read_ptr))
1973 return read_bigq_string(read_ptr);
1975 #if defined HAVE_MPFR && defined WITH_MPFR
1976 if (isfloat_string(read_ptr) && (Vread_real_as == Qbigfr))
1977 return read_bigfr_string(read_ptr);
1978 #endif /* HAVE_MPFR */
1979 #if defined HAVE_MPF && defined WITH_GMP
1980 if (isfloat_string(read_ptr) && (Vread_real_as == Qbigf))
1981 return read_bigf_string(read_ptr);
1983 #endif /* HAVE_MPF */
1985 if (isfloat_string(read_ptr)) {
1986 return make_float(str_to_fpfloat(read_ptr));
1989 #if defined HAVE_PSEUG && defined WITH_PSEUG
1990 if (isgaussian_string(read_ptr))
1991 return read_bigg_string(read_ptr);
1993 #if defined HAVE_MPC && defined WITH_MPC || \
1994 defined HAVE_PSEUC && defined WITH_PSEUC
1995 if (isbigc_string(read_ptr))
1996 return read_bigc_string(read_ptr);
1997 #endif /* HAVE_MPC */
1998 #if defined HAVE_QUATERN && defined WITH_QUATERN
1999 if (isquatern_string(read_ptr))
2000 return read_quatern_string(read_ptr);
2004 /* check for resclass syntax */
2005 if (ase_resc_rng_pred_f && ase_resc_rng_f &&
2006 ase_resc_rng_pred_f(read_ptr))
2007 return ase_resc_rng_f(read_ptr);
2008 if (ase_resc_elm_pred_f && ase_resc_elm_f &&
2009 ase_resc_elm_pred_f(read_ptr))
2010 return ase_resc_elm_f(read_ptr);
2014 if (uninterned_symbol)
2016 Fmake_symbol(make_string
2017 ((Bufbyte *) read_ptr, len));
2020 make_string((Bufbyte *) read_ptr, len);
2021 sym = Fintern(name, Qnil);
2028 parse_integer(const Bufbyte * buf, Bytecount len, int base)
2030 const Bufbyte *lim = buf + len;
2031 const Bufbyte *p = buf;
2033 int negativland = 0;
2038 } else if (*p == '+') {
2045 for (; (p < lim) && (*p != '\0'); p++) {
2051 else if (isupper(c))
2053 else if (islower(c))
2058 if (c < 0 || c >= base)
2062 num = num * base + c;
2068 EMACS_INT int_result =
2069 negativland ? -(EMACS_INT) num : (EMACS_INT) num;
2070 Lisp_Object result = make_int(int_result);
2071 if (num && ((XINT(result) < 0) != negativland))
2073 if (XINT(result) != int_result)
2078 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_BSDMP)
2079 return read_bigz_string((const char*)buf, base);
2081 /* This is going to kill us!
2082 * Big integers cannot be used anywhere if the reader rewards
2083 * their occurence that harshly
2085 return Fsignal(Qinvalid_read_syntax,
2086 list3(build_translated_string
2087 ("Integer constant overflow in reader"),
2088 make_string(buf, len), make_int(base)));
2090 warn_when_safe(Qinvalid_read_syntax, Qwarning,
2091 "Integer constant overflow in reader: %s,"
2092 " proceeding nervously with 0.",
2095 #endif /* HAVE_MPZ && WITH_GMP||WITH_BSDMP */
2097 return Fsignal(Qinvalid_read_syntax,
2098 list3(build_translated_string
2099 ("Invalid integer constant in reader"),
2100 make_string(buf, len), make_int(base)));
2104 read_integer(Lisp_Object readcharfun, int base)
2106 /* This function can GC */
2107 int saw_a_backslash;
2108 Bytecount len = read_atom_0(readcharfun, -1, &saw_a_backslash);
2109 return (parse_integer
2110 (resizing_buffer_stream_ptr(XLSTREAM(Vread_buffer_stream)),
2112 ? 0 /* make parse_integer signal error */
2117 read_bit_vector(Lisp_Object readcharfun)
2119 unsigned_char_dynarr *dyn = Dynarr_new(unsigned_char);
2124 Emchar c = readchar(readcharfun);
2131 unreadchar(readcharfun, c);
2134 Dynarr_add(dyn, bit);
2137 val = make_bit_vector_from_byte_vector(Dynarr_atp(dyn, 0),
2138 Dynarr_length(dyn));
2146 struct structure_type*
2147 define_structure_type(Lisp_Object type,
2148 int(*validate)(Lisp_Object data, Error_behavior errb),
2149 Lisp_Object(*instantiate)(Lisp_Object data))
2151 struct structure_type st;
2154 st.keywords = Dynarr_new(structure_keyword_entry);
2155 st.validate = validate;
2156 st.instantiate = instantiate;
2157 Dynarr_add(the_structure_type_dynarr, st);
2159 return Dynarr_atp(the_structure_type_dynarr,
2160 Dynarr_length(the_structure_type_dynarr) - 1);
2164 define_structure_type_keyword(struct structure_type *st, Lisp_Object keyword,
2165 int (*validate) (Lisp_Object keyword,
2167 Error_behavior errb))
2169 struct structure_keyword_entry en;
2171 en.keyword = keyword;
2172 en.validate = validate;
2173 Dynarr_add(st->keywords, en);
2176 static struct structure_type*
2177 recognized_structure_type(Lisp_Object type)
2181 for (i = 0; i < Dynarr_length(the_structure_type_dynarr); i++) {
2182 struct structure_type *st =
2183 Dynarr_atp(the_structure_type_dynarr, i);
2184 if (EQ(st->type, type))
2192 read_structure(Lisp_Object readcharfun)
2194 Emchar c = readchar(readcharfun);
2195 Lisp_Object list = Qnil;
2196 Lisp_Object orig_list = Qnil;
2197 Lisp_Object already_seen = Qnil;
2199 struct structure_type *st;
2200 struct gcpro gcpro1, gcpro2;
2202 GCPRO2(orig_list, already_seen);
2204 RETURN_UNGCPRO(continuable_read_syntax_error
2205 ("#s not followed by paren"));
2206 list = read_list(readcharfun, ')', 0, 0);
2209 int len = XINT(Flength(list));
2211 RETURN_UNGCPRO(continuable_read_syntax_error
2212 ("structure type not specified"));
2215 (continuable_read_syntax_error
2216 ("structures must have alternating keyword/value pairs"));
2219 st = recognized_structure_type(XCAR(list));
2221 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2222 list2(build_translated_string
2223 ("unrecognized structure type"),
2227 keyword_count = Dynarr_length(st->keywords);
2228 while (!NILP(list)) {
2229 Lisp_Object keyword, value;
2231 struct structure_keyword_entry *en = NULL;
2233 keyword = Fcar(list);
2238 if (!NILP(memq_no_quit(keyword, already_seen)))
2239 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2240 list2(build_translated_string
2241 ("structure keyword already seen"),
2244 for (i = 0; i < keyword_count; i++) {
2245 en = Dynarr_atp(st->keywords, i);
2246 if (EQ(keyword, en->keyword))
2250 if (i == keyword_count)
2251 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2252 list2(build_translated_string
2253 ("unrecognized structure keyword"),
2256 if (en->validate && !(en->validate) (keyword, value, ERROR_ME))
2258 (Fsignal(Qinvalid_read_syntax,
2259 list3(build_translated_string
2260 ("invalid value for structure keyword"),
2263 already_seen = Fcons(keyword, already_seen);
2266 if (st->validate && !(st->validate) (orig_list, ERROR_ME))
2267 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2268 list2(build_translated_string
2269 ("invalid structure initializer"),
2272 RETURN_UNGCPRO((st->instantiate) (XCDR(orig_list)));
2275 static Lisp_Object read_compiled_function(Lisp_Object readcharfun, int);
2276 static Lisp_Object read_vector(Lisp_Object readcharfun, int terminator);
2278 /* Get the next character; filter out whitespace and comments */
2281 reader_nextchar(Lisp_Object readcharfun)
2283 /* This function can GC */
2288 c = readchar(readcharfun);
2290 signal_error(Qend_of_file,
2291 list1(READCHARFUN_MAYBE(readcharfun)));
2296 /* Ignore whitespace and control characters */
2305 while ((c = readchar(readcharfun)) >= 0 && c != '\n')
2313 static Lisp_Object list2_pure(int pure, Lisp_Object a, Lisp_Object b)
2315 return pure ? pure_cons(a, pure_cons(b, Qnil)) : list2(a, b);
2319 /* Read the next Lisp object from the stream READCHARFUN and return it.
2320 If the return value is a cons whose car is Qunbound, then read1()
2321 encountered a misplaced token (e.g. a right bracket, right paren,
2322 or dot followed by a non-number). To filter this stuff out,
2326 read_string(Lisp_Object readcharfun, Emchar delim, int raw)
2329 /* #### If the input stream is translating, then the string
2330 should be marked as translatable by setting its
2331 `string-translatable' property to t. .el and .elc files
2332 normally are translating input streams. See Fgettext()
2333 and print_internal(). */
2338 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
2339 while ((c = readchar(readcharfun)) >= 0 && c != delim) {
2342 /* For raw strings, insert the
2343 backslash and the next char, */
2345 XLSTREAM(Vread_buffer_stream), c);
2346 c = readchar(readcharfun);
2348 /* otherwise, backslash escapes the next char */
2349 c = read_escape(readcharfun);
2352 /* c is -1 if \ newline has just been seen */
2354 if (!Lstream_byte_count(XLSTREAM(Vread_buffer_stream))) {
2358 Lstream_put_emchar(XLSTREAM
2359 (Vread_buffer_stream),
2365 return Fsignal(Qend_of_file,
2366 list1(READCHARFUN_MAYBE(readcharfun)));
2369 /* If purifying, and string starts with \ newline,
2370 return zero instead. This is for doc strings
2371 that we are really going to find in lib-src/DOC.nn.nn */
2372 if (purify_flag && NILP(Vinternal_doc_file_name) && cancel) {
2376 Lstream_flush(XLSTREAM(Vread_buffer_stream));
2377 return make_string(resizing_buffer_stream_ptr
2378 (XLSTREAM(Vread_buffer_stream)),
2379 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
2383 read_raw_string(Lisp_Object readcharfun)
2386 c = reader_nextchar(readcharfun);
2388 /* #r:engine"my sexy raw string" -- raw string w/ flags*/
2390 /* #r"my raw string" -- raw string */
2392 return read_string(readcharfun, '\"', 1);
2393 /* invalid syntax */
2395 unreadchar(readcharfun, c);
2396 return Fsignal(Qinvalid_read_syntax,
2398 ("unrecognized raw string syntax")));
2404 read1(Lisp_Object readcharfun)
2409 c = reader_nextchar(readcharfun);
2413 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2414 /* if this is disabled, then other code in eval.c must be
2416 Emchar ch = reader_nextchar(readcharfun);
2420 int speccount = specpdl_depth();
2421 ++old_backquote_flag;
2422 record_unwind_protect(backquote_unwind,
2424 (&old_backquote_flag));
2425 tem = read0(readcharfun);
2426 unbind_to(speccount, Qnil);
2427 ch = reader_nextchar(readcharfun);
2429 unreadchar(readcharfun, ch);
2432 (Qinvalid_read_syntax,
2434 ("Weird old-backquote syntax")));
2436 return list2(Qbacktick, tem);
2439 if (old_backquote_flag) {
2440 Lisp_Object tem, comma_type;
2441 ch = readchar(readcharfun);
2443 comma_type = Qcomma_at;
2449 comma_type = Qcomma;
2451 tem = read0(readcharfun);
2452 ch = reader_nextchar
2455 unreadchar(readcharfun,
2458 Qinvalid_read_syntax,
2460 ("Weird old-backquote "
2463 return list2(comma_type, tem);
2465 unreadchar(readcharfun, ch);
2469 (Qinvalid_read_syntax,
2471 ("Comma outside of backquote")));
2473 /* #### - yuck....but this is reverse
2475 /* mostly this is required by edebug, which does
2476 its own annotated reading. We need to have
2477 an annotated_read function that records (with
2478 markers) the buffer positions of the elements
2479 that make up lists, then that can be used in
2480 edebug and bytecomp and the check above can
2481 go back in. --Stig */
2487 unreadchar(readcharfun, ch);
2489 #endif /* old backquote crap... */
2490 return read_list(readcharfun, ')', 1, 1);
2493 return read_vector(readcharfun, ']');
2497 /* #### - huh? these don't do what they seem... */
2498 return noseeum_cons(Qunbound, make_char(c));
2501 /* If a period is followed by a number, then we should read it
2502 as a floating point number. Otherwise, it denotes a dotted
2505 c = readchar(readcharfun);
2506 unreadchar(readcharfun, c);
2508 /* Can't use isdigit on Emchars */
2509 if (c < '0' || c > '9')
2510 return noseeum_cons(Qunbound, make_char('.'));
2512 /* Note that read_atom will loop
2513 at least once, assuring that we will not try to UNREAD
2514 two characters in a row.
2515 (I think this doesn't matter anymore because there should
2516 be no more danger in unreading multiple characters) */
2517 return read_atom(readcharfun, '.', 0);
2519 #else /* ! HAVE_FPFLOAT */
2520 return noseeum_cons(Qunbound, make_char('.'));
2521 #endif /* ! HAVE_FPFLOAT */
2525 c = readchar(readcharfun);
2527 #if 0 /* FSFmacs silly char-table syntax */
2530 #if 0 /* FSFmacs silly bool-vector syntax */
2533 /* "#["-- byte-code constant syntax */
2534 /* purecons #[...] syntax */
2536 return read_compiled_function(readcharfun, ']'
2539 /* "#:"-- gensym syntax */
2541 return read_atom(readcharfun, -1, 1);
2542 /* #'x => (function x) */
2544 return list2(Qfunction, read0(readcharfun));
2546 /* RMS uses this syntax for fat-strings.
2547 If we use it for vectors, then obscure bugs happen.
2549 /* "#(" -- Scheme/CL vector syntax */
2551 return read_vector(readcharfun, ')');
2554 /* When are we going to drop this crap??? -hroptatyr */
2557 struct gcpro gcpro1;
2559 /* Read the string itself. */
2560 tmp = read1(readcharfun);
2561 if (!STRINGP(tmp)) {
2563 && UNBOUNDP(XCAR(tmp)))
2564 free_cons(XCONS(tmp));
2567 (Qinvalid_read_syntax,
2568 list1(build_string("#")));
2571 /* Read the intervals and their properties. */
2573 Lisp_Object beg, end, plist;
2577 beg = read1(readcharfun);
2578 if (CONSP(beg) && UNBOUNDP(XCAR(beg))) {
2579 ch = XCHAR(XCDR(beg));
2580 free_cons(XCONS(beg));
2591 UNBOUNDP(XCAR(end)))
2613 (Qinvalid_read_syntax,
2619 Fset_text_properties(beg, end, plist, tmp);
2626 /* #@NUMBER is used to skip NUMBER following characters.
2627 That's used in .elc files to skip over doc strings
2628 and function definitions. */
2631 /* Read a decimal integer. */
2632 while ((c = readchar(readcharfun)) >= 0
2633 && c >= '0' && c <= '9')
2635 (10 * nskip) + (c - '0');
2637 unreadchar(readcharfun, c);
2639 /* FSF has code here that maybe caches the skipped
2640 string. See above for why this is totally
2641 losing. We handle this differently. */
2643 /* Skip that many characters. */
2644 for (i = 0; i < nskip && c >= 0; i++)
2645 c = readchar(readcharfun);
2650 return Vload_file_name_internal;
2653 return read_bit_vector(readcharfun);
2654 /* #o10 => 8 -- octal constant syntax */
2656 return read_integer(readcharfun, 8);
2657 /* #xdead => 57005 -- hex constant syntax */
2659 return read_integer(readcharfun, 16);
2660 /* #b010 => 2 -- binary constant syntax */
2662 return read_integer(readcharfun, 2);
2665 Emchar _c_ = reader_nextchar(readcharfun);
2666 /* check for permutation syntax */
2669 read_vector(readcharfun, ']');
2670 if (ase_permutation_f) {
2671 return ase_permutation_f(perm);
2676 unreadchar(readcharfun, _c_);
2678 "unrecognised permutation syntax");
2680 Qinvalid_read_syntax, list1(err));
2685 /* #r"raw\stringt" -- raw string syntax */
2686 return read_raw_string(readcharfun);
2689 /* #s(foobar key1 val1 key2 val2) --
2690 * structure syntax */
2691 return read_structure(readcharfun);
2693 /* Check user readers */
2694 Lisp_Object uoname = read_string(readcharfun, ' ', 0);
2695 Lisp_Object ureader = ureader_find(uoname);
2697 return ureader_read(ureader, readcharfun);
2699 unreadchar(readcharfun, c);
2700 return Fsignal(Qinvalid_read_syntax,
2702 ("No ureader for"), uoname));
2704 #ifdef FEATUREP_SYNTAX
2707 Lisp_Object feature_exp, obj, tem;
2708 struct gcpro gcpro1, gcpro2;
2710 feature_exp = read0(readcharfun);
2711 obj = read0(readcharfun);
2713 /* the call to `featurep' may GC. */
2714 GCPRO2(feature_exp, obj);
2715 tem = call1(Qfeaturep, feature_exp);
2718 if (c == '+' && NILP(tem))
2720 if (c == '-' && !NILP(tem))
2735 /* Reader forms that can reuse previously read
2740 /* Using read_integer() here is impossible, because it
2741 chokes on `='. Using parse_integer() is too hard.
2742 So we simply read it in, and ignore overflows, which
2744 while (c >= '0' && c <= '9') {
2747 c = readchar(readcharfun);
2749 found = assq_no_quit(make_int(n), Vread_objects);
2751 /* #n=object returns object, but associates it
2758 (Qinvalid_read_syntax,
2760 (build_translated_string
2761 ("Multiply defined symbol label"),
2763 obj = read0(readcharfun);
2769 } else if (c == '#') {
2770 /* #n# returns a previously read object. */
2776 (Qinvalid_read_syntax,
2778 (build_translated_string
2779 ("Undefined symbol label"),
2782 return Fsignal(Qinvalid_read_syntax,
2787 unreadchar(readcharfun, c);
2788 return Fsignal(Qinvalid_read_syntax,
2797 return list2(Qquote, read0(readcharfun));
2799 #ifdef LISP_BACKQUOTES
2802 int speccount = specpdl_depth();
2803 ++new_backquote_flag;
2804 record_unwind_protect(backquote_unwind,
2806 (&new_backquote_flag));
2807 tem = read0(readcharfun);
2808 unbind_to(speccount, Qnil);
2809 return list2(Qbackquote, tem);
2813 if (new_backquote_flag) {
2814 Lisp_Object comma_type = Qnil;
2815 int ch = readchar(readcharfun);
2818 comma_type = Qcomma_at;
2820 comma_type = Qcomma_dot;
2823 unreadchar(readcharfun, ch);
2824 comma_type = Qcomma;
2826 return list2(comma_type, read0(readcharfun));
2828 /* YUCK. 99.999% backwards compatibility. The Right
2829 Thing(tm) is to signal an error here, because it's
2830 really invalid read syntax. Instead, this permits
2831 commas to begin symbols (unless they're inside
2832 backquotes). If an error is signalled here in the
2833 future, then commas should be invalid read syntax
2834 outside of backquotes anywhere they're found (i.e.
2835 they must be quoted in symbols) -- Stig */
2836 return read_atom(readcharfun, c, 0);
2842 /* Evil GNU Emacs "character" (ie integer) syntax */
2843 c = readchar(readcharfun);
2845 return Fsignal(Qend_of_file,
2846 list1(READCHARFUN_MAYBE
2850 c = read_escape(readcharfun);
2851 return make_char(c);
2856 return read_string(readcharfun, '\"', 0);
2859 /* Ignore whitespace and control characters */
2862 return read_atom(readcharfun, c, 0);
2874 /* for complex numbers */
2875 #define INTERMEDIATE_UNARY_SYMBOL 32
2876 #define LEAD_INT2 64
2877 #define DOT_CHAR2 128
2878 #define TRAIL_INT2 256
2880 #define EXP_INT2 1024
2886 isfloat_string(const char *cp)
2889 const Bufbyte *ucp = (const Bufbyte *)cp;
2891 if (*ucp == '+' || *ucp == '-')
2894 if (*ucp >= '0' && *ucp <= '9') {
2896 while (*ucp >= '0' && *ucp <= '9')
2903 if (*ucp >= '0' && *ucp <= '9') {
2905 while (*ucp >= '0' && *ucp <= '9')
2908 if (*ucp == 'e' || *ucp == 'E') {
2911 if ((*ucp == '+') || (*ucp == '-'))
2915 if (*ucp >= '0' && *ucp <= '9') {
2917 while (*ucp >= '0' && *ucp <= '9')
2920 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t')
2922 || (*ucp == '\r') || (*ucp == '\f'))
2923 && (state == (LEAD_INT | DOT_CHAR | TRAIL_INT)
2924 || state == (DOT_CHAR | TRAIL_INT)
2925 || state == (LEAD_INT | E_CHAR | EXP_INT)
2927 (LEAD_INT | DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)
2928 || state == (DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)));
2930 #endif /* HAVE_FPFLOAT */
2931 #if defined HAVE_MPC && defined WITH_MPC || \
2932 defined HAVE_PSEUC && defined WITH_PSEUC
2934 isbigc_string (const char *cp)
2937 const Bufbyte *ucp = (const Bufbyte *)cp;
2940 /* parse the real part */
2942 if (*ucp == '+' || *ucp == '-')
2945 if (*ucp >= '0' && *ucp <= '9') {
2947 while (*ucp >= '0' && *ucp <= '9')
2954 if (*ucp >= '0' && *ucp <= '9') {
2956 while (*ucp >= '0' && *ucp <= '9')
2959 if (*ucp == 'e' || *ucp == 'E') {
2962 if ((*ucp == '+') || (*ucp == '-'))
2966 if (*ucp >= '0' && *ucp <= '9') {
2968 while (*ucp >= '0' && *ucp <= '9')
2972 /* check if we had a real number until here */
2973 if (!(state == (LEAD_INT | DOT_CHAR | TRAIL_INT) ||
2974 state == (DOT_CHAR | TRAIL_INT) ||
2975 state == (LEAD_INT | E_CHAR | EXP_INT) ||
2976 state == (LEAD_INT | DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT) ||
2977 state == (DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)))
2980 /* now parse imaginary part */
2982 if (*ucp == '+' || *ucp == '-') {
2983 state |= INTERMEDIATE_UNARY_SYMBOL;
2987 if (*ucp >= '0' && *ucp <= '9') {
2989 while (*ucp >= '0' && *ucp <= '9')
2996 if (*ucp >= '0' && *ucp <= '9') {
2997 state |= TRAIL_INT2;
2998 while (*ucp >= '0' && *ucp <= '9')
3001 if (*ucp == 'e' || *ucp == 'E') {
3004 if ((*ucp == '+') || (*ucp == '-'))
3008 if (*ucp >= '0' && *ucp <= '9') {
3010 while (*ucp >= '0' && *ucp <= '9')
3013 if (*ucp == 'i' || *ucp == 'I') {
3017 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
3018 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
3019 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | DOT_CHAR2 |
3020 TRAIL_INT2 | I_CHAR) ||
3021 state == (INTERMEDIATE_UNARY_SYMBOL | DOT_CHAR2 |
3022 TRAIL_INT2 | I_CHAR) ||
3023 state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 |
3024 E_CHAR2 | EXP_INT2 | I_CHAR) ||
3025 state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | DOT_CHAR2 |
3026 TRAIL_INT2 | E_CHAR2 | EXP_INT2 | I_CHAR) ||
3027 state == (INTERMEDIATE_UNARY_SYMBOL | DOT_CHAR2 | TRAIL_INT2 |
3028 E_CHAR2 | EXP_INT2 | I_CHAR) ||
3029 state == (INTERMEDIATE_UNARY_SYMBOL | I_CHAR)));
3031 #endif /* HAVE_MPC */
3032 #if defined WITH_PSEUG && defined HAVE_PSEUG
3034 isgaussian_string (const char *cp)
3037 const Bufbyte *ucp = (const Bufbyte *)cp;
3040 /* parse the real part */
3042 if (*ucp == '+' || *ucp == '-')
3045 if (*ucp >= '0' && *ucp <= '9') {
3047 while (*ucp >= '0' && *ucp <= '9')
3051 /* check if we had a int number until here */
3052 if (!(state == (LEAD_INT)))
3055 /* now parse imaginary part */
3057 if (*ucp == '+' || *ucp == '-') {
3058 state |= INTERMEDIATE_UNARY_SYMBOL;
3062 if (*ucp >= '0' && *ucp <= '9') {
3064 while (*ucp >= '0' && *ucp <= '9')
3067 if (*ucp == 'i' || *ucp == 'I') {
3071 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
3072 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
3073 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | I_CHAR) ||
3074 state == (INTERMEDIATE_UNARY_SYMBOL | I_CHAR)));
3076 #endif /* HAVE_PSEUG */
3077 #if defined HAVE_MPQ && defined WITH_GMP
3079 isbigq_string (const char *cp)
3081 /* Possible minus/plus sign */
3082 if (*cp == '-' || *cp == '+')
3086 if (*cp < '0' || *cp > '9')
3091 } while (*cp >= '0' && *cp <= '9');
3098 if (*cp < '0' || *cp > '9')
3103 } while (*cp >= '0' && *cp <= '9');
3105 return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' ||
3106 *cp == '\r' || *cp == '\f';
3108 #endif /* HAVE_MPQ */
3112 sequence_reader(Lisp_Object readcharfun,
3115 void*(*conser)(Lisp_Object, void*, Charcount))
3119 for (len = 0;; len++) {
3123 ch = reader_nextchar(readcharfun);
3125 if (ch == terminator)
3128 unreadchar(readcharfun, ch);
3129 #ifdef FEATUREP_SYNTAX
3131 read_syntax_error("\"]\" in a list");
3133 read_syntax_error("\")\" in a vector");
3135 state = ((conser) (readcharfun, state, len));
3139 struct read_list_state {
3143 int allow_dotted_lists;
3148 read_list_conser(Lisp_Object readcharfun, void *state, Charcount len)
3150 struct read_list_state *s = (struct read_list_state *)state;
3153 elt = read1(readcharfun);
3155 if (CONSP(elt) && UNBOUNDP(XCAR(elt))) {
3156 Lisp_Object tem = elt;
3160 free_cons(XCONS(tem));
3163 #ifdef FEATUREP_SYNTAX
3164 if (ch == s->terminator) {
3165 /* deal with #+, #- reader macros */
3166 unreadchar(readcharfun, s->terminator);
3168 } else if (ch == ']')
3169 read_syntax_error("']' in a list");
3171 read_syntax_error("')' in a vector");
3175 signal_simple_error("BUG! Internal reader error", elt);
3176 else if (!s->allow_dotted_lists)
3177 read_syntax_error("\".\" in a vector");
3180 XCDR(s->tail) = read0(readcharfun);
3182 s->head = read0(readcharfun);
3183 elt = read1(readcharfun);
3184 if (CONSP(elt) && UNBOUNDP(XCAR(elt))) {
3185 ch = XCHAR(XCDR(elt));
3186 free_cons(XCONS(elt));
3187 if (ch == s->terminator) {
3188 unreadchar(readcharfun, s->terminator);
3192 read_syntax_error(". in wrong context");
3195 #if 0 /* FSFmacs defun hack, or something ... */
3196 if (NILP(tail) && defun_hack && EQ(elt, Qdefun) && !read_pure) {
3197 record_unwind_protect(unreadpure, Qzero);
3202 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3203 if (s->length == 1 && s->allow_dotted_lists && EQ(XCAR(s->head), Qfset)) {
3204 if (CONSP(elt) && EQ(XCAR(elt), Qquote) && CONSP(XCDR(elt)))
3205 Vcurrent_compiled_function_annotation = XCAR(XCDR(elt));
3207 Vcurrent_compiled_function_annotation = elt;
3211 elt = Fcons(elt, Qnil);
3213 XCDR(s->tail) = elt;
3222 #if 0 /* FSFmacs defun hack */
3223 /* -1 for allow_dotted_lists means allow_dotted_lists and check
3224 for starting with defun and make structure pure. */
3228 read_list(Lisp_Object readcharfun,
3230 int allow_dotted_lists, int check_for_doc_references)
3232 struct read_list_state s;
3233 struct gcpro gcpro1, gcpro2;
3234 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3235 Lisp_Object old_compiled_function_annotation =
3236 Vcurrent_compiled_function_annotation;
3242 s.allow_dotted_lists = allow_dotted_lists;
3243 s.terminator = terminator;
3244 GCPRO2(s.head, s.tail);
3246 sequence_reader(readcharfun, terminator, &s, read_list_conser);
3247 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3248 Vcurrent_compiled_function_annotation =
3249 old_compiled_function_annotation;
3252 if ((purify_flag || load_force_doc_strings) && check_for_doc_references) {
3253 /* check now for any doc string references and record them
3257 /* We might be dealing with an imperfect list so don't
3259 for (tail = s.head; CONSP(tail); tail = XCDR(tail)) {
3260 Lisp_Object holding_cons = Qnil;
3263 Lisp_Object elem = XCAR(tail);
3264 /* elem might be (#$ . INT) ... */
3266 && EQ(XCAR(elem), Vload_file_name_internal))
3267 holding_cons = tail;
3268 /* or it might be (quote (#$ . INT)) i.e.
3269 (quote . ((#$ . INT) . nil)) in the case of
3270 `autoload' (autoload evaluates its arguments, while
3271 `defvar', `defun', etc. don't). */
3272 if (CONSP(elem) && EQ(XCAR(elem), Qquote)
3273 && CONSP(XCDR(elem))) {
3274 elem = XCAR(XCDR(elem));
3277 Vload_file_name_internal))
3278 holding_cons = XCDR(XCAR(tail));
3282 if (CONSP(holding_cons)) {
3284 if (NILP(Vinternal_doc_file_name))
3285 /* We have not yet called
3286 Snarf-documentation, so
3287 assume this file is described
3289 Snarf-documentation will fill
3290 in the right value later.
3291 For now, replace the whole
3293 XCAR(holding_cons) = Qzero;
3295 /* We have already called
3296 Snarf-documentation, so make
3297 a relative file name for this
3298 file, so it can be found
3299 properly in the installed
3300 Lisp directory. We don't use
3301 Fexpand_file_name because
3302 that would make the directory
3304 XCAR(XCAR(holding_cons)) =
3305 concat2(build_string
3307 Ffile_name_nondirectory
3308 (Vload_file_name_internal));
3310 /* Not pure. Just add to
3311 Vload_force_doc_string_list, and the
3312 string will be filled in properly in
3313 load_force_doc_string_unwind(). */
3314 Vload_force_doc_string_list =
3315 /* We pass the cons that holds the
3316 (#$ . INT) so we can modify it
3319 Vload_force_doc_string_list);
3329 read_vector(Lisp_Object readcharfun, Emchar terminator)
3335 struct read_list_state s;
3336 struct gcpro gcpro1, gcpro2;
3341 s.allow_dotted_lists = 0;
3342 GCPRO2(s.head, s.tail);
3344 sequence_reader(readcharfun, terminator, &s, read_list_conser);
3348 len = XINT(Flength(tem));
3350 #if 0 /* FSFmacs defun hack */
3352 s.head = make_pure_vector(len, Qnil);
3355 s.head = make_vector(len, Qnil);
3357 for (i = 0, p = &(XVECTOR_DATA(s.head)[0]); i < len; i++, p++) {
3358 Lisp_Cons *otem = XCONS(tem);
3368 read_compiled_function(Lisp_Object readcharfun, Emchar terminator)
3370 /* Accept compiled functions at read-time so that we don't
3371 have to build them at load-time. */
3373 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3374 struct gcpro gcpro1;
3377 int saw_a_doc_ref = 0;
3379 /* Note: we tell read_list not to search for doc references
3380 because we need to handle the "doc reference" for the
3381 instructions and constants differently. */
3382 stuff = read_list(readcharfun, terminator, 0, 0);
3383 len = XINT(Flength(stuff));
3384 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3386 continuable_read_syntax_error
3387 ("#[...] used with wrong number of elements");
3389 for (iii = 0; CONSP(stuff); iii++) {
3390 Lisp_Cons *victim = XCONS(stuff);
3391 make_byte_code_args[iii] = Fcar(stuff);
3392 if ((purify_flag || load_force_doc_strings)
3393 && CONSP(make_byte_code_args[iii])
3394 && EQ(XCAR(make_byte_code_args[iii]),
3395 Vload_file_name_internal)) {
3396 if (purify_flag && iii == COMPILED_DOC_STRING) {
3397 /* same as in read_list(). */
3398 if (NILP(Vinternal_doc_file_name))
3399 make_byte_code_args[iii] = Qzero;
3401 XCAR(make_byte_code_args[iii]) =
3402 concat2(build_string("../lisp/"),
3403 Ffile_name_nondirectory
3404 (Vload_file_name_internal));
3408 stuff = Fcdr(stuff);
3411 GCPROn(make_byte_code_args, len);
3413 /* v18 or v19 bytecode file. Need to Ebolify. */
3414 if (load_byte_code_version < 20 && VECTORP(make_byte_code_args[2]))
3415 ebolify_bytecode_constants(make_byte_code_args[2]);
3417 /* make-byte-code looks at purify_flag, which should have the same
3418 * value as our "read-pure" argument */
3419 stuff = Fmake_byte_code(len, make_byte_code_args);
3420 XCOMPILED_FUNCTION(stuff)->flags.ebolified =
3421 (load_byte_code_version < 20);
3423 Vload_force_doc_string_list =
3424 Fcons(stuff, Vload_force_doc_string_list);
3429 void init_lread(void)
3431 char *stroot = NULL, *btroot = NULL;
3434 load_in_progress = 0;
3436 Vload_descriptor_list = Qnil;
3438 /* kludge: locate-file does not work for a null load-path, even if
3439 the file name is absolute. */
3441 Vload_path = Fcons(build_string(""), Qnil);
3442 /* The following is intended for the build chain only */
3443 if ((stroot = getenv("SOURCE_TREE_ROOT")) && strlen(stroot)) {
3444 Lisp_Object lispsubdir = build_string("lisp");
3445 Lisp_Object strootdir = build_string(stroot);
3446 Lisp_Object stlispdir =
3447 Fexpand_file_name(lispsubdir, strootdir);
3448 Vload_path = Fcons(stlispdir, Vload_path);
3450 if ((btroot = getenv("BUILD_TREE_ROOT")) && strlen(btroot)) {
3451 Lisp_Object lispsubdir = build_string("lisp");
3452 Lisp_Object btrootdir = build_string(btroot);
3453 Lisp_Object btlispdir =
3454 Fexpand_file_name(lispsubdir, btrootdir);
3455 Vload_path = Fcons(btlispdir, Vload_path);
3458 /* This used to get initialized in init_lread because all streams
3459 got closed when dumping occurs. This is no longer true --
3460 Vread_buffer_stream is a resizing output stream, and there is no
3461 reason to close it at dump-time.
3463 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3464 will initialize it only once, at dump-time. */
3465 if (NILP(Vread_buffer_stream))
3466 Vread_buffer_stream = make_resizing_buffer_output_stream();
3468 Vload_force_doc_string_list = Qnil;
3471 void syms_of_lread(void)
3474 DEFSUBR(Fread_from_string);
3475 DEFSUBR(Fload_internal);
3476 DEFSUBR(Flocate_file);
3477 DEFSUBR(Flocate_file_clear_hashing);
3478 DEFSUBR(Feval_buffer);
3479 DEFSUBR(Feval_region);
3481 defsymbol(&Qstandard_input, "standard-input");
3482 defsymbol(&Qread_char, "read-char");
3483 defsymbol(&Qcurrent_load_list, "current-load-list");
3484 defsymbol(&Qload, "load");
3485 defsymbol(&Qload_file_name, "load-file-name");
3486 defsymbol(&Qfset, "fset");
3488 #ifdef LISP_BACKQUOTES
3489 defsymbol(&Qbackquote, "backquote");
3490 defsymbol(&Qbacktick, "`");
3491 defsymbol(&Qcomma, ",");
3492 defsymbol(&Qcomma_at, ",@");
3493 defsymbol(&Qcomma_dot, ",.");
3496 defsymbol(&Qexists, "exists");
3497 defsymbol(&Qreadable, "readable");
3498 defsymbol(&Qwritable, "writable");
3499 defsymbol(&Qexecutable, "executable");
3502 void structure_type_create(void)
3504 the_structure_type_dynarr = Dynarr_new(structure_type);
3507 void reinit_vars_of_lread(void)
3509 Vread_buffer_stream = Qnil;
3510 staticpro_nodump(&Vread_buffer_stream);
3513 void vars_of_lread(void)
3515 reinit_vars_of_lread();
3517 DEFVAR_LISP("values", &Vvalues /*
3518 List of values of all expressions which were read, evaluated and printed.
3519 Order is reverse chronological.
3522 DEFVAR_LISP("standard-input", &Vstandard_input /*
3523 Stream for read to get input from.
3524 See documentation of `read' for possible values.
3526 Vstandard_input = Qt;
3528 DEFVAR_LISP("load-path", &Vload_path /*
3529 *List of directories to search for files to load.
3530 Each element is a string (directory name) or nil (try default directory).
3532 Note that the elements of this list *may not* begin with "~", so you must
3533 call `expand-file-name' on them before adding them to this list.
3535 Initialized based on EMACSLOADPATH environment variable, if any,
3536 otherwise to default specified in by file `paths.h' when SXEmacs was built.
3537 If there were no paths specified in `paths.h', then SXEmacs chooses a default
3538 value for this variable by looking around in the file-system near the
3539 directory in which the SXEmacs executable resides.
3543 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3544 "*Location of lisp files to be used when dumping ONLY."); */
3546 DEFVAR_BOOL("load-in-progress", &load_in_progress /*
3547 Non-nil iff inside of `load'.
3549 DEFVAR_LISP ("load-suppress-alist", &Vload_suppress_alist /*
3550 An alist of expressions controlling whether particular files can be loaded.
3551 Each element looks like (FILENAME EXPR).
3552 FILENAME should be a full pathname, but without the .el suffix.
3553 When `load' is run and is about to load the specified file, it evaluates
3554 the form to determine if the file can be loaded.
3555 This variable is normally initialized automatically.
3557 Vload_suppress_alist = Qnil;
3559 DEFVAR_LISP("after-load-alist", &Vafter_load_alist /*
3560 An alist of expressions to be evalled when particular files are loaded.
3561 Each element looks like (FILENAME FORMS...).
3562 When `load' is run and the file-name argument is FILENAME,
3563 the FORMS in the corresponding element are executed at the end of loading.
3565 FILENAME must match exactly! Normally FILENAME is the name of a library,
3566 with no directory specified, since that is how `load' is normally called.
3567 An error in FORMS does not undo the load,
3568 but does prevent execution of the rest of the FORMS.
3570 Vafter_load_alist = Qnil;
3572 DEFVAR_BOOL("load-warn-when-source-newer", &load_warn_when_source_newer /*
3573 *Whether `load' should check whether the source is newer than the binary.
3574 If this variable is true, then when a `.elc' file is being loaded and the
3575 corresponding `.el' is newer, a warning message will be printed.
3577 load_warn_when_source_newer = 0;
3579 DEFVAR_BOOL("load-warn-when-source-only", &load_warn_when_source_only /*
3580 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3581 If this variable is true, then when `load' is called with a filename without
3582 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3583 then a message will be printed. If an explicit extension is passed to `load',
3584 no warning will be printed.
3586 load_warn_when_source_only = 0;
3588 DEFVAR_BOOL("load-ignore-elc-files", &load_ignore_elc_files /*
3589 *Whether `load' should ignore `.elc' files when a suffix is not given.
3590 This is normally used only to bootstrap the `.elc' files when building SXEmacs.
3592 load_ignore_elc_files = 0;
3595 DEFVAR_LISP("load-history", &Vload_history /*
3596 Alist mapping source file names to symbols and features.
3597 Each alist element is a list that starts with a file name,
3598 except for one element (optional) that starts with nil and describes
3599 definitions evaluated from buffers not visiting files.
3600 The remaining elements of each list are symbols defined as functions
3601 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3603 Vload_history = Qnil;
3605 DEFVAR_LISP("current-load-list", &Vcurrent_load_list /*
3606 Used for internal purposes by `load'.
3608 Vcurrent_load_list = Qnil;
3611 DEFVAR_LISP("load-file-name", &Vload_file_name /*
3612 Full name of file being loaded by `load'.
3614 Vload_file_name = Qnil;
3616 DEFVAR_LISP("load-read-function", &Vload_read_function /*
3617 Function used by `load' and `eval-region' for reading expressions.
3618 The default is nil, which means use the function `read'.
3620 Vload_read_function = Qnil;
3622 DEFVAR_BOOL("load-force-doc-strings", &load_force_doc_strings /*
3623 Non-nil means `load' should force-load all dynamic doc strings.
3624 This is useful when the file being loaded is a temporary copy.
3626 load_force_doc_strings = 0;
3628 /* See read_escape(). */
3630 /* Used to be named `puke-on-fsf-keys' */
3631 DEFVAR_BOOL("fail-on-bucky-bit-character-escapes", &fail_on_bucky_bit_character_escapes /*
3632 Whether `read' should signal an error when it encounters unsupported
3633 character escape syntaxes or just read them incorrectly.
3635 fail_on_bucky_bit_character_escapes = 0;
3638 /* This must be initialized in init_lread otherwise it may start out
3639 with values saved when the image is dumped. */
3640 staticpro(&Vload_descriptor_list);
3642 /* Initialized in init_lread. */
3643 staticpro(&Vload_force_doc_string_list);
3645 Vload_file_name_internal = Qnil;
3646 staticpro(&Vload_file_name_internal);
3648 Vload_file_name_internal_the_purecopy = Qnil;
3649 staticpro(&Vload_file_name_internal_the_purecopy);
3651 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3652 Vcurrent_compiled_function_annotation = Qnil;
3653 staticpro(&Vcurrent_compiled_function_annotation);
3656 /* So that early-early stuff will work */
3657 Ffset(Qload, intern("load-internal"));
3659 #ifdef FEATUREP_SYNTAX
3660 defsymbol(&Qfeaturep, "featurep");
3661 Fprovide(intern("xemacs"));
3662 Fprovide(intern("sxemacs"));
3663 Fprovide(intern("raw-strings"));
3665 Fprovide(intern("infodock"));
3666 #endif /* INFODOCK */
3667 #endif /* FEATUREP_SYNTAX */
3669 #ifdef LISP_BACKQUOTES
3670 old_backquote_flag = new_backquote_flag = 0;
3674 Vfile_domain = Qnil;
3677 Vread_objects = Qnil;
3678 staticpro(&Vread_objects);
3680 Vlocate_file_hash_table = make_lisp_hash_table(200,
3681 HASH_TABLE_NON_WEAK,
3683 staticpro(&Vlocate_file_hash_table);
3684 #ifdef DEBUG_SXEMACS
3686 Lisp_Object tmp = intern("Vlocate-file-hash-table");
3687 symbol_value(XSYMBOL(tmp)) = Vlocate_file_hash_table;
3691 /* User defined readers */
3692 DEFVAR_LISP("ureaders", &Vureaders /*
3693 Alist of user defined readers.
3694 Car is ureader NAME, represented by string to match against when reading
3696 Cdr is user function called with one arg - string.
3697 Function must return lisp object or signal error.
3702 /* lread.c ends here */