1 /* Lisp parsing and input streams.
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems.
4 Copyright (C) 1996 Ben Wing.
6 This file is part of XEmacs.
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 /* Synched up with: Mule 2.0, FSF 19.30. */
25 /* This file has been Mule-ized. */
38 #include "file-coding.h"
43 #ifdef LISP_FLOAT_TYPE
44 #define THIS_FILENAME lread
46 #endif /* LISP_FLOAT_TYPE */
48 Lisp_Object Qread_char, Qstandard_input;
49 Lisp_Object Qvariable_documentation;
50 #define LISP_BACKQUOTES
51 #ifdef LISP_BACKQUOTES
53 Nonzero means inside a new-style backquote
54 with no surrounding parentheses.
55 Fread initializes this to zero, so we need not specbind it
56 or worry about what happens to it when there is an error.
59 Nested backquotes are perfectly legal and fail utterly with
61 static int new_backquote_flag, old_backquote_flag;
62 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
64 Lisp_Object Qvariable_domain; /* I18N3 */
65 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
66 Lisp_Object Qcurrent_load_list;
67 Lisp_Object Qload, Qload_file_name;
68 Lisp_Object Qlocate_file_hash_table;
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 read_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 #if 0 /* More FSF implementation kludges. */
166 /* In order to implement load-force-doc-string, FSF saves the
167 #@-quoted string when it's seen, and goes back and retrieves
170 This approach is not only kludgy, but it in general won't work
171 correctly because there's no stack of remembered #@-quoted-strings
172 and those strings don't generally appear in the file in the same
173 order as their #$ references. (Yes, that is amazingly stupid too.
175 It would be trivially easy to always encode the #@ string
176 [which is a comment, anyway] in the middle of the (#$ . INT) cons
177 reference. That way, it would be really easy to implement
178 load-force-doc-string in a non-kludgy way by just retrieving the
179 string immediately, because it's delivered on a silver platter.)
181 And finally, this stupid approach doesn't work under Mule, or
182 under MS-DOS or Windows NT, or under VMS, or any other place
183 where you either can't do an ftell() or don't get back a byte
186 Oh, and one more lossage in this approach: If you attempt to
187 dump any ELC files that were compiled with `byte-compile-dynamic'
188 (as opposed to just `byte-compile-dynamic-docstring'), you
189 get hosed. FMH! (as the illustrious JWZ was prone to utter)
191 The approach we use is clean, solves all of these problems, and is
192 probably easier to implement anyway. We just save a list of all
193 the containing objects that have (#$ . INT) conses in them (this
194 will only be compiled-function objects and lists), and when the
195 file is finished loading, we go through and fill in all the
196 doc strings at once. */
198 /* This contains the last string skipped with #@. */
199 static char *saved_doc_string;
200 /* Length of buffer allocated in saved_doc_string. */
201 static int saved_doc_string_size;
202 /* Length of actual data in saved_doc_string. */
203 static int saved_doc_string_length;
204 /* This is the file position that string came from. */
205 static int saved_doc_string_position;
208 EXFUN (Fread_from_string, 3);
210 /* When errors are signaled, the actual readcharfun should not be used
211 as an argument if it is an lstream, so that lstreams don't escape
212 to the Lisp level. */
213 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
214 ? (build_string ("internal input stream")) \
219 syntax_error (CONST char *string)
221 signal_error (Qinvalid_read_syntax,
222 list1 (build_translated_string (string)));
226 continuable_syntax_error (CONST char *string)
228 return Fsignal (Qinvalid_read_syntax,
229 list1 (build_translated_string (string)));
233 /* Handle unreading and rereading of characters. */
235 readchar (Lisp_Object readcharfun)
237 /* This function can GC */
239 if (BUFFERP (readcharfun))
242 struct buffer *b = XBUFFER (readcharfun);
244 if (!BUFFER_LIVE_P (b))
245 error ("Reading from killed buffer");
247 if (BUF_PT (b) >= BUF_ZV (b))
249 c = BUF_FETCH_CHAR (b, BUF_PT (b));
250 BUF_SET_PT (b, BUF_PT (b) + 1);
254 else if (LSTREAMP (readcharfun))
256 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
257 #ifdef DEBUG_XEMACS /* testing Mule */
258 static int testing_mule = 0; /* Change via debugger */
260 if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
261 else if (c == '\n') fprintf (stderr, "\\n\n");
262 else fprintf (stderr, "\\%o ", c);
267 else if (MARKERP (readcharfun))
270 Bufpos mpos = marker_position (readcharfun);
271 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
273 if (mpos >= BUF_ZV (inbuffer))
275 c = BUF_FETCH_CHAR (inbuffer, mpos);
276 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. */
293 unreadchar (Lisp_Object readcharfun, Emchar c)
296 /* Don't back up the pointer if we're unreading the end-of-input mark,
297 since readchar didn't advance it when we read it. */
299 else if (BUFFERP (readcharfun))
300 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
301 else if (LSTREAMP (readcharfun))
303 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
304 #ifdef DEBUG_XEMACS /* testing Mule */
306 static int testing_mule = 0; /* Set this using debugger */
309 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
310 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
314 else if (MARKERP (readcharfun))
315 set_marker_position (readcharfun, 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),
348 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
350 Lstream_close (XLSTREAM (stream));
351 if (--load_in_progress < 0)
352 load_in_progress = 0;
357 load_descriptor_unwind (Lisp_Object oldlist)
359 Vload_descriptor_list = oldlist;
364 load_file_name_internal_unwind (Lisp_Object oldval)
366 Vload_file_name_internal = oldval;
371 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
373 Vload_file_name_internal_the_purecopy = oldval;
378 load_byte_code_version_unwind (Lisp_Object oldval)
380 load_byte_code_version = XINT (oldval);
384 /* The plague is coming.
386 Ring around the rosy, pocket full of posy,
387 Ashes ashes, they all fall down.
390 ebolify_bytecode_constants (Lisp_Object vector)
392 int len = XVECTOR_LENGTH (vector);
395 for (i = 0; i < len; i++)
397 Lisp_Object el = XVECTOR_DATA (vector)[i];
399 /* We don't check for `eq', `equal', and the others that have
400 bytecode opcodes. This might lose if someone passes #'eq or
401 something to `funcall', but who would really do that? As
402 they say in law, we've made a "good-faith effort" to
403 unfuckify ourselves. And doing it this way avoids screwing
404 up args to `make-hashtable' and such. As it is, we have to
405 add an extra Ebola check in decode_weak_list_type(). --ben */
411 /* I think this is a bad idea because it will probably mess
413 if (EQ (el, Qdelete))
418 if (EQ (el, Qrassoc))
420 XVECTOR_DATA (vector)[i] = el;
425 pas_de_lache_ici (int fd, Lisp_Object victim)
430 if (!INTP (XCDR (victim)))
431 signal_simple_error ("Bogus doc string reference", victim);
432 pos = XINT (XCDR (victim));
434 pos = -pos; /* kludge to mark a user variable */
435 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
437 signal_error (Qerror, tem);
442 load_force_doc_string_unwind (Lisp_Object oldlist)
445 Lisp_Object list = Vload_force_doc_string_list;
447 int fd = XINT (XCAR (Vload_descriptor_list));
448 /* NOTE: If purify_flag is true, we're in-place modifying objects that
449 may be in purespace (and if not, they will be). Therefore, we have
450 to be VERY careful to make sure that all objects that we create
451 are purecopied -- objects in purespace are not marked for GC, and
452 if we leave any impure objects inside of pure ones, we're really
456 /* restore the old value first just in case an error occurs. */
457 Vload_force_doc_string_list = oldlist;
459 LIST_LOOP (tail, list)
461 Lisp_Object john = Fcar (tail);
464 assert (CONSP (XCAR (john)));
465 assert (!purify_flag); /* should have been handled in read_list() */
466 XCAR (john) = pas_de_lache_ici (fd, XCAR (john));
472 assert (COMPILED_FUNCTIONP (john));
473 if (CONSP (XCOMPILED_FUNCTION (john)->bytecodes))
475 struct gcpro ngcpro1;
476 Lisp_Object juan = (pas_de_lache_ici
477 (fd, XCOMPILED_FUNCTION (john)->bytecodes));
483 signal_simple_error ("invalid lazy-loaded byte code", ivan);
484 /* Remember to purecopy; see above. */
485 XCOMPILED_FUNCTION (john)->bytecodes = Fpurecopy (XCAR (ivan));
486 /* v18 or v19 bytecode file. Need to Ebolify. */
487 if (XCOMPILED_FUNCTION (john)->flags.ebolified
488 && VECTORP (XCDR (ivan)))
489 ebolify_bytecode_constants (XCDR (ivan));
490 XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
493 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
496 assert (!purify_flag); /* should have been handled in
497 read_compiled_function() */
498 doc = pas_de_lache_ici (fd, doc);
499 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
512 /* Close all descriptors in use for Fload_internal.
513 This is used when starting a subprocess. */
516 close_load_descs (void)
519 LIST_LOOP (tail, Vload_descriptor_list)
520 close (XINT (XCAR (tail)));
524 Lisp_Object Vfile_domain;
527 restore_file_domain (Lisp_Object val)
534 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
535 Execute a file of Lisp code named FILE; no coding-system frobbing.
536 This function is identical to `load' except for the handling of the
537 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
538 support is not present, both functions are identical and ignore the
539 CODESYS and USED-CODESYS arguments.)
541 If support for Mule exists in this Emacs, the file is decoded
542 according to CODESYS; if omitted, no conversion happens. If
543 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
544 system that was used for the decoding is stored into it. It will in
545 general be different from CODESYS if CODESYS specifies automatic
546 encoding detection or end-of-line detection.
548 (file, no_error, nomessage, nosuffix, codesys, used_codesys))
550 /* This function can GC */
552 int speccount = specpdl_depth ();
554 Lisp_Object newer = Qnil;
555 Lisp_Object handler = Qnil;
556 Lisp_Object found = Qnil;
557 struct gcpro gcpro1, gcpro2, gcpro3;
559 int message_p = NILP (nomessage);
560 /*#ifdef DEBUG_XEMACS*/
561 static Lisp_Object last_file_loaded;
562 size_t pure_usage = 0;
565 GCPRO3 (file, newer, found);
569 /*#ifdef DEBUG_XEMACS*/
570 if (purify_flag && noninteractive)
573 last_file_loaded = file;
574 pure_usage = purespace_usage ();
576 /*#endif / * DEBUG_XEMACS */
578 /* If file name is magic, call the handler. */
579 handler = Ffind_file_name_handler (file, Qload);
581 RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
582 nomessage, nosuffix));
584 /* Do this after the handler to avoid
585 the need to gcpro noerror, nomessage and nosuffix.
586 (Below here, we care only whether they are nil or not.) */
587 file = Fsubstitute_in_file_name (file);
589 if (!NILP (used_codesys))
590 CHECK_SYMBOL (used_codesys);
593 /* Avoid weird lossage with null string as arg,
594 since it would try to load a directory as a Lisp file.
596 if (XSTRING_LENGTH (file) > 0)
601 fd = locate_file (Vload_path, file,
602 ((!NILP (nosuffix)) ? "" :
603 load_ignore_elc_files ? ".el:" :
611 signal_file_error ("Cannot open load file", file);
619 foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
620 strcpy (foundstr, (char *) XSTRING_DATA (found));
621 foundlen = strlen (foundstr);
623 /* The omniscient JWZ thinks this is worthless, but I beg to
625 if (load_ignore_elc_files)
627 newer = Ffile_name_nondirectory (found);
629 else if (load_warn_when_source_newer &&
630 !memcmp (".elc", foundstr + foundlen - 4, 4))
632 if (! fstat (fd, &s1)) /* can't fail, right? */
635 /* temporarily hack the 'c' off the end of the filename */
636 foundstr[foundlen - 1] = '\0';
637 result = stat (foundstr, &s2);
639 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
641 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
643 struct gcpro nngcpro1;
644 NNGCPRO1 (newer_name);
645 newer = Ffile_name_nondirectory (newer_name);
648 /* put the 'c' back on (kludge-o-rama) */
649 foundstr[foundlen - 1] = 'c';
652 else if (load_warn_when_source_only &&
653 /* `found' ends in ".el" */
654 !memcmp (".el", foundstr + foundlen - 3, 3) &&
655 /* `file' does not end in ".el" */
657 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
663 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
667 #define PRINT_LOADING_MESSAGE(done) do { \
668 if (load_ignore_elc_files) \
671 message ("Loading %s..." done, XSTRING_DATA (newer)); \
673 else if (!NILP (newer)) \
674 message ("Loading %s..." done " (file %s is newer)", \
675 XSTRING_DATA (file), \
676 XSTRING_DATA (newer)); \
677 else if (source_only) \
678 message ("Loading %s..." done " (file %s.elc does not exist)", \
679 XSTRING_DATA (file), \
680 XSTRING_DATA (Ffile_name_nondirectory (file))); \
681 else if (message_p) \
682 message ("Loading %s..." done, XSTRING_DATA (file)); \
685 PRINT_LOADING_MESSAGE ("");
688 /* Lisp_Object's must be malloc'ed, not stack-allocated */
689 Lisp_Object lispstream = Qnil;
690 CONST int block_size = 8192;
691 struct gcpro ngcpro1;
693 NGCPRO1 (lispstream);
694 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
695 /* 64K is used for normal files; 8K should be OK here because Lisp
696 files aren't really all that big. */
697 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
700 lispstream = make_decoding_input_stream
701 (XLSTREAM (lispstream), Fget_coding_system (codesys));
702 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
705 /* NOTE: Order of these is very important. Don't rearrange them. */
706 record_unwind_protect (load_unwind, lispstream);
707 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
708 record_unwind_protect (load_file_name_internal_unwind,
709 Vload_file_name_internal);
710 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
711 Vload_file_name_internal_the_purecopy);
712 record_unwind_protect (load_force_doc_string_unwind,
713 Vload_force_doc_string_list);
714 Vload_file_name_internal = found;
715 Vload_file_name_internal_the_purecopy = Qnil;
716 specbind (Qload_file_name, found);
717 Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
718 Vload_force_doc_string_list = Qnil;
720 record_unwind_protect (restore_file_domain, Vfile_domain);
721 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
725 /* Now determine what sort of ELC file we're reading in. */
726 record_unwind_protect (load_byte_code_version_unwind,
727 make_int (load_byte_code_version));
733 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
735 || strncmp (elc_header, ";ELC", 4))
737 /* Huh? Probably not a valid ELC file. */
738 load_byte_code_version = 100; /* no Ebolification needed */
739 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
742 load_byte_code_version = elc_header[4];
745 load_byte_code_version = 100; /* no Ebolification needed */
747 readevalloop (lispstream, file, Feval, 0);
749 if (!NILP (used_codesys))
752 (decoding_stream_coding_system (XLSTREAM (lispstream))));
754 unbind_to (speccount, Qnil);
761 /* #### Disgusting kludge */
762 /* Run any load-hooks for this file. */
763 /* #### An even more disgusting kludge. There is horrible code */
764 /* that is relying on the fact that dumped lisp files are found */
765 /* via `load-path' search. */
766 Lisp_Object name = file;
768 if (!NILP(Ffile_name_absolute_p(file)))
770 name = Ffile_name_nondirectory(file);
774 struct gcpro ngcpro1;
777 tem = Fassoc (name, Vafter_load_alist);
782 struct gcpro ngcpro1;
785 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
786 tem = Fcons (Qprogn, Fcdr (tem));
792 /*#ifdef DEBUG_XEMACS*/
793 if (purify_flag && noninteractive)
795 if (EQ (last_file_loaded, file))
796 message_append (" (%ld)",
797 (unsigned long) (purespace_usage() - pure_usage));
799 message ("Loading %s ...done (%ld)", XSTRING_DATA (file),
800 (unsigned long) (purespace_usage() - pure_usage));
802 /*#endif / * DEBUG_XEMACS */
805 PRINT_LOADING_MESSAGE ("done");
815 complete_filename_p (Lisp_Object pathname)
817 REGISTER unsigned char *s = XSTRING_DATA (pathname);
818 return (IS_DIRECTORY_SEP (s[0])
819 || (XSTRING_LENGTH (pathname) > 2
820 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
828 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
829 Search for FILENAME through PATH-LIST, expanded by one of the optional
830 SUFFIXES (string of suffixes separated by ":"s), checking for access
831 MODE (0|1|2|4 = exists|executable|writeable|readable), default readable.
833 `locate-file' keeps hash tables of the directories it searches through,
834 in order to speed things up. It tries valiantly to not get confused in
835 the face of a changing and unpredictable environment, but can occasionally
836 get tripped up. In this case, you will have to call
837 `locate-file-clear-hashing' to get it back on track. See that function
840 (filename, path_list, suffixes, mode))
842 /* This function can GC */
845 CHECK_STRING (filename);
846 if (!NILP (suffixes))
847 CHECK_STRING (suffixes);
851 locate_file (path_list, filename,
852 ((NILP (suffixes)) ? "" :
853 (char *) (XSTRING_DATA (suffixes))),
854 &tp, (NILP (mode) ? R_OK : XINT (mode)));
858 /* recalculate the hash table for the given string */
861 locate_file_refresh_hashing (Lisp_Object str)
864 make_directory_hash_table ((char *) XSTRING_DATA (str));
865 Fput (str, Qlocate_file_hash_table, hash);
869 /* find the hash table for the given string, recalculating if necessary */
872 locate_file_find_directory_hash_table (Lisp_Object str)
874 Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
875 if (NILP (Fhashtablep (hash)))
876 return locate_file_refresh_hashing (str);
880 /* look for STR in PATH, optionally adding suffixes in SUFFIX */
883 locate_file_in_directory (Lisp_Object path, Lisp_Object str,
884 CONST char *suffix, Lisp_Object *storeptr,
887 /* This function can GC */
894 Lisp_Object filename = Qnil;
895 struct gcpro gcpro1, gcpro2, gcpro3;
898 GCPRO3 (path, str, filename);
900 filename = Fexpand_file_name (str, path);
901 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
902 /* If there are non-absolute elts in PATH (eg ".") */
903 /* Of course, this could conceivably lose if luser sets
904 default-directory to be something non-absolute ... */
907 /* NIL means current dirctory */
908 filename = current_buffer->directory;
910 filename = Fexpand_file_name (filename,
911 current_buffer->directory);
912 if (NILP (Ffile_name_absolute_p (filename)))
914 /* Give up on this path element! */
919 /* Calculate maximum size of any filename made from
920 this path element/specified file name and any possible suffix. */
921 want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1;
922 if (fn_size < want_size)
923 fn = (char *) alloca (fn_size = 100 + want_size);
927 /* Loop over suffixes. */
930 char *esuffix = (char *) strchr (nsuffix, ':');
931 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
933 /* Concatenate path element/specified name with the suffix. */
934 strncpy (fn, (char *) XSTRING_DATA (filename),
935 XSTRING_LENGTH (filename));
936 fn[XSTRING_LENGTH (filename)] = 0;
937 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
938 strncat (fn, nsuffix, lsuffix);
940 /* Ignore file if it's a directory. */
941 if (stat (fn, &st) >= 0
942 && (st.st_mode & S_IFMT) != S_IFDIR)
944 /* Check that we can access or open it. */
946 fd = access (fn, mode);
948 fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
952 /* We succeeded; return this descriptor and filename. */
954 *storeptr = build_string (fn);
958 /* If we actually opened the file, set close-on-exec flag
959 on the new descriptor so that subprocesses can't whack
962 (void) fcntl (fd, F_SETFD, FD_CLOEXEC);
969 /* Advance to next suffix. */
972 nsuffix += lsuffix + 1;
979 /* do the same as locate_file() but don't use any hash tables. */
982 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
983 CONST char *suffix, Lisp_Object *storeptr,
986 /* This function can GC */
990 /* is this necessary? */
993 absolute = !NILP (Ffile_name_absolute_p (str));
995 for (; !NILP (path); path = Fcdr (path))
997 int val = locate_file_in_directory (Fcar (path), str, suffix,
1012 /* Construct a list of all files to search for. */
1015 locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
1021 CONST char *nsuffix;
1022 Lisp_Object suffixtab = Qnil;
1024 /* Calculate maximum size of any filename made from
1025 this path element/specified file name and any possible suffix. */
1026 want_size = strlen (suffix) + XSTRING_LENGTH (str) + 1;
1027 if (fn_size < want_size)
1028 fn = (char *) alloca (fn_size = 100 + want_size);
1034 char *esuffix = (char *) strchr (nsuffix, ':');
1035 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
1037 /* Concatenate path element/specified name with the suffix. */
1038 strncpy (fn, (char *) XSTRING_DATA (str), XSTRING_LENGTH (str));
1039 fn[XSTRING_LENGTH (str)] = 0;
1040 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
1041 strncat (fn, nsuffix, lsuffix);
1043 suffixtab = Fcons (build_string (fn), suffixtab);
1044 /* Advance to next suffix. */
1047 nsuffix += lsuffix + 1;
1049 return Fnreverse (suffixtab);
1052 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1053 Clear the hash records for the specified list of directories.
1054 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1055 track the following environmental changes:
1057 -- changes of any sort to the list of directories to be searched.
1058 -- addition and deletion of non-shadowing files (see below) from the
1059 directories in the list.
1060 -- byte-compilation of a .el file into a .elc file.
1062 `locate-file' will primarily get confused if you add a file that shadows
1063 \(i.e. has the same name as) another file further down in the directory list.
1064 In this case, you must call `locate-file-clear-hashing'.
1068 Lisp_Object pathtail;
1070 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
1072 Lisp_Object pathel = Fcar (pathtail);
1073 if (!purified (pathel))
1074 Fput (pathel, Qlocate_file_hash_table, Qnil);
1079 /* Search for a file whose name is STR, looking in directories
1080 in the Lisp list PATH, and trying suffixes from SUFFIX.
1081 SUFFIX is a string containing possible suffixes separated by colons.
1082 On success, returns a file descriptor. On failure, returns -1.
1084 MODE nonnegative means don't open the files,
1085 just look for one for which access(file,MODE) succeeds. In this case,
1086 returns 1 on success.
1088 If STOREPTR is nonzero, it points to a slot where the name of
1089 the file actually found should be stored as a Lisp string.
1090 Nil is stored there on failure.
1092 Called openp() in FSFmacs. */
1095 locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix,
1096 Lisp_Object *storeptr, int mode)
1098 /* This function can GC */
1099 Lisp_Object suffixtab = Qnil;
1100 Lisp_Object pathtail;
1102 struct gcpro gcpro1, gcpro2, gcpro3;
1107 /* if this filename has directory components, it's too complicated
1108 to try and use the hash tables. */
1109 if (!NILP (Ffile_name_directory (str)))
1110 return locate_file_without_hash (path, str, suffix, storeptr,
1113 /* Is it really necessary to gcpro path and str? It shouldn't be
1114 unless some caller has fucked up. */
1115 GCPRO3 (path, str, suffixtab);
1117 suffixtab = locate_file_construct_suffixed_files (str, suffix);
1119 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
1121 Lisp_Object pathel = Fcar (pathtail);
1122 Lisp_Object hashtab;
1126 /* If this path element is relative, we have to look by hand.
1127 Can't set string property in a pure string. */
1128 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)) ||
1131 val = locate_file_in_directory (pathel, str, suffix, storeptr,
1141 hashtab = locate_file_find_directory_hash_table (pathel);
1143 /* Loop over suffixes. */
1144 for (tail = suffixtab, found = 0; !found && CONSP (tail);
1147 if (!NILP (Fgethash (XCAR (tail), hashtab, Qnil)))
1153 /* This is a likely candidate. Look by hand in this directory
1154 so we don't get thrown off if someone byte-compiles a file. */
1155 val = locate_file_in_directory (pathel, str, suffix, storeptr,
1163 /* Hmm ... the file isn't actually there. (Or possibly it's
1164 a directory ...) So refresh our hashing. */
1165 locate_file_refresh_hashing (pathel);
1169 /* File is probably not there, but check the hard way just in case. */
1170 val = locate_file_without_hash (path, str, suffix, storeptr,
1174 /* Sneaky user added a file without telling us. */
1175 Flocate_file_clear_hashing (path);
1185 /* Merge the list we've accumulated of globals from the current input source
1186 into the load_history variable. The details depend on whether
1187 the source has an associated file name or not. */
1190 build_load_history (int loading, Lisp_Object source)
1192 REGISTER Lisp_Object tail, prev, newelt;
1193 REGISTER Lisp_Object tem, tem2;
1196 #if !defined(LOADHIST_DUMPED)
1197 /* Don't bother recording anything for preloaded files. */
1202 tail = Vload_history;
1205 while (!NILP (tail))
1209 /* Find the feature's previous assoc list... */
1210 if (internal_equal (source, Fcar (tem), 0))
1214 /* If we're loading, remove it. */
1218 Vload_history = Fcdr (tail);
1220 Fsetcdr (prev, Fcdr (tail));
1223 /* Otherwise, cons on new symbols that are not already members. */
1226 tem2 = Vcurrent_load_list;
1228 while (CONSP (tem2))
1230 newelt = XCAR (tem2);
1232 if (NILP (Fmemq (newelt, tem)))
1233 Fsetcar (tail, Fcons (Fcar (tem),
1234 Fcons (newelt, Fcdr (tem))));
1247 /* If we're loading, cons the new assoc onto the front of load-history,
1248 the most-recently-loaded position. Also do this if we didn't find
1249 an existing member for the current source. */
1250 if (loading || !foundit)
1251 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1255 #else /* !LOADHIST */
1256 #define build_load_history(x,y)
1257 #endif /* !LOADHIST */
1260 #if 0 /* FSFmacs defun hack */
1262 unreadpure (void) /* Used as unwind-protect function in readevalloop */
1270 readevalloop (Lisp_Object readcharfun,
1271 Lisp_Object sourcename,
1272 Lisp_Object (*evalfun) (Lisp_Object),
1275 /* This function can GC */
1277 REGISTER Lisp_Object val;
1278 int speccount = specpdl_depth ();
1279 struct gcpro gcpro1;
1280 struct buffer *b = 0;
1282 if (BUFFERP (readcharfun))
1283 b = XBUFFER (readcharfun);
1284 else if (MARKERP (readcharfun))
1285 b = XMARKER (readcharfun)->buffer;
1287 /* Don't do this. It is not necessary, and it needlessly exposes
1288 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1289 /*specbind (Qstandard_input, readcharfun);*/
1291 specbind (Qcurrent_load_list, Qnil);
1293 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1294 Vcurrent_compiled_function_annotation = Qnil;
1296 GCPRO1 (sourcename);
1298 LOADHIST_ATTACH (sourcename);
1304 if (b != 0 && !BUFFER_LIVE_P (b))
1305 error ("Reading from killed buffer");
1307 c = readchar (readcharfun);
1311 while ((c = readchar (readcharfun)) != '\n' && c != -1)
1318 /* Ignore whitespace here, so we can detect eof. */
1319 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1322 #if 0 /* FSFmacs defun hack */
1323 if (purify_flag && c == '(')
1325 int count1 = specpdl_depth ();
1326 record_unwind_protect (unreadpure, Qnil);
1327 val = read_list (readcharfun, ')', -1, 1);
1328 unbind_to (count1, Qnil);
1331 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1333 unreadchar (readcharfun, c);
1334 read_objects = Qnil;
1335 if (NILP (Vload_read_function))
1336 val = read0 (readcharfun);
1338 val = call1 (Vload_read_function, readcharfun);
1341 val = (*evalfun) (val);
1344 Vvalues = Fcons (val, Vvalues);
1345 if (EQ (Vstandard_output, Qt))
1352 build_load_history (LSTREAMP (readcharfun) ||
1353 /* This looks weird, but it's what's in FSFmacs */
1354 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
1358 unbind_to (speccount, Qnil);
1361 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1362 Execute BUFFER as Lisp code.
1363 Programs can pass two arguments, BUFFER and PRINTFLAG.
1364 BUFFER is the buffer to evaluate (nil means use current buffer).
1365 PRINTFLAG controls printing of output:
1366 nil means discard it; anything else is stream for print.
1368 If there is no error, point does not move. If there is an error,
1369 point remains at the end of the last character read from the buffer.
1370 Execute BUFFER as Lisp code.
1372 (bufname, printflag))
1374 /* This function can GC */
1375 int speccount = specpdl_depth ();
1376 Lisp_Object tem, buf;
1379 buf = Fcurrent_buffer ();
1381 buf = Fget_buffer (bufname);
1383 error ("No such buffer.");
1385 if (NILP (printflag))
1386 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1389 specbind (Qstandard_output, tem);
1390 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1391 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1392 readevalloop (buf, XBUFFER (buf)->filename, Feval,
1395 return unbind_to (speccount, Qnil);
1399 xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1400 Execute the current buffer as Lisp code.
1401 Programs can pass argument PRINTFLAG which controls printing of output:
1402 nil means discard it; anything else is stream for print.
1404 If there is no error, point does not move. If there is an error,
1405 point remains at the end of the last character read from the buffer.
1413 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
1414 Execute the region as Lisp code.
1415 When called from programs, expects two arguments,
1416 giving starting and ending indices in the current buffer
1417 of the text to be executed.
1418 Programs can pass third argument PRINTFLAG which controls output:
1419 nil means discard it; anything else is stream for printing it.
1421 If there is no error, point does not move. If there is an error,
1422 point remains at the end of the last character read from the buffer.
1424 Note: Before evaling the region, this function narrows the buffer to it.
1425 If the code being eval'd should happen to trigger a redisplay you may
1426 see some text temporarily disappear because of this.
1430 /* This function can GC */
1431 int speccount = specpdl_depth ();
1433 Lisp_Object cbuf = Fcurrent_buffer ();
1435 if (NILP (printflag))
1436 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1439 specbind (Qstandard_output, tem);
1441 if (NILP (printflag))
1442 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1443 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1445 /* This both uses b and checks its type. */
1446 Fgoto_char (b, cbuf);
1447 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
1448 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
1451 return unbind_to (speccount, Qnil);
1454 DEFUN ("read", Fread, 0, 1, 0, /*
1455 Read one Lisp expression as text from STREAM, return as Lisp object.
1456 If STREAM is nil, use the value of `standard-input' (which see).
1457 STREAM or the value of `standard-input' may be:
1458 a buffer (read from point and advance it)
1459 a marker (read from where it points and advance it)
1460 a function (call it with no arguments for each character,
1461 call it with a char as argument to push a char back)
1462 a string (takes text from string, starting at the beginning)
1463 t (read text line using minibuffer and use it).
1468 stream = Vstandard_input;
1469 if (EQ (stream, Qt))
1470 stream = Qread_char;
1472 read_objects = Qnil;
1474 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1475 Vcurrent_compiled_function_annotation = Qnil;
1477 if (EQ (stream, Qread_char))
1479 Lisp_Object val = call1 (Qread_from_minibuffer,
1480 build_translated_string ("Lisp expression: "));
1481 return Fcar (Fread_from_string (val, Qnil, Qnil));
1484 if (STRINGP (stream))
1485 return Fcar (Fread_from_string (stream, Qnil, Qnil));
1487 return read0 (stream);
1490 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
1491 Read one Lisp expression which is represented as text by STRING.
1492 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1493 START and END optionally delimit a substring of STRING from which to read;
1494 they default to 0 and (length STRING) respectively.
1496 (string, start, end))
1498 Bytecount startval, endval;
1500 Lisp_Object lispstream = Qnil;
1501 struct gcpro gcpro1;
1503 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1504 Vcurrent_compiled_function_annotation = Qnil;
1506 GCPRO1 (lispstream);
1507 CHECK_STRING (string);
1508 get_string_range_byte (string, start, end, &startval, &endval,
1509 GB_HISTORICAL_STRING_BEHAVIOR);
1510 lispstream = make_lisp_string_input_stream (string, startval,
1513 read_objects = Qnil;
1515 tem = read0 (lispstream);
1516 /* Yeah, it's ugly. Gonna make something of it?
1517 At least our reader is reentrant ... */
1519 (Fcons (tem, make_int
1520 (bytecount_to_charcount
1521 (XSTRING_DATA (string),
1522 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
1523 Lstream_delete (XLSTREAM (lispstream));
1529 #ifdef LISP_BACKQUOTES
1532 backquote_unwind (Lisp_Object ptr)
1533 { /* used as unwind-protect function in read0() */
1534 int *counter = (int *) get_opaque_ptr (ptr);
1537 free_opaque_ptr (ptr);
1543 /* Use this for recursive reads, in contexts where internal tokens
1544 are not allowed. See also read1(). */
1546 read0 (Lisp_Object readcharfun)
1550 val = read1 (readcharfun);
1551 if (CONSP (val) && UNBOUNDP (XCAR (val)))
1553 Emchar c = XCHAR (XCDR (val));
1554 free_cons (XCONS (val));
1555 return Fsignal (Qinvalid_read_syntax,
1556 list1 (Fchar_to_string (make_char (c))));
1563 read_escape (Lisp_Object readcharfun)
1565 /* This function can GC */
1566 Emchar c = readchar (readcharfun);
1569 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1573 case 'a': return '\007';
1574 case 'b': return '\b';
1575 case 'd': return 0177;
1576 case 'e': return 033;
1577 case 'f': return '\f';
1578 case 'n': return '\n';
1579 case 'r': return '\r';
1580 case 't': return '\t';
1581 case 'v': return '\v';
1582 case '\n': return -1;
1585 c = readchar (readcharfun);
1587 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1589 error ("Invalid escape character syntax");
1590 c = readchar (readcharfun);
1592 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1594 c = read_escape (readcharfun);
1597 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1598 compatibility by defining character "modifiers" alt, super,
1599 hyper and shift to infest the characters (i.e. integers).
1601 However, this doesn't cut it for XEmacs 20, which
1602 distinguishes characters from integers. Without Mule, ?\H-a
1603 simply returns ?a because every character is clipped into
1604 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1605 produces an illegal character, and moves us to crash-land.
1607 For these reasons, FSF_KEYS hack is useless and without hope
1608 of ever working under XEmacs 20. */
1612 #define alt_modifier (0x040000)
1613 #define super_modifier (0x080000)
1614 #define hyper_modifier (0x100000)
1615 #define shift_modifier (0x200000)
1616 /* fsf uses a different modifiers for meta and control. Possibly
1617 byte_compiled code will still work fsfmacs, though... --Stig
1619 #define ctl_modifier (0x400000)
1620 #define meta_modifier (0x800000)
1622 #define FSF_LOSSAGE(mask) \
1623 if (fail_on_bucky_bit_character_escapes || \
1624 ((c = readchar (readcharfun)) != '-')) \
1625 error ("Invalid escape character syntax"); \
1626 c = readchar (readcharfun); \
1628 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1630 c = read_escape (readcharfun); \
1633 case 'S': FSF_LOSSAGE (shift_modifier);
1634 case 'H': FSF_LOSSAGE (hyper_modifier);
1635 case 'A': FSF_LOSSAGE (alt_modifier);
1636 case 's': FSF_LOSSAGE (super_modifier);
1638 #undef super_modifier
1639 #undef hyper_modifier
1640 #undef shift_modifier
1643 #endif /* FSF_KEYS */
1646 c = readchar (readcharfun);
1648 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1650 error ("Invalid escape character syntax");
1652 c = readchar (readcharfun);
1654 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1656 c = read_escape (readcharfun);
1657 /* FSFmacs junk for non-ASCII controls.
1662 return c & (0200 | 037);
1672 /* An octal escape, as in ANSI C. */
1674 REGISTER Emchar i = c - '0';
1675 REGISTER int count = 0;
1678 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
1679 i = (i << 3) + (c - '0');
1682 unreadchar (readcharfun, c);
1690 /* A hex escape, as in ANSI C. */
1692 REGISTER Emchar i = 0;
1695 c = readchar (readcharfun);
1696 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1697 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1698 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1699 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1702 unreadchar (readcharfun, c);
1710 /* #### need some way of reading an extended character with
1711 an escape sequence. */
1721 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1723 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1725 /* This function can GC */
1726 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
1727 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
1729 *saw_a_backslash = 0;
1731 while (c > 040 /* #### - comma should be here as should backquote */
1732 && !(c == '\"' || c == '\'' || c == ';'
1733 || c == '(' || c == ')'
1734 #ifndef LISP_FLOAT_TYPE
1735 /* If we have floating-point support, then we need
1736 to allow <digits><dot><digits>. */
1738 #endif /* not LISP_FLOAT_TYPE */
1739 || c == '[' || c == ']' || c == '#'
1744 c = readchar (readcharfun);
1746 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1747 *saw_a_backslash = 1;
1749 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
1751 c = readchar (readcharfun);
1755 unreadchar (readcharfun, c);
1756 /* blasted terminating 0 */
1757 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
1758 Lstream_flush (XLSTREAM (Vread_buffer_stream));
1760 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
1763 static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
1766 read_atom (Lisp_Object readcharfun,
1768 int uninterned_symbol)
1770 /* This function can GC */
1771 int saw_a_backslash;
1772 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
1773 char *read_ptr = (char *)
1774 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
1776 /* Is it an integer? */
1777 if (! (saw_a_backslash || uninterned_symbol))
1779 /* If a token had any backslashes in it, it is disqualified from
1780 being an integer or a float. This means that 123\456 is a
1781 symbol, as is \123 (which is the way (intern "123") prints).
1782 Also, if token was preceded by #:, it's always a symbol.
1784 char *p = read_ptr + len;
1785 char *p1 = read_ptr;
1787 if (*p1 == '+' || *p1 == '-') p1++;
1792 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1794 #ifdef LISP_FLOAT_TYPE
1795 /* Integers can have trailing decimal points. */
1796 if (p1 > read_ptr && p1 < p && *p1 == '.')
1801 /* It is an integer. */
1802 #ifdef LISP_FLOAT_TYPE
1809 if (sizeof (int) == sizeof (EMACS_INT))
1810 number = atoi (read_buffer);
1811 else if (sizeof (long) == sizeof (EMACS_INT))
1812 number = atol (read_buffer);
1815 return make_int (number);
1818 return parse_integer ((Bufbyte *) read_ptr, len, 10);
1822 #ifdef LISP_FLOAT_TYPE
1823 if (isfloat_string (read_ptr))
1824 return make_float (atof (read_ptr));
1830 if (uninterned_symbol)
1831 sym = (Fmake_symbol ((purify_flag)
1832 ? make_pure_pname ((Bufbyte *) read_ptr, len, 0)
1833 : make_string ((Bufbyte *) read_ptr, len)));
1836 /* intern will purecopy pname if necessary */
1837 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
1838 sym = Fintern (name, Qnil);
1840 if (SYMBOL_IS_KEYWORD (sym))
1842 /* the LISP way is to put keywords in their own package,
1843 but we don't have packages, so we do something simpler.
1844 Someday, maybe we'll have packages and then this will
1845 be reworked. --Stig. */
1846 XSYMBOL (sym)->value = sym;
1855 parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
1857 CONST Bufbyte *lim = buf + len;
1858 CONST Bufbyte *p = buf;
1860 int negativland = 0;
1875 for (; (p < lim) && (*p != '\0'); p++)
1882 else if (isupper (c))
1884 else if (islower (c))
1889 if (c < 0 || c >= base)
1893 num = num * base + c;
1899 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
1900 Lisp_Object result = make_int (int_result);
1901 if (num && ((XINT (result) < 0) != negativland))
1903 if (XINT (result) != int_result)
1908 return Fsignal (Qinvalid_read_syntax,
1909 list3 (build_translated_string
1910 ("Integer constant overflow in reader"),
1911 make_string (buf, len),
1914 return Fsignal (Qinvalid_read_syntax,
1915 list3 (build_translated_string
1916 ("Invalid integer constant in reader"),
1917 make_string (buf, len),
1923 read_integer (Lisp_Object readcharfun, int base)
1925 /* This function can GC */
1926 int saw_a_backslash;
1927 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
1928 return (parse_integer
1929 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
1931 ? 0 /* make parse_integer signal error */
1937 read_bit_vector (Lisp_Object readcharfun)
1939 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
1944 c = readchar (readcharfun);
1945 if (c != '0' && c != '1')
1947 Dynarr_add (dyn, (unsigned char) (c - '0'));
1951 unreadchar (readcharfun, c);
1953 return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
1954 Dynarr_length (dyn));
1961 struct structure_type *
1962 define_structure_type (Lisp_Object type,
1963 int (*validate) (Lisp_Object data,
1964 Error_behavior errb),
1965 Lisp_Object (*instantiate) (Lisp_Object data))
1967 struct structure_type st;
1970 st.keywords = Dynarr_new (structure_keyword_entry);
1971 st.validate = validate;
1972 st.instantiate = instantiate;
1973 Dynarr_add (the_structure_type_dynarr, st);
1975 return Dynarr_atp (the_structure_type_dynarr,
1976 Dynarr_length (the_structure_type_dynarr) - 1);
1980 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
1981 int (*validate) (Lisp_Object keyword,
1983 Error_behavior errb))
1985 struct structure_keyword_entry en;
1987 en.keyword = keyword;
1988 en.validate = validate;
1989 Dynarr_add (st->keywords, en);
1992 static struct structure_type *
1993 recognized_structure_type (Lisp_Object type)
1997 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
1999 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
2000 if (EQ (st->type, type))
2008 read_structure (Lisp_Object readcharfun)
2010 Emchar c = readchar (readcharfun);
2011 Lisp_Object list = Qnil;
2012 Lisp_Object orig_list = Qnil;
2013 Lisp_Object already_seen = Qnil;
2015 struct structure_type *st;
2016 struct gcpro gcpro1, gcpro2;
2018 GCPRO2 (orig_list, already_seen);
2020 RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
2021 list = read_list (readcharfun, ')', 0, 0);
2024 int len = XINT (Flength (list));
2026 RETURN_UNGCPRO (continuable_syntax_error
2027 ("structure type not specified"));
2030 (continuable_syntax_error
2031 ("structures must have alternating keyword/value pairs"));
2034 st = recognized_structure_type (XCAR (list));
2036 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2037 list2 (build_translated_string
2038 ("unrecognized structure type"),
2042 keyword_count = Dynarr_length (st->keywords);
2043 while (!NILP (list))
2045 Lisp_Object keyword, value;
2047 struct structure_keyword_entry *en = NULL;
2049 keyword = Fcar (list);
2051 value = Fcar (list);
2054 if (!NILP (memq_no_quit (keyword, already_seen)))
2055 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2056 list2 (build_translated_string
2057 ("structure keyword already seen"),
2060 for (i = 0; i < keyword_count; i++)
2062 en = Dynarr_atp (st->keywords, i);
2063 if (EQ (keyword, en->keyword))
2067 if (i == keyword_count)
2068 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2069 list2 (build_translated_string
2070 ("unrecognized structure keyword"),
2073 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
2075 (Fsignal (Qinvalid_read_syntax,
2076 list3 (build_translated_string
2077 ("invalid value for structure keyword"),
2080 already_seen = Fcons (keyword, already_seen);
2083 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
2084 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2085 list2 (build_translated_string
2086 ("invalid structure initializer"),
2089 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
2093 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
2095 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
2097 /* Get the next character; filter out whitespace and comments */
2100 reader_nextchar (Lisp_Object readcharfun)
2102 /* This function can GC */
2107 c = readchar (readcharfun);
2109 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2115 /* Ignore whitespace and control characters */
2124 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
2133 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
2135 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
2139 /* Read the next Lisp object from the stream READCHARFUN and return it.
2140 If the return value is a cons whose car is Qunbound, then read1()
2141 encountered a misplaced token (e.g. a right bracket, right paren,
2142 or dot followed by a non-number). To filter this stuff out,
2146 read1 (Lisp_Object readcharfun)
2151 c = reader_nextchar (readcharfun);
2157 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2158 /* if this is disabled, then other code in eval.c must be enabled */
2159 Emchar ch = reader_nextchar (readcharfun);
2165 int speccount = specpdl_depth ();
2166 ++old_backquote_flag;
2167 record_unwind_protect (backquote_unwind,
2168 make_opaque_ptr (&old_backquote_flag));
2169 tem = read0 (readcharfun);
2170 unbind_to (speccount, Qnil);
2171 ch = reader_nextchar (readcharfun);
2174 unreadchar (readcharfun, ch);
2175 return Fsignal (Qinvalid_read_syntax,
2177 ("Weird old-backquote syntax")));
2179 return list2 (Qbacktick, tem);
2183 if (old_backquote_flag)
2185 Lisp_Object tem, comma_type;
2186 ch = readchar (readcharfun);
2188 comma_type = Qcomma_at;
2192 unreadchar (readcharfun, ch);
2193 comma_type = Qcomma;
2195 tem = read0 (readcharfun);
2196 ch = reader_nextchar (readcharfun);
2199 unreadchar (readcharfun, ch);
2200 return Fsignal (Qinvalid_read_syntax,
2202 ("Weird old-backquote syntax")));
2204 return list2 (comma_type, tem);
2208 unreadchar (readcharfun, ch);
2210 return Fsignal (Qinvalid_read_syntax,
2211 list1 (build_string ("Comma outside of backquote")));
2213 /* #### - yuck....but this is reverse compatible. */
2214 /* mostly this is required by edebug, which does its own
2215 annotated reading. We need to have an annotated_read
2216 function that records (with markers) the buffer
2217 positions of the elements that make up lists, then that
2218 can be used in edebug and bytecomp and the check above
2219 can go back in. --Stig */
2225 unreadchar (readcharfun, ch);
2227 #endif /* old backquote crap... */
2228 return read_list (readcharfun, ')', 1, 1);
2231 return read_vector (readcharfun, ']');
2235 /* #### - huh? these don't do what they seem... */
2236 return noseeum_cons (Qunbound, make_char (c));
2239 #ifdef LISP_FLOAT_TYPE
2240 /* If a period is followed by a number, then we should read it
2241 as a floating point number. Otherwise, it denotes a dotted
2244 c = readchar (readcharfun);
2245 unreadchar (readcharfun, c);
2247 /* Can't use isdigit on Emchars */
2248 if (c < '0' || c > '9')
2249 return noseeum_cons (Qunbound, make_char ('.'));
2251 /* Note that read_atom will loop
2252 at least once, assuring that we will not try to UNREAD
2253 two characters in a row.
2254 (I think this doesn't matter anymore because there should
2255 be no more danger in unreading multiple characters) */
2256 return read_atom (readcharfun, '.', 0);
2258 #else /* ! LISP_FLOAT_TYPE */
2259 return noseeum_cons (Qunbound, make_char ('.'));
2260 #endif /* ! LISP_FLOAT_TYPE */
2265 c = readchar (readcharfun);
2268 #if 0 /* FSFmacs silly char-table syntax */
2271 #if 0 /* FSFmacs silly bool-vector syntax */
2274 /* "#["-- byte-code constant syntax */
2275 /* purecons #[...] syntax */
2276 case '[': return read_compiled_function (readcharfun, ']'
2277 /*, purify_flag */ );
2278 /* "#:"-- gensym syntax */
2279 case ':': return read_atom (readcharfun, -1, 1);
2280 /* #'x => (function x) */
2281 case '\'': return list2 (Qfunction, read0 (readcharfun));
2283 /* RMS uses this syntax for fat-strings.
2284 If we use it for vectors, then obscure bugs happen.
2286 /* "#(" -- Scheme/CL vector syntax */
2287 case '(': return read_vector (readcharfun, ')');
2293 struct gcpro gcpro1;
2295 /* Read the string itself. */
2296 tmp = read1 (readcharfun);
2299 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
2300 free_cons (XCONS (tmp));
2301 return Fsignal (Qinvalid_read_syntax,
2302 list1 (build_string ("#")));
2305 /* Read the intervals and their properties. */
2308 Lisp_Object beg, end, plist;
2312 beg = read1 (readcharfun);
2313 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
2315 ch = XCHAR (XCDR (beg));
2316 free_cons (XCONS (beg));
2324 end = read1 (readcharfun);
2325 if (CONSP (end) && UNBOUNDP (XCAR (end)))
2327 free_cons (XCONS (end));
2333 plist = read1 (readcharfun);
2334 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
2336 free_cons (XCONS (plist));
2342 (Fsignal (Qinvalid_read_syntax,
2344 (build_string ("invalid string property list"),
2346 Fset_text_properties (beg, end, plist, tmp);
2354 /* #@NUMBER is used to skip NUMBER following characters.
2355 That's used in .elc files to skip over doc strings
2356 and function definitions. */
2359 /* Read a decimal integer. */
2360 while ((c = readchar (readcharfun)) >= 0
2361 && c >= '0' && c <= '9')
2362 nskip = (10 * nskip) + (c - '0');
2364 unreadchar (readcharfun, c);
2366 /* FSF has code here that maybe caches the skipped
2367 string. See above for why this is totally
2368 losing. We handle this differently. */
2370 /* Skip that many characters. */
2371 for (i = 0; i < nskip && c >= 0; i++)
2372 c = readchar (readcharfun);
2376 case '$': return Vload_file_name_internal;
2378 case '*': return read_bit_vector (readcharfun);
2379 /* #o10 => 8 -- octal constant syntax */
2380 case 'o': return read_integer (readcharfun, 8);
2381 /* #xdead => 57005 -- hex constant syntax */
2382 case 'x': return read_integer (readcharfun, 16);
2383 /* #b010 => 2 -- binary constant syntax */
2384 case 'b': return read_integer (readcharfun, 2);
2385 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
2386 case 's': return read_structure (readcharfun);
2389 unreadchar (readcharfun, c);
2390 return Fsignal (Qinvalid_read_syntax,
2391 list1 (build_string ("Cannot read unreadable object")));
2393 #ifdef FEATUREP_SYNTAX
2397 Lisp_Object fexp, obj, tem;
2398 struct gcpro gcpro1, gcpro2;
2400 fexp = read0(readcharfun);
2401 obj = read0(readcharfun);
2403 /* the call to `featurep' may GC. */
2405 tem = call1(Qfeaturep, fexp);
2408 if (c == '+' && NILP(tem)) goto retry;
2409 if (c == '-' && !NILP(tem)) goto retry;
2413 case '0': case '1': case '2': case '3': case '4':
2414 case '5': case '6': case '7': case '8': case '9':
2415 /* Reader forms that can reuse previously read objects. */
2420 /* Using read_integer() here is impossible, because it
2421 chokes on `='. Using parse_integer() is too hard.
2422 So we simply read it in, and ignore overflows, which
2424 while (c >= '0' && c <= '9')
2428 c = readchar (readcharfun);
2430 found = assq_no_quit (make_int (n), read_objects);
2433 /* #n=object returns object, but associates it with
2437 return Fsignal (Qinvalid_read_syntax,
2438 list2 (build_translated_string
2439 ("Multiply defined symbol label"),
2441 obj = read0 (readcharfun);
2442 read_objects = Fcons (Fcons (make_int (n), obj), read_objects);
2447 /* #n# returns a previously read object. */
2449 return XCDR (found);
2451 return Fsignal (Qinvalid_read_syntax,
2452 list2 (build_translated_string
2453 ("Undefined symbol label"),
2456 return Fsignal (Qinvalid_read_syntax,
2457 list1 (build_string ("#")));
2461 unreadchar (readcharfun, c);
2462 return Fsignal (Qinvalid_read_syntax,
2463 list1 (build_string ("#")));
2469 case '\'': return list2 (Qquote, read0 (readcharfun));
2471 #ifdef LISP_BACKQUOTES
2475 int speccount = specpdl_depth ();
2476 ++new_backquote_flag;
2477 record_unwind_protect (backquote_unwind,
2478 make_opaque_ptr (&new_backquote_flag));
2479 tem = read0 (readcharfun);
2480 unbind_to (speccount, Qnil);
2481 return list2 (Qbackquote, tem);
2486 if (new_backquote_flag)
2488 Lisp_Object comma_type = Qnil;
2489 int ch = readchar (readcharfun);
2492 comma_type = Qcomma_at;
2494 comma_type = Qcomma_dot;
2498 unreadchar (readcharfun, ch);
2499 comma_type = Qcomma;
2501 return list2 (comma_type, read0 (readcharfun));
2505 /* YUCK. 99.999% backwards compatibility. The Right
2506 Thing(tm) is to signal an error here, because it's
2507 really invalid read syntax. Instead, this permits
2508 commas to begin symbols (unless they're inside
2509 backquotes). If an error is signalled here in the
2510 future, then commas should be invalid read syntax
2511 outside of backquotes anywhere they're found (i.e.
2512 they must be quoted in symbols) -- Stig */
2513 return read_atom (readcharfun, c, 0);
2520 /* Evil GNU Emacs "character" (ie integer) syntax */
2521 c = readchar (readcharfun);
2523 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2526 c = read_escape (readcharfun);
2527 return make_char (c);
2534 /* #### If the input stream is translating, then the string
2535 should be marked as translatable by setting its
2536 `string-translatable' property to t. .el and .elc files
2537 normally are translating input streams. See Fgettext()
2538 and print_internal(). */
2542 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
2543 while ((c = readchar (readcharfun)) >= 0
2547 c = read_escape (readcharfun);
2548 /* c is -1 if \ newline has just been seen */
2551 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
2555 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
2559 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2561 /* If purifying, and string starts with \ newline,
2562 return zero instead. This is for doc strings
2563 that we are really going to find in lib-src/DOC.nn.nn */
2564 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
2567 Lstream_flush (XLSTREAM (Vread_buffer_stream));
2568 #if 0 /* FSFmacs defun hack */
2572 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2573 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2578 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2579 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2584 /* Ignore whitespace and control characters */
2587 return read_atom (readcharfun, c, 0);
2594 #ifdef LISP_FLOAT_TYPE
2603 isfloat_string (CONST char *cp)
2606 CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
2608 if (*ucp == '+' || *ucp == '-')
2611 if (*ucp >= '0' && *ucp <= '9')
2614 while (*ucp >= '0' && *ucp <= '9')
2622 if (*ucp >= '0' && *ucp <= '9')
2625 while (*ucp >= '0' && *ucp <= '9')
2628 if (*ucp == 'e' || *ucp == 'E')
2632 if ((*ucp == '+') || (*ucp == '-'))
2636 if (*ucp >= '0' && *ucp <= '9')
2639 while (*ucp >= '0' && *ucp <= '9')
2642 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
2643 || (*ucp == '\r') || (*ucp == '\f'))
2644 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
2645 || state == (DOT_CHAR|TRAIL_INT)
2646 || state == (LEAD_INT|E_CHAR|EXP_INT)
2647 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2648 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
2650 #endif /* LISP_FLOAT_TYPE */
2653 sequence_reader (Lisp_Object readcharfun,
2656 void * (*conser) (Lisp_Object readcharfun,
2657 void *state, Charcount len))
2661 for (len = 0; ; len++)
2666 ch = reader_nextchar (readcharfun);
2668 if (ch == terminator)
2671 unreadchar (readcharfun, ch);
2672 #ifdef FEATUREP_SYNTAX
2674 syntax_error ("\"]\" in a list");
2676 syntax_error ("\")\" in a vector");
2678 state = ((conser) (readcharfun, state, len));
2683 struct read_list_state
2688 int allow_dotted_lists;
2693 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
2695 struct read_list_state *s = (struct read_list_state *) state;
2698 elt = read1 (readcharfun);
2700 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2702 Lisp_Object tem = elt;
2706 free_cons (XCONS (tem));
2709 #ifdef FEATUREP_SYNTAX
2710 if (ch == s->terminator) /* deal with #+, #- reader macros */
2712 unreadchar (readcharfun, s->terminator);
2716 syntax_error ("']' in a list");
2718 syntax_error ("')' in a vector");
2722 signal_simple_error ("BUG! Internal reader error", elt);
2723 else if (!s->allow_dotted_lists)
2724 syntax_error ("\".\" in a vector");
2727 if (!NILP (s->tail))
2728 XCDR (s->tail) = read0 (readcharfun);
2730 s->head = read0 (readcharfun);
2731 elt = read1 (readcharfun);
2732 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2734 ch = XCHAR (XCDR (elt));
2735 free_cons (XCONS (elt));
2736 if (ch == s->terminator)
2738 unreadchar (readcharfun, s->terminator);
2742 syntax_error (". in wrong context");
2746 #if 0 /* FSFmacs defun hack, or something ... */
2747 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
2749 record_unwind_protect (unreadpure, Qzero);
2754 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2755 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
2757 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
2758 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
2760 Vcurrent_compiled_function_annotation = elt;
2764 elt = Fcons (elt, Qnil);
2765 if (!NILP (s->tail))
2766 XCDR (s->tail) = elt;
2776 #if 0 /* FSFmacs defun hack */
2777 /* -1 for allow_dotted_lists means allow_dotted_lists and check
2778 for starting with defun and make structure pure. */
2782 read_list (Lisp_Object readcharfun,
2784 int allow_dotted_lists,
2785 int check_for_doc_references)
2787 struct read_list_state s;
2788 struct gcpro gcpro1, gcpro2;
2789 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2790 Lisp_Object old_compiled_function_annotation =
2791 Vcurrent_compiled_function_annotation;
2797 s.allow_dotted_lists = allow_dotted_lists;
2798 s.terminator = terminator;
2799 GCPRO2 (s.head, s.tail);
2801 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2802 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2803 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
2806 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
2808 /* check now for any doc string references and record them
2812 /* We might be dealing with an imperfect list so don't
2814 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
2816 Lisp_Object holding_cons = Qnil;
2819 Lisp_Object elem = XCAR (tail);
2820 /* elem might be (#$ . INT) ... */
2821 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2822 holding_cons = tail;
2823 /* or it might be (quote (#$ . INT)) i.e.
2824 (quote . ((#$ . INT) . nil)) in the case of
2825 `autoload' (autoload evaluates its arguments, while
2826 `defvar', `defun', etc. don't). */
2827 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
2828 && CONSP (XCDR (elem)))
2830 elem = XCAR (XCDR (elem));
2831 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2832 holding_cons = XCDR (XCAR (tail));
2836 if (CONSP (holding_cons))
2840 if (NILP (Vinternal_doc_file_name))
2841 /* We have not yet called Snarf-documentation, so
2842 assume this file is described in the DOC file
2843 and Snarf-documentation will fill in the right
2844 value later. For now, replace the whole list
2846 XCAR (holding_cons) = Qzero;
2848 /* We have already called Snarf-documentation, so
2849 make a relative file name for this file, so it
2850 can be found properly in the installed Lisp
2851 directory. We don't use Fexpand_file_name
2852 because that would make the directory absolute
2854 XCAR (XCAR (holding_cons)) =
2855 concat2 (build_string ("../lisp/"),
2856 Ffile_name_nondirectory
2857 (Vload_file_name_internal));
2860 /* Not pure. Just add to Vload_force_doc_string_list,
2861 and the string will be filled in properly in
2862 load_force_doc_string_unwind(). */
2863 Vload_force_doc_string_list =
2864 /* We pass the cons that holds the (#$ . INT) so we
2865 can modify it in-place. */
2866 Fcons (holding_cons, Vload_force_doc_string_list);
2876 read_vector (Lisp_Object readcharfun,
2883 struct read_list_state s;
2884 struct gcpro gcpro1, gcpro2;
2889 s.allow_dotted_lists = 0;
2890 GCPRO2 (s.head, s.tail);
2892 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2896 len = XINT (Flength (tem));
2898 #if 0 /* FSFmacs defun hack */
2900 s.head = make_pure_vector (len, Qnil);
2903 s.head = make_vector (len, Qnil);
2905 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
2909 struct Lisp_Cons *otem = XCONS (tem);
2910 #if 0 /* FSFmacs defun hack */
2912 tem = Fpurecopy (Fcar (tem));
2924 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
2926 /* Accept compiled functions at read-time so that we don't
2927 have to build them at load-time. */
2929 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
2930 struct gcpro gcpro1;
2933 int saw_a_doc_ref = 0;
2935 /* Note: we tell read_list not to search for doc references
2936 because we need to handle the "doc reference" for the
2937 instructions and constants differently. */
2938 stuff = read_list (readcharfun, terminator, 0, 0);
2939 len = XINT (Flength (stuff));
2940 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
2942 continuable_syntax_error ("#[...] used with wrong number of elements");
2944 for (iii = 0; CONSP (stuff); iii++)
2946 struct Lisp_Cons *victim = XCONS (stuff);
2947 make_byte_code_args[iii] = Fcar (stuff);
2948 if ((purify_flag || load_force_doc_strings)
2949 && CONSP (make_byte_code_args[iii])
2950 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
2952 if (purify_flag && iii == COMPILED_DOC_STRING)
2954 /* same as in read_list(). */
2955 if (NILP (Vinternal_doc_file_name))
2956 make_byte_code_args[iii] = Qzero;
2958 XCAR (make_byte_code_args[iii]) =
2959 concat2 (build_string ("../lisp/"),
2960 Ffile_name_nondirectory
2961 (Vload_file_name_internal));
2966 stuff = Fcdr (stuff);
2969 GCPRO1 (make_byte_code_args[0]);
2972 /* v18 or v19 bytecode file. Need to Ebolify. */
2973 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
2974 ebolify_bytecode_constants (make_byte_code_args[2]);
2976 /* make-byte-code looks at purify_flag, which should have the same
2977 * value as our "read-pure" argument */
2978 stuff = Fmake_byte_code (len, make_byte_code_args);
2979 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
2981 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
2993 load_in_progress = 0;
2995 Vload_descriptor_list = Qnil;
2997 /* kludge: locate-file does not work for a null load-path, even if
2998 the file name is absolute. */
3000 Vload_path = Fcons (build_string (""), Qnil);
3002 /* This used to get initialized in init_lread because all streams
3003 got closed when dumping occurs. This is no longer true --
3004 Vread_buffer_stream is a resizing output stream, and there is no
3005 reason to close it at dump-time.
3007 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3008 will initialize it only once, at dump-time. */
3009 if (NILP (Vread_buffer_stream))
3010 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3012 Vload_force_doc_string_list = Qnil;
3016 syms_of_lread (void)
3019 DEFSUBR (Fread_from_string);
3020 DEFSUBR (Fload_internal);
3021 DEFSUBR (Flocate_file);
3022 DEFSUBR (Flocate_file_clear_hashing);
3023 DEFSUBR (Feval_buffer);
3024 DEFSUBR (Feval_region);
3026 defsymbol (&Qstandard_input, "standard-input");
3027 defsymbol (&Qread_char, "read-char");
3028 defsymbol (&Qcurrent_load_list, "current-load-list");
3029 defsymbol (&Qload, "load");
3030 defsymbol (&Qload_file_name, "load-file-name");
3031 defsymbol (&Qlocate_file_hash_table, "locate-file-hash-table");
3032 defsymbol (&Qfset, "fset");
3034 #ifdef LISP_BACKQUOTES
3035 defsymbol (&Qbackquote, "backquote");
3036 defsymbol (&Qbacktick, "`");
3037 defsymbol (&Qcomma, ",");
3038 defsymbol (&Qcomma_at, ",@");
3039 defsymbol (&Qcomma_dot, ",.");
3044 structure_type_create (void)
3046 the_structure_type_dynarr = Dynarr_new (structure_type);
3050 vars_of_lread (void)
3052 DEFVAR_LISP ("values", &Vvalues /*
3053 List of values of all expressions which were read, evaluated and printed.
3054 Order is reverse chronological.
3057 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3058 Stream for read to get input from.
3059 See documentation of `read' for possible values.
3061 Vstandard_input = Qt;
3063 DEFVAR_LISP ("load-path", &Vload_path /*
3064 *List of directories to search for files to load.
3065 Each element is a string (directory name) or nil (try default directory).
3067 Note that the elements of this list *may not* begin with "~", so you must
3068 call `expand-file-name' on them before adding them to this list.
3070 Initialized based on EMACSLOADPATH environment variable, if any,
3071 otherwise to default specified in by file `paths.h' when XEmacs was built.
3072 If there were no paths specified in `paths.h', then XEmacs chooses a default
3073 value for this variable by looking around in the file-system near the
3074 directory in which the XEmacs executable resides.
3078 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3079 "*Location of lisp files to be used when dumping ONLY."); */
3081 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3082 Non-nil iff inside of `load'.
3085 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3086 An alist of expressions to be evalled when particular files are loaded.
3087 Each element looks like (FILENAME FORMS...).
3088 When `load' is run and the file-name argument is FILENAME,
3089 the FORMS in the corresponding element are executed at the end of loading.
3091 FILENAME must match exactly! Normally FILENAME is the name of a library,
3092 with no directory specified, since that is how `load' is normally called.
3093 An error in FORMS does not undo the load,
3094 but does prevent execution of the rest of the FORMS.
3096 Vafter_load_alist = Qnil;
3098 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3099 *Whether `load' should check whether the source is newer than the binary.
3100 If this variable is true, then when a `.elc' file is being loaded and the
3101 corresponding `.el' is newer, a warning message will be printed.
3103 load_warn_when_source_newer = 0;
3105 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3106 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3107 If this variable is true, then when `load' is called with a filename without
3108 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3109 then a message will be printed. If an explicit extension is passed to `load',
3110 no warning will be printed.
3112 load_warn_when_source_only = 0;
3114 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3115 *Whether `load' should ignore `.elc' files when a suffix is not given.
3116 This is normally used only to bootstrap the `.elc' files when building XEmacs.
3118 load_ignore_elc_files = 0;
3121 DEFVAR_LISP ("load-history", &Vload_history /*
3122 Alist mapping source file names to symbols and features.
3123 Each alist element is a list that starts with a file name,
3124 except for one element (optional) that starts with nil and describes
3125 definitions evaluated from buffers not visiting files.
3126 The remaining elements of each list are symbols defined as functions
3127 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3129 Vload_history = Qnil;
3131 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3132 Used for internal purposes by `load'.
3134 Vcurrent_load_list = Qnil;
3137 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3138 Full name of file being loaded by `load'.
3140 Vload_file_name = Qnil;
3142 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3143 Function used by `load' and `eval-region' for reading expressions.
3144 The default is nil, which means use the function `read'.
3146 Vload_read_function = Qnil;
3148 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3149 Non-nil means `load' should force-load all dynamic doc strings.
3150 This is useful when the file being loaded is a temporary copy.
3152 load_force_doc_strings = 0;
3154 /* See read_escape(). */
3156 /* Used to be named `puke-on-fsf-keys' */
3157 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3158 &fail_on_bucky_bit_character_escapes /*
3159 Whether `read' should signal an error when it encounters unsupported
3160 character escape syntaxes or just read them incorrectly.
3162 fail_on_bucky_bit_character_escapes = 0;
3165 /* This must be initialized in init_lread otherwise it may start out
3166 with values saved when the image is dumped. */
3167 staticpro (&Vload_descriptor_list);
3169 Vread_buffer_stream = Qnil;
3170 staticpro (&Vread_buffer_stream);
3172 /* Initialized in init_lread. */
3173 staticpro (&Vload_force_doc_string_list);
3175 Vload_file_name_internal = Qnil;
3176 staticpro (&Vload_file_name_internal);
3178 Vload_file_name_internal_the_purecopy = Qnil;
3179 staticpro (&Vload_file_name_internal_the_purecopy);
3181 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3182 Vcurrent_compiled_function_annotation = Qnil;
3183 staticpro (&Vcurrent_compiled_function_annotation);
3186 /* So that early-early stuff will work */
3187 Ffset (Qload, intern ("load-internal"));
3189 #ifdef FEATUREP_SYNTAX
3190 defsymbol (&Qfeaturep, "featurep");
3191 Fprovide(intern("xemacs"));
3193 Fprovide(intern("infodock"));
3194 #endif /* INFODOCK */
3195 #endif /* FEATUREP_SYNTAX */
3197 #ifdef LISP_BACKQUOTES
3198 old_backquote_flag = new_backquote_flag = 0;
3202 Vfile_domain = Qnil;
3205 read_objects = Qnil;
3206 staticpro (&read_objects);